From f5f7a74bd8a4900f0b797da6783be80e11a68d86 Mon Sep 17 00:00:00 2001 From: Loriane Weber Date: Wed, 27 Apr 2016 16:09:57 +0200 Subject: [PATCH] Add a useful package (from Source forge) for octave --- octave_packages/audio-1.1.4/au.m | 51 + octave_packages/audio-1.1.4/auload.m | 383 ++ octave_packages/audio-1.1.4/auplot.m | 197 + octave_packages/audio-1.1.4/ausave.m | 262 + octave_packages/audio-1.1.4/clip.m | 63 + octave_packages/audio-1.1.4/doc-cache | 331 + .../audio-1.1.4/packinfo/.autoload | 0 .../audio-1.1.4/packinfo/DESCRIPTION | 11 + octave_packages/audio-1.1.4/packinfo/INDEX | 11 + octave_packages/audio-1.1.4/sample.wav | Bin 0 -> 34804 bytes octave_packages/audio-1.1.4/sound.m | 159 + octave_packages/audio-1.1.4/soundsc.m | 65 + .../benchmark-1.1.1/benchmark_dtmm.m | 99 + .../benchmark-1.1.1/benchmark_index.m | 174 + .../benchmark-1.1.1/benchmark_intmath.m | 182 + .../benchmark-1.1.1/benchmark_permute.m | 54 + .../benchmark-1.1.1/benchmark_stmm.m | 78 + .../benchmark-1.1.1/benchutil_average.m | 40 + .../benchmark-1.1.1/benchutil_default_arg.m | 28 + .../benchmark-1.1.1/benchutil_initialize.m | 44 + .../benchmark-1.1.1/benchutil_is_octave.m | 30 + .../benchmark-1.1.1/benchutil_parse_desc.m | 69 + .../benchmark-1.1.1/benchutil_set_result.m | 32 + .../benchmark-1.1.1/benchutil_verbose.m | 33 + octave_packages/benchmark-1.1.1/doc-cache | 395 ++ .../benchmark-1.1.1/packinfo/.autoload | 0 .../benchmark-1.1.1/packinfo/DESCRIPTION | 10 + .../benchmark-1.1.1/packinfo/INDEX | 11 + .../communications-1.1.1/@galois/conv.m | 81 + .../communications-1.1.1/@galois/convmtx.m | 47 + .../communications-1.1.1/@galois/deconv.m | 80 + .../communications-1.1.1/@galois/det.m | 24 + .../communications-1.1.1/@galois/dftmtx.m | 67 + .../communications-1.1.1/@galois/diag.m | 42 + .../communications-1.1.1/@galois/exp.m | 25 + .../communications-1.1.1/@galois/fft.m | 50 + .../communications-1.1.1/@galois/filter.m | 90 + .../communications-1.1.1/@galois/ifft.m | 51 + .../communications-1.1.1/@galois/inv.m | 26 + .../communications-1.1.1/@galois/inverse.m | 24 + .../communications-1.1.1/@galois/isequal.m | 32 + .../communications-1.1.1/@galois/log.m | 25 + .../communications-1.1.1/@galois/lu.m | 63 + .../communications-1.1.1/@galois/prod.m | 26 + .../communications-1.1.1/@galois/rank.m | 25 + .../communications-1.1.1/@galois/reshape.m | 56 + .../communications-1.1.1/@galois/roots.m | 75 + .../communications-1.1.1/@galois/sqrt.m | 26 + .../communications-1.1.1/@galois/sum.m | 25 + .../communications-1.1.1/@galois/sumsq.m | 31 + .../communications-1.1.1/ademodce.m | 187 + .../communications-1.1.1/amdemod.m | 30 + octave_packages/communications-1.1.1/ammod.m | 30 + octave_packages/communications-1.1.1/amodce.m | 171 + .../communications-1.1.1/apkconst.m | 149 + octave_packages/communications-1.1.1/awgn.m | 147 + .../communications-1.1.1/bchpoly.m | 233 + octave_packages/communications-1.1.1/bi2de.m | 96 + octave_packages/communications-1.1.1/biterr.m | 170 + octave_packages/communications-1.1.1/bsc.m | 39 + octave_packages/communications-1.1.1/comms.m | 665 ++ .../communications-1.1.1/compand.m | 116 + .../communications-1.1.1/convenc.m | 65 + octave_packages/communications-1.1.1/cosets.m | 53 + octave_packages/communications-1.1.1/de2bi.m | 107 + octave_packages/communications-1.1.1/decode.m | 282 + .../communications-1.1.1/deintrlv.m | 44 + .../communications-1.1.1/demodmap.m | 240 + .../communications-1.1.1/doc-cache | 3942 ++++++++++++ .../communications-1.1.1/egolaydec.m | 126 + .../communications-1.1.1/egolayenc.m | 70 + .../communications-1.1.1/egolaygen.m | 41 + octave_packages/communications-1.1.1/encode.m | 213 + .../communications-1.1.1/eyediagram.m | 199 + .../communications-1.1.1/fibodeco.m | 81 + .../communications-1.1.1/fiboenco.m | 89 + .../communications-1.1.1/fibosplitstream.m | 81 + .../communications-1.1.1/fmdemod.m | 29 + octave_packages/communications-1.1.1/fmmod.m | 30 + .../communications-1.1.1/gen2par.m | 50 + .../communications-1.1.1/genqamdemod.m | 38 + .../communications-1.1.1/genqammod.m | 51 + .../communications-1.1.1/gftable.m | 28 + .../communications-1.1.1/gfweight.m | 78 + .../communications-1.1.1/golombdeco.m | 92 + .../communications-1.1.1/golombenco.m | 104 + .../communications-1.1.1/hammgen.m | 73 + .../communications-1.1.1/helintrlv.m | 71 + .../communications-1.1.1/helscandeintrlv.m | 23 + .../communications-1.1.1/helscanintrlv.m | 61 + .../communications-1.1.1/huffmandeco.m | 102 + .../communications-1.1.1/huffmandict.m | 222 + .../communications-1.1.1/huffmanenco.m | 46 + octave_packages/communications-1.1.1/intrlv.m | 41 + octave_packages/communications-1.1.1/lloyds.m | 170 + .../communications-1.1.1/lz77deco.m | 77 + .../communications-1.1.1/lz77enco.m | 93 + .../communications-1.1.1/matdeintrlv.m | 27 + .../communications-1.1.1/matintrlv.m | 52 + octave_packages/communications-1.1.1/minpol.m | 80 + octave_packages/communications-1.1.1/modmap.m | 332 + .../communications-1.1.1/oct2dec.m | 61 + .../communications-1.1.1/packinfo/.autoload | 0 .../communications-1.1.1/packinfo/DESCRIPTION | 11 + .../communications-1.1.1/packinfo/INDEX | 179 + .../communications-1.1.1/packinfo/NEWS | 27 + .../communications-1.1.1/pamdemod.m | 68 + octave_packages/communications-1.1.1/pammod.m | 75 + .../communications-1.1.1/prbs_generator.m | 61 + .../communications-1.1.1/prbs_iterator.m | 144 + .../communications-1.1.1/prbs_sequence.m | 81 + .../communications-1.1.1/pskdemod.m | 68 + octave_packages/communications-1.1.1/pskmod.m | 69 + .../communications-1.1.1/qamdemod.m | 40 + octave_packages/communications-1.1.1/qammod.m | 43 + .../communications-1.1.1/qaskdeco.m | 215 + .../communications-1.1.1/qaskenco.m | 180 + octave_packages/communications-1.1.1/qfunc.m | 25 + .../communications-1.1.1/qfuncinv.m | 27 + .../communications-1.1.1/quantiz.m | 52 + .../communications-1.1.1/randdeintrlv.m | 33 + .../communications-1.1.1/randerr.m | 114 + .../communications-1.1.1/randint.m | 99 + .../communications-1.1.1/randintrlv.m | 33 + .../communications-1.1.1/randsrc.m | 120 + .../communications-1.1.1/reedmullerdec.m | 266 + .../communications-1.1.1/reedmullerenc.m | 52 + .../communications-1.1.1/reedmullergen.m | 81 + .../communications-1.1.1/ricedeco.m | 80 + .../communications-1.1.1/riceenco.m | 108 + .../communications-1.1.1/rledeco.m | 52 + .../communications-1.1.1/rleenco.m | 55 + .../communications-1.1.1/rsdecof.m | 92 + .../communications-1.1.1/rsencof.m | 111 + .../communications-1.1.1/rsgenpoly.m | 151 + .../communications-1.1.1/scatterplot.m | 158 + .../communications-1.1.1/shannonfanodeco.m | 142 + .../communications-1.1.1/shannonfanodict.m | 118 + .../communications-1.1.1/shannonfanoenco.m | 50 + octave_packages/communications-1.1.1/symerr.m | 143 + .../communications-1.1.1/systematize.m | 121 + .../communications-1.1.1/vec2mat.m | 56 + octave_packages/communications-1.1.1/wgn.m | 143 + octave_packages/control-2.3.52/@frd/__c2d__.m | 31 + .../control-2.3.52/@frd/__ctranspose__.m | 35 + octave_packages/control-2.3.52/@frd/__d2c__.m | 31 + .../control-2.3.52/@frd/__freqresp__.m | 81 + octave_packages/control-2.3.52/@frd/__get__.m | 39 + .../control-2.3.52/@frd/__minreal__.m | 29 + .../control-2.3.52/@frd/__pole__.m | 29 + .../control-2.3.52/@frd/__property_names__.m | 46 + octave_packages/control-2.3.52/@frd/__set__.m | 43 + .../control-2.3.52/@frd/__sys2ss__.m | 32 + .../control-2.3.52/@frd/__sys2tf__.m | 32 + .../control-2.3.52/@frd/__sys_connect__.m | 54 + .../control-2.3.52/@frd/__sys_data__.m | 30 + .../control-2.3.52/@frd/__sys_group__.m | 77 + .../control-2.3.52/@frd/__sys_inverse__.m | 35 + .../control-2.3.52/@frd/__sys_prune__.m | 33 + .../control-2.3.52/@frd/__transpose__.m | 35 + .../control-2.3.52/@frd/__zero__.m | 29 + octave_packages/control-2.3.52/@frd/display.m | 138 + octave_packages/control-2.3.52/@frd/frd.m | 127 + .../control-2.3.52/@lti/__lti_data__.m | 31 + .../control-2.3.52/@lti/__lti_group__.m | 51 + .../control-2.3.52/@lti/__lti_prune__.m | 32 + .../control-2.3.52/@lti/__property_names__.m | 45 + octave_packages/control-2.3.52/@lti/append.m | 37 + octave_packages/control-2.3.52/@lti/blkdiag.m | 31 + octave_packages/control-2.3.52/@lti/c2d.m | 222 + octave_packages/control-2.3.52/@lti/connect.m | 59 + .../control-2.3.52/@lti/ctranspose.m | 48 + octave_packages/control-2.3.52/@lti/d2c.m | 146 + octave_packages/control-2.3.52/@lti/dcgain.m | 50 + octave_packages/control-2.3.52/@lti/display.m | 33 + octave_packages/control-2.3.52/@lti/dss.m | 42 + octave_packages/control-2.3.52/@lti/dssdata.m | 79 + octave_packages/control-2.3.52/@lti/eig.m | 31 + .../control-2.3.52/@lti/feedback.m | 263 + .../control-2.3.52/@lti/filtdata.m | 87 + octave_packages/control-2.3.52/@lti/frdata.m | 67 + .../control-2.3.52/@lti/freqresp.m | 57 + octave_packages/control-2.3.52/@lti/get.m | 61 + octave_packages/control-2.3.52/@lti/horzcat.m | 109 + octave_packages/control-2.3.52/@lti/inv.m | 84 + octave_packages/control-2.3.52/@lti/isct.m | 49 + octave_packages/control-2.3.52/@lti/isdt.m | 49 + .../control-2.3.52/@lti/isminimumphase.m | 65 + octave_packages/control-2.3.52/@lti/issiso.m | 35 + .../control-2.3.52/@lti/isstable.m | 62 + octave_packages/control-2.3.52/@lti/lft.m | 156 + octave_packages/control-2.3.52/@lti/lti.m | 39 + .../control-2.3.52/@lti/mconnect.m | 89 + octave_packages/control-2.3.52/@lti/minreal.m | 185 + octave_packages/control-2.3.52/@lti/minus.m | 47 + .../control-2.3.52/@lti/mldivide.m | 45 + octave_packages/control-2.3.52/@lti/mpower.m | 59 + .../control-2.3.52/@lti/mrdivide.m | 45 + octave_packages/control-2.3.52/@lti/mtimes.m | 154 + octave_packages/control-2.3.52/@lti/norm.m | 144 + .../control-2.3.52/@lti/parallel.m | 56 + octave_packages/control-2.3.52/@lti/plus.m | 108 + octave_packages/control-2.3.52/@lti/pole.m | 47 + .../control-2.3.52/@lti/prescale.m | 297 + octave_packages/control-2.3.52/@lti/series.m | 118 + octave_packages/control-2.3.52/@lti/set.m | 110 + octave_packages/control-2.3.52/@lti/size.m | 91 + .../control-2.3.52/@lti/sminreal.m | 142 + octave_packages/control-2.3.52/@lti/ssdata.m | 62 + .../control-2.3.52/@lti/subsasgn.m | 45 + octave_packages/control-2.3.52/@lti/subsref.m | 60 + octave_packages/control-2.3.52/@lti/tfdata.m | 79 + .../control-2.3.52/@lti/transpose.m | 40 + octave_packages/control-2.3.52/@lti/uminus.m | 37 + octave_packages/control-2.3.52/@lti/uplus.m | 31 + octave_packages/control-2.3.52/@lti/vertcat.m | 49 + octave_packages/control-2.3.52/@lti/xperm.m | 44 + octave_packages/control-2.3.52/@lti/zero.m | 165 + octave_packages/control-2.3.52/@lti/zpkdata.m | 66 + octave_packages/control-2.3.52/@ss/__c2d__.m | 52 + .../control-2.3.52/@ss/__ctranspose__.m | 54 + octave_packages/control-2.3.52/@ss/__d2c__.m | 54 + .../control-2.3.52/@ss/__freqresp__.m | 66 + octave_packages/control-2.3.52/@ss/__get__.m | 54 + .../control-2.3.52/@ss/__minreal__.m | 45 + octave_packages/control-2.3.52/@ss/__pole__.m | 43 + .../control-2.3.52/@ss/__prescale__.m | 42 + .../control-2.3.52/@ss/__property_names__.m | 58 + octave_packages/control-2.3.52/@ss/__set__.m | 68 + .../control-2.3.52/@ss/__sys2frd__.m | 36 + .../control-2.3.52/@ss/__sys2tf__.m | 88 + .../control-2.3.52/@ss/__sys_connect__.m | 86 + .../control-2.3.52/@ss/__sys_data__.m | 35 + .../control-2.3.52/@ss/__sys_group__.m | 66 + .../control-2.3.52/@ss/__sys_inverse__.m | 61 + .../control-2.3.52/@ss/__sys_prune__.m | 42 + .../control-2.3.52/@ss/__transpose__.m | 41 + octave_packages/control-2.3.52/@ss/__zero__.m | 42 + octave_packages/control-2.3.52/@ss/display.m | 97 + octave_packages/control-2.3.52/@ss/ss.m | 151 + octave_packages/control-2.3.52/@tf/__c2d__.m | 42 + .../control-2.3.52/@tf/__ctranspose__.m | 42 + octave_packages/control-2.3.52/@tf/__d2c__.m | 42 + .../control-2.3.52/@tf/__freqresp__.m | 71 + octave_packages/control-2.3.52/@tf/__get__.m | 44 + .../control-2.3.52/@tf/__minreal__.m | 74 + octave_packages/control-2.3.52/@tf/__pole__.m | 34 + .../control-2.3.52/@tf/__property_names__.m | 52 + octave_packages/control-2.3.52/@tf/__set__.m | 59 + .../control-2.3.52/@tf/__sys2frd__.m | 36 + .../control-2.3.52/@tf/__sys2ss__.m | 177 + .../control-2.3.52/@tf/__sys_connect__.m | 120 + .../control-2.3.52/@tf/__sys_data__.m | 31 + .../control-2.3.52/@tf/__sys_group__.m | 68 + .../control-2.3.52/@tf/__sys_inverse__.m | 52 + .../control-2.3.52/@tf/__sys_prune__.m | 34 + .../control-2.3.52/@tf/__transpose__.m | 33 + octave_packages/control-2.3.52/@tf/__zero__.m | 37 + octave_packages/control-2.3.52/@tf/display.m | 101 + octave_packages/control-2.3.52/@tf/tf.m | 211 + .../@tfpoly/__make_equally_long__.m | 35 + .../@tfpoly/__remove_leading_zeros__.m | 36 + .../control-2.3.52/@tfpoly/conj_ct.m | 30 + .../control-2.3.52/@tfpoly/conj_dt.m | 30 + .../control-2.3.52/@tfpoly/display.m | 29 + octave_packages/control-2.3.52/@tfpoly/eq.m | 32 + octave_packages/control-2.3.52/@tfpoly/get.m | 29 + .../control-2.3.52/@tfpoly/length.m | 29 + .../control-2.3.52/@tfpoly/minus.m | 41 + .../control-2.3.52/@tfpoly/mpower.m | 48 + .../control-2.3.52/@tfpoly/mtimes.m | 37 + octave_packages/control-2.3.52/@tfpoly/ne.m | 32 + .../control-2.3.52/@tfpoly/numel.m | 29 + octave_packages/control-2.3.52/@tfpoly/plus.m | 41 + .../control-2.3.52/@tfpoly/roots.m | 29 + .../control-2.3.52/@tfpoly/subsref.m | 45 + .../control-2.3.52/@tfpoly/tfpoly.m | 51 + .../control-2.3.52/@tfpoly/tfpoly2str.m | 113 + .../control-2.3.52/@tfpoly/uminus.m | 29 + .../control-2.3.52/@tfpoly/uplus.m | 29 + octave_packages/control-2.3.52/Anderson.m | 80 + octave_packages/control-2.3.52/BMWengine.m | 122 + octave_packages/control-2.3.52/Boeing707.m | 69 + octave_packages/control-2.3.52/MDSSystem.m | 162 + octave_packages/control-2.3.52/Madievski.m | 126 + octave_packages/control-2.3.52/WestlandLynx.m | 103 + .../control-2.3.52/__adjust_frd_data__.m | 51 + .../control-2.3.52/__adjust_labels__.m | 38 + .../control-2.3.52/__adjust_ss_data__.m | 48 + .../control-2.3.52/__axis_limits__.m | 71 + .../control-2.3.52/__axis_margin__.m | 63 + .../__conred_check_feedback_sign__.m | 40 + .../control-2.3.52/__conred_sb16ad__.m | 191 + octave_packages/control-2.3.52/__dss2ss__.m | 36 + .../control-2.3.52/__dss_bilin__.m | 91 + octave_packages/control-2.3.52/__frd_dim__.m | 47 + .../control-2.3.52/__frequency_response__.m | 55 + .../control-2.3.52/__frequency_vector__.m | 135 + .../control-2.3.52/__is_stable__.m | 33 + octave_packages/control-2.3.52/__labels__.m | 38 + .../control-2.3.52/__modred_ab09id__.m | 178 + .../control-2.3.52/__modred_check_alpha__.m | 40 + .../__modred_check_alpha_gram__.m | 35 + .../control-2.3.52/__modred_check_equil__.m | 33 + .../control-2.3.52/__modred_check_gram__.m | 40 + .../control-2.3.52/__modred_check_order__.m | 38 + .../control-2.3.52/__modred_check_tol__.m | 31 + .../control-2.3.52/__modred_check_weight__.m | 49 + .../control-2.3.52/__modred_default_alpha__.m | 33 + octave_packages/control-2.3.52/__opt2cell__.m | 37 + .../__remove_trailing_zeros__.m | 36 + octave_packages/control-2.3.52/__ss_dim__.m | 72 + octave_packages/control-2.3.52/__tf_dim__.m | 36 + .../control-2.3.52/__time_response__.m | 304 + .../control-2.3.52/__vec2tfpoly__.m | 34 + octave_packages/control-2.3.52/augw.m | 168 + octave_packages/control-2.3.52/bode.m | 97 + octave_packages/control-2.3.52/bodemag.m | 85 + octave_packages/control-2.3.52/bstmodred.m | 351 ++ octave_packages/control-2.3.52/btaconred.m | 281 + octave_packages/control-2.3.52/btamodred.m | 304 + octave_packages/control-2.3.52/care.m | 258 + octave_packages/control-2.3.52/cfconred.m | 334 + octave_packages/control-2.3.52/covar.m | 91 + octave_packages/control-2.3.52/ctrb.m | 83 + octave_packages/control-2.3.52/ctrbf.m | 122 + octave_packages/control-2.3.52/dare.m | 206 + octave_packages/control-2.3.52/dlqe.m | 113 + octave_packages/control-2.3.52/dlqr.m | 97 + octave_packages/control-2.3.52/dlyap.m | 166 + octave_packages/control-2.3.52/dlyapchol.m | 106 + octave_packages/control-2.3.52/doc-cache | 5035 +++++++++++++++ octave_packages/control-2.3.52/dss.m | 90 + octave_packages/control-2.3.52/estim.m | 99 + octave_packages/control-2.3.52/filt.m | 139 + octave_packages/control-2.3.52/fitfrd.m | 100 + octave_packages/control-2.3.52/fwcfconred.m | 295 + octave_packages/control-2.3.52/gensig.m | 99 + octave_packages/control-2.3.52/gram.m | 117 + octave_packages/control-2.3.52/h2syn.m | 265 + octave_packages/control-2.3.52/hinfsyn.m | 268 + octave_packages/control-2.3.52/hnamodred.m | 469 ++ octave_packages/control-2.3.52/hsvd.m | 106 + octave_packages/control-2.3.52/impulse.m | 75 + octave_packages/control-2.3.52/initial.m | 151 + octave_packages/control-2.3.52/isctrb.m | 99 + octave_packages/control-2.3.52/isdetectable.m | 87 + octave_packages/control-2.3.52/isobsv.m | 81 + octave_packages/control-2.3.52/issample.m | 113 + .../control-2.3.52/isstabilizable.m | 135 + octave_packages/control-2.3.52/kalman.m | 125 + octave_packages/control-2.3.52/lqe.m | 113 + octave_packages/control-2.3.52/lqr.m | 98 + octave_packages/control-2.3.52/lsim.m | 195 + octave_packages/control-2.3.52/ltimodels.m | 413 ++ octave_packages/control-2.3.52/lyap.m | 177 + octave_packages/control-2.3.52/lyapchol.m | 154 + octave_packages/control-2.3.52/margin.m | 437 ++ octave_packages/control-2.3.52/mixsyn.m | 162 + octave_packages/control-2.3.52/ncfsyn.m | 503 ++ octave_packages/control-2.3.52/nichols.m | 84 + octave_packages/control-2.3.52/nyquist.m | 82 + octave_packages/control-2.3.52/obsv.m | 80 + octave_packages/control-2.3.52/obsvf.m | 77 + octave_packages/control-2.3.52/optiPID.m | 102 + octave_packages/control-2.3.52/optiPIDctrl.m | 18 + octave_packages/control-2.3.52/optiPIDfun.m | 56 + octave_packages/control-2.3.52/options.m | 83 + .../control-2.3.52/packinfo/.autoload | 0 .../control-2.3.52/packinfo/DESCRIPTION | 11 + octave_packages/control-2.3.52/packinfo/INDEX | 133 + octave_packages/control-2.3.52/packinfo/NEWS | 387 ++ octave_packages/control-2.3.52/place.m | 186 + octave_packages/control-2.3.52/pzmap.m | 75 + octave_packages/control-2.3.52/rlocus.m | 352 ++ octave_packages/control-2.3.52/sigma.m | 117 + octave_packages/control-2.3.52/spaconred.m | 232 + octave_packages/control-2.3.52/spamodred.m | 232 + octave_packages/control-2.3.52/step.m | 75 + octave_packages/control-2.3.52/strseq.m | 41 + octave_packages/control-2.3.52/test_control.m | 105 + octave_packages/control-2.3.52/tfpoly2str.m | 104 + octave_packages/control-2.3.52/tfpolyones.m | 33 + octave_packages/control-2.3.52/tfpolyzeros.m | 33 + octave_packages/control-2.3.52/zpk.m | 105 + octave_packages/data-smoothing-1.3.0/ddmat.m | 53 + .../data-smoothing-1.3.0/doc-cache | 211 + .../data-smoothing-1.3.0/packinfo/.autoload | 0 .../data-smoothing-1.3.0/packinfo/DESCRIPTION | 12 + .../data-smoothing-1.3.0/packinfo/INDEX | 6 + .../data-smoothing-1.3.0/packinfo/NEWS | 9 + .../data-smoothing-1.3.0/regdatasmooth.m | 189 + .../data-smoothing-1.3.0/rgdtsmcore.m | 166 + .../data-smoothing-1.3.0/rgdtsmcorewrap.m | 71 + .../dataframe-0.9.1/@dataframe/abs.m | 29 + .../dataframe-0.9.1/@dataframe/acos.m | 29 + .../dataframe-0.9.1/@dataframe/acosh.m | 29 + .../dataframe-0.9.1/@dataframe/and.m | 32 + .../dataframe-0.9.1/@dataframe/angle.m | 29 + .../dataframe-0.9.1/@dataframe/arg.m | 29 + .../dataframe-0.9.1/@dataframe/asin.m | 29 + .../dataframe-0.9.1/@dataframe/asinh.m | 29 + .../dataframe-0.9.1/@dataframe/atan.m | 29 + .../dataframe-0.9.1/@dataframe/atanh.m | 29 + .../dataframe-0.9.1/@dataframe/bsxfun.m | 51 + .../dataframe-0.9.1/@dataframe/cat.m | 201 + .../dataframe-0.9.1/@dataframe/ceil.m | 29 + .../dataframe-0.9.1/@dataframe/columns.m | 31 + .../dataframe-0.9.1/@dataframe/conj.m | 29 + .../dataframe-0.9.1/@dataframe/cos.m | 29 + .../dataframe-0.9.1/@dataframe/cosh.m | 29 + .../dataframe-0.9.1/@dataframe/cumprod.m | 29 + .../dataframe-0.9.1/@dataframe/cumsum.m | 29 + .../dataframe-0.9.1/@dataframe/dataframe.m | 434 ++ .../dataframe-0.9.1/@dataframe/display.m | 203 + .../dataframe-0.9.1/@dataframe/end.m | 40 + .../dataframe-0.9.1/@dataframe/eq.m | 32 + .../dataframe-0.9.1/@dataframe/erf.m | 29 + .../dataframe-0.9.1/@dataframe/erfc.m | 29 + .../dataframe-0.9.1/@dataframe/erfcx.m | 29 + .../dataframe-0.9.1/@dataframe/erfinv.m | 29 + .../dataframe-0.9.1/@dataframe/exp.m | 29 + .../dataframe-0.9.1/@dataframe/expm1.m | 29 + .../dataframe-0.9.1/@dataframe/find.m | 60 + .../dataframe-0.9.1/@dataframe/finite.m | 29 + .../dataframe-0.9.1/@dataframe/fix.m | 29 + .../dataframe-0.9.1/@dataframe/floor.m | 29 + .../dataframe-0.9.1/@dataframe/fold.m | 96 + .../dataframe-0.9.1/@dataframe/gamma.m | 29 + .../dataframe-0.9.1/@dataframe/ge.m | 32 + .../dataframe-0.9.1/@dataframe/gt.m | 32 + .../dataframe-0.9.1/@dataframe/horzcat.m | 33 + .../dataframe-0.9.1/@dataframe/imag.m | 29 + .../dataframe-0.9.1/@dataframe/inv.m | 52 + .../dataframe-0.9.1/@dataframe/ipermute.m | 29 + .../dataframe-0.9.1/@dataframe/isempty.m | 10 + .../dataframe-0.9.1/@dataframe/isfield.m | 92 + .../dataframe-0.9.1/@dataframe/isinf.m | 29 + .../dataframe-0.9.1/@dataframe/ismatrix.m | 38 + .../dataframe-0.9.1/@dataframe/isna.m | 29 + .../dataframe-0.9.1/@dataframe/isnan.m | 29 + .../dataframe-0.9.1/@dataframe/isnumeric.m | 39 + .../dataframe-0.9.1/@dataframe/isscalar.m | 31 + .../dataframe-0.9.1/@dataframe/isvector.m | 31 + .../dataframe-0.9.1/@dataframe/kron.m | 36 + .../dataframe-0.9.1/@dataframe/ldivide.m | 37 + .../dataframe-0.9.1/@dataframe/le.m | 32 + .../dataframe-0.9.1/@dataframe/lgamma.m | 29 + .../dataframe-0.9.1/@dataframe/log.m | 29 + .../dataframe-0.9.1/@dataframe/log10.m | 29 + .../dataframe-0.9.1/@dataframe/log1p.m | 29 + .../dataframe-0.9.1/@dataframe/log2.m | 29 + .../dataframe-0.9.1/@dataframe/lt.m | 32 + .../dataframe-0.9.1/@dataframe/max.m | 29 + .../dataframe-0.9.1/@dataframe/min.m | 29 + .../dataframe-0.9.1/@dataframe/minus.m | 37 + .../dataframe-0.9.1/@dataframe/mldivide.m | 37 + .../dataframe-0.9.1/@dataframe/mrdivide.m | 37 + .../dataframe-0.9.1/@dataframe/mtimes.m | 37 + .../dataframe-0.9.1/@dataframe/ndims.m | 12 + .../dataframe-0.9.1/@dataframe/ne.m | 32 + .../dataframe-0.9.1/@dataframe/not.m | 29 + .../dataframe-0.9.1/@dataframe/or.m | 32 + .../dataframe-0.9.1/@dataframe/permute.m | 114 + .../dataframe-0.9.1/@dataframe/plus.m | 37 + .../dataframe-0.9.1/@dataframe/power.m | 29 + .../@dataframe/private/df_allmeta.m | 62 + .../@dataframe/private/df_basecomp.m | 193 + .../@dataframe/private/df_check_char_array.m | 52 + .../@dataframe/private/df_colmeta.m | 43 + .../@dataframe/private/df_cow.m | 78 + .../@dataframe/private/df_func.m | 235 + .../@dataframe/private/df_mapper.m | 37 + .../@dataframe/private/df_mapper2.m | 77 + .../@dataframe/private/df_matassign.m | 502 ++ .../@dataframe/private/df_name2idx.m | 130 + .../@dataframe/private/df_pad.m | 166 + .../@dataframe/private/df_strjust.m | 36 + .../@dataframe/private/df_strset.m | 80 + .../@dataframe/private/df_thirddim.m | 39 + .../@dataframe/private/df_whole.m | 54 + .../dataframe-0.9.1/@dataframe/prod.m | 33 + .../dataframe-0.9.1/@dataframe/rationale.txt | 113 + .../dataframe-0.9.1/@dataframe/rdivide.m | 37 + .../dataframe-0.9.1/@dataframe/real.m | 29 + .../dataframe-0.9.1/@dataframe/repmat.m | 65 + .../dataframe-0.9.1/@dataframe/reshape.m | 35 + .../dataframe-0.9.1/@dataframe/round.m | 29 + .../dataframe-0.9.1/@dataframe/roundb.m | 29 + .../dataframe-0.9.1/@dataframe/rows.m | 31 + .../dataframe-0.9.1/@dataframe/signum.m | 29 + .../dataframe-0.9.1/@dataframe/sin.m | 29 + .../dataframe-0.9.1/@dataframe/sinh.m | 29 + .../dataframe-0.9.1/@dataframe/size.m | 88 + .../dataframe-0.9.1/@dataframe/sort.m | 151 + .../dataframe-0.9.1/@dataframe/sqrt.m | 29 + .../dataframe-0.9.1/@dataframe/subsasgn.m | 190 + .../dataframe-0.9.1/@dataframe/subsindex.m | 45 + .../dataframe-0.9.1/@dataframe/subsref.m | 678 ++ .../dataframe-0.9.1/@dataframe/sum.m | 33 + .../dataframe-0.9.1/@dataframe/summary.m | 86 + .../dataframe-0.9.1/@dataframe/sumsq.m | 33 + .../dataframe-0.9.1/@dataframe/tan.m | 29 + .../dataframe-0.9.1/@dataframe/tanh.m | 29 + .../dataframe-0.9.1/@dataframe/times.m | 37 + .../dataframe-0.9.1/@dataframe/uminus.m | 32 + .../dataframe-0.9.1/@dataframe/uplus.m | 32 + .../dataframe-0.9.1/@dataframe/vertcat.m | 34 + .../dataframe-0.9.1/@dataframe/xor.m | 32 + octave_packages/dataframe-0.9.1/data_test.csv | 14 + octave_packages/dataframe-0.9.1/dataframe | 229 + .../dataframe-0.9.1/packinfo/DESCRIPTION | 12 + .../dataframe-0.9.1/packinfo/INDEX | 23 + octave_packages/dataframe-0.9.1/packinfo/NEWS | 4 + .../__kernel_epanechnikov.m | 36 + .../econometrics-1.0.8/__kernel_normal.m | 29 + .../econometrics-1.0.8/__kernel_weights.m | 32 + .../econometrics-1.0.8/average_moments.m | 54 + .../econometrics-1.0.8/delta_method.m | 23 + octave_packages/econometrics-1.0.8/doc-cache | 990 +++ .../econometrics-1.0.8/gmm_estimate.m | 74 + .../econometrics-1.0.8/gmm_example.m | 64 + octave_packages/econometrics-1.0.8/gmm_obj.m | 31 + .../econometrics-1.0.8/gmm_results.m | 105 + .../econometrics-1.0.8/gmm_variance.m | 24 + .../gmm_variance_inefficient.m | 27 + .../econometrics-1.0.8/kernel_density.m | 119 + .../kernel_density_cvscore.m | 6 + .../econometrics-1.0.8/kernel_density_nodes.m | 54 + .../econometrics-1.0.8/kernel_example.m | 140 + .../kernel_optimal_bandwidth.m | 58 + .../econometrics-1.0.8/kernel_regression.m | 117 + .../kernel_regression_cvscore.m | 5 + .../kernel_regression_nodes.m | 62 + .../econometrics-1.0.8/mle_estimate.m | 73 + .../econometrics-1.0.8/mle_example.m | 79 + octave_packages/econometrics-1.0.8/mle_obj.m | 64 + .../econometrics-1.0.8/mle_obj_nodes.m | 33 + .../econometrics-1.0.8/mle_results.m | 89 + .../econometrics-1.0.8/mle_variance.m | 29 + .../econometrics-1.0.8/nls_estimate.m | 70 + .../econometrics-1.0.8/nls_example.m | 57 + octave_packages/econometrics-1.0.8/nls_obj.m | 60 + .../econometrics-1.0.8/nls_obj_nodes.m | 36 + .../econometrics-1.0.8/packinfo/.autoload | 0 .../econometrics-1.0.8/packinfo/DESCRIPTION | 11 + .../econometrics-1.0.8/packinfo/INDEX | 22 + .../econometrics-1.0.8/parameterize.m | 28 + octave_packages/econometrics-1.0.8/poisson.m | 25 + .../econometrics-1.0.8/poisson_moments.m | 26 + .../econometrics-1.0.8/prettyprint.m | 47 + .../econometrics-1.0.8/prettyprint_c.m | 37 + .../econometrics-1.0.8/scale_data.m | 45 + .../econometrics-1.0.8/sum_moments_nodes.m | 37 + .../econometrics-1.0.8/unscale_parameters.m | 39 + octave_packages/financial-0.4.0/bolling.m | 72 + octave_packages/financial-0.4.0/busdate.m | 97 + octave_packages/financial-0.4.0/busdays.m | 127 + octave_packages/financial-0.4.0/cfconv.m | 60 + octave_packages/financial-0.4.0/cfdur.m | 62 + octave_packages/financial-0.4.0/corr2cov.m | 55 + octave_packages/financial-0.4.0/cov2corr.m | 53 + octave_packages/financial-0.4.0/dateaxis.m | 101 + octave_packages/financial-0.4.0/datefind.m | 44 + octave_packages/financial-0.4.0/datesplit.m | 492 ++ octave_packages/financial-0.4.0/day.m | 31 + octave_packages/financial-0.4.0/daysact.m | 76 + octave_packages/financial-0.4.0/doc-cache | 2059 ++++++ octave_packages/financial-0.4.0/easter.m | 69 + octave_packages/financial-0.4.0/effrr.m | 34 + octave_packages/financial-0.4.0/eomdate.m | 40 + octave_packages/financial-0.4.0/fbusdate.m | 58 + octave_packages/financial-0.4.0/fetch.m | 149 + octave_packages/financial-0.4.0/fv.m | 74 + octave_packages/financial-0.4.0/fvl.m | 42 + octave_packages/financial-0.4.0/google.m | 44 + octave_packages/financial-0.4.0/hhigh.m | 54 + octave_packages/financial-0.4.0/highlow.m | 71 + octave_packages/financial-0.4.0/holidays.m | 91 + octave_packages/financial-0.4.0/hour.m | 30 + octave_packages/financial-0.4.0/irr.m | 39 + octave_packages/financial-0.4.0/isbusday.m | 72 + octave_packages/financial-0.4.0/lbusdate.m | 56 + octave_packages/financial-0.4.0/llow.m | 52 + octave_packages/financial-0.4.0/lweekdate.m | 37 + octave_packages/financial-0.4.0/m2xdate.m | 74 + octave_packages/financial-0.4.0/minute.m | 30 + octave_packages/financial-0.4.0/mirr.m | 48 + octave_packages/financial-0.4.0/month.m | 31 + octave_packages/financial-0.4.0/months.m | 58 + octave_packages/financial-0.4.0/movavg.m | 105 + octave_packages/financial-0.4.0/negvolidx.m | 82 + octave_packages/financial-0.4.0/nomrr.m | 34 + octave_packages/financial-0.4.0/nper.m | 75 + octave_packages/financial-0.4.0/npv.m | 69 + octave_packages/financial-0.4.0/nweekdate.m | 152 + octave_packages/financial-0.4.0/onbalvol.m | 59 + .../financial-0.4.0/packinfo/.autoload | 0 .../financial-0.4.0/packinfo/DESCRIPTION | 12 + .../financial-0.4.0/packinfo/INDEX | 61 + octave_packages/financial-0.4.0/packinfo/NEWS | 41 + octave_packages/financial-0.4.0/pmt.m | 66 + octave_packages/financial-0.4.0/pointfig.m | 88 + octave_packages/financial-0.4.0/posvolidx.m | 82 + .../financial-0.4.0/private/fetch_google.m | 102 + .../financial-0.4.0/private/fetch_yahoo.m | 98 + octave_packages/financial-0.4.0/pv.m | 74 + octave_packages/financial-0.4.0/pvl.m | 42 + octave_packages/financial-0.4.0/rate.m | 67 + octave_packages/financial-0.4.0/rsindex.m | 66 + octave_packages/financial-0.4.0/second.m | 30 + octave_packages/financial-0.4.0/taxedrr.m | 38 + .../financial-0.4.0/thirdwednesday.m | 68 + octave_packages/financial-0.4.0/today.m | 32 + octave_packages/financial-0.4.0/vol.m | 70 + octave_packages/financial-0.4.0/x2mdate.m | 75 + octave_packages/financial-0.4.0/yahoo.m | 44 + octave_packages/financial-0.4.0/year.m | 30 + octave_packages/financial-0.4.0/yeardays.m | 111 + octave_packages/fixed-0.7.10/PKG_ADD | 5 + octave_packages/fixed-0.7.10/concat.m | 105 + .../fixed-0.7.10/create_lookup_table.m | 33 + octave_packages/fixed-0.7.10/doc-cache | 244 + octave_packages/fixed-0.7.10/doc.info | 3630 +++++++++++ octave_packages/fixed-0.7.10/fixedpoint.m | 1744 +++++ octave_packages/fixed-0.7.10/float.m | 32 + octave_packages/fixed-0.7.10/fsort.m | 69 + octave_packages/fixed-0.7.10/lookup_table.m | 54 + .../fixed-0.7.10/packinfo/.autoload | 0 .../fixed-0.7.10/packinfo/DESCRIPTION | 11 + octave_packages/fixed-0.7.10/packinfo/INDEX | 62 + .../fpl-1.2.0/FPL2coloredgradient.net | 635 ++ .../fpl-1.2.0/FPL2coloredrubbersheet.net | 619 ++ octave_packages/fpl-1.2.0/FPL2dxappenddata.m | 90 + octave_packages/fpl-1.2.0/FPL2dxoutputdata.m | 126 + .../fpl-1.2.0/FPL2dxoutputtimeseries.m | 71 + octave_packages/fpl-1.2.0/FPL2pdequiver.m | 92 + octave_packages/fpl-1.2.0/FPL2pdequiver.net | 613 ++ octave_packages/fpl-1.2.0/FPL2pdeshowmesh.m | 94 + octave_packages/fpl-1.2.0/FPL2pdeshowmesh.net | 518 ++ octave_packages/fpl-1.2.0/FPL2pdesurf.m | 130 + octave_packages/fpl-1.2.0/FPL2ptcquiver.m | 83 + octave_packages/fpl-1.2.0/FPL2ptcquiver.net | 710 +++ octave_packages/fpl-1.2.0/FPL2ptcshowmesh.m | 80 + octave_packages/fpl-1.2.0/FPL2ptcshowmesh.net | 565 ++ octave_packages/fpl-1.2.0/FPL2ptcsurf.m | 81 + octave_packages/fpl-1.2.0/FPL2ptcsurf.net | 749 +++ octave_packages/fpl-1.2.0/FPL2showmesh.net | 587 ++ octave_packages/fpl-1.2.0/FPL2trspdesurf.m | 83 + octave_packages/fpl-1.2.0/FPL2trspdesurf.net | 702 +++ octave_packages/fpl-1.2.0/FPL2trsptcsurf.m | 90 + octave_packages/fpl-1.2.0/FPL2trsptcsurf.net | 923 +++ octave_packages/fpl-1.2.0/FPL2vtkoutputdata.m | 144 + octave_packages/fpl-1.2.0/FPL3dxoutputfield.m | 76 + octave_packages/fpl-1.2.0/FPL3dxoutputmesh.m | 110 + octave_packages/fpl-1.2.0/doc-cache | 746 +++ .../fpl-1.2.0/fpl_dx_write_field.m | 222 + .../fpl-1.2.0/fpl_dx_write_series.m | 119 + .../fpl-1.2.0/fpl_vtk_write_field.m | 227 + octave_packages/fpl-1.2.0/packinfo/.autoload | 0 .../fpl-1.2.0/packinfo/DESCRIPTION | 13 + octave_packages/fpl-1.2.0/packinfo/INDEX | 25 + octave_packages/fpl-1.2.0/pdemesh.m | 69 + octave_packages/fpl-1.2.0/pdesurf.m | 92 + .../ga-0.10.0/__ga_crossoverfcn__.m | 33 + .../ga-0.10.0/__ga_initial_population__.m | 92 + .../ga-0.10.0/__ga_mutationfcn__.m | 27 + .../ga-0.10.0/__ga_popinitrange__.m | 28 + octave_packages/ga-0.10.0/__ga_problem__.m | 102 + .../ga-0.10.0/__ga_problem_private_state__.m | 49 + .../__ga_problem_return_variables__.m | 38 + .../__ga_problem_state_selection__.m | 32 + ...roblem_update_state_at_each_generation__.m | 48 + octave_packages/ga-0.10.0/__ga_scores__.m | 48 + .../ga-0.10.0/__ga_selectionfcn__.m | 22 + octave_packages/ga-0.10.0/__ga_stop__.m | 39 + .../__gaoptimset_default_options__.m | 53 + .../ga-0.10.0/crossoverscattered.m | 49 + octave_packages/ga-0.10.0/doc-cache | 378 ++ octave_packages/ga-0.10.0/fitscalingrank.m | 55 + octave_packages/ga-0.10.0/ga.m | 372 ++ octave_packages/ga-0.10.0/gacreationuniform.m | 65 + octave_packages/ga-0.10.0/gaoptimset.m | 121 + octave_packages/ga-0.10.0/mutationgaussian.m | 60 + octave_packages/ga-0.10.0/packinfo/.autoload | 0 .../ga-0.10.0/packinfo/DESCRIPTION | 12 + octave_packages/ga-0.10.0/packinfo/INDEX | 25 + octave_packages/ga-0.10.0/packinfo/NEWS | 18 + octave_packages/ga-0.10.0/rastriginsfcn.m | 50 + .../ga-0.10.0/selectionstochunif.m | 46 + octave_packages/ga-0.10.0/test_ga.m | 49 + octave_packages/general-1.3.1/@dict/dict.m | 95 + octave_packages/general-1.3.1/@dict/display.m | 41 + octave_packages/general-1.3.1/@dict/end.m | 22 + octave_packages/general-1.3.1/@dict/get.m | 56 + octave_packages/general-1.3.1/@dict/has.m | 37 + octave_packages/general-1.3.1/@dict/isempty.m | 28 + octave_packages/general-1.3.1/@dict/join.m | 50 + octave_packages/general-1.3.1/@dict/length.m | 28 + octave_packages/general-1.3.1/@dict/struct.m | 32 + .../general-1.3.1/@dict/subsasgn.m | 103 + octave_packages/general-1.3.1/@dict/subsref.m | 73 + .../general-1.3.1/@inputParser/addOptional.m | 63 + .../@inputParser/addParamValue.m | 55 + .../general-1.3.1/@inputParser/addRequired.m | 60 + .../general-1.3.1/@inputParser/addSwitch.m | 48 + .../general-1.3.1/@inputParser/createCopy.m | 38 + .../general-1.3.1/@inputParser/display.m | 58 + .../general-1.3.1/@inputParser/inputParser.m | 224 + .../general-1.3.1/@inputParser/parse.m | 37 + .../general-1.3.1/@inputParser/subsasgn.m | 37 + .../general-1.3.1/@inputParser/subsref.m | 336 + octave_packages/general-1.3.1/adresamp2.m | 90 + octave_packages/general-1.3.1/doc-cache | 359 ++ octave_packages/general-1.3.1/majle.m | 160 + .../general-1.3.1/packinfo/.autoload | 0 .../general-1.3.1/packinfo/DESCRIPTION | 11 + octave_packages/general-1.3.1/packinfo/INDEX | 34 + octave_packages/general-1.3.1/packinfo/NEWS | 39 + octave_packages/general-1.3.1/pararrayfun.m | 73 + octave_packages/general-1.3.1/parcellfun.m | 387 ++ .../general-1.3.1/private/chunk_parcellfun.m | 53 + .../general-1.3.1/private/parcellfun_opts.m | 77 + octave_packages/general-1.3.1/safeprod.m | 62 + octave_packages/general-1.3.1/unresamp2.m | 64 + octave_packages/general-1.3.1/unvech.m | 79 + octave_packages/general-1.3.1/ztvals.m | 44 + .../geometry-1.5.0/geom2d/angle2Points.m | 109 + .../geometry-1.5.0/geom2d/angle3Points.m | 82 + .../geometry-1.5.0/geom2d/angleAbsDiff.m | 66 + .../geometry-1.5.0/geom2d/angleDiff.m | 76 + .../geometry-1.5.0/geom2d/angleSort.m | 106 + .../geometry-1.5.0/geom2d/angles2d.m | 54 + .../geometry-1.5.0/geom2d/beltproblem.m | 136 + .../geometry-1.5.0/geom2d/bisector.m | 126 + .../geometry-1.5.0/geom2d/boxes2d.m | 53 + .../geometry-1.5.0/geom2d/cartesianLine.m | 69 + .../geometry-1.5.0/geom2d/cbezier2poly.m | 154 + .../geometry-1.5.0/geom2d/centroid.m | 129 + .../geometry-1.5.0/geom2d/changelog.txt | 192 + .../geometry-1.5.0/geom2d/circleArcAsCurve.m | 79 + .../geometry-1.5.0/geom2d/circleAsPolygon.m | 74 + .../geometry-1.5.0/geom2d/circles2d.m | 64 + .../geometry-1.5.0/geom2d/clipEdge.m | 203 + .../geometry-1.5.0/geom2d/clipLine.m | 210 + .../geometry-1.5.0/geom2d/clipPoints.m | 101 + .../geometry-1.5.0/geom2d/clipRay.m | 172 + .../geometry-1.5.0/geom2d/closed_path.m | 105 + .../geometry-1.5.0/geom2d/cov2ellipse.m | 71 + .../geometry-1.5.0/geom2d/crackPattern.m | 189 + .../geometry-1.5.0/geom2d/crackPattern2.m | 148 + .../geom2d/createBasisTransform.m | 108 + .../geometry-1.5.0/geom2d/createCircle.m | 129 + .../geom2d/createDirectedCircle.m | 92 + .../geometry-1.5.0/geom2d/createEdge.m | 121 + .../geometry-1.5.0/geom2d/createHomothecy.m | 61 + .../geometry-1.5.0/geom2d/createLine.m | 163 + .../geom2d/createLineReflection.m | 68 + .../geometry-1.5.0/geom2d/createRay.m | 104 + .../geometry-1.5.0/geom2d/createRotation.m | 112 + .../geometry-1.5.0/geom2d/createScaling.m | 106 + .../geometry-1.5.0/geom2d/createTranslation.m | 71 + .../geometry-1.5.0/geom2d/createVector.m | 54 + .../geometry-1.5.0/geom2d/deg2rad.m | 58 + .../geometry-1.5.0/geom2d/distancePointEdge.m | 133 + .../geometry-1.5.0/geom2d/distancePointLine.m | 77 + .../geometry-1.5.0/geom2d/distancePoints.m | 204 + .../geometry-1.5.0/geom2d/doc-cache | 5081 +++++++++++++++ .../geometry-1.5.0/geom2d/drawArrow.m | 142 + .../geometry-1.5.0/geom2d/drawBezierCurve.m | 107 + .../geometry-1.5.0/geom2d/drawBox.m | 81 + .../geometry-1.5.0/geom2d/drawCenteredEdge.m | 152 + .../geometry-1.5.0/geom2d/drawCircle.m | 132 + .../geometry-1.5.0/geom2d/drawCircleArc.m | 123 + .../geometry-1.5.0/geom2d/drawEdge.m | 164 + .../geometry-1.5.0/geom2d/drawEllipse.m | 141 + .../geometry-1.5.0/geom2d/drawEllipseArc.m | 161 + .../geometry-1.5.0/geom2d/drawLabels.m | 108 + .../geometry-1.5.0/geom2d/drawLine.m | 218 + .../geometry-1.5.0/geom2d/drawOrientedBox.m | 113 + .../geometry-1.5.0/geom2d/drawParabola.m | 142 + .../geometry-1.5.0/geom2d/drawPoint.m | 91 + .../geometry-1.5.0/geom2d/drawRay.m | 66 + .../geometry-1.5.0/geom2d/drawRect.m | 104 + .../geometry-1.5.0/geom2d/drawShape.m | 110 + .../geometry-1.5.0/geom2d/edgeAngle.m | 61 + .../geometry-1.5.0/geom2d/edgeLength.m | 60 + .../geometry-1.5.0/geom2d/edgePosition.m | 91 + .../geometry-1.5.0/geom2d/edgeToLine.m | 56 + .../geometry-1.5.0/geom2d/edges2d.m | 56 + .../geometry-1.5.0/geom2d/ellipse2cov.m | 92 + .../geometry-1.5.0/geom2d/ellipseAsPolygon.m | 93 + .../geometry-1.5.0/geom2d/ellipses2d.m | 50 + .../geometry-1.5.0/geom2d/enclosingCircle.m | 98 + .../geom2d/fitAffineTransform2d.m | 73 + .../geometry-1.5.0/geom2d/geom2d_Contents.m | 223 + .../geometry-1.5.0/geom2d/hexagonalGrid.m | 122 + .../geometry-1.5.0/geom2d/inertiaEllipse.m | 96 + .../geometry-1.5.0/geom2d/intersectBoxes.m | 76 + .../geometry-1.5.0/geom2d/intersectCircles.m | 129 + .../geometry-1.5.0/geom2d/intersectEdges.m | 175 + .../geom2d/intersectLineCircle.m | 106 + .../geometry-1.5.0/geom2d/intersectLineEdge.m | 106 + .../geometry-1.5.0/geom2d/intersectLines.m | 178 + .../geom2d/isCounterClockwise.m | 156 + .../geometry-1.5.0/geom2d/isLeftOriented.m | 59 + .../geometry-1.5.0/geom2d/isParallel.m | 97 + .../geometry-1.5.0/geom2d/isPerpendicular.m | 95 + .../geometry-1.5.0/geom2d/isPointInCircle.m | 67 + .../geometry-1.5.0/geom2d/isPointInEllipse.m | 81 + .../geometry-1.5.0/geom2d/isPointOnCircle.m | 65 + .../geometry-1.5.0/geom2d/isPointOnEdge.m | 294 + .../geometry-1.5.0/geom2d/isPointOnLine.m | 72 + .../geometry-1.5.0/geom2d/isPointOnRay.m | 94 + .../geometry-1.5.0/geom2d/lineAngle.m | 105 + .../geometry-1.5.0/geom2d/linePosition.m | 139 + .../geometry-1.5.0/geom2d/lines2d.m | 66 + .../geometry-1.5.0/geom2d/medianLine.m | 146 + .../geometry-1.5.0/geom2d/mergeBoxes.m | 77 + .../geometry-1.5.0/geom2d/midPoint.m | 170 + .../geometry-1.5.0/geom2d/minDistancePoints.m | 280 + .../geometry-1.5.0/geom2d/normalizeAngle.m | 96 + .../geometry-1.5.0/geom2d/normalizeVector.m | 72 + .../geometry-1.5.0/geom2d/orthogonalLine.m | 64 + .../geometry-1.5.0/geom2d/parallelLine.m | 63 + .../geometry-1.5.0/geom2d/pointOnLine.m | 53 + .../geometry-1.5.0/geom2d/points2d.m | 60 + .../geometry-1.5.0/geom2d/polarPoint.m | 83 + .../geom2d/private/assertAlmostEqual.m | 26 + .../private/assertElementsAlmostEqual.m | 26 + .../geom2d/private/assertEqual.m | 26 + .../geom2d/private/assertFalse.m | 26 + .../geom2d/private/assertTrue.m | 26 + .../geometry-1.5.0/geom2d/projPointOnLine.m | 69 + .../geometry-1.5.0/geom2d/rad2deg.m | 58 + .../geometry-1.5.0/geom2d/radicalAxis.m | 88 + .../geometry-1.5.0/geom2d/randomPointInBox.m | 85 + .../geometry-1.5.0/geom2d/rays2d.m | 60 + .../geometry-1.5.0/geom2d/readme.txt | 68 + .../geometry-1.5.0/geom2d/reverseEdge.m | 50 + .../geometry-1.5.0/geom2d/reverseLine.m | 52 + .../geometry-1.5.0/geom2d/rotateVector.m | 64 + .../geometry-1.5.0/geom2d/squareGrid.m | 82 + .../geometry-1.5.0/geom2d/transformEdge.m | 71 + .../geometry-1.5.0/geom2d/transformLine.m | 66 + .../geometry-1.5.0/geom2d/transformPoint.m | 92 + .../geometry-1.5.0/geom2d/transformVector.m | 108 + .../geometry-1.5.0/geom2d/transforms2d.m | 63 + .../geometry-1.5.0/geom2d/triangleGrid.m | 69 + .../geometry-1.5.0/geom2d/vectorAngle.m | 221 + .../geometry-1.5.0/geom2d/vectorNorm.m | 114 + .../geometry-1.5.0/geom2d/vectors2d.m | 54 + .../geometry-1.5.0/graphs/delaunayGraph.m | 93 + .../geometry-1.5.0/graphs/doc-cache | 190 + .../geometry-1.5.0/graphs/drawGraph.m | 290 + .../geometry-1.5.0/graphs/knnGraph.m | 73 + .../geometry-1.5.0/graphs/voronoi2d.m | 69 + .../geometry-1.5.0/io/@svg/display.m | 25 + .../geometry-1.5.0/io/@svg/getpath.m | 76 + .../geometry-1.5.0/io/@svg/height.m | 22 + .../geometry-1.5.0/io/@svg/inkex.py | 235 + .../geometry-1.5.0/io/@svg/loadpaths.m | 97 + .../geometry-1.5.0/io/@svg/loadsvgdata.m | 36 + .../geometry-1.5.0/io/@svg/normalize.m | 95 + .../geometry-1.5.0/io/@svg/parsePath.py | 79 + .../geometry-1.5.0/io/@svg/parseSVGData.py | 34 + .../geometry-1.5.0/io/@svg/path2polygon.m | 71 + .../geometry-1.5.0/io/@svg/pathid.m | 22 + octave_packages/geometry-1.5.0/io/@svg/plot.m | 53 + .../geometry-1.5.0/io/@svg/simplepath.py | 212 + .../geometry-1.5.0/io/@svg/subsref.m | 84 + octave_packages/geometry-1.5.0/io/@svg/svg.m | 82 + .../geometry-1.5.0/io/@svg/width.m | 22 + octave_packages/geometry-1.5.0/io/data2geo.m | 113 + .../geometry-1.5.0/io/deprecated/doc-cache | 111 + .../deprecated/private/SVGstrPath2SVGpath.m | 103 + .../io/deprecated/private/_parsePath.py | 64 + .../io/deprecated/private/formatSVGstr.m | 24 + .../io/deprecated/private/getSVGPaths_py.m | 113 + .../io/deprecated/private/getSVGdata.m | 33 + .../io/deprecated/private/getSVGstrPath.m | 20 + .../geometry-1.5.0/io/deprecated/svgload.m | 62 + .../io/deprecated/svgnormalize.m | 68 + .../io/deprecated/svgpath2polygon.m | 60 + octave_packages/geometry-1.5.0/io/doc-cache | 44 + octave_packages/geometry-1.5.0/io/drawing.svg | 43 + .../geometry-1.5.0/io/drawing2.svg | 43 + .../geometry-1.5.0/io/drawing3.svg | 35 + .../geometry-1.5.0/io/drawing4.svg | 65 + .../geometry-1.5.0/io/drawing5.svg | 64 + .../geometry-1.5.0/io/drawing6.svg | 36 + .../geometry-1.5.0/io/private/inkex.py | 235 + .../geometry-1.5.0/io/private/lineGeo.m | 29 + .../geometry-1.5.0/io/private/lineLoopGeo.m | 32 + .../geometry-1.5.0/io/private/planeSurfGeo.m | 36 + .../geometry-1.5.0/io/private/pointGeo.m | 32 + .../geometry-1.5.0/io/private/ruledSurfGeo.m | 39 + .../geometry-1.5.0/io/private/simplepath.py | 212 + .../geometry-1.5.0/octclip/doc-cache | 72 + .../geometry-1.5.0/octclip/oc_polybool.m | 264 + .../geometry-1.5.0/packinfo/.autoload | 0 .../geometry-1.5.0/packinfo/DESCRIPTION | 11 + octave_packages/geometry-1.5.0/packinfo/INDEX | 177 + octave_packages/geometry-1.5.0/packinfo/NEWS | 262 + .../geometry-1.5.0/polygons2d/curvature.m | 177 + .../polygons2d/distancePointPolygon.m | 51 + .../polygons2d/distancePointPolyline.m | 71 + .../polygons2d/distancePolygons.m | 43 + .../geometry-1.5.0/polygons2d/doc-cache | 883 +++ .../geometry-1.5.0/polygons2d/drawPolygon.m | 144 + .../geometry-1.5.0/polygons2d/expandPolygon.m | 85 + .../polygons2d/medialAxisConvex.m | 153 + .../geometry-1.5.0/polygons2d/parametrize.m | 96 + .../geometry-1.5.0/polygons2d/polygon2shape.m | 54 + .../geometry-1.5.0/polygons2d/polygonLoops.m | 143 + .../polygons2d/polygonSelfIntersections.m | 87 + .../geometry-1.5.0/polygons2d/polygons2d.m | 180 + .../polygons2d/polylineSelfIntersections.m | 153 + .../polygons2d/reversePolygon.m | 44 + .../polygons2d/reversePolyline.m | 43 + .../polygons2d/simplifypolygon.m | 60 + .../polygons2d/simplifypolyline.m | 156 + .../geometry-1.5.0/polygons2d/splitPolygons.m | 64 + .../polygons2d/supportFunction.m | 72 + .../geometry-1.5.0/shape2d/curve2polyline.m | 141 + .../geometry-1.5.0/shape2d/curveval.m | 30 + .../geometry-1.5.0/shape2d/doc-cache | 266 + .../geometry-1.5.0/shape2d/shape2polygon.m | 65 + .../geometry-1.5.0/shape2d/shapearea.m | 77 + .../geometry-1.5.0/shape2d/shapecentroid.m | 149 + .../geometry-1.5.0/shape2d/shapeplot.m | 37 + .../geometry-1.5.0/shape2d/shapetransform.m | 109 + octave_packages/gsl-1.0.8/doc-cache | 55 + octave_packages/gsl-1.0.8/packinfo/.autoload | 0 .../gsl-1.0.8/packinfo/DESCRIPTION | 13 + octave_packages/gsl-1.0.8/packinfo/INDEX | 119 + octave_packages/gsl-1.0.8/test_ellint.m | 136 + octave_packages/gsl-1.0.8/test_hyperg.m | 152 + octave_packages/gsl-1.0.8/test_hyperg_corr.c | 512 ++ octave_packages/gsl-1.0.8/test_sf.c | 2719 ++++++++ octave_packages/image-1.0.15/applylut.m | 62 + octave_packages/image-1.0.15/bestblk.m | 118 + octave_packages/image-1.0.15/blkproc.m | 204 + octave_packages/image-1.0.15/bmpwrite.m | 99 + octave_packages/image-1.0.15/bwarea.m | 56 + octave_packages/image-1.0.15/bwborder.m | 37 + octave_packages/image-1.0.15/bwboundaries.m | 95 + octave_packages/image-1.0.15/bwconncomp.m | 67 + octave_packages/image-1.0.15/bwdist.m | 61 + octave_packages/image-1.0.15/bweuler.m | 107 + octave_packages/image-1.0.15/bwhitmiss.m | 64 + octave_packages/image-1.0.15/bwmorph.m | 624 ++ octave_packages/image-1.0.15/bwperim.m | 70 + octave_packages/image-1.0.15/bwselect.m | 55 + octave_packages/image-1.0.15/cmpermute.m | 132 + octave_packages/image-1.0.15/cmunique.m | 211 + octave_packages/image-1.0.15/col2im.m | 180 + octave_packages/image-1.0.15/colfilt.m | 116 + octave_packages/image-1.0.15/colorgradient.m | 56 + octave_packages/image-1.0.15/conndef.m | 114 + octave_packages/image-1.0.15/corr2.m | 44 + octave_packages/image-1.0.15/dilate.m | 90 + octave_packages/image-1.0.15/doc-cache | 4747 ++++++++++++++ octave_packages/image-1.0.15/edge.m | 545 ++ octave_packages/image-1.0.15/entropy.m | 67 + octave_packages/image-1.0.15/entropyfilt.m | 100 + octave_packages/image-1.0.15/erode.m | 88 + octave_packages/image-1.0.15/fchcode.m | 88 + octave_packages/image-1.0.15/fftconv2.m | 134 + octave_packages/image-1.0.15/fspecial.m | 252 + octave_packages/image-1.0.15/grayslice.m | 77 + octave_packages/image-1.0.15/graythresh.m | 84 + octave_packages/image-1.0.15/histeq.m | 47 + octave_packages/image-1.0.15/hough_circle.m | 94 + octave_packages/image-1.0.15/houghtf.m | 102 + octave_packages/image-1.0.15/im2bw.m | 72 + octave_packages/image-1.0.15/im2col.m | 245 + octave_packages/image-1.0.15/im2double.m | 47 + octave_packages/image-1.0.15/im2uint16.m | 47 + octave_packages/image-1.0.15/im2uint8.m | 47 + octave_packages/image-1.0.15/imadjust.m | 361 ++ octave_packages/image-1.0.15/imclose.m | 41 + octave_packages/image-1.0.15/imcomplement.m | 45 + octave_packages/image-1.0.15/imdilate.m | 51 + octave_packages/image-1.0.15/imdither.m | 103 + octave_packages/image-1.0.15/imerode.m | 48 + octave_packages/image-1.0.15/imfilter.m | 129 + octave_packages/image-1.0.15/imginfo.m | 60 + octave_packages/image-1.0.15/imhist.m | 71 + octave_packages/image-1.0.15/immaximas.m | 108 + octave_packages/image-1.0.15/imnoise.m | 72 + octave_packages/image-1.0.15/imopen.m | 41 + octave_packages/image-1.0.15/impad.m | 142 + .../image-1.0.15/imperspectivewarp.m | 168 + octave_packages/image-1.0.15/imremap.m | 229 + octave_packages/image-1.0.15/imresize.m | 67 + octave_packages/image-1.0.15/imrotate.m | 235 + .../image-1.0.15/imrotate_Fourier.m | 186 + octave_packages/image-1.0.15/imshear.m | 129 + octave_packages/image-1.0.15/imsmooth.m | 500 ++ octave_packages/image-1.0.15/imtophat.m | 81 + octave_packages/image-1.0.15/imtranslate.m | 73 + octave_packages/image-1.0.15/iradon.m | 169 + octave_packages/image-1.0.15/isbw.m | 38 + octave_packages/image-1.0.15/isgray.m | 45 + octave_packages/image-1.0.15/isind.m | 42 + octave_packages/image-1.0.15/isrgb.m | 80 + octave_packages/image-1.0.15/label2rgb.m | 137 + octave_packages/image-1.0.15/makelut.m | 72 + octave_packages/image-1.0.15/mat2gray.m | 48 + octave_packages/image-1.0.15/mean2.m | 38 + octave_packages/image-1.0.15/medfilt2.m | 67 + octave_packages/image-1.0.15/mmgradm.m | 50 + octave_packages/image-1.0.15/nlfilter.m | 178 + octave_packages/image-1.0.15/ordfilt2.m | 68 + octave_packages/image-1.0.15/ordfiltn.m | 99 + .../image-1.0.15/packinfo/.autoload | 0 .../image-1.0.15/packinfo/DESCRIPTION | 15 + octave_packages/image-1.0.15/packinfo/INDEX | 113 + octave_packages/image-1.0.15/padarray.m | 374 ++ octave_packages/image-1.0.15/phantom.m | 215 + octave_packages/image-1.0.15/poly2mask.m | 259 + octave_packages/image-1.0.15/qtdecomp.m | 341 + octave_packages/image-1.0.15/qtgetblk.m | 162 + octave_packages/image-1.0.15/qtsetblk.m | 113 + octave_packages/image-1.0.15/radon.m | 88 + octave_packages/image-1.0.15/rangefilt.m | 71 + octave_packages/image-1.0.15/readexif.m | 529 ++ octave_packages/image-1.0.15/regionprops.m | 289 + octave_packages/image-1.0.15/rgb2gray.m | 55 + octave_packages/image-1.0.15/rgb2ycbcr.m | 39 + octave_packages/image-1.0.15/rgbplot.m | 34 + octave_packages/image-1.0.15/rho_filter.m | 183 + octave_packages/image-1.0.15/roicolor.m | 79 + octave_packages/image-1.0.15/std2.m | 37 + octave_packages/image-1.0.15/stdfilt.m | 74 + octave_packages/image-1.0.15/stretchlim.m | 208 + octave_packages/image-1.0.15/tiff_tag_read.m | 196 + octave_packages/image-1.0.15/uintlut.m | 62 + octave_packages/io-1.0.19/append_save.m | 165 + octave_packages/io-1.0.19/calccelladdress.m | 88 + .../io-1.0.19/chk_spreadsheet_support.m | 569 ++ octave_packages/io-1.0.19/doc-cache | 1809 ++++++ octave_packages/io-1.0.19/fexist.m | 83 + octave_packages/io-1.0.19/getusedrange.m | 659 ++ octave_packages/io-1.0.19/io_ods_testscript.m | 121 + octave_packages/io-1.0.19/io_xls_testscript.m | 124 + octave_packages/io-1.0.19/object2json.m | 189 + octave_packages/io-1.0.19/oct2ods.m | 1168 ++++ octave_packages/io-1.0.19/oct2xls.m | 1077 ++++ octave_packages/io-1.0.19/ods2oct.m | 899 +++ octave_packages/io-1.0.19/odsclose.m | 186 + octave_packages/io-1.0.19/odsfinfo.m | 188 + octave_packages/io-1.0.19/odsopen.m | 551 ++ octave_packages/io-1.0.19/odsread.m | 149 + octave_packages/io-1.0.19/odswrite.m | 123 + octave_packages/io-1.0.19/packinfo/.autoload | 0 .../io-1.0.19/packinfo/DESCRIPTION | 15 + octave_packages/io-1.0.19/packinfo/INDEX | 44 + octave_packages/io-1.0.19/packinfo/NEWS | 128 + octave_packages/io-1.0.19/parse_sp_range.m | 117 + octave_packages/io-1.0.19/parsecell.m | 171 + octave_packages/io-1.0.19/pch2mat.m | 93 + octave_packages/io-1.0.19/spsh_chkrange.m | 103 + octave_packages/io-1.0.19/spsh_prstype.m | 88 + octave_packages/io-1.0.19/xls2oct.m | 995 +++ octave_packages/io-1.0.19/xlsclose.m | 278 + octave_packages/io-1.0.19/xlsfinfo.m | 231 + octave_packages/io-1.0.19/xlsopen.m | 647 ++ octave_packages/io-1.0.19/xlsread.m | 222 + octave_packages/io-1.0.19/xlswrite.m | 178 + octave_packages/io-1.0.19/xmlwrite.m | 201 + octave_packages/java-1.2.8/__java__.h | 272 + octave_packages/java-1.2.8/dlgtest.m | 255 + octave_packages/java-1.2.8/doc-cache | 624 ++ octave_packages/java-1.2.8/doc.info | 1255 ++++ octave_packages/java-1.2.8/errordlg.m | 37 + octave_packages/java-1.2.8/helpdlg.m | 38 + octave_packages/java-1.2.8/inputdlg.m | 106 + octave_packages/java-1.2.8/java.m | 19 + octave_packages/java-1.2.8/javaArray.m | 48 + octave_packages/java-1.2.8/javaaddpath.m | 44 + octave_packages/java-1.2.8/javaclasspath.m | 106 + octave_packages/java-1.2.8/javafields.m | 44 + octave_packages/java-1.2.8/javamem.m | 84 + octave_packages/java-1.2.8/javamethods.m | 44 + octave_packages/java-1.2.8/javarmpath.m | 45 + octave_packages/java-1.2.8/listdlg.m | 126 + octave_packages/java-1.2.8/msgbox.m | 54 + octave_packages/java-1.2.8/octave.jar | Bin 0 -> 30933 bytes octave_packages/java-1.2.8/packinfo/.autoload | 0 .../java-1.2.8/packinfo/DESCRIPTION | 12 + octave_packages/java-1.2.8/packinfo/INDEX | 30 + octave_packages/java-1.2.8/questdlg.m | 81 + octave_packages/java-1.2.8/warndlg.m | 36 + .../linear-algebra-2.2.0/@blksparse/blksize.m | 25 + .../@blksparse/blksparse.m | 114 + .../@blksparse/ctranspose.m | 28 + .../linear-algebra-2.2.0/@blksparse/display.m | 39 + .../linear-algebra-2.2.0/@blksparse/full.m | 27 + .../@blksparse/ismatrix.m | 20 + .../linear-algebra-2.2.0/@blksparse/isreal.m | 21 + .../@blksparse/issparse.m | 20 + .../linear-algebra-2.2.0/@blksparse/minus.m | 40 + .../@blksparse/mldivide.m | 115 + .../@blksparse/mrdivide.m | 112 + .../linear-algebra-2.2.0/@blksparse/mtimes.m | 121 + .../linear-algebra-2.2.0/@blksparse/plus.m | 40 + .../linear-algebra-2.2.0/@blksparse/size.m | 24 + .../linear-algebra-2.2.0/@blksparse/sparse.m | 32 + .../linear-algebra-2.2.0/@blksparse/subsref.m | 60 + .../@blksparse/transpose.m | 29 + .../linear-algebra-2.2.0/@blksparse/uminus.m | 25 + .../linear-algebra-2.2.0/@blksparse/uplus.m | 26 + .../linear-algebra-2.2.0/@kronprod/columns.m | 32 + .../@kronprod/ctranspose.m | 37 + .../linear-algebra-2.2.0/@kronprod/det.m | 56 + .../linear-algebra-2.2.0/@kronprod/disp.m | 28 + .../linear-algebra-2.2.0/@kronprod/display.m | 48 + .../linear-algebra-2.2.0/@kronprod/full.m | 41 + .../linear-algebra-2.2.0/@kronprod/inv.m | 52 + .../@kronprod/iscomplex.m | 32 + .../linear-algebra-2.2.0/@kronprod/ismatrix.m | 24 + .../linear-algebra-2.2.0/@kronprod/isreal.m | 33 + .../linear-algebra-2.2.0/@kronprod/issparse.m | 34 + .../linear-algebra-2.2.0/@kronprod/issquare.m | 33 + .../linear-algebra-2.2.0/@kronprod/kronprod.m | 47 + .../linear-algebra-2.2.0/@kronprod/minus.m | 52 + .../linear-algebra-2.2.0/@kronprod/mldivide.m | 59 + .../linear-algebra-2.2.0/@kronprod/mpower.m | 44 + .../linear-algebra-2.2.0/@kronprod/mtimes.m | 92 + .../@kronprod/not_done/eig.m | 71 + .../@kronprod/not_done/svd.m | 54 + .../linear-algebra-2.2.0/@kronprod/numel.m | 32 + .../linear-algebra-2.2.0/@kronprod/plus.m | 56 + .../linear-algebra-2.2.0/@kronprod/rank.m | 33 + .../linear-algebra-2.2.0/@kronprod/rdivide.m | 53 + .../linear-algebra-2.2.0/@kronprod/rows.m | 32 + .../linear-algebra-2.2.0/@kronprod/size.m | 39 + .../@kronprod/size_equal.m | 23 + .../linear-algebra-2.2.0/@kronprod/sparse.m | 33 + .../linear-algebra-2.2.0/@kronprod/times.m | 67 + .../linear-algebra-2.2.0/@kronprod/trace.m | 41 + .../@kronprod/transpose.m | 37 + .../linear-algebra-2.2.0/@kronprod/uminus.m | 38 + .../linear-algebra-2.2.0/@kronprod/uplus.m | 25 + .../linear-algebra-2.2.0/cartprod.m | 59 + .../linear-algebra-2.2.0/circulant_eig.m | 66 + .../linear-algebra-2.2.0/circulant_inv.m | 44 + .../circulant_make_matrix.m | 41 + .../circulant_matrix_vector_product.m | 42 + octave_packages/linear-algebra-2.2.0/cod.m | 96 + .../linear-algebra-2.2.0/condeig.m | 122 + .../linear-algebra-2.2.0/doc-cache | 972 +++ octave_packages/linear-algebra-2.2.0/funm.m | 86 + octave_packages/linear-algebra-2.2.0/lobpcg.m | 1070 ++++ .../linear-algebra-2.2.0/ndcovlt.m | 99 + .../linear-algebra-2.2.0/nmf_bpas.m | 711 +++ octave_packages/linear-algebra-2.2.0/nmf_pg.m | 297 + .../linear-algebra-2.2.0/packinfo/.autoload | 0 .../linear-algebra-2.2.0/packinfo/DESCRIPTION | 12 + .../linear-algebra-2.2.0/packinfo/INDEX | 79 + .../linear-algebra-2.2.0/packinfo/NEWS | 33 + .../linear-algebra-2.2.0/rotparams.m | 73 + octave_packages/linear-algebra-2.2.0/rotv.m | 82 + .../linear-algebra-2.2.0/smwsolve.m | 78 + octave_packages/linear-algebra-2.2.0/thfm.m | 98 + octave_packages/mapping-1.0.7/azimuth.m | 94 + octave_packages/mapping-1.0.7/deg2rad.m | 24 + octave_packages/mapping-1.0.7/distance.m | 44 + octave_packages/mapping-1.0.7/doc-cache | 198 + octave_packages/mapping-1.0.7/km2deg.m | 31 + .../mapping-1.0.7/packinfo/.autoload | 0 .../mapping-1.0.7/packinfo/DESCRIPTION | 12 + octave_packages/mapping-1.0.7/packinfo/INDEX | 8 + octave_packages/mapping-1.0.7/rad2deg.m | 24 + octave_packages/mapping-1.0.7/reckon.m | 121 + octave_packages/miscellaneous-1.1.0/apply.m | 102 + octave_packages/miscellaneous-1.1.0/asci.m | 88 + .../miscellaneous-1.1.0/chebyshevpoly.m | 66 + octave_packages/miscellaneous-1.1.0/clip.m | 66 + .../miscellaneous-1.1.0/colorboard.m | 174 + .../miscellaneous-1.1.0/csv2latex.m | 161 + octave_packages/miscellaneous-1.1.0/doc-cache | 1258 ++++ .../miscellaneous-1.1.0/gameoflife.m | 59 + .../miscellaneous-1.1.0/hermitepoly.m | 116 + .../miscellaneous-1.1.0/hilbert_curve.m | 88 + .../miscellaneous-1.1.0/infoskeleton.m | 129 + .../miscellaneous-1.1.0/laguerrepoly.m | 63 + octave_packages/miscellaneous-1.1.0/lauchli.m | 32 + .../miscellaneous-1.1.0/legendrepoly.m | 62 + octave_packages/miscellaneous-1.1.0/map.m | 96 + octave_packages/miscellaneous-1.1.0/match.m | 75 + octave_packages/miscellaneous-1.1.0/normc.m | 61 + octave_packages/miscellaneous-1.1.0/normr.m | 60 + octave_packages/miscellaneous-1.1.0/nze.m | 31 + .../miscellaneous-1.1.0/packinfo/DESCRIPTION | 14 + .../miscellaneous-1.1.0/packinfo/INDEX | 35 + .../miscellaneous-1.1.0/packinfo/NEWS | 46 + .../miscellaneous-1.1.0/peano_curve.m | 99 + octave_packages/miscellaneous-1.1.0/publish.m | 335 + .../miscellaneous-1.1.0/read_options.m | 199 + octave_packages/miscellaneous-1.1.0/reduce.m | 72 + .../miscellaneous-1.1.0/rolldices.m | 81 + .../miscellaneous-1.1.0/slurp_file.m | 54 + .../miscellaneous-1.1.0/solvesudoku.m | 192 + .../miscellaneous-1.1.0/temp_name.m | 71 + octave_packages/miscellaneous-1.1.0/units.m | 61 + octave_packages/miscellaneous-1.1.0/z_curve.m | 90 + octave_packages/miscellaneous-1.1.0/zagzig.m | 87 + octave_packages/miscellaneous-1.1.0/zigzag.m | 84 + .../__functionstatus__.m | 45 + .../__matlabfunctionlist__.m | 92 + .../__missingmatlab2txt__.m | 96 + .../missing-functions-1.0.2/doc-cache | 68 + .../missingfunctionstatus.m | 88 + .../missingmatlabfunctions.m | 57 + .../packinfo/.autoload | 0 .../packinfo/DESCRIPTION | 12 + .../missing-functions-1.0.2/packinfo/INDEX | 7 + octave_packages/nan-2.5.5/bland_altman.m | 121 + octave_packages/nan-2.5.5/cat2bin.m | 90 + octave_packages/nan-2.5.5/cdfplot.m | 57 + octave_packages/nan-2.5.5/center.m | 62 + octave_packages/nan-2.5.5/classify.m | 77 + .../nan-2.5.5/coefficient_of_variation.m | 44 + octave_packages/nan-2.5.5/cor.m | 101 + octave_packages/nan-2.5.5/corrcoef.m | 386 ++ octave_packages/nan-2.5.5/cov.m | 95 + octave_packages/nan-2.5.5/covm.m | 248 + octave_packages/nan-2.5.5/cumsumskipnan.m | 49 + octave_packages/nan-2.5.5/decovm.m | 78 + octave_packages/nan-2.5.5/detrend.m | 157 + octave_packages/nan-2.5.5/doc-cache | 3690 +++++++++++ octave_packages/nan-2.5.5/ecdf.m | 80 + .../nan-2.5.5/flag_accuracy_level.m | 76 + .../nan-2.5.5/flag_implicit_significance.m | 67 + .../nan-2.5.5/flag_implicit_skip_nan.m | 65 + octave_packages/nan-2.5.5/flag_nans_occured.m | 41 + octave_packages/nan-2.5.5/fss.m | 144 + octave_packages/nan-2.5.5/geomean.m | 53 + octave_packages/nan-2.5.5/gscatter.m | 98 + octave_packages/nan-2.5.5/harmmean.m | 56 + octave_packages/nan-2.5.5/hist2res.m | 147 + octave_packages/nan-2.5.5/iqr.m | 52 + octave_packages/nan-2.5.5/kappa.m | 190 + octave_packages/nan-2.5.5/kurtosis.m | 66 + octave_packages/nan-2.5.5/load_fisheriris.m | 44 + octave_packages/nan-2.5.5/mad.m | 64 + octave_packages/nan-2.5.5/mahal.m | 48 + octave_packages/nan-2.5.5/mean.m | 125 + octave_packages/nan-2.5.5/meandev.m | 62 + octave_packages/nan-2.5.5/meansq.m | 53 + octave_packages/nan-2.5.5/medAbsDev.m | 44 + octave_packages/nan-2.5.5/median.m | 94 + octave_packages/nan-2.5.5/moment.m | 106 + octave_packages/nan-2.5.5/nanconv.m | 59 + octave_packages/nan-2.5.5/nanfft.m | 58 + octave_packages/nan-2.5.5/nanfilter.m | 62 + octave_packages/nan-2.5.5/nanfilter1uc.m | 54 + octave_packages/nan-2.5.5/naninsttest.m | 173 + octave_packages/nan-2.5.5/nanmean.m | 41 + octave_packages/nan-2.5.5/nanstd.m | 71 + octave_packages/nan-2.5.5/nansum.m | 43 + octave_packages/nan-2.5.5/nantest.m | 290 + octave_packages/nan-2.5.5/normcdf.m | 60 + octave_packages/nan-2.5.5/norminv.m | 60 + octave_packages/nan-2.5.5/normpdf.m | 54 + .../nan-2.5.5/packinfo/DESCRIPTION | 11 + octave_packages/nan-2.5.5/packinfo/INDEX | 13 + octave_packages/nan-2.5.5/partcorrcoef.m | 166 + octave_packages/nan-2.5.5/percentile.m | 47 + octave_packages/nan-2.5.5/prctile.m | 48 + octave_packages/nan-2.5.5/quantile.m | 151 + octave_packages/nan-2.5.5/range.m | 66 + octave_packages/nan-2.5.5/rankcorr.m | 45 + octave_packages/nan-2.5.5/ranks.m | 169 + octave_packages/nan-2.5.5/rms.m | 57 + octave_packages/nan-2.5.5/row_col_deletion.m | 113 + octave_packages/nan-2.5.5/sem.m | 58 + octave_packages/nan-2.5.5/skewness.m | 68 + octave_packages/nan-2.5.5/spearman.m | 45 + octave_packages/nan-2.5.5/statistic.m | 173 + octave_packages/nan-2.5.5/std.m | 124 + octave_packages/nan-2.5.5/sumskipnan.m | 193 + octave_packages/nan-2.5.5/sumsq.m | 50 + octave_packages/nan-2.5.5/tcdf.m | 61 + octave_packages/nan-2.5.5/test_sc.m | 296 + octave_packages/nan-2.5.5/tiedrank.m | 50 + octave_packages/nan-2.5.5/tinv.m | 54 + octave_packages/nan-2.5.5/tpdf.m | 49 + octave_packages/nan-2.5.5/train_lda_sparse.m | 145 + octave_packages/nan-2.5.5/train_sc.m | 942 +++ octave_packages/nan-2.5.5/trimean.m | 79 + octave_packages/nan-2.5.5/trimmean.m | 74 + octave_packages/nan-2.5.5/ttest.m | 125 + octave_packages/nan-2.5.5/ttest2.m | 137 + octave_packages/nan-2.5.5/var.m | 102 + octave_packages/nan-2.5.5/xcovf.m | 118 + octave_packages/nan-2.5.5/xptopen.m | 41 + octave_packages/nan-2.5.5/xval.m | 187 + octave_packages/nan-2.5.5/zScoreMedian.m | 46 + octave_packages/nan-2.5.5/zscore.m | 64 + octave_packages/nnet-0.1.13/__analyzerows.m | 117 + octave_packages/nnet-0.1.13/__calcjacobian.m | 283 + octave_packages/nnet-0.1.13/__calcperf.m | 110 + .../nnet-0.1.13/__checknetstruct.m | 49 + octave_packages/nnet-0.1.13/__copycoltopos1.m | 45 + octave_packages/nnet-0.1.13/__dlogsig.m | 32 + octave_packages/nnet-0.1.13/__dpurelin.m | 35 + octave_packages/nnet-0.1.13/__dradbas.m | 44 + octave_packages/nnet-0.1.13/__dtansig.m | 38 + octave_packages/nnet-0.1.13/__getx.m | 54 + octave_packages/nnet-0.1.13/__init.m | 84 + octave_packages/nnet-0.1.13/__mae.m | 54 + octave_packages/nnet-0.1.13/__mse.m | 53 + octave_packages/nnet-0.1.13/__newnetwork.m | 195 + .../nnet-0.1.13/__optimizedatasets.m | 89 + octave_packages/nnet-0.1.13/__printAdaptFcn.m | 35 + .../nnet-0.1.13/__printAdaptParam.m | 36 + octave_packages/nnet-0.1.13/__printB.m | 48 + .../nnet-0.1.13/__printBiasConnect.m | 60 + octave_packages/nnet-0.1.13/__printBiases.m | 40 + octave_packages/nnet-0.1.13/__printIW.m | 48 + octave_packages/nnet-0.1.13/__printInitFcn.m | 37 + .../nnet-0.1.13/__printInitParam.m | 36 + .../nnet-0.1.13/__printInputConnect.m | 59 + .../nnet-0.1.13/__printInputWeights.m | 42 + octave_packages/nnet-0.1.13/__printInputs.m | 51 + octave_packages/nnet-0.1.13/__printLW.m | 48 + .../nnet-0.1.13/__printLayerConnect.m | 79 + .../nnet-0.1.13/__printLayerWeights.m | 42 + octave_packages/nnet-0.1.13/__printLayers.m | 40 + .../nnet-0.1.13/__printMLPHeader.m | 43 + .../nnet-0.1.13/__printNetworkType.m | 36 + .../nnet-0.1.13/__printNumInputDelays.m | 42 + .../nnet-0.1.13/__printNumInputs.m | 44 + .../nnet-0.1.13/__printNumLayerDelays.m | 43 + .../nnet-0.1.13/__printNumLayers.m | 39 + .../nnet-0.1.13/__printNumOutputs.m | 43 + .../nnet-0.1.13/__printNumTargets.m | 43 + .../nnet-0.1.13/__printOutputConnect.m | 81 + octave_packages/nnet-0.1.13/__printOutputs.m | 45 + .../nnet-0.1.13/__printPerformFcn.m | 36 + .../nnet-0.1.13/__printPerformParam.m | 36 + .../nnet-0.1.13/__printTargetConnect.m | 84 + octave_packages/nnet-0.1.13/__printTargets.m | 40 + octave_packages/nnet-0.1.13/__printTrainFcn.m | 37 + .../nnet-0.1.13/__printTrainParam.m | 61 + octave_packages/nnet-0.1.13/__randomisecols.m | 44 + .../nnet-0.1.13/__rerangecolumns.m | 168 + octave_packages/nnet-0.1.13/__setx.m | 61 + octave_packages/nnet-0.1.13/__trainlm.m | 361 ++ octave_packages/nnet-0.1.13/dhardlim.m | 31 + octave_packages/nnet-0.1.13/dividerand.m | 74 + octave_packages/nnet-0.1.13/doc-cache | 905 +++ octave_packages/nnet-0.1.13/dposlin.m | 35 + octave_packages/nnet-0.1.13/dsatlin.m | 41 + octave_packages/nnet-0.1.13/dsatlins.m | 41 + octave_packages/nnet-0.1.13/hardlim.m | 34 + octave_packages/nnet-0.1.13/hardlims.m | 38 + octave_packages/nnet-0.1.13/ind2vec.m | 43 + octave_packages/nnet-0.1.13/isposint.m | 61 + octave_packages/nnet-0.1.13/logsig.m | 41 + octave_packages/nnet-0.1.13/mapstd.m | 329 + octave_packages/nnet-0.1.13/min_max.m | 62 + octave_packages/nnet-0.1.13/newff.m | 279 + octave_packages/nnet-0.1.13/newp.m | 145 + .../nnet-0.1.13/packinfo/.autoload | 0 .../nnet-0.1.13/packinfo/DESCRIPTION | 12 + octave_packages/nnet-0.1.13/packinfo/INDEX | 31 + octave_packages/nnet-0.1.13/poslin.m | 35 + octave_packages/nnet-0.1.13/poststd.m | 80 + octave_packages/nnet-0.1.13/prestd.m | 100 + octave_packages/nnet-0.1.13/purelin.m | 37 + octave_packages/nnet-0.1.13/radbas.m | 39 + octave_packages/nnet-0.1.13/satlin.m | 40 + octave_packages/nnet-0.1.13/satlins.m | 40 + octave_packages/nnet-0.1.13/saveMLPStruct.m | 187 + octave_packages/nnet-0.1.13/sim.m | 84 + octave_packages/nnet-0.1.13/subset.m | 212 + octave_packages/nnet-0.1.13/tansig.m | 41 + octave_packages/nnet-0.1.13/train.m | 217 + octave_packages/nnet-0.1.13/trastd.m | 91 + octave_packages/nnet-0.1.13/vec2ind.m | 44 + octave_packages/nurbs-1.3.6/basisfun.m | 87 + octave_packages/nurbs-1.3.6/basisfunder.m | 151 + octave_packages/nurbs-1.3.6/bspdegelev.m | 296 + octave_packages/nurbs-1.3.6/bspderiv.m | 67 + octave_packages/nurbs-1.3.6/bspeval.m | 72 + octave_packages/nurbs-1.3.6/bspkntins.m | 112 + octave_packages/nurbs-1.3.6/curvederivcpts.m | 60 + octave_packages/nurbs-1.3.6/curvederiveval.m | 67 + octave_packages/nurbs-1.3.6/deg2rad.m | 44 + octave_packages/nurbs-1.3.6/doc-cache | 3555 +++++++++++ octave_packages/nurbs-1.3.6/findspan.m | 61 + octave_packages/nurbs-1.3.6/kntbrkdegmult.m | 122 + octave_packages/nurbs-1.3.6/kntbrkdegreg.m | 117 + octave_packages/nurbs-1.3.6/kntrefine.m | 158 + octave_packages/nurbs-1.3.6/kntuniform.m | 52 + octave_packages/nurbs-1.3.6/nrb4surf.m | 74 + octave_packages/nurbs-1.3.6/nrbbasisfun.m | 137 + octave_packages/nurbs-1.3.6/nrbbasisfunder.m | 123 + octave_packages/nurbs-1.3.6/nrbcirc.m | 123 + octave_packages/nurbs-1.3.6/nrbcoons.m | 181 + octave_packages/nurbs-1.3.6/nrbcrvderiveval.m | 79 + octave_packages/nurbs-1.3.6/nrbctrlplot.m | 104 + octave_packages/nurbs-1.3.6/nrbcylind.m | 74 + octave_packages/nurbs-1.3.6/nrbdegelev.m | 173 + octave_packages/nurbs-1.3.6/nrbderiv.m | 503 ++ octave_packages/nurbs-1.3.6/nrbdeval.m | 272 + octave_packages/nurbs-1.3.6/nrbeval.m | 304 + octave_packages/nurbs-1.3.6/nrbexport.m | 80 + octave_packages/nurbs-1.3.6/nrbextract.m | 87 + octave_packages/nurbs-1.3.6/nrbextrude.m | 92 + octave_packages/nurbs-1.3.6/nrbkntins.m | 190 + octave_packages/nurbs-1.3.6/nrbkntplot.m | 238 + octave_packages/nurbs-1.3.6/nrbline.m | 59 + octave_packages/nurbs-1.3.6/nrbmak.m | 245 + octave_packages/nurbs-1.3.6/nrbnumbasisfun.m | 87 + octave_packages/nurbs-1.3.6/nrbplot.m | 278 + octave_packages/nurbs-1.3.6/nrbrect.m | 70 + octave_packages/nurbs-1.3.6/nrbreverse.m | 78 + octave_packages/nurbs-1.3.6/nrbrevolve.m | 180 + octave_packages/nurbs-1.3.6/nrbruled.m | 89 + .../nurbs-1.3.6/nrbsurfderiveval.m | 294 + octave_packages/nurbs-1.3.6/nrbtestcrv.m | 31 + octave_packages/nurbs-1.3.6/nrbtestsrf.m | 61 + octave_packages/nurbs-1.3.6/nrbtform.m | 82 + octave_packages/nurbs-1.3.6/nrbtransp.m | 55 + octave_packages/nurbs-1.3.6/numbasisfun.m | 49 + .../nurbs-1.3.6/packinfo/.autoload | 0 .../nurbs-1.3.6/packinfo/DESCRIPTION | 14 + octave_packages/nurbs-1.3.6/packinfo/INDEX | 70 + .../nurbs-1.3.6/private/nrb_crv_basisfun__.m | 20 + .../private/nrb_crv_basisfun_der__.m | 32 + .../nurbs-1.3.6/private/nrb_srf_basisfun__.m | 41 + .../private/nrb_srf_basisfun_der__.m | 52 + .../private/nrb_srf_numbasisfun__.m | 34 + .../nurbs-1.3.6/private/onebasisfun__.m | 56 + .../nurbs-1.3.6/private/onebasisfunder__.m | 39 + octave_packages/nurbs-1.3.6/rad2deg.m | 45 + octave_packages/nurbs-1.3.6/surfderivcpts.m | 79 + octave_packages/nurbs-1.3.6/surfderiveval.m | 95 + octave_packages/nurbs-1.3.6/tbasisfun.m | 131 + octave_packages/nurbs-1.3.6/vecangle.m | 50 + octave_packages/nurbs-1.3.6/veccross.m | 59 + octave_packages/nurbs-1.3.6/vecdot.m | 50 + octave_packages/nurbs-1.3.6/vecmag.m | 46 + octave_packages/nurbs-1.3.6/vecmag2.m | 47 + octave_packages/nurbs-1.3.6/vecnorm.m | 46 + octave_packages/nurbs-1.3.6/vecrot.m | 53 + octave_packages/nurbs-1.3.6/vecrotx.m | 62 + octave_packages/nurbs-1.3.6/vecroty.m | 62 + octave_packages/nurbs-1.3.6/vecrotz.m | 62 + octave_packages/nurbs-1.3.6/vecscale.m | 65 + octave_packages/nurbs-1.3.6/vectrans.m | 65 + .../ocs-0.1.3/asm/asm_build_system.m | 112 + .../ocs-0.1.3/asm/asm_initialize_system.m | 118 + octave_packages/ocs-0.1.3/asm/doc-cache | 80 + octave_packages/ocs-0.1.3/nls/doc-cache | 94 + .../ocs-0.1.3/nls/nls_newton_raphson.m | 110 + .../ocs-0.1.3/nls/nls_stationary.m | 81 + octave_packages/ocs-0.1.3/packinfo/.autoload | 0 .../ocs-0.1.3/packinfo/DESCRIPTION | 11 + octave_packages/ocs-0.1.3/packinfo/INDEX | 28 + octave_packages/ocs-0.1.3/prs/doc-cache | 193 + octave_packages/ocs-0.1.3/prs/prs_iff.m | 312 + octave_packages/ocs-0.1.3/prs/prs_spice.m | 1127 ++++ octave_packages/ocs-0.1.3/sbn/Mcapacitors.m | 178 + .../ocs-0.1.3/sbn/Mcurrentsources.m | 123 + octave_packages/ocs-0.1.3/sbn/Mdiode.m | 111 + octave_packages/ocs-0.1.3/sbn/Minductors.m | 77 + octave_packages/ocs-0.1.3/sbn/Mnmosfet.m | 161 + .../ocs-0.1.3/sbn/Mpdesympnjunct.m | 125 + octave_packages/ocs-0.1.3/sbn/Mpmosfet.m | 153 + octave_packages/ocs-0.1.3/sbn/Mresistors.m | 131 + .../ocs-0.1.3/sbn/Mshichmanhodgesmosfet.m | 332 + octave_packages/ocs-0.1.3/sbn/Mtdnmos.cir | 29 + octave_packages/ocs-0.1.3/sbn/Mtdnmos.nms | 10 + octave_packages/ocs-0.1.3/sbn/Mtdpmos.cir | 29 + octave_packages/ocs-0.1.3/sbn/Mtdpmos.nms | 10 + .../ocs-0.1.3/sbn/Mvoltagesources.m | 183 + octave_packages/ocs-0.1.3/sbn/doc-cache | 551 ++ octave_packages/ocs-0.1.3/tst/doc-cache | 239 + .../ocs-0.1.3/tst/tst_backward_euler.m | 179 + octave_packages/ocs-0.1.3/tst/tst_daspk.m | 135 + octave_packages/ocs-0.1.3/tst/tst_odepkg.m | 164 + .../ocs-0.1.3/tst/tst_theta_method.m | 162 + octave_packages/ocs-0.1.3/utl/doc-cache | 70 + .../ocs-0.1.3/utl/utl_plot_by_name.m | 59 + .../ocs-0.1.3/utl/utl_sbn_server.m | 96 + .../octcdf-1.1.4/@ncatt/datatype.m | 3 + octave_packages/octcdf-1.1.4/@ncatt/name.m | 7 + .../octcdf-1.1.4/@ncdim/isrecord.m | 3 + octave_packages/octcdf-1.1.4/@ncdim/name.m | 7 + octave_packages/octcdf-1.1.4/@ncfile/att.m | 3 + octave_packages/octcdf-1.1.4/@ncfile/close.m | 3 + octave_packages/octcdf-1.1.4/@ncfile/dim.m | 3 + octave_packages/octcdf-1.1.4/@ncfile/endef.m | 3 + octave_packages/octcdf-1.1.4/@ncfile/name.m | 3 + octave_packages/octcdf-1.1.4/@ncfile/redef.m | 3 + octave_packages/octcdf-1.1.4/@ncfile/sync.m | 3 + octave_packages/octcdf-1.1.4/@ncfile/var.m | 3 + octave_packages/octcdf-1.1.4/@ncvar/att.m | 3 + octave_packages/octcdf-1.1.4/@ncvar/autonan.m | 3 + .../octcdf-1.1.4/@ncvar/autoscale.m | 3 + .../octcdf-1.1.4/@ncvar/datatype.m | 3 + octave_packages/octcdf-1.1.4/@ncvar/dim.m | 3 + octave_packages/octcdf-1.1.4/@ncvar/fillval.m | 7 + octave_packages/octcdf-1.1.4/@ncvar/name.m | 7 + octave_packages/octcdf-1.1.4/doc-cache | 409 ++ octave_packages/octcdf-1.1.4/example_netcdf.m | 89 + .../octcdf-1.1.4/example_opendap.m | 57 + octave_packages/octcdf-1.1.4/ncbyte.m | 40 + octave_packages/octcdf-1.1.4/ncchar.m | 40 + octave_packages/octcdf-1.1.4/ncdouble.m | 40 + octave_packages/octcdf-1.1.4/ncdump.m | 147 + octave_packages/octcdf-1.1.4/ncfillval.m | 40 + octave_packages/octcdf-1.1.4/ncfloat.m | 40 + octave_packages/octcdf-1.1.4/ncint.m | 40 + octave_packages/octcdf-1.1.4/nclong.m | 40 + octave_packages/octcdf-1.1.4/ncshort.m | 40 + octave_packages/octcdf-1.1.4/nctest.m | 262 + .../octcdf-1.1.4/packinfo/.autoload | 0 .../octcdf-1.1.4/packinfo/DESCRIPTION | 12 + octave_packages/octcdf-1.1.4/packinfo/INDEX | 27 + octave_packages/octgpr-1.2.0/demo_octgpr.m | 279 + octave_packages/octgpr-1.2.0/doc-cache | 35 + .../octgpr-1.2.0/packinfo/.autoload | 0 .../octgpr-1.2.0/packinfo/DESCRIPTION | 13 + octave_packages/octgpr-1.2.0/packinfo/INDEX | 10 + octave_packages/octgpr-1.2.0/rbf_centers.m | 92 + octave_packages/odepkg-0.8.2/bvp4c.m | 233 + octave_packages/odepkg-0.8.2/doc-cache | 1891 ++++++ octave_packages/odepkg-0.8.2/doc.info | 2758 ++++++++ octave_packages/odepkg-0.8.2/ode23.m | 753 +++ octave_packages/odepkg-0.8.2/ode23d.m | 764 +++ octave_packages/odepkg-0.8.2/ode45.m | 757 +++ octave_packages/odepkg-0.8.2/ode45d.m | 768 +++ octave_packages/odepkg-0.8.2/ode54.m | 793 +++ octave_packages/odepkg-0.8.2/ode54d.m | 769 +++ octave_packages/odepkg-0.8.2/ode78.m | 779 +++ octave_packages/odepkg-0.8.2/ode78d.m | 789 +++ octave_packages/odepkg-0.8.2/odebwe.m | 804 +++ octave_packages/odepkg-0.8.2/odeexamples.m | 53 + octave_packages/odepkg-0.8.2/odeget.m | 122 + octave_packages/odepkg-0.8.2/odephas2.m | 70 + octave_packages/odepkg-0.8.2/odephas3.m | 76 + octave_packages/odepkg-0.8.2/odepkg.m | 230 + .../odepkg-0.8.2/odepkg_event_handle.m | 164 + .../odepkg-0.8.2/odepkg_examples_dae.m | 85 + .../odepkg-0.8.2/odepkg_examples_dde.m | 132 + .../odepkg-0.8.2/odepkg_examples_ide.m | 109 + .../odepkg-0.8.2/odepkg_examples_ode.m | 178 + .../odepkg-0.8.2/odepkg_structure_check.m | 435 ++ .../odepkg-0.8.2/odepkg_testsuite_calcmescd.m | 59 + .../odepkg-0.8.2/odepkg_testsuite_calcscd.m | 58 + .../odepkg-0.8.2/odepkg_testsuite_chemakzo.m | 184 + .../odepkg-0.8.2/odepkg_testsuite_hires.m | 142 + .../odepkg-0.8.2/odepkg_testsuite_implakzo.m | 192 + .../odepkg-0.8.2/odepkg_testsuite_implrober.m | 137 + .../odepkg-0.8.2/odepkg_testsuite_impltrans.m | 177 + .../odepkg_testsuite_oregonator.m | 117 + .../odepkg-0.8.2/odepkg_testsuite_pollution.m | 261 + .../odepkg-0.8.2/odepkg_testsuite_robertson.m | 121 + .../odepkg_testsuite_transistor.m | 162 + octave_packages/odepkg-0.8.2/odeplot.m | 73 + octave_packages/odepkg-0.8.2/odeprint.m | 65 + octave_packages/odepkg-0.8.2/odeset.m | 186 + .../odepkg-0.8.2/packinfo/.autoload | 0 .../odepkg-0.8.2/packinfo/DESCRIPTION | 12 + octave_packages/odepkg-0.8.2/packinfo/INDEX | 54 + octave_packages/openmpi_ext-1.0.2/Pi.m | 110 + octave_packages/openmpi_ext-1.0.2/allnodes | 7 + octave_packages/openmpi_ext-1.0.2/doc-cache | 222 + .../openmpi_ext-1.0.2/hello2dimmat.m | 33 + octave_packages/openmpi_ext-1.0.2/hellocell.m | 52 + .../openmpi_ext-1.0.2/hellosparsemat.m | 47 + .../openmpi_ext-1.0.2/hellostruct.m | 48 + .../openmpi_ext-1.0.2/helloworld.m | 49 + .../openmpi_ext-1.0.2/mc_example.m | 53 + .../openmpi_ext-1.0.2/montecarlo.m | 138 + .../openmpi_ext-1.0.2/packinfo/.autoload | 0 .../openmpi_ext-1.0.2/packinfo/DESCRIPTION | 11 + .../openmpi_ext-1.0.2/packinfo/INDEX | 9 + .../optim-1.2.0/LinearRegression.m | 76 + octave_packages/optim-1.2.0/PKG_ADD | 4 + octave_packages/optim-1.2.0/__bracket_min.m | 42 + .../optim-1.2.0/__poly_2_extrema.m | 54 + octave_packages/optim-1.2.0/__semi_bracket.m | 50 + octave_packages/optim-1.2.0/adsmax.m | 171 + octave_packages/optim-1.2.0/battery.m | 49 + octave_packages/optim-1.2.0/bfgsmin.m | 130 + octave_packages/optim-1.2.0/bfgsmin_example.m | 170 + octave_packages/optim-1.2.0/brent_line_min.m | 233 + octave_packages/optim-1.2.0/cauchy.m | 125 + octave_packages/optim-1.2.0/cdiff.m | 155 + octave_packages/optim-1.2.0/cg_min.m | 305 + octave_packages/optim-1.2.0/cpiv_bard.m | 86 + octave_packages/optim-1.2.0/curvefit_stat.m | 76 + octave_packages/optim-1.2.0/d2_min.m | 393 ++ octave_packages/optim-1.2.0/dcdp.m | 42 + octave_packages/optim-1.2.0/de_min.m | 451 ++ octave_packages/optim-1.2.0/deriv.m | 98 + octave_packages/optim-1.2.0/dfdp.m | 70 + octave_packages/optim-1.2.0/dfpdp.m | 50 + octave_packages/optim-1.2.0/dfxpdp.m | 53 + octave_packages/optim-1.2.0/doc-cache | 3563 +++++++++++ octave_packages/optim-1.2.0/expfit.m | 136 + octave_packages/optim-1.2.0/fmin.m | 28 + octave_packages/optim-1.2.0/fmins.m | 78 + octave_packages/optim-1.2.0/fminsearch.m | 36 + octave_packages/optim-1.2.0/fminunc_compat.m | 166 + octave_packages/optim-1.2.0/gjp.m | 52 + octave_packages/optim-1.2.0/jacobs.m | 142 + octave_packages/optim-1.2.0/leasqr.m | 798 +++ octave_packages/optim-1.2.0/line_min.m | 83 + octave_packages/optim-1.2.0/linprog.m | 159 + octave_packages/optim-1.2.0/mdsmax.m | 200 + octave_packages/optim-1.2.0/minimize.m | 297 + octave_packages/optim-1.2.0/nelder_mead_min.m | 352 ++ octave_packages/optim-1.2.0/nmsmax.m | 213 + octave_packages/optim-1.2.0/nonlin_curvefit.m | 101 + octave_packages/optim-1.2.0/nonlin_min.m | 1420 +++++ octave_packages/optim-1.2.0/nonlin_residmin.m | 304 + octave_packages/optim-1.2.0/nrm.m | 38 + octave_packages/optim-1.2.0/optim_problems.m | 1258 ++++ octave_packages/optim-1.2.0/optimset_compat.m | 76 + .../optim-1.2.0/packinfo/.autoload | 0 .../optim-1.2.0/packinfo/DESCRIPTION | 11 + octave_packages/optim-1.2.0/packinfo/INDEX | 48 + octave_packages/optim-1.2.0/packinfo/NEWS | 71 + octave_packages/optim-1.2.0/poly_2_ex.m | 51 + octave_packages/optim-1.2.0/polyconf.m | 140 + octave_packages/optim-1.2.0/polyfitinf.m | 870 +++ octave_packages/optim-1.2.0/powell.m | 193 + .../private/__collect_constraints__.m | 93 + .../optim-1.2.0/private/__covd_wls__.m | 32 + .../optim-1.2.0/private/__covp_corp_wls__.m | 105 + .../optim-1.2.0/private/__dfdp__.m | 156 + .../optim-1.2.0/private/__lm_feasible__.m | 505 ++ .../optim-1.2.0/private/__lm_svd__.m | 510 ++ .../optim-1.2.0/private/__nonlin_residmin__.m | 1032 +++ .../optim-1.2.0/private/__null_optim__.m | 120 + .../optim-1.2.0/private/__plot_cmds__.m | 50 + .../optim-1.2.0/private/__residmin_stat__.m | 621 ++ .../optim-1.2.0/private/__s2mat__.m | 50 + .../optim-1.2.0/private/__siman__.m | 249 + octave_packages/optim-1.2.0/private/__sqp__.m | 160 + .../private/optim_problems_p_r_y.data | 675 ++ octave_packages/optim-1.2.0/residmin_stat.m | 99 + octave_packages/optim-1.2.0/rosenbrock.m | 30 + octave_packages/optim-1.2.0/samin_example.m | 75 + octave_packages/optim-1.2.0/test_d2_min_1.m | 184 + octave_packages/optim-1.2.0/test_d2_min_2.m | 115 + octave_packages/optim-1.2.0/test_d2_min_3.m | 102 + octave_packages/optim-1.2.0/test_fminunc_1.m | 144 + octave_packages/optim-1.2.0/test_min_1.m | 104 + octave_packages/optim-1.2.0/test_min_2.m | 123 + octave_packages/optim-1.2.0/test_min_3.m | 112 + octave_packages/optim-1.2.0/test_min_4.m | 119 + octave_packages/optim-1.2.0/test_minimize_1.m | 255 + .../optim-1.2.0/test_nelder_mead_min_1.m | 189 + .../optim-1.2.0/test_nelder_mead_min_2.m | 153 + octave_packages/optim-1.2.0/test_wpolyfit.m | 512 ++ octave_packages/optim-1.2.0/vfzero.m | 367 ++ octave_packages/optim-1.2.0/wpolyfit.m | 261 + octave_packages/optim-1.2.0/wrap_f_dfdp.m | 45 + octave_packages/optim-1.2.0/wsolve.m | 128 + octave_packages/optiminterp-0.3.3/doc-cache | 299 + .../optiminterp-0.3.3/example_optiminterp.m | 67 + .../optiminterp-0.3.3/optiminterp1.m | 41 + .../optiminterp-0.3.3/optiminterp2.m | 45 + .../optiminterp-0.3.3/optiminterp3.m | 47 + .../optiminterp-0.3.3/optiminterp4.m | 48 + .../optiminterp-0.3.3/optiminterpn.m | 103 + .../optiminterp-0.3.3/packinfo/.autoload | 0 .../optiminterp-0.3.3/packinfo/DESCRIPTION | 11 + .../optiminterp-0.3.3/packinfo/INDEX | 11 + .../optiminterp-0.3.3/test_optiminterp.m | 147 + .../optiminterp-0.3.3/test_optiminterp_mult.m | 159 + octave_packages/plot-1.1.0/doc-cache | 241 + octave_packages/plot-1.1.0/dxfwrite.m | 164 + octave_packages/plot-1.1.0/gplot3.m | 74 + octave_packages/plot-1.1.0/hist2d.m | 50 + octave_packages/plot-1.1.0/packinfo/.autoload | 0 .../plot-1.1.0/packinfo/DESCRIPTION | 12 + octave_packages/plot-1.1.0/packinfo/INDEX | 9 + octave_packages/plot-1.1.0/plotdecimate.m | 128 + octave_packages/plot-1.1.0/tics.m | 48 + octave_packages/plot-1.1.0/tricontour.m | 117 + octave_packages/plot-1.1.0/zoom.m | 9 + .../quaternion-2.0.0/@quaternion/abs.m | 38 + .../quaternion-2.0.0/@quaternion/blkdiag.m | 60 + .../quaternion-2.0.0/@quaternion/cat.m | 36 + .../quaternion-2.0.0/@quaternion/columns.m | 34 + .../quaternion-2.0.0/@quaternion/conj.m | 40 + .../quaternion-2.0.0/@quaternion/ctranspose.m | 31 + .../quaternion-2.0.0/@quaternion/diag.m | 53 + .../quaternion-2.0.0/@quaternion/diff.m | 64 + .../quaternion-2.0.0/@quaternion/display.m | 63 + .../quaternion-2.0.0/@quaternion/eq.m | 35 + .../quaternion-2.0.0/@quaternion/exp.m | 40 + .../quaternion-2.0.0/@quaternion/horzcat.m | 34 + .../quaternion-2.0.0/@quaternion/inv.m | 42 + .../quaternion-2.0.0/@quaternion/ispure.m | 33 + .../quaternion-2.0.0/@quaternion/ldivide.m | 27 + .../quaternion-2.0.0/@quaternion/log.m | 61 + .../quaternion-2.0.0/@quaternion/minus.m | 38 + .../quaternion-2.0.0/@quaternion/mldivide.m | 27 + .../quaternion-2.0.0/@quaternion/mpower.m | 56 + .../quaternion-2.0.0/@quaternion/mrdivide.m | 27 + .../quaternion-2.0.0/@quaternion/mtimes.m | 43 + .../quaternion-2.0.0/@quaternion/norm.m | 38 + .../quaternion-2.0.0/@quaternion/plus.m | 38 + .../quaternion-2.0.0/@quaternion/power.m | 49 + .../@quaternion/private/norm2.m | 29 + .../@quaternion/private/normv.m | 29 + .../quaternion-2.0.0/@quaternion/quaternion.m | 111 + .../quaternion-2.0.0/@quaternion/rdivide.m | 27 + .../quaternion-2.0.0/@quaternion/rows.m | 33 + .../quaternion-2.0.0/@quaternion/size.m | 74 + .../quaternion-2.0.0/@quaternion/subsasgn.m | 64 + .../quaternion-2.0.0/@quaternion/subsref.m | 60 + .../quaternion-2.0.0/@quaternion/times.m | 43 + .../quaternion-2.0.0/@quaternion/transpose.m | 34 + .../quaternion-2.0.0/@quaternion/uminus.m | 30 + .../quaternion-2.0.0/@quaternion/unit.m | 38 + .../quaternion-2.0.0/@quaternion/uplus.m | 27 + .../quaternion-2.0.0/@quaternion/vertcat.m | 34 + octave_packages/quaternion-2.0.0/doc-cache | 242 + .../quaternion-2.0.0/packinfo/.autoload | 0 .../quaternion-2.0.0/packinfo/DESCRIPTION | 11 + .../quaternion-2.0.0/packinfo/INDEX | 44 + .../quaternion-2.0.0/packinfo/NEWS | 14 + octave_packages/quaternion-2.0.0/q2rot.m | 93 + octave_packages/quaternion-2.0.0/qi.m | 48 + octave_packages/quaternion-2.0.0/qj.m | 48 + octave_packages/quaternion-2.0.0/qk.m | 48 + octave_packages/quaternion-2.0.0/rot2q.m | 95 + .../quaternion-2.0.0/test_quaternion.m | 4 + .../DDG/DDGelectron_driftdiffusion.m | 82 + .../secs1d-0.0.8/DDG/DDGgummelmap.m | 147 + .../secs1d-0.0.8/DDG/DDGhole_driftdiffusion.m | 83 + octave_packages/secs1d-0.0.8/DDG/DDGn2phin.m | 38 + .../secs1d-0.0.8/DDG/DDGnlpoisson.m | 255 + octave_packages/secs1d-0.0.8/DDG/DDGp2phip.m | 38 + octave_packages/secs1d-0.0.8/DDG/DDGphin2n.m | 36 + octave_packages/secs1d-0.0.8/DDG/DDGphip2p.m | 39 + .../secs1d-0.0.8/DDG/DDGplotresults.m | 53 + octave_packages/secs1d-0.0.8/DDG/doc-cache | 295 + .../secs1d-0.0.8/DDN/DDNnewtonmap.m | 272 + octave_packages/secs1d-0.0.8/DDN/doc-cache | 61 + octave_packages/secs1d-0.0.8/PKG_ADD | 7 + octave_packages/secs1d-0.0.8/PKG_DEL | 7 + .../secs1d-0.0.8/Utilities/Ubern.m | 98 + .../secs1d-0.0.8/Utilities/Ubernoulli.m | 49 + .../secs1d-0.0.8/Utilities/Ucompconst.m | 33 + .../secs1d-0.0.8/Utilities/Ucomplap.m | 43 + .../secs1d-0.0.8/Utilities/Ucompmass.m | 34 + .../secs1d-0.0.8/Utilities/Udriftdiffusion.m | 54 + .../secs1d-0.0.8/Utilities/Umediaarmonica.m | 35 + .../Utilities/Uscharfettergummel.m | 54 + .../secs1d-0.0.8/Utilities/constants.m | 73 + .../secs1d-0.0.8/Utilities/doc-cache | 276 + octave_packages/secs1d-0.0.8/doc-cache | 37 + .../secs1d-0.0.8/packinfo/.autoload | 0 .../secs1d-0.0.8/packinfo/DESCRIPTION | 12 + octave_packages/secs1d-0.0.8/packinfo/INDEX | 24 + octave_packages/secs1d-0.0.8/secs1d.m | 15 + .../secs2d-0.0.8/DDGOX/DDGOXddcurrent.m | 52 + .../DDGOX/DDGOXelectron_driftdiffusion.m | 58 + .../secs2d-0.0.8/DDGOX/DDGOXgummelmap.m | 177 + .../DDGOX/DDGOXhole_driftdiffusion.m | 60 + .../secs2d-0.0.8/DDGOX/DDGOXnlpoisson.m | 253 + .../secs2d-0.0.8/DDGOX/DDGOXplotresults.m | 54 + octave_packages/secs2d-0.0.8/DDGOX/doc-cache | 184 + .../DDGOXT/DDGOXTelectron_driftdiffusion.m | 60 + .../secs2d-0.0.8/DDGOXT/DDGOXTgummelmap.m | 162 + .../DDGOXT/DDGOXThole_driftdiffusion.m | 59 + octave_packages/secs2d-0.0.8/DDGOXT/doc-cache | 115 + .../secs2d-0.0.8/METLINES/METLINEScapcomp.m | 41 + .../METLINES/METLINESdefinepermittivity.m | 15 + .../secs2d-0.0.8/METLINES/doc-cache | 63 + octave_packages/secs2d-0.0.8/PKG_ADD | 27 + octave_packages/secs2d-0.0.8/PKG_DEL | 9 + .../secs2d-0.0.8/QDDGOX/QDDGOXcompdens.m | 173 + .../secs2d-0.0.8/QDDGOX/QDDGOXddcurrent.m | 39 + .../secs2d-0.0.8/QDDGOX/QDDGOXgummelmap.m | 294 + .../secs2d-0.0.8/QDDGOX/QDDGOXnlpoisson.m | 244 + octave_packages/secs2d-0.0.8/QDDGOX/doc-cache | 111 + .../secs2d-0.0.8/ThDDGOX/ThDDGOXMOBN0STD.m | 6 + .../secs2d-0.0.8/ThDDGOX/ThDDGOXMOBN1STD.m | 5 + .../secs2d-0.0.8/ThDDGOX/ThDDGOXMOBP0STD.m | 6 + .../secs2d-0.0.8/ThDDGOX/ThDDGOXMOBP1STD.m | 5 + .../secs2d-0.0.8/ThDDGOX/ThDDGOXTWN0STD.m | 6 + .../secs2d-0.0.8/ThDDGOX/ThDDGOXTWN1STD.m | 6 + .../secs2d-0.0.8/ThDDGOX/ThDDGOXTWP0STD.m | 6 + .../secs2d-0.0.8/ThDDGOX/ThDDGOXTWP1STD.m | 5 + .../secs2d-0.0.8/ThDDGOX/ThDDGOXddcurrent.m | 54 + .../ThDDGOX/ThDDGOXelectron_driftdiffusion.m | 48 + .../ThDDGOX/ThDDGOXeletiteration.m | 147 + .../secs2d-0.0.8/ThDDGOX/ThDDGOXgummelmap.m | 69 + .../ThDDGOX/ThDDGOXhole_driftdiffusion.m | 47 + .../secs2d-0.0.8/ThDDGOX/ThDDGOXnlpoisson.m | 229 + .../ThDDGOX/ThDDGOXthermaliteration.m | 156 + .../ThDDGOX/ThDDGOXupdateelectron_temp.m | 59 + .../ThDDGOX/ThDDGOXupdatehole_temp.m | 60 + .../ThDDGOX/ThDDGOXupdatelattice_temp.m | 52 + .../secs2d-0.0.8/ThDDGOX/doc-cache | 271 + .../secs2d-0.0.8/Utilities/UDXappend2Ddata.m | 56 + .../secs2d-0.0.8/Utilities/UDXoutput2Ddata.m | 115 + .../Utilities/UDXoutput2Dtimeseries.m | 58 + .../Utilities/URREcyclingpattern.m | 42 + .../secs2d-0.0.8/Utilities/Ubern.m | 105 + .../Utilities/Ucoloredrubbersheet.net | 608 ++ .../Utilities/Ucoloredrubbersheetseries.net | 657 ++ .../secs2d-0.0.8/Utilities/Ucolumns.m | 32 + .../secs2d-0.0.8/Utilities/Ucompconst.m | 52 + .../secs2d-0.0.8/Utilities/Ucomplap.m | 57 + .../secs2d-0.0.8/Utilities/Ucompmass2.m | 58 + .../secs2d-0.0.8/Utilities/Udescaling.m | 99 + .../secs2d-0.0.8/Utilities/Udopdepmob.m | 30 + .../secs2d-0.0.8/Utilities/Udrawcurrent.net | 653 ++ .../secs2d-0.0.8/Utilities/Udrawedge.m | 57 + .../secs2d-0.0.8/Utilities/Udriftdepmob.m | 40 + .../secs2d-0.0.8/Utilities/Udriftdiffusion.m | 95 + .../secs2d-0.0.8/Utilities/Udriftdiffusion2.m | 75 + .../secs2d-0.0.8/Utilities/Ufielddepmob.m | 43 + .../secs2d-0.0.8/Utilities/Ufvsgcurrent.m | 74 + .../secs2d-0.0.8/Utilities/Ufvsgcurrent2.m | 86 + .../secs2d-0.0.8/Utilities/Ufvsgcurrent3.m | 146 + .../secs2d-0.0.8/Utilities/Uinvfermidirac.m | 62 + .../secs2d-0.0.8/Utilities/Uise2pde.m | 672 ++ .../secs2d-0.0.8/Utilities/Ujoinmeshes.m | 120 + .../secs2d-0.0.8/Utilities/Umeshproperties.m | 76 + .../secs2d-0.0.8/Utilities/Umsh2pdetool.m | 61 + .../secs2d-0.0.8/Utilities/Umshcreatemesh.m | 17 + .../secs2d-0.0.8/Utilities/Unodesonside.m | 37 + .../secs2d-0.0.8/Utilities/Updegrad.m | 39 + .../secs2d-0.0.8/Utilities/Updemesh.m | 75 + .../secs2d-0.0.8/Utilities/Updesurf.m | 72 + .../secs2d-0.0.8/Utilities/Urows.m | 31 + .../secs2d-0.0.8/Utilities/Urrextrapolation.m | 40 + .../secs2d-0.0.8/Utilities/Urubbersheet.net | 519 ++ .../secs2d-0.0.8/Utilities/Uscaling.m | 174 + .../Utilities/Uscharfettergummel.m | 0 .../Utilities/Uscharfettergummel2.m | 100 + .../Utilities/Uscharfettergummel3.m | 290 + .../secs2d-0.0.8/Utilities/Ushowgrid.net | 515 ++ .../secs2d-0.0.8/Utilities/Usmoothguess.m | 20 + .../secs2d-0.0.8/Utilities/Ustructmesh.m | 34 + .../secs2d-0.0.8/Utilities/Ustructmesh_left.m | 55 + .../Utilities/Ustructmesh_random.m | 63 + .../Utilities/Ustructmesh_right.m | 54 + .../secs2d-0.0.8/Utilities/Usubdomains2.m | 75 + .../secs2d-0.0.8/Utilities/Usubmesh.m | 93 + .../secs2d-0.0.8/Utilities/Utemplogm.m | 8 + .../secs2d-0.0.8/Utilities/constants.m | 111 + .../secs2d-0.0.8/Utilities/constants.mat | 187 + .../secs2d-0.0.8/Utilities/doc-cache | 1226 ++++ octave_packages/secs2d-0.0.8/doc-cache | 56 + .../secs2d-0.0.8/packinfo/.autoload | 0 .../secs2d-0.0.8/packinfo/DESCRIPTION | 12 + octave_packages/secs2d-0.0.8/packinfo/INDEX | 90 + octave_packages/secs2d-0.0.8/secs2d.m | 36 + octave_packages/signal-1.1.3/__power.m | 89 + octave_packages/signal-1.1.3/ar_psd.m | 291 + octave_packages/signal-1.1.3/arburg.m | 228 + octave_packages/signal-1.1.3/aryule.m | 61 + octave_packages/signal-1.1.3/barthannwin.m | 34 + octave_packages/signal-1.1.3/besselap.m | 52 + octave_packages/signal-1.1.3/besself.m | 117 + octave_packages/signal-1.1.3/bilinear.m | 104 + octave_packages/signal-1.1.3/bitrevorder.m | 98 + octave_packages/signal-1.1.3/blackmanharris.m | 36 + .../signal-1.1.3/blackmannuttall.m | 37 + octave_packages/signal-1.1.3/bohmanwin.m | 51 + octave_packages/signal-1.1.3/boxcar.m | 30 + octave_packages/signal-1.1.3/buffer.m | 275 + octave_packages/signal-1.1.3/butter.m | 176 + octave_packages/signal-1.1.3/buttord.m | 82 + octave_packages/signal-1.1.3/cceps.m | 76 + octave_packages/signal-1.1.3/cheb.m | 51 + octave_packages/signal-1.1.3/cheb1ord.m | 147 + octave_packages/signal-1.1.3/cheb2ord.m | 148 + octave_packages/signal-1.1.3/chebwin.m | 89 + octave_packages/signal-1.1.3/cheby1.m | 131 + octave_packages/signal-1.1.3/cheby2.m | 140 + octave_packages/signal-1.1.3/chirp.m | 94 + octave_packages/signal-1.1.3/cmorwavf.m | 29 + octave_packages/signal-1.1.3/cohere.m | 56 + octave_packages/signal-1.1.3/convmtx.m | 57 + octave_packages/signal-1.1.3/cplxreal.m | 73 + octave_packages/signal-1.1.3/cpsd.m | 51 + octave_packages/signal-1.1.3/csd.m | 54 + octave_packages/signal-1.1.3/czt.m | 83 + octave_packages/signal-1.1.3/data2fun.m | 167 + octave_packages/signal-1.1.3/dct.m | 91 + octave_packages/signal-1.1.3/dct2.m | 44 + octave_packages/signal-1.1.3/dctmtx.m | 46 + octave_packages/signal-1.1.3/decimate.m | 83 + octave_packages/signal-1.1.3/dftmtx.m | 36 + octave_packages/signal-1.1.3/diric.m | 32 + octave_packages/signal-1.1.3/doc-cache | 5602 +++++++++++++++++ octave_packages/signal-1.1.3/downsample.m | 39 + octave_packages/signal-1.1.3/dst.m | 58 + octave_packages/signal-1.1.3/dwt.m | 33 + octave_packages/signal-1.1.3/ellip.m | 164 + octave_packages/signal-1.1.3/ellipord.m | 90 + octave_packages/signal-1.1.3/fht.m | 69 + octave_packages/signal-1.1.3/filtfilt.m | 124 + octave_packages/signal-1.1.3/filtic.m | 136 + octave_packages/signal-1.1.3/fir1.m | 152 + octave_packages/signal-1.1.3/fir2.m | 174 + octave_packages/signal-1.1.3/firls.m | 109 + octave_packages/signal-1.1.3/flattopwin.m | 45 + octave_packages/signal-1.1.3/fracshift.m | 177 + octave_packages/signal-1.1.3/freqs.m | 45 + octave_packages/signal-1.1.3/freqs_plot.m | 50 + octave_packages/signal-1.1.3/fwhm.m | 171 + octave_packages/signal-1.1.3/gauspuls.m | 29 + octave_packages/signal-1.1.3/gaussian.m | 38 + octave_packages/signal-1.1.3/gausswin.m | 33 + octave_packages/signal-1.1.3/gmonopuls.m | 25 + octave_packages/signal-1.1.3/grpdelay.m | 321 + octave_packages/signal-1.1.3/hann.m | 3 + octave_packages/signal-1.1.3/hilbert.m | 149 + octave_packages/signal-1.1.3/idct.m | 74 + octave_packages/signal-1.1.3/idct2.m | 44 + octave_packages/signal-1.1.3/idst.m | 30 + octave_packages/signal-1.1.3/ifht.m | 68 + octave_packages/signal-1.1.3/iirlp2mb.m | 318 + octave_packages/signal-1.1.3/impinvar.m | 146 + octave_packages/signal-1.1.3/impz.m | 99 + octave_packages/signal-1.1.3/interp.m | 58 + octave_packages/signal-1.1.3/invfreq.m | 234 + octave_packages/signal-1.1.3/invfreqs.m | 93 + octave_packages/signal-1.1.3/invfreqz.m | 87 + octave_packages/signal-1.1.3/invimpinvar.m | 149 + octave_packages/signal-1.1.3/kaiser.m | 55 + octave_packages/signal-1.1.3/kaiserord.m | 147 + octave_packages/signal-1.1.3/levinson.m | 84 + octave_packages/signal-1.1.3/marcumq.m | 389 ++ octave_packages/signal-1.1.3/mexihat.m | 29 + octave_packages/signal-1.1.3/meyeraux.m | 25 + octave_packages/signal-1.1.3/morlet.m | 29 + octave_packages/signal-1.1.3/mscohere.m | 52 + octave_packages/signal-1.1.3/ncauer.m | 133 + octave_packages/signal-1.1.3/nuttallwin.m | 42 + .../signal-1.1.3/packinfo/.autoload | 0 .../signal-1.1.3/packinfo/DESCRIPTION | 11 + octave_packages/signal-1.1.3/packinfo/INDEX | 162 + octave_packages/signal-1.1.3/packinfo/NEWS | 69 + octave_packages/signal-1.1.3/parzenwin.m | 43 + octave_packages/signal-1.1.3/pburg.m | 148 + .../signal-1.1.3/pei_tseng_notch.m | 119 + octave_packages/signal-1.1.3/polystab.m | 29 + .../signal-1.1.3/private/h1_z_deriv.m | 53 + .../signal-1.1.3/private/inv_residue.m | 56 + .../signal-1.1.3/private/polyrev.m | 23 + .../signal-1.1.3/private/to_real.m | 23 + octave_packages/signal-1.1.3/pulstran.m | 144 + octave_packages/signal-1.1.3/pwelch.m | 955 +++ octave_packages/signal-1.1.3/pyulear.m | 120 + octave_packages/signal-1.1.3/qp_kaiser.m | 90 + octave_packages/signal-1.1.3/rceps.m | 105 + octave_packages/signal-1.1.3/rectpuls.m | 57 + octave_packages/signal-1.1.3/rectwin.m | 25 + octave_packages/signal-1.1.3/resample.m | 192 + octave_packages/signal-1.1.3/residued.m | 161 + octave_packages/signal-1.1.3/residuez.m | 169 + .../signal-1.1.3/sampled2continuous.m | 43 + octave_packages/signal-1.1.3/sawtooth.m | 59 + octave_packages/signal-1.1.3/sftrans.m | 183 + octave_packages/signal-1.1.3/sgolay.m | 104 + octave_packages/signal-1.1.3/sgolayfilt.m | 117 + octave_packages/signal-1.1.3/shanwavf.m | 32 + octave_packages/signal-1.1.3/sigmoid_train.m | 119 + octave_packages/signal-1.1.3/sos2tf.m | 91 + octave_packages/signal-1.1.3/sos2zp.m | 92 + octave_packages/signal-1.1.3/specgram.m | 219 + octave_packages/signal-1.1.3/square.m | 31 + octave_packages/signal-1.1.3/ss2tf.m | 62 + octave_packages/signal-1.1.3/ss2zp.m | 34 + octave_packages/signal-1.1.3/tf2sos.m | 64 + octave_packages/signal-1.1.3/tf2ss.m | 63 + octave_packages/signal-1.1.3/tf2zp.m | 36 + octave_packages/signal-1.1.3/tfe.m | 55 + octave_packages/signal-1.1.3/tfestimate.m | 51 + octave_packages/signal-1.1.3/triang.m | 64 + octave_packages/signal-1.1.3/tripuls.m | 67 + octave_packages/signal-1.1.3/tukeywin.m | 67 + octave_packages/signal-1.1.3/upsample.m | 39 + octave_packages/signal-1.1.3/welchwin.m | 97 + octave_packages/signal-1.1.3/window.m | 34 + octave_packages/signal-1.1.3/wkeep.m | 65 + octave_packages/signal-1.1.3/wrev.m | 30 + octave_packages/signal-1.1.3/xcorr.m | 283 + octave_packages/signal-1.1.3/xcorr2.m | 87 + octave_packages/signal-1.1.3/xcov.m | 62 + octave_packages/signal-1.1.3/zerocrossing.m | 72 + octave_packages/signal-1.1.3/zp2sos.m | 136 + octave_packages/signal-1.1.3/zp2ss.m | 65 + octave_packages/signal-1.1.3/zp2tf.m | 43 + octave_packages/signal-1.1.3/zplane.m | 152 + .../sockets-1.0.8/packinfo/.autoload | 0 .../sockets-1.0.8/packinfo/DESCRIPTION | 12 + octave_packages/sockets-1.0.8/packinfo/INDEX | 25 + octave_packages/sockets-1.0.8/packinfo/NEWS | 4 + octave_packages/specfun-1.1.0/Ci.m | 39 + octave_packages/specfun-1.1.0/Si.m | 44 + octave_packages/specfun-1.1.0/cosint.m | 34 + octave_packages/specfun-1.1.0/dirac.m | 28 + octave_packages/specfun-1.1.0/doc-cache | 742 +++ octave_packages/specfun-1.1.0/ellipke.m | 125 + octave_packages/specfun-1.1.0/erfcinv.m | 27 + octave_packages/specfun-1.1.0/expint.m | 34 + octave_packages/specfun-1.1.0/expint_E1.m | 38 + octave_packages/specfun-1.1.0/expint_Ei.m | 63 + octave_packages/specfun-1.1.0/heaviside.m | 41 + octave_packages/specfun-1.1.0/laguerre.m | 91 + octave_packages/specfun-1.1.0/lambertw.m | 101 + octave_packages/specfun-1.1.0/laplacian.m | 495 ++ octave_packages/specfun-1.1.0/multinom.m | 67 + .../specfun-1.1.0/multinom_coeff.m | 104 + octave_packages/specfun-1.1.0/multinom_exp.m | 92 + .../specfun-1.1.0/packinfo/.autoload | 0 .../specfun-1.1.0/packinfo/DESCRIPTION | 12 + octave_packages/specfun-1.1.0/packinfo/INDEX | 22 + octave_packages/specfun-1.1.0/packinfo/NEWS | 16 + octave_packages/specfun-1.1.0/psi.m | 43 + octave_packages/specfun-1.1.0/sinint.m | 24 + octave_packages/specfun-1.1.0/zeta.m | 46 + octave_packages/splines-1.0.7/catmullrom.m | 61 + octave_packages/splines-1.0.7/csape.m | 275 + octave_packages/splines-1.0.7/csapi.m | 35 + octave_packages/splines-1.0.7/doc-cache | 203 + octave_packages/splines-1.0.7/fnder.m | 46 + octave_packages/splines-1.0.7/fnplt.m | 60 + octave_packages/splines-1.0.7/fnval.m | 14 + .../splines-1.0.7/packinfo/.autoload | 0 .../splines-1.0.7/packinfo/DESCRIPTION | 12 + octave_packages/splines-1.0.7/packinfo/INDEX | 9 + .../statistics-1.1.3/anderson_darling_cdf.m | 131 + .../statistics-1.1.3/anderson_darling_test.m | 153 + octave_packages/statistics-1.1.3/anovan.m | 359 ++ octave_packages/statistics-1.1.3/betastat.m | 123 + octave_packages/statistics-1.1.3/binostat.m | 123 + octave_packages/statistics-1.1.3/boxplot.m | 325 + octave_packages/statistics-1.1.3/caseread.m | 61 + octave_packages/statistics-1.1.3/casewrite.m | 66 + octave_packages/statistics-1.1.3/chi2stat.m | 92 + .../statistics-1.1.3/cl_multinom.m | 124 + octave_packages/statistics-1.1.3/combnk.m | 88 + octave_packages/statistics-1.1.3/copulacdf.m | 288 + octave_packages/statistics-1.1.3/copulapdf.m | 194 + octave_packages/statistics-1.1.3/copularnd.m | 281 + octave_packages/statistics-1.1.3/doc-cache | 4344 +++++++++++++ octave_packages/statistics-1.1.3/expstat.m | 92 + octave_packages/statistics-1.1.3/ff2n.m | 13 + octave_packages/statistics-1.1.3/fstat.m | 130 + octave_packages/statistics-1.1.3/fullfact.m | 27 + octave_packages/statistics-1.1.3/gamfit.m | 44 + octave_packages/statistics-1.1.3/gamlike.m | 21 + octave_packages/statistics-1.1.3/gamstat.m | 123 + octave_packages/statistics-1.1.3/geomean.m | 34 + octave_packages/statistics-1.1.3/geostat.m | 93 + octave_packages/statistics-1.1.3/harmmean.m | 34 + octave_packages/statistics-1.1.3/histfit.m | 70 + .../statistics-1.1.3/hmmestimate.m | 338 + .../statistics-1.1.3/hmmgenerate.m | 251 + octave_packages/statistics-1.1.3/hmmviterbi.m | 250 + octave_packages/statistics-1.1.3/hygestat.m | 133 + octave_packages/statistics-1.1.3/jackknife.m | 141 + octave_packages/statistics-1.1.3/jsucdf.m | 61 + octave_packages/statistics-1.1.3/jsupdf.m | 62 + octave_packages/statistics-1.1.3/kmeans.m | 139 + octave_packages/statistics-1.1.3/linkage.m | 231 + octave_packages/statistics-1.1.3/lognstat.m | 123 + octave_packages/statistics-1.1.3/mad.m | 98 + octave_packages/statistics-1.1.3/mnpdf.m | 134 + octave_packages/statistics-1.1.3/mnrnd.m | 184 + .../statistics-1.1.3/monotone_smooth.m | 160 + octave_packages/statistics-1.1.3/mvncdf.m | 173 + octave_packages/statistics-1.1.3/mvnpdf.m | 132 + octave_packages/statistics-1.1.3/mvnrnd.m | 105 + octave_packages/statistics-1.1.3/mvtcdf.m | 166 + octave_packages/statistics-1.1.3/mvtrnd.m | 137 + octave_packages/statistics-1.1.3/nanmax.m | 53 + octave_packages/statistics-1.1.3/nanmean.m | 36 + octave_packages/statistics-1.1.3/nanmedian.m | 69 + octave_packages/statistics-1.1.3/nanmin.m | 54 + octave_packages/statistics-1.1.3/nanstd.m | 86 + octave_packages/statistics-1.1.3/nansum.m | 35 + octave_packages/statistics-1.1.3/nanvar.m | 65 + octave_packages/statistics-1.1.3/nbinstat.m | 124 + .../statistics-1.1.3/normalise_distribution.m | 299 + octave_packages/statistics-1.1.3/normplot.m | 75 + octave_packages/statistics-1.1.3/normstat.m | 122 + .../statistics-1.1.3/packinfo/.autoload | 0 .../statistics-1.1.3/packinfo/DESCRIPTION | 12 + .../statistics-1.1.3/packinfo/INDEX | 74 + .../statistics-1.1.3/packinfo/NEWS | 77 + octave_packages/statistics-1.1.3/pdist.m | 233 + octave_packages/statistics-1.1.3/poisstat.m | 92 + octave_packages/statistics-1.1.3/princomp.m | 51 + .../statistics-1.1.3/private/tbl_delim.m | 126 + octave_packages/statistics-1.1.3/random.m | 171 + octave_packages/statistics-1.1.3/raylcdf.m | 117 + octave_packages/statistics-1.1.3/raylinv.m | 123 + octave_packages/statistics-1.1.3/raylpdf.m | 116 + octave_packages/statistics-1.1.3/raylrnd.m | 157 + octave_packages/statistics-1.1.3/raylstat.m | 94 + octave_packages/statistics-1.1.3/regress.m | 214 + octave_packages/statistics-1.1.3/repanova.m | 100 + octave_packages/statistics-1.1.3/squareform.m | 94 + octave_packages/statistics-1.1.3/tabulate.m | 129 + octave_packages/statistics-1.1.3/tblread.m | 97 + octave_packages/statistics-1.1.3/tblwrite.m | 126 + octave_packages/statistics-1.1.3/trimmean.m | 58 + octave_packages/statistics-1.1.3/tstat.m | 98 + octave_packages/statistics-1.1.3/unidstat.m | 94 + octave_packages/statistics-1.1.3/unifstat.m | 122 + octave_packages/statistics-1.1.3/vmpdf.m | 46 + octave_packages/statistics-1.1.3/vmrnd.m | 76 + octave_packages/statistics-1.1.3/wblstat.m | 124 + octave_packages/strings-1.1.0/base64decode.m | 157 + octave_packages/strings-1.1.0/base64encode.m | 77 + octave_packages/strings-1.1.0/cstrcmp.m | 111 + octave_packages/strings-1.1.0/doc-cache | 240 + octave_packages/strings-1.1.0/editdistance.m | 79 + .../strings-1.1.0/packinfo/.autoload | 0 .../strings-1.1.0/packinfo/DESCRIPTION | 12 + octave_packages/strings-1.1.0/packinfo/INDEX | 11 + octave_packages/strings-1.1.0/packinfo/NEWS | 13 + octave_packages/strings-1.1.0/strjoin.m | 54 + octave_packages/strings-1.1.0/strsort.m | 19 + octave_packages/struct-1.0.10/doc-cache | 117 + octave_packages/struct-1.0.10/getfields.m | 39 + .../struct-1.0.10/packinfo/.autoload | 0 .../struct-1.0.10/packinfo/DESCRIPTION | 12 + octave_packages/struct-1.0.10/packinfo/INDEX | 11 + octave_packages/struct-1.0.10/packinfo/NEWS | 7 + octave_packages/struct-1.0.10/setfields.m | 47 + octave_packages/struct-1.0.10/tars.m | 28 + octave_packages/struct-1.0.10/test_struct.m | 133 + octave_packages/symbolic-1.1.0/doc-cache | 214 + octave_packages/symbolic-1.1.0/findsym.m | 92 + .../symbolic-1.1.0/packinfo/.autoload | 0 .../symbolic-1.1.0/packinfo/DESCRIPTION | 12 + octave_packages/symbolic-1.1.0/packinfo/INDEX | 28 + octave_packages/symbolic-1.1.0/poly2sym.m | 63 + octave_packages/symbolic-1.1.0/splot.m | 32 + octave_packages/symbolic-1.1.0/sym2poly.m | 157 + octave_packages/symbolic-1.1.0/symfsolve.m | 171 + octave_packages/tsa-4.2.4/aar.m | 292 + octave_packages/tsa-4.2.4/aarmam.m | 240 + octave_packages/tsa-4.2.4/ac2poly.m | 40 + octave_packages/tsa-4.2.4/ac2rc.m | 39 + octave_packages/tsa-4.2.4/acorf.m | 70 + octave_packages/tsa-4.2.4/acovf.m | 147 + octave_packages/tsa-4.2.4/adim.m | 131 + octave_packages/tsa-4.2.4/amarma.m | 233 + octave_packages/tsa-4.2.4/ar2poly.m | 40 + octave_packages/tsa-4.2.4/ar2rc.m | 89 + octave_packages/tsa-4.2.4/ar_spa.m | 104 + octave_packages/tsa-4.2.4/arcext.m | 60 + octave_packages/tsa-4.2.4/arfit2.m | 143 + octave_packages/tsa-4.2.4/biacovf.m | 43 + octave_packages/tsa-4.2.4/bisdemo.m | 34 + octave_packages/tsa-4.2.4/bispec.m | 54 + octave_packages/tsa-4.2.4/content.m | 94 + octave_packages/tsa-4.2.4/contents.m | 114 + octave_packages/tsa-4.2.4/covm.m | 248 + octave_packages/tsa-4.2.4/detrend.m | 157 + octave_packages/tsa-4.2.4/doc-cache | 2575 ++++++++ octave_packages/tsa-4.2.4/durlev.m | 100 + octave_packages/tsa-4.2.4/eeg8s.mat | Bin 0 -> 8218 bytes .../tsa-4.2.4/flag_implicit_samplerate.m | 64 + .../tsa-4.2.4/flag_implicit_skip_nan.m | 65 + octave_packages/tsa-4.2.4/flix.m | 51 + octave_packages/tsa-4.2.4/histo.m | 73 + octave_packages/tsa-4.2.4/histo2.m | 97 + octave_packages/tsa-4.2.4/histo3.m | 153 + octave_packages/tsa-4.2.4/histo4.m | 97 + octave_packages/tsa-4.2.4/hup.m | 53 + octave_packages/tsa-4.2.4/invest0.m | 85 + octave_packages/tsa-4.2.4/invest1.m | 126 + octave_packages/tsa-4.2.4/invfdemo.m | 51 + octave_packages/tsa-4.2.4/lattice.m | 127 + octave_packages/tsa-4.2.4/lpc.m | 71 + octave_packages/tsa-4.2.4/mvaar.m | 174 + octave_packages/tsa-4.2.4/mvar.m | 1138 ++++ octave_packages/tsa-4.2.4/mvfilter.m | 111 + octave_packages/tsa-4.2.4/mvfreqz.m | 254 + octave_packages/tsa-4.2.4/pacf.m | 69 + .../tsa-4.2.4/packinfo/DESCRIPTION | 11 + octave_packages/tsa-4.2.4/packinfo/INDEX | 60 + octave_packages/tsa-4.2.4/parcor.m | 49 + octave_packages/tsa-4.2.4/poly2ac.m | 48 + octave_packages/tsa-4.2.4/poly2ar.m | 38 + octave_packages/tsa-4.2.4/poly2rc.m | 50 + octave_packages/tsa-4.2.4/rc2ac.m | 46 + octave_packages/tsa-4.2.4/rc2ar.m | 91 + octave_packages/tsa-4.2.4/rc2poly.m | 48 + octave_packages/tsa-4.2.4/rmle.m | 99 + octave_packages/tsa-4.2.4/sbispec.m | 35 + octave_packages/tsa-4.2.4/selmo.m | 146 + octave_packages/tsa-4.2.4/selmo2.m | 77 + octave_packages/tsa-4.2.4/sinvest1.m | 289 + octave_packages/tsa-4.2.4/sumskipnan.m | 193 + octave_packages/tsa-4.2.4/tsademo.m | 39 + octave_packages/tsa-4.2.4/ucp.m | 45 + octave_packages/tsa-4.2.4/y2res.m | 121 + octave_packages/vrml-1.0.13/best_dir.m | 184 + octave_packages/vrml-1.0.13/best_dir_cov.m | 121 + octave_packages/vrml-1.0.13/bound_convex.m | 111 + octave_packages/vrml-1.0.13/checker_color.m | 41 + octave_packages/vrml-1.0.13/doc-cache | 1663 +++++ .../vrml-1.0.13/packinfo/.autoload | 0 .../vrml-1.0.13/packinfo/DESCRIPTION | 12 + octave_packages/vrml-1.0.13/packinfo/INDEX | 38 + octave_packages/vrml-1.0.13/packinfo/NEWS | 32 + octave_packages/vrml-1.0.13/proplan.m | 35 + octave_packages/vrml-1.0.13/save_vrml.m | 119 + .../vrml-1.0.13/test_moving_surf.m | 70 + octave_packages/vrml-1.0.13/test_vmesh.m | 64 + octave_packages/vrml-1.0.13/test_vrml_faces.m | 125 + octave_packages/vrml-1.0.13/vmesh.m | 287 + octave_packages/vrml-1.0.13/vrml_Background.m | 84 + octave_packages/vrml-1.0.13/vrml_Box.m | 34 + .../vrml-1.0.13/vrml_DirectionalLight.m | 65 + octave_packages/vrml-1.0.13/vrml_PointLight.m | 74 + octave_packages/vrml-1.0.13/vrml_ROUTE.m | 20 + octave_packages/vrml-1.0.13/vrml_Sphere.m | 30 + octave_packages/vrml-1.0.13/vrml_TimeSensor.m | 162 + octave_packages/vrml-1.0.13/vrml_Viewpoint.m | 126 + octave_packages/vrml-1.0.13/vrml_anim.m | 45 + octave_packages/vrml-1.0.13/vrml_arrow.m | 118 + octave_packages/vrml-1.0.13/vrml_browse.m | 234 + octave_packages/vrml-1.0.13/vrml_cyl.m | 146 + .../vrml-1.0.13/vrml_demo_tutorial_1.m | 65 + .../vrml-1.0.13/vrml_demo_tutorial_2.m | 45 + .../vrml-1.0.13/vrml_demo_tutorial_3.m | 47 + .../vrml-1.0.13/vrml_demo_tutorial_4.m | 61 + octave_packages/vrml-1.0.13/vrml_ellipsoid.m | 81 + octave_packages/vrml-1.0.13/vrml_faces.m | 315 + octave_packages/vrml-1.0.13/vrml_flatten.m | 44 + octave_packages/vrml-1.0.13/vrml_frame.m | 148 + octave_packages/vrml-1.0.13/vrml_group.m | 44 + octave_packages/vrml-1.0.13/vrml_interp.m | 76 + octave_packages/vrml-1.0.13/vrml_kill.m | 36 + octave_packages/vrml-1.0.13/vrml_lines.m | 94 + octave_packages/vrml-1.0.13/vrml_material.m | 62 + octave_packages/vrml-1.0.13/vrml_newname.m | 36 + .../vrml-1.0.13/vrml_parallelepiped.m | 112 + .../vrml-1.0.13/vrml_parallelogram.m | 99 + octave_packages/vrml-1.0.13/vrml_points.m | 219 + octave_packages/vrml-1.0.13/vrml_surf.m | 506 ++ octave_packages/vrml-1.0.13/vrml_text.m | 83 + octave_packages/vrml-1.0.13/vrml_thick_surf.m | 183 + octave_packages/vrml-1.0.13/vrml_transfo.m | 115 + octave_packages/zenity-0.5.7/doc-cache | 372 ++ .../zenity-0.5.7/packinfo/.autoload | 0 .../zenity-0.5.7/packinfo/DESCRIPTION | 15 + octave_packages/zenity-0.5.7/packinfo/INDEX | 11 + .../zenity-0.5.7/zenity_calendar.m | 48 + octave_packages/zenity-0.5.7/zenity_entry.m | 48 + .../zenity-0.5.7/zenity_file_selection.m | 80 + octave_packages/zenity-0.5.7/zenity_list.m | 105 + octave_packages/zenity-0.5.7/zenity_message.m | 43 + .../zenity-0.5.7/zenity_notification.m | 43 + .../zenity-0.5.7/zenity_progress.m | 87 + octave_packages/zenity-0.5.7/zenity_scale.m | 71 + .../zenity-0.5.7/zenity_text_info.m | 54 + 2277 files changed, 304603 insertions(+) create mode 100644 octave_packages/audio-1.1.4/au.m create mode 100644 octave_packages/audio-1.1.4/auload.m create mode 100644 octave_packages/audio-1.1.4/auplot.m create mode 100644 octave_packages/audio-1.1.4/ausave.m create mode 100644 octave_packages/audio-1.1.4/clip.m create mode 100644 octave_packages/audio-1.1.4/doc-cache create mode 100644 octave_packages/audio-1.1.4/packinfo/.autoload create mode 100644 octave_packages/audio-1.1.4/packinfo/DESCRIPTION create mode 100644 octave_packages/audio-1.1.4/packinfo/INDEX create mode 100644 octave_packages/audio-1.1.4/sample.wav create mode 100644 octave_packages/audio-1.1.4/sound.m create mode 100644 octave_packages/audio-1.1.4/soundsc.m create mode 100644 octave_packages/benchmark-1.1.1/benchmark_dtmm.m create mode 100644 octave_packages/benchmark-1.1.1/benchmark_index.m create mode 100644 octave_packages/benchmark-1.1.1/benchmark_intmath.m create mode 100644 octave_packages/benchmark-1.1.1/benchmark_permute.m create mode 100644 octave_packages/benchmark-1.1.1/benchmark_stmm.m create mode 100644 octave_packages/benchmark-1.1.1/benchutil_average.m create mode 100644 octave_packages/benchmark-1.1.1/benchutil_default_arg.m create mode 100644 octave_packages/benchmark-1.1.1/benchutil_initialize.m create mode 100644 octave_packages/benchmark-1.1.1/benchutil_is_octave.m create mode 100644 octave_packages/benchmark-1.1.1/benchutil_parse_desc.m create mode 100644 octave_packages/benchmark-1.1.1/benchutil_set_result.m create mode 100644 octave_packages/benchmark-1.1.1/benchutil_verbose.m create mode 100644 octave_packages/benchmark-1.1.1/doc-cache create mode 100644 octave_packages/benchmark-1.1.1/packinfo/.autoload create mode 100644 octave_packages/benchmark-1.1.1/packinfo/DESCRIPTION create mode 100644 octave_packages/benchmark-1.1.1/packinfo/INDEX create mode 100644 octave_packages/communications-1.1.1/@galois/conv.m create mode 100644 octave_packages/communications-1.1.1/@galois/convmtx.m create mode 100644 octave_packages/communications-1.1.1/@galois/deconv.m create mode 100644 octave_packages/communications-1.1.1/@galois/det.m create mode 100644 octave_packages/communications-1.1.1/@galois/dftmtx.m create mode 100644 octave_packages/communications-1.1.1/@galois/diag.m create mode 100644 octave_packages/communications-1.1.1/@galois/exp.m create mode 100644 octave_packages/communications-1.1.1/@galois/fft.m create mode 100644 octave_packages/communications-1.1.1/@galois/filter.m create mode 100644 octave_packages/communications-1.1.1/@galois/ifft.m create mode 100644 octave_packages/communications-1.1.1/@galois/inv.m create mode 100644 octave_packages/communications-1.1.1/@galois/inverse.m create mode 100644 octave_packages/communications-1.1.1/@galois/isequal.m create mode 100644 octave_packages/communications-1.1.1/@galois/log.m create mode 100644 octave_packages/communications-1.1.1/@galois/lu.m create mode 100644 octave_packages/communications-1.1.1/@galois/prod.m create mode 100644 octave_packages/communications-1.1.1/@galois/rank.m create mode 100644 octave_packages/communications-1.1.1/@galois/reshape.m create mode 100644 octave_packages/communications-1.1.1/@galois/roots.m create mode 100644 octave_packages/communications-1.1.1/@galois/sqrt.m create mode 100644 octave_packages/communications-1.1.1/@galois/sum.m create mode 100644 octave_packages/communications-1.1.1/@galois/sumsq.m create mode 100644 octave_packages/communications-1.1.1/ademodce.m create mode 100644 octave_packages/communications-1.1.1/amdemod.m create mode 100644 octave_packages/communications-1.1.1/ammod.m create mode 100644 octave_packages/communications-1.1.1/amodce.m create mode 100644 octave_packages/communications-1.1.1/apkconst.m create mode 100644 octave_packages/communications-1.1.1/awgn.m create mode 100644 octave_packages/communications-1.1.1/bchpoly.m create mode 100644 octave_packages/communications-1.1.1/bi2de.m create mode 100644 octave_packages/communications-1.1.1/biterr.m create mode 100644 octave_packages/communications-1.1.1/bsc.m create mode 100644 octave_packages/communications-1.1.1/comms.m create mode 100644 octave_packages/communications-1.1.1/compand.m create mode 100644 octave_packages/communications-1.1.1/convenc.m create mode 100644 octave_packages/communications-1.1.1/cosets.m create mode 100644 octave_packages/communications-1.1.1/de2bi.m create mode 100644 octave_packages/communications-1.1.1/decode.m create mode 100644 octave_packages/communications-1.1.1/deintrlv.m create mode 100644 octave_packages/communications-1.1.1/demodmap.m create mode 100644 octave_packages/communications-1.1.1/doc-cache create mode 100644 octave_packages/communications-1.1.1/egolaydec.m create mode 100644 octave_packages/communications-1.1.1/egolayenc.m create mode 100644 octave_packages/communications-1.1.1/egolaygen.m create mode 100644 octave_packages/communications-1.1.1/encode.m create mode 100644 octave_packages/communications-1.1.1/eyediagram.m create mode 100644 octave_packages/communications-1.1.1/fibodeco.m create mode 100644 octave_packages/communications-1.1.1/fiboenco.m create mode 100644 octave_packages/communications-1.1.1/fibosplitstream.m create mode 100644 octave_packages/communications-1.1.1/fmdemod.m create mode 100644 octave_packages/communications-1.1.1/fmmod.m create mode 100644 octave_packages/communications-1.1.1/gen2par.m create mode 100644 octave_packages/communications-1.1.1/genqamdemod.m create mode 100644 octave_packages/communications-1.1.1/genqammod.m create mode 100644 octave_packages/communications-1.1.1/gftable.m create mode 100644 octave_packages/communications-1.1.1/gfweight.m create mode 100644 octave_packages/communications-1.1.1/golombdeco.m create mode 100644 octave_packages/communications-1.1.1/golombenco.m create mode 100644 octave_packages/communications-1.1.1/hammgen.m create mode 100644 octave_packages/communications-1.1.1/helintrlv.m create mode 100644 octave_packages/communications-1.1.1/helscandeintrlv.m create mode 100644 octave_packages/communications-1.1.1/helscanintrlv.m create mode 100644 octave_packages/communications-1.1.1/huffmandeco.m create mode 100644 octave_packages/communications-1.1.1/huffmandict.m create mode 100644 octave_packages/communications-1.1.1/huffmanenco.m create mode 100644 octave_packages/communications-1.1.1/intrlv.m create mode 100644 octave_packages/communications-1.1.1/lloyds.m create mode 100644 octave_packages/communications-1.1.1/lz77deco.m create mode 100644 octave_packages/communications-1.1.1/lz77enco.m create mode 100644 octave_packages/communications-1.1.1/matdeintrlv.m create mode 100644 octave_packages/communications-1.1.1/matintrlv.m create mode 100644 octave_packages/communications-1.1.1/minpol.m create mode 100644 octave_packages/communications-1.1.1/modmap.m create mode 100644 octave_packages/communications-1.1.1/oct2dec.m create mode 100644 octave_packages/communications-1.1.1/packinfo/.autoload create mode 100644 octave_packages/communications-1.1.1/packinfo/DESCRIPTION create mode 100644 octave_packages/communications-1.1.1/packinfo/INDEX create mode 100644 octave_packages/communications-1.1.1/packinfo/NEWS create mode 100644 octave_packages/communications-1.1.1/pamdemod.m create mode 100644 octave_packages/communications-1.1.1/pammod.m create mode 100644 octave_packages/communications-1.1.1/prbs_generator.m create mode 100644 octave_packages/communications-1.1.1/prbs_iterator.m create mode 100644 octave_packages/communications-1.1.1/prbs_sequence.m create mode 100644 octave_packages/communications-1.1.1/pskdemod.m create mode 100644 octave_packages/communications-1.1.1/pskmod.m create mode 100644 octave_packages/communications-1.1.1/qamdemod.m create mode 100644 octave_packages/communications-1.1.1/qammod.m create mode 100644 octave_packages/communications-1.1.1/qaskdeco.m create mode 100644 octave_packages/communications-1.1.1/qaskenco.m create mode 100644 octave_packages/communications-1.1.1/qfunc.m create mode 100644 octave_packages/communications-1.1.1/qfuncinv.m create mode 100644 octave_packages/communications-1.1.1/quantiz.m create mode 100644 octave_packages/communications-1.1.1/randdeintrlv.m create mode 100644 octave_packages/communications-1.1.1/randerr.m create mode 100644 octave_packages/communications-1.1.1/randint.m create mode 100644 octave_packages/communications-1.1.1/randintrlv.m create mode 100644 octave_packages/communications-1.1.1/randsrc.m create mode 100644 octave_packages/communications-1.1.1/reedmullerdec.m create mode 100644 octave_packages/communications-1.1.1/reedmullerenc.m create mode 100644 octave_packages/communications-1.1.1/reedmullergen.m create mode 100644 octave_packages/communications-1.1.1/ricedeco.m create mode 100644 octave_packages/communications-1.1.1/riceenco.m create mode 100644 octave_packages/communications-1.1.1/rledeco.m create mode 100644 octave_packages/communications-1.1.1/rleenco.m create mode 100644 octave_packages/communications-1.1.1/rsdecof.m create mode 100644 octave_packages/communications-1.1.1/rsencof.m create mode 100644 octave_packages/communications-1.1.1/rsgenpoly.m create mode 100644 octave_packages/communications-1.1.1/scatterplot.m create mode 100644 octave_packages/communications-1.1.1/shannonfanodeco.m create mode 100644 octave_packages/communications-1.1.1/shannonfanodict.m create mode 100644 octave_packages/communications-1.1.1/shannonfanoenco.m create mode 100644 octave_packages/communications-1.1.1/symerr.m create mode 100644 octave_packages/communications-1.1.1/systematize.m create mode 100644 octave_packages/communications-1.1.1/vec2mat.m create mode 100644 octave_packages/communications-1.1.1/wgn.m create mode 100644 octave_packages/control-2.3.52/@frd/__c2d__.m create mode 100644 octave_packages/control-2.3.52/@frd/__ctranspose__.m create mode 100644 octave_packages/control-2.3.52/@frd/__d2c__.m create mode 100644 octave_packages/control-2.3.52/@frd/__freqresp__.m create mode 100644 octave_packages/control-2.3.52/@frd/__get__.m create mode 100644 octave_packages/control-2.3.52/@frd/__minreal__.m create mode 100644 octave_packages/control-2.3.52/@frd/__pole__.m create mode 100644 octave_packages/control-2.3.52/@frd/__property_names__.m create mode 100644 octave_packages/control-2.3.52/@frd/__set__.m create mode 100644 octave_packages/control-2.3.52/@frd/__sys2ss__.m create mode 100644 octave_packages/control-2.3.52/@frd/__sys2tf__.m create mode 100644 octave_packages/control-2.3.52/@frd/__sys_connect__.m create mode 100644 octave_packages/control-2.3.52/@frd/__sys_data__.m create mode 100644 octave_packages/control-2.3.52/@frd/__sys_group__.m create mode 100644 octave_packages/control-2.3.52/@frd/__sys_inverse__.m create mode 100644 octave_packages/control-2.3.52/@frd/__sys_prune__.m create mode 100644 octave_packages/control-2.3.52/@frd/__transpose__.m create mode 100644 octave_packages/control-2.3.52/@frd/__zero__.m create mode 100644 octave_packages/control-2.3.52/@frd/display.m create mode 100644 octave_packages/control-2.3.52/@frd/frd.m create mode 100644 octave_packages/control-2.3.52/@lti/__lti_data__.m create mode 100644 octave_packages/control-2.3.52/@lti/__lti_group__.m create mode 100644 octave_packages/control-2.3.52/@lti/__lti_prune__.m create mode 100644 octave_packages/control-2.3.52/@lti/__property_names__.m create mode 100644 octave_packages/control-2.3.52/@lti/append.m create mode 100644 octave_packages/control-2.3.52/@lti/blkdiag.m create mode 100644 octave_packages/control-2.3.52/@lti/c2d.m create mode 100644 octave_packages/control-2.3.52/@lti/connect.m create mode 100644 octave_packages/control-2.3.52/@lti/ctranspose.m create mode 100644 octave_packages/control-2.3.52/@lti/d2c.m create mode 100644 octave_packages/control-2.3.52/@lti/dcgain.m create mode 100644 octave_packages/control-2.3.52/@lti/display.m create mode 100644 octave_packages/control-2.3.52/@lti/dss.m create mode 100644 octave_packages/control-2.3.52/@lti/dssdata.m create mode 100644 octave_packages/control-2.3.52/@lti/eig.m create mode 100644 octave_packages/control-2.3.52/@lti/feedback.m create mode 100644 octave_packages/control-2.3.52/@lti/filtdata.m create mode 100644 octave_packages/control-2.3.52/@lti/frdata.m create mode 100644 octave_packages/control-2.3.52/@lti/freqresp.m create mode 100644 octave_packages/control-2.3.52/@lti/get.m create mode 100644 octave_packages/control-2.3.52/@lti/horzcat.m create mode 100644 octave_packages/control-2.3.52/@lti/inv.m create mode 100644 octave_packages/control-2.3.52/@lti/isct.m create mode 100644 octave_packages/control-2.3.52/@lti/isdt.m create mode 100644 octave_packages/control-2.3.52/@lti/isminimumphase.m create mode 100644 octave_packages/control-2.3.52/@lti/issiso.m create mode 100644 octave_packages/control-2.3.52/@lti/isstable.m create mode 100644 octave_packages/control-2.3.52/@lti/lft.m create mode 100644 octave_packages/control-2.3.52/@lti/lti.m create mode 100644 octave_packages/control-2.3.52/@lti/mconnect.m create mode 100644 octave_packages/control-2.3.52/@lti/minreal.m create mode 100644 octave_packages/control-2.3.52/@lti/minus.m create mode 100644 octave_packages/control-2.3.52/@lti/mldivide.m create mode 100644 octave_packages/control-2.3.52/@lti/mpower.m create mode 100644 octave_packages/control-2.3.52/@lti/mrdivide.m create mode 100644 octave_packages/control-2.3.52/@lti/mtimes.m create mode 100644 octave_packages/control-2.3.52/@lti/norm.m create mode 100644 octave_packages/control-2.3.52/@lti/parallel.m create mode 100644 octave_packages/control-2.3.52/@lti/plus.m create mode 100644 octave_packages/control-2.3.52/@lti/pole.m create mode 100644 octave_packages/control-2.3.52/@lti/prescale.m create mode 100644 octave_packages/control-2.3.52/@lti/series.m create mode 100644 octave_packages/control-2.3.52/@lti/set.m create mode 100644 octave_packages/control-2.3.52/@lti/size.m create mode 100644 octave_packages/control-2.3.52/@lti/sminreal.m create mode 100644 octave_packages/control-2.3.52/@lti/ssdata.m create mode 100644 octave_packages/control-2.3.52/@lti/subsasgn.m create mode 100644 octave_packages/control-2.3.52/@lti/subsref.m create mode 100644 octave_packages/control-2.3.52/@lti/tfdata.m create mode 100644 octave_packages/control-2.3.52/@lti/transpose.m create mode 100644 octave_packages/control-2.3.52/@lti/uminus.m create mode 100644 octave_packages/control-2.3.52/@lti/uplus.m create mode 100644 octave_packages/control-2.3.52/@lti/vertcat.m create mode 100644 octave_packages/control-2.3.52/@lti/xperm.m create mode 100644 octave_packages/control-2.3.52/@lti/zero.m create mode 100644 octave_packages/control-2.3.52/@lti/zpkdata.m create mode 100644 octave_packages/control-2.3.52/@ss/__c2d__.m create mode 100644 octave_packages/control-2.3.52/@ss/__ctranspose__.m create mode 100644 octave_packages/control-2.3.52/@ss/__d2c__.m create mode 100644 octave_packages/control-2.3.52/@ss/__freqresp__.m create mode 100644 octave_packages/control-2.3.52/@ss/__get__.m create mode 100644 octave_packages/control-2.3.52/@ss/__minreal__.m create mode 100644 octave_packages/control-2.3.52/@ss/__pole__.m create mode 100644 octave_packages/control-2.3.52/@ss/__prescale__.m create mode 100644 octave_packages/control-2.3.52/@ss/__property_names__.m create mode 100644 octave_packages/control-2.3.52/@ss/__set__.m create mode 100644 octave_packages/control-2.3.52/@ss/__sys2frd__.m create mode 100644 octave_packages/control-2.3.52/@ss/__sys2tf__.m create mode 100644 octave_packages/control-2.3.52/@ss/__sys_connect__.m create mode 100644 octave_packages/control-2.3.52/@ss/__sys_data__.m create mode 100644 octave_packages/control-2.3.52/@ss/__sys_group__.m create mode 100644 octave_packages/control-2.3.52/@ss/__sys_inverse__.m create mode 100644 octave_packages/control-2.3.52/@ss/__sys_prune__.m create mode 100644 octave_packages/control-2.3.52/@ss/__transpose__.m create mode 100644 octave_packages/control-2.3.52/@ss/__zero__.m create mode 100644 octave_packages/control-2.3.52/@ss/display.m create mode 100644 octave_packages/control-2.3.52/@ss/ss.m create mode 100644 octave_packages/control-2.3.52/@tf/__c2d__.m create mode 100644 octave_packages/control-2.3.52/@tf/__ctranspose__.m create mode 100644 octave_packages/control-2.3.52/@tf/__d2c__.m create mode 100644 octave_packages/control-2.3.52/@tf/__freqresp__.m create mode 100644 octave_packages/control-2.3.52/@tf/__get__.m create mode 100644 octave_packages/control-2.3.52/@tf/__minreal__.m create mode 100644 octave_packages/control-2.3.52/@tf/__pole__.m create mode 100644 octave_packages/control-2.3.52/@tf/__property_names__.m create mode 100644 octave_packages/control-2.3.52/@tf/__set__.m create mode 100644 octave_packages/control-2.3.52/@tf/__sys2frd__.m create mode 100644 octave_packages/control-2.3.52/@tf/__sys2ss__.m create mode 100644 octave_packages/control-2.3.52/@tf/__sys_connect__.m create mode 100644 octave_packages/control-2.3.52/@tf/__sys_data__.m create mode 100644 octave_packages/control-2.3.52/@tf/__sys_group__.m create mode 100644 octave_packages/control-2.3.52/@tf/__sys_inverse__.m create mode 100644 octave_packages/control-2.3.52/@tf/__sys_prune__.m create mode 100644 octave_packages/control-2.3.52/@tf/__transpose__.m create mode 100644 octave_packages/control-2.3.52/@tf/__zero__.m create mode 100644 octave_packages/control-2.3.52/@tf/display.m create mode 100644 octave_packages/control-2.3.52/@tf/tf.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/__make_equally_long__.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/__remove_leading_zeros__.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/conj_ct.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/conj_dt.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/display.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/eq.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/get.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/length.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/minus.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/mpower.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/mtimes.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/ne.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/numel.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/plus.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/roots.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/subsref.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/tfpoly.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/tfpoly2str.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/uminus.m create mode 100644 octave_packages/control-2.3.52/@tfpoly/uplus.m create mode 100644 octave_packages/control-2.3.52/Anderson.m create mode 100644 octave_packages/control-2.3.52/BMWengine.m create mode 100644 octave_packages/control-2.3.52/Boeing707.m create mode 100644 octave_packages/control-2.3.52/MDSSystem.m create mode 100644 octave_packages/control-2.3.52/Madievski.m create mode 100644 octave_packages/control-2.3.52/WestlandLynx.m create mode 100644 octave_packages/control-2.3.52/__adjust_frd_data__.m create mode 100644 octave_packages/control-2.3.52/__adjust_labels__.m create mode 100644 octave_packages/control-2.3.52/__adjust_ss_data__.m create mode 100644 octave_packages/control-2.3.52/__axis_limits__.m create mode 100644 octave_packages/control-2.3.52/__axis_margin__.m create mode 100644 octave_packages/control-2.3.52/__conred_check_feedback_sign__.m create mode 100644 octave_packages/control-2.3.52/__conred_sb16ad__.m create mode 100644 octave_packages/control-2.3.52/__dss2ss__.m create mode 100644 octave_packages/control-2.3.52/__dss_bilin__.m create mode 100644 octave_packages/control-2.3.52/__frd_dim__.m create mode 100644 octave_packages/control-2.3.52/__frequency_response__.m create mode 100644 octave_packages/control-2.3.52/__frequency_vector__.m create mode 100644 octave_packages/control-2.3.52/__is_stable__.m create mode 100644 octave_packages/control-2.3.52/__labels__.m create mode 100644 octave_packages/control-2.3.52/__modred_ab09id__.m create mode 100644 octave_packages/control-2.3.52/__modred_check_alpha__.m create mode 100644 octave_packages/control-2.3.52/__modred_check_alpha_gram__.m create mode 100644 octave_packages/control-2.3.52/__modred_check_equil__.m create mode 100644 octave_packages/control-2.3.52/__modred_check_gram__.m create mode 100644 octave_packages/control-2.3.52/__modred_check_order__.m create mode 100644 octave_packages/control-2.3.52/__modred_check_tol__.m create mode 100644 octave_packages/control-2.3.52/__modred_check_weight__.m create mode 100644 octave_packages/control-2.3.52/__modred_default_alpha__.m create mode 100644 octave_packages/control-2.3.52/__opt2cell__.m create mode 100644 octave_packages/control-2.3.52/__remove_trailing_zeros__.m create mode 100644 octave_packages/control-2.3.52/__ss_dim__.m create mode 100644 octave_packages/control-2.3.52/__tf_dim__.m create mode 100644 octave_packages/control-2.3.52/__time_response__.m create mode 100644 octave_packages/control-2.3.52/__vec2tfpoly__.m create mode 100644 octave_packages/control-2.3.52/augw.m create mode 100644 octave_packages/control-2.3.52/bode.m create mode 100644 octave_packages/control-2.3.52/bodemag.m create mode 100644 octave_packages/control-2.3.52/bstmodred.m create mode 100644 octave_packages/control-2.3.52/btaconred.m create mode 100644 octave_packages/control-2.3.52/btamodred.m create mode 100644 octave_packages/control-2.3.52/care.m create mode 100644 octave_packages/control-2.3.52/cfconred.m create mode 100644 octave_packages/control-2.3.52/covar.m create mode 100644 octave_packages/control-2.3.52/ctrb.m create mode 100644 octave_packages/control-2.3.52/ctrbf.m create mode 100644 octave_packages/control-2.3.52/dare.m create mode 100644 octave_packages/control-2.3.52/dlqe.m create mode 100644 octave_packages/control-2.3.52/dlqr.m create mode 100644 octave_packages/control-2.3.52/dlyap.m create mode 100644 octave_packages/control-2.3.52/dlyapchol.m create mode 100644 octave_packages/control-2.3.52/doc-cache create mode 100644 octave_packages/control-2.3.52/dss.m create mode 100644 octave_packages/control-2.3.52/estim.m create mode 100644 octave_packages/control-2.3.52/filt.m create mode 100644 octave_packages/control-2.3.52/fitfrd.m create mode 100644 octave_packages/control-2.3.52/fwcfconred.m create mode 100644 octave_packages/control-2.3.52/gensig.m create mode 100644 octave_packages/control-2.3.52/gram.m create mode 100644 octave_packages/control-2.3.52/h2syn.m create mode 100644 octave_packages/control-2.3.52/hinfsyn.m create mode 100644 octave_packages/control-2.3.52/hnamodred.m create mode 100644 octave_packages/control-2.3.52/hsvd.m create mode 100644 octave_packages/control-2.3.52/impulse.m create mode 100644 octave_packages/control-2.3.52/initial.m create mode 100644 octave_packages/control-2.3.52/isctrb.m create mode 100644 octave_packages/control-2.3.52/isdetectable.m create mode 100644 octave_packages/control-2.3.52/isobsv.m create mode 100644 octave_packages/control-2.3.52/issample.m create mode 100644 octave_packages/control-2.3.52/isstabilizable.m create mode 100644 octave_packages/control-2.3.52/kalman.m create mode 100644 octave_packages/control-2.3.52/lqe.m create mode 100644 octave_packages/control-2.3.52/lqr.m create mode 100644 octave_packages/control-2.3.52/lsim.m create mode 100644 octave_packages/control-2.3.52/ltimodels.m create mode 100644 octave_packages/control-2.3.52/lyap.m create mode 100644 octave_packages/control-2.3.52/lyapchol.m create mode 100644 octave_packages/control-2.3.52/margin.m create mode 100644 octave_packages/control-2.3.52/mixsyn.m create mode 100644 octave_packages/control-2.3.52/ncfsyn.m create mode 100644 octave_packages/control-2.3.52/nichols.m create mode 100644 octave_packages/control-2.3.52/nyquist.m create mode 100644 octave_packages/control-2.3.52/obsv.m create mode 100644 octave_packages/control-2.3.52/obsvf.m create mode 100644 octave_packages/control-2.3.52/optiPID.m create mode 100644 octave_packages/control-2.3.52/optiPIDctrl.m create mode 100644 octave_packages/control-2.3.52/optiPIDfun.m create mode 100644 octave_packages/control-2.3.52/options.m create mode 100644 octave_packages/control-2.3.52/packinfo/.autoload create mode 100644 octave_packages/control-2.3.52/packinfo/DESCRIPTION create mode 100644 octave_packages/control-2.3.52/packinfo/INDEX create mode 100644 octave_packages/control-2.3.52/packinfo/NEWS create mode 100644 octave_packages/control-2.3.52/place.m create mode 100644 octave_packages/control-2.3.52/pzmap.m create mode 100644 octave_packages/control-2.3.52/rlocus.m create mode 100644 octave_packages/control-2.3.52/sigma.m create mode 100644 octave_packages/control-2.3.52/spaconred.m create mode 100644 octave_packages/control-2.3.52/spamodred.m create mode 100644 octave_packages/control-2.3.52/step.m create mode 100644 octave_packages/control-2.3.52/strseq.m create mode 100644 octave_packages/control-2.3.52/test_control.m create mode 100644 octave_packages/control-2.3.52/tfpoly2str.m create mode 100644 octave_packages/control-2.3.52/tfpolyones.m create mode 100644 octave_packages/control-2.3.52/tfpolyzeros.m create mode 100644 octave_packages/control-2.3.52/zpk.m create mode 100644 octave_packages/data-smoothing-1.3.0/ddmat.m create mode 100644 octave_packages/data-smoothing-1.3.0/doc-cache create mode 100644 octave_packages/data-smoothing-1.3.0/packinfo/.autoload create mode 100644 octave_packages/data-smoothing-1.3.0/packinfo/DESCRIPTION create mode 100644 octave_packages/data-smoothing-1.3.0/packinfo/INDEX create mode 100644 octave_packages/data-smoothing-1.3.0/packinfo/NEWS create mode 100644 octave_packages/data-smoothing-1.3.0/regdatasmooth.m create mode 100644 octave_packages/data-smoothing-1.3.0/rgdtsmcore.m create mode 100644 octave_packages/data-smoothing-1.3.0/rgdtsmcorewrap.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/abs.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/acos.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/acosh.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/and.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/angle.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/arg.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/asin.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/asinh.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/atan.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/atanh.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/bsxfun.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/cat.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/ceil.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/columns.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/conj.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/cos.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/cosh.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/cumprod.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/cumsum.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/dataframe.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/display.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/end.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/eq.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/erf.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/erfc.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/erfcx.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/erfinv.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/exp.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/expm1.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/find.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/finite.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/fix.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/floor.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/fold.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/gamma.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/ge.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/gt.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/horzcat.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/imag.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/inv.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/ipermute.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/isempty.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/isfield.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/isinf.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/ismatrix.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/isna.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/isnan.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/isnumeric.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/isscalar.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/isvector.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/kron.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/ldivide.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/le.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/lgamma.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/log.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/log10.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/log1p.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/log2.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/lt.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/max.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/min.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/minus.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/mldivide.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/mrdivide.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/mtimes.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/ndims.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/ne.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/not.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/or.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/permute.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/plus.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/power.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_allmeta.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_basecomp.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_check_char_array.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_colmeta.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_cow.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_func.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_mapper.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_mapper2.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_matassign.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_name2idx.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_pad.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_strjust.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_strset.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_thirddim.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/private/df_whole.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/prod.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/rationale.txt create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/rdivide.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/real.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/repmat.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/reshape.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/round.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/roundb.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/rows.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/signum.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/sin.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/sinh.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/size.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/sort.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/sqrt.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/subsasgn.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/subsindex.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/subsref.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/sum.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/summary.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/sumsq.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/tan.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/tanh.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/times.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/uminus.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/uplus.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/vertcat.m create mode 100644 octave_packages/dataframe-0.9.1/@dataframe/xor.m create mode 100644 octave_packages/dataframe-0.9.1/data_test.csv create mode 100644 octave_packages/dataframe-0.9.1/dataframe create mode 100644 octave_packages/dataframe-0.9.1/packinfo/DESCRIPTION create mode 100644 octave_packages/dataframe-0.9.1/packinfo/INDEX create mode 100644 octave_packages/dataframe-0.9.1/packinfo/NEWS create mode 100644 octave_packages/econometrics-1.0.8/__kernel_epanechnikov.m create mode 100644 octave_packages/econometrics-1.0.8/__kernel_normal.m create mode 100644 octave_packages/econometrics-1.0.8/__kernel_weights.m create mode 100644 octave_packages/econometrics-1.0.8/average_moments.m create mode 100644 octave_packages/econometrics-1.0.8/delta_method.m create mode 100644 octave_packages/econometrics-1.0.8/doc-cache create mode 100644 octave_packages/econometrics-1.0.8/gmm_estimate.m create mode 100644 octave_packages/econometrics-1.0.8/gmm_example.m create mode 100644 octave_packages/econometrics-1.0.8/gmm_obj.m create mode 100644 octave_packages/econometrics-1.0.8/gmm_results.m create mode 100644 octave_packages/econometrics-1.0.8/gmm_variance.m create mode 100644 octave_packages/econometrics-1.0.8/gmm_variance_inefficient.m create mode 100644 octave_packages/econometrics-1.0.8/kernel_density.m create mode 100644 octave_packages/econometrics-1.0.8/kernel_density_cvscore.m create mode 100644 octave_packages/econometrics-1.0.8/kernel_density_nodes.m create mode 100644 octave_packages/econometrics-1.0.8/kernel_example.m create mode 100644 octave_packages/econometrics-1.0.8/kernel_optimal_bandwidth.m create mode 100644 octave_packages/econometrics-1.0.8/kernel_regression.m create mode 100644 octave_packages/econometrics-1.0.8/kernel_regression_cvscore.m create mode 100644 octave_packages/econometrics-1.0.8/kernel_regression_nodes.m create mode 100644 octave_packages/econometrics-1.0.8/mle_estimate.m create mode 100644 octave_packages/econometrics-1.0.8/mle_example.m create mode 100644 octave_packages/econometrics-1.0.8/mle_obj.m create mode 100644 octave_packages/econometrics-1.0.8/mle_obj_nodes.m create mode 100644 octave_packages/econometrics-1.0.8/mle_results.m create mode 100644 octave_packages/econometrics-1.0.8/mle_variance.m create mode 100644 octave_packages/econometrics-1.0.8/nls_estimate.m create mode 100644 octave_packages/econometrics-1.0.8/nls_example.m create mode 100644 octave_packages/econometrics-1.0.8/nls_obj.m create mode 100644 octave_packages/econometrics-1.0.8/nls_obj_nodes.m create mode 100644 octave_packages/econometrics-1.0.8/packinfo/.autoload create mode 100644 octave_packages/econometrics-1.0.8/packinfo/DESCRIPTION create mode 100644 octave_packages/econometrics-1.0.8/packinfo/INDEX create mode 100644 octave_packages/econometrics-1.0.8/parameterize.m create mode 100644 octave_packages/econometrics-1.0.8/poisson.m create mode 100644 octave_packages/econometrics-1.0.8/poisson_moments.m create mode 100644 octave_packages/econometrics-1.0.8/prettyprint.m create mode 100644 octave_packages/econometrics-1.0.8/prettyprint_c.m create mode 100644 octave_packages/econometrics-1.0.8/scale_data.m create mode 100644 octave_packages/econometrics-1.0.8/sum_moments_nodes.m create mode 100644 octave_packages/econometrics-1.0.8/unscale_parameters.m create mode 100644 octave_packages/financial-0.4.0/bolling.m create mode 100644 octave_packages/financial-0.4.0/busdate.m create mode 100644 octave_packages/financial-0.4.0/busdays.m create mode 100644 octave_packages/financial-0.4.0/cfconv.m create mode 100644 octave_packages/financial-0.4.0/cfdur.m create mode 100644 octave_packages/financial-0.4.0/corr2cov.m create mode 100644 octave_packages/financial-0.4.0/cov2corr.m create mode 100644 octave_packages/financial-0.4.0/dateaxis.m create mode 100644 octave_packages/financial-0.4.0/datefind.m create mode 100644 octave_packages/financial-0.4.0/datesplit.m create mode 100644 octave_packages/financial-0.4.0/day.m create mode 100644 octave_packages/financial-0.4.0/daysact.m create mode 100644 octave_packages/financial-0.4.0/doc-cache create mode 100644 octave_packages/financial-0.4.0/easter.m create mode 100644 octave_packages/financial-0.4.0/effrr.m create mode 100644 octave_packages/financial-0.4.0/eomdate.m create mode 100644 octave_packages/financial-0.4.0/fbusdate.m create mode 100644 octave_packages/financial-0.4.0/fetch.m create mode 100644 octave_packages/financial-0.4.0/fv.m create mode 100644 octave_packages/financial-0.4.0/fvl.m create mode 100644 octave_packages/financial-0.4.0/google.m create mode 100644 octave_packages/financial-0.4.0/hhigh.m create mode 100644 octave_packages/financial-0.4.0/highlow.m create mode 100644 octave_packages/financial-0.4.0/holidays.m create mode 100644 octave_packages/financial-0.4.0/hour.m create mode 100644 octave_packages/financial-0.4.0/irr.m create mode 100644 octave_packages/financial-0.4.0/isbusday.m create mode 100644 octave_packages/financial-0.4.0/lbusdate.m create mode 100644 octave_packages/financial-0.4.0/llow.m create mode 100644 octave_packages/financial-0.4.0/lweekdate.m create mode 100644 octave_packages/financial-0.4.0/m2xdate.m create mode 100644 octave_packages/financial-0.4.0/minute.m create mode 100644 octave_packages/financial-0.4.0/mirr.m create mode 100644 octave_packages/financial-0.4.0/month.m create mode 100644 octave_packages/financial-0.4.0/months.m create mode 100644 octave_packages/financial-0.4.0/movavg.m create mode 100644 octave_packages/financial-0.4.0/negvolidx.m create mode 100644 octave_packages/financial-0.4.0/nomrr.m create mode 100644 octave_packages/financial-0.4.0/nper.m create mode 100644 octave_packages/financial-0.4.0/npv.m create mode 100644 octave_packages/financial-0.4.0/nweekdate.m create mode 100644 octave_packages/financial-0.4.0/onbalvol.m create mode 100644 octave_packages/financial-0.4.0/packinfo/.autoload create mode 100644 octave_packages/financial-0.4.0/packinfo/DESCRIPTION create mode 100644 octave_packages/financial-0.4.0/packinfo/INDEX create mode 100644 octave_packages/financial-0.4.0/packinfo/NEWS create mode 100644 octave_packages/financial-0.4.0/pmt.m create mode 100644 octave_packages/financial-0.4.0/pointfig.m create mode 100644 octave_packages/financial-0.4.0/posvolidx.m create mode 100644 octave_packages/financial-0.4.0/private/fetch_google.m create mode 100644 octave_packages/financial-0.4.0/private/fetch_yahoo.m create mode 100644 octave_packages/financial-0.4.0/pv.m create mode 100644 octave_packages/financial-0.4.0/pvl.m create mode 100644 octave_packages/financial-0.4.0/rate.m create mode 100644 octave_packages/financial-0.4.0/rsindex.m create mode 100644 octave_packages/financial-0.4.0/second.m create mode 100644 octave_packages/financial-0.4.0/taxedrr.m create mode 100644 octave_packages/financial-0.4.0/thirdwednesday.m create mode 100644 octave_packages/financial-0.4.0/today.m create mode 100644 octave_packages/financial-0.4.0/vol.m create mode 100644 octave_packages/financial-0.4.0/x2mdate.m create mode 100644 octave_packages/financial-0.4.0/yahoo.m create mode 100644 octave_packages/financial-0.4.0/year.m create mode 100644 octave_packages/financial-0.4.0/yeardays.m create mode 100644 octave_packages/fixed-0.7.10/PKG_ADD create mode 100644 octave_packages/fixed-0.7.10/concat.m create mode 100644 octave_packages/fixed-0.7.10/create_lookup_table.m create mode 100644 octave_packages/fixed-0.7.10/doc-cache create mode 100644 octave_packages/fixed-0.7.10/doc.info create mode 100644 octave_packages/fixed-0.7.10/fixedpoint.m create mode 100644 octave_packages/fixed-0.7.10/float.m create mode 100644 octave_packages/fixed-0.7.10/fsort.m create mode 100644 octave_packages/fixed-0.7.10/lookup_table.m create mode 100644 octave_packages/fixed-0.7.10/packinfo/.autoload create mode 100644 octave_packages/fixed-0.7.10/packinfo/DESCRIPTION create mode 100644 octave_packages/fixed-0.7.10/packinfo/INDEX create mode 100644 octave_packages/fpl-1.2.0/FPL2coloredgradient.net create mode 100644 octave_packages/fpl-1.2.0/FPL2coloredrubbersheet.net create mode 100644 octave_packages/fpl-1.2.0/FPL2dxappenddata.m create mode 100644 octave_packages/fpl-1.2.0/FPL2dxoutputdata.m create mode 100644 octave_packages/fpl-1.2.0/FPL2dxoutputtimeseries.m create mode 100644 octave_packages/fpl-1.2.0/FPL2pdequiver.m create mode 100644 octave_packages/fpl-1.2.0/FPL2pdequiver.net create mode 100644 octave_packages/fpl-1.2.0/FPL2pdeshowmesh.m create mode 100644 octave_packages/fpl-1.2.0/FPL2pdeshowmesh.net create mode 100644 octave_packages/fpl-1.2.0/FPL2pdesurf.m create mode 100644 octave_packages/fpl-1.2.0/FPL2ptcquiver.m create mode 100644 octave_packages/fpl-1.2.0/FPL2ptcquiver.net create mode 100644 octave_packages/fpl-1.2.0/FPL2ptcshowmesh.m create mode 100644 octave_packages/fpl-1.2.0/FPL2ptcshowmesh.net create mode 100644 octave_packages/fpl-1.2.0/FPL2ptcsurf.m create mode 100644 octave_packages/fpl-1.2.0/FPL2ptcsurf.net create mode 100644 octave_packages/fpl-1.2.0/FPL2showmesh.net create mode 100644 octave_packages/fpl-1.2.0/FPL2trspdesurf.m create mode 100644 octave_packages/fpl-1.2.0/FPL2trspdesurf.net create mode 100644 octave_packages/fpl-1.2.0/FPL2trsptcsurf.m create mode 100644 octave_packages/fpl-1.2.0/FPL2trsptcsurf.net create mode 100644 octave_packages/fpl-1.2.0/FPL2vtkoutputdata.m create mode 100644 octave_packages/fpl-1.2.0/FPL3dxoutputfield.m create mode 100644 octave_packages/fpl-1.2.0/FPL3dxoutputmesh.m create mode 100644 octave_packages/fpl-1.2.0/doc-cache create mode 100644 octave_packages/fpl-1.2.0/fpl_dx_write_field.m create mode 100644 octave_packages/fpl-1.2.0/fpl_dx_write_series.m create mode 100644 octave_packages/fpl-1.2.0/fpl_vtk_write_field.m create mode 100644 octave_packages/fpl-1.2.0/packinfo/.autoload create mode 100644 octave_packages/fpl-1.2.0/packinfo/DESCRIPTION create mode 100644 octave_packages/fpl-1.2.0/packinfo/INDEX create mode 100644 octave_packages/fpl-1.2.0/pdemesh.m create mode 100644 octave_packages/fpl-1.2.0/pdesurf.m create mode 100644 octave_packages/ga-0.10.0/__ga_crossoverfcn__.m create mode 100644 octave_packages/ga-0.10.0/__ga_initial_population__.m create mode 100644 octave_packages/ga-0.10.0/__ga_mutationfcn__.m create mode 100644 octave_packages/ga-0.10.0/__ga_popinitrange__.m create mode 100644 octave_packages/ga-0.10.0/__ga_problem__.m create mode 100644 octave_packages/ga-0.10.0/__ga_problem_private_state__.m create mode 100644 octave_packages/ga-0.10.0/__ga_problem_return_variables__.m create mode 100644 octave_packages/ga-0.10.0/__ga_problem_state_selection__.m create mode 100644 octave_packages/ga-0.10.0/__ga_problem_update_state_at_each_generation__.m create mode 100644 octave_packages/ga-0.10.0/__ga_scores__.m create mode 100644 octave_packages/ga-0.10.0/__ga_selectionfcn__.m create mode 100644 octave_packages/ga-0.10.0/__ga_stop__.m create mode 100644 octave_packages/ga-0.10.0/__gaoptimset_default_options__.m create mode 100644 octave_packages/ga-0.10.0/crossoverscattered.m create mode 100644 octave_packages/ga-0.10.0/doc-cache create mode 100644 octave_packages/ga-0.10.0/fitscalingrank.m create mode 100644 octave_packages/ga-0.10.0/ga.m create mode 100644 octave_packages/ga-0.10.0/gacreationuniform.m create mode 100644 octave_packages/ga-0.10.0/gaoptimset.m create mode 100644 octave_packages/ga-0.10.0/mutationgaussian.m create mode 100644 octave_packages/ga-0.10.0/packinfo/.autoload create mode 100644 octave_packages/ga-0.10.0/packinfo/DESCRIPTION create mode 100644 octave_packages/ga-0.10.0/packinfo/INDEX create mode 100644 octave_packages/ga-0.10.0/packinfo/NEWS create mode 100644 octave_packages/ga-0.10.0/rastriginsfcn.m create mode 100644 octave_packages/ga-0.10.0/selectionstochunif.m create mode 100644 octave_packages/ga-0.10.0/test_ga.m create mode 100644 octave_packages/general-1.3.1/@dict/dict.m create mode 100644 octave_packages/general-1.3.1/@dict/display.m create mode 100644 octave_packages/general-1.3.1/@dict/end.m create mode 100644 octave_packages/general-1.3.1/@dict/get.m create mode 100644 octave_packages/general-1.3.1/@dict/has.m create mode 100644 octave_packages/general-1.3.1/@dict/isempty.m create mode 100644 octave_packages/general-1.3.1/@dict/join.m create mode 100644 octave_packages/general-1.3.1/@dict/length.m create mode 100644 octave_packages/general-1.3.1/@dict/struct.m create mode 100644 octave_packages/general-1.3.1/@dict/subsasgn.m create mode 100644 octave_packages/general-1.3.1/@dict/subsref.m create mode 100644 octave_packages/general-1.3.1/@inputParser/addOptional.m create mode 100644 octave_packages/general-1.3.1/@inputParser/addParamValue.m create mode 100644 octave_packages/general-1.3.1/@inputParser/addRequired.m create mode 100644 octave_packages/general-1.3.1/@inputParser/addSwitch.m create mode 100644 octave_packages/general-1.3.1/@inputParser/createCopy.m create mode 100644 octave_packages/general-1.3.1/@inputParser/display.m create mode 100644 octave_packages/general-1.3.1/@inputParser/inputParser.m create mode 100644 octave_packages/general-1.3.1/@inputParser/parse.m create mode 100644 octave_packages/general-1.3.1/@inputParser/subsasgn.m create mode 100644 octave_packages/general-1.3.1/@inputParser/subsref.m create mode 100644 octave_packages/general-1.3.1/adresamp2.m create mode 100644 octave_packages/general-1.3.1/doc-cache create mode 100644 octave_packages/general-1.3.1/majle.m create mode 100644 octave_packages/general-1.3.1/packinfo/.autoload create mode 100644 octave_packages/general-1.3.1/packinfo/DESCRIPTION create mode 100644 octave_packages/general-1.3.1/packinfo/INDEX create mode 100644 octave_packages/general-1.3.1/packinfo/NEWS create mode 100644 octave_packages/general-1.3.1/pararrayfun.m create mode 100644 octave_packages/general-1.3.1/parcellfun.m create mode 100644 octave_packages/general-1.3.1/private/chunk_parcellfun.m create mode 100644 octave_packages/general-1.3.1/private/parcellfun_opts.m create mode 100644 octave_packages/general-1.3.1/safeprod.m create mode 100644 octave_packages/general-1.3.1/unresamp2.m create mode 100644 octave_packages/general-1.3.1/unvech.m create mode 100644 octave_packages/general-1.3.1/ztvals.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/angle2Points.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/angle3Points.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/angleAbsDiff.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/angleDiff.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/angleSort.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/angles2d.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/beltproblem.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/bisector.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/boxes2d.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/cartesianLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/cbezier2poly.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/centroid.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/changelog.txt create mode 100644 octave_packages/geometry-1.5.0/geom2d/circleArcAsCurve.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/circleAsPolygon.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/circles2d.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/clipEdge.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/clipLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/clipPoints.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/clipRay.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/closed_path.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/cov2ellipse.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/crackPattern.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/crackPattern2.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/createBasisTransform.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/createCircle.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/createDirectedCircle.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/createEdge.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/createHomothecy.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/createLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/createLineReflection.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/createRay.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/createRotation.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/createScaling.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/createTranslation.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/createVector.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/deg2rad.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/distancePointEdge.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/distancePointLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/distancePoints.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/doc-cache create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawArrow.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawBezierCurve.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawBox.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawCenteredEdge.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawCircle.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawCircleArc.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawEdge.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawEllipse.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawEllipseArc.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawLabels.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawOrientedBox.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawParabola.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawPoint.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawRay.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawRect.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/drawShape.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/edgeAngle.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/edgeLength.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/edgePosition.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/edgeToLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/edges2d.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/ellipse2cov.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/ellipseAsPolygon.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/ellipses2d.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/enclosingCircle.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/fitAffineTransform2d.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/geom2d_Contents.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/hexagonalGrid.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/inertiaEllipse.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/intersectBoxes.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/intersectCircles.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/intersectEdges.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/intersectLineCircle.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/intersectLineEdge.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/intersectLines.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/isCounterClockwise.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/isLeftOriented.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/isParallel.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/isPerpendicular.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/isPointInCircle.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/isPointInEllipse.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/isPointOnCircle.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/isPointOnEdge.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/isPointOnLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/isPointOnRay.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/lineAngle.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/linePosition.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/lines2d.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/medianLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/mergeBoxes.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/midPoint.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/minDistancePoints.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/normalizeAngle.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/normalizeVector.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/orthogonalLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/parallelLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/pointOnLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/points2d.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/polarPoint.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/private/assertAlmostEqual.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/private/assertElementsAlmostEqual.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/private/assertEqual.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/private/assertFalse.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/private/assertTrue.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/projPointOnLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/rad2deg.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/radicalAxis.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/randomPointInBox.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/rays2d.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/readme.txt create mode 100644 octave_packages/geometry-1.5.0/geom2d/reverseEdge.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/reverseLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/rotateVector.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/squareGrid.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/transformEdge.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/transformLine.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/transformPoint.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/transformVector.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/transforms2d.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/triangleGrid.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/vectorAngle.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/vectorNorm.m create mode 100644 octave_packages/geometry-1.5.0/geom2d/vectors2d.m create mode 100644 octave_packages/geometry-1.5.0/graphs/delaunayGraph.m create mode 100644 octave_packages/geometry-1.5.0/graphs/doc-cache create mode 100644 octave_packages/geometry-1.5.0/graphs/drawGraph.m create mode 100644 octave_packages/geometry-1.5.0/graphs/knnGraph.m create mode 100644 octave_packages/geometry-1.5.0/graphs/voronoi2d.m create mode 100644 octave_packages/geometry-1.5.0/io/@svg/display.m create mode 100644 octave_packages/geometry-1.5.0/io/@svg/getpath.m create mode 100644 octave_packages/geometry-1.5.0/io/@svg/height.m create mode 100644 octave_packages/geometry-1.5.0/io/@svg/inkex.py create mode 100644 octave_packages/geometry-1.5.0/io/@svg/loadpaths.m create mode 100644 octave_packages/geometry-1.5.0/io/@svg/loadsvgdata.m create mode 100644 octave_packages/geometry-1.5.0/io/@svg/normalize.m create mode 100644 octave_packages/geometry-1.5.0/io/@svg/parsePath.py create mode 100644 octave_packages/geometry-1.5.0/io/@svg/parseSVGData.py create mode 100644 octave_packages/geometry-1.5.0/io/@svg/path2polygon.m create mode 100644 octave_packages/geometry-1.5.0/io/@svg/pathid.m create mode 100644 octave_packages/geometry-1.5.0/io/@svg/plot.m create mode 100644 octave_packages/geometry-1.5.0/io/@svg/simplepath.py create mode 100644 octave_packages/geometry-1.5.0/io/@svg/subsref.m create mode 100644 octave_packages/geometry-1.5.0/io/@svg/svg.m create mode 100644 octave_packages/geometry-1.5.0/io/@svg/width.m create mode 100644 octave_packages/geometry-1.5.0/io/data2geo.m create mode 100644 octave_packages/geometry-1.5.0/io/deprecated/doc-cache create mode 100644 octave_packages/geometry-1.5.0/io/deprecated/private/SVGstrPath2SVGpath.m create mode 100644 octave_packages/geometry-1.5.0/io/deprecated/private/_parsePath.py create mode 100644 octave_packages/geometry-1.5.0/io/deprecated/private/formatSVGstr.m create mode 100644 octave_packages/geometry-1.5.0/io/deprecated/private/getSVGPaths_py.m create mode 100644 octave_packages/geometry-1.5.0/io/deprecated/private/getSVGdata.m create mode 100644 octave_packages/geometry-1.5.0/io/deprecated/private/getSVGstrPath.m create mode 100644 octave_packages/geometry-1.5.0/io/deprecated/svgload.m create mode 100644 octave_packages/geometry-1.5.0/io/deprecated/svgnormalize.m create mode 100644 octave_packages/geometry-1.5.0/io/deprecated/svgpath2polygon.m create mode 100644 octave_packages/geometry-1.5.0/io/doc-cache create mode 100644 octave_packages/geometry-1.5.0/io/drawing.svg create mode 100644 octave_packages/geometry-1.5.0/io/drawing2.svg create mode 100644 octave_packages/geometry-1.5.0/io/drawing3.svg create mode 100644 octave_packages/geometry-1.5.0/io/drawing4.svg create mode 100644 octave_packages/geometry-1.5.0/io/drawing5.svg create mode 100644 octave_packages/geometry-1.5.0/io/drawing6.svg create mode 100644 octave_packages/geometry-1.5.0/io/private/inkex.py create mode 100644 octave_packages/geometry-1.5.0/io/private/lineGeo.m create mode 100644 octave_packages/geometry-1.5.0/io/private/lineLoopGeo.m create mode 100644 octave_packages/geometry-1.5.0/io/private/planeSurfGeo.m create mode 100644 octave_packages/geometry-1.5.0/io/private/pointGeo.m create mode 100644 octave_packages/geometry-1.5.0/io/private/ruledSurfGeo.m create mode 100644 octave_packages/geometry-1.5.0/io/private/simplepath.py create mode 100644 octave_packages/geometry-1.5.0/octclip/doc-cache create mode 100644 octave_packages/geometry-1.5.0/octclip/oc_polybool.m create mode 100644 octave_packages/geometry-1.5.0/packinfo/.autoload create mode 100644 octave_packages/geometry-1.5.0/packinfo/DESCRIPTION create mode 100644 octave_packages/geometry-1.5.0/packinfo/INDEX create mode 100644 octave_packages/geometry-1.5.0/packinfo/NEWS create mode 100644 octave_packages/geometry-1.5.0/polygons2d/curvature.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/distancePointPolygon.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/distancePointPolyline.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/distancePolygons.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/doc-cache create mode 100644 octave_packages/geometry-1.5.0/polygons2d/drawPolygon.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/expandPolygon.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/medialAxisConvex.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/parametrize.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/polygon2shape.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/polygonLoops.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/polygonSelfIntersections.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/polygons2d.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/polylineSelfIntersections.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/reversePolygon.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/reversePolyline.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/simplifypolygon.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/simplifypolyline.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/splitPolygons.m create mode 100644 octave_packages/geometry-1.5.0/polygons2d/supportFunction.m create mode 100644 octave_packages/geometry-1.5.0/shape2d/curve2polyline.m create mode 100644 octave_packages/geometry-1.5.0/shape2d/curveval.m create mode 100644 octave_packages/geometry-1.5.0/shape2d/doc-cache create mode 100644 octave_packages/geometry-1.5.0/shape2d/shape2polygon.m create mode 100644 octave_packages/geometry-1.5.0/shape2d/shapearea.m create mode 100644 octave_packages/geometry-1.5.0/shape2d/shapecentroid.m create mode 100644 octave_packages/geometry-1.5.0/shape2d/shapeplot.m create mode 100644 octave_packages/geometry-1.5.0/shape2d/shapetransform.m create mode 100644 octave_packages/gsl-1.0.8/doc-cache create mode 100644 octave_packages/gsl-1.0.8/packinfo/.autoload create mode 100644 octave_packages/gsl-1.0.8/packinfo/DESCRIPTION create mode 100644 octave_packages/gsl-1.0.8/packinfo/INDEX create mode 100644 octave_packages/gsl-1.0.8/test_ellint.m create mode 100644 octave_packages/gsl-1.0.8/test_hyperg.m create mode 100644 octave_packages/gsl-1.0.8/test_hyperg_corr.c create mode 100644 octave_packages/gsl-1.0.8/test_sf.c create mode 100644 octave_packages/image-1.0.15/applylut.m create mode 100644 octave_packages/image-1.0.15/bestblk.m create mode 100644 octave_packages/image-1.0.15/blkproc.m create mode 100644 octave_packages/image-1.0.15/bmpwrite.m create mode 100644 octave_packages/image-1.0.15/bwarea.m create mode 100644 octave_packages/image-1.0.15/bwborder.m create mode 100644 octave_packages/image-1.0.15/bwboundaries.m create mode 100644 octave_packages/image-1.0.15/bwconncomp.m create mode 100644 octave_packages/image-1.0.15/bwdist.m create mode 100644 octave_packages/image-1.0.15/bweuler.m create mode 100644 octave_packages/image-1.0.15/bwhitmiss.m create mode 100644 octave_packages/image-1.0.15/bwmorph.m create mode 100644 octave_packages/image-1.0.15/bwperim.m create mode 100644 octave_packages/image-1.0.15/bwselect.m create mode 100644 octave_packages/image-1.0.15/cmpermute.m create mode 100644 octave_packages/image-1.0.15/cmunique.m create mode 100644 octave_packages/image-1.0.15/col2im.m create mode 100644 octave_packages/image-1.0.15/colfilt.m create mode 100644 octave_packages/image-1.0.15/colorgradient.m create mode 100644 octave_packages/image-1.0.15/conndef.m create mode 100644 octave_packages/image-1.0.15/corr2.m create mode 100644 octave_packages/image-1.0.15/dilate.m create mode 100644 octave_packages/image-1.0.15/doc-cache create mode 100644 octave_packages/image-1.0.15/edge.m create mode 100644 octave_packages/image-1.0.15/entropy.m create mode 100644 octave_packages/image-1.0.15/entropyfilt.m create mode 100644 octave_packages/image-1.0.15/erode.m create mode 100644 octave_packages/image-1.0.15/fchcode.m create mode 100644 octave_packages/image-1.0.15/fftconv2.m create mode 100644 octave_packages/image-1.0.15/fspecial.m create mode 100644 octave_packages/image-1.0.15/grayslice.m create mode 100644 octave_packages/image-1.0.15/graythresh.m create mode 100644 octave_packages/image-1.0.15/histeq.m create mode 100644 octave_packages/image-1.0.15/hough_circle.m create mode 100644 octave_packages/image-1.0.15/houghtf.m create mode 100644 octave_packages/image-1.0.15/im2bw.m create mode 100644 octave_packages/image-1.0.15/im2col.m create mode 100644 octave_packages/image-1.0.15/im2double.m create mode 100644 octave_packages/image-1.0.15/im2uint16.m create mode 100644 octave_packages/image-1.0.15/im2uint8.m create mode 100644 octave_packages/image-1.0.15/imadjust.m create mode 100644 octave_packages/image-1.0.15/imclose.m create mode 100644 octave_packages/image-1.0.15/imcomplement.m create mode 100644 octave_packages/image-1.0.15/imdilate.m create mode 100644 octave_packages/image-1.0.15/imdither.m create mode 100644 octave_packages/image-1.0.15/imerode.m create mode 100644 octave_packages/image-1.0.15/imfilter.m create mode 100644 octave_packages/image-1.0.15/imginfo.m create mode 100644 octave_packages/image-1.0.15/imhist.m create mode 100644 octave_packages/image-1.0.15/immaximas.m create mode 100644 octave_packages/image-1.0.15/imnoise.m create mode 100644 octave_packages/image-1.0.15/imopen.m create mode 100644 octave_packages/image-1.0.15/impad.m create mode 100644 octave_packages/image-1.0.15/imperspectivewarp.m create mode 100644 octave_packages/image-1.0.15/imremap.m create mode 100644 octave_packages/image-1.0.15/imresize.m create mode 100644 octave_packages/image-1.0.15/imrotate.m create mode 100644 octave_packages/image-1.0.15/imrotate_Fourier.m create mode 100644 octave_packages/image-1.0.15/imshear.m create mode 100644 octave_packages/image-1.0.15/imsmooth.m create mode 100644 octave_packages/image-1.0.15/imtophat.m create mode 100644 octave_packages/image-1.0.15/imtranslate.m create mode 100644 octave_packages/image-1.0.15/iradon.m create mode 100644 octave_packages/image-1.0.15/isbw.m create mode 100644 octave_packages/image-1.0.15/isgray.m create mode 100644 octave_packages/image-1.0.15/isind.m create mode 100644 octave_packages/image-1.0.15/isrgb.m create mode 100644 octave_packages/image-1.0.15/label2rgb.m create mode 100644 octave_packages/image-1.0.15/makelut.m create mode 100644 octave_packages/image-1.0.15/mat2gray.m create mode 100644 octave_packages/image-1.0.15/mean2.m create mode 100644 octave_packages/image-1.0.15/medfilt2.m create mode 100644 octave_packages/image-1.0.15/mmgradm.m create mode 100644 octave_packages/image-1.0.15/nlfilter.m create mode 100644 octave_packages/image-1.0.15/ordfilt2.m create mode 100644 octave_packages/image-1.0.15/ordfiltn.m create mode 100644 octave_packages/image-1.0.15/packinfo/.autoload create mode 100644 octave_packages/image-1.0.15/packinfo/DESCRIPTION create mode 100644 octave_packages/image-1.0.15/packinfo/INDEX create mode 100644 octave_packages/image-1.0.15/padarray.m create mode 100644 octave_packages/image-1.0.15/phantom.m create mode 100644 octave_packages/image-1.0.15/poly2mask.m create mode 100644 octave_packages/image-1.0.15/qtdecomp.m create mode 100644 octave_packages/image-1.0.15/qtgetblk.m create mode 100644 octave_packages/image-1.0.15/qtsetblk.m create mode 100644 octave_packages/image-1.0.15/radon.m create mode 100644 octave_packages/image-1.0.15/rangefilt.m create mode 100644 octave_packages/image-1.0.15/readexif.m create mode 100644 octave_packages/image-1.0.15/regionprops.m create mode 100644 octave_packages/image-1.0.15/rgb2gray.m create mode 100644 octave_packages/image-1.0.15/rgb2ycbcr.m create mode 100644 octave_packages/image-1.0.15/rgbplot.m create mode 100644 octave_packages/image-1.0.15/rho_filter.m create mode 100644 octave_packages/image-1.0.15/roicolor.m create mode 100644 octave_packages/image-1.0.15/std2.m create mode 100644 octave_packages/image-1.0.15/stdfilt.m create mode 100644 octave_packages/image-1.0.15/stretchlim.m create mode 100644 octave_packages/image-1.0.15/tiff_tag_read.m create mode 100644 octave_packages/image-1.0.15/uintlut.m create mode 100644 octave_packages/io-1.0.19/append_save.m create mode 100644 octave_packages/io-1.0.19/calccelladdress.m create mode 100644 octave_packages/io-1.0.19/chk_spreadsheet_support.m create mode 100644 octave_packages/io-1.0.19/doc-cache create mode 100644 octave_packages/io-1.0.19/fexist.m create mode 100644 octave_packages/io-1.0.19/getusedrange.m create mode 100644 octave_packages/io-1.0.19/io_ods_testscript.m create mode 100644 octave_packages/io-1.0.19/io_xls_testscript.m create mode 100644 octave_packages/io-1.0.19/object2json.m create mode 100644 octave_packages/io-1.0.19/oct2ods.m create mode 100644 octave_packages/io-1.0.19/oct2xls.m create mode 100644 octave_packages/io-1.0.19/ods2oct.m create mode 100644 octave_packages/io-1.0.19/odsclose.m create mode 100644 octave_packages/io-1.0.19/odsfinfo.m create mode 100644 octave_packages/io-1.0.19/odsopen.m create mode 100644 octave_packages/io-1.0.19/odsread.m create mode 100644 octave_packages/io-1.0.19/odswrite.m create mode 100644 octave_packages/io-1.0.19/packinfo/.autoload create mode 100644 octave_packages/io-1.0.19/packinfo/DESCRIPTION create mode 100644 octave_packages/io-1.0.19/packinfo/INDEX create mode 100644 octave_packages/io-1.0.19/packinfo/NEWS create mode 100644 octave_packages/io-1.0.19/parse_sp_range.m create mode 100644 octave_packages/io-1.0.19/parsecell.m create mode 100644 octave_packages/io-1.0.19/pch2mat.m create mode 100644 octave_packages/io-1.0.19/spsh_chkrange.m create mode 100644 octave_packages/io-1.0.19/spsh_prstype.m create mode 100644 octave_packages/io-1.0.19/xls2oct.m create mode 100644 octave_packages/io-1.0.19/xlsclose.m create mode 100644 octave_packages/io-1.0.19/xlsfinfo.m create mode 100644 octave_packages/io-1.0.19/xlsopen.m create mode 100644 octave_packages/io-1.0.19/xlsread.m create mode 100644 octave_packages/io-1.0.19/xlswrite.m create mode 100644 octave_packages/io-1.0.19/xmlwrite.m create mode 100644 octave_packages/java-1.2.8/__java__.h create mode 100644 octave_packages/java-1.2.8/dlgtest.m create mode 100644 octave_packages/java-1.2.8/doc-cache create mode 100644 octave_packages/java-1.2.8/doc.info create mode 100644 octave_packages/java-1.2.8/errordlg.m create mode 100644 octave_packages/java-1.2.8/helpdlg.m create mode 100644 octave_packages/java-1.2.8/inputdlg.m create mode 100644 octave_packages/java-1.2.8/java.m create mode 100644 octave_packages/java-1.2.8/javaArray.m create mode 100644 octave_packages/java-1.2.8/javaaddpath.m create mode 100644 octave_packages/java-1.2.8/javaclasspath.m create mode 100644 octave_packages/java-1.2.8/javafields.m create mode 100644 octave_packages/java-1.2.8/javamem.m create mode 100644 octave_packages/java-1.2.8/javamethods.m create mode 100644 octave_packages/java-1.2.8/javarmpath.m create mode 100644 octave_packages/java-1.2.8/listdlg.m create mode 100644 octave_packages/java-1.2.8/msgbox.m create mode 100644 octave_packages/java-1.2.8/octave.jar create mode 100644 octave_packages/java-1.2.8/packinfo/.autoload create mode 100644 octave_packages/java-1.2.8/packinfo/DESCRIPTION create mode 100644 octave_packages/java-1.2.8/packinfo/INDEX create mode 100644 octave_packages/java-1.2.8/questdlg.m create mode 100644 octave_packages/java-1.2.8/warndlg.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/blksize.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/blksparse.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/ctranspose.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/display.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/full.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/ismatrix.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/isreal.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/issparse.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/minus.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/mldivide.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/mrdivide.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/mtimes.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/plus.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/size.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/sparse.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/subsref.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/transpose.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/uminus.m create mode 100644 octave_packages/linear-algebra-2.2.0/@blksparse/uplus.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/columns.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/ctranspose.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/det.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/disp.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/display.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/full.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/inv.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/iscomplex.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/ismatrix.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/isreal.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/issparse.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/issquare.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/kronprod.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/minus.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/mldivide.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/mpower.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/mtimes.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/not_done/eig.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/not_done/svd.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/numel.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/plus.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/rank.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/rdivide.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/rows.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/size.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/size_equal.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/sparse.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/times.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/trace.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/transpose.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/uminus.m create mode 100644 octave_packages/linear-algebra-2.2.0/@kronprod/uplus.m create mode 100644 octave_packages/linear-algebra-2.2.0/cartprod.m create mode 100644 octave_packages/linear-algebra-2.2.0/circulant_eig.m create mode 100644 octave_packages/linear-algebra-2.2.0/circulant_inv.m create mode 100644 octave_packages/linear-algebra-2.2.0/circulant_make_matrix.m create mode 100644 octave_packages/linear-algebra-2.2.0/circulant_matrix_vector_product.m create mode 100644 octave_packages/linear-algebra-2.2.0/cod.m create mode 100644 octave_packages/linear-algebra-2.2.0/condeig.m create mode 100644 octave_packages/linear-algebra-2.2.0/doc-cache create mode 100644 octave_packages/linear-algebra-2.2.0/funm.m create mode 100644 octave_packages/linear-algebra-2.2.0/lobpcg.m create mode 100644 octave_packages/linear-algebra-2.2.0/ndcovlt.m create mode 100644 octave_packages/linear-algebra-2.2.0/nmf_bpas.m create mode 100644 octave_packages/linear-algebra-2.2.0/nmf_pg.m create mode 100644 octave_packages/linear-algebra-2.2.0/packinfo/.autoload create mode 100644 octave_packages/linear-algebra-2.2.0/packinfo/DESCRIPTION create mode 100644 octave_packages/linear-algebra-2.2.0/packinfo/INDEX create mode 100644 octave_packages/linear-algebra-2.2.0/packinfo/NEWS create mode 100644 octave_packages/linear-algebra-2.2.0/rotparams.m create mode 100644 octave_packages/linear-algebra-2.2.0/rotv.m create mode 100644 octave_packages/linear-algebra-2.2.0/smwsolve.m create mode 100644 octave_packages/linear-algebra-2.2.0/thfm.m create mode 100644 octave_packages/mapping-1.0.7/azimuth.m create mode 100644 octave_packages/mapping-1.0.7/deg2rad.m create mode 100644 octave_packages/mapping-1.0.7/distance.m create mode 100644 octave_packages/mapping-1.0.7/doc-cache create mode 100644 octave_packages/mapping-1.0.7/km2deg.m create mode 100644 octave_packages/mapping-1.0.7/packinfo/.autoload create mode 100644 octave_packages/mapping-1.0.7/packinfo/DESCRIPTION create mode 100644 octave_packages/mapping-1.0.7/packinfo/INDEX create mode 100644 octave_packages/mapping-1.0.7/rad2deg.m create mode 100644 octave_packages/mapping-1.0.7/reckon.m create mode 100644 octave_packages/miscellaneous-1.1.0/apply.m create mode 100644 octave_packages/miscellaneous-1.1.0/asci.m create mode 100644 octave_packages/miscellaneous-1.1.0/chebyshevpoly.m create mode 100644 octave_packages/miscellaneous-1.1.0/clip.m create mode 100644 octave_packages/miscellaneous-1.1.0/colorboard.m create mode 100644 octave_packages/miscellaneous-1.1.0/csv2latex.m create mode 100644 octave_packages/miscellaneous-1.1.0/doc-cache create mode 100644 octave_packages/miscellaneous-1.1.0/gameoflife.m create mode 100644 octave_packages/miscellaneous-1.1.0/hermitepoly.m create mode 100644 octave_packages/miscellaneous-1.1.0/hilbert_curve.m create mode 100644 octave_packages/miscellaneous-1.1.0/infoskeleton.m create mode 100644 octave_packages/miscellaneous-1.1.0/laguerrepoly.m create mode 100644 octave_packages/miscellaneous-1.1.0/lauchli.m create mode 100644 octave_packages/miscellaneous-1.1.0/legendrepoly.m create mode 100644 octave_packages/miscellaneous-1.1.0/map.m create mode 100644 octave_packages/miscellaneous-1.1.0/match.m create mode 100644 octave_packages/miscellaneous-1.1.0/normc.m create mode 100644 octave_packages/miscellaneous-1.1.0/normr.m create mode 100644 octave_packages/miscellaneous-1.1.0/nze.m create mode 100644 octave_packages/miscellaneous-1.1.0/packinfo/DESCRIPTION create mode 100644 octave_packages/miscellaneous-1.1.0/packinfo/INDEX create mode 100644 octave_packages/miscellaneous-1.1.0/packinfo/NEWS create mode 100644 octave_packages/miscellaneous-1.1.0/peano_curve.m create mode 100644 octave_packages/miscellaneous-1.1.0/publish.m create mode 100644 octave_packages/miscellaneous-1.1.0/read_options.m create mode 100644 octave_packages/miscellaneous-1.1.0/reduce.m create mode 100644 octave_packages/miscellaneous-1.1.0/rolldices.m create mode 100644 octave_packages/miscellaneous-1.1.0/slurp_file.m create mode 100644 octave_packages/miscellaneous-1.1.0/solvesudoku.m create mode 100644 octave_packages/miscellaneous-1.1.0/temp_name.m create mode 100644 octave_packages/miscellaneous-1.1.0/units.m create mode 100644 octave_packages/miscellaneous-1.1.0/z_curve.m create mode 100644 octave_packages/miscellaneous-1.1.0/zagzig.m create mode 100644 octave_packages/miscellaneous-1.1.0/zigzag.m create mode 100644 octave_packages/missing-functions-1.0.2/__functionstatus__.m create mode 100644 octave_packages/missing-functions-1.0.2/__matlabfunctionlist__.m create mode 100644 octave_packages/missing-functions-1.0.2/__missingmatlab2txt__.m create mode 100644 octave_packages/missing-functions-1.0.2/doc-cache create mode 100644 octave_packages/missing-functions-1.0.2/missingfunctionstatus.m create mode 100644 octave_packages/missing-functions-1.0.2/missingmatlabfunctions.m create mode 100644 octave_packages/missing-functions-1.0.2/packinfo/.autoload create mode 100644 octave_packages/missing-functions-1.0.2/packinfo/DESCRIPTION create mode 100644 octave_packages/missing-functions-1.0.2/packinfo/INDEX create mode 100644 octave_packages/nan-2.5.5/bland_altman.m create mode 100644 octave_packages/nan-2.5.5/cat2bin.m create mode 100644 octave_packages/nan-2.5.5/cdfplot.m create mode 100644 octave_packages/nan-2.5.5/center.m create mode 100644 octave_packages/nan-2.5.5/classify.m create mode 100644 octave_packages/nan-2.5.5/coefficient_of_variation.m create mode 100644 octave_packages/nan-2.5.5/cor.m create mode 100644 octave_packages/nan-2.5.5/corrcoef.m create mode 100644 octave_packages/nan-2.5.5/cov.m create mode 100644 octave_packages/nan-2.5.5/covm.m create mode 100644 octave_packages/nan-2.5.5/cumsumskipnan.m create mode 100644 octave_packages/nan-2.5.5/decovm.m create mode 100644 octave_packages/nan-2.5.5/detrend.m create mode 100644 octave_packages/nan-2.5.5/doc-cache create mode 100644 octave_packages/nan-2.5.5/ecdf.m create mode 100644 octave_packages/nan-2.5.5/flag_accuracy_level.m create mode 100644 octave_packages/nan-2.5.5/flag_implicit_significance.m create mode 100644 octave_packages/nan-2.5.5/flag_implicit_skip_nan.m create mode 100644 octave_packages/nan-2.5.5/flag_nans_occured.m create mode 100644 octave_packages/nan-2.5.5/fss.m create mode 100644 octave_packages/nan-2.5.5/geomean.m create mode 100644 octave_packages/nan-2.5.5/gscatter.m create mode 100644 octave_packages/nan-2.5.5/harmmean.m create mode 100644 octave_packages/nan-2.5.5/hist2res.m create mode 100644 octave_packages/nan-2.5.5/iqr.m create mode 100644 octave_packages/nan-2.5.5/kappa.m create mode 100644 octave_packages/nan-2.5.5/kurtosis.m create mode 100644 octave_packages/nan-2.5.5/load_fisheriris.m create mode 100644 octave_packages/nan-2.5.5/mad.m create mode 100644 octave_packages/nan-2.5.5/mahal.m create mode 100644 octave_packages/nan-2.5.5/mean.m create mode 100644 octave_packages/nan-2.5.5/meandev.m create mode 100644 octave_packages/nan-2.5.5/meansq.m create mode 100644 octave_packages/nan-2.5.5/medAbsDev.m create mode 100644 octave_packages/nan-2.5.5/median.m create mode 100644 octave_packages/nan-2.5.5/moment.m create mode 100644 octave_packages/nan-2.5.5/nanconv.m create mode 100644 octave_packages/nan-2.5.5/nanfft.m create mode 100644 octave_packages/nan-2.5.5/nanfilter.m create mode 100644 octave_packages/nan-2.5.5/nanfilter1uc.m create mode 100644 octave_packages/nan-2.5.5/naninsttest.m create mode 100644 octave_packages/nan-2.5.5/nanmean.m create mode 100644 octave_packages/nan-2.5.5/nanstd.m create mode 100644 octave_packages/nan-2.5.5/nansum.m create mode 100644 octave_packages/nan-2.5.5/nantest.m create mode 100644 octave_packages/nan-2.5.5/normcdf.m create mode 100644 octave_packages/nan-2.5.5/norminv.m create mode 100644 octave_packages/nan-2.5.5/normpdf.m create mode 100644 octave_packages/nan-2.5.5/packinfo/DESCRIPTION create mode 100644 octave_packages/nan-2.5.5/packinfo/INDEX create mode 100644 octave_packages/nan-2.5.5/partcorrcoef.m create mode 100644 octave_packages/nan-2.5.5/percentile.m create mode 100644 octave_packages/nan-2.5.5/prctile.m create mode 100644 octave_packages/nan-2.5.5/quantile.m create mode 100644 octave_packages/nan-2.5.5/range.m create mode 100644 octave_packages/nan-2.5.5/rankcorr.m create mode 100644 octave_packages/nan-2.5.5/ranks.m create mode 100644 octave_packages/nan-2.5.5/rms.m create mode 100644 octave_packages/nan-2.5.5/row_col_deletion.m create mode 100644 octave_packages/nan-2.5.5/sem.m create mode 100644 octave_packages/nan-2.5.5/skewness.m create mode 100644 octave_packages/nan-2.5.5/spearman.m create mode 100644 octave_packages/nan-2.5.5/statistic.m create mode 100644 octave_packages/nan-2.5.5/std.m create mode 100644 octave_packages/nan-2.5.5/sumskipnan.m create mode 100644 octave_packages/nan-2.5.5/sumsq.m create mode 100644 octave_packages/nan-2.5.5/tcdf.m create mode 100644 octave_packages/nan-2.5.5/test_sc.m create mode 100644 octave_packages/nan-2.5.5/tiedrank.m create mode 100644 octave_packages/nan-2.5.5/tinv.m create mode 100644 octave_packages/nan-2.5.5/tpdf.m create mode 100644 octave_packages/nan-2.5.5/train_lda_sparse.m create mode 100644 octave_packages/nan-2.5.5/train_sc.m create mode 100644 octave_packages/nan-2.5.5/trimean.m create mode 100644 octave_packages/nan-2.5.5/trimmean.m create mode 100644 octave_packages/nan-2.5.5/ttest.m create mode 100644 octave_packages/nan-2.5.5/ttest2.m create mode 100644 octave_packages/nan-2.5.5/var.m create mode 100644 octave_packages/nan-2.5.5/xcovf.m create mode 100644 octave_packages/nan-2.5.5/xptopen.m create mode 100644 octave_packages/nan-2.5.5/xval.m create mode 100644 octave_packages/nan-2.5.5/zScoreMedian.m create mode 100644 octave_packages/nan-2.5.5/zscore.m create mode 100644 octave_packages/nnet-0.1.13/__analyzerows.m create mode 100644 octave_packages/nnet-0.1.13/__calcjacobian.m create mode 100644 octave_packages/nnet-0.1.13/__calcperf.m create mode 100644 octave_packages/nnet-0.1.13/__checknetstruct.m create mode 100644 octave_packages/nnet-0.1.13/__copycoltopos1.m create mode 100644 octave_packages/nnet-0.1.13/__dlogsig.m create mode 100644 octave_packages/nnet-0.1.13/__dpurelin.m create mode 100644 octave_packages/nnet-0.1.13/__dradbas.m create mode 100644 octave_packages/nnet-0.1.13/__dtansig.m create mode 100644 octave_packages/nnet-0.1.13/__getx.m create mode 100644 octave_packages/nnet-0.1.13/__init.m create mode 100644 octave_packages/nnet-0.1.13/__mae.m create mode 100644 octave_packages/nnet-0.1.13/__mse.m create mode 100644 octave_packages/nnet-0.1.13/__newnetwork.m create mode 100644 octave_packages/nnet-0.1.13/__optimizedatasets.m create mode 100644 octave_packages/nnet-0.1.13/__printAdaptFcn.m create mode 100644 octave_packages/nnet-0.1.13/__printAdaptParam.m create mode 100644 octave_packages/nnet-0.1.13/__printB.m create mode 100644 octave_packages/nnet-0.1.13/__printBiasConnect.m create mode 100644 octave_packages/nnet-0.1.13/__printBiases.m create mode 100644 octave_packages/nnet-0.1.13/__printIW.m create mode 100644 octave_packages/nnet-0.1.13/__printInitFcn.m create mode 100644 octave_packages/nnet-0.1.13/__printInitParam.m create mode 100644 octave_packages/nnet-0.1.13/__printInputConnect.m create mode 100644 octave_packages/nnet-0.1.13/__printInputWeights.m create mode 100644 octave_packages/nnet-0.1.13/__printInputs.m create mode 100644 octave_packages/nnet-0.1.13/__printLW.m create mode 100644 octave_packages/nnet-0.1.13/__printLayerConnect.m create mode 100644 octave_packages/nnet-0.1.13/__printLayerWeights.m create mode 100644 octave_packages/nnet-0.1.13/__printLayers.m create mode 100644 octave_packages/nnet-0.1.13/__printMLPHeader.m create mode 100644 octave_packages/nnet-0.1.13/__printNetworkType.m create mode 100644 octave_packages/nnet-0.1.13/__printNumInputDelays.m create mode 100644 octave_packages/nnet-0.1.13/__printNumInputs.m create mode 100644 octave_packages/nnet-0.1.13/__printNumLayerDelays.m create mode 100644 octave_packages/nnet-0.1.13/__printNumLayers.m create mode 100644 octave_packages/nnet-0.1.13/__printNumOutputs.m create mode 100644 octave_packages/nnet-0.1.13/__printNumTargets.m create mode 100644 octave_packages/nnet-0.1.13/__printOutputConnect.m create mode 100644 octave_packages/nnet-0.1.13/__printOutputs.m create mode 100644 octave_packages/nnet-0.1.13/__printPerformFcn.m create mode 100644 octave_packages/nnet-0.1.13/__printPerformParam.m create mode 100644 octave_packages/nnet-0.1.13/__printTargetConnect.m create mode 100644 octave_packages/nnet-0.1.13/__printTargets.m create mode 100644 octave_packages/nnet-0.1.13/__printTrainFcn.m create mode 100644 octave_packages/nnet-0.1.13/__printTrainParam.m create mode 100644 octave_packages/nnet-0.1.13/__randomisecols.m create mode 100644 octave_packages/nnet-0.1.13/__rerangecolumns.m create mode 100644 octave_packages/nnet-0.1.13/__setx.m create mode 100644 octave_packages/nnet-0.1.13/__trainlm.m create mode 100644 octave_packages/nnet-0.1.13/dhardlim.m create mode 100644 octave_packages/nnet-0.1.13/dividerand.m create mode 100644 octave_packages/nnet-0.1.13/doc-cache create mode 100644 octave_packages/nnet-0.1.13/dposlin.m create mode 100644 octave_packages/nnet-0.1.13/dsatlin.m create mode 100644 octave_packages/nnet-0.1.13/dsatlins.m create mode 100644 octave_packages/nnet-0.1.13/hardlim.m create mode 100644 octave_packages/nnet-0.1.13/hardlims.m create mode 100644 octave_packages/nnet-0.1.13/ind2vec.m create mode 100644 octave_packages/nnet-0.1.13/isposint.m create mode 100644 octave_packages/nnet-0.1.13/logsig.m create mode 100644 octave_packages/nnet-0.1.13/mapstd.m create mode 100644 octave_packages/nnet-0.1.13/min_max.m create mode 100644 octave_packages/nnet-0.1.13/newff.m create mode 100644 octave_packages/nnet-0.1.13/newp.m create mode 100644 octave_packages/nnet-0.1.13/packinfo/.autoload create mode 100644 octave_packages/nnet-0.1.13/packinfo/DESCRIPTION create mode 100644 octave_packages/nnet-0.1.13/packinfo/INDEX create mode 100644 octave_packages/nnet-0.1.13/poslin.m create mode 100644 octave_packages/nnet-0.1.13/poststd.m create mode 100644 octave_packages/nnet-0.1.13/prestd.m create mode 100644 octave_packages/nnet-0.1.13/purelin.m create mode 100644 octave_packages/nnet-0.1.13/radbas.m create mode 100644 octave_packages/nnet-0.1.13/satlin.m create mode 100644 octave_packages/nnet-0.1.13/satlins.m create mode 100644 octave_packages/nnet-0.1.13/saveMLPStruct.m create mode 100644 octave_packages/nnet-0.1.13/sim.m create mode 100644 octave_packages/nnet-0.1.13/subset.m create mode 100644 octave_packages/nnet-0.1.13/tansig.m create mode 100644 octave_packages/nnet-0.1.13/train.m create mode 100644 octave_packages/nnet-0.1.13/trastd.m create mode 100644 octave_packages/nnet-0.1.13/vec2ind.m create mode 100644 octave_packages/nurbs-1.3.6/basisfun.m create mode 100644 octave_packages/nurbs-1.3.6/basisfunder.m create mode 100644 octave_packages/nurbs-1.3.6/bspdegelev.m create mode 100644 octave_packages/nurbs-1.3.6/bspderiv.m create mode 100644 octave_packages/nurbs-1.3.6/bspeval.m create mode 100644 octave_packages/nurbs-1.3.6/bspkntins.m create mode 100644 octave_packages/nurbs-1.3.6/curvederivcpts.m create mode 100644 octave_packages/nurbs-1.3.6/curvederiveval.m create mode 100644 octave_packages/nurbs-1.3.6/deg2rad.m create mode 100644 octave_packages/nurbs-1.3.6/doc-cache create mode 100644 octave_packages/nurbs-1.3.6/findspan.m create mode 100644 octave_packages/nurbs-1.3.6/kntbrkdegmult.m create mode 100644 octave_packages/nurbs-1.3.6/kntbrkdegreg.m create mode 100644 octave_packages/nurbs-1.3.6/kntrefine.m create mode 100644 octave_packages/nurbs-1.3.6/kntuniform.m create mode 100644 octave_packages/nurbs-1.3.6/nrb4surf.m create mode 100644 octave_packages/nurbs-1.3.6/nrbbasisfun.m create mode 100644 octave_packages/nurbs-1.3.6/nrbbasisfunder.m create mode 100644 octave_packages/nurbs-1.3.6/nrbcirc.m create mode 100644 octave_packages/nurbs-1.3.6/nrbcoons.m create mode 100644 octave_packages/nurbs-1.3.6/nrbcrvderiveval.m create mode 100644 octave_packages/nurbs-1.3.6/nrbctrlplot.m create mode 100644 octave_packages/nurbs-1.3.6/nrbcylind.m create mode 100644 octave_packages/nurbs-1.3.6/nrbdegelev.m create mode 100644 octave_packages/nurbs-1.3.6/nrbderiv.m create mode 100644 octave_packages/nurbs-1.3.6/nrbdeval.m create mode 100644 octave_packages/nurbs-1.3.6/nrbeval.m create mode 100644 octave_packages/nurbs-1.3.6/nrbexport.m create mode 100644 octave_packages/nurbs-1.3.6/nrbextract.m create mode 100644 octave_packages/nurbs-1.3.6/nrbextrude.m create mode 100644 octave_packages/nurbs-1.3.6/nrbkntins.m create mode 100644 octave_packages/nurbs-1.3.6/nrbkntplot.m create mode 100644 octave_packages/nurbs-1.3.6/nrbline.m create mode 100644 octave_packages/nurbs-1.3.6/nrbmak.m create mode 100644 octave_packages/nurbs-1.3.6/nrbnumbasisfun.m create mode 100644 octave_packages/nurbs-1.3.6/nrbplot.m create mode 100644 octave_packages/nurbs-1.3.6/nrbrect.m create mode 100644 octave_packages/nurbs-1.3.6/nrbreverse.m create mode 100644 octave_packages/nurbs-1.3.6/nrbrevolve.m create mode 100644 octave_packages/nurbs-1.3.6/nrbruled.m create mode 100644 octave_packages/nurbs-1.3.6/nrbsurfderiveval.m create mode 100644 octave_packages/nurbs-1.3.6/nrbtestcrv.m create mode 100644 octave_packages/nurbs-1.3.6/nrbtestsrf.m create mode 100644 octave_packages/nurbs-1.3.6/nrbtform.m create mode 100644 octave_packages/nurbs-1.3.6/nrbtransp.m create mode 100644 octave_packages/nurbs-1.3.6/numbasisfun.m create mode 100644 octave_packages/nurbs-1.3.6/packinfo/.autoload create mode 100644 octave_packages/nurbs-1.3.6/packinfo/DESCRIPTION create mode 100644 octave_packages/nurbs-1.3.6/packinfo/INDEX create mode 100644 octave_packages/nurbs-1.3.6/private/nrb_crv_basisfun__.m create mode 100644 octave_packages/nurbs-1.3.6/private/nrb_crv_basisfun_der__.m create mode 100644 octave_packages/nurbs-1.3.6/private/nrb_srf_basisfun__.m create mode 100644 octave_packages/nurbs-1.3.6/private/nrb_srf_basisfun_der__.m create mode 100644 octave_packages/nurbs-1.3.6/private/nrb_srf_numbasisfun__.m create mode 100644 octave_packages/nurbs-1.3.6/private/onebasisfun__.m create mode 100644 octave_packages/nurbs-1.3.6/private/onebasisfunder__.m create mode 100644 octave_packages/nurbs-1.3.6/rad2deg.m create mode 100644 octave_packages/nurbs-1.3.6/surfderivcpts.m create mode 100644 octave_packages/nurbs-1.3.6/surfderiveval.m create mode 100644 octave_packages/nurbs-1.3.6/tbasisfun.m create mode 100644 octave_packages/nurbs-1.3.6/vecangle.m create mode 100644 octave_packages/nurbs-1.3.6/veccross.m create mode 100644 octave_packages/nurbs-1.3.6/vecdot.m create mode 100644 octave_packages/nurbs-1.3.6/vecmag.m create mode 100644 octave_packages/nurbs-1.3.6/vecmag2.m create mode 100644 octave_packages/nurbs-1.3.6/vecnorm.m create mode 100644 octave_packages/nurbs-1.3.6/vecrot.m create mode 100644 octave_packages/nurbs-1.3.6/vecrotx.m create mode 100644 octave_packages/nurbs-1.3.6/vecroty.m create mode 100644 octave_packages/nurbs-1.3.6/vecrotz.m create mode 100644 octave_packages/nurbs-1.3.6/vecscale.m create mode 100644 octave_packages/nurbs-1.3.6/vectrans.m create mode 100644 octave_packages/ocs-0.1.3/asm/asm_build_system.m create mode 100644 octave_packages/ocs-0.1.3/asm/asm_initialize_system.m create mode 100644 octave_packages/ocs-0.1.3/asm/doc-cache create mode 100644 octave_packages/ocs-0.1.3/nls/doc-cache create mode 100644 octave_packages/ocs-0.1.3/nls/nls_newton_raphson.m create mode 100644 octave_packages/ocs-0.1.3/nls/nls_stationary.m create mode 100644 octave_packages/ocs-0.1.3/packinfo/.autoload create mode 100644 octave_packages/ocs-0.1.3/packinfo/DESCRIPTION create mode 100644 octave_packages/ocs-0.1.3/packinfo/INDEX create mode 100644 octave_packages/ocs-0.1.3/prs/doc-cache create mode 100644 octave_packages/ocs-0.1.3/prs/prs_iff.m create mode 100644 octave_packages/ocs-0.1.3/prs/prs_spice.m create mode 100644 octave_packages/ocs-0.1.3/sbn/Mcapacitors.m create mode 100644 octave_packages/ocs-0.1.3/sbn/Mcurrentsources.m create mode 100644 octave_packages/ocs-0.1.3/sbn/Mdiode.m create mode 100644 octave_packages/ocs-0.1.3/sbn/Minductors.m create mode 100644 octave_packages/ocs-0.1.3/sbn/Mnmosfet.m create mode 100644 octave_packages/ocs-0.1.3/sbn/Mpdesympnjunct.m create mode 100644 octave_packages/ocs-0.1.3/sbn/Mpmosfet.m create mode 100644 octave_packages/ocs-0.1.3/sbn/Mresistors.m create mode 100644 octave_packages/ocs-0.1.3/sbn/Mshichmanhodgesmosfet.m create mode 100644 octave_packages/ocs-0.1.3/sbn/Mtdnmos.cir create mode 100644 octave_packages/ocs-0.1.3/sbn/Mtdnmos.nms create mode 100644 octave_packages/ocs-0.1.3/sbn/Mtdpmos.cir create mode 100644 octave_packages/ocs-0.1.3/sbn/Mtdpmos.nms create mode 100644 octave_packages/ocs-0.1.3/sbn/Mvoltagesources.m create mode 100644 octave_packages/ocs-0.1.3/sbn/doc-cache create mode 100644 octave_packages/ocs-0.1.3/tst/doc-cache create mode 100644 octave_packages/ocs-0.1.3/tst/tst_backward_euler.m create mode 100644 octave_packages/ocs-0.1.3/tst/tst_daspk.m create mode 100644 octave_packages/ocs-0.1.3/tst/tst_odepkg.m create mode 100644 octave_packages/ocs-0.1.3/tst/tst_theta_method.m create mode 100644 octave_packages/ocs-0.1.3/utl/doc-cache create mode 100644 octave_packages/ocs-0.1.3/utl/utl_plot_by_name.m create mode 100644 octave_packages/ocs-0.1.3/utl/utl_sbn_server.m create mode 100644 octave_packages/octcdf-1.1.4/@ncatt/datatype.m create mode 100644 octave_packages/octcdf-1.1.4/@ncatt/name.m create mode 100644 octave_packages/octcdf-1.1.4/@ncdim/isrecord.m create mode 100644 octave_packages/octcdf-1.1.4/@ncdim/name.m create mode 100644 octave_packages/octcdf-1.1.4/@ncfile/att.m create mode 100644 octave_packages/octcdf-1.1.4/@ncfile/close.m create mode 100644 octave_packages/octcdf-1.1.4/@ncfile/dim.m create mode 100644 octave_packages/octcdf-1.1.4/@ncfile/endef.m create mode 100644 octave_packages/octcdf-1.1.4/@ncfile/name.m create mode 100644 octave_packages/octcdf-1.1.4/@ncfile/redef.m create mode 100644 octave_packages/octcdf-1.1.4/@ncfile/sync.m create mode 100644 octave_packages/octcdf-1.1.4/@ncfile/var.m create mode 100644 octave_packages/octcdf-1.1.4/@ncvar/att.m create mode 100644 octave_packages/octcdf-1.1.4/@ncvar/autonan.m create mode 100644 octave_packages/octcdf-1.1.4/@ncvar/autoscale.m create mode 100644 octave_packages/octcdf-1.1.4/@ncvar/datatype.m create mode 100644 octave_packages/octcdf-1.1.4/@ncvar/dim.m create mode 100644 octave_packages/octcdf-1.1.4/@ncvar/fillval.m create mode 100644 octave_packages/octcdf-1.1.4/@ncvar/name.m create mode 100644 octave_packages/octcdf-1.1.4/doc-cache create mode 100644 octave_packages/octcdf-1.1.4/example_netcdf.m create mode 100644 octave_packages/octcdf-1.1.4/example_opendap.m create mode 100644 octave_packages/octcdf-1.1.4/ncbyte.m create mode 100644 octave_packages/octcdf-1.1.4/ncchar.m create mode 100644 octave_packages/octcdf-1.1.4/ncdouble.m create mode 100644 octave_packages/octcdf-1.1.4/ncdump.m create mode 100644 octave_packages/octcdf-1.1.4/ncfillval.m create mode 100644 octave_packages/octcdf-1.1.4/ncfloat.m create mode 100644 octave_packages/octcdf-1.1.4/ncint.m create mode 100644 octave_packages/octcdf-1.1.4/nclong.m create mode 100644 octave_packages/octcdf-1.1.4/ncshort.m create mode 100644 octave_packages/octcdf-1.1.4/nctest.m create mode 100644 octave_packages/octcdf-1.1.4/packinfo/.autoload create mode 100644 octave_packages/octcdf-1.1.4/packinfo/DESCRIPTION create mode 100644 octave_packages/octcdf-1.1.4/packinfo/INDEX create mode 100644 octave_packages/octgpr-1.2.0/demo_octgpr.m create mode 100644 octave_packages/octgpr-1.2.0/doc-cache create mode 100644 octave_packages/octgpr-1.2.0/packinfo/.autoload create mode 100644 octave_packages/octgpr-1.2.0/packinfo/DESCRIPTION create mode 100644 octave_packages/octgpr-1.2.0/packinfo/INDEX create mode 100644 octave_packages/octgpr-1.2.0/rbf_centers.m create mode 100644 octave_packages/odepkg-0.8.2/bvp4c.m create mode 100644 octave_packages/odepkg-0.8.2/doc-cache create mode 100644 octave_packages/odepkg-0.8.2/doc.info create mode 100644 octave_packages/odepkg-0.8.2/ode23.m create mode 100644 octave_packages/odepkg-0.8.2/ode23d.m create mode 100644 octave_packages/odepkg-0.8.2/ode45.m create mode 100644 octave_packages/odepkg-0.8.2/ode45d.m create mode 100644 octave_packages/odepkg-0.8.2/ode54.m create mode 100644 octave_packages/odepkg-0.8.2/ode54d.m create mode 100644 octave_packages/odepkg-0.8.2/ode78.m create mode 100644 octave_packages/odepkg-0.8.2/ode78d.m create mode 100644 octave_packages/odepkg-0.8.2/odebwe.m create mode 100644 octave_packages/odepkg-0.8.2/odeexamples.m create mode 100644 octave_packages/odepkg-0.8.2/odeget.m create mode 100644 octave_packages/odepkg-0.8.2/odephas2.m create mode 100644 octave_packages/odepkg-0.8.2/odephas3.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_event_handle.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_examples_dae.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_examples_dde.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_examples_ide.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_examples_ode.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_structure_check.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_testsuite_calcmescd.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_testsuite_calcscd.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_testsuite_chemakzo.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_testsuite_hires.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_testsuite_implakzo.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_testsuite_implrober.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_testsuite_impltrans.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_testsuite_oregonator.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_testsuite_pollution.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_testsuite_robertson.m create mode 100644 octave_packages/odepkg-0.8.2/odepkg_testsuite_transistor.m create mode 100644 octave_packages/odepkg-0.8.2/odeplot.m create mode 100644 octave_packages/odepkg-0.8.2/odeprint.m create mode 100644 octave_packages/odepkg-0.8.2/odeset.m create mode 100644 octave_packages/odepkg-0.8.2/packinfo/.autoload create mode 100644 octave_packages/odepkg-0.8.2/packinfo/DESCRIPTION create mode 100644 octave_packages/odepkg-0.8.2/packinfo/INDEX create mode 100644 octave_packages/openmpi_ext-1.0.2/Pi.m create mode 100644 octave_packages/openmpi_ext-1.0.2/allnodes create mode 100644 octave_packages/openmpi_ext-1.0.2/doc-cache create mode 100644 octave_packages/openmpi_ext-1.0.2/hello2dimmat.m create mode 100644 octave_packages/openmpi_ext-1.0.2/hellocell.m create mode 100644 octave_packages/openmpi_ext-1.0.2/hellosparsemat.m create mode 100644 octave_packages/openmpi_ext-1.0.2/hellostruct.m create mode 100644 octave_packages/openmpi_ext-1.0.2/helloworld.m create mode 100644 octave_packages/openmpi_ext-1.0.2/mc_example.m create mode 100644 octave_packages/openmpi_ext-1.0.2/montecarlo.m create mode 100644 octave_packages/openmpi_ext-1.0.2/packinfo/.autoload create mode 100644 octave_packages/openmpi_ext-1.0.2/packinfo/DESCRIPTION create mode 100644 octave_packages/openmpi_ext-1.0.2/packinfo/INDEX create mode 100644 octave_packages/optim-1.2.0/LinearRegression.m create mode 100644 octave_packages/optim-1.2.0/PKG_ADD create mode 100644 octave_packages/optim-1.2.0/__bracket_min.m create mode 100644 octave_packages/optim-1.2.0/__poly_2_extrema.m create mode 100644 octave_packages/optim-1.2.0/__semi_bracket.m create mode 100644 octave_packages/optim-1.2.0/adsmax.m create mode 100644 octave_packages/optim-1.2.0/battery.m create mode 100644 octave_packages/optim-1.2.0/bfgsmin.m create mode 100644 octave_packages/optim-1.2.0/bfgsmin_example.m create mode 100644 octave_packages/optim-1.2.0/brent_line_min.m create mode 100644 octave_packages/optim-1.2.0/cauchy.m create mode 100644 octave_packages/optim-1.2.0/cdiff.m create mode 100644 octave_packages/optim-1.2.0/cg_min.m create mode 100644 octave_packages/optim-1.2.0/cpiv_bard.m create mode 100644 octave_packages/optim-1.2.0/curvefit_stat.m create mode 100644 octave_packages/optim-1.2.0/d2_min.m create mode 100644 octave_packages/optim-1.2.0/dcdp.m create mode 100644 octave_packages/optim-1.2.0/de_min.m create mode 100644 octave_packages/optim-1.2.0/deriv.m create mode 100644 octave_packages/optim-1.2.0/dfdp.m create mode 100644 octave_packages/optim-1.2.0/dfpdp.m create mode 100644 octave_packages/optim-1.2.0/dfxpdp.m create mode 100644 octave_packages/optim-1.2.0/doc-cache create mode 100644 octave_packages/optim-1.2.0/expfit.m create mode 100644 octave_packages/optim-1.2.0/fmin.m create mode 100644 octave_packages/optim-1.2.0/fmins.m create mode 100644 octave_packages/optim-1.2.0/fminsearch.m create mode 100644 octave_packages/optim-1.2.0/fminunc_compat.m create mode 100644 octave_packages/optim-1.2.0/gjp.m create mode 100644 octave_packages/optim-1.2.0/jacobs.m create mode 100644 octave_packages/optim-1.2.0/leasqr.m create mode 100644 octave_packages/optim-1.2.0/line_min.m create mode 100644 octave_packages/optim-1.2.0/linprog.m create mode 100644 octave_packages/optim-1.2.0/mdsmax.m create mode 100644 octave_packages/optim-1.2.0/minimize.m create mode 100644 octave_packages/optim-1.2.0/nelder_mead_min.m create mode 100644 octave_packages/optim-1.2.0/nmsmax.m create mode 100644 octave_packages/optim-1.2.0/nonlin_curvefit.m create mode 100644 octave_packages/optim-1.2.0/nonlin_min.m create mode 100644 octave_packages/optim-1.2.0/nonlin_residmin.m create mode 100644 octave_packages/optim-1.2.0/nrm.m create mode 100644 octave_packages/optim-1.2.0/optim_problems.m create mode 100644 octave_packages/optim-1.2.0/optimset_compat.m create mode 100644 octave_packages/optim-1.2.0/packinfo/.autoload create mode 100644 octave_packages/optim-1.2.0/packinfo/DESCRIPTION create mode 100644 octave_packages/optim-1.2.0/packinfo/INDEX create mode 100644 octave_packages/optim-1.2.0/packinfo/NEWS create mode 100644 octave_packages/optim-1.2.0/poly_2_ex.m create mode 100644 octave_packages/optim-1.2.0/polyconf.m create mode 100644 octave_packages/optim-1.2.0/polyfitinf.m create mode 100644 octave_packages/optim-1.2.0/powell.m create mode 100644 octave_packages/optim-1.2.0/private/__collect_constraints__.m create mode 100644 octave_packages/optim-1.2.0/private/__covd_wls__.m create mode 100644 octave_packages/optim-1.2.0/private/__covp_corp_wls__.m create mode 100644 octave_packages/optim-1.2.0/private/__dfdp__.m create mode 100644 octave_packages/optim-1.2.0/private/__lm_feasible__.m create mode 100644 octave_packages/optim-1.2.0/private/__lm_svd__.m create mode 100644 octave_packages/optim-1.2.0/private/__nonlin_residmin__.m create mode 100644 octave_packages/optim-1.2.0/private/__null_optim__.m create mode 100644 octave_packages/optim-1.2.0/private/__plot_cmds__.m create mode 100644 octave_packages/optim-1.2.0/private/__residmin_stat__.m create mode 100644 octave_packages/optim-1.2.0/private/__s2mat__.m create mode 100644 octave_packages/optim-1.2.0/private/__siman__.m create mode 100644 octave_packages/optim-1.2.0/private/__sqp__.m create mode 100644 octave_packages/optim-1.2.0/private/optim_problems_p_r_y.data create mode 100644 octave_packages/optim-1.2.0/residmin_stat.m create mode 100644 octave_packages/optim-1.2.0/rosenbrock.m create mode 100644 octave_packages/optim-1.2.0/samin_example.m create mode 100644 octave_packages/optim-1.2.0/test_d2_min_1.m create mode 100644 octave_packages/optim-1.2.0/test_d2_min_2.m create mode 100644 octave_packages/optim-1.2.0/test_d2_min_3.m create mode 100644 octave_packages/optim-1.2.0/test_fminunc_1.m create mode 100644 octave_packages/optim-1.2.0/test_min_1.m create mode 100644 octave_packages/optim-1.2.0/test_min_2.m create mode 100644 octave_packages/optim-1.2.0/test_min_3.m create mode 100644 octave_packages/optim-1.2.0/test_min_4.m create mode 100644 octave_packages/optim-1.2.0/test_minimize_1.m create mode 100644 octave_packages/optim-1.2.0/test_nelder_mead_min_1.m create mode 100644 octave_packages/optim-1.2.0/test_nelder_mead_min_2.m create mode 100644 octave_packages/optim-1.2.0/test_wpolyfit.m create mode 100644 octave_packages/optim-1.2.0/vfzero.m create mode 100644 octave_packages/optim-1.2.0/wpolyfit.m create mode 100644 octave_packages/optim-1.2.0/wrap_f_dfdp.m create mode 100644 octave_packages/optim-1.2.0/wsolve.m create mode 100644 octave_packages/optiminterp-0.3.3/doc-cache create mode 100644 octave_packages/optiminterp-0.3.3/example_optiminterp.m create mode 100644 octave_packages/optiminterp-0.3.3/optiminterp1.m create mode 100644 octave_packages/optiminterp-0.3.3/optiminterp2.m create mode 100644 octave_packages/optiminterp-0.3.3/optiminterp3.m create mode 100644 octave_packages/optiminterp-0.3.3/optiminterp4.m create mode 100644 octave_packages/optiminterp-0.3.3/optiminterpn.m create mode 100644 octave_packages/optiminterp-0.3.3/packinfo/.autoload create mode 100644 octave_packages/optiminterp-0.3.3/packinfo/DESCRIPTION create mode 100644 octave_packages/optiminterp-0.3.3/packinfo/INDEX create mode 100644 octave_packages/optiminterp-0.3.3/test_optiminterp.m create mode 100644 octave_packages/optiminterp-0.3.3/test_optiminterp_mult.m create mode 100644 octave_packages/plot-1.1.0/doc-cache create mode 100644 octave_packages/plot-1.1.0/dxfwrite.m create mode 100644 octave_packages/plot-1.1.0/gplot3.m create mode 100644 octave_packages/plot-1.1.0/hist2d.m create mode 100644 octave_packages/plot-1.1.0/packinfo/.autoload create mode 100644 octave_packages/plot-1.1.0/packinfo/DESCRIPTION create mode 100644 octave_packages/plot-1.1.0/packinfo/INDEX create mode 100644 octave_packages/plot-1.1.0/plotdecimate.m create mode 100644 octave_packages/plot-1.1.0/tics.m create mode 100644 octave_packages/plot-1.1.0/tricontour.m create mode 100644 octave_packages/plot-1.1.0/zoom.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/abs.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/blkdiag.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/cat.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/columns.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/conj.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/ctranspose.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/diag.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/diff.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/display.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/eq.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/exp.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/horzcat.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/inv.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/ispure.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/ldivide.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/log.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/minus.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/mldivide.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/mpower.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/mrdivide.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/mtimes.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/norm.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/plus.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/power.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/private/norm2.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/private/normv.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/quaternion.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/rdivide.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/rows.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/size.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/subsasgn.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/subsref.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/times.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/transpose.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/uminus.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/unit.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/uplus.m create mode 100644 octave_packages/quaternion-2.0.0/@quaternion/vertcat.m create mode 100644 octave_packages/quaternion-2.0.0/doc-cache create mode 100644 octave_packages/quaternion-2.0.0/packinfo/.autoload create mode 100644 octave_packages/quaternion-2.0.0/packinfo/DESCRIPTION create mode 100644 octave_packages/quaternion-2.0.0/packinfo/INDEX create mode 100644 octave_packages/quaternion-2.0.0/packinfo/NEWS create mode 100644 octave_packages/quaternion-2.0.0/q2rot.m create mode 100644 octave_packages/quaternion-2.0.0/qi.m create mode 100644 octave_packages/quaternion-2.0.0/qj.m create mode 100644 octave_packages/quaternion-2.0.0/qk.m create mode 100644 octave_packages/quaternion-2.0.0/rot2q.m create mode 100644 octave_packages/quaternion-2.0.0/test_quaternion.m create mode 100644 octave_packages/secs1d-0.0.8/DDG/DDGelectron_driftdiffusion.m create mode 100644 octave_packages/secs1d-0.0.8/DDG/DDGgummelmap.m create mode 100644 octave_packages/secs1d-0.0.8/DDG/DDGhole_driftdiffusion.m create mode 100644 octave_packages/secs1d-0.0.8/DDG/DDGn2phin.m create mode 100644 octave_packages/secs1d-0.0.8/DDG/DDGnlpoisson.m create mode 100644 octave_packages/secs1d-0.0.8/DDG/DDGp2phip.m create mode 100644 octave_packages/secs1d-0.0.8/DDG/DDGphin2n.m create mode 100644 octave_packages/secs1d-0.0.8/DDG/DDGphip2p.m create mode 100644 octave_packages/secs1d-0.0.8/DDG/DDGplotresults.m create mode 100644 octave_packages/secs1d-0.0.8/DDG/doc-cache create mode 100644 octave_packages/secs1d-0.0.8/DDN/DDNnewtonmap.m create mode 100644 octave_packages/secs1d-0.0.8/DDN/doc-cache create mode 100644 octave_packages/secs1d-0.0.8/PKG_ADD create mode 100644 octave_packages/secs1d-0.0.8/PKG_DEL create mode 100644 octave_packages/secs1d-0.0.8/Utilities/Ubern.m create mode 100644 octave_packages/secs1d-0.0.8/Utilities/Ubernoulli.m create mode 100644 octave_packages/secs1d-0.0.8/Utilities/Ucompconst.m create mode 100644 octave_packages/secs1d-0.0.8/Utilities/Ucomplap.m create mode 100644 octave_packages/secs1d-0.0.8/Utilities/Ucompmass.m create mode 100644 octave_packages/secs1d-0.0.8/Utilities/Udriftdiffusion.m create mode 100644 octave_packages/secs1d-0.0.8/Utilities/Umediaarmonica.m create mode 100644 octave_packages/secs1d-0.0.8/Utilities/Uscharfettergummel.m create mode 100644 octave_packages/secs1d-0.0.8/Utilities/constants.m create mode 100644 octave_packages/secs1d-0.0.8/Utilities/doc-cache create mode 100644 octave_packages/secs1d-0.0.8/doc-cache create mode 100644 octave_packages/secs1d-0.0.8/packinfo/.autoload create mode 100644 octave_packages/secs1d-0.0.8/packinfo/DESCRIPTION create mode 100644 octave_packages/secs1d-0.0.8/packinfo/INDEX create mode 100644 octave_packages/secs1d-0.0.8/secs1d.m create mode 100644 octave_packages/secs2d-0.0.8/DDGOX/DDGOXddcurrent.m create mode 100644 octave_packages/secs2d-0.0.8/DDGOX/DDGOXelectron_driftdiffusion.m create mode 100644 octave_packages/secs2d-0.0.8/DDGOX/DDGOXgummelmap.m create mode 100644 octave_packages/secs2d-0.0.8/DDGOX/DDGOXhole_driftdiffusion.m create mode 100644 octave_packages/secs2d-0.0.8/DDGOX/DDGOXnlpoisson.m create mode 100644 octave_packages/secs2d-0.0.8/DDGOX/DDGOXplotresults.m create mode 100644 octave_packages/secs2d-0.0.8/DDGOX/doc-cache create mode 100644 octave_packages/secs2d-0.0.8/DDGOXT/DDGOXTelectron_driftdiffusion.m create mode 100644 octave_packages/secs2d-0.0.8/DDGOXT/DDGOXTgummelmap.m create mode 100644 octave_packages/secs2d-0.0.8/DDGOXT/DDGOXThole_driftdiffusion.m create mode 100644 octave_packages/secs2d-0.0.8/DDGOXT/doc-cache create mode 100644 octave_packages/secs2d-0.0.8/METLINES/METLINEScapcomp.m create mode 100644 octave_packages/secs2d-0.0.8/METLINES/METLINESdefinepermittivity.m create mode 100644 octave_packages/secs2d-0.0.8/METLINES/doc-cache create mode 100644 octave_packages/secs2d-0.0.8/PKG_ADD create mode 100644 octave_packages/secs2d-0.0.8/PKG_DEL create mode 100644 octave_packages/secs2d-0.0.8/QDDGOX/QDDGOXcompdens.m create mode 100644 octave_packages/secs2d-0.0.8/QDDGOX/QDDGOXddcurrent.m create mode 100644 octave_packages/secs2d-0.0.8/QDDGOX/QDDGOXgummelmap.m create mode 100644 octave_packages/secs2d-0.0.8/QDDGOX/QDDGOXnlpoisson.m create mode 100644 octave_packages/secs2d-0.0.8/QDDGOX/doc-cache create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBN0STD.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBN1STD.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBP0STD.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBP1STD.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWN0STD.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWN1STD.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWP0STD.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWP1STD.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXddcurrent.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXelectron_driftdiffusion.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXeletiteration.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXgummelmap.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXhole_driftdiffusion.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXnlpoisson.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXthermaliteration.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXupdateelectron_temp.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXupdatehole_temp.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXupdatelattice_temp.m create mode 100644 octave_packages/secs2d-0.0.8/ThDDGOX/doc-cache create mode 100644 octave_packages/secs2d-0.0.8/Utilities/UDXappend2Ddata.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/UDXoutput2Ddata.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/UDXoutput2Dtimeseries.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/URREcyclingpattern.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ubern.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ucoloredrubbersheet.net create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ucoloredrubbersheetseries.net create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ucolumns.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ucompconst.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ucomplap.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ucompmass2.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Udescaling.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Udopdepmob.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Udrawcurrent.net create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Udrawedge.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Udriftdepmob.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Udriftdiffusion.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Udriftdiffusion2.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ufielddepmob.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ufvsgcurrent.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ufvsgcurrent2.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ufvsgcurrent3.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Uinvfermidirac.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Uise2pde.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ujoinmeshes.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Umeshproperties.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Umsh2pdetool.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Umshcreatemesh.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Unodesonside.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Updegrad.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Updemesh.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Updesurf.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Urows.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Urrextrapolation.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Urubbersheet.net create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Uscaling.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Uscharfettergummel.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Uscharfettergummel2.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Uscharfettergummel3.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ushowgrid.net create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Usmoothguess.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ustructmesh.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ustructmesh_left.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ustructmesh_random.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Ustructmesh_right.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Usubdomains2.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Usubmesh.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/Utemplogm.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/constants.m create mode 100644 octave_packages/secs2d-0.0.8/Utilities/constants.mat create mode 100644 octave_packages/secs2d-0.0.8/Utilities/doc-cache create mode 100644 octave_packages/secs2d-0.0.8/doc-cache create mode 100644 octave_packages/secs2d-0.0.8/packinfo/.autoload create mode 100644 octave_packages/secs2d-0.0.8/packinfo/DESCRIPTION create mode 100644 octave_packages/secs2d-0.0.8/packinfo/INDEX create mode 100644 octave_packages/secs2d-0.0.8/secs2d.m create mode 100644 octave_packages/signal-1.1.3/__power.m create mode 100644 octave_packages/signal-1.1.3/ar_psd.m create mode 100644 octave_packages/signal-1.1.3/arburg.m create mode 100644 octave_packages/signal-1.1.3/aryule.m create mode 100644 octave_packages/signal-1.1.3/barthannwin.m create mode 100644 octave_packages/signal-1.1.3/besselap.m create mode 100644 octave_packages/signal-1.1.3/besself.m create mode 100644 octave_packages/signal-1.1.3/bilinear.m create mode 100644 octave_packages/signal-1.1.3/bitrevorder.m create mode 100644 octave_packages/signal-1.1.3/blackmanharris.m create mode 100644 octave_packages/signal-1.1.3/blackmannuttall.m create mode 100644 octave_packages/signal-1.1.3/bohmanwin.m create mode 100644 octave_packages/signal-1.1.3/boxcar.m create mode 100644 octave_packages/signal-1.1.3/buffer.m create mode 100644 octave_packages/signal-1.1.3/butter.m create mode 100644 octave_packages/signal-1.1.3/buttord.m create mode 100644 octave_packages/signal-1.1.3/cceps.m create mode 100644 octave_packages/signal-1.1.3/cheb.m create mode 100644 octave_packages/signal-1.1.3/cheb1ord.m create mode 100644 octave_packages/signal-1.1.3/cheb2ord.m create mode 100644 octave_packages/signal-1.1.3/chebwin.m create mode 100644 octave_packages/signal-1.1.3/cheby1.m create mode 100644 octave_packages/signal-1.1.3/cheby2.m create mode 100644 octave_packages/signal-1.1.3/chirp.m create mode 100644 octave_packages/signal-1.1.3/cmorwavf.m create mode 100644 octave_packages/signal-1.1.3/cohere.m create mode 100644 octave_packages/signal-1.1.3/convmtx.m create mode 100644 octave_packages/signal-1.1.3/cplxreal.m create mode 100644 octave_packages/signal-1.1.3/cpsd.m create mode 100644 octave_packages/signal-1.1.3/csd.m create mode 100644 octave_packages/signal-1.1.3/czt.m create mode 100644 octave_packages/signal-1.1.3/data2fun.m create mode 100644 octave_packages/signal-1.1.3/dct.m create mode 100644 octave_packages/signal-1.1.3/dct2.m create mode 100644 octave_packages/signal-1.1.3/dctmtx.m create mode 100644 octave_packages/signal-1.1.3/decimate.m create mode 100644 octave_packages/signal-1.1.3/dftmtx.m create mode 100644 octave_packages/signal-1.1.3/diric.m create mode 100644 octave_packages/signal-1.1.3/doc-cache create mode 100644 octave_packages/signal-1.1.3/downsample.m create mode 100644 octave_packages/signal-1.1.3/dst.m create mode 100644 octave_packages/signal-1.1.3/dwt.m create mode 100644 octave_packages/signal-1.1.3/ellip.m create mode 100644 octave_packages/signal-1.1.3/ellipord.m create mode 100644 octave_packages/signal-1.1.3/fht.m create mode 100644 octave_packages/signal-1.1.3/filtfilt.m create mode 100644 octave_packages/signal-1.1.3/filtic.m create mode 100644 octave_packages/signal-1.1.3/fir1.m create mode 100644 octave_packages/signal-1.1.3/fir2.m create mode 100644 octave_packages/signal-1.1.3/firls.m create mode 100644 octave_packages/signal-1.1.3/flattopwin.m create mode 100644 octave_packages/signal-1.1.3/fracshift.m create mode 100644 octave_packages/signal-1.1.3/freqs.m create mode 100644 octave_packages/signal-1.1.3/freqs_plot.m create mode 100644 octave_packages/signal-1.1.3/fwhm.m create mode 100644 octave_packages/signal-1.1.3/gauspuls.m create mode 100644 octave_packages/signal-1.1.3/gaussian.m create mode 100644 octave_packages/signal-1.1.3/gausswin.m create mode 100644 octave_packages/signal-1.1.3/gmonopuls.m create mode 100644 octave_packages/signal-1.1.3/grpdelay.m create mode 100644 octave_packages/signal-1.1.3/hann.m create mode 100644 octave_packages/signal-1.1.3/hilbert.m create mode 100644 octave_packages/signal-1.1.3/idct.m create mode 100644 octave_packages/signal-1.1.3/idct2.m create mode 100644 octave_packages/signal-1.1.3/idst.m create mode 100644 octave_packages/signal-1.1.3/ifht.m create mode 100644 octave_packages/signal-1.1.3/iirlp2mb.m create mode 100644 octave_packages/signal-1.1.3/impinvar.m create mode 100644 octave_packages/signal-1.1.3/impz.m create mode 100644 octave_packages/signal-1.1.3/interp.m create mode 100644 octave_packages/signal-1.1.3/invfreq.m create mode 100644 octave_packages/signal-1.1.3/invfreqs.m create mode 100644 octave_packages/signal-1.1.3/invfreqz.m create mode 100644 octave_packages/signal-1.1.3/invimpinvar.m create mode 100644 octave_packages/signal-1.1.3/kaiser.m create mode 100644 octave_packages/signal-1.1.3/kaiserord.m create mode 100644 octave_packages/signal-1.1.3/levinson.m create mode 100644 octave_packages/signal-1.1.3/marcumq.m create mode 100644 octave_packages/signal-1.1.3/mexihat.m create mode 100644 octave_packages/signal-1.1.3/meyeraux.m create mode 100644 octave_packages/signal-1.1.3/morlet.m create mode 100644 octave_packages/signal-1.1.3/mscohere.m create mode 100644 octave_packages/signal-1.1.3/ncauer.m create mode 100644 octave_packages/signal-1.1.3/nuttallwin.m create mode 100644 octave_packages/signal-1.1.3/packinfo/.autoload create mode 100644 octave_packages/signal-1.1.3/packinfo/DESCRIPTION create mode 100644 octave_packages/signal-1.1.3/packinfo/INDEX create mode 100644 octave_packages/signal-1.1.3/packinfo/NEWS create mode 100644 octave_packages/signal-1.1.3/parzenwin.m create mode 100644 octave_packages/signal-1.1.3/pburg.m create mode 100644 octave_packages/signal-1.1.3/pei_tseng_notch.m create mode 100644 octave_packages/signal-1.1.3/polystab.m create mode 100644 octave_packages/signal-1.1.3/private/h1_z_deriv.m create mode 100644 octave_packages/signal-1.1.3/private/inv_residue.m create mode 100644 octave_packages/signal-1.1.3/private/polyrev.m create mode 100644 octave_packages/signal-1.1.3/private/to_real.m create mode 100644 octave_packages/signal-1.1.3/pulstran.m create mode 100644 octave_packages/signal-1.1.3/pwelch.m create mode 100644 octave_packages/signal-1.1.3/pyulear.m create mode 100644 octave_packages/signal-1.1.3/qp_kaiser.m create mode 100644 octave_packages/signal-1.1.3/rceps.m create mode 100644 octave_packages/signal-1.1.3/rectpuls.m create mode 100644 octave_packages/signal-1.1.3/rectwin.m create mode 100644 octave_packages/signal-1.1.3/resample.m create mode 100644 octave_packages/signal-1.1.3/residued.m create mode 100644 octave_packages/signal-1.1.3/residuez.m create mode 100644 octave_packages/signal-1.1.3/sampled2continuous.m create mode 100644 octave_packages/signal-1.1.3/sawtooth.m create mode 100644 octave_packages/signal-1.1.3/sftrans.m create mode 100644 octave_packages/signal-1.1.3/sgolay.m create mode 100644 octave_packages/signal-1.1.3/sgolayfilt.m create mode 100644 octave_packages/signal-1.1.3/shanwavf.m create mode 100644 octave_packages/signal-1.1.3/sigmoid_train.m create mode 100644 octave_packages/signal-1.1.3/sos2tf.m create mode 100644 octave_packages/signal-1.1.3/sos2zp.m create mode 100644 octave_packages/signal-1.1.3/specgram.m create mode 100644 octave_packages/signal-1.1.3/square.m create mode 100644 octave_packages/signal-1.1.3/ss2tf.m create mode 100644 octave_packages/signal-1.1.3/ss2zp.m create mode 100644 octave_packages/signal-1.1.3/tf2sos.m create mode 100644 octave_packages/signal-1.1.3/tf2ss.m create mode 100644 octave_packages/signal-1.1.3/tf2zp.m create mode 100644 octave_packages/signal-1.1.3/tfe.m create mode 100644 octave_packages/signal-1.1.3/tfestimate.m create mode 100644 octave_packages/signal-1.1.3/triang.m create mode 100644 octave_packages/signal-1.1.3/tripuls.m create mode 100644 octave_packages/signal-1.1.3/tukeywin.m create mode 100644 octave_packages/signal-1.1.3/upsample.m create mode 100644 octave_packages/signal-1.1.3/welchwin.m create mode 100644 octave_packages/signal-1.1.3/window.m create mode 100644 octave_packages/signal-1.1.3/wkeep.m create mode 100644 octave_packages/signal-1.1.3/wrev.m create mode 100644 octave_packages/signal-1.1.3/xcorr.m create mode 100644 octave_packages/signal-1.1.3/xcorr2.m create mode 100644 octave_packages/signal-1.1.3/xcov.m create mode 100644 octave_packages/signal-1.1.3/zerocrossing.m create mode 100644 octave_packages/signal-1.1.3/zp2sos.m create mode 100644 octave_packages/signal-1.1.3/zp2ss.m create mode 100644 octave_packages/signal-1.1.3/zp2tf.m create mode 100644 octave_packages/signal-1.1.3/zplane.m create mode 100644 octave_packages/sockets-1.0.8/packinfo/.autoload create mode 100644 octave_packages/sockets-1.0.8/packinfo/DESCRIPTION create mode 100644 octave_packages/sockets-1.0.8/packinfo/INDEX create mode 100644 octave_packages/sockets-1.0.8/packinfo/NEWS create mode 100644 octave_packages/specfun-1.1.0/Ci.m create mode 100644 octave_packages/specfun-1.1.0/Si.m create mode 100644 octave_packages/specfun-1.1.0/cosint.m create mode 100644 octave_packages/specfun-1.1.0/dirac.m create mode 100644 octave_packages/specfun-1.1.0/doc-cache create mode 100644 octave_packages/specfun-1.1.0/ellipke.m create mode 100644 octave_packages/specfun-1.1.0/erfcinv.m create mode 100644 octave_packages/specfun-1.1.0/expint.m create mode 100644 octave_packages/specfun-1.1.0/expint_E1.m create mode 100644 octave_packages/specfun-1.1.0/expint_Ei.m create mode 100644 octave_packages/specfun-1.1.0/heaviside.m create mode 100644 octave_packages/specfun-1.1.0/laguerre.m create mode 100644 octave_packages/specfun-1.1.0/lambertw.m create mode 100644 octave_packages/specfun-1.1.0/laplacian.m create mode 100644 octave_packages/specfun-1.1.0/multinom.m create mode 100644 octave_packages/specfun-1.1.0/multinom_coeff.m create mode 100644 octave_packages/specfun-1.1.0/multinom_exp.m create mode 100644 octave_packages/specfun-1.1.0/packinfo/.autoload create mode 100644 octave_packages/specfun-1.1.0/packinfo/DESCRIPTION create mode 100644 octave_packages/specfun-1.1.0/packinfo/INDEX create mode 100644 octave_packages/specfun-1.1.0/packinfo/NEWS create mode 100644 octave_packages/specfun-1.1.0/psi.m create mode 100644 octave_packages/specfun-1.1.0/sinint.m create mode 100644 octave_packages/specfun-1.1.0/zeta.m create mode 100644 octave_packages/splines-1.0.7/catmullrom.m create mode 100644 octave_packages/splines-1.0.7/csape.m create mode 100644 octave_packages/splines-1.0.7/csapi.m create mode 100644 octave_packages/splines-1.0.7/doc-cache create mode 100644 octave_packages/splines-1.0.7/fnder.m create mode 100644 octave_packages/splines-1.0.7/fnplt.m create mode 100644 octave_packages/splines-1.0.7/fnval.m create mode 100644 octave_packages/splines-1.0.7/packinfo/.autoload create mode 100644 octave_packages/splines-1.0.7/packinfo/DESCRIPTION create mode 100644 octave_packages/splines-1.0.7/packinfo/INDEX create mode 100644 octave_packages/statistics-1.1.3/anderson_darling_cdf.m create mode 100644 octave_packages/statistics-1.1.3/anderson_darling_test.m create mode 100644 octave_packages/statistics-1.1.3/anovan.m create mode 100644 octave_packages/statistics-1.1.3/betastat.m create mode 100644 octave_packages/statistics-1.1.3/binostat.m create mode 100644 octave_packages/statistics-1.1.3/boxplot.m create mode 100644 octave_packages/statistics-1.1.3/caseread.m create mode 100644 octave_packages/statistics-1.1.3/casewrite.m create mode 100644 octave_packages/statistics-1.1.3/chi2stat.m create mode 100644 octave_packages/statistics-1.1.3/cl_multinom.m create mode 100644 octave_packages/statistics-1.1.3/combnk.m create mode 100644 octave_packages/statistics-1.1.3/copulacdf.m create mode 100644 octave_packages/statistics-1.1.3/copulapdf.m create mode 100644 octave_packages/statistics-1.1.3/copularnd.m create mode 100644 octave_packages/statistics-1.1.3/doc-cache create mode 100644 octave_packages/statistics-1.1.3/expstat.m create mode 100644 octave_packages/statistics-1.1.3/ff2n.m create mode 100644 octave_packages/statistics-1.1.3/fstat.m create mode 100644 octave_packages/statistics-1.1.3/fullfact.m create mode 100644 octave_packages/statistics-1.1.3/gamfit.m create mode 100644 octave_packages/statistics-1.1.3/gamlike.m create mode 100644 octave_packages/statistics-1.1.3/gamstat.m create mode 100644 octave_packages/statistics-1.1.3/geomean.m create mode 100644 octave_packages/statistics-1.1.3/geostat.m create mode 100644 octave_packages/statistics-1.1.3/harmmean.m create mode 100644 octave_packages/statistics-1.1.3/histfit.m create mode 100644 octave_packages/statistics-1.1.3/hmmestimate.m create mode 100644 octave_packages/statistics-1.1.3/hmmgenerate.m create mode 100644 octave_packages/statistics-1.1.3/hmmviterbi.m create mode 100644 octave_packages/statistics-1.1.3/hygestat.m create mode 100644 octave_packages/statistics-1.1.3/jackknife.m create mode 100644 octave_packages/statistics-1.1.3/jsucdf.m create mode 100644 octave_packages/statistics-1.1.3/jsupdf.m create mode 100644 octave_packages/statistics-1.1.3/kmeans.m create mode 100644 octave_packages/statistics-1.1.3/linkage.m create mode 100644 octave_packages/statistics-1.1.3/lognstat.m create mode 100644 octave_packages/statistics-1.1.3/mad.m create mode 100644 octave_packages/statistics-1.1.3/mnpdf.m create mode 100644 octave_packages/statistics-1.1.3/mnrnd.m create mode 100644 octave_packages/statistics-1.1.3/monotone_smooth.m create mode 100644 octave_packages/statistics-1.1.3/mvncdf.m create mode 100644 octave_packages/statistics-1.1.3/mvnpdf.m create mode 100644 octave_packages/statistics-1.1.3/mvnrnd.m create mode 100644 octave_packages/statistics-1.1.3/mvtcdf.m create mode 100644 octave_packages/statistics-1.1.3/mvtrnd.m create mode 100644 octave_packages/statistics-1.1.3/nanmax.m create mode 100644 octave_packages/statistics-1.1.3/nanmean.m create mode 100644 octave_packages/statistics-1.1.3/nanmedian.m create mode 100644 octave_packages/statistics-1.1.3/nanmin.m create mode 100644 octave_packages/statistics-1.1.3/nanstd.m create mode 100644 octave_packages/statistics-1.1.3/nansum.m create mode 100644 octave_packages/statistics-1.1.3/nanvar.m create mode 100644 octave_packages/statistics-1.1.3/nbinstat.m create mode 100644 octave_packages/statistics-1.1.3/normalise_distribution.m create mode 100644 octave_packages/statistics-1.1.3/normplot.m create mode 100644 octave_packages/statistics-1.1.3/normstat.m create mode 100644 octave_packages/statistics-1.1.3/packinfo/.autoload create mode 100644 octave_packages/statistics-1.1.3/packinfo/DESCRIPTION create mode 100644 octave_packages/statistics-1.1.3/packinfo/INDEX create mode 100644 octave_packages/statistics-1.1.3/packinfo/NEWS create mode 100644 octave_packages/statistics-1.1.3/pdist.m create mode 100644 octave_packages/statistics-1.1.3/poisstat.m create mode 100644 octave_packages/statistics-1.1.3/princomp.m create mode 100644 octave_packages/statistics-1.1.3/private/tbl_delim.m create mode 100644 octave_packages/statistics-1.1.3/random.m create mode 100644 octave_packages/statistics-1.1.3/raylcdf.m create mode 100644 octave_packages/statistics-1.1.3/raylinv.m create mode 100644 octave_packages/statistics-1.1.3/raylpdf.m create mode 100644 octave_packages/statistics-1.1.3/raylrnd.m create mode 100644 octave_packages/statistics-1.1.3/raylstat.m create mode 100644 octave_packages/statistics-1.1.3/regress.m create mode 100644 octave_packages/statistics-1.1.3/repanova.m create mode 100644 octave_packages/statistics-1.1.3/squareform.m create mode 100644 octave_packages/statistics-1.1.3/tabulate.m create mode 100644 octave_packages/statistics-1.1.3/tblread.m create mode 100644 octave_packages/statistics-1.1.3/tblwrite.m create mode 100644 octave_packages/statistics-1.1.3/trimmean.m create mode 100644 octave_packages/statistics-1.1.3/tstat.m create mode 100644 octave_packages/statistics-1.1.3/unidstat.m create mode 100644 octave_packages/statistics-1.1.3/unifstat.m create mode 100644 octave_packages/statistics-1.1.3/vmpdf.m create mode 100644 octave_packages/statistics-1.1.3/vmrnd.m create mode 100644 octave_packages/statistics-1.1.3/wblstat.m create mode 100644 octave_packages/strings-1.1.0/base64decode.m create mode 100644 octave_packages/strings-1.1.0/base64encode.m create mode 100644 octave_packages/strings-1.1.0/cstrcmp.m create mode 100644 octave_packages/strings-1.1.0/doc-cache create mode 100644 octave_packages/strings-1.1.0/editdistance.m create mode 100644 octave_packages/strings-1.1.0/packinfo/.autoload create mode 100644 octave_packages/strings-1.1.0/packinfo/DESCRIPTION create mode 100644 octave_packages/strings-1.1.0/packinfo/INDEX create mode 100644 octave_packages/strings-1.1.0/packinfo/NEWS create mode 100644 octave_packages/strings-1.1.0/strjoin.m create mode 100644 octave_packages/strings-1.1.0/strsort.m create mode 100644 octave_packages/struct-1.0.10/doc-cache create mode 100644 octave_packages/struct-1.0.10/getfields.m create mode 100644 octave_packages/struct-1.0.10/packinfo/.autoload create mode 100644 octave_packages/struct-1.0.10/packinfo/DESCRIPTION create mode 100644 octave_packages/struct-1.0.10/packinfo/INDEX create mode 100644 octave_packages/struct-1.0.10/packinfo/NEWS create mode 100644 octave_packages/struct-1.0.10/setfields.m create mode 100644 octave_packages/struct-1.0.10/tars.m create mode 100644 octave_packages/struct-1.0.10/test_struct.m create mode 100644 octave_packages/symbolic-1.1.0/doc-cache create mode 100644 octave_packages/symbolic-1.1.0/findsym.m create mode 100644 octave_packages/symbolic-1.1.0/packinfo/.autoload create mode 100644 octave_packages/symbolic-1.1.0/packinfo/DESCRIPTION create mode 100644 octave_packages/symbolic-1.1.0/packinfo/INDEX create mode 100644 octave_packages/symbolic-1.1.0/poly2sym.m create mode 100644 octave_packages/symbolic-1.1.0/splot.m create mode 100644 octave_packages/symbolic-1.1.0/sym2poly.m create mode 100644 octave_packages/symbolic-1.1.0/symfsolve.m create mode 100644 octave_packages/tsa-4.2.4/aar.m create mode 100644 octave_packages/tsa-4.2.4/aarmam.m create mode 100644 octave_packages/tsa-4.2.4/ac2poly.m create mode 100644 octave_packages/tsa-4.2.4/ac2rc.m create mode 100644 octave_packages/tsa-4.2.4/acorf.m create mode 100644 octave_packages/tsa-4.2.4/acovf.m create mode 100644 octave_packages/tsa-4.2.4/adim.m create mode 100644 octave_packages/tsa-4.2.4/amarma.m create mode 100644 octave_packages/tsa-4.2.4/ar2poly.m create mode 100644 octave_packages/tsa-4.2.4/ar2rc.m create mode 100644 octave_packages/tsa-4.2.4/ar_spa.m create mode 100644 octave_packages/tsa-4.2.4/arcext.m create mode 100644 octave_packages/tsa-4.2.4/arfit2.m create mode 100644 octave_packages/tsa-4.2.4/biacovf.m create mode 100644 octave_packages/tsa-4.2.4/bisdemo.m create mode 100644 octave_packages/tsa-4.2.4/bispec.m create mode 100644 octave_packages/tsa-4.2.4/content.m create mode 100644 octave_packages/tsa-4.2.4/contents.m create mode 100644 octave_packages/tsa-4.2.4/covm.m create mode 100644 octave_packages/tsa-4.2.4/detrend.m create mode 100644 octave_packages/tsa-4.2.4/doc-cache create mode 100644 octave_packages/tsa-4.2.4/durlev.m create mode 100644 octave_packages/tsa-4.2.4/eeg8s.mat create mode 100644 octave_packages/tsa-4.2.4/flag_implicit_samplerate.m create mode 100644 octave_packages/tsa-4.2.4/flag_implicit_skip_nan.m create mode 100644 octave_packages/tsa-4.2.4/flix.m create mode 100644 octave_packages/tsa-4.2.4/histo.m create mode 100644 octave_packages/tsa-4.2.4/histo2.m create mode 100644 octave_packages/tsa-4.2.4/histo3.m create mode 100644 octave_packages/tsa-4.2.4/histo4.m create mode 100644 octave_packages/tsa-4.2.4/hup.m create mode 100644 octave_packages/tsa-4.2.4/invest0.m create mode 100644 octave_packages/tsa-4.2.4/invest1.m create mode 100644 octave_packages/tsa-4.2.4/invfdemo.m create mode 100644 octave_packages/tsa-4.2.4/lattice.m create mode 100644 octave_packages/tsa-4.2.4/lpc.m create mode 100644 octave_packages/tsa-4.2.4/mvaar.m create mode 100644 octave_packages/tsa-4.2.4/mvar.m create mode 100644 octave_packages/tsa-4.2.4/mvfilter.m create mode 100644 octave_packages/tsa-4.2.4/mvfreqz.m create mode 100644 octave_packages/tsa-4.2.4/pacf.m create mode 100644 octave_packages/tsa-4.2.4/packinfo/DESCRIPTION create mode 100644 octave_packages/tsa-4.2.4/packinfo/INDEX create mode 100644 octave_packages/tsa-4.2.4/parcor.m create mode 100644 octave_packages/tsa-4.2.4/poly2ac.m create mode 100644 octave_packages/tsa-4.2.4/poly2ar.m create mode 100644 octave_packages/tsa-4.2.4/poly2rc.m create mode 100644 octave_packages/tsa-4.2.4/rc2ac.m create mode 100644 octave_packages/tsa-4.2.4/rc2ar.m create mode 100644 octave_packages/tsa-4.2.4/rc2poly.m create mode 100644 octave_packages/tsa-4.2.4/rmle.m create mode 100644 octave_packages/tsa-4.2.4/sbispec.m create mode 100644 octave_packages/tsa-4.2.4/selmo.m create mode 100644 octave_packages/tsa-4.2.4/selmo2.m create mode 100644 octave_packages/tsa-4.2.4/sinvest1.m create mode 100644 octave_packages/tsa-4.2.4/sumskipnan.m create mode 100644 octave_packages/tsa-4.2.4/tsademo.m create mode 100644 octave_packages/tsa-4.2.4/ucp.m create mode 100644 octave_packages/tsa-4.2.4/y2res.m create mode 100644 octave_packages/vrml-1.0.13/best_dir.m create mode 100644 octave_packages/vrml-1.0.13/best_dir_cov.m create mode 100644 octave_packages/vrml-1.0.13/bound_convex.m create mode 100644 octave_packages/vrml-1.0.13/checker_color.m create mode 100644 octave_packages/vrml-1.0.13/doc-cache create mode 100644 octave_packages/vrml-1.0.13/packinfo/.autoload create mode 100644 octave_packages/vrml-1.0.13/packinfo/DESCRIPTION create mode 100644 octave_packages/vrml-1.0.13/packinfo/INDEX create mode 100644 octave_packages/vrml-1.0.13/packinfo/NEWS create mode 100644 octave_packages/vrml-1.0.13/proplan.m create mode 100644 octave_packages/vrml-1.0.13/save_vrml.m create mode 100644 octave_packages/vrml-1.0.13/test_moving_surf.m create mode 100644 octave_packages/vrml-1.0.13/test_vmesh.m create mode 100644 octave_packages/vrml-1.0.13/test_vrml_faces.m create mode 100644 octave_packages/vrml-1.0.13/vmesh.m create mode 100644 octave_packages/vrml-1.0.13/vrml_Background.m create mode 100644 octave_packages/vrml-1.0.13/vrml_Box.m create mode 100644 octave_packages/vrml-1.0.13/vrml_DirectionalLight.m create mode 100644 octave_packages/vrml-1.0.13/vrml_PointLight.m create mode 100644 octave_packages/vrml-1.0.13/vrml_ROUTE.m create mode 100644 octave_packages/vrml-1.0.13/vrml_Sphere.m create mode 100644 octave_packages/vrml-1.0.13/vrml_TimeSensor.m create mode 100644 octave_packages/vrml-1.0.13/vrml_Viewpoint.m create mode 100644 octave_packages/vrml-1.0.13/vrml_anim.m create mode 100644 octave_packages/vrml-1.0.13/vrml_arrow.m create mode 100644 octave_packages/vrml-1.0.13/vrml_browse.m create mode 100644 octave_packages/vrml-1.0.13/vrml_cyl.m create mode 100644 octave_packages/vrml-1.0.13/vrml_demo_tutorial_1.m create mode 100644 octave_packages/vrml-1.0.13/vrml_demo_tutorial_2.m create mode 100644 octave_packages/vrml-1.0.13/vrml_demo_tutorial_3.m create mode 100644 octave_packages/vrml-1.0.13/vrml_demo_tutorial_4.m create mode 100644 octave_packages/vrml-1.0.13/vrml_ellipsoid.m create mode 100644 octave_packages/vrml-1.0.13/vrml_faces.m create mode 100644 octave_packages/vrml-1.0.13/vrml_flatten.m create mode 100644 octave_packages/vrml-1.0.13/vrml_frame.m create mode 100644 octave_packages/vrml-1.0.13/vrml_group.m create mode 100644 octave_packages/vrml-1.0.13/vrml_interp.m create mode 100644 octave_packages/vrml-1.0.13/vrml_kill.m create mode 100644 octave_packages/vrml-1.0.13/vrml_lines.m create mode 100644 octave_packages/vrml-1.0.13/vrml_material.m create mode 100644 octave_packages/vrml-1.0.13/vrml_newname.m create mode 100644 octave_packages/vrml-1.0.13/vrml_parallelepiped.m create mode 100644 octave_packages/vrml-1.0.13/vrml_parallelogram.m create mode 100644 octave_packages/vrml-1.0.13/vrml_points.m create mode 100644 octave_packages/vrml-1.0.13/vrml_surf.m create mode 100644 octave_packages/vrml-1.0.13/vrml_text.m create mode 100644 octave_packages/vrml-1.0.13/vrml_thick_surf.m create mode 100644 octave_packages/vrml-1.0.13/vrml_transfo.m create mode 100644 octave_packages/zenity-0.5.7/doc-cache create mode 100644 octave_packages/zenity-0.5.7/packinfo/.autoload create mode 100644 octave_packages/zenity-0.5.7/packinfo/DESCRIPTION create mode 100644 octave_packages/zenity-0.5.7/packinfo/INDEX create mode 100644 octave_packages/zenity-0.5.7/zenity_calendar.m create mode 100644 octave_packages/zenity-0.5.7/zenity_entry.m create mode 100644 octave_packages/zenity-0.5.7/zenity_file_selection.m create mode 100644 octave_packages/zenity-0.5.7/zenity_list.m create mode 100644 octave_packages/zenity-0.5.7/zenity_message.m create mode 100644 octave_packages/zenity-0.5.7/zenity_notification.m create mode 100644 octave_packages/zenity-0.5.7/zenity_progress.m create mode 100644 octave_packages/zenity-0.5.7/zenity_scale.m create mode 100644 octave_packages/zenity-0.5.7/zenity_text_info.m diff --git a/octave_packages/audio-1.1.4/au.m b/octave_packages/audio-1.1.4/au.m new file mode 100644 index 0000000..a194bfd --- /dev/null +++ b/octave_packages/audio-1.1.4/au.m @@ -0,0 +1,51 @@ +## Copyright (C) 2000 Paul Kienzle +## +## 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 . + +## y = au(x, fs, lo [, hi]) +## +## Extract data from x for time range lo to hi in milliseconds. If lo +## is [], start at the beginning. If hi is [], go to the end. If hi is +## not specified, return the single element at lo. If lo<0, prepad the +## signal to time lo. If hi is beyond the end, postpad the signal to +## time hi. + +## TODO: modify prepad and postpad so that they accept matrices. +function y=au(x,fs,lo,hi) + if nargin<3 || nargin>4, + usage("y = au(x, fs, lo [,hi])"); + endif + + if nargin<4, hi=lo; endif + if isempty(lo), + lo=1; + else + lo=fix(lo*fs/1000)+1; + endif + if isempty(hi), + hi=length(x); + else + hi=fix(hi*fs/1000)+1; + endif + if hilength(x)), y=postpad(y,length(y)+hi-length(x)); endif + else + y=x(max(lo,1):min(hi,length(x)), :); + if (lo<1), y=[zeros(size(x,2),-lo+1) ; y]; endif + if (hi>length(x)), y=[y ; zeros(size(x,2),hi-length(x))]; endif + endif +endfunction diff --git a/octave_packages/audio-1.1.4/auload.m b/octave_packages/audio-1.1.4/auload.m new file mode 100644 index 0000000..833e470 --- /dev/null +++ b/octave_packages/audio-1.1.4/auload.m @@ -0,0 +1,383 @@ +## Copyright (C) 1999 Paul Kienzle +## +## 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},@var{fs},@var{sampleformat}] =} auload (@var{filename}) +## +## Reads an audio waveform from a file given by the string @var{filename}. +## Returns the audio samples in data, one column per channel, one row per +## time slice. Also returns the sample rate and stored format (one of ulaw, +## alaw, char, int16, int24, int32, float, double). The sample value will be +## normalized to the range [-1,1] regardless of the stored format. +## +## @example +## [x, fs] = auload(file_in_loadpath("sample.wav")); +## auplot(x,fs); +## @end example +## +## Note that translating the asymmetric range [-2^n,2^n-1] into the +## symmetric range [-1,1] requires a DC offset of 2/2^n. The inverse +## process used by ausave requires a DC offset of -2/2^n, so loading and +## saving a file will not change the contents. Other applications may +## compensate for the asymmetry in a different way (including previous +## versions of auload/ausave) so you may find small differences in +## calculated DC offsets for the same file. +## @end deftypefn + +## 2001-09-04 Paul Kienzle +## * skip unknown blocks in WAVE format. +## 2001-09-05 Paul Kienzle +## * remove debugging stuff from AIFF format. +## * use data length if it is given rather than reading to the end of file. +## 2001-12-11 Paul Kienzle +## * use closed interval [-1,1] rather than open interval [-1,1) internally + +function [data, rate, sampleformat] = auload(path) + + if (nargin != 1) + usage("[x, fs, sampleformat] = auload('filename.ext')"); + end + data = []; # if error then read nothing + rate = 8000; + sampleformat = 'ulaw'; + ext = rindex(path, '.'); + if (ext == 0) + usage('x = auload(filename.ext)'); + end + ext = tolower(substr(path, ext+1, length(path)-ext)); + + [file, msg] = fopen(path, 'rb'); + if (file == -1) + error([ msg, ": ", path]); + end + + msg = sprintf('Invalid audio header: %s', path); + ## Microsoft .wav format + if strcmp(ext,'wav') + + ## Header format obtained from sox/wav.c + ## April 15, 1992 + ## Copyright 1992 Rick Richardson + ## Copyright 1991 Lance Norskog And Sundry Contributors + ## This source code is freely redistributable and may be used for + ## any purpose. This copyright notice must be maintained. + ## Lance Norskog And Sundry Contributors are not responsible for + ## the consequences of using this software. + + ## check the file magic header bytes + arch = 'ieee-le'; + str = char(fread(file, 4, 'char')'); + if !strcmp(str, 'RIFF') + error(msg); + end + len = fread(file, 1, 'int32', 0, arch); + str = char(fread(file, 4, 'char')'); + if !strcmp(str, 'WAVE') + error(msg); + end + + ## skip to the "fmt " section, ignoring everything else + while (1) + if feof(file) + error(msg); + end + str = char(fread(file, 4, 'char')'); + len = fread(file, 1, 'int32', 0, arch); + if strcmp(str, 'fmt ') + break; + end + fseek(file, len, SEEK_CUR); + end + + ## read the "fmt " section + formatid = fread(file, 1, 'int16', 0, arch); + channels = fread(file, 1, 'int16', 0, arch); + rate = fread(file, 1, 'int32', 0, arch); + fread(file, 1, 'int32', 0, arch); + fread(file, 1, 'int16', 0, arch); + bits = fread(file, 1, 'int16', 0, arch); + fseek(file, len-16, SEEK_CUR); + + ## skip to the "data" section, ignoring everything else + while (1) + if feof(file) + error(msg); + end + str = char(fread(file, 4, 'char')'); + len = fread(file, 1, 'int32', 0, arch); + if strcmp(str, 'data') + break; + end + fseek(file, len, SEEK_CUR); + end + + if (formatid == 1) + if bits == 8 + sampleformat = 'uchar'; + precision = 'uchar'; + samples = len; + elseif bits == 16 + sampleformat = 'int16'; + precision = 'int16'; + samples = len/2; + elseif bits == 24 + sampleformat = 'int24'; + precision = 'int24'; + samples = len/3; + elseif bits == 32 + sampleformat = 'int32'; + precision = 'int32'; + samples = len/4; + else + error(msg); + endif + elseif (formatid == 3) + if bits == 32 + sampleformat = 'float'; + precision = 'float'; + samples = len/4; + elseif bits == 64 + sampleformat = 'double'; + precision = 'double'; + samples = len/8; + else + error(msg); + endif + elseif (formatid == 6 && bits == 8) + sampleformat = 'alaw'; + precision = 'uchar'; + samples = len; + elseif (formatid == 7 && bits == 8) + sampleformat = 'ulaw'; + precision = 'uchar'; + samples = len; + else + error(msg); + return; + endif + + ## Sun .au format + elseif strcmp(ext, 'au') + + ## Header format obtained from sox/au.c + ## September 25, 1991 + ## Copyright 1991 Guido van Rossum And Sundry Contributors + ## This source code is freely redistributable and may be used for + ## any purpose. This copyright notice must be maintained. + ## Guido van Rossum And Sundry Contributors are not responsible for + ## the consequences of using this software. + + str = char(fread(file, 4, 'char')'); + magic=' ds.'; + invmagic='ds. '; + magic(1) = char(0); + invmagic(1) = char(0); + if strcmp(str, 'dns.') || strcmp(str, magic) + arch = 'ieee-le'; + elseif strcmp(str, '.snd') || strcmp(str, invmagic) + arch = 'ieee-be'; + else + error(msg); + end + header = fread(file, 1, 'int32', 0, 'ieee-be'); + len = fread(file, 1, 'int32', 0, 'ieee-be'); + formatid = fread(file, 1, 'int32', 0, 'ieee-be'); + rate = fread(file, 1, 'int32', 0, 'ieee-be'); + channels = fread(file, 1, 'int32', 0, 'ieee-be'); + fseek(file, header-24, SEEK_CUR); % skip file comment + + ## interpret the sample format + if formatid == 1 + sampleformat = 'ulaw'; + precision = 'uchar'; + bits = 12; + samples = len; + elseif formatid == 2 + sampleformat = 'uchar'; + precision = 'uchar'; + bits = 8; + samples = len; + elseif formatid == 3 + sampleformat = 'int16'; + precision = 'int16'; + bits = 16; + samples = len/2; + elseif formatid == 5 + sampleformat = 'int32'; + precision = 'int32'; + bits = 32; + samples = len/4; + elseif formatid == 6 + sampleformat = 'float'; + precision = 'float'; + bits = 32; + samples = len/4; + elseif formatid == 7 + sampleformat = 'double'; + precision = 'double'; + bits = 64; + samples = len/8; + else + error(msg); + end + + ## Apple/SGI .aiff format + elseif strcmp(ext,'aiff') || strcmp(ext,'aif') + + ## Header format obtained from sox/aiff.c + ## September 25, 1991 + ## Copyright 1991 Guido van Rossum And Sundry Contributors + ## This source code is freely redistributable and may be used for + ## any purpose. This copyright notice must be maintained. + ## Guido van Rossum And Sundry Contributors are not responsible for + ## the consequences of using this software. + ## + ## IEEE 80-bit float I/O taken from + ## ftp://ftp.mathworks.com/pub/contrib/signal/osprey.tar + ## David K. Mellinger + ## dave@mbari.org + ## +1-831-775-1805 + ## fax -1620 + ## Monterey Bay Aquarium Research Institute + ## 7700 Sandholdt Road + + ## check the file magic header bytes + arch = 'ieee-be'; + str = char(fread(file, 4, 'char')'); + if !strcmp(str, 'FORM') + error(msg); + end + len = fread(file, 1, 'int32', 0, arch); + str = char(fread(file, 4, 'char')'); + if !strcmp(str, 'AIFF') + error(msg); + end + + ## skip to the "COMM" section, ignoring everything else + while (1) + if feof(file) + error(msg); + end + str = char(fread(file, 4, 'char')'); + len = fread(file, 1, 'int32', 0, arch); + if strcmp(str, 'COMM') + break; + end + fseek(file, len, SEEK_CUR); + end + + ## read the "COMM" section + channels = fread(file, 1, 'int16', 0, arch); + frames = fread(file, 1, 'int32', 0, arch); + bits = fread(file, 1, 'int16', 0, arch); + exp = fread(file, 1, 'uint16', 0, arch); % read a 10-byte float + mant = fread(file, 2, 'uint32', 0, arch); + mant = mant(1) / 2^31 + mant(2) / 2^63; + if (exp >= 32768), mant = -mant; exp = exp - 32768; end + exp = exp - 16383; + rate = mant * 2^exp; + fseek(file, len-18, SEEK_CUR); + + ## skip to the "SSND" section, ignoring everything else + while (1) + if feof(file) + error(msg); + end + str = char(fread(file, 4, 'char')'); + len = fread(file, 1, 'int32', 0, arch); + if strcmp(str, 'SSND') + break; + end + fseek(file, len, SEEK_CUR); + end + offset = fread(file, 1, 'int32', 0, arch); + fread(file, 1, 'int32', 0, arch); + fseek(file, offset, SEEK_CUR); + + if bits == 8 + precision = 'uchar'; + sampleformat = 'uchar'; + samples = len - 8; + elseif bits == 16 + precision = 'int16'; + sampleformat = 'int16'; + samples = (len - 8)/2; + elseif bits == 32 + precision = 'int32'; + sampleformat = 'int32'; + samples = (len - 8)/4; + else + error(msg); + endif + + ## file extension unknown + else + error('auload(filename.ext) understands .wav .au and .aiff only'); + end + + ## suck in all the samples + if (samples <= 0) samples = Inf; end + if (precision == 'int24') + data = fread(file, 3*samples, 'uint8', 0, arch); + if (arch == 'ieee-le') + data = data(1:3:end) + data(2:3:end) * 2^8 + cast(typecast(cast(data(3:3:end), 'uint8'), 'int8'), 'double') * 2^16; + else + data = data(3:3:end) + data(2:3:end) * 2^8 + cast(typecast(cast(data(1:3:end), 'uint8'), 'int8'), 'double') * 2^16; + endif + else + data = fread(file, samples, precision, 0, arch); + endif + fclose(file); + + ## convert samples into range [-1, 1) + if strcmp(sampleformat, 'alaw') + alaw = [ \ + -5504, -5248, -6016, -5760, -4480, -4224, -4992, -4736, \ + -7552, -7296, -8064, -7808, -6528, -6272, -7040, -6784, \ + -2752, -2624, -3008, -2880, -2240, -2112, -2496, -2368, \ + -3776, -3648, -4032, -3904, -3264, -3136, -3520, -3392, \ + -22016, -20992, -24064, -23040, -17920, -16896, -19968, -18944, \ + -30208, -29184, -32256, -31232, -26112, -25088, -28160, -27136, \ + -11008, -10496, -12032, -11520, -8960, -8448, -9984, -9472, \ + -15104, -14592, -16128, -15616, -13056, -12544, -14080, -13568, \ + -344, -328, -376, -360, -280, -264, -312, -296, \ + -472, -456, -504, -488, -408, -392, -440, -424, \ + -88, -72, -120, -104, -24, -8, -56, -40, \ + -216, -200, -248, -232, -152, -136, -184, -168, \ + -1376, -1312, -1504, -1440, -1120, -1056, -1248, -1184, \ + -1888, -1824, -2016, -1952, -1632, -1568, -1760, -1696, \ + -688, -656, -752, -720, -560, -528, -624, -592, \ + -944, -912, -1008, -976, -816, -784, -880, -848 ]; + alaw = ([ alaw,-alaw]+0.5)/32767.5; + data = alaw(data+1); + elseif strcmp(sampleformat, 'ulaw') + data = mu2lin(data, 0); + elseif strcmp(sampleformat, 'uchar') + ## [ 0, 255 ] -> [ -1, 1 ] + data = data/127.5 - 1; + elseif strcmp(sampleformat, 'int16') + ## [ -32768, 32767 ] -> [ -1, 1 ] + data = (data+0.5)/32767.5; + elseif strcmp(sampleformat, 'int32') + ## [ -2^31, 2^31-1 ] -> [ -1, 1 ] + data = (data+0.5)/(2^31-0.5); + end + data = reshape(data, channels, length(data)/channels)'; + +endfunction + +%!demo +%! [x, fs] = auload(file_in_loadpath("sample.wav")); +%! auplot(x,fs); diff --git a/octave_packages/audio-1.1.4/auplot.m b/octave_packages/audio-1.1.4/auplot.m new file mode 100644 index 0000000..45e2203 --- /dev/null +++ b/octave_packages/audio-1.1.4/auplot.m @@ -0,0 +1,197 @@ +## Copyright (C) 1999 Paul Kienzle +## +## 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{y},@var{t},@var{scale}] = } auplot (@var{x}) +## @deftypefnx {Function File} {[@var{y},@var{t},@var{scale}] = } auplot (@var{x},@var{fs}) +## @deftypefnx {Function File} {[@var{y},@var{t},@var{scale}] = } auplot (@var{x},@var{fs},@var{offset}) +## @deftypefnx {Function File} {[@var{y},@var{t},@var{scale}] = } auplot (@var{...},@var{plotstr}) +## +## Plot the waveform data, displaying time on the @var{x} axis. If you are +## plotting a slice from the middle of an array, you may want to specify +## the @var{offset} into the array to retain the appropriate time index. If +## the waveform contains multiple channels, then the data are scaled to +## the range [-1,1] and shifted so that they do not overlap. If a @var{plotstr} +## is given, it is passed as the third argument to the plot command. This +## allows you to set the linestyle easily. @var{fs} defaults to 8000 Hz, and +## @var{offset} defaults to 0 samples. +## +## Instead of plotting directly, you can ask for the returned processed +## vectors. If @var{y} has multiple channels, the plot should have the y-range +## [-1 2*size(y,2)-1]. scale specifies how much the matrix was scaled +## so that each signal would fit in the specified range. +## +## Since speech samples can be very long, we need a way to plot them +## rapidly. For long signals, auplot windows the data and keeps the +## minimum and maximum values in the window. Together, these values +## define the minimal polygon which contains the signal. The number of +## points in the polygon is set with the global variable auplot_points. +## The polygon may be either 'filled' or 'outline', as set by the global +## variable auplot_format. For moderately long data, the window does +## not contain enough points to draw an interesting polygon. In this +## case, simply choosing an arbitrary point from the window looks best. +## The global variable auplot_window sets the size of the window +## required for creating polygons. You can turn off the polygons +## entirely by setting auplot_format to 'sampled'. To turn off fast +## plotting entirely, set auplot_format to 'direct', or set +## auplot_points=1. There is no reason to do this since your screen +## resolution is limited and increasing the number of points plotted +## will not add any information. auplot_format, auplot_points and +## auplot_window may be set in .octaverc. By default auplot_format is +## 'outline', auplot_points=1000 and auplot_window=7. +## @end deftypefn + +## 2000-03 Paul Kienzle +## accept either row or column data +## implement fast plotting +## 2000-04 Paul Kienzle +## return signal and time vectors if asked + +## TODO: test offset and plotstr +## TODO: convert offset to time range in the form used by au +## TODO: rename to au; if nargout return data within time range +## TODO: otherwise plot the data +function [y_r, t_r, scale_r] = auplot(x, fs, offset, plotstr) + + global auplot_points=1000; + global auplot_format="outline"; + global auplot_window=7; + + if nargin<1 || nargin>4 + usage("[y, t, scale] = auplot(x [, fs [, offset [, plotstr]]])"); + endif + if nargin<2, fs = 8000; offset=0; plotstr = []; endif + if nargin<3, offset=0; plotstr = []; endif + if nargin<4, plotstr = []; endif + if ischar(fs), plotstr=fs; fs=8000; endif + if ischar(offset), plotstr=offset; offset=0; endif + if isempty(plotstr), plotstr=";;"; endif + + + if (size(x,1)c*r); + + if r==1 || strcmp(auplot_format,"direct") + ## full plot + t=[0:samples-1]*1000/fs; + y=x; + elseif r 1 + scale = max(abs(y(:))); + if (scale > 0) y=y/scale; endif + for i=1:channels + y(:,i) = y(:,i) + 2*(i-1); + end + else + scale = 1; + end + + if nargout >= 1, y_r = y; endif + if nargout >= 2, t_r = t; endif + if nargout >= 3, scale_r = scale; endif + if nargout == 0 + if channels > 1 + unwind_protect ## protect plot state + ylabel(sprintf('signal scaled by %f', scale)); + axis([min(t), max(t), -1, 2*channels-1]); + plot(t,y,plotstr); + unwind_protect_cleanup + axis(); ylabel(""); + end_unwind_protect + else + plot(t,y,plotstr); + end + endif +end + +%!demo +%! [x, fs] = auload(file_in_loadpath("sample.wav")); +%! subplot(211); title("single channel"); auplot(x,fs); +%! subplot(212); title("2 channels, x and 3x"); auplot([x, 3*x], fs); +%! oneplot(); title(""); + +%!demo +%! [x, fs] = auload(file_in_loadpath("sample.wav")); +%! global auplot_points; pts=auplot_points; +%! global auplot_format; fmt=auplot_format; +%! auplot_points=300; +%! subplot(221); title("filled"); auplot_format="filled"; auplot(x,fs); +%! subplot(223); title("outline"); auplot_format="outline"; auplot(x,fs); +%! auplot_points=900; +%! subplot(222); title("sampled"); auplot_format="sampled"; auplot(x,fs); +%! subplot(224); title("direct"); auplot_format="direct"; auplot(x,fs); +%! auplot_format=fmt; auplot_points=pts; title(""); oneplot(); + +%!demo +%! [x, fs] = auload(file_in_loadpath("sample.wav")); +%! title("subrange example"); auplot(au(x,fs,300,450),fs) +%! title(""); + +%!error auplot +%!error auplot(1,2,3,4,5) diff --git a/octave_packages/audio-1.1.4/ausave.m b/octave_packages/audio-1.1.4/ausave.m new file mode 100644 index 0000000..6050ac4 --- /dev/null +++ b/octave_packages/audio-1.1.4/ausave.m @@ -0,0 +1,262 @@ +## Copyright (C) 1999 Paul Kienzle +## +## 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 . + +## usage: ausave('filename.ext', x, fs, format) +## +## Writes an audio file with the appropriate header. The extension on +## the filename determines the layout of the header. Currently supports +## .wav and .au layouts. Data is a matrix of audio samples in the +## range [-1,1] (inclusive), one row per time step, one column per +## channel. Fs defaults to 8000 Hz. Format is one of ulaw, alaw, char, +## short, long, float, double +## +## Note that translating the symmetric range [-1,1] into the asymmetric +## range [-2^n,2^n-1] requires a DC offset of -2/2^n. The inverse +## process used by auload requires a DC offset of 2/2^n, so loading and +## saving a file will not change the contents. Other applications may +## compensate for the asymmetry in a different way (including previous +## versions of auload/ausave) so you may find small differences in +## calculated DC offsets for the same file. + + +## 2001-10-23 Paul Kienzle +## * force lin2mu to use [-1:1] regardless of its default +## 2001-12-11 Paul Kienzle +## * use closed interval [-1,1] rather than open interval [-1,1) internally +## * rescale data if it exceeds the range + +function ausave(path, data, rate, sampleformat) + + if nargin < 2 || nargin>4 + usage("ausave('filename.ext', x [, fs, sampleformat])"); + end + if nargin < 3, rate = 8000; end + if nargin < 4, sampleformat = 'short'; end + + ext = rindex(path, '.'); + if (ext == 0) + usage("ausave('filename.ext', x [, fs, sampleformat])"); + end + ext = tolower(substr(path, ext+1, length(path)-ext)); + + # determine data size and orientation + [samples, channels] = size(data); + if (samples < channels) + data = data.'; + [samples, channels] = size(data); + endif + + ## Microsoft .wav format + if strcmp(ext,'wav') + + ## Header format obtained from sox/wav.c + ## April 15, 1992 + ## Copyright 1992 Rick Richardson + ## Copyright 1991 Lance Norskog And Sundry Contributors + ## This source code is freely redistributable and may be used for + ## any purpose. This copyright notice must be maintained. + ## Lance Norskog And Sundry Contributors are not responsible for + ## the consequences of using this software. + + if (strcmp(sampleformat,'uchar')) + formatid = 1; + samplesize = 1; + elseif (strcmp(sampleformat,'short')) + formatid = 1; + samplesize = 2; + elseif (strcmp(sampleformat, 'long')) + formatid = 1; + samplesize = 4; + elseif (strcmp(sampleformat, 'float')) + formatid = 3; + samplesize = 4; + elseif (strcmp(sampleformat, 'double')) + formatid = 3; + samplesize = 8; + elseif (strcmp(sampleformat, 'alaw')) + formatid = 6; + samplesize = 1; + elseif (strcmp(sampleformat, 'ulaw')) + formatid = 7; + samplesize = 1; + else + error("%s is invalid format for .wav file\n", sampleformat); + end + datasize = channels*samplesize*samples; + + [file, msg] = fopen(path, 'wb'); + if (file == -1) + error("%s: %s", msg, path); + end + + ## write the magic header + arch = 'ieee-le'; + fwrite(file, toascii('RIFF'), 'char'); + fwrite(file, datasize+36, 'long', 0, arch); + fwrite(file, toascii('WAVE'), 'char'); + + ## write the "fmt " section + fwrite(file, toascii('fmt '), 'char'); + fwrite(file, 16, 'long', 0, arch); + fwrite(file, formatid, 'short', 0, arch); + fwrite(file, channels, 'short', 0, arch); + fwrite(file, rate, 'long', 0, arch); + fwrite(file, rate*channels*samplesize, 'long', 0, arch); + fwrite(file, channels*samplesize, 'short', 0, arch); + fwrite(file, samplesize*8, 'short', 0, arch); + + ## write the "data" section + fwrite(file, toascii('data'), 'char'); + fwrite(file, datasize, 'long', 0, arch); + + ## Sun .au format + elseif strcmp(ext, 'au') + + ## Header format obtained from sox/au.c + ## September 25, 1991 + ## Copyright 1991 Guido van Rossum And Sundry Contributors + ## This source code is freely redistributable and may be used for + ## any purpose. This copyright notice must be maintained. + ## Guido van Rossum And Sundry Contributors are not responsible for + ## the consequences of using this software. + + if (strcmp(sampleformat, 'ulaw')) + formatid = 1; + samplesize = 1; + elseif (strcmp(sampleformat,'uchar')) + formatid = 2; + samplesize = 1; + elseif (strcmp(sampleformat,'short')) + formatid = 3; + samplesize = 2; + elseif (strcmp(sampleformat, 'long')) + formatid = 5; + samplesize = 4; + elseif (strcmp(sampleformat, 'float')) + formatid = 6; + samplesize = 4; + elseif (strcmp(sampleformat, 'double')) + formatid = 7; + samplesize = 8; + else + error("%s is invalid format for .au file\n", sampleformat); + end + datasize = channels*samplesize*samples; + + [file, msg] = fopen(path, 'wb'); + if (file == -1) + error("%s: %s", msg, path); + end + + arch = 'ieee-be'; + fwrite(file, toascii('.snd'), 'char'); + fwrite(file, 24, 'long', 0, arch); + fwrite(file, datasize, 'long', 0, arch); + fwrite(file, formatid, 'long', 0, arch); + fwrite(file, rate, 'long', 0, arch); + fwrite(file, channels, 'long', 0, arch); + + ## Apple/SGI .aiff format + elseif strcmp(ext,'aiff') || strcmp(ext,'aif') + + ## Header format obtained from sox/aiff.c + ## September 25, 1991 + ## Copyright 1991 Guido van Rossum And Sundry Contributors + ## This source code is freely redistributable and may be used for + ## any purpose. This copyright notice must be maintained. + ## Guido van Rossum And Sundry Contributors are not responsible for + ## the consequences of using this software. + ## + ## IEEE 80-bit float I/O taken from + ## ftp://ftp.mathworks.com/pub/contrib/signal/osprey.tar + ## David K. Mellinger + ## dave@mbari.org + ## +1-831-775-1805 + ## fax -1620 + ## Monterey Bay Aquarium Research Institute + ## 7700 Sandholdt Road + + if (strcmp(sampleformat,'uchar')) + samplesize = 1; + elseif (strcmp(sampleformat,'short')) + samplesize = 2; + elseif (strcmp(sampleformat, 'long')) + samplesize = 4; + else + error("%s is invalid format for .aiff file\n", sampleformat); + end + datasize = channels*samplesize*samples; + + [file, msg] = fopen(path, 'wb'); + if (file == -1) + error("%s: %s", msg, path); + end + + ## write the magic header + arch = 'ieee-be'; + fwrite(file, toascii('FORM'), 'char'); + fwrite(file, datasize+46, 'long', 0, arch); + fwrite(file, toascii('AIFF'), 'char'); + + ## write the "COMM" section + fwrite(file, toascii('COMM'), 'char'); + fwrite(file, 18, 'long', 0, arch); + fwrite(file, channels, 'short', 0, arch); + fwrite(file, samples, 'long', 0, arch); + fwrite(file, 8*samplesize, 'short', 0, arch); + fwrite(file, 16414, 'ushort', 0, arch); % sample rate exponent + fwrite(file, [rate, 0], 'ulong', 0, arch); % sample rate mantissa + + ## write the "SSND" section + fwrite(file, toascii('SSND'), 'char'); + fwrite(file, datasize+8, 'long', 0, arch); # section length + fwrite(file, 0, 'long', 0, arch); # block size + fwrite(file, 0, 'long', 0, arch); # offset + + ## file extension unknown + else + error('ausave(filename.ext,...) understands .wav .au and .aiff only'); + end + + ## Make sure the data fits into the sample range + scale = max(abs(data(:))); + if (scale > 1.0) + warning("ausave: audio data exceeds range [-1,1] --- rescaling"); + data = data / scale; + endif + + ## convert samples from range [-1, 1] + if strcmp(sampleformat, 'alaw') + error("FIXME: ausave needs linear to alaw conversion\n"); + precision = 'uchar'; + elseif strcmp(sampleformat, 'ulaw') + data = lin2mu(data, 0); + precision = 'uchar' + elseif strcmp(sampleformat, 'uchar') + data = round((data+1)*127.5); + precision = 'uchar'; + elseif strcmp(sampleformat, 'short') + data = round(data*32767.5 - 0.5); + precision = 'short'; + elseif strcmp(sampleformat, 'long') + data = round(data*(2^31-0.5) - 0.5); + precision = 'long'; + else + precision = sampleformat; + end + fwrite(file, data', precision, 0, arch); + fclose(file); + +endfunction diff --git a/octave_packages/audio-1.1.4/clip.m b/octave_packages/audio-1.1.4/clip.m new file mode 100644 index 0000000..fbfb787 --- /dev/null +++ b/octave_packages/audio-1.1.4/clip.m @@ -0,0 +1,63 @@ +## Copyright (C) 1999 Paul Kienzle +## +## 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 . + +## Clip values outside the range to the value at the boundary of the +## range. +## +## X = clip(X) +## Clip to range [0, 1] +## +## X = clip(X, hi) +## Clip to range [0, hi] +## +## X = clip(X, [lo, hi]) +## Clip to range [lo, hi] + +## TODO: more clip modes, such as three level clip(X, [lo, mid, hi]), which +## TODO: sends everything above hi to hi, below lo to lo and between to +## TODO: mid; or infinite peak clipping, which sends everything above mid +## TODO: to hi and below mid to lo. + +function x = clip (x, range) + + if (nargin == 2) + if (length(range) == 1) + range = [0, range]; + end + elseif (nargin == 1) + range = [0, 1]; + else + usage("X = clip(X [, range])"); + end + try wfi = warning("query", "Octave:fortran-indexing").state; + catch wfi = "off"; + end + unwind_protect + x (find (x > range (2))) = range (2); + x (find (x < range (1))) = range (1); + unwind_protect_cleanup + warning(wfi, "Octave:fortran-indexing"); + end_unwind_protect + +endfunction + +%!error clip +%!error clip(1,2,3) +%!assert (clip(pi), 1) +%!assert (clip(-pi), 0) +%!assert (clip([-1.5, 0, 1.5], [-1, 1]), [-1, 0, 1]); +%!assert (clip([-1.5, 0, 1.5]', [-1, 1]'), [-1, 0, 1]'); +%!assert (clip([-1.5, 1; 0, 1.5], [-1, 1]), [-1, 1; 0, 1]); +%!assert (isempty(clip([],1))); diff --git a/octave_packages/audio-1.1.4/doc-cache b/octave_packages/audio-1.1.4/doc-cache new file mode 100644 index 0000000..9837470 --- /dev/null +++ b/octave_packages/audio-1.1.4/doc-cache @@ -0,0 +1,331 @@ +# Created by Octave 3.6.1, Tue Mar 20 07:03:19 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 7 +# name: +# type: sq_string +# elements: 1 +# length: 2 +au + + +# name: +# type: sq_string +# elements: 1 +# length: 315 + y = au(x, fs, lo [, hi]) + + Extract data from x for time range lo to hi in milliseconds. If lo + is [], start at the beginning. If hi is [], go to the end. If hi is + not specified, return the single element at lo. If lo<0, prepad the + signal to time lo. If hi is beyond the end, postpad the signal to + time hi. + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 + y = au(x, fs, lo [, hi]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +auload + + +# name: +# type: sq_string +# elements: 1 +# length: 1008 + -- Function File: [X,FS,SAMPLEFORMAT] = auload (FILENAME) + Reads an audio waveform from a file given by the string FILENAME. + Returns the audio samples in data, one column per channel, one row + per time slice. Also returns the sample rate and stored format + (one of ulaw, alaw, char, int16, int24, int32, float, double). The + sample value will be normalized to the range [-1,1] regardless of + the stored format. + + [x, fs] = auload(file_in_loadpath("sample.wav")); + auplot(x,fs); + + Note that translating the asymmetric range [-2^n,2^n-1] into the + symmetric range [-1,1] requires a DC offset of 2/2^n. The inverse + process used by ausave requires a DC offset of -2/2^n, so loading + and saving a file will not change the contents. Other + applications may compensate for the asymmetry in a different way + (including previous versions of auload/ausave) so you may find + small differences in calculated DC offsets for the same file. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 +Reads an audio waveform from a file given by the string FILENAME. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +auplot + + +# name: +# type: sq_string +# elements: 1 +# length: 2310 + -- Function File: [Y,T,SCALE] = auplot (X) + -- Function File: [Y,T,SCALE] = auplot (X,FS) + -- Function File: [Y,T,SCALE] = auplot (X,FS,OFFSET) + -- Function File: [Y,T,SCALE] = auplot (...,PLOTSTR) + Plot the waveform data, displaying time on the X axis. If you are + plotting a slice from the middle of an array, you may want to + specify the OFFSET into the array to retain the appropriate time + index. If the waveform contains multiple channels, then the data + are scaled to the range [-1,1] and shifted so that they do not + overlap. If a PLOTSTR is given, it is passed as the third argument + to the plot command. This allows you to set the linestyle easily. + FS defaults to 8000 Hz, and OFFSET defaults to 0 samples. + + Instead of plotting directly, you can ask for the returned + processed vectors. If Y has multiple channels, the plot should + have the y-range [-1 2*size(y,2)-1]. scale specifies how much the + matrix was scaled so that each signal would fit in the specified + range. + + Since speech samples can be very long, we need a way to plot them + rapidly. For long signals, auplot windows the data and keeps the + minimum and maximum values in the window. Together, these values + define the minimal polygon which contains the signal. The number + of points in the polygon is set with the global variable + auplot_points. The polygon may be either 'filled' or 'outline', + as set by the global variable auplot_format. For moderately long + data, the window does not contain enough points to draw an + interesting polygon. In this case, simply choosing an arbitrary + point from the window looks best. The global variable + auplot_window sets the size of the window required for creating + polygons. You can turn off the polygons entirely by setting + auplot_format to 'sampled'. To turn off fast plotting entirely, + set auplot_format to 'direct', or set auplot_points=1. There is no + reason to do this since your screen resolution is limited and + increasing the number of points plotted will not add any + information. auplot_format, auplot_points and auplot_window may + be set in .octaverc. By default auplot_format is 'outline', + auplot_points=1000 and auplot_window=7. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Plot the waveform data, displaying time on the X axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ausave + + +# name: +# type: sq_string +# elements: 1 +# length: 871 + usage: ausave('filename.ext', x, fs, format) + + Writes an audio file with the appropriate header. The extension on + the filename determines the layout of the header. Currently supports + .wav and .au layouts. Data is a matrix of audio samples in the + range [-1,1] (inclusive), one row per time step, one column per + channel. Fs defaults to 8000 Hz. Format is one of ulaw, alaw, char, + short, long, float, double + + Note that translating the symmetric range [-1,1] into the asymmetric + range [-2^n,2^n-1] requires a DC offset of -2/2^n. The inverse + process used by auload requires a DC offset of 2/2^n, so loading and + saving a file will not change the contents. Other applications may + compensate for the asymmetry in a different way (including previous + versions of auload/ausave) so you may find small differences in + calculated DC offsets for the same file. + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 + usage: ausave('filename. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +clip + + +# name: +# type: sq_string +# elements: 1 +# length: 206 + Clip values outside the range to the value at the boundary of the + range. + + X = clip(X) + Clip to range [0, 1] + + X = clip(X, hi) + Clip to range [0, hi] + + X = clip(X, [lo, hi]) + Clip to range [lo, hi] + + + +# name: +# type: sq_string +# elements: 1 +# length: 74 + Clip values outside the range to the value at the boundary of the + range. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +sound + + +# name: +# type: sq_string +# elements: 1 +# length: 2377 + usage: sound(x [, fs, bs]) + + Play the signal through the speakers. Data is a matrix with + one column per channel. Rate fs defaults to 8000 Hz. The signal + is clipped to [-1, 1]. Buffer size bs controls how many audio samples + are clipped and buffered before sending them to the audio player. bs + defaults to fs, which is equivalent to 1 second of audio. + + Note that if $DISPLAY != $HOSTNAME:n then a remote shell is opened + to the host specified in $HOSTNAME to play the audio. See manual + pages for ssh, ssh-keygen, ssh-agent and ssh-add to learn how to + set it up. + + This function writes the audio data through a pipe to the program + "play" from the sox distribution. sox runs pretty much anywhere, + but it only has audio drivers for OSS (primarily linux and freebsd) + and SunOS. In case your local machine is not one of these, write + a shell script such as ~/bin/octaveplay, substituting AUDIO_UTILITY + with whatever audio utility you happen to have on your system: + #!/bin/sh + cat > ~/.octave_play.au + SYSTEM_AUDIO_UTILITY ~/.octave_play.au + rm -f ~/.octave_play.au + and set the global variable (e.g., in .octaverc) + global sound_play_utility="~/bin/octaveplay"; + + If your audio utility can accept an AU file via a pipe, then you + can use it directly: + global sound_play_utility="SYSTEM_AUDIO_UTILITY flags" + where flags are whatever you need to tell it that it is receiving + an AU file. + + With clever use of the command dd, you can chop out the header and + dump the data directly to the audio device in big-endian format: + global sound_play_utility="dd of=/dev/audio ibs=2 skip=12" + or little-endian format: + global sound_play_utility="dd of=/dev/dsp ibs=2 skip=12 conv=swab" + but you lose the sampling rate in the process. + + Finally, you could modify sound.m to produce data in a format that + you can dump directly to your audio device and use "cat >/dev/audio" + as your sound_play_utility. Things you may want to do are resample + so that the rate is appropriate for your machine and convert the data + to mulaw and output as bytes. + + If you experience buffer underruns while playing audio data, the bs + buffer size parameter can be increased to tradeoff interactivity + for smoother playback. If bs=Inf, then all the data is clipped and + buffered before sending it to the audio player pipe. By default, 1 + sec of audio is buffered. + + + +# name: +# type: sq_string +# elements: 1 +# length: 28 + usage: sound(x [, fs, bs]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +soundsc + + +# name: +# type: sq_string +# elements: 1 +# length: 793 + usage: soundsc(x, fs, limit) or soundsc(x, fs, [ lo, hi ]) + + soundsc(x) + Scale the signal so that [min(x), max(x)] -> [-1, 1], then + play it through the speakers at 8000 Hz sampling rate. The + signal has one column per channel. + + soundsc(x,fs) + Scale the signal and play it at sampling rate fs. + + soundsc(x, fs, limit) + Scale the signal so that [-|limit|, |limit|] -> [-1, 1], then + play it at sampling rate fs. If fs is empty, then the default + 8000 Hz sampling rate is used. + + soundsc(x, fs, [ lo, hi ]) + Scale the signal so that [lo, hi] -> [-1, 1], then play it + at sampling rate fs. If fs is empty, then the default 8000 Hz + sampling rate is used. + + y=soundsc(...) + return the scaled waveform rather than play it. + + See sound for more information. + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 + usage: soundsc(x, fs, limit) or soundsc(x, fs, [ lo, hi ]) + + + + + + diff --git a/octave_packages/audio-1.1.4/packinfo/.autoload b/octave_packages/audio-1.1.4/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/audio-1.1.4/packinfo/DESCRIPTION b/octave_packages/audio-1.1.4/packinfo/DESCRIPTION new file mode 100644 index 0000000..ef006a5 --- /dev/null +++ b/octave_packages/audio-1.1.4/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: Audio +Version: 1.1.4 +Date: 2009-05-03 +Author: Paul Kienzle +Maintainer: Paul Kienzle +Title: Audio +Description: Audio recording, processing and playing tools. +Depends: octave (>= 2.9.7) +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net diff --git a/octave_packages/audio-1.1.4/packinfo/INDEX b/octave_packages/audio-1.1.4/packinfo/INDEX new file mode 100644 index 0000000..a884780 --- /dev/null +++ b/octave_packages/audio-1.1.4/packinfo/INDEX @@ -0,0 +1,11 @@ +audio >> Audio +Record and play + sound + soundsc + aurecord aucapture +Read and write + auload ausave +Process + auplot + au + diff --git a/octave_packages/audio-1.1.4/sample.wav b/octave_packages/audio-1.1.4/sample.wav new file mode 100644 index 0000000000000000000000000000000000000000..8d9a6fd67b6dc50c630f051f5c2e8010988efc4e GIT binary patch literal 34804 zcmXV21DGU9)6S~uYR)vqYumPM+}bv8ty|mPy|r!IzO~I+j$5V7{NJAMf9mO(W>sc5 z-iWA{4eHiSm`zCA8g1(I89Xw(n-C)4$k~RF+WQF+iJSE5KC=65d?&~gxR-zD0iMdg z@caA{zs+yr{|)|*KjlyOH+=Sm-^E`G$wW$!+N3$DKq`?kqy_nlw8WzcX-evoYNR@8 zj7L>cj+DYTN|XGgAif_(G7=~8kVa%0X-kTcIFiN{98TgQGVya6fA8R$*Z6gQ9@n{t zzyI;~xNZWDKV0MC_{L|RghSyH)-Dl++X&}B`6qnNIm6l|oGp?6=E->YxexCdc=++4 zcyPR%g#D%R6zt_a|H>mt1`)Tk(GkzAUy2_vP4|wMl zkH?z6;k*hL$Q%Ba|G@VZp2k1p83lFRI6|+}xQcHuuH$bSJ~5}$IEjnIh9ije6e7RK z1ToBX#Pms8E+z?oi$kR+QZ1>yI9PZ?W?_$e_*_1Ui~KM4oqncm*dF#TGiYvl%s6Gl z(q*&&+s_i&ZWhCK(X+H7`^ZM~S$qQT#mDol{210+jC3Z$NCOg1N|GVuFgZ&ulU<XI>JB56iCk)7lrxk733aCAa}v_{^SD5A>I- z#@S3hA7_6H3hrg=*-O?QdpXO;@JW0&pUC_0eUK5I=K(jj@S>nhH@=Y{giIztGKXWu zk9c0vfrR1H@}Sa1NYxuik(*?OG@s-SvWLWzBUqzI?twO?$U$NiJi;01zz(cu2$@2% zkTZNLpTei{e<58#$c}|v1jqm3+o69?aP`vAs5qiSPJ5AMprDo9!uKj;ue-@;VkXCN zrHha}6SV6k*1Z{Pj)Csg!&SaPa=-JE(8c0-JqTx@d>sD^d#Fs7gGXC-796=s736z27@|7m;#Z_3N?N|1r0{1&K| ziF;Wkz8>=6A&+sUth^@nk(G2K{YWG^#E(NyGmseQ@Lj$W(pMjR+XDRx(Yz?m+5j{k z$m{XOd;o8a|E+mP@OnOE;v;_z9{z^Lm`G959#pT79rY&*$sOV&cHt{zdLFDyZ8DyG zz&qPWMc9Q5koUXb!9B=eYtSG&X-77bSL8j}MB2b^H747MM#>18gsWs7oqhS`6!NkH4ODJEp?&hHQ=kPM*iPUSp>L$k##G z8wN@G$&Y}N|KW-ui*pbh@$u}S={L}EK6ri%@^p=#Ul*L}2KhJy z`5(jo<})C1anSd#u#lg?m%ZTqXubkc@Q7c=)fVC^{cxTM(4t9r)}0T+Zw7;#)p-eC z2lgWtM;0E(i-5~bASvB&g^J+%YOH$+zPSo3yb8(K0$JR`@8C)gv8&Jyj$&7PAjL!Z z0!aP~&}BL#b0gmU2C3bGSCjBq4c$G6-LJ)}*250&0yW-(z9M|XYpnh}{6i${z6S61 z1XepU$pef03aj4-+TMWPPUVWykQS~J_O%tM@EoUutnP;3tdPJ@Vy)9iqDJSOzp{VG7>gvJ|uKK zj^$)Ew0s}A54k-A9iKra;q^+g6_15vGQ4e7So7idMO(;GS&|#)C{7ANCyJ2r&@2VI z?7-@p!)6`eW1+$8LB}iD|18*sRX9dMbNhjgm+^jx)*GRV3aD`gQnVGc$pYC-0artQ zIRj|&8uWPu=@dbobNn>ofp<7g<7{KWn^WM$V%UK(p!|9Kek3?O6O#A>kJWg#7PS0@ z=NrJSYp@Gu(Ek*!`vCSO6MW(sz8^BA!b_cpe9eUX7@)it7FGeb2zDneclz|In)Lh8Q4k40mBL&!i_5i`wWdW4m$B_+{KN)))(oImSlgtntctYWy~G(Z2XrHJS~6 ze=vPZW0`{`(Eu&acCZiZ9ec~tSQIp?E>>6r^8Xe#zbmXy8(7F$W&0SW8?ceivO*VX2H%S?Vdxlb%YSq_2`+3P>9MCP}}fchXJis}_@(e^nNam?Hx>!K+w!436xu34YL8!+sLkQ$#wWSRIyuCDLc~23=44 z(LD5}vBB7D95oK%e;=cnQOs}~ny%@B;V~QrF+S+e^mjNu>QD9K`ZE2Xo~qX{Ivb@8 zmtit;8ZC?-MsH(`u?MuihZt(Bal*(?U(oHWIc!V~?5U?vL>wSFWXW>Iy3cmmR?wzc zU)#8&uQSHI%>BZ3!ucosYj_*y4d)4GUT2Z;jA4ZwmFz`rA1zzVIpzIQZ!xEknTY%u z{nx0kGxe6TF8Dk!F)%bRAVB>s{gZs3yx+VleWU!@0z(4h0w)5^gEQ^6YXY>=s zFB%2@RTV@~Jco2mT5eh<&o)=HY`1K*EVlHs6tMWsPtE7di_IO)H|2QKed&(KgdV~J zL_c%+26mUKMk8aV?$K9i`Ls*w7`1^~LanIQRV%3Z)SBu{^`%-?8?D{dhUrvq1xh3s zVYDgTO8tm0_aovPj2NI3&jVc;2bz56C*TVnur-MPb|b#L${Mkybg0o@zoT8!GU=7{ zN7`@ofznDTtTxeK(*B6YJggYa%tYa$X`khWwX5~E^8&f_VZ_{vN&; z-u7Ob_h;IjwC!ml)8?hUNo($ve5ZYV{TTy}V0Go5I$VEb+@viaZ%cWYK*b-X=4Ng# zYzdmPTc%r_*6Y^3wga|>w%^u(C15UQzAd+s|1-r)pT$%}XGKX~o|k2#t&J^us#Z_i ztM*dcsAbf{iZ}RIuuO1Gu#|FE@hKLSD#g@V>NwS>&d^HeclA2PT;rM{(1Fm<;p>2n36#`6&x0<6KoZn6#Nma zuWV3WDt5J-x4qPgYm}5L2J^5^aHiC!mJ@%#2zsRGM^1BJ93|g^b@^D z*V1{ggu|#zYa2aus@2x*M!*XJ?%X? z-M^i)oXuR@-CsTVBd&Sgy7#yyItztAam=;PvCXhfvg9#OF`X23GK4F%oAFQ+)hfXr zfp`AR{v7^>zQSHTwM^>Al)9;%(q?%p`wIGwdWU-b-kN@EaI^A8C9pF8(!Hz^tnWKA zPh4xNYc6CNVmW6SX6>KaK zQjA-AguYEPX-(7xO04oOcqZ66_&6{lup*EtxHTBAlu;@wHI;>mq|R3@+B`_!E4{0+ z%Qy{h5pQ%ymbM&LHWm34e4hdbP52kpzqj|nL(QLEkvp){Y>>B1i;Lh$|24$ zxEeS!h2M6puvfPQEsMihLmdMqfKAM$yX$z;DUO|r^V zu513wyv6*((!icIe4gvB`=a}{>!Wk0vyW@1`+&z5vB1;UUCb5cG>3~}SM6PGan_IK z&2k>o8u1e;#MjU$W3u*I=@_gT*zIrP_xLCJx_HZ{Eli!7Dx|GRqiMOlrM!o|GkoX# ziGh{Dc1nA7ttK0z>04HftQT&IH>G8!dUAd9dP}UWGHB-o1t;43*++negYCKPi)~k} z2O#sQrVG+fF^5<~s7s3RT+BmF2Gz1?ZPi0cWkpn82j>T?27d?s!|^^~4>k|(3c8eW z${FRGl2M(c=GUB%!1~5$V+Q*yZ<+kRT<{9QTmY%lEVdtHl-CNwR zTnWzQ&L~%$TXFaBWcD<77j;EBgJCZm$LwpM!?i7s<@%-@Vj*E8FT>6mx%8pxf5C-; zoBn40g8rL6o6qV^NUaV%ewBJYZJ_t6cc*uYSMgr-xdO9-XOu^(q_;Qr)7R`5j}_X8 zhol&}nAvH0W4UTQX6tMJ&;9~boNXUzZ)pE$>uTF(eP@ZVlrU$LQ>1g^PGKK8&%d%4 z^r3NIf33x6bJY}OppqQi9UK>|7_C- zUL8?RO`{6p#;NoJTTLp8)1`@~=O(YIvYg5M(h_ZN8umK8gEJ|-Q22!~cleX=W6rX! zFxO<~-tfC&DUJw7j6KRmEw9a+`j7c; zdoAAeX`9mCr*-fqd1v`N{yF}5f3?7qz}(<@n=rbWkz3K3`Bre49=g7~E~JxNQjhiom+l%A2l=H1C4p|E=qouI` zHvI);f*SSdN}5W`vVm+hJC7KeBA)1qOzsJgft)}*njniA1=MX9a>o1QHhF@4=LK+) zQ{)P{1_bUP@}1s5Vv8V8%!?e+Op=hhTt>!q68YI2WIl6{S#LxB^DlC?qv^QsQ)Ge{ zkng1+^UaLxGEaJzSqOg%;~bfAxPX~z$lSgIhdT!Z=MsLo8~Nl^-V@PcNuC?olb8Ks zZ;+k5$Kx@q>QDBGU0?^07iVnBS#As?@cJhK(@|30KA zR@4)(%R|cQfn&|_w*`)>$khws^;RGRozl^T%%E&2ul#`=`W$lQ&EU=q*v?sq#m68| zZOU7v=UI8NvJi?=82PG~`5?6}WKdS*Q`ytk?cw2g?ch%Eq8jXRW8|K#fbxt5Dzg%2 z-2t9mM|S=hm~BC)(;d{{UVPLe_r*H%S0am4Y1k6A+bm_#Y2^l;ZDe$jf1@ z;SA*PEF|b9u$wP<_W^$S3g7l}J5Y!Od^ZgADTebGLbjeW{dpzOv>B+{9(YV6T)i-m zZJGQ6QWJrl6iugpX{;%PuQkE{*2sig<2OB!6Su{)5GR@gr)dvvK4j;FYj{-+IC6GygEBME z#%uEq_(dzAU3I~)e!!#FLtmGrOU({xz?QHUY$9;}Xdcg2u?DCxOk#)Fai9g=*>L1RR;;TP|Hx`1`@c=I z;+sXehaW-=R-AQY4_F~y5Os-dY%DDG4Q7Wf|AoCZ!k+r!=nFJ+5VF|gkh)Oy$chyV zf$XZJkPs=jU@`|k0DgJ4CIhOBTfNTc>}*s$Y}nX-30|)z}n6L zMNI5(ufs3073?7V#0$j#-4Xxyf~|dvoZtjI%Ju<^ z8Oi>}^S0p2HQ2a`tPjpK4ESCFa*C&5y@Nr|NZ1h#Ht{8Fivb(GfVF3(SQpspe%SdQ zP__|l(H-o=BPhnSL`08Gq~Xh{>;Nh8C&Y^qX3J%}^t>_1XY^ zyfKlshR2x3UeV0-3vyM?_K`TE!cp1k0sOVWGD6z1s- zfkm}7z8Ml-3Xh*rf2Y;azw7;tBgS!HQQeHb#(U!}eaAlVeWa1_LpU$qmTJj%i_d!7 z{=-o@?6YHx<8McJSikUOr^nsNeaki1nJ@g6OaaK@l`X|43Kx%gFbalP5rl=aLm- ztlZi%$~xTo%TmVjz6P^=dNaL~J|Bo&Z=)vd0;G)q2_Fa?dnVaJjzju; zlkbqJ%J5-%fUhR7x$Gfz&{oDKJxpJ#P0>zhS@gmBKs{M=YZ2;SN>OF5l1p8us_Hv+ zy}DgJtA0}z)uZLqs%dMrntDE?6m7uz^Iaq$3u z!HGe;a#&fQRzZAy6O^x^Ro4z_+w?Gck$oYT#bTyaa=^UH`o$g}-qJHWYGur~nETNs zqXtD*i0T+~FRpLKW*Jw;vFIw1SKVEm4;&e6i_ODK*(I-#gRG>PwN-(g-Y==<)S)ST zlbeC-Bzq z4Ezn0>n1ROjmS~z1V4h7mz4bK1$BeAOTT73pof4S36REI!W7{uaPmsx8L^#YGtDz? zGW})RB;6O?Vh`actbbcRf=!{Tj3dA$omw_^gc7bK1fKxg`V*)YcDxDv>Y zytzWKMQ~nF4<1z}soAvSS`B@po(UTN*yu%T!CvPQUWl_zh0SLzQ*1vS=bZOEi=%4C zERT5;eK9IFs!i0;Xc}XRD;hU6_I>oW$O4`g&f*SY^~evze8MOG51VehP!j@$ePY_I zlt#%FlB7i6pPqk4|7n#lH}Q3nE5(xR6FJF`{3m3Vc&Nrq(6R)TjAvxy) z*#k*_zuz2)3X}_s349K82_^-{Dkk-ixrbT}-OvPwI}LgFgn393L5yaXFej{wJa=&@R5bv=*=qI?Z*3YH2U2{a4j4ipLW z3>*!(gA0NR@WaW#A0{ZPl}E}@wUJgzH}u_xANWCjI)Ub3dHGh-L9A$sHU})pHdojt z=NM0>sHm7p&+vpNiE+t=Q?jRKO6%zT;hPqSRFd?;(CS z1LUFJ?QHs?gZ{faBTpTU#M*VBPSPGGbLnuue@FBnfW9dReHU{YzG_y8H zeX2}Rsw=+We&E~|Skm^v`@!gYljWRsgFP*5qASUBHgZT*hNvcy`y(z#9FA0?wCKz+ZKIz@N)eIn zkKwf)C9L)2n<7KpwuNP&Xcg~G z-faGJfeA{I+E=eZC-Lt>6;pllEz3b`Bb(J8?uZVvhIbB+4j&kH2-Kb680qjhqU}4a z4$BPLZQ3bT7mo8uY%SG|e~c&kV{N`#Pw5xT6s#XS3>#Nc>4d!!c;nLAKFzOn*8{Mu z2kBH+1(9L}c=@KnccHF0L~I~BL|Lqd$V`x2(hG4EI-mX#bi`+~_(7)7?(kM4j5NKp z-UZjlq6UC=2bJ5XB*Z8VB~EDx?LQ3sHjnxjyuVqiqYcvLYX50nfSepMER-3~5l`hs z&2S;>3oOAPdBnX^JNT_}R^7JMu{`{;YqjS{#O;WRhy%8GT1Iq@%o|lIYDi?3h}G^W z*U<1Lj(ygTat~>_(3lkFe`prtt~xL{)-U*OrL9YClu|DFXwvnhp2F@vHBVhd@2R1&qp;^H15R+va00L|XcGO=y6AU$nF z82$89T5j#II$0g0HdM>2`PE8lOH>seA(Ap{Hbh$awc*-fEk(oytJ!@`?PzqJDWSRd$W7I#}$!3 zVufe1yR7SH_^L3oql_(^#UYoM9twL&4}O-O(GRPSgS`Xw{lk4Ly_eEh>bTUuQ=g_z z1k%0D8{u2!tLZNj=pH<+uZ^0}nJGdmR4eYw3G!^&iQ|>*v2?ZmZOdu@h6+_L z>vYRP^GJE7=?<#cC8b#Dxo8E#c#V%_o#`?o2GMG6eWezweN>ZFQL}0<)m^BSMyoy5 zU+OBYo}L7|P?f$y#QFr?Xdy&9f%hV@!cifYI9BW}RuF#*D})AuMc9oT-U~cq1oCM+ z--=4!Vk*Kul)_a67|mOrrg>v$cJ@$g&x4Mk8Yr|QTwb;?ewNG z#3*Y-8C{JeV9{<(lleB)JtNeu(CupgLRQD6s8c{AWrI{GFj z0cF#HF`0l0)kGgc7U1N&fzk{Dx^W)Al+nF%78ruaU!$9#DzMJ|c+3Zaw*#4VcVIPV z**#VYcwQL#G~%Ei{eh{KK;P0?_}JVyDyR3H3_`YOBTvya^cq-JX=E;~aXkwVr$qE` zP69&NKv*nnNA`JMI3c_e{s?iv4=RW?#13K~agw+kveH;Ii?4(&=ufF76c;iJ0iX&0 zkSfUj6M;}%2TrjBRr4IcA7#i-ERd4CJR?^AiTy!8L=ak*4QmUcC*mS<`?stUaJ;ra za!T=>=u~L}tY;fKc|!d?LxBiv1(nRev#O=zUJZfcR7ZzW2XwD>#(LWVU&scWCkDuF z79eNg*n1edQG-Bp)6jpD1nllD@VX~JAkG7WyaJ@|2v&FmuTDS;58(L;AWX+V&%=0i z4|v{t{Niakn)n%*#Z#acFMvfQqOa&ZZ2xr}cX6g;IOBF?nd^asZ3iOKA9&O_NOnVD zDJ_8BRK^}7vHOB}-4dN))qtN>L2qRXpbd?H@3h9dJ@EZ**yD8c6m11wy%ebRcC6|G z5ZMbr6CVP9OarH$!)>+A|(B>j~^@C{WQUz(B_XAzcC7b2U0UcK`!jfPSC;_)be;Hl@-#p+o3n zk@P;SQ19?JV4(4+-GsVIkK(uh8tww^j^VKv-E2kjmv|0`na4R$*gko>Ov-Qx0z4-kB;Dbw`8*|Xrxfed@E!6+3Yy4 z00b$3Gx@>!pIA`ovfyFr&}Kv0(gjav)~uLMmu zgJPk|%2>R&4wMUZC9cN1>+yFUzOfD*T9Hoi>GoRoe81yOB!}kPQcOUEf0!jLVon1)R&5+iHI{NlQ;tu2aEgVPj ze>Ywo2Ise97klvOAt1w-aqipr-a-6!J)~tL>Ox0g?Ly~0k1M?f-JU_OzG59WamB~r z_&e}EbmqhO^-0LXO=NmE(~r%Nx(&F_Fi zxjE##KI~IvSi^GQZc*q`2^@u>QRVSGR9Pql)XoLY$ixR5^(&pvp{kA_vhxP~xs5eG z#)|G@6;H6{=b&0>#V>%<{sLX@&hZiZeUDFn4>3Deg zdL$k-l7Ap~+3|W0(7_Dw$y@O4cRV*LIdx$r-hkdA{yHEPnbAi+9A2UYJoX;Y;u$D? z8XCGBzd3Km&$6Vh7nHTol_&Z^RbDLcWQ8WtgH7b_fQ3u^6sEAh4u%Aj z7uEnlF9|fEoOo55ESEG_M@}S*yHG#R3m&f#?C2S(jb7fF@JWYQJ@jY&IQ-W9$5=iy26pCF>SiFTp8u^Xa`=CHV-igk5VRDPnOv=rxk2ML-BD}5Za zz6!559iJbDR&PQqQU<@61WIp)l-5LNP&lr09WmrjmJ@OqLa*g5L5MWEv{f zg@xA0>Kb94IZ!2gii&AgOnii7bQ7$8c~r30p$aw{^_8=@{!Gw3C*=Afu9X{We2;8n zBkHefFhepHlO$(Q`x}EuKmr#v+KprDbX#kD7 zfPKWligp8NR^+hI;i!K!?^sqH?2B+5$fHEv(os_=+2lcq?f65ti!% zs5c7{b8paMKdkI?_@4KmyaWE&K~mH0Y(l!{&x2KzL0z^i?6?OJ@;gYf50>c<&XEKT zG{a7Ypmtjn_TLMuD1rAi5ar}bj}}b$btPDt0+4kdetQl2`yQ6ehVRB>U1K4+!$GmuysXPi43TII*HkhT4uZUKYowP%UE!>4k(-E$&h$&W7lNK_7Y3(JJ&=z+e6+U!_d zy%Ba%3|{U$YV@tpJ>WoOUJugM3o_aYp8XYaw`PbhdxI0%;Xm%me5VNI~X%7*;CW37DQ&k6J{^n?t2gHH(g=1_!}2Nm}rh~@j@e`vlVRO2mz>}ewE-6|F>rqvPN%>CB$-sAN2aJNKnZJeiw=e4`O`=%?}^*a2sW2P;;WsS)y*5?C^ z)9U+Rt>A^=93``wLA?Zw)dNg0C%OkcYHuyvxJC2B0>+cI!T>QwS}N_A+DQ+95M7tn znH1A&Q!Z0qP}nJzmwHRNrE%gAp*J}O37o_zmC}0y`mn92QrAN_<_FYmy0R;n-q?!{ zj0DtA55QiwfxZlb1@4WA!UbvVjkv@Qx(n!NA3>+lMVK5oPv6n+^Z}laq_gNn>S7%r zp%pQe`WC&On^CJQLp5NtBaB*@*eH+wTUIpT2LDUly03df}JB(q|f@$1s(_P1#c)n)W7vEbT*$W7^1`U%CuRoZQf=+hI*|b@0R<^4tXr*EsTFYhnx$<^O-j|$%K8fX zBLmrj(-l>1rVm4}atf1$qL_8qY~E<;Zw**0*sQkE)}@vy=0)-)(^F}OI8K-e+nyg& zuJxJA$fm`qdBFK$S`;RHej2GXfek_C^@2A7T{U4p`Z2Gf&$FBK7!yn*q}Ad9ApsFU zdESPtL&xzXdWs$dea;wljRHnNOvwy4&KMP`O3wh_9SqAn7*YEU#Ajm>&1D9%)*e=F zENrVET}Fl2DO#ScL$5=%`^GvhMtF7PdFT&4w-bGi+ z@GN7ej6>pb#`KM<7&#=Ox~Hw{MOan)GfNY>p7@51)E6k@1228Kyq!?(>6o09JS4Tg zSM-kyIF)niKY9^*68-$wgp<-?d6lIRdceopN7-wj_u!dzp(T@fttnPID0C-fcp|ia zyM93X3BEs9#w(3bvl^)$)`}Qw(MKGI$+>639#j)pdp zl>cEtSkQ0iSRD&1*w>hdDVKT1N>G7g*2PcTqo=+IBJF#KDJ_U8lMs2$2Wn~K4}tkk zfsJkld!8MAJ0*HO+*Hg8zihkh46Ng0>otgz&bWT+uV) zI%dod`qF4$WS@w}9?hkMPjlF9kIh3(mxX^=9=()e3Uu)8Pm4|6n;exqF8ND}o)+#; z3LH=tXiW_t?Z;n}K4Ni`$$Z07$d+X5X&-3MVxMfAV2!kllwV2>#l_?bYe*H{qW9Du zsy$S{a!%-Kyey5QRDxl`CFjyL^fE^EzVFA>(qwIJafiYy-C_6&1Hg}1Puvy7D^qzq)Y(O&&0P}w&p?N&-u^4r9%iKmk8ru6du z@`ov@>Un)QmH1Sm3Y(;Ea$`%Ft+zdkqq!rKW0ZZGt+Mr^`LpSRc!zvoMd&MNULI7j z#;Qfs9ZF-Rkdj9kt#nfVXfKWb*hun5NJ1~wdQ*hlOCBKilv~T~5gO6YFgq&xLS`c~ax3^aBcpN$NdD~hKJST*1_{V+$_U6><`!mR0GWGIJ_ zfkvP!Y%QX;5wObbF<&zXUTy<)zqVn6?1m;AIvRs9-SAAGrZ?70>e=;3{f%~AlTig; zj;?hDlb+GWSpB({UAw8Cf`==pP1HVXIrM&*Evah^q4!vRWRkjg*0kN+(VEphJuKEe zIO=BH)lBU(pUrqT))ieLGE+p1XS&NB9%FB6xooN={>5XBcS^ZH4qwZ(#VJWiPZLij zeoT^6PkHMGdMXvQczqo$#CMb0B9k7=>n)XS{p^JuT^w#lFMBVW%{s_D($rL}PX@3z z#uR;#hFKow zPs)U;u*bqlGKSl6o{${b^lRDy?X6ZFyDx}X-~#H2-7wWv1PFu^vYHFMU>rS~Z!j(0 z4_VwLWHTk<%Fv9}hD!nxAF;BBj zvKwJz+{>ft#g)mpEyJML!%@>BdU_tZ@1Sm3&oR$hz#M7%D&*y1Mx1&%p!+I&d!{~0 zR+D-s`%6VVY^Ll^b)S~G3EdS7XPnUPxRYAuJciN^AQ9C)dSQrnY9m zdcyX~;dkDT*c~%ILye5z;s(Uzj#?Mt^NjS=bDNyZ&Mc$lD$*%(pB~j-1$X$p-u7uL zQzDY5CRI%KrawFzhI3e)f&oS^c8hbx~ToNDf&etBb&_6LW&2Ac`*6>*0f083mRMG z52m2$y{Wk=OzI?P{2lv)nZpX0NV$x(fO1@^4t-0f;BOh{*=&h4r`EEY#dz z!VWx8qqTm}l`9;WW_7WG#MlnS;|zN*{xN^~=O%WDdE#HFUH=6RO(*4x%-TX~z^*2Y@L zk^(!rPFgRn7dnv4+y~u^F$$pvbR??i72)Ngv@_ZWy)j~}oXm|}dl9KDBnsQbo>H>Z z*)+yf)^tm%CfyQ?iPMD>z*iRXbI5d?(F2%kGQ(!b_-jHO(8O47SP{FGM%Qf?#Az3S z|KtZ&R1#=P9bh7@fTp{E)l3I&k$?*61az0@WAW(1t$|4*ukpxOkCt*o|ItsVRh7qq zPX26|hWzb)%=fb_Y$bY(A0duyXY_+b-Gxp953+z6tQHU#H_(r~xYNWO zbeq2*KOvbNAd~BXH(X~^(O;m_jmXT3(f7s^=xGsTWB*YnB86eF$Jf)*>3r~UOL3;( zz~C&v>=a<-cY(CDMxSmm;OG?)C0h|4C#Uy`dw_c-VY>ecFxKao;?IPR{jBIu&x_8J z=D=WwqBh?L7*!|Ka>oP5+mB;Cc-9irDNXRnc)U6X{L7zSwp1d zVLs$yujmnENG)hSnu+G66=?%x`a{t*IGOIC*MP7@qmRBNJb6bTQVjIAA!Z9I z;!y{??uTq(9Bz_-42M++XnGd|K zFV58g_M|PU1=E1u&Bc1wpq982^gIsyYXz{fA;?==0u|~8x;6j;Ss!u`^V719)`BM_c4Qa(`stGEaqAYV~)=!02{yTAp@;{G*zFhP}p zr{daYFvqqGGS(d^P6HgJky%v&nlljh#h8ppbvM>h0sFdztKY${W`gE}fHiFZimKw? zMmf{bMFBWq2v`0BT<-~vN9mYfEONyH$f{G2Ri6aS_9K^@0n|D)k24k0bpmyQEwIX6 zvB&m6L1%(ycW|Z0`1=m{XsA|r8nw$KK*}yc(%(Sxf5301!FD}@9)#|;6QcJ$9Jf&Y zU56`#s(wd-==XtyR7Fju5u~I)@V+6Sd}&ytOW5rK;CcP9-$JlT1yRvpkhb+e3Qody z7lExBiqH3>a^S%kCIXYr0F1w^a9Hq&{lo`iY3U1WPAgfF%a{wBgYs5+mb?tJhKCSs zWtXR$o=I(_+vvI3f_tF!#J#49^36cbRs&l}fo9(}UL#XT#$lk_C?jU&_fSp;fd37! zn-{1Vw1kEDNm^m1?yF!CCGiuwSsDP_TmlWOiGG(!@M?WQ*XQ6wUC3}8rq1#~|0_Ti zdqBF^WB;N1ly$=ll#Hx77j~TnIZI?RI3B=6@D}X8684@OnspQ%O~pX{7Ld&H+y0$;!fR)WaPAZ)vdH%re^c#PKe?t4npAcSX78 zI6FA|V3K>ZQw=W>UOlXy!)_mDZDxKVwH9*n7W9igN6V_d44w!i`)B)m;ocR3|AFtK z@2jtr|G9rdU{mms(o_?SH8eLLMTQG4#Ui+S&2m!_`Iwv!cg^sbi(0B$9F|Mwn&#E= zF4HP$h}a*!``O6_=zMwP(+5$B{eW5P8i)<Sa4(e2IU?bkbUXFuI*Mes*gR3-wm+J+a zP!Qic2z=uQ5Y7^q*q(?eq==ClvrZk29map4*lMGk@f~QzRsBExJ?ig zU4ohQhv>mPg?`Uk`YfI4dyUD+S)g~Mi!d8Kct_-imR9H&9_Y&LdF8q1$>EviF6_?d zuIJ9;-tKzjd>p@FR{F=4c%pML|5Yw*Zzw=)d5ykiC(3(A+HLi<=%rL8xUg<&}b#B zw*{50tmG5w3g`}i@9l-G`W*dhtXcT8QK!9?2x_-qIJ zkB$ZY8bLoJ((7teHZmBJk);1YjJ!<$M_;c$(VfV{ai$ z@13{9^M^gOC7QQM3yGVRF!pLyAi4hp8vFa>UNv33!L%W1&NOdogS6zdc(3j&9@ro3 zrZ(2|(L^?#d=Q+HXnJWHDaXrW&DktBE$gjqZ6|EIY&mUht;H-qkPY{! z8w(V^F`tT@aWC#>v>MoLHB676)w39jksXFHraL%MAIS0^)(M%13rEDACWqy@?R403*Fn#%h#wJSBYt}R_B8ag^Yr!<@H}_d za`(smZpMa1+6!8U$u1mXS24%1TJsH-1FT+kn$Qiqj34W7g^hCIjy+rAl?r^pte7yBdns)s`^ql_2& zJWRO_0ammLT-|~d%+crS3-l%WZlLu9Ie8uAMa7M$`b1Fux^_-`r)5Mp@lCxLYAe~m z|Dmid`W^{Eq-pgsfQn#kw#~oWn;w}%n{i%V$iliOT%hJVc z55EiC5)%@L#`1r0 zzlnX~X~ci?V1L6bmn_+>RjnzOzLpcXdr(Pvi>bDWVftq{s(drVeZp#V$^6Zh!;ilJ zZ5h1rV)R`v#~tQwfa;K=UFh`vWWR78U-{h{hK~J_{f!D2Y7gIPN~U z3H@nZLFM9zx2?#oov7w#Mt8+KV9m`z-O`NRqX^VT2xx2W)Ref`W)LVsCWJb*Ou6#45B zZTrbMc7beni%LACe+2FYV)2|!z&rC6ylZs0hwia1P5N4%qQ3wYcTzf9tJ-Henn$#c zc;fiTVR1aMKeNB-XzOU_sOxxauSWiy14>s@y8crsok-%tK|`$b`qJImW5=61&(}=#sGG_C6Gh}$Bq;Eqpp;VOY5Kl~7-O0-hFE30>7a4C zu@$!BO2#*gLBmzUVZ%p;J9?8|FBhTFGzIOmg}wd&Juw4W?H{D4u5iRw{#asO&-lkM z(tco|rU&0g+bqJG{36g2-{@e@zXc#pV!+Vlp*^eyC$JN&k)QmbgFraU1y4`|eliZs zcP?k%`)Eip@QMQV$vP}YULuE*0}4K6zrSjrFO+?dm39QnvJ&Nkj^MvUz_g>)XT&KF z;Vky!kKBQ8bsMn-7w~@fN8?Li&)f?)XO$aEdD2{Yr2Zqr4*VlK6pJ<2TGsZDwJk9e zITqE@f}B<9)_iNodW+0Ul4X>6HIW2U7g{4Xzgu8-KWZ#axC8KNM?A0;XK%Y zIfk-^arz5#HF-A~TbA-zE{())ISpT6KABmj5#@6v%-aZ16bI?O&`LJ&dK$XO1WtnuP(V!(H9w(|cLODpj(&ZKR^LP7 zehfM;k(p}5-Z5i85t#@kfgkBA?UJ5KN%AH+Aa^7xGE@IbU)E3&8%96FbmrhsLk78f z{xYmZUucLgbd=sq#AHu7AnlVrC)>#@axlyT;j#-}cLvnoL$D0v$l{j_7p)k45g@)J zupF-TeIPaP7g=PwVfm;>pZ9QXWs#k6BFN0|$mJIYqRodUv<7_IKJ>tzXwRjusaQE=Z#L!~(BG~Vh4-~vyBABlt~yoZIp58ul{hprL!aM$Z(VWE7IwBM^}+bX>(%lnOK zL*d;MoTUP_z7;9^FOZuT`2Qhv^NUF3J&|5&Vv%YH?-v<_`=OWCXYH!6gUW;c6DLA< z-kr>f_GX1XU~NC+xfgqECU%8gps~E5PT%GvPXfc!gOLpdD>MZTI2V*r2AO5@VJcbwH`TlDfS(aL1qy7*!wfknnz(9nT{^DnDHIJa&ZJI{GD?ygMQs(j2^J50#jeL1l<RcN;^YZMJVCoq-{%&9=XiJb37Vq*jbI9(D-ZG6QO@aKSdBE+W(#{D z6{+YuW_2&)T*&->%`E??)vx5v-*ZQSo=;<)vsrtQo98t+K!LoKKtmY7a+*PBi9M5y z{Xs;pH08C(CEtigA}5g*I?=J0{QSlRmOPGmiG@yT@{J~3EqSy7N7Rn-3pBZSrvWok zg-1JA$$Rrb`*wwa(n7z(W_vhdZ z#ca>Rb|(<{*IAu?X#OX7b&GahFv}5O*o&FxUM^v46t;mh zE)iLBn)TfeRc1132}%;V^uw%^$l5QmD>?Cclwn1Ttf2-LDIUA03~pLwZoItninH!t z_+TNeWO2ux-0di>iFp;7g6{D+Ltiua|6wRd#3&r2z02V9j??N{`hSUU2sHl<=vPD- z-Qk|4SvfJc)tP-OJ*dQ@InmJRg-!WFWXJG6W&)B*?1v$hzEr@5J3oV%T19i~EoOZem= zJ2Do^dCc9m@&2Ez!((V6L=Qz&NDedfUo=bxH1(3P{!>D8g4>7{_QK(-vUl6SvBX|2 zh4)-!-;QODbo68-YZF0Vp7MP$a)o&;%P3^*xMHuoCL5H4d37K${TD|fDlOzegGKc8 zCaZCY-6N_qi0BCuaRH+L$KWsLdG`u)eyU{E@}V5D7ew?@4v$>MahKVCQSzRs5paRN zKjhtWthM;xx&Pk}he{}O6D#&#WXwT6yTJV~(9%9=We>aeHut*8y>4>X7u^2_|G&$8 zh}jUiwnV1>%luA6=ZJl<501IEWWVoauZd`)t(*_SDB2Q z%AloO#>)iYq74yK zbC3T$pl7eRPXT`)^RAm;syyTL=G48(iW@n-qB&p0$g&yP6WWYp7ns>W*Xg@J$KQr7 zuF~%t{6d`g`F!&htq9!vL8x#mRB@E=h`2is4^f%q1i!dUA8*sI9G?GSydg##;NfL- z3ZoP|rxd%d0?*N`<(r&}?N~p-rNv%}fS=>qXWxrRIuHH+m-cno;soVB;CjM)B4+CX zZC#~**Xda{yW<+KMAX$qUWrx9<@GUEDxY`uK;t4pRB*c!{1sg78ov?oQAeTQlYB1X z2!(G;#4aA@Tl?X(hmj<((ku+OhB7ap$XtkfaeI>O8p&};F&*ztKKJ-NXzGa1j_lGPUH(i!%0CNrJEb&j4L zC~4sgJwMMqav7QEg@~xz&*}IZpQrIEo$EBOPqVMC@O+gydqK<3p#b5Tx{Z7yI9RY` zj{VH5h*=PoY$VWGf;LrX$pl{$k*X?`BC?f<3Ouj*g*Z`U)~y2js1_$(0_!LwJ0Zo` zc&{9PTOi{I38@)7E`j$%-nufJLUCLonlg%bfK7E;GR4Ptf#jSF9wSj#I=+!I## z1*>?Czfb9TE}sah7gB?h(G)`Ig;1Tybttm)i>Nt4r_Xu)8j7h8HhdJ^peiG}$31Uz z7qPdV(~_X*8?5`EtcR#4bgP7BL_Fa$zNONud}i+=^m2~tHurO}KfF+$sA+MsgtEoT zWpQ6onMdUtVZ00PG1B``$VjBro8*_63_8CdyIMrIh{&}f?&4tVGI3LP`As=|SqF8C zuxHQFAJD;qlm2-@_05Kk|T#!MAl2kK8GcUr(vjvIOq-m{F|J zndL0~b;C+SEBznRdZdYEXh|2DYeTq9XlL*Wc{=B!EBZi=-@)VdBk132p}lDEVf=hY zLnD}NFZ<~v6!r*TW+S+ckv;h}6%4%6F8KpA!MS>azLESpc^v+gO3N?EUAkVEizQsd z3bZD2;431lCS%pPh$d|W4_qsB2HV-ZU|z63)=Bbtfs^Qr6}KV3xs4qy51Z8`PT=dv z^aD99sxq1l^jxgU5b`^Qh%dQ|tk8*7_zc|2P&jus5_?l*&F=WACG_p9Xwh|%HbtyL z4ED?R=n8G|H#tL9v2d2=oT$e9+$C$^Z1n1Pur$Z;_c5^(*&v;_Qla5}{P7=CH{cI+ zq?N=6q@dHg&>?F;H@QSpY-KJASoyBlo%V2o{Ka^;VToSOZV4c>JPT!pIzv&jK%;x` zvR=na)06!wGzJlg`HBd}I^^H2h5jAS>GyzL<%FwjW0cV)ksOVvh*1I0Lo^(v0;g0D z_Dc-=?H6QdD_Zm_=BO6Cs19e-BP65+x=eJxR;m+6m-;{?4gCkrOnWt02$%NOSX{T z7I2;A+@6ROFK`gMX|EC|tr1^t3TJp0wK#?l(Nsyd21);0#ykm((RO-L9}XU1l=Gq3 zjmX|VfbW_Hr#Q{1{)Var?-kK%%elX(M|A^!l?ktR(C1&!6~1Smd)Sdb({2k|U&Lz@ z=cCBr*qQqrf-aKy{iASGY=LdyFE2Ucd`P?J(Hu+T1M6C1CbNdsq@mDT!y6*z)M{*am*@4_=8kv{|m_7eW{q0pq@BRY7W5$^X0 z9>1O5?xcMWb0BJT?PE3<)4O6KfNC+5$B??dXEp>HAOtt%^uF;cl((8`|NKK)qRrDiF~ns)>oW)O?WsNOFE~L zh~Rglg_LLIpKx}ch2y(e?J7`Q9Ml?*EE>m1N^>r{7)hYyZ1O^N5`0NuI?|Y#9at`w zvY&)jo5kJ`*pS7{{~lH&mFpM&W-`;ip!NI+=h(`73;2bouOuXehn#0Z{>g%$ifAb# zySx%-s<0diy~WR2ChQl_Ss_s|$5BE*{o!Wyp;nc(y92kX2Y(c++>7@+vKm#GqXhWI zFgW9c&N|v;aWTnXg zdofV|lfJfLsG%eAXA8;dw++PDYQs0!TU#627#bLg^?&JS=^N@F%CqD$@?NQj6oi|O zheK_`j`$C`UX$p*Ope!+oU!ABlkhlCq9)A`#QAIwrgEJOUc;T39_v73B)J-W(PN5ZnCA9x7XR%G!P#P>(07I5wcx?z9 z_nZ8t0#mvv&2*cjA@@v^P0^-1#y>zh1@Q>j^!4Sb#80&#w?JZO04S7?@q_g9@76kN z(Oi1avnlEf5XyFKxmJo#Hh@Y=As5(k(0|RSff2)LmJf#!R-Z=fz>z%PgO3S|e?Kgt zm!R2JQ0Z&%S+#>%AOfZn?c)K*;3c!@G~y%rYPB?tTyA-w$)mN(T3aoHEc9OldJ*-O z5^94CFciH0BSS@VPfG*a7`w+_$I;jE#BmEh;r6J~rCOJ2R;qTXtf*&^KSeZl1Z-ie z-FjJxG#iX=xvLbddqK8<@`10kN4|O90iHVU>aJeSm&Nys4bEoHBxgr31s9!DU4z}7 zJZ-%FeBY|)HG3dAI3=`^3{Bn1uhvB$Ymh+W&oebO=a>g7`;<&&h0;YaE62_A%y#oM z(>-Hb;}WovN&12EC(_5dDd7d7slkPT-^uAVT&qNu$IsPj7~l(hx5+~K*k@M=+}b;%zw3Kw?im47owNC4(zE zMZ8qoKoPm_ZRDOB%zEWe1LjNW#8l!MsBUIPztA-8uzzx(eb54ef$T!MczHh<`jzI* zme#f!_Mhxt`$vu%5w#;dkyD~JM6HSXCaO`?j>wx4zd9P({Z^0VmNL}5$+%U2OBzdN z;fkTZ1Ib`-yZNl%r|vth$IdFweZ@P9^NVF?th1?eyfe!=#+Br5=xIk}T88Rie9MB@ zLPcc7ogg&@72eoT-&oreY0fr}Q;L*#EsZT@Ea#QUN)zRRdARw!Datg@_}q|Sn6KZ4 z|8=KsYnVI=!AamVto{weB)wLD1qU&bI!se}?ypWz|5V>3YN;;yaK8arkQw}x3(qL*4MpC_OF;a3@B!b&;-&itW4+Q^K99#pEZyp%^&Hj#lkM^fF zLF=M5hyL@K#jlyuIbhJrYqNWr%f}t(twUy}Cn+ zcocCV^4q9?q9RMlr7lGcj!KQ37}4L+%HF_M#hR!c65q(hYBV8qO_=gqt1{4 z&l1%(@*V2D;NmJ!#%;Q0Kd9A~^?_s87`CT0F?N1A%S99ii1w z=ubqu3^!CZxy-vQWo)l()9m^7DUP}krpW!|sI3s?i_DH3ANe{WKB9&r)?S&KB`1`o z#Ecx#Tjd?Puc-T?22%aW+FjoP??z9$+wU6fD$B0VcIG*AonB`v*DhBtcY>$LljA+h ze!rx>^gDtLL*IrU>JrJO`iQuM`-Vlvaa3G;VE#}!s6<(6TN)9Wx{^7)Z(d|JnCqFE z7>60Q>y7#$MChGjXTBo(Ha4gWB>1OjrLVEiL^i1eTYAL-(zR`C}FrfE{fSQkV9)sm#Av)F<;Dvt*w!*W&8U%|# z2{onW+6;DlE3G!P+MEoe7u7%1-Rd1;A4h{`+vxu=@Mh2-6gAKmfZ^LD`}FC?S>^=G zT13GCM@)meAeFxM7TA{x| za8<|~ZU_%m<*oY8h6jda#`aV++iWhQOrfsR8fBU?L}{Z$C|k@G%)?BxjOhlCz6W^+ z0@8=lPddC|p^RWYD6_%D?o8HVv`RKaa6RM zsSP8_sgqWdbI?t7o)t(F+tecUf5e}5^E>_NfiKAL|1k6uw7L|FjbvDAOdw}#ywzme zVl&&P*<&0#9LW(&Bi2)I?Bj@95q~>k9S!ZRY+bFLEtQnxrdq}y^_As3T`GB``vj{5 z?t`0{>l^Q#>{;iQ-QT;CU6ov=Ts2&sT=QKwT?5=+5U&Hg^?V+vHC?;zuZB%&L--zP z8G`a3`X5KV(fGO3G#tQY4_oBQ{e-H)CEKyl|lyCMC?&JP-qs=P|pG@gPo9Lm!eg@4?^IY z?hQ_+e$ppkGUiF+h|YM3oum`G&yY&<|$RoYm83)EV;8pwa{?KP`Th;|9)+; zI>k4J8c=uLeVE-Ft|P9^t`n}Ot~%~j?rLP|{>=M^@0RZ`bukqNKBSV|`q19+Wt~&1 zp>JWRW;|rHfgxUD(oDn67tAK5j?!4Et3;8#y^?vANimHgdwaB@E_Khok#U-5Yu6m2C1=;FtqUO30ne5`^UjQm<1krOz)czq z+LN>fWQc8}P1Fu)FSL4K7^|Qk3t`Kp>8a$JIvUS_FZ)KCOQx%Jp~=CP0ae?sE)!2d={ezP<~>NZZkI1leUoU*pM!@(zlN89*Zx@k3@+Qo z7-f2HT5dKf)s;jlLVc{PS9T~rD%F&YV7I?CT{pf%Y{MzNUf)z626C_ueDEw8I(9)( zss2*_jap0Xxq3uhr~XXDTn;Fs0%o{_c19ZjvT!)K?#976!BFrskSVRPm^4CLzNq_G zXCi)g7(C%OX$zS9Wa%ZDlInvhN+Rpblu$HiruLw;r-OFA1$H>me@UCiUG>^oA|J;h z2~VfmfEg}vkO~#ki2T1f464Z@z_Zm?_hwdcMNeL=LEI(L|S*}pEaVmB54k`h2d#d$4GIn5gQ}rqGFVbNoqDJB2p`U|K!AS0g z4}PT?wLjH`>NIs6r}Zi|3(33#c{t8dTj3;e$>-5HwqnuV94dp|G(^nW9<<1}Knl%~ zHcDrxG<%&a+P_QF;SPmFpN+%LbPLO1h4A;GSWvI!gPX{aa-aF_>VKi_fmRz+L-Z&u zEmW7P`-tG(hOTjqnu@pJ3Ufp0;p)<#asmKI(k!*3Aefhg^X}{uFJi>hg6XyZndVi=Muo z9QSPZ7w#1IV|QK82+uChYtJaJ-k0s$t}fDM!4bL!6Vc+yvxlrVTEE+{&e+8CJ@V^* z^CwDyB3lZS>&h!7TbZZ0%paOxniiYlO&=KFF*xOGNS(uUo5Pu8TImfgeNf;GGdml^ zc}H}{a@sXcv7gCmQb+60N%m43LB8x>@XKo;d4CJ`#;(#Ct6_GyCc2djbqt{L?h5HI zB1sNQtEqF`hN@WQrJLZ6>SI@(1jg+!NccO%`&JMB6&M&$;ky0(b%-p!26vc5yB}!N z;p;0HRcjEo5|)%w#B!aIo9p+0drUM|FvWo39j6>u8d=gTR%<1z$-2|h*Cvct&>ZE4+dVvAl=pEza>c`4wr7qHTWRjRL5lmovQ>ZrDn=uA7n?D_G>mN=qx0=8SK1aK% zl_%TsHUFE~O;&)A+(#76ax5(lY}e=UWq%6(F%SKqI$3!;P%i^nMe0P|=vvYZuwV7D zGhISbXdBKZqNZ=CQs@|YizRa0-6!wQHey}k(PayWE0`MS3m&>ST%_wOHD=Y@k^3kl zU(|nWxKt9gwVwL3dTQO(F>f}9%ob&Yc{EziTgEqy<%lz$Vvx!8kSmArj@Wc>fbWka zLil|!(#8HU{)+xWEt?7)BgoYqP|w4ARuThjZXzOd zDzf`)@ROq$+jOFP%KNJ#Z4L#KzMZosgE$I5`+o;I&|G5IY*5@dP_SlDcbD+VjfPfF zQ?cr?&O>a~08X;GoM2U?*Z6@>V$oa+@>2Nivaza;B(gsgDkP`z-q6>?z?CPXkO3Rv zickdh{;k-93*c!3$iU?X$^SQ5mB&)E@1d+G+HIr$j$UHky!xH`Nkkqt(#Pv#sbiTc zx04IV(NG6X=R^FXmuaUP^`(EIpK+l_!Sisf736kG3`Pd;6XSHAM!#3E&*{{oW$3U>0$1 zSx8!qu|&E3H$J&{U&!Y+6;D%VU{8+U_rryKY zYE!W*eh0S|xse5a>k`)eir~?DVW;_l`8-38kV2iEd|jQS5%BDfq~1u}U6JXMq>2&; z68WhMK|Ail-aG?4^ZQtbpW!_bSdsx3qg)C=j!~yN%f2(-4kDk1s%}DZbSn*1=#O^c=4gV&7 zhbq|lI%1cajOF|+Xw8d^J)pCY53>T+l?W=B>7oBHIT3syJYSKMG79QxM!odW$hK{e zzWlr|@z2UPJZKeH!D5MAjKAOu98Z4@cxP^+$vwq4a27Az*I2E)k(Do=vDf5WtqnT0 z1AdftcvFXCWgN@rpW{85#2TfsK3B1`i@dKQFRQ@fIPq>r;8pk!BNc;OZD;g#Qn(alrEc literal 0 HcmV?d00001 diff --git a/octave_packages/audio-1.1.4/sound.m b/octave_packages/audio-1.1.4/sound.m new file mode 100644 index 0000000..760689c --- /dev/null +++ b/octave_packages/audio-1.1.4/sound.m @@ -0,0 +1,159 @@ +## Copyright (C) 1999-2000 Paul Kienzle +## +## 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 . + +## usage: sound(x [, fs, bs]) +## +## Play the signal through the speakers. Data is a matrix with +## one column per channel. Rate fs defaults to 8000 Hz. The signal +## is clipped to [-1, 1]. Buffer size bs controls how many audio samples +## are clipped and buffered before sending them to the audio player. bs +## defaults to fs, which is equivalent to 1 second of audio. +## +## Note that if $DISPLAY != $HOSTNAME:n then a remote shell is opened +## to the host specified in $HOSTNAME to play the audio. See manual +## pages for ssh, ssh-keygen, ssh-agent and ssh-add to learn how to +## set it up. +## +## This function writes the audio data through a pipe to the program +## "play" from the sox distribution. sox runs pretty much anywhere, +## but it only has audio drivers for OSS (primarily linux and freebsd) +## and SunOS. In case your local machine is not one of these, write +## a shell script such as ~/bin/octaveplay, substituting AUDIO_UTILITY +## with whatever audio utility you happen to have on your system: +## #!/bin/sh +## cat > ~/.octave_play.au +## SYSTEM_AUDIO_UTILITY ~/.octave_play.au +## rm -f ~/.octave_play.au +## and set the global variable (e.g., in .octaverc) +## global sound_play_utility="~/bin/octaveplay"; +## +## If your audio utility can accept an AU file via a pipe, then you +## can use it directly: +## global sound_play_utility="SYSTEM_AUDIO_UTILITY flags" +## where flags are whatever you need to tell it that it is receiving +## an AU file. +## +## With clever use of the command dd, you can chop out the header and +## dump the data directly to the audio device in big-endian format: +## global sound_play_utility="dd of=/dev/audio ibs=2 skip=12" +## or little-endian format: +## global sound_play_utility="dd of=/dev/dsp ibs=2 skip=12 conv=swab" +## but you lose the sampling rate in the process. +## +## Finally, you could modify sound.m to produce data in a format that +## you can dump directly to your audio device and use "cat >/dev/audio" +## as your sound_play_utility. Things you may want to do are resample +## so that the rate is appropriate for your machine and convert the data +## to mulaw and output as bytes. +## +## If you experience buffer underruns while playing audio data, the bs +## buffer size parameter can be increased to tradeoff interactivity +## for smoother playback. If bs=Inf, then all the data is clipped and +## buffered before sending it to the audio player pipe. By default, 1 +## sec of audio is buffered. + +function sound(data, rate, buffer_size) + + if nargin<1 || nargin>3 + usage("sound(x [, fs, bs])"); + endif + if nargin<2 || isempty(rate), rate = 8000; endif + if nargin<3 || isempty(buffer_size), buffer_size = rate; endif + if rows(data) != length(data), data=data'; endif + [samples, channels] = size(data); + + ## Check if the octave engine is running locally by seeing if the + ## DISPLAY environment variable is empty or if it is the same as the + ## host name of the machine running octave. The host name is + ## taken from the HOSTNAME environment variable if it is available, + ## otherwise it is taken from the "uname -n" command. + display=getenv("DISPLAY"); + colon = rindex(display,":"); + if isempty(display) || colon==1 + islocal = 1; + else + if colon, display = display(1:colon-1); endif + host=getenv("HOSTNAME"); + if isempty(host), + [status, host] = system("uname -n"); + ## trim newline from end of hostname + if !isempty(host), host = host(1:length(host)-1); endif + endif + islocal = strcmp(tolower(host),tolower(display)); + endif + + ## What do we use for playing? + global sound_play_utility; + if ~isempty(sound_play_utility), + ## User specified command + elseif (file_in_path(EXEC_PATH, "ofsndplay")) + ## Mac + sound_play_utility = "ofsndplay -" + elseif (file_in_path(EXEC_PATH, "play")) + ## Linux (sox) + sound_play_utility = "play -t AU -"; + else + error("sound.m: No command line utility found for sound playing"); + endif + + ## If not running locally, then must use ssh to execute play command + if islocal + fid=popen(sound_play_utility, "w"); + else + fid=popen(["ssh ", host, " ", sound_play_utility], "w"); + end + if fid < 0, + warning("sound could not open play process"); + else + ## write sun .au format header to the pipe + fwrite(fid, toascii(".snd"), 'char'); + fwrite(fid, 24, 'int32', 0, 'ieee-be'); + fwrite(fid, -1, 'int32', 0, 'ieee-be'); + fwrite(fid, 3, 'int32', 0, 'ieee-be'); + fwrite(fid, rate, 'int32', 0, 'ieee-be'); + fwrite(fid, channels, 'int32', 0, 'ieee-be'); + + if isinf(buffer_size), + fwrite(fid, 32767*clip(data,[-1, 1])', 'int16', 0, 'ieee-be'); + else + ## write data in blocks rather than all at once + nblocks = ceil(samples/buffer_size); + block_start = 1; + for i=1:nblocks, + block_end = min(size(data,1), block_start+buffer_size-1); + fwrite(fid, 32767*clip(data(block_start:block_end,:),[-1, 1])', 'int16', 0, 'ieee-be'); + block_start = block_end + 1; + end + endif + pclose(fid); + endif +end + +###### auplay based version: not needed if using sox +## ## If not running locally, then must use ssh to execute play command +## global sound_play_utility="~/bin/auplay" +## if islocal +## fid=popen(sound_play_utility, "w"); +## else +## fid=popen(["ssh ", host, " ", sound_play_utility], "w"); +## end +## fwrite(fid, rate, 'int32'); +## fwrite(fid, channels, 'int32'); +## fwrite(fid, 32767*clip(data,[-1, 1])', 'int16'); +## pclose(fid); + +%!demo +%! [x, fs] = auload(file_in_loadpath("sample.wav")); +%! sound(x,fs); diff --git a/octave_packages/audio-1.1.4/soundsc.m b/octave_packages/audio-1.1.4/soundsc.m new file mode 100644 index 0000000..8820fb0 --- /dev/null +++ b/octave_packages/audio-1.1.4/soundsc.m @@ -0,0 +1,65 @@ +## Copyright (C) 2000 Paul Kienzle +## +## 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 . + +## usage: soundsc(x, fs, limit) or soundsc(x, fs, [ lo, hi ]) +## +## soundsc(x) +## Scale the signal so that [min(x), max(x)] -> [-1, 1], then +## play it through the speakers at 8000 Hz sampling rate. The +## signal has one column per channel. +## +## soundsc(x,fs) +## Scale the signal and play it at sampling rate fs. +## +## soundsc(x, fs, limit) +## Scale the signal so that [-|limit|, |limit|] -> [-1, 1], then +## play it at sampling rate fs. If fs is empty, then the default +## 8000 Hz sampling rate is used. +## +## soundsc(x, fs, [ lo, hi ]) +## Scale the signal so that [lo, hi] -> [-1, 1], then play it +## at sampling rate fs. If fs is empty, then the default 8000 Hz +## sampling rate is used. +## +## y=soundsc(...) +## return the scaled waveform rather than play it. +## +## See sound for more information. + +function data_r = soundsc(data, rate, range) + + if nargin < 1 || nargin > 3, usage("soundsc(x, fs, [lo, hi])") endif + if nargin < 2, rate = []; endif + if nargin < 3, range = [min(data(:)), max(data(:))]; endif + if isscalar(range), range = [-abs(range), abs(range)]; endif + + data=(data - mean(range))/((range(2)-range(1))/2); + if nargout > 0 + data_r = data; + else + sound(data, rate); + endif +endfunction + + +%!demo +%! [x, fs] = auload(file_in_loadpath("sample.wav")); +%! soundsc(x,fs); + +%!shared y +%! [x, fs] = auload(file_in_loadpath("sample.wav")); +%! y=soundsc(x); +%!assert (min(y(:)), -1, eps) +%!assert (max(y(:)), 1, eps) diff --git a/octave_packages/benchmark-1.1.1/benchmark_dtmm.m b/octave_packages/benchmark-1.1.1/benchmark_dtmm.m new file mode 100644 index 0000000..4aa7434 --- /dev/null +++ b/octave_packages/benchmark-1.1.1/benchmark_dtmm.m @@ -0,0 +1,99 @@ +% Copyright (C) 2008 Jaroslav Hajek +% +% This file is part of OctaveForge. +% +% OctaveForge is free software; you can 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 software; see the file COPYING. If not, see +% . +% + +% function benchmark_dtmm (m, n, nvec) +% description: +% Dense transposed matrix-matrix and matrix-vector multiplication benchmark. +% This is to test the "compound operators" feature introduced in Octave. +% +% arguments: +% m = row dimension of matrices +% n = col dimension of matrices +% nvec = number of vector op repeats +% +% results: +% time_tmm = Time for A'*B (A,B m-by-n matrices) +% time_smm = Time for A'*A +% time_mtm = Time for A*B' (A,B n-by-m matrices) +% time_msm = Time for A*A' +% time_tmv = Time for A'*v nvec-times (A m-by-n matrix) +% ratio_tmv = Ratio to precomputed transpose time +% time_mtv = Time for v*A' nvec-times (A m-by-n matrix) +% ratio_mtv = Ratio to precomputed transpose time +% + +function results = benchmark_dtmm (m, n, nvec) + + benchutil_default_arg ('m', 40192); + benchutil_default_arg ('n', 150); + benchutil_default_arg ('nvec', 100); + + benchutil_initialize (mfilename) + + A = rand (m, n); + B = rand (m, n); + + tic; C = A'*B; time_tmm = toc; + benchutil_set_result ('time_tmm') + + tic; C = A'*A; time_smm = toc; + benchutil_set_result ('time_smm') + + A = A'; + B = B'; + + tic; C = A*B'; time_mtm = toc; + benchutil_set_result ('time_mtm') + + tic; C = A*A'; time_msm = toc; + benchutil_set_result ('time_msm') + + A = A'; + + v = rand (m, 1); + tic; + for i=1:nvec + c = A'*v; + end + time_tmv = toc; + benchutil_set_result ('time_tmv') + + B = A'; + tic; + for i=1:nvec + c = B*v; + end + ratio_tmv = time_tmv / toc; + benchutil_set_result ('ratio_tmv') + + v = rand (1, n); + tic; + for i=1:nvec + c = v*A'; + end + time_mtv = toc; + benchutil_set_result ('time_mtv') + + tic; + for i=1:nvec + c = v*B; + end + ratio_mtv = time_mtv / toc; + benchutil_set_result ('ratio_mtv') + diff --git a/octave_packages/benchmark-1.1.1/benchmark_index.m b/octave_packages/benchmark-1.1.1/benchmark_index.m new file mode 100644 index 0000000..abeab9e --- /dev/null +++ b/octave_packages/benchmark-1.1.1/benchmark_index.m @@ -0,0 +1,174 @@ +% Copyright (C) 2009 VZLU Prague +% +% This file is part of OctaveForge. +% +% OctaveForge is free software; you can 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 software; see the file COPYING. If not, see +% . +% + +% function benchmark_index (n, rep) +% description: +% Test speed of array indexing. +% +% arguments: +% n = array size +% rep = number of repeats +% +% results: +% time_slice1 = time for a(i:j) +% time_slice1s = time for a(i:k:j) +% time_slice1v = time for a(idx) +% time_slice2c = time for a(:,i:j) +% time_slice2r = time for a(i:j,:) +% time_slice2cv = time for a(:,idx) +% time_slice2rv = time for a(idx,:) +% time_slicenc = time for a(:,:,i:j,k) +% time_slicend = time for a(:,:,k,i:j) +% time_slicens = time for a(i,j,k,:) +% time_spreadr = time for a(ones(1, k), :), a row vector +% time_spreadc = time for a(:, ones(1, k)), a column vector +% + +function results = benchmark_index (n, rep) + + benchutil_default_arg ('n', 4e6); + benchutil_default_arg ('rep', 100); + + benchutil_initialize (mfilename) + + a = rand (1, n); + + i = 10; + j = n - 10; + + tic; + for irep = 1:rep + b = a(i:j); + end + time_slice1 = toc; + benchutil_set_result ('time_slice1') + + k = 2; + + tic; + for irep = 1:rep + b = a(i:k:j); + end + time_slice1s = toc; + benchutil_set_result ('time_slice1s') + + idx = cumsum (rand (1, n)); + idx = ceil (idx / idx(end) * n); + + tic; + for irep = 1:rep + b = a(idx); + end + time_slice1v = toc; + benchutil_set_result ('time_slice1v') + + m = floor (sqrt(n)); + a = rand (m); + + i = 5; + j = m - 5; + + tic; + for irep = 1:rep + b = a(:,i:j); + end + time_slice2c = toc; + benchutil_set_result ('time_slice2c') + + tic; + for irep = 1:rep + b = a(i:j,:); + end + time_slice2r = toc; + benchutil_set_result ('time_slice2r') + + idx = cumsum (rand (1, m)); + idx = ceil (idx / idx(end) * m); + + tic; + for irep = 1:rep + b = a(:,idx); + end + time_slice2cv = toc; + benchutil_set_result ('time_slice2cv') + + tic; + for irep = 1:rep + b = a(idx,:); + end + time_slice2rv = toc; + benchutil_set_result ('time_slice2rv') + + m = floor (sqrt (n / 6)); + a = rand (2, m, m, 3); + + i = 5; + j = m - 5; + k = 2; + + tic; + for irep = 1:rep + b = a(:,:,i:j,k); + end + time_slicenc = toc; + benchutil_set_result ('time_slicenc') + + m = floor (sqrt (n / 6)); + a = rand (2, m, 3, m); + + i = 5; + j = m - 5; + k = 2; + + tic; + for irep = 1:rep + b = a(:,:,k,i:j); + end + time_slicend = toc; + benchutil_set_result ('time_slicend') + + m = floor (n / 12); + a = rand (2, 2, 3, m); + + tic; + for irep = 1:rep + b = a(2,1,3,:); + end + time_slicens = toc; + benchutil_set_result ('time_slicens') + + m = floor (sqrt (n)); + a = rand (1, m); + + tic; + for irep = 1:rep + b = a(ones(1, m), :); + end + time_spreadr = toc; + benchutil_set_result ('time_spreadr') + + a = rand (m, 1); + + tic; + for irep = 1:rep + b = a(:, ones(1, m)); + end + time_spreadc = toc; + benchutil_set_result ('time_spreadc') + diff --git a/octave_packages/benchmark-1.1.1/benchmark_intmath.m b/octave_packages/benchmark-1.1.1/benchmark_intmath.m new file mode 100644 index 0000000..aa3a329 --- /dev/null +++ b/octave_packages/benchmark-1.1.1/benchmark_intmath.m @@ -0,0 +1,182 @@ +% Copyright (C) 2008 Jaroslav Hajek +% +% This file is part of OctaveForge. +% +% OctaveForge is free software; you can 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 software; see the file COPYING. If not, see +% . +% + +% function benchmark_intmath (n, ratio) +% description: +% Test speed of integer math & conversions. +% +% arguments: +% n = array size +% ratio = ratio of intmath for generating integers +% +% results: +% time_uint8_conv = time to convert real vector to uint8 +% time_uint8_add = time to add two uint8 vectors +% time_uint8_sub = time to subtract two uint8 vectors +% time_uint8_mul = time to multiply two uint8 vectors +% time_uint8_div = time to divide two uint8 vectors +% time_int8_conv = time to convert real vector to int8 +% time_int8_add = time to add two int8 vectors +% time_int8_sub = time to subtract two int8 vectors +% time_int8_mul = time to multiply two int8 vectors +% time_int8_div = time to divide two int8 vectors +% time_uint16_conv = time to convert real vector to uint16 +% time_uint16_add = time to add two uint16 vectors +% time_uint16_sub = time to subtract two uint16 vectors +% time_uint16_mul = time to multiply two uint16 vectors +% time_uint16_div = time to divide two uint16 vectors +% time_int16_conv = time to convert real vector to int16 +% time_int16_add = time to add two int16 vectors +% time_int16_sub = time to subtract two int16 vectors +% time_int16_mul = time to multiply two int16 vectors +% time_int16_div = time to divide two int16 vectors +% time_uint32_conv = time to convert real vector to uint32 +% time_uint32_add = time to add two uint32 vectors +% time_uint32_sub = time to subtract two uint32 vectors +% time_uint32_mul = time to multiply two uint32 vectors +% time_uint32_div = time to divide two uint32 vectors +% time_int32_conv = time to convert real vector to int32 +% time_int32_add = time to add two int32 vectors +% time_int32_sub = time to subtract two int32 vectors +% time_int32_mul = time to multiply two int32 vectors +% time_int32_div = time to divide two int32 vectors +% + +function results = benchmark_intmath (n, ratio) + + benchutil_default_arg ('n', 1e7); + benchutil_default_arg ('ratio', 0.6); + + benchutil_initialize (mfilename) + + x = ratio * double (intmax ('uint8')) * rand(n, 1); + y = ratio * double (intmax ('uint8')) * rand(n, 1); + + x = uint8 (x); + tic; y = uint8 (y); time_uint8_conv = toc; + benchutil_set_result ('time_uint8_conv') + + tic; xy = x + y; time_uint8_add = toc; + benchutil_set_result ('time_uint8_add') + + tic; xy = x - y; time_uint8_sub = toc; + benchutil_set_result ('time_uint8_sub') + + tic; xy = x .* y; time_uint8_mul = toc; + benchutil_set_result ('time_uint8_mul') + + tic; xy = x ./ y; time_uint8_div = toc; + benchutil_set_result ('time_uint8_div') + + x = ratio * double (intmax ('int8')) * (2 * rand(n, 1) - 1); + y = ratio * double (intmax ('int8')) * (2 * rand(n, 1) - 1); + + x = int8 (x); + tic; y = int8 (y); time_int8_conv = toc; + benchutil_set_result ('time_int8_conv') + + tic; xy = x + y; time_int8_add = toc; + benchutil_set_result ('time_int8_add') + + tic; xy = x - y; time_int8_sub = toc; + benchutil_set_result ('time_int8_sub') + + tic; xy = x .* y; time_int8_mul = toc; + benchutil_set_result ('time_int8_mul') + + tic; xy = x ./ y; time_int8_div = toc; + benchutil_set_result ('time_int8_div') + + x = ratio * double (intmax ('uint16')) * rand(n, 1); + y = ratio * double (intmax ('uint16')) * rand(n, 1); + + x = uint16 (x); + tic; y = uint16 (y); time_uint16_conv = toc; + benchutil_set_result ('time_uint16_conv') + + tic; xy = x + y; time_uint16_add = toc; + benchutil_set_result ('time_uint16_add') + + tic; xy = x - y; time_uint16_sub = toc; + benchutil_set_result ('time_uint16_sub') + + tic; xy = x .* y; time_uint16_mul = toc; + benchutil_set_result ('time_uint16_mul') + + tic; xy = x ./ y; time_uint16_div = toc; + benchutil_set_result ('time_uint16_div') + + x = ratio * double (intmax ('int16')) * (2 * rand(n, 1) - 1); + y = ratio * double (intmax ('int16')) * (2 * rand(n, 1) - 1); + + x = int16 (x); + tic; y = int16 (y); time_int16_conv = toc; + benchutil_set_result ('time_int16_conv') + + tic; xy = x + y; time_int16_add = toc; + benchutil_set_result ('time_int16_add') + + tic; xy = x - y; time_int16_sub = toc; + benchutil_set_result ('time_int16_sub') + + tic; xy = x .* y; time_int16_mul = toc; + benchutil_set_result ('time_int16_mul') + + tic; xy = x ./ y; time_int16_div = toc; + benchutil_set_result ('time_int16_div') + + x = ratio * double (intmax ('uint32')) * rand(n, 1); + y = ratio * double (intmax ('uint32')) * rand(n, 1); + + x = uint32 (x); + tic; y = uint32 (y); time_uint32_conv = toc; + benchutil_set_result ('time_uint32_conv') + + tic; xy = x + y; time_uint32_add = toc; + benchutil_set_result ('time_uint32_add') + + tic; xy = x - y; time_uint32_sub = toc; + benchutil_set_result ('time_uint32_sub') + + tic; xy = x .* y; time_uint32_mul = toc; + benchutil_set_result ('time_uint32_mul') + + tic; xy = x ./ y; time_uint32_div = toc; + benchutil_set_result ('time_uint32_div') + + x = ratio * double (intmax ('int32')) * (2 * rand(n, 1) - 1); + y = ratio * double (intmax ('int32')) * (2 * rand(n, 1) - 1); + + x = int32 (x); + tic; y = int32 (y); time_int32_conv = toc; + benchutil_set_result ('time_int32_conv') + + tic; xy = x + y; time_int32_add = toc; + benchutil_set_result ('time_int32_add') + + tic; xy = x - y; time_int32_sub = toc; + benchutil_set_result ('time_int32_sub') + + tic; xy = x .* y; time_int32_mul = toc; + benchutil_set_result ('time_int32_mul') + + tic; xy = x ./ y; time_int32_div = toc; + benchutil_set_result ('time_int32_div') + + diff --git a/octave_packages/benchmark-1.1.1/benchmark_permute.m b/octave_packages/benchmark-1.1.1/benchmark_permute.m new file mode 100644 index 0000000..996cfdd --- /dev/null +++ b/octave_packages/benchmark-1.1.1/benchmark_permute.m @@ -0,0 +1,54 @@ +% Copyright (C) 2009 VZLU Prague +% +% This file is part of OctaveForge. +% +% OctaveForge is free software; you can 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 software; see the file COPYING. If not, see +% . +% + +% function benchmark_permute (n) +% description: +% Test speed of array permuting. +% +% arguments: +% n = dimension size (n^5 is number of elements) +% +% results: +% +% time_21345 = time for [2,1,3,4,5] permutation +% time_13425 = time for [1,3,4,2,5] permutation +% time_34125 = time for [3,4,1,2,5] permutation +% time_45123 = time for [4,5,1,2,3] permutation +% + +function results = benchmark_permute (n, rep) + + benchutil_default_arg ('n', 30); + + benchutil_initialize (mfilename) + + a = zeros (n, n, n, n, n); + + tic; b = permute (a, [2,1,3,4,5]); time_21345 = toc + benchutil_set_result ('time_21345') + + tic; b = permute (a, [1,3,4,2,5]); time_13425 = toc + benchutil_set_result ('time_13425') + + tic; b = permute (a, [3,4,1,2,5]); time_34125 = toc + benchutil_set_result ('time_34125') + + tic; b = permute (a, [4,5,1,2,3]); time_45123 = toc + benchutil_set_result ('time_45123') + diff --git a/octave_packages/benchmark-1.1.1/benchmark_stmm.m b/octave_packages/benchmark-1.1.1/benchmark_stmm.m new file mode 100644 index 0000000..81ceb82 --- /dev/null +++ b/octave_packages/benchmark-1.1.1/benchmark_stmm.m @@ -0,0 +1,78 @@ +% Copyright (C) 2008 Jaroslav Hajek +% +% This file is part of OctaveForge. +% +% OctaveForge is free software; you can 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 software; see the file COPYING. If not, see +% . +% + +% function benchmark_stmm (n, nvec) +% description: +% Sparse transposed matrix-vector multiplication benchmark. +% This is to test the "compound operators" feature introduced in Octave. +% +% arguments: +% n = dimension of matrix +% nvec = number of vector op repeats +% +% results: +% time_tmm = Time for A'*B (B n^2-by-nvec matrix) +% time_tmv = Time for A'*v nvec-times (v vector) +% time_mtm = Time for B*A' (B nvec-by-n^2 matrix) +% time_mtv = Time for v*A' nvec-times (v vector) +% + +function results = benchmark_stmm (n, nvec) + + benchutil_default_arg ('n', 300); + benchutil_default_arg ('nvec', 100); + + benchutil_initialize (mfilename) + + disp ('constructing sparse matrix') + n = 300; % size of the grid + m = n^2; % number of points + X = (n-1)*rand (m, 1); Y = (n-1)*rand (m, 1); + IX = ceil (X); JY = ceil (Y); + + A = sparse(m, n^2); + A = A + sparse (1:m, sub2ind ([n, n], IX , JY ), (IX+1-X).*(JY+1-Y), m, n^2); + A = A + sparse (1:m, sub2ind ([n, n], IX+1, JY ), (X - IX).*(JY+1-Y), m, n^2); + A = A + sparse (1:m, sub2ind ([n, n], IX , JY+1), (IX+1-X).*(Y - JY), m, n^2); + A = A + sparse (1:m, sub2ind ([n, n], IX+1, JY+1), (X - IX).*(Y - JY), m, n^2); + + v = ones (m, nvec); + tic; u = A'*v; time_tmm = toc; + benchutil_set_result ('time_tmm') + + v = ones (m, 1); + tic; + for i=1:nvec + u = A'*v; + end + time_tmv = toc; + benchutil_set_result ('time_tmv') + + v = ones (nvec, m); + tic; u = v*A'; time_mtm = toc; + benchutil_set_result ('time_mtm') + + v = ones (1, m); + tic; + for i=1:nvec + u = v*A'; + end + time_mtv = toc; + benchutil_set_result ('time_mtv') + diff --git a/octave_packages/benchmark-1.1.1/benchutil_average.m b/octave_packages/benchmark-1.1.1/benchutil_average.m new file mode 100644 index 0000000..79f4e31 --- /dev/null +++ b/octave_packages/benchmark-1.1.1/benchutil_average.m @@ -0,0 +1,40 @@ +% Copyright (C) 2008 Jaroslav Hajek +% +% This file is part of OctaveForge. +% +% OctaveForge is free software; you can 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 software; see the file COPYING. If not, see +% . +% + +% function results = benchutil_average (benchmark, nruns, arg1, arg2, ...) +% Average the benchmark results over a certain number of runs. + +function results = benchutil_average (benchmark, nruns, varargin) + bfun = str2func (benchmark); + for i = 1:nruns + resi(i) = bfun (varargin{:}); + end + for f = fieldnames (resi).' + f = f{1}; + results.(f) = mean ([resi.(f)]); + end + + if (benchutil_verbose) + [bdesc, adesc, rdesc] = benchutil_parse_desc ([benchmark, '.m']); + printf ('\n\n'); + for [desc, fn] = rdesc + printf ('%s (avg. over %d runs): %f\n', desc, nruns, results.(fn)); + endfor + endif + diff --git a/octave_packages/benchmark-1.1.1/benchutil_default_arg.m b/octave_packages/benchmark-1.1.1/benchutil_default_arg.m new file mode 100644 index 0000000..4edfd92 --- /dev/null +++ b/octave_packages/benchmark-1.1.1/benchutil_default_arg.m @@ -0,0 +1,28 @@ +% Copyright (C) 2008 Jaroslav Hajek +% +% This file is part of OctaveForge. +% +% OctaveForge is free software; you can 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 software; see the file COPYING. If not, see +% . +% + +% benchmark_default_arg (name, value) +% set argument to a default value. This function is provided for +% compatibility with Matlab, which misses Octave's default arguments +% feature. +% +function benchutil_default_arg (name, value) + if (~ evalin ('caller', sprintf ('exist (''%s'', ''var'')', name))) + assignin ('caller', name, value); + end diff --git a/octave_packages/benchmark-1.1.1/benchutil_initialize.m b/octave_packages/benchmark-1.1.1/benchutil_initialize.m new file mode 100644 index 0000000..7290060 --- /dev/null +++ b/octave_packages/benchmark-1.1.1/benchutil_initialize.m @@ -0,0 +1,44 @@ +% Copyright (C) 2008 Jaroslav Hajek +% +% This file is part of OctaveForge. +% +% OctaveForge is free software; you can 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 software; see the file COPYING. If not, see +% . +% + +% function benchutil_initialize (mfname) +% initializes a benchmark. The argument passed must be the filename of the +% function. +% +function benchutil_initialize (mfname) + [bench_desc, arg_desc, result_desc] = ... + benchutil_parse_desc ([mfname, '.m']); + assignin ('caller', 'result_desc', result_desc); + if (benchutil_verbose) + fprintf (1, 'Running benchmark: %s\n', mfname); + fwrite (1, bench_desc); + fprintf (1, '\n'); + argns = fieldnames (arg_desc); + for argn = argns' + argn = argn{1}; + argv = evalin ('caller', argn); + fprintf (1, '%s (%s) = %g\n', arg_desc.(argn), argn, argv); + end + if (benchutil_is_octave) + fflush (1); + end + end + + + diff --git a/octave_packages/benchmark-1.1.1/benchutil_is_octave.m b/octave_packages/benchmark-1.1.1/benchutil_is_octave.m new file mode 100644 index 0000000..9bdf3ee --- /dev/null +++ b/octave_packages/benchmark-1.1.1/benchutil_is_octave.m @@ -0,0 +1,30 @@ +% Copyright (C) 2008 Jaroslav Hajek +% +% This file is part of OctaveForge. +% +% OctaveForge is free software; you can 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 software; see the file COPYING. If not, see +% . +% + +% function benchutil_is_octave () +% returns true if this is Octave. If not, we're probably run on Matlab. +% + +function answer = benchutil_is_octave () + persistent isoctave; + if (isempty (isoctave)) + isoctave = exist ('printf') > 0; + end + answer = isoctave; + diff --git a/octave_packages/benchmark-1.1.1/benchutil_parse_desc.m b/octave_packages/benchmark-1.1.1/benchutil_parse_desc.m new file mode 100644 index 0000000..079e8b1 --- /dev/null +++ b/octave_packages/benchmark-1.1.1/benchutil_parse_desc.m @@ -0,0 +1,69 @@ +% Copyright (C) 2008 Jaroslav Hajek +% +% This file is part of OctaveForge. +% +% OctaveForge is free software; you can 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 software; see the file COPYING. If not, see +% . +% + +% function [bench_desc, arg_desc, result_desc] = benchutil_parse_desc (mpath) +% parse the inline comment description from a benchmark +% + +function [bench_desc, arg_desc, result_desc] = benchutil_parse_desc (mpath) + fid = fopen (mpath, 'rt'); + + line = ''; + iseof = feof (fid); + while (~ (strncmp (line, '% description:', 14) || iseof)) + line = fgets (fid); + iseof = feof (fid); + end + + bench_desc = ''; + line = fgets (fid); + iseof = feof (fid); + while (~ (strncmp (line, '% arguments:', 12) || feof (fid))) + %TODO fix + bench_desc = [bench_desc, line(3:end)]; + line = fgets (fid); + iseof = feof (fid); + end + + line = fgetl (fid); + iseof = feof (fid); + while (~ (strncmp (line, '% results:', 10) || feof (fid))) + i = strfind (line, ' = '); + if (~ isempty (i)) + name = line (3:i(1)-1); + arg_desc.(name) = line (i(1)+3:end); + end + line = fgetl (fid); + iseof = feof (fid); + end + + line = fgetl (fid); + iseof = feof (fid); + while (strncmp (line, '%', 1) && ~ feof (fid)) + i = strfind (line, ' = '); + if (~ isempty (i)) + name = line (3:i(1)-1); + result_desc.(name) = line (i(1)+3:end); + end + line = fgetl (fid); + iseof = feof (fid); + end + + fclose (fid); + diff --git a/octave_packages/benchmark-1.1.1/benchutil_set_result.m b/octave_packages/benchmark-1.1.1/benchutil_set_result.m new file mode 100644 index 0000000..868eb8c --- /dev/null +++ b/octave_packages/benchmark-1.1.1/benchutil_set_result.m @@ -0,0 +1,32 @@ +% Copyright (C) 2008 Jaroslav Hajek +% +% This file is part of OctaveForge. +% +% OctaveForge is free software; you can 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 software; see the file COPYING. If not, see +% . +% + +function benchutil_set_result (name) + if (~ benchutil_verbose || evalin ('caller', 'nargout') > 0) + evalin ('caller', sprintf ('results.%s = %s;', name, name)); + end + if (benchutil_verbose) + value_desc = evalin ('caller', sprintf ('result_desc.%s', name)); + value = evalin ('caller', name); + fprintf (1, '%s: %g\n', value_desc, value); + if (benchutil_is_octave) + fflush (1); + end + end + diff --git a/octave_packages/benchmark-1.1.1/benchutil_verbose.m b/octave_packages/benchmark-1.1.1/benchutil_verbose.m new file mode 100644 index 0000000..23d8740 --- /dev/null +++ b/octave_packages/benchmark-1.1.1/benchutil_verbose.m @@ -0,0 +1,33 @@ +% Copyright (C) 2008 Jaroslav Hajek +% +% This file is part of OctaveForge. +% +% OctaveForge is free software; you can 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 software; see the file COPYING. If not, see +% . +% + +% function OLD_FLAG = benchutil_verbose (NEW_FLAG) +% sets or queries the benchmark verbosity flag +% +function flag = benchutil_verbose (setflag) + persistent verbose; + if (isempty (verbose)) + verbose = true; + end + if (nargin == 0 || nargout == 1) + flag = verbose; + end + if (nargin == 1) + verbose = setflag; + end diff --git a/octave_packages/benchmark-1.1.1/doc-cache b/octave_packages/benchmark-1.1.1/doc-cache new file mode 100644 index 0000000..15f30bb --- /dev/null +++ b/octave_packages/benchmark-1.1.1/doc-cache @@ -0,0 +1,395 @@ +# Created by Octave 3.6.1, Sun Apr 01 21:17:46 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 11 +# name: +# type: sq_string +# elements: 1 +# length: 14 +benchmark_dtmm + + +# name: +# type: sq_string +# elements: 1 +# length: 679 + function benchmark_dtmm (m, n, nvec) + description: + Dense transposed matrix-matrix and matrix-vector multiplication benchmark. + This is to test the "compound operators" feature introduced in Octave. + + arguments: + m = row dimension of matrices + n = col dimension of matrices + nvec = number of vector op repeats + + results: + time_tmm = Time for A'*B (A,B m-by-n matrices) + time_smm = Time for A'*A + time_mtm = Time for A*B' (A,B n-by-m matrices) + time_msm = Time for A*A' + time_tmv = Time for A'*v nvec-times (A m-by-n matrix) + ratio_tmv = Ratio to precomputed transpose time + time_mtv = Time for v*A' nvec-times (A m-by-n matrix) + ratio_mtv = Ratio to precomputed transpose time + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + function benchmark_dtmm (m, n, nvec) + description: + Dense transposed matrix-mat + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +benchmark_index + + +# name: +# type: sq_string +# elements: 1 +# length: 608 + function benchmark_index (n, rep) + description: + Test speed of array indexing. + + arguments: + n = array size + rep = number of repeats + + results: + time_slice1 = time for a(i:j) + time_slice1s = time for a(i:k:j) + time_slice1v = time for a(idx) + time_slice2c = time for a(:,i:j) + time_slice2r = time for a(i:j,:) + time_slice2cv = time for a(:,idx) + time_slice2rv = time for a(idx,:) + time_slicenc = time for a(:,:,i:j,k) + time_slicend = time for a(:,:,k,i:j) + time_slicens = time for a(i,j,k,:) + time_spreadr = time for a(ones(1, k), :), a row vector + time_spreadc = time for a(:, ones(1, k)), a column vector + + + + +# name: +# type: sq_string +# elements: 1 +# length: 79 + function benchmark_index (n, rep) + description: + Test speed of array indexing. + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +benchmark_intmath + + +# name: +# type: sq_string +# elements: 1 +# length: 1763 + function benchmark_intmath (n, ratio) + description: + Test speed of integer math & conversions. + + arguments: + n = array size + ratio = ratio of intmath for generating integers + + results: + time_uint8_conv = time to convert real vector to uint8 + time_uint8_add = time to add two uint8 vectors + time_uint8_sub = time to subtract two uint8 vectors + time_uint8_mul = time to multiply two uint8 vectors + time_uint8_div = time to divide two uint8 vectors + time_int8_conv = time to convert real vector to int8 + time_int8_add = time to add two int8 vectors + time_int8_sub = time to subtract two int8 vectors + time_int8_mul = time to multiply two int8 vectors + time_int8_div = time to divide two int8 vectors + time_uint16_conv = time to convert real vector to uint16 + time_uint16_add = time to add two uint16 vectors + time_uint16_sub = time to subtract two uint16 vectors + time_uint16_mul = time to multiply two uint16 vectors + time_uint16_div = time to divide two uint16 vectors + time_int16_conv = time to convert real vector to int16 + time_int16_add = time to add two int16 vectors + time_int16_sub = time to subtract two int16 vectors + time_int16_mul = time to multiply two int16 vectors + time_int16_div = time to divide two int16 vectors + time_uint32_conv = time to convert real vector to uint32 + time_uint32_add = time to add two uint32 vectors + time_uint32_sub = time to subtract two uint32 vectors + time_uint32_mul = time to multiply two uint32 vectors + time_uint32_div = time to divide two uint32 vectors + time_int32_conv = time to convert real vector to int32 + time_int32_add = time to add two int32 vectors + time_int32_sub = time to subtract two int32 vectors + time_int32_mul = time to multiply two int32 vectors + time_int32_div = time to divide two int32 vectors + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + function benchmark_intmath (n, ratio) + description: + Test speed of integer math + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +benchmark_permute + + +# name: +# type: sq_string +# elements: 1 +# length: 340 + function benchmark_permute (n) + description: + Test speed of array permuting. + + arguments: + n = dimension size (n^5 is number of elements) + + results: + + time_21345 = time for [2,1,3,4,5] permutation + time_13425 = time for [1,3,4,2,5] permutation + time_34125 = time for [3,4,1,2,5] permutation + time_45123 = time for [4,5,1,2,3] permutation + + + + +# name: +# type: sq_string +# elements: 1 +# length: 77 + function benchmark_permute (n) + description: + Test speed of array permuting. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +benchmark_stmm + + +# name: +# type: sq_string +# elements: 1 +# length: 460 + function benchmark_stmm (n, nvec) + description: + Sparse transposed matrix-vector multiplication benchmark. + This is to test the "compound operators" feature introduced in Octave. + + arguments: + n = dimension of matrix + nvec = number of vector op repeats + + results: + time_tmm = Time for A'*B (B n^2-by-nvec matrix) + time_tmv = Time for A'*v nvec-times (v vector) + time_mtm = Time for B*A' (B nvec-by-n^2 matrix) + time_mtv = Time for v*A' nvec-times (v vector) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + function benchmark_stmm (n, nvec) + description: + Sparse transposed matrix-vecto + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +benchutil_average + + +# name: +# type: sq_string +# elements: 1 +# length: 136 + function results = benchutil_average (benchmark, nruns, arg1, arg2, ...) + Average the benchmark results over a certain number of runs. + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 + function results = benchutil_average (benchmark, nruns, arg1, arg2, . + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +benchutil_default_arg + + +# name: +# type: sq_string +# elements: 1 +# length: 181 + benchmark_default_arg (name, value) + set argument to a default value. This function is provided for + compatibility with Matlab, which misses Octave's default arguments + feature. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 + benchmark_default_arg (name, value) + set argument to a default value. + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +benchutil_initialize + + +# name: +# type: sq_string +# elements: 1 +# length: 126 + function benchutil_initialize (mfname) + initializes a benchmark. The argument passed must be the filename of the + function. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 + function benchutil_initialize (mfname) + initializes a benchmark. + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +benchutil_is_octave + + +# name: +# type: sq_string +# elements: 1 +# length: 105 + function benchutil_is_octave () + returns true if this is Octave. If not, we're probably run on Matlab. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 + function benchutil_is_octave () + returns true if this is Octave. + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +benchutil_parse_desc + + +# name: +# type: sq_string +# elements: 1 +# length: 133 + function [bench_desc, arg_desc, result_desc] = benchutil_parse_desc (mpath) + parse the inline comment description from a benchmark + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + function [bench_desc, arg_desc, result_desc] = benchutil_parse_desc (mpath) + pa + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +benchutil_verbose + + +# name: +# type: sq_string +# elements: 1 +# length: 97 + function OLD_FLAG = benchutil_verbose (NEW_FLAG) + sets or queries the benchmark verbosity flag + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + function OLD_FLAG = benchutil_verbose (NEW_FLAG) + sets or queries the benchmark + + + + + diff --git a/octave_packages/benchmark-1.1.1/packinfo/.autoload b/octave_packages/benchmark-1.1.1/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/benchmark-1.1.1/packinfo/DESCRIPTION b/octave_packages/benchmark-1.1.1/packinfo/DESCRIPTION new file mode 100644 index 0000000..c29b6a2 --- /dev/null +++ b/octave_packages/benchmark-1.1.1/packinfo/DESCRIPTION @@ -0,0 +1,10 @@ +Name: benchmark +Version: 1.1.1 +Date: 2009-04-15 +Author: Octave community +Title: Benchmarks for Octave +Maintainer: Jaroslav Hajek (highegg@gmail.com) +Description: The package contains code used to benchmark speed of Octave. +License: GPL v2 +Depends: octave (>= 2.9.7) +Autoload: yes diff --git a/octave_packages/benchmark-1.1.1/packinfo/INDEX b/octave_packages/benchmark-1.1.1/packinfo/INDEX new file mode 100644 index 0000000..406a74a --- /dev/null +++ b/octave_packages/benchmark-1.1.1/packinfo/INDEX @@ -0,0 +1,11 @@ +benchmark >> Benchmark +Utility + benchutil_default_arg + benchutil_initialize + benchutil_is_octave + benchutil_parse_desc + benchutil_set_result + benchutil_verbose +Benchmarks + benchmark_dtmm + benchmark_stmm diff --git a/octave_packages/communications-1.1.1/@galois/conv.m b/octave_packages/communications-1.1.1/@galois/conv.m new file mode 100644 index 0000000..cf3f936 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/conv.m @@ -0,0 +1,81 @@ +## Copyright (C) 2002 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} conv (@var{a}, @var{b}) +## Convolve two Galois vectors. +## +## @code{y = conv (a, b)} returns a vector of length equal to +## @code{length (a) + length (b) - 1}. +## If @var{a} and @var{b} are polynomial coefficient vectors, @code{conv} +## returns the coefficients of the product polynomial. +## @end deftypefn +## @seealso{deconv} + +function y = conv (a, b) + + if (nargin != 2) + usage ("conv(a, b)"); + endif + + if (!isgalois (a) && !isgalois (b)) + error("conv: at least one argument must be a galois variable"); + elseif (!isgalois (a)) + a = gf(a, b.m, b.prim_poly); + elseif (!isgalois (b)) + b = gf(b, a.m, a.prim_poly); + elseif (a.m != b.m && a.prim_poly != b.prim_poly) + error("conv: both vectors must be in the same galois field"); + endif + + if (min(size(a)) > 1 || min(size(b)) > 1) + error("conv: both arguments must be vectors"); + endif + + la = length (a); + lb = length (b); + + ly = la + lb - 1; + + ## Ensure that both vectors are row vectors. + if (rows (a) > 1) + a = reshape (a, 1, la); + endif + if (rows (b) > 1) + b = reshape (b, 1, lb); + endif + + ## Use the shortest vector as the coefficent vector to filter. + if (la < lb) + if (ly > lb) + ## Can't concatenate galois variables like this yet + ## x = [b, (zeros (1, ly - lb))]; + x = gf([b, (zeros (1, ly - lb))], b.m, b.prim_poly); + else + x = b; + endif + y = filter (a, 1, x); + else + if(ly > la) + ## Can't concatenate galois variables like this yet + ## x = [a, (zeros (1, ly - la))]; + x = gf([a, (zeros (1, ly - la))], a.m, a.prim_poly); + else + x = a; + endif + y = filter (b, 1, x); + endif + +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/convmtx.m b/octave_packages/communications-1.1.1/@galois/convmtx.m new file mode 100644 index 0000000..2c423c1 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/convmtx.m @@ -0,0 +1,47 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} convmtx (@var{a}, @var{n}) +## +## Create matrix to perform repeated convolutions with the same vector +## in a Galois Field. If @var{a} is a column vector and @var{x} is a +## column vector of length @var{n}, in a Galois Field then +## +## @code{convmtx(@var{a}, @var{n}) * @var{x}} +## +## gives the convolution of of @var{a} and @var{x} and is the +## same as @code{conv(@var{a}, @var{x})}. The difference is if +## many vectors are to be convolved with the same vector, then +## this technique is possibly faster. +## +## Similarly, if @var{a} is a row vector and @var{x} is a row +## vector of length @var{n}, then +## +## @code{@var{x} * convmtx(@var{a}, @var{n})} +## +## is the same as @code{conv(@var{x}, @var{a})}. +## @end deftypefn +## @seealso{conv} + +function b = convmtx (a, n) + + if (!isgalois (a)) + error("convmtx: argument must be a galois variable"); + endif + + b = gf(convmtx(a.x,n), a.m, a.prim_poly); + +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/deconv.m b/octave_packages/communications-1.1.1/@galois/deconv.m new file mode 100644 index 0000000..ba0b82b --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/deconv.m @@ -0,0 +1,80 @@ +## Copyright (C) 2002 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} deconv (@var{y}, @var{a}) +## Deconvolve two Galois 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 remander polynomial of lowest order. +## @end deftypefn +## @seealso{conv} + +function [b, r] = deconv (y, a) + + + if (nargin != 2) + usage ("deconv(a, b)"); + endif + + if (!isgalois (y) && !isgalois (a)) + error("deconv: at least one argument must be a galois variable"); + elseif (!isgalois (y)) + y = gf(y, a.m, a.prim_poly); + elseif (!isgalois (a)) + a = gf(a, y.m, y.prim_poly); + elseif (a.m != y.m && a.prim_poly != y.prim_poly) + error("deconv: both vectors must be in the same galois field"); + endif + + if (min(size(a)) > 1 || min(size(y)) > 1) + error("deconv: both arguments must be vectors"); + endif + + la = length (a); + ly = length (y); + + lb = ly - la + 1; + + ## Ensure that both vectors are row vectors. + if (rows (a) > 1) + a = reshape (a, 1, la); + endif + if (rows (y) > 1) + y = reshape (y, 1, ly); + endif + + if (ly > la) + b = filter (y, a, [1, (zeros (1, ly - la))]); + elseif (ly == la) + b = filter (y, a, 1); + else + b = gf(0, y.m, y.prim_poly); + endif + + lc = la + length (b) - 1; + if (ly == lc) + r = y - conv (a, b); + else + ## Can't concatenate galois variables like this yet + ## r = [(zeros (1, lc - ly)), y] - conv (a, b); + r = gf([(zeros (1, lc - ly)), y], y.m, y.prim_poly) - conv (a, b); + endif + +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/det.m b/octave_packages/communications-1.1.1/@galois/det.m new file mode 100644 index 0000000..f60c374 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/det.m @@ -0,0 +1,24 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {@var{d} = } det (@var{a}) +## Compute the determinant of the Galois array @var{a}. +## @end deftypefn + +function varargout = det (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = gdet (varargin{:}); +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/dftmtx.m b/octave_packages/communications-1.1.1/@galois/dftmtx.m new file mode 100644 index 0000000..6de2e5f --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/dftmtx.m @@ -0,0 +1,67 @@ +## Copyright (C) 2002 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{d} = } dftmtx (@var{a}) +## +## Form a matrix, that can be used to perform Fourier transforms in +## a Galois Field. +## +## Given that @var{a} is an element of the Galois Field GF(2^m), and +## that the minimum value for @var{k} for which @code{@var{a} ^ @var{k}} +## is equal to one is @code{2^m - 1}, then this function produces a +## @var{k}-by-@var{k} matrix representing the discrete Fourier transform +## over a Galois Field with respect to @var{a}. The Fourier transform of +## a column vector is then given by @code{dftmtx(@var{a}) * @var{x}}. +## +## The inverse Fourier transform is given by @code{dftmtx(1/@var{a})} +## @end deftypefn + +function d = dftmtx(a) + + if (nargin != 1) + error ("usage: d = dftmtx (a)"); + endif + + if (!isgalois(a)) + error("dftmtx: argument must be a galois variable"); + endif + + m = a.m; + prim = a.prim_poly; + n = 2^a.m - 1; + if (n > 255) + error ([ "dftmtx: argument must be in Galois Field GF(2^m), where" ... + " m is not greater than 8"]); + endif + + if (length(a) ~= 1) + error ("dftmtx: argument must be a scalar"); + endif + + mp = minpol(a); + if ((mp(1) ~= 1) || !isprimitive(mp)) + error("dftmtx: argument must be a primitive nth root of unity"); + endif + + step = log(a); + step = step.x; + row = exp(gf([0:n-1], m, prim)); + d = zeros(n); + for i=1:n; + d(i,:) = row .^ mod(step*(i-1),n); + end + +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/diag.m b/octave_packages/communications-1.1.1/@galois/diag.m new file mode 100644 index 0000000..4f99216 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/diag.m @@ -0,0 +1,42 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {} diag (@var{v}, @var{k}) +## Return a diagonal matrix with Galois vector @var{v} on diagonal @var{k}. +## The second argument is optional. If it is positive, the vector is placed on +## the @var{k}-th super-diagonal. If it is negative, it is placed on the +## @var{-k}-th sub-diagonal. The default value of @var{k} is 0, and the +## vector is placed on the main diagonal. For example, +## +## @example +## diag (gf([1, 2, 3],2), 1) +## ans = +## GF(2^2) array. Primitive Polynomial = D^2+D+1 (decimal 7) +## +## Array elements = +## +## 0 1 0 0 +## 0 0 2 0 +## 0 0 0 3 +## 0 0 0 0 +## @end example +## @end deftypefn + +function varargout = diag (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = gdiag (varargin{:}); +endfunction + diff --git a/octave_packages/communications-1.1.1/@galois/exp.m b/octave_packages/communications-1.1.1/@galois/exp.m new file mode 100644 index 0000000..103dc08 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/exp.m @@ -0,0 +1,25 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {} exp (@var{x}) +## Compute the anti-logarithm for each element of @var{x} for a Galois +## array. +## @end deftypefn + +function varargout = exp (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = gexp (varargin{:}); +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/fft.m b/octave_packages/communications-1.1.1/@galois/fft.m new file mode 100644 index 0000000..2aca25f --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/fft.m @@ -0,0 +1,50 @@ +## Copyright (C) 2002 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fft (@var{x}) +## +## If @var{x} is a column vector, finds the FFT over the primitive element +## of the Galois Field of @var{x}. If @var{x} is in the Galois Field +## GF(2^@var{m}), then @var{x} must have @code{2^@var{m} - 1} elements. +## @end deftypefn + +function y = fft(x) + + if (nargin != 1) + error ("usage: y = fft (x)"); + endif + + if (!isgalois(x)) + error("fft: argument must be a galois variable"); + endif + + n = 2^x.m - 1; + if (n > 255) + error ([ "fft: argument must be in Galois Field GF(2^m), where", ... + " m is not greater than 8"]); + endif + + alph = gf(2, x.m, x.prim_poly); + [nr,nc] = size(x); + if ((nc == 1) && (nr == n)) + y = dftmtx(alph) * x; + elseif ((nc == n) && (nr == 1)) + y = (dftmtx(alph) * x')'; + else + error ("fft: argument must be a vector in GF(2^m) of length 2^m-1"); + endif + +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/filter.m b/octave_packages/communications-1.1.1/@galois/filter.m new file mode 100644 index 0000000..0c9d57a --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/filter.m @@ -0,0 +1,90 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {y =} filter (@var{b}, @var{a}, @var{x}) +## @deftypefnx {Loadable Function} {[@var{y}, @var{sf}] =} filter (@var{b}, @var{a}, @var{x}, @var{si}) +## +## Digital filtering of vectors in a Galois Field. Returns the solution to +## the following linear, time-invariant difference equation over a Galois +## Field: +## @iftex +## @tex +## $$ +## \\sum_{k=0}^N a_{k+1} y_{n-k} = \\sum_{k=0}^M b_{k+1} x_{n-k}, \\qquad +## 1 \\le n \\le P +## $$ +## @end tex +## @end iftex +## @ifinfo +## +## @smallexample +## N M +## SUM a(k+1) y(n-k) = SUM b(k+1) x(n-k) for 1<=n<=length(x) +## k=0 k=0 +## @end smallexample +## @end ifinfo +## +## @noindent +## where +## @ifinfo +## N=length(a)-1 and M=length(b)-1. +## @end ifinfo +## @iftex +## @tex +## $a \\in \\Re^{N-1}$, $b \\in \\Re^{M-1}$, and $x \\in \\Re^P$. +## @end tex +## @end iftex +## An equivalent form of this equation is: +## @iftex +## @tex +## $$ +## y_n = -\\sum_{k=1}^N c_{k+1} y_{n-k} + \\sum_{k=0}^M d_{k+1} x_{n-k}, \\qquad +## 1 \\le n \\le P +## $$ +## @end tex +## @end iftex +## @ifinfo +## +## @smallexample +## N M +## y(n) = - SUM c(k+1) y(n-k) + SUM d(k+1) x(n-k) for 1<=n<=length(x) +## k=1 k=0 +## @end smallexample +## @end ifinfo +## +## @noindent +## where +## @ifinfo +## c = a/a(1) and d = b/a(1). +## @end ifinfo +## @iftex +## @tex +## $c = a/a_1$ and $d = b/a_1$. +## @end tex +## @end iftex +## +## If the fourth argument @var{si} is provided, it is taken as the +## initial state of the system and the final state is returned as +## @var{sf}. The state vector is a column vector whose length is +## equal to the length of the longest coefficient vector minus one. +## If @var{si} is not supplied, the initial state vector is set to all +## zeros. +## @end deftypefn + +function varargout = filter (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = gfilter (varargin{:}); +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/ifft.m b/octave_packages/communications-1.1.1/@galois/ifft.m new file mode 100644 index 0000000..ba42f60 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/ifft.m @@ -0,0 +1,51 @@ +## Copyright (C) 2002 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ifft (@var{x}) +## +## If @var{x} is a column vector, finds the IFFT over the primitive element +## of the Galois Field of @var{x}. If @var{x} is in the Galois Field +## GF(2^@var{m}), then @var{x} must have @code{2^@var{m} - 1} elements. +## @end deftypefn +## @seealso{ifft} + +function y = ifft(x) + + if (nargin != 1) + error ("usage: y = ifft (x)"); + endif + + if (!isgalois(x)) + error("ifft: argument must be a galois variable"); + endif + + n = 2^x.m - 1; + if (n > 255) + error ([ "ifft: argument must be in Galois Field GF(2^m), where", ... + " m is not greater than 8"]); + endif + + alph = gf(2, x.m, x.prim_poly); + [nr,nc] = size(x); + if ((nc == 1) && (nr == n)) + y = dftmtx(1/alph) * x; + elseif ((nc == n) && (nr == 1)) + y = (dftmtx(1/alph) * x')'; + else + error ("ifft: argument must be a vector in GF(2^m) of length 2^m-1"); + endif + +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/inv.m b/octave_packages/communications-1.1.1/@galois/inv.m new file mode 100644 index 0000000..502af45 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/inv.m @@ -0,0 +1,26 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {[@var{x}, @var{rcond}] = } inv (@var{a}) +## Compute the inverse of the square matrix @var{a}. Return an estimate +## of the reciprocal condition number if requested, otherwise warn of an +## ill-conditioned matrix if the reciprocal condition number is small. +## @end deftypefn + +function varargout = inv (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = ginv (varargin{:}); +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/inverse.m b/octave_packages/communications-1.1.1/@galois/inverse.m new file mode 100644 index 0000000..301af03 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/inverse.m @@ -0,0 +1,24 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {[@var{x}, @var{rcond}] = } inverse (@var{a}) +## See inv. +## @end deftypefn +g +function varargout = inverse (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = ginverse (varargin{:}); +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/isequal.m b/octave_packages/communications-1.1.1/@galois/isequal.m new file mode 100644 index 0000000..5ed411f --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/isequal.m @@ -0,0 +1,32 @@ +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isequal (@var{x1}, @var{x2}, @dots{}) +## Return true if all of @var{x1}, @var{x2}, @dots{} are equal. +## @seealso{isequalwithequalnans} +## @end deftypefn + +function t = isequal(x,varargin) + if nargin < 2 + usage("isequal(x,y,...)"); + endif + + for arg = 1:length(varargin) + y = varargin{arg}; + t = all (x (:) == y (:)); + if !t, return; endif + endfor +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/log.m b/octave_packages/communications-1.1.1/@galois/log.m new file mode 100644 index 0000000..5d02533 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/log.m @@ -0,0 +1,25 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {} log (@var{x}) +## Compute the natural logarithm for each element of @var{x} for a Galois +## array. +## @end deftypefn + +function varargout = log (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = glog (varargin{:}); +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/lu.m b/octave_packages/communications-1.1.1/@galois/lu.m new file mode 100644 index 0000000..40dca06 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/lu.m @@ -0,0 +1,63 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {[@var{l}, @var{u}, @var{p}] =} lu (@var{a}) +## @cindex LU decomposition of Galois matrix +## Compute the LU decomposition of @var{a} in a Galois Field. The result is +## returned in a permuted form, according to the optional return value +## @var{p}. For example, given the matrix +## @code{a = gf([1, 2; 3, 4],3)}, +## +## @example +## [l, u, p] = lu (a) +## @end example +## +## @noindent +## returns +## +## @example +## l = +## GF(2^3) array. Primitive Polynomial = D^3+D+1 (decimal 11) +## +## Array elements = +## +## 1 0 +## 6 1 +## +## u = +## GF(2^3) array. Primitive Polynomial = D^3+D+1 (decimal 11) +## +## Array elements = +## +## 3 4 +## 0 7 +## +## p = +## +## 0 1 +## 1 0 +## @end example +## +## Such that @code{@var{p} * @var{a} = @var{l} * @var{u}}. If the argument +## @var{p} is not included then the permutations are applied to @var{l} +## so that @code{@var{a} = @var{l} * @var{u}}. @var{l} is then a pseudo- +## lower triangular matrix. The matrix @var{a} can be rectangular. +## @end deftypefn + +function varargout = lu (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = glu (varargin{:}); +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/prod.m b/octave_packages/communications-1.1.1/@galois/prod.m new file mode 100644 index 0000000..d90d1ae --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/prod.m @@ -0,0 +1,26 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {} prod (@var{x}, @var{dim}) +## Product of elements along dimension @var{dim} of Galois array. If +## @var{dim} is omitted, it defaults to 1 (column-wise products). +## @end deftypefn + +function varargout = prod (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = gprod (varargin{:}); +endfunction + diff --git a/octave_packages/communications-1.1.1/@galois/rank.m b/octave_packages/communications-1.1.1/@galois/rank.m new file mode 100644 index 0000000..733e850 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/rank.m @@ -0,0 +1,25 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {@var{d} = } rank (@var{a}) +## Compute the rank of the Galois array @var{a} by counting the independent +## rows and columns. +## @end deftypefn + +function varargout = rank (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = grank (varargin{:}); +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/reshape.m b/octave_packages/communications-1.1.1/@galois/reshape.m new file mode 100644 index 0000000..4af2145 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/reshape.m @@ -0,0 +1,56 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {} reshape (@var{a}, @var{m}, @var{n}) +## Return a matrix with @var{m} rows and @var{n} columns whose elements are +## taken from the Galois array @var{a}. To decide how to order the elements, +## Octave pretends that the elements of a matrix are stored in column-major +## order (like Fortran arrays are stored). +## +## For example, +## +## @example +## reshape (gf([1, 2, 3, 4],3), 2, 2) +## ans = +## GF(2^3) array. Primitive Polynomial = D^3+D+1 (decimal 11) +## +## Array elements = +## +## 1 3 +## 2 4 +## @end example +## +## The @code{reshape} function is equivalent to +## +## @example +## @group +## retval = gf(zeros (m, n), a.m, a.prim_poly); +## retval (:) = a; +## @end group +## @end example +## +## @noindent +## but it is somewhat less cryptic to use @code{reshape} instead of the +## colon operator. Note that the total number of elements in the original +## matrix must match the total number of elements in the new matrix. +## @end deftypefn +## @seealso{`:'} + +function varargout = reshape (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = greshape (varargin{:}); +endfunction + diff --git a/octave_packages/communications-1.1.1/@galois/roots.m b/octave_packages/communications-1.1.1/@galois/roots.m new file mode 100644 index 0000000..938c770 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/roots.m @@ -0,0 +1,75 @@ +## Copyright (C) 2002 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} roots (@var{v}) +## +## For a vector @var{v} with @math{N} components, return +## the roots of the polynomial over a Galois Field +## @iftex +## @tex +## $$ +## v_1 z^{N-1} + \cdots + v_{N-1} z + v_N. +## $$ +## @end tex +## @end iftex +## @ifinfo +## +## @example +## v(1) * z^(N-1) + ... + v(N-1) * z + v(N). +## @end example +## @end ifinfo +## +## The number of roots returned and their value will be determined +## by the order and primitive polynomial of the Galios Field +## @end deftypefn + +function r = roots (v) + + if (nargin != 1) + error("usage: r = roots(v)"); + endif + + if (!isgalois(v)) + error("roots: argument must be a galois variable"); + endif + + if (min (size (v)) > 1 || nargin != 1) + usage ("roots (v), where v is a galois vector"); + endif + + v = reshape (v, 1, length(v)); + m = v.m; + prim_poly = v.prim_poly; + n = 2^m - 1; + poly = v; + nr = 0; + t = 0; + r = []; + + while ((t <= n) && (length(poly) > 1)) + [npoly, nrem] = deconv(poly,gf([1,t],m,prim_poly)); + if (any(nrem)) + t = t + 1; + else + nr = nr + 1; + r(nr) = t; + poly = npoly; + endif + end + + r = gf(r,m,prim_poly); + +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/sqrt.m b/octave_packages/communications-1.1.1/@galois/sqrt.m new file mode 100644 index 0000000..315d224 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/sqrt.m @@ -0,0 +1,26 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {} sqrt (@var{x}) +## Compute the square root of @var{x}, element by element, in a Galois Field. +## @end deftypefn +## @seealso{exp} + +function varargout = sqrt (varargin) + + varargout = cell (1, max(1, nargout)); + [varargout{:}] = gsqrt (varargin{:}); +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/sum.m b/octave_packages/communications-1.1.1/@galois/sum.m new file mode 100644 index 0000000..c8ac924 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/sum.m @@ -0,0 +1,25 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {} sum (@var{x}, @var{dim}) +## Sum of elements along dimension @var{dim} of Galois array. If @var{dim} +## is omitted, it defaults to 1 (column-wise sum). +## @end deftypefn + +function varargout = sum (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = gsum (varargin{:}); +endfunction diff --git a/octave_packages/communications-1.1.1/@galois/sumsq.m b/octave_packages/communications-1.1.1/@galois/sumsq.m new file mode 100644 index 0000000..0112e87 --- /dev/null +++ b/octave_packages/communications-1.1.1/@galois/sumsq.m @@ -0,0 +1,31 @@ +## Copyright (C) 2011 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {} sumsq (@var{x}, @var{dim}) +## Sum of squares of elements along dimension @var{dim} of Galois array. +## If @var{dim} is omitted, it defaults to 1 (column-wise sum of squares). +## +## This function is equivalent to computing +## @example +## gsum (x .* conj (x), dim) +## @end example +## but it uses less memory. +## @end deftypefn + +function varargout = sumsq (varargin) + varargout = cell (1, max(1, nargout)); + [varargout{:}] = gsumsq (varargin{:}); +endfunction diff --git a/octave_packages/communications-1.1.1/ademodce.m b/octave_packages/communications-1.1.1/ademodce.m new file mode 100644 index 0000000..e610658 --- /dev/null +++ b/octave_packages/communications-1.1.1/ademodce.m @@ -0,0 +1,187 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} ademodce (@var{x},@var{Fs},'amdsb-tc',offset) +## @deftypefnx {Function File} {@var{y} =} ademodce (@var{x},@var{Fs},'amdsb-tc/costas',offset) +## @deftypefnx {Function File} {@var{y} =} ademodce (@var{x},@var{Fs},'amdsb-sc') +## @deftypefnx {Function File} {@var{y} =} ademodce (@var{x},@var{Fs},'amdsb-sc/costas') +## @deftypefnx {Function File} {@var{y} =} ademodce (@var{x},@var{Fs},'amssb') +## @deftypefnx {Function File} {@var{y} =} ademodce (@var{x},@var{Fs},'qam') +## @deftypefnx {Function File} {@var{y} =} ademodce (@var{x},@var{Fs},'qam/cmplx') +## @deftypefnx {Function File} {@var{y} =} ademodce (@var{x},@var{Fs},'fm',@var{dev}) +## @deftypefnx {Function File} {@var{y} =} ademodce (@var{x},@var{Fs},'pm',@var{dev}) +## @deftypefnx {Function File} {@var{y} =} ademodce (@var{x},[@var{Fs},@var{iphs}],@var{...}) +## @deftypefnx {Function File} {@var{y} =} ademodce (@var{...},@var{num},@var{den}) +## +## Baseband demodulator for analog signals. The input signal is specified by +## @var{x}, its sampling frequency by @var{Fs} and the type of modulation +## by the third argument, @var{typ}. The default values of @var{Fs} is 1 and +## @var{typ} is 'amdsb-tc'. +## +## If the argument @var{Fs} is a two element vector, the the first element +## represents the sampling rate and the second the initial phase. +## +## The different types of demodulations that are available are +## +## @table @asis +## @item 'am' +## @itemx 'amdsb-tc' +## Double-sideband with carrier +## @item 'amdsb-tc/costas' +## Double-sideband with carrier and Costas phase locked loop +## @item 'amdsb-sc' +## Double-sideband with suppressed carrier +## @item 'amssb' +## Single-sideband with frequency domain Hilbert filtering +## @item 'qam' +## Quadrature amplitude demodulation. In-phase in odd-columns and quadrature +## in even-columns +## @item 'qam/cmplx' +## Quadrature amplitude demodulation with complex return value. +## @item 'fm' +## Frequency demodulation +## @item 'pm' +## Phase demodulation +## @end table +## +## Additional arguments are available for the demodulations 'amdsb-tc', 'fm', +## 'pm'. These arguments are +## +## @table @code +## @item offset +## The offset in the input signal for the transmitted carrier. +## @item dev +## The deviation of the phase and frequency modulation +## @end table +## +## It is possible to specify a low-pass filter, by the numerator @var{num} +## and denominator @var{den} that will be applied to the returned vector. +## +## @end deftypefn +## @seealso{ademodce,dmodce} + +function y = ademodce (x, Fs, typ, varargin) + + if (nargin < 1) + help("ademodce"); + elseif (nargin < 2) + Fs = 1; + typ = "am"; + elseif (nargin < 3) + typ = "am"; + endif + + if (isempty(Fs)) + Fs = 1; + iphs = 0; + elseif (isscalar(Fs)) + iphs = 0; + else + if ((max(size(Fs)) != 2) || (min(size(Fs)) != 1)) + error ("ademodce: sampling frequency must be a scalar or 2-element vector"); + endif + Fs = Fs(1); + iphs = Fs(2); + endif + + ## Pass the optional arguments + dev = 1; + num = []; + den = []; + narg = 1; + if (!ischar(typ)) + error ("ademodce: modulation type must be a string"); + elseif (strcmp(typ,"am") || strcmp(typ,"amdsb-tc")) + if (length(varargin) > 0) + offset = varargin{1}; + narg = narg + 1; + endif + elseif (strcmp(typ,"fm") || strcmp(typ,"pm")) + if (length(varargin) > 0) + dev = varargin{1}; + narg = narg + 1; + endif + endif + if (length(varargin) == narg) + error ("ademodce: must specify must numerator and denominator of transfer function"); + elseif (length(varargin) == narg+1) + num = varargin{narg}; + den = varargin{narg+1}; + elseif (length(varargin) != narg - 1) + error ("ademodce: too many arguments"); + endif + + if (strcmp(typ,"am") || findstr(typ,"amdsb-tc")) + if (findstr(typ,"/costas")) + error ("ademodce: Costas phase locked loop not implemented"); + endif + y = real(x * exp(-1i * iphs)); + if (exist("offset","var")) + y = y - offset; + else + if (min(size(y)) == 1) + y = y - mean(y); + else + for i=1:size(y,2) + y(:,i) = y(:,i) - mean(y(:,i)); + end + endif + endif + elseif (strcmp(typ,"amdsb-sc")) + y = real(x * exp(-1i * iphs)); + elseif (findstr(typ,"amssb")) + if (findstr(typ,"/costas")) + error ("ademodce: Costas phase locked loop not implemented"); + endif + y = real(x * exp(-1i * iphs)); + elseif (strcmp(typ,"qam")) + y1 = x * exp(-1i * iphs); + y = zeros(size(y1,1),2*size(y1,2)); + y(:,1:2:size(y,2)) = real(y1); + y(:,2:2:size(y,2)) = imag(y1); + elseif (strcmp(typ,"qam/cmplx")) + y = x * exp(-1i * iphs); + elseif (strcmp(typ,"pm")) + y = ( -1i * log(x) + iphs) / dev; + elseif (strcmp(typ,"fm")) + ## This can't work as it doesn't take into account the + ## phase wrapping in the modulation process. Therefore + ## we'll get some of the demodulated values in error, with + ## most of the values being correct.. + ## + ## Not sure the best approach to fixing this. Perhaps implement + ## a PLL with the ouput of the phase detector being the demodulated + ## signal... + warning("ademodce: FM demodulation broken!!") + pm = Fs / dev / pi * ( - 1i * log(x) + iphs) + y = [pm(:,1), (pm(:,2:size(pm,2)) - pm(:,1:size(pm,2)-1))]; + else + error ("ademodce: unknown demodulation specified"); + endif + + if (!isempty(num) && !isempty(dem)) + ## Low-pass filter the output + if (min(size(y)) == 1) + y = filter(num,den, y); + else + for i=1:size(y,2) + y(:,i) = filter(num, den, y(:,i)); + end + endif + endif + +endfunction + diff --git a/octave_packages/communications-1.1.1/amdemod.m b/octave_packages/communications-1.1.1/amdemod.m new file mode 100644 index 0000000..d632f4a --- /dev/null +++ b/octave_packages/communications-1.1.1/amdemod.m @@ -0,0 +1,30 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}] =} amdemod (@var{s}, @var{fc}, @var{fs}) +## Compute the amplitude demodulation of the signal @var{s} with a carrier +## frequency of @var{fc} and a sample frequency of @var{fs}. +## @seealso{ammod} +## @end deftypefn + +function [m] = amdemod(s,fc,fs) + if(nargin ~= 3) + usage("m = amdemod(s,fc,fs)"); + end + t = 0:1./fs:(length(s)-1)./fs; + e = s.*cos(2.*pi.*fc.*t); + [b a] = butter(5,fc.*2./fs); + m = filtfilt(b,a,e).*2; diff --git a/octave_packages/communications-1.1.1/ammod.m b/octave_packages/communications-1.1.1/ammod.m new file mode 100644 index 0000000..c7126a5 --- /dev/null +++ b/octave_packages/communications-1.1.1/ammod.m @@ -0,0 +1,30 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} ammod (@var{x},@var{fc},@var{fs}) +## Create the AM modulation of the signal x with carrier frequency fs. Where x is sample at frequency fs. +## @seealso{amdemod,fmmod,fmdemod} +## @end deftypefn + + +function [y] = ammod(x,fc,fs) + if (nargin != 3) + usage ("ammod(x,fs,fc)"); + endif + + l = length(x); + t=0:1./fs:(l-1)./fs; + y = x.*cos(2.*pi.*fc.*t); diff --git a/octave_packages/communications-1.1.1/amodce.m b/octave_packages/communications-1.1.1/amodce.m new file mode 100644 index 0000000..b4995a7 --- /dev/null +++ b/octave_packages/communications-1.1.1/amodce.m @@ -0,0 +1,171 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} amodce (@var{x},@var{Fs},'amdsb-tc',offset) +## @deftypefnx {Function File} {@var{y} =} amodce (@var{x},@var{Fs},'amdsb-sc') +## @deftypefnx {Function File} {@var{y} =} amodce (@var{x},@var{Fs},'amssb') +## @deftypefnx {Function File} {@var{y} =} amodce (@var{x},@var{Fs},'amssb/time',@var{num},@var{den}) +## @deftypefnx {Function File} {@var{y} =} amodce (@var{x},@var{Fs},'qam') +## @deftypefnx {Function File} {@var{y} =} amodce (@var{x},@var{Fs},'fm',@var{dev}) +## @deftypefnx {Function File} {@var{y} =} amodce (@var{x},@var{Fs},'pm',@var{dev}) +## @deftypefnx {Function File} {@var{y} =} amodce (@var{x},[@var{Fs},@var{iphs}],@var{...}) +## +## Baseband modulator for analog signals. The input signal is specified by +## @var{x}, its sampling frequency by @var{Fs} and the type of modulation +## by the third argument, @var{typ}. The default values of @var{Fs} is 1 and +## @var{typ} is 'amdsb-tc'. +## +## If the argument @var{Fs} is a two element vector, the the first element +## represents the sampling rate and the second the initial phase. +## +## The different types of modulations that are available are +## +## @table @asis +## @item 'am' +## @itemx 'amdsb-tc' +## Double-sideband with carrier +## @item 'amdsb-sc' +## Double-sideband with suppressed carrier +## @item 'amssb' +## Single-sideband with frequency domain Hilbert filtering +## @item 'amssb/time' +## Single-sideband with time domain filtering. Hilbert filter is used by +## default, but the filter can be specified +## @item 'qam' +## Quadrature amplitude modulation +## @item 'fm' +## Frequency modulation +## @item 'pm' +## Phase modulation +## @end table +## +## Additional arguments are available for the modulations 'amdsb-tc', 'fm, +## 'pm' and 'amssb/time'. These arguments are +## +## @table @code +## @item offset +## The offset in the input signal for the transmitted carrier. +## @item dev +## The deviation of the phase and frequency modulation +## @item num +## @itemx den +## The numerator and denominator of the filter transfer function for the +## time domain filtering of the SSB modulation +## @end table +## +## @end deftypefn +## @seealso{ademodce,dmodce} + +function y = amodce (x, Fs, typ, varargin) + + if (nargin < 1) + help("amodce"); + elseif (nargin < 2) + Fs = 1; + typ = "am"; + elseif (nargin < 3) + typ = "am"; + endif + + if (isempty(Fs)) + Fs = 1; + iphs = 0; + elseif (isscalar(Fs)) + iphs = 0; + else + if ((max(size(Fs)) != 2) || (min(size(Fs)) != 1)) + error ("amodce: sampling frequency must be a scalar or 2-element vector"); + endif + Fs = Fs(1); + iphs = Fs(2); + endif + + ## Pass the optional arguments + offset = min(x(:)); + dev = 1; + num = []; + den = []; + narg = 1; + if (!ischar(typ)) + error ("amodce: modulation type must be a string"); + elseif (strcmp(typ,"am") || strcmp(typ,"amdsb-tc")) + if (length(varargin) > 0) + offset = varargin{1}; + narg = narg + 1; + endif + elseif (strcmp(typ,"fm") || strcmp(typ,"pm")) + if (length(varargin) > 0) + dev = varargin{1}; + narg = narg + 1; + endif + endif + if (length(varargin) == narg) + error ("amodce: must specify must numerator and denominator of transfer function"); + elseif (length(varargin) == narg+1) + num = varargin{narg}; + den = varargin{narg+1}; + elseif (length(varargin) != narg - 1) + error ("amodce: too many arguments"); + endif + + if (strcmp(typ,"am") || strcmp(typ,"amdsb-tc")) + y = (x + offset) * exp(1i * iphs); + elseif (strcmp(typ,"amdsb-sc")) + y = x * exp(1i * iphs); + elseif (strcmp(typ,"amssb")) + if (!isreal(x)) + error ("amodce: SSB modulated signal must be real"); + endif + ## Damn, must treat Hilbert transform row-by-row!!! + y = zeros(size(x)); + for i=1:size(x,2) + y(:,i) = hilbert(x(:,i)) * exp(1i * iphs); + end + elseif (strcmp(typ,"amssb/time")) + if (isempty(num) || isempty(dem)) + error ("amodce: have not implemented Hilbert transform in time domain yet"); + endif + y = zeros(size(x)); + for i=1:size(x,2) + y(:,i) = filter(num, den, x(:,i)); + y(:,i) = (x(:,i) + 1i*y(:,i)) * exp(1i * iphs); + end + elseif (strcmp(typ,"qam")) + if (isreal(x)) + if (floor(size(x,2)/2) != (size(x,2)/2)) + error ("amodce: QAM modulation must have an even number of columns for real signals"); + endif + y = (x(:,1:2:size(x,2)) + 1i * x(:,2:2:size(x,2))); + else + y = x; + endif + y = y * exp(1i * iphs); + elseif (strcmp(typ,"pm")) + y = exp(1i * (dev*x + iphs)); + elseif (strcmp(typ,"fm")) + ## To convert to PM signal, need to evaluate + ## p(t) = \int_0^t dev * x(T) dT + ## As x(t) is discrete and not a function, the only way to perform the + ## above integration is with Simpson's rule. Note \Delta T = 2 * pi / Fs. + pm = pi / Fs * dev * (cumsum([zeros(1,size(x,2));x(1:size(x,1)-1,:)]) ... + + cumsum(x)); + y = exp(1i * (pm + iphs)); + else + error ("amodce: unknown modulation specified"); + endif + +endfunction + diff --git a/octave_packages/communications-1.1.1/apkconst.m b/octave_packages/communications-1.1.1/apkconst.m new file mode 100644 index 0000000..b6f2d09 --- /dev/null +++ b/octave_packages/communications-1.1.1/apkconst.m @@ -0,0 +1,149 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} apkconst (@var{nsig}) +## @deftypefnx {Function File} {} apkconst (@var{nsig},@var{amp}) +## @deftypefnx {Function File} {} apkconst (@var{nsig},@var{amp},@var{phs}) +## @deftypefnx {Function File} {} apkconst (@var{...},"n") +## @deftypefnx {Function File} {} apkconst (@var{...},@var{str}) +## @deftypefnx {Function File} {@var{y} = } apkconst (@var{...}) +## +## Plots a ASK/PSK signal constellation. Argument @var{nsig} is a real vector +## whose length determines the number of ASK radii in the constellation. +## The values of vector @var{nsig} determine the number of points in each +## ASK radii. +## +## By default the radii of each ASK modulated level is given by the index of +## @var{nsig}. The amplitudes can be defined explictly in the variable +## @var{amp}, which is a vector of the same length as @var{nsig}. +## +## By default the first point in each ASK radii has zero phase, and following +## points are coding in an anti-clockwise manner. If @var{phs} is defined then +## it is a vector of the same length as @var{nsig} defining the initial phase +## in each ASK radii. +## +## In addition @dfn{apkconst} takes two string arguments 'n' and and @var{str}. +## If the string 'n' is included in the arguments, then a number is printed +## next to each constellation point giving the symbol value that would be +## mapped to this point by the @dfn{modmap} function. The argument @var{str} +## is a plot style string (example 'r+') and determines the default gnuplot +## point style to use for plot points in the constellation. +## +## If @dfn{apskconst} is called with a return argument, then no plot is +## created. However the return value is a vector giving the in-phase and +## quadrature values of the symbols in the constellation. +## @end deftypefn +## @seealso{dmod,ddemod,modmap,demodmap} + + +## 2005-04-23 Dmitri A. Sergatskov +## * modified for new gnuplot interface (octave > 2.9.0) + + + +function yout = apkconst(varargin) + + if ((nargin < 1) || (nargin > 5)) + error ("apkconst: incorrect number of arguments"); + endif + + numargs = 0; + printnums = 0; + fmt = "+r"; + amp = []; + phs = []; + + for i=1:length(varargin) + arg = varargin{i}; + if (ischar(arg)) + if (strcmp(arg,"n")) + try + text(); + printnums = 1; + catch + printnums = 0; + end + else + fmt = arg; + endif + else + numargs++; + switch (numargs) + case 1, + nsig = arg; + case 2, + amp = arg; + case 3, + phs = arg; + otherwise + error ("apkconst: too many numerical arguments"); + endswitch + endif + end + + if (numargs < 1) + error ("apkconst: must have at least one vector argument"); + endif + + if (isempty(amp)) + amp = 1:length(nsig); + endif + + if (isempty(phs)) + phs = zeros(size(amp)); + endif + + if (!isvector(nsig) || !isvector(amp) || !isvector(phs) || ... + (length(nsig) != length(amp)) || (length(nsig) != length(phs))) + error ("apkconst: numerical arguments must be vectors of the same length"); + endif + + if (length(nsig) == 0) + error ("apkconst: first numerical argument must have non-zero length"); + endif + + y = []; + for i=1:length(nsig) + if (nsig(i) < 1) + error ("apkconst: must have at least one point in ASK radii"); + endif + y = [y; amp(i) * [cos(2*pi*[0:nsig(i)-1]'/nsig(i) + phs(i)) + ... + 1i*sin(2*pi*[0:nsig(i)-1]'/nsig(i) + phs(i))]]; + end + + if (nargout == 0) + r = [0:0.02:2]'*pi; + x0 = cos(r) * amp; + y0 = sin(r) * amp; + plot(x0, y0, "b"); + yy = [real(y), imag(y)]; + hold on; + if (printnums) + xd = 0.05 * max(real(y)); + for i=1:length(y) + text(real(y(i))+xd,imag(y(i)),num2str(i-1)); + end + endif + plot (real(y), imag(y), fmt); + + title("ASK/PSK Constellation"); + xlabel("In-phase"); + ylabel("Quadrature"); + else + yout = y; + endif + +endfunction diff --git a/octave_packages/communications-1.1.1/awgn.m b/octave_packages/communications-1.1.1/awgn.m new file mode 100644 index 0000000..cbad5cf --- /dev/null +++ b/octave_packages/communications-1.1.1/awgn.m @@ -0,0 +1,147 @@ +## Copyright (C) 2002 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} awgn (@var{x},@var{snr}) +## @deftypefnx {Function File} {@var{y} =} awgn (@var{x},@var{snr},@var{pwr}) +## @deftypefnx {Function File} {@var{y} =} awgn (@var{x},@var{snr}, @var{pwr},@var{seed}) +## @deftypefnx {Function File} {@var{y} =} awgn (@var{...}, '@var{type}') +## +## Add white Gaussian noise to a voltage signal. +## +## The input @var{x} is assumed to be a real or complex voltage signal. The +## returned value @var{y} will be the same form and size as @var{x} but with +## Gaussian noise added. Unless the power is specified in @var{pwr}, the +## signal power is assumed to be 0dBW, and the noise of @var{snr} dB will be +## added with respect to this. If @var{pwr} is a numeric value then the signal +## @var{x} is assumed to be @var{pwr} dBW, otherwise if @var{pwr} is +## 'measured', then the power in the signal will be measured and the noise +## added relative to this measured power. +## +## If @var{seed} is specified, then the random number generator seed is +## initialized with this value +## +## By default the @var{snr} and @var{pwr} are assumed to be in dB and dBW +## respectively. This default behaviour can be chosen with @var{type} +## set to 'dB'. In the case where @var{type} is set to 'linear', @var{pwr} +## is assumed to be in Watts and @var{snr} is a ratio. +## @end deftypefn +## @seealso{randn,wgn} + +## 2003-01-28 +## initial release + +function y = awgn (x, snr, varargin) + + if ((nargin < 2) || (nargin > 5)) + error ("usage: awgn(x, snr, p, seed, type"); + endif + + [m,n] = size(x); + if (isreal(x)) + out = "real"; + else + out = "complex"; + endif + + p = 0; + seed = []; + type = "dB"; + meas = 0; + narg = 0; + + for i=1:length(varargin) + arg = varargin{i}; + if (ischar(arg)) + if (strcmp(arg,"measured")) + meas = 1; + elseif (strcmp(arg,"dB")) + type = "dB"; + elseif (strcmp(arg,"linear")) + type = "linear"; + else + error ("awgn: invalid argument"); + endif + else + narg++; + switch (narg) + case 1, + p = arg; + case 2, + seed = arg; + otherwise + error ("wgn: too many arguments"); + endswitch + endif + end + + if (isempty(p)) + p = 0; + endif + + if (!isempty(seed)) + if (!isscalar(seed) || !isreal(seed) || (seed < 0) || + ((seed-floor(seed)) != 0)) + error ("awgn: random seed must be integer"); + endif + endif + + if (!isscalar(p) || !isreal(p)) + error("awgn: invalid power"); + endif + if (strcmp(type,"linear") && (p < 0)) + error("awgn: invalid power"); + endif + + if (!isscalar(snr) || !isreal(snr)) + error("awgn: invalid snr"); + endif + if (strcmp(type,"linear") && (snr < 0)) + error("awgn: invalid snr"); + endif + + if(!isempty(seed)) + randn("state",seed); + endif + + if (meas == 1) + p = sum( abs( x(:)) .^ 2) / length(x(:)); + if (strcmp(type,"dB")) + p = 10 * log10(p); + endif + endif + + if (strcmp(type,"linear")) + np = p / snr; + else + np = p - snr; + endif + + y = x + wgn (m, n, np, 1, seed, type, out); + +endfunction + + %!shared x, y, noisy + %! x = [0:0.01:2*pi]; y = sin (x); + %! noisy = awgn (y, 20, "dB", "measured"); + +## Test of noisy is pretty arbitrary, but should pickup most errors + %!error awgn (); + %!error awgn (1); + %!error awgn (1,1,1,1,1); + %!assert (isreal(noisy)); + %!assert (iscomplex(awgn(y+1i,20,"dB","measured"))); + %!assert (size(y) == size(noisy)) + %!assert (abs(10*log10(mean(y.^2)/mean((y-noisy).^ 2)) - 20) < 1); diff --git a/octave_packages/communications-1.1.1/bchpoly.m b/octave_packages/communications-1.1.1/bchpoly.m new file mode 100644 index 0000000..3ab6528 --- /dev/null +++ b/octave_packages/communications-1.1.1/bchpoly.m @@ -0,0 +1,233 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{p} = } bchpoly () +## @deftypefnx {Function File} {@var{p} = } bchpoly (@var{n}) +## @deftypefnx {Function File} {@var{p} = } bchpoly (@var{n},@var{k}) +## @deftypefnx {Function File} {@var{p} = } bchpoly (@var{prim},@var{k}) +## @deftypefnx {Function File} {@var{p} = } bchpoly (@var{n},@var{k},@var{prim}) +## @deftypefnx {Function File} {@var{p} = } bchpoly (@var{...},@var{probe}) +## @deftypefnx {Function File} {[@var{p},@var{f}] = } bchpoly (@var{...}) +## @deftypefnx {Function File} {[@var{p},@var{f},@var{c}] = } bchpoly (@var{...}) +## @deftypefnx {Function File} {[@var{p},@var{f},@var{c},@var{par}] = } bchpoly (@var{...}) +## @deftypefnx {Function File} {[@var{p},@var{f},@var{c},@var{par},@var{t}] = } bchpoly (@var{...}) +## +## Calculates the generator polynomials for a BCH coder. Called with no input +## arguments @dfn{bchpoly} returns a list of all of the valid BCH codes for +## the codeword length 7, 15, 31, 63, 127, 255 and 511. A three column matrix +## is returned with each row representing a seperate valid BCH code. The first +## column is the codeword length, the second the message length and the third +## the error correction capability of the code. +## +## Called with a single input argument, @dfn{bchpoly} returns the valid BCH +## codes for the specified codeword length @var{n}. The output format is the +## same as above. +## +## When called with two or more arguments, @dfn{bchpoly} calculates the +## generator polynomial of a particular BCH code. The generator polynomial +## is returned in @var{p} as a vector representation of a polynomial in +## GF(2). The terms of the polynomial are listed least-significant term +## first. +## +## The desired BCH code can be specified by its codeword length @var{n} +## and its message length @var{k}. Alternatively, the primitive polynomial +## over which to calculate the polynomial can be specified as @var{prim}. +## If a vector representation of the primitive polynomial is given, then +## @var{prim} can be specified as the first argument of two arguments, +## or as the third argument. However, if an integer representation of the +## primitive polynomial is used, then the primitive polynomial must be +## specified as the third argument. +## +## When called with two or more arguments, @dfn{bchpoly} can also return the +## factors @var{f} of the generator polynomial @var{p}, the cyclotomic coset +## for the Galois field over which the BCH code is calculated, the parity +## check matrix @var{par} and the error correction capability @var{t}. It +## should be noted that the parity check matrix is calculated with +## @dfn{cyclgen} and limitations in this function means that the parity +## check matrix is only available for codeword length upto 63. For +## codeword length longer than this @var{par} returns an empty matrix. +## +## With a string argument @var{probe} defined, the action of @dfn{bchpoly} +## is to calculate the error correcting capability of the BCH code defined +## by @var{n}, @var{k} and @var{prim} and return it in @var{p}. This is +## similar to a call to @dfn{bchpoly} with zero or one argument, except that +## only a single code is checked. Any string value for @var{probe} will +## force this action. +## +## In general the codeword length @var{n} can be expressed as +## @code{2^@var{m}-1}, where @var{m} is an integer. However, if +## [@var{n},@var{k}] is a valid BCH code, then a shortened BCH code of +## the form [@var{n}-@var{x},@var{k}-@var{x}] can be created with the +## same generator polynomial +## +## @end deftypefn +## @seealso{cyclpoly,encode,decode,cosets} + +function [p, f, c, par, t] = bchpoly(nn, k, varargin) + + if ((nargin < 0) || (nargin > 4)) + error ("bchpoly: incorrect number of arguments"); + endif + + probe = 0; + prim = 0; ## Set to zero to use default primitive polynomial + if (nargin == 0) + m = [3:9]; + n = 2.^m - 1; + nn = n; + elseif (isscalar(nn)) + m = ceil(log2(nn+1)); + n = 2.^m - 1; + if ((n != floor(n)) || (n < 7) || (m != floor(m)) ) + error("bchpoly: n must be a integer greater than 3"); + endif + else + prim = bi2de(n); + if (!isprimitive(prim)) + error ("bchpoly: prim must be a primitive polynomial of GF(2^m)"); + endif + m = length(n) - 1; + n = 2^m - 1; + endif + + if ((nargin > 1) && (!isscalar(k) || (floor(k) != k) || (k > n))) + error ("bchpoly: message length must be less than codeword length"); + endif + + for i=1:length(varargin) + arg = varargin{i}; + if (ischar(arg)) + probe = 1; + if (nargout > 1) + error ("bchpoly: only one output argument allowed when probing valid codes"); + endif + else + if (prim != 0) + error ("bchpoly: primitive polynomial already defined"); + endif + prim = arg; + if (!isscalar(prim)) + prim = bi2de(prim); + endif + if ((floor(prim) != prim) || (prim < 2^m) || (prim > 2^(m+1)) || ... + !isprimitive(prim)) + error ("bchpoly: prim must be a primitive polynomial of GF(2^m)"); + endif + endif + end + + ## Am I using the right algo to calculate the correction capability? + if (nargin < 2) + if (nargout > 1) + error ("bchpoly: only one output argument allowed when probing valid codes"); + endif + + p = []; + for ni=1:length(n) + c = cosets(m(ni), prim); + nc = length(c); + fc = zeros(1,nc); + f = []; + + for t=1:floor(n(ni)/2) + for i=1:nc + if (fc(i) != 1) + cl = log(c{i}); + for j=2*(t-1)+1:2*t + if (find(cl == j)) + f = [f, c{i}.x]; + fc(i) = 1; + break; + endif + end + endif + end + + k = nn(ni) - length(f); + if (k < 2) + break; + endif + + if (!isempty(p) && (k == p(size(p,1),2))) + p(size(p,1),:) = [nn(ni), k, t]; + else + p = [p; [nn(ni), k, t]]; + endif + end + end + else + c = cosets(m, prim); + nc = length(c); + fc = zeros(1,nc); + f = []; + fl = 0; + f0 = []; + f1 = []; + t = 0; + do + t++; + f0 = f1; + for i=1:nc + if (fc(i) != 1) + cl = log(c{i}); + for j=2*(t-1)+1:2*t + if (find(cl == j)) + f1 = [f1, c{i}.x]; + fc(i) = 1; + ptmp = gf([c{i}(1), 1], m, prim); + for l=2:length(c{i}) + ptmp = conv(ptmp, [c{i}(l), 1]); + end + f = [f; [ptmp.x, zeros(1,m-length(ptmp)+1)]]; + fl = fl + length(ptmp); + break; + endif + end + endif + end + until (length(f1) > nn - k) + t--; + + if (nn - length(f0) != k) + error("bchpoly: can not find valid generator polynomial for parameters"); + endif + + if (probe) + p = [nn, k, t]; + else + + ## Have to delete a line from the list of minimum polynomials + ## since we've gone one past in calculating f1 above to be + ## sure or the error correcting capability + f = f(1:size(f,1)-1,:); + + p = gf([f0(1), 1], m, prim); + for i=2:length(f0) + p = conv(p, [f0(i), 1]); + end + p = p.x; + + if (nargout > 3) + if (n > 64) + warning("bchpoly: can not create parity matrix\n"); + par = []; + else + par = cyclgen(n,p); + endif + endif + endif + endif +endfunction diff --git a/octave_packages/communications-1.1.1/bi2de.m b/octave_packages/communications-1.1.1/bi2de.m new file mode 100644 index 0000000..d3d17f4 --- /dev/null +++ b/octave_packages/communications-1.1.1/bi2de.m @@ -0,0 +1,96 @@ +## Copyright (C) 2001 Laurent Mazet +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{d} = } bi2de (@var{b}) +## @deftypefnx {Function File} {@var{d} = } bi2de (@var{b},@var{f}) +## @deftypefnx {Function File} {@var{d} = } bi2de (@var{b},@var{p}) +## @deftypefnx {Function File} {@var{d} = } bi2de (@var{b},@var{p},@var{f}) +## +## Convert bit matrix to a vector of integers +## +## Each row of the matrix @var{b} is treated as a single integer represented +## in binary form. The elements of @var{b}, must therefore be '0' or '1' +## +## If @var{p} is defined then it is treated as the base of the decomposition +## and the elements of @var{b} must then lie between '0' and 'p-1'. +## +## The variable @var{f} defines whether the first or last element of @var{b} +## is considered to be the most-significant. Valid values of @var{f} are +## 'right-msb' or 'left-msb'. By default @var{f} is 'right-msb'. +## +## @seealso{de2bi} +## @end deftypefn + +function d = bi2de (b, p, f) + + switch (nargin) + case 1, + p = 2; + f = 'right-msb'; + case 2, + if (ischar (p)) + f = p; + p = 2; + else + f = 'right-msb'; + endif + case 3, + if (ischar (p)) + tmp = f; + f = p; + p = tmp; + endif + otherwise + print_usage (); + endswitch + + if ( any (b(:) < 0) || any (b(:) != floor (b(:))) || any (b(:) > p - 1) ) + error ("bi2de: d must only contain integers in the range [0, p-1]"); + endif + + if (strcmp (f, 'left-msb')) + b = b(:,size(b,2):-1:1); + elseif (!strcmp (f, 'right-msb')) + error ("bi2de: unrecognized flag"); + endif + + if (length (b) == 0) + d = []; + else + d = b * ( p .^ [ 0 : (columns(b)-1) ]' ); + endif + +endfunction + + %!shared x + %! x = randi ([0 1], 100, 16); + %!assert (bi2de (0), 0) + %!assert (bi2de (1), 1) + %!assert (bi2de (ones (1, 8)), 255) + %!assert (bi2de ([7 7 7 7], 8), 4095) + %!assert (size (bi2de (x)), [100 1]) + %!assert (bi2de (x, "right-msb"), bi2de (x)) + %!assert (bi2de (x, "left-msb"), bi2de (fliplr (x))) + +%% Test input validation + %!error bi2de () + %!error bi2de (1, 2, 3, 4) + %!error bi2de (1, 2, 3) + %!error bi2de (1, 2, "invalid") + %!error bi2de (0.1) + %!error bi2de (-1) + %!error bi2de (2) + %!error bi2de (7, 6) diff --git a/octave_packages/communications-1.1.1/biterr.m b/octave_packages/communications-1.1.1/biterr.m new file mode 100644 index 0000000..4dc9127 --- /dev/null +++ b/octave_packages/communications-1.1.1/biterr.m @@ -0,0 +1,170 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{num}, @var{rate}] = } biterr (@var{a},@var{b}) +## @deftypefnx {Function File} {[@var{num}, @var{rate}] = } biterr (@var{...},@var{k}) +## @deftypefnx {Function File} {[@var{num}, @var{rate}] = } biterr (@var{...},@var{flag}) +## @deftypefnx {Function File} {[@var{num}, @var{rate} @var{ind}] = } biterr (@var{...}) +## +## Compares two matrices and returns the number of bit errors and the bit +## error rate. The binary representations of the variables @var{a} and +## @var{b} are treated and @var{a} and @var{b} can be either: +## +## @table @asis +## @item Both matrices +## In this case both matrices must be the same size and then by default the +## the return values @var{num} and @var{rate} are the overall number of bit +## errors and the overall bit error rate. +## @item One column vector +## In this case the column vector is used for bit error comparision column-wise +## with the matrix. The returned values @var{num} and @var{rate} are then +## row vectors containing the num of bit errors and the bit error rate for +## each of the column-wise comparisons. The number of rows in the matrix +## must be the same as the length of the column vector +## @item One row vector +## In this case the row vector is used for bit error comparision row-wise +## with the matrix. The returned values @var{num} and @var{rate} are then +## column vectors containing the num of bit errors and the bit error rate for +## each of the row-wise comparisons. The number of columns in the matrix +## must be the same as the length of the row vector +## @end table +## +## This behaviour can be overridden with the variable @var{flag}. @var{flag} +## can take the value 'column-wise', 'row-wise' or 'overall'. A column-wise +## comparision is not possible with a row vector and visa-versa. +## +## By default the number of bits in each symbol is assumed to be give by the +## number required to represent the maximum value of @var{a} and @var{b}. +## The number of bits to represent a symbol can be overridden by the variable +## @var{k}. +## @end deftypefn + +## 2003 FEB 13 +## initial release + +function [num, rate, ind] = biterr (a, b, varargin) + + if ((nargin < 2) || (nargin > 4)) + usage ("[num rate ind] = biterr (a, b [,k [,flag]])"); + endif + + if (ndims (a) > 2 || ndims (b) > 2) + error ("biterr: a and b must have at most two dimensions"); + endif + + if (any(any(isinf(a))) || any(any(isnan(a))) || any(any(isinf(b))) || ... + any(any(isnan(b))) || !isreal(a) || !isreal(b) || ... + any(any((floor(a)) != a)) || any(any((floor(b)) != b)) || ... + any(any(a < 0)) || any(any(b < 0))) + error ("biterr: a and b must contain only non-negative integers"); + endif + + [ar,ac] = size(a); + [br,bc] = size(b); + + k = max([max(a(:)),max(b(:))]); + m = 1; + while (k > (2^m-1)) + m = m + 1; + end + + if ((ar == br) && (ac == bc)) + type = "matrix"; + flag = "overall"; + c = 1; + elseif (any([ar,br] == 1)) + type = "row"; + flag = "row"; + if (ac != bc) + error ("biterr: row-wise comparison must have the same number of columns in inputs"); + endif + if (ar == 1) + a = ones(br,1) * a; + else + b = ones(ar,1) * b; + endif + elseif (any([ac,bc] == 1)) + type = "column"; + flag = "column"; + if (ar != br) + error ("biterr: column-wise comparison must have the same number of rows in inputs"); + endif + if (ac == 1) + a = a * ones(1,bc); + else + b = b * ones(1,ac); + endif + else + error ("biterr: matrix sizes must match"); + endif + + k = 0; + for i =1:length(varargin) + arg = varargin{i}; + if (ischar(arg)) + if (strcmp(arg,"row-wise")) + if (strcmp(type,"column")) + error ("biterr: row-wise comparison not possible with column inputs"); + endif + flag = "row"; + elseif (strcmp(arg,"column-wise")) + if (strcmp(type,"row")) + error ("biterr: column-wise comparison not possible with row inputs"); + endif + flag = "column"; + elseif (strcmp(arg,"overall")) + flag = "overall"; + else + error ("biterr: unrecognized string argument"); + endif + else + k = arg; + if (k < m) + error ("biterr: the symbol size is too small for largest element"); + endif + endif + end + + if (k == 0) + k = m; + endif + + ## Call the core error function to count the bit errors + ind = __errcore__(a,b); + + switch (flag) + case 'row', + if (strcmp(type,"matrix") && (ac == 1)) + num = ind; + else + num = sum(ind')'; + endif + rate = num / k / max(ac,bc); + case 'column', + if (strcmp(type,"matrix") && (ar == 1)) + num = ind; + else + num = sum(ind); + endif + rate = num / k / max(ar,br); + case 'overall', + num = sum(sum(ind)); + rate = num / k / max(ar,br) / max(ac,bc); + otherwise + error("impossible"); + endswitch + +endfunction diff --git a/octave_packages/communications-1.1.1/bsc.m b/octave_packages/communications-1.1.1/bsc.m new file mode 100644 index 0000000..a9355d1 --- /dev/null +++ b/octave_packages/communications-1.1.1/bsc.m @@ -0,0 +1,39 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} bsc (@var{data}, @var{p}) +## Send @var{data} into a binary symetric channel with probability +## @var{p} of error one each symbol. +## @end deftypefn + +function [ndata] = bsc(data,p) + if (nargin < 1); usage('ndata = bsc(data,p)'); end + + if(isscalar(p) ~= 1 || p > 1 || p < 0) + error('p muste be a positive scalar less than one'); + exit; + end + if(any(data(:) ~= floor(data(:))) || any(data(:) > 1) || any(data(:) < 0)) + error('data must be a binary sequence'); + exit; + end + + ndata = data; + ndata(find(data == 0)) = randsrc(size(ndata(find(data == 0)),1),size(ndata(find(data == 0)),2),[-1 -2;1-p p]); + ndata(find(data == 1)) = randsrc(size(ndata(find(data == 1)),1),size(ndata(find(data == 1)),2),[1 0;1-p p]); + ndata(find(ndata == -1)) = 0; + ndata(find(ndata == -2)) = 1; + diff --git a/octave_packages/communications-1.1.1/comms.m b/octave_packages/communications-1.1.1/comms.m new file mode 100644 index 0000000..8f8ecde --- /dev/null +++ b/octave_packages/communications-1.1.1/comms.m @@ -0,0 +1,665 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} comms ('help') +## @deftypefnx {Function File} {} comms ('info') +## @deftypefnx {Function File} {} comms ('info', @var{mod}) +## @deftypefnx {Function File} {} comms ('test') +## @deftypefnx {Function File} {} comms ('test', @var{mod}) +## +## Manual and test code for the Octave Communications toolbox. There are +## 5 possible ways to call this function. +## +## @table @code +## @item comms ('help') +## Display this help message. Called with no arguments, this function also +## displays this help message +## @item comms ('info') +## Open the Commumications toolbox manual +## @item comms ('info', @var{mod}) +## Open the Commumications toolbox manual at the section specified by +## @var{mod} +## @item comms ('test') +## Run all of the test code for the Communications toolbox. +## @item comms ('test', @var{mod}) +## Run only the test code for the Communications toolbox in the module +## @var{mod}. +## @end table +## +## Valid values for the varibale @var{mod} are +## +## @table @asis +## @item 'all' +## All of the toolbox +## @item 'random' +## The random signal generation and analysis package +## @item 'source' +## The source coding functions of the package +## @item 'block' +## The block coding functions +## @item 'convol' +## The convolution coding package +## @item 'modulation' +## The modulation package +## @item 'special' +## The special filter functions +## @item 'galois' +## The Galois fields package +## @end table +## +## Please note that this function file should be used as an example of the +## use of this toolbox. +## @end deftypefn + +function retval = comms(typ, tests) + + if (nargin < 1) + help ("comms"); + elseif (nargin < 2) + tests = 'all'; + endif + + + if strcmp(tests,"all") + nodename = "Top"; + elseif strcmp(tests,"random") + nodename = "Random Signals"; + elseif strcmp(tests,"source") + nodename = "Source Coding"; + elseif strcmp(tests,"block") + nodename = "Block Coding"; + elseif strcmp(tests,"convol") + nodename = "Convolutional Coding"; + elseif strcmp(tests,"modulation") + nodename = "Modulations"; + elseif strcmp(tests,"special") + nodename = "Special Fields"; + elseif strcmp(tests,"galois") + nodename = "Galois Fields"; + else + error ("comms: unrecognized package"); + endif + + if (strcmp(typ,"help")) + help ("comms"); + elseif (strcmp(typ,"info")) + infopaths = ["."]; + if (!isempty(char(strsplit (path, ":")))) + infopaths =[infopaths; char(strsplit (path, ":"))]; + endif + if (!isempty(char(strsplit (DEFAULT_LOADPATH, ":")))) + infopaths =[infopaths; char(strsplit (DEFAULT_LOADPATH, ":"))]; + endif + for i=1:size(infopaths,1) + infopath = deblank(infopaths(i,:)); + len = length(infopath); + if (len) + if (len > 1 && strcmp(infopath([len-1, len]),"//")) + [status, showfile] = system(["find '", infopath(1:len-1), ... + "' -name ", infofile]); + else + [status, showfile] = system(["find '", infopath, "' -name ", ... + infofile, " -maxdepth 1"]); + endif + if (length(showfile)) + break; + endif + endif + end + if (!exist("showfile") || !length(showfile)) + error("comms: info file not found"); + endif + if (showfile(length(showfile)) == "\n") + showfile = showfile(1:length(showfile)-1); + endif + + if (exist("INFO_PROGAM")) + [testret, testout] = system(["'", INFO_PROGRAM, "' --version"]); + if (testret) + error("comms: info command not found"); + else + system(["'", INFO_PROGRAM, "' --file '", showfile, "' --node '", ... + nodename, "'"]); + endif + else + [testret, testout] = system("info --version"); + if (testret) + error("comms: info command not found"); + else + system(["info --file '", showfile, "' --node '", nodename, "'"]); + endif + endif + elseif (strcmp(typ,"test")) + pso = page_screen_output(); + unwind_protect + page_screen_output(0); + + if (strcmp(tests,"random") || strcmp(tests,"all")) + fprintf("\n<< Random Signals Package >>\n"); + fprintf(" Signal Creation: "); + n = 10; + m = 32; + x = randint(n,n,m); + if (any(size(x) != [10, 10]) || (max(x(:)) >= m) || (min(x(:) < 0))) + error ("FAILED"); + endif + x = randsrc(n,n,[1, 1i, -1, -1i,]); + if (any(size(x) != [10, 10]) || ... + !all(all((x == 1) | (x == 1i) | (x == -1) | (x == -1i)))) + error ("FAILED"); + endif + x = randerr(n,n); + if (any(size(x) != [10, 10]) || any(sum(x') != ones(1,n))) + error ("FAILED"); + endif + + nse_30dBm_1Ohm = wgn(10000,1,30,1,"dBm"); + nse_0dBW_1Ohm = wgn(10000,1,0,1,"dBW"); + nse_1W_1Ohm = wgn(10000,1,1,1,"linear"); + ## Standard deviations should be about 1... If it is greater than + ## some value flag an error + dev = [std(nse_30dBm_1Ohm), std(nse_0dBW_1Ohm), std(nse_1W_1Ohm)]; + if (any(dev > 1.5)) + error ("FAILED"); + endif + + x = [0:0.1:2*pi]; + y = sin(x); + noisy = awgn(y, 10, "dB", "measured"); + if (any(size(y) != size(noisy))) + error ("FAILED"); + endif + ## This is a pretty arbitrary test, but should pick up gross errors + if (any(abs(y-noisy) > 1)) + error ("FAILED"); + endif + fprintf("PASSED\n"); + + fprintf(" Signal Analysis: "); + ## Protect!! Since bitxor might not be installed + try + n = 10; + m = 8; + msg = randint(n,n,2^m); + noisy = bitxor(msg,diag(3*ones(1,n))); + [berr, brate] = biterr(msg, noisy, m); + if ((berr != 2*n) || (brate != 2/(n*m))) + error ("FAILED"); + endif + [serr, srate] = symerr(msg, noisy); + if ((serr != n) || (srate != 1/n)) + error ("FAILED"); + endif + catch + end + ## Can not easily test eyediagram, scatterplot!! + fprintf("PASSED\n"); + endif + if (strcmp(tests,"source") || strcmp(tests,"all")) + fprintf("\n<< Source Coding Package >>\n"); + fprintf(" PCM Functions: "); + fprintf("Not tested\n"); + fprintf(" Quantization Functions: "); + x = [0:0.1:2*pi]; + y = sin(x); + [tab, cod] = lloyds(y, 16); + [i, q, d] = quantiz(y, tab, cod); + if (abs(d) > 0.1) + error ("FAILED"); + endif + + mu = 0.1; + V = 1; + x = sin([0:0.1:2*pi]); + y = compand(x, mu, V, "mu/compressor"); + z = compand(x, mu, V, "mu/expander"); + ## Again this is a pretty arbitrary test + if (max(abs(x-z)) > 0.1) + error ("FAILED"); + endif + fprintf("PASSED\n"); + endif + if (strcmp(tests,"block") || strcmp(tests,"all")) + fprintf("\n<< Block Coding Package >>\n"); + fprintf(" Cyclic Coding: "); + nsym = 100; + m = 4; + n = 2^m-1; # [15,11] Hamming code + k = n - m; + p = cyclpoly(n,k); + if (bi2de(p) != primpoly(m,"nodisplay")) + error("FAILED"); + endif + [par, gen] = cyclgen(n,p); + if (any(any(gen2par(par) != gen))) + error("FAILED"); + endif + if (gfweight(gen) != 3) + error("FAILED"); + endif + + msg = randint(nsym,k); + code = encode(msg,n,k,"cyclic"); + noisy = mod(code + randerr(nsym,n), 2); + dec = decode(noisy,n,k,"cyclic"); + if (any(any(dec != msg))) + error("FAILED"); + endif + try # Protect! If bitshift isn't install!! + msg = randint(nsym,1,n); + code = encode(msg,n,k,"cyclic/decimal"); + noisy = mod(code + bitshift(1,randint(nsym,1,n)), n+1); + dec = decode(noisy,n,k,"cyclic/decimal"); + if (any(dec != msg)) + error("FAILED"); + endif + catch + end + fprintf("PASSED\n"); + + fprintf(" Hamming Coding: "); + nsym = 100; + m = 4; + [par, gen, n, k] = hammgen (m); + if (any(any(gen2par(par) != gen))) + error("FAILED"); + endif + if (gfweight(gen) != 3) + error("FAILED"); + endif + msg = randint(nsym,k); + code = encode(msg,n,k,"hamming"); + noisy = mod(code + randerr(nsym,n), 2); + dec = decode(noisy,n,k,"hamming"); + if (any(any(dec != msg))) + error("FAILED"); + endif + try # Protect! If bitshift isn't install!! + msg = randint(nsym,1,n); + code = encode(msg,n,k,"hamming/decimal"); + noisy = mod(code + bitshift(1,randint(nsym,1,n)), n+1); + dec = decode(noisy,n,k,"hamming/decimal"); + if (any(dec != msg)) + error("FAILED"); + endif + catch + end + fprintf("PASSED\n"); + + fprintf(" BCH Coding: "); + ## Setup + m = 5; + nsym = 100; + p = bchpoly(2^m - 1); + ## Pick a BCH code from the list at random + l = ceil(size(p,1) * rand(1,1)); + n = p(l,1); + k = p(l,2); + t = p(l,3); + ## Symbols represented by rows of binary matrix + msg = randint(nsym,k); + code = encode(msg,n,k,"bch"); + noisy = mod(code + randerr(nsym,n), 2); + dec = decode(noisy,n,k,"bch"); + if (any(any(dec != msg))) + error("FAILED"); + endif + try # Protect! If bitshift isn't install!! + msg = randint(nsym,1,n); + code = encode(msg,n,k,"bch/decimal"); + noisy = mod(code + bitshift(1,randint(nsym,1,n)), n+1); + dec = decode(noisy,n,k,"bch/decimal"); + if (any(dec != msg)) + error("FAILED"); + endif + catch + end + fprintf("PASSED\n"); + + fprintf(" Reed-Solomon Coding: "); + ## Test for a CCSDS like coder, but without dual-basis translation + mrs = 8; + nrs = 2^mrs -1; + krs = nrs - 32; + prs = 391; + fcr = 112; + step = 11; + + ## CCSDS generator polynomial + ggrs = rsgenpoly(nrs, krs, prs, fcr, step); + + ## Code two blocks + msg = gf(floor(2^mrs*rand(2,krs)),mrs,prs); + cde = rsenc(msg,nrs,krs,ggrs); + + ## Introduce errors + noisy = cde + [ 255,0,255,0,255,zeros(1,250); ... + 0,255,0,255,zeros(1,251)]; + + ## Decode (better to pass fcr and step rather than gg for speed) + dec = rsdec(noisy,nrs,krs,fcr,step); + + if (any(dec != msg)) + error("FAILED"); + endif + fprintf("PASSED\n"); + endif + if (strcmp(tests,"convol") || strcmp(tests,"all")) + fprintf("\n<< Convolutional Coding Package >>\n"); + fprintf(" Utility functions: "); + ## create a trellis, use poly2trellis and test with istrellis + fprintf("Not tested\n"); + fprintf(" Coding: "); + ## use convenc, punturing?? + fprintf("Not tested\n"); + fprintf(" Viterbi: "); + ## use vitdec + fprintf("Not tested\n"); + endif + if (strcmp(tests,"modulation") || strcmp(tests,"all")) + fprintf("\n<< Modulation Package >>\n"); + fprintf(" Analog Modulation: "); + Fs = 100; + t = [0:1/Fs:2]; + x = sin(2*pi*t); + xq = x + 1i * cos(2*pi*t); + ## Can not test FM as it doesn't work !!! + if ((max(abs(x - ademodce(amodce(x,Fs,"pm"),Fs,"pm"))) > 0.001) || ... + (max(abs(x - ademodce(amodce(x,Fs,"am"),Fs,"am"))) > 0.001) || ... + (max(abs(xq - ademodce(amodce(xq,Fs,"qam"),Fs,"qam/cmplx"))) > 0.001)) + error("FAILED"); + endif + fprintf("PASSED\n"); + fprintf(" Digital Mapping: "); + m = 32; + n = 100; + x = randint(n,n,32); + if ((x != demodmap(modmap(x,1,1,"ask",m),1,1,"ask",m)) || ... + (x != demodmap(modmap(x,1,1,"fsk",m),1,1,"fsk",m)) || ... + (x != demodmap(modmap(x,1,1,"msk"),1,1,"msk")) || ... + (x != demodmap(modmap(x,1,1,"psk",m),1,1,"psk",m)) || ... + (x != demodmap(modmap(x,1,1,"qask",m),1,1,"qask",m)) || ... + (x != demodmap(modmap(x,1,1,"qask/cir", ... + [floor(m/2), m - floor(m/2)]),1,1,"qask/cir", ... + [floor(m/2), m - floor(m/2)]))) + error("FAILED"); + endif + fprintf("PASSED\n"); + fprintf(" Digital Modulation: "); + fprintf("Not tested\n"); + endif + if (strcmp(tests,"special") || strcmp(tests,"all")) + fprintf("\n<< Special Filters Package >>\n"); + fprintf(" Hankel/Hilbert: "); + ## use hank2sys, hilbiir + fprintf("Not tested\n"); + fprintf(" Raised Cosine: "); + ## use rcosflt, rcosiir rcosine, rcosfir + fprintf("Not tested\n"); + endif + if (strcmp(tests,"galois") || strcmp(tests,"all")) + fprintf("\n<< Galois Fields Package >>\n"); + ## Testing of the Galois Fields package + m = 3; ## must be greater than 2 + + fprintf(" Find primitive polynomials: "); + prims = primpoly(m,"all","nodisplay"); + for i=2^m:2^(m+1)-1 + if (find(prims == i)) + if (!isprimitive(i)) + error("Error in primitive polynomials"); + endif + else + if (isprimitive(i)) + error("Error in primitive polynomials"); + endif + endif + end + fprintf("PASSED\n"); + fprintf(" Create Galois variables: "); + n = 2^m-1; + gempty = gf([],m); + gzero = gf(0,m); + gone = gf(1,m); + gmax = gf(n,m); + grow = gf(0:n,m); + gcol = gf([0:n]',m); + matlen = ceil(sqrt(2^m)); + gmat = gf(reshape(mod([0:matlen*matlen-1],2^m),matlen,matlen),m); + fprintf("PASSED\n"); + fprintf(" Access Galois structures: "); + if (gcol.m != m || gcol.prim_poly != primpoly(m,"min", ... + "nodisplay")) + error("FAILED"); + endif + fprintf("PASSED\n"); + fprintf(" Miscellaneous functions: "); + if (size(gmat) != [matlen, matlen]) + error("FAILED"); + endif + if (length(grow) != 2^m) + error("FAILED"); + endif + if (!any(grow) || all(grow) || any(gzero) || !all(gone)) + error("FAILED"); + endif + if (isempty(gone) || !isempty(gempty)) + error("FAILED"); + endif + tmp = diag(grow); + if (size(tmp,1) != 2^m || size(tmp,2) != 2^m) + error("FAILED"); + endif + for i=1:2^m + for j=1:2^m + if ((i == j) && (tmp(i,j) != grow(i))) + error("FAILED"); + elseif ((i != j) && (tmp(i,j) != 0)) + error("FAILED"); + endif + end + end + tmp = diag(gmat); + if (length(tmp) != matlen) + error("FAILED"); + endif + for i=1:matlen + if (gmat(i,i) != tmp(i)) + error("FAILED"); + endif + end + tmp = reshape(gmat,prod(size(gmat)),1); + if (length(tmp) != prod(size(gmat))) + error("FAILED"); + endif + if (exp(log(gf([1:n],m))) != [1:n]) + error("FAILED"); + endif + tmp = sqrt(gmat); + if (tmp .* tmp != gmat) + error("FAILED"); + endif + + fprintf("PASSED\n"); + fprintf(" Unary operators: "); + tmp = - grow; + if (tmp != grow) + error("FAILED"); + endif + tmp = !grow; + if (tmp(1) != 1) + error("FAILED"); + endif + if (any(tmp(2:length(tmp)))) + error("FAILED"); + endif + tmp = gmat'; + for i=1:size(gmat,1) + for j=1:size(gmat,2) + if (gmat(i,j) != tmp(j,i)) + error("FAILED"); + endif + end + end + fprintf("PASSED\n"); + fprintf(" Arithmetic operators: "); + if (any(gmat + gmat)) + error("FAILED"); + endif + multbl = gcol * grow; + elsqr = gcol .* gcol; + elsqr2 = gcol .^ gf(2,m); + for i=1:length(elsqr) + if (elsqr(i) != multbl(i,i)) + error("FAILED"); + endif + end + for i=1:length(elsqr) + if (elsqr(i) != elsqr2(i)) + error("FAILED"); + endif + end + tmp = grow(2:length(grow)) ./ gcol(2:length(gcol))'; + if (length(tmp) != n || any(tmp != ones(1,length(grow)-1))) + error("FAILED"); + endif + fprintf("PASSED\n"); + fprintf(" Logical operators: "); + if (grow(1) != gzero || grow(2) != gone || grow(2^m) != n) + error("FAILED"); + endif + if (!(grow(1) == gzero) || any(grow != gcol')) + error("FAILED"); + endif + fprintf("PASSED\n"); + + fprintf(" Polynomial manipulation: "); + poly1 = gf([2,4,5,1],3); + poly2 = gf([1,2],3); + sumpoly = poly1 + [0,0,poly2]; ## Already test "+" + mulpoly = conv(poly1, poly2); ## multiplication + poly3 = [poly,remd] = deconv(mulpoly, poly2); + if (!isequal(poly1,poly3)) + error("FAILED"); + endif + if (any(remd)) + error("FAILED"); + endif + x0 = gf([0,1,2,3],3); + y0 = polyval(poly1, x0); + alph = gf(2,3); + y1 = alph * x0.^3 + alph.^2 * x0.^2 + (alph.^2+1) *x0 + 1; + if (!isequal(y0,y1)) + error("FAILED"); + endif + roots1 = roots(poly1); + ck1 = polyval(poly1, roots1); + if (any(ck1)) + error("FAILED"); + endif + b = minpol(alph); + bpoly = bi2de(b.x,"left-msb"); + if (bpoly != alph.prim_poly) + error("FAILED"); + endif + c = cosets(3); + c2 = c{2}; + mpol = minpol(c2(1)); + for i=2:length(c2) + if (mpol != minpol(c2(i))) + error("FAILED"); + endif + end + fprintf("PASSED\n"); + + fprintf(" Linear Algebra: "); + [l,u,p] = lu(gmat); + if (any(l*u-p*gmat)) + error("FAILED"); + endif + g1 = inv(gmat); + g2 = gmat ^ -1; + if (any(g1*gmat != eye(matlen))) + error("FAILED"); + endif + if (any(g1 != g2)) + error("FAILED"); + endif + matdet = 0; + while (!matdet) + granmat = gf(floor(2^m*rand(matlen)),m); + matdet = det(granmat); + endwhile + matrank = rank(granmat); + smallcol = gf([0:matlen-1],m)'; + sol1 = granmat \ smallcol; + sol2 = smallcol' / granmat; + if (any(granmat * sol1 != smallcol)) + error("FAILED"); + endif + if (any(sol2 * granmat != smallcol')) + error("FAILED"); + endif + fprintf("PASSED\n"); + fprintf(" Signal Processing functions: "); + b = gf([1,0,0,1,0,1,0,1],m); + a = gf([1,0,1,1],m); + x = gf([1,zeros(1,99)],m); + y0 = filter(b, a, x); + y1 = conv(grow+1, grow); + y2 = grow * convmtx(grow+1, length(grow)); + if (any(y1 != y2)) + error("FAILED"); + endif + [y3,remd] = deconv(y2, grow+1); + if (any(y3 != grow)) + error("FAILED"); + endif + if (any(remd)) + error("FAILED"); + endif + alph = gf(2,m); + x = gf(floor(2^m*rand(n,1)),m); + fm = dftmtx(alph); + ifm = dftmtx(1/alph); + y0 = fft(x); + y1 = fm * x; + if (any(y0 != y1)) + error("FAILED"); + endif + z0 = ifft(y0); + z1 = ifm * y1; + if (any(z0 != x)) + error("FAILED"); + endif + if (any(z1 != x)) + error("FAILED"); + endif + fprintf("PASSED\n"); + + endif + fprintf("\n"); + unwind_protect_cleanup + page_screen_output(pso); + end_unwind_protect + else + usage("comms: Unknown argument"); + endif +endfunction + +%!test +%! try comms("test"); +%! catch disp(lasterr()); end diff --git a/octave_packages/communications-1.1.1/compand.m b/octave_packages/communications-1.1.1/compand.m new file mode 100644 index 0000000..8b3596f --- /dev/null +++ b/octave_packages/communications-1.1.1/compand.m @@ -0,0 +1,116 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} = } compand (@var{x}, @var{mu}, @var{V}, 'mu/compressor') +## @deftypefnx {Function File} {@var{y} = } compand (@var{x}, @var{mu}, @var{V}, 'mu/expander') +## @deftypefnx {Function File} {@var{y} = } compand (@var{x}, @var{mu}, @var{V}, 'A/compressor') +## @deftypefnx {Function File} {@var{y} = } compand (@var{x}, @var{mu}, @var{V}, 'A/expander') +## +## Compresses and expanding the dynamic range of a signal using a mu-law or +## or A-law algorithm. +## +## The mu-law compressor/expander for reducing the dynamic range, is used +## if the fourth argument of @dfn{compand} starts with 'mu/'. Whereas the +## A-law compressor/expander is used if @dfn{compand} starts with 'A/'. +## The mu-law algorithm uses the formulation +## +## @iftex +## @tex +## $$ +## y = {V log (1 + \\mu / V \\|x\\|) \\over log (1 + \\mu)} sgn(x) +## $$ +## @end tex +## @end iftex +## @ifinfo +## @example +## +## V log (1 + \mu/V |x|) +## y = -------------------- sgn(x) +## log (1 + \mu) +## +## @end example +## @end ifinfo +## +## while the A-law algorithm used the formulation +## +## @iftex +## @tex +## $$ +## y = { \\left\{ \\matrix{ {A / (1 + log A) x}, & 0 <= \\|x\\| <= V/A \\cr +## & \\cr +## {V log (1 + log(A/V \\|x\\|) ) \\over 1 + logA}, & +## V/A < \\|x\\| <= V} \\right. } +## $$ +## @end tex +## @end iftex +## @ifinfo +## @example +## +## / A / (1 + log A) x, 0 <= |x| <= V/A +## | +## y = < V ( 1 + log (A/V |x|) ) +## | ----------------------- sgn(x), V/A < |x| <= V +## \ 1 + log A +## @end example +## @end ifinfo +## +## Neither converts from or to audio file ulaw format. Use mu2lin or lin2mu +## instead. +## +## @end deftypefn +## @seealso{m2ulin, lin2mu} + +function y = compand(x, mu, V, stype) + + if (nargin != 3 && nargin != 4) + usage('y=compand(x,[mu|A],V,stype);'); + endif + if (nargin < 4) + stype = 'mu/compressor'; + else + stype = tolower(stype); + endif + + if strcmp(stype, 'mu/compressor') + y = (V/log(1+mu)) * log(1+(mu/V)*abs(x)) .* sign(x); + elseif strcmp(stype, 'mu/expander') + y = (V/mu) * ( exp (abs(x) * (log(1+mu)/V)) - 1 ) .* sign(x); + elseif strcmp(stype, 'a/compressor') + y = zeros(size(x)); + idx = find (abs(x) <= V/mu); + if (idx) + y(idx) = (mu/(1+log(mu))) * abs(x(idx)); + endif + idx = find (abs(x) > V/mu); + if (idx) + y(idx) = (V/(1+log(mu))) * (1 + log ((mu/V) * abs(x(idx)))); + endif + y = y .* sign(x); + elseif strcmp(stype, 'a/expander') + y = zeros(size(x)); + idx = find (abs(x) <= V/(1+log(mu))); + if (idx) + y(idx) = ((1+log(mu))/mu) * abs(x(idx)); + endif + idx = find (abs(x) > V/(1+log(mu))); + if (idx) + y(idx) = exp (((1+log(mu))/V) * abs(x(idx)) - 1) * (V/mu); + endif + y = y .* sign(x); + endif + +endfunction + diff --git a/octave_packages/communications-1.1.1/convenc.m b/octave_packages/communications-1.1.1/convenc.m new file mode 100644 index 0000000..ccbc222 --- /dev/null +++ b/octave_packages/communications-1.1.1/convenc.m @@ -0,0 +1,65 @@ +## Copyright (C) 2012 Tony Richardson +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} convenc (@var{m}, @var{G}, @var{k}) +## Compute output of an (n, @var{k}, L) convolutional encoder with vector input +## @var{m} and matrix of generator polynomials @var{G}. +## +## The input vector @var{m} can be of arbitrary length. @var{G} is a matrix with n rows +## and @var{k}*(L+1) columns. The rows of @var{G} are the generator polynomials for each +## of the n output bits (per @var{k} input bits). +## +## The output is a vector whose length is n*floor([length(@var{m})+@var{k}*(L+1)-1]/@var{k}). +## If unspecified, @var{k} defaults to 1. +## +## Example 1: Compute the output from a (2, 1, 2) convolutional encoder +## @example +## @group +## m = [ 1 1 0 1 1 1 0 0 1 0 0 0]; +## g1 = [1 1 1]; +## g2 = [1 0 1]; +## convenc (m, [g1; g2]) +## @result{} [1 1 0 1 0 1 0 0 0 1 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 0] +## @end group +## @end example +## +## Example 2: Compute the output from a (3, 2, 1) convolutional encoder +## @example +## @group +## m = [0 1 1 0 0 0 1 1 ]; +## g1 = [1 0 1 1]; +## g2 = [1 1 0 1]; +## g3 = [1 0 1 0]; +## convenc (m, [g1; g2; g3], 2) +## @result{} [1 1 1 1 1 1 1 1 0 1 0 1] +## @end group +## @end example +## +## @strong{Caution:}: this function is not compatible with @sc{matlab}'s convenc(). +## @end deftypefn + +function x = convenc (m, G, k = 1) + if (nargin < 2 || nargin > 3) + print_usage; + endif + + # Use conv2 to do repeated 1d convolutions of m with each row of G. + # rem is used to transform the standard convolution result to one + # which uses modulo-2 addition. Only cols with index a mult. of k + # are in the actual enc. output + + x = rem(conv2(1, m(:)', G),2)(:,!rem(1:numel(m),k))(:)'; +endfunction diff --git a/octave_packages/communications-1.1.1/cosets.m b/octave_packages/communications-1.1.1/cosets.m new file mode 100644 index 0000000..171cd0a --- /dev/null +++ b/octave_packages/communications-1.1.1/cosets.m @@ -0,0 +1,53 @@ +## Copyright (C) 2002 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cosets (@var{m}, @var{prim}) +## +## Finds the elements of GF(2^@var{m}) with primitive polynomial +## @var{prim}, that share the same minimum polynomial. Returns a +## cell array of the paratitioning of GF(2^@var{m}). +## @end deftypefn + +function c = cosets(m, prim) + + if (nargin == 1) + prim = 0; ## This flags to use default primitive + elseif (nargin != 2) + error ("usage: c = cosets (m [, prim])"); + endif + + n = 2^m-1; + found = zeros(1,n); + c{1} = gf(1,m,prim); + found(1) = 1; + nc = 2; + f = log(gf(1:n,m,prim)); + + while ((!all(found))) + t = find(!found); + idx = f(t(find(f(t) == min(f(t).x)))).x; + set = idx; + r = rem(idx*2,n); + while (r > idx) + set =[set,r]; + r = rem(r*2,n); + end + c{nc} = gf(sort(exp(gf(set,m,prim)).x),m,prim); + found(c{nc}.x) = ones(1,length(c{nc})); + nc = nc + 1; + end + +endfunction diff --git a/octave_packages/communications-1.1.1/de2bi.m b/octave_packages/communications-1.1.1/de2bi.m new file mode 100644 index 0000000..194d9b0 --- /dev/null +++ b/octave_packages/communications-1.1.1/de2bi.m @@ -0,0 +1,107 @@ +## Copyright (C) 2001 Laurent Mazet +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{b} = } de2bi (@var{d}) +## @deftypefnx {Function File} {@var{b} = } de2bi (@var{d},@var{n}) +## @deftypefnx {Function File} {@var{b} = } de2bi (@var{d},@var{n},@var{p}) +## @deftypefnx {Function File} {@var{b} = } de2bi (@var{d},@var{n},@var{p},@var{f}) +## +## Convert a non-negative integer to bit vector. +## +## The variable @var{d} must be a vector of non-negative integers. @dfn{de2bi} +## then returns a matrix where each row represents the binary representation +## of elements of @var{d}. If @var{n} is defined then the returned matrix +## will have @var{n} columns. This number of columns can be either larger +## than the minimum needed and zeros will be added to the msb of the +## binary representation or smaller than the minimum in which case the +## least-significant part of the element is returned. +## +## If @var{p} is defined then it is used as the base for the decomposition +## of the returned values. That is the elements of the returned value are +## between '0' and 'p-1'. +## +## The variable @var{f} defines whether the first or last element of @var{b} +## is considered to be the most-significant. Valid values of @var{f} are +## 'right-msb' or 'left-msb'. By default @var{f} is 'right-msb'. +## +## @seealso{bi2de} +## @end deftypefn + +function b = de2bi (d, n, p, f) + + if (nargin == 1) + p = 2; + n = floor ( log (max (max (d), 1)) ./ log (p) ) + 1; + f = 'right-msb'; + elseif (nargin == 2) + p = 2; + f = 'right-msb'; + elseif (nargin == 3) + if (ischar (p)) + f = p; + p = 2; + else + f = 'right-msb'; + endif + elseif (nargin == 4) + if (ischar (p)) + tmp = f; + f = p; + p = tmp; + endif + else + print_usage (); + endif + + d = d(:); + if ( any (d < 0) || any (d != floor (d)) ) + error ("de2bi: d must only contain non-negative integers"); + endif + + if (isempty (n)) + n = floor ( log (max (max (d), 1)) ./ log (p) ) + 1; + endif + + power = ones (length (d), 1) * (p .^ [0 : n-1] ); + d = d * ones (1, n); + b = floor (rem (d, p*power) ./ power); + + if (strcmp (f, 'left-msb')) + b = b(:,columns(b):-1:1); + elseif (!strcmp (f, 'right-msb')) + error ("de2bi: unrecognized flag"); + endif + +endfunction + + %!shared x + %! x = randi ([0 2^16-1], 100, 1); + %!assert (de2bi (0), 0) + %!assert (de2bi (1), 1) + %!assert (de2bi (255), ones (1, 8)) + %!assert (de2bi (255, [], 256), 255) + %!assert (de2bi (1023, 8, 8), [7 7 7 1 0 0 0 0]) + %!assert (size (de2bi (x, 16)), [100 16]) + %!assert (de2bi (x, 16, "right-msb"), de2bi (x, 16)) + %!assert (de2bi (x, 16, "left-msb"), fliplr (de2bi (x, 16))) + +%% Test input validation + %!error de2bi () + %!error de2bi (1, 2, 3, 4, 5) + %!error de2bi (1, 2, 3, 4) + %!error de2bi (1, 2, 3, "invalid") + %!error de2bi (0.1) + %!error de2bi (-1) diff --git a/octave_packages/communications-1.1.1/decode.m b/octave_packages/communications-1.1.1/decode.m new file mode 100644 index 0000000..8ab1633 --- /dev/null +++ b/octave_packages/communications-1.1.1/decode.m @@ -0,0 +1,282 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{msg} =} decode (@var{code},@var{n},@var{k}) +## @deftypefnx {Function File} {@var{msg} =} decode (@var{code},@var{n},@var{k},@var{typ}) +## @deftypefnx {Function File} {@var{msg} =} decode (@var{code},@var{n},@var{k},@var{typ},@var{opt1}) +## @deftypefnx {Function File} {@var{msg} =} decode (@var{code},@var{n},@var{k},@var{typ},@var{opt1},@var{opt2}) +## @deftypefnx {Function File} {[@var{msg}, @var{err}] =} decode (@var{...}) +## @deftypefnx {Function File} {[@var{msg}, @var{err}, @var{ccode}] =} decode (@var{...}) +## @deftypefnx {Function File} {[@var{msg}, @var{err}, @var{ccode}, @var{cerr}] =} decode (@var{...}) +## +## Top level block decoder. This function makes use of the lower level +## functions such as @dfn{cyclpoly}, @dfn{cyclgen}, @dfn{hammgen}, and +## @dfn{bchenco}. The coded message to decode is pass in @var{code}, the +## codeword length is @var{n} and the message length is @var{k}. This +## function is used to decode messages using either: +## +## @table @asis +## @item A [n,k] linear block code defined by a generator matrix +## @item A [n,k] cyclic code defined by a generator polynomial +## @item A [n,k] Hamming code defined by a primitive polynomial +## @item A [n,k] BCH code code defined by a generator polynomial +## @end table +## +## The type of coding to use is defined by the variable @var{typ}. This +## variable is a string taking one of the values +## +## @table @code +## @item 'linear' or 'linear/binary' +## A linear block code is assumed with the message @var{msg} being in a +## binary format. In this case the argument @var{opt1} is the generator +## matrix, and is required. Additionally, @var{opt2} containing the +## syndrome lookup table (see @dfn{syndtable}) can also be passed. +## @item 'cyclic' or 'cyclic/binary' +## A cyclic code is assumed with the message @var{msg} being in a binary +## format. The generator polynomial to use can be defined in @var{opt1}. +## The default generator polynomial to use will be +## @dfn{cyclpoly(@var{n},@var{k})}. Additionally, @var{opt2} containing the +## syndrome lookup table (see @dfn{syndtable}) can also be passed. +## @item 'hamming' or 'hamming/binary' +## A Hamming code is assumed with the message @var{msg} being in a binary +## format. In this case @var{n} must be of an integer of the form +## @code{2^@var{m}-1}, where @var{m} is an integer. In addition @var{k} +## must be @code{@var{n}-@var{m}}. The primitive polynomial to use can +## be defined in @var{opt1}. The default primitive polynomial to use is +## the same as defined by @dfn{hammgen}. The variable @var{opt2} should +## not be defined. +## @item 'bch' or 'bch/binary' +## A BCH code is assumed with the message @var{msg} being in a binary +## format. The primitive polynomial to use can be defined in @var{opt2}. +## The error correction capability of the code can also be defined in +## @var{opt1}. Use the empty matrix [] to let the error correction +## capability take the default value. +## @end table +## +## In addition the argument 'binary' above can be replaced with 'decimal', +## in which case the message is assumed to be a decimal vector, with each +## value representing a symbol to be coded. The binary format can be in two +## forms +## +## @table @code +## @item An @var{x}-by-@var{n} matrix +## Each row of this matrix represents a symbol to be decoded +## @item A vector with length divisible by @var{n} +## The coded symbols are created from groups of @var{n} elements of this vector +## @end table +## +## The decoded message is return in @var{msg}. The number of errors encountered +## is returned in @var{err}. If the coded message format is 'decimal' or a +## 'binary' matrix, then @var{err} is a column vector having a length equal +## to the number of decoded symbols. If @var{code} is a 'binary' vector, then +## @var{err} is the same length as @var{msg} and indicated the number of +## errors in each symbol. If the value @var{err} is positive it indicates the +## number of errors corrected in the corresponding symbol. A negative value +## indicates an uncorrectable error. The corrected code is returned in +## @var{ccode} in a similar format to the coded message @var{msg}. The +## variable @var{cerr} contains similar data to @var{err} for @var{ccode}. +## +## It should be noted that all internal calculations are performed in the +## binary format. Therefore for large values of @var{n}, it is preferable +## to use the binary format to pass the messages to avoid possible rounding +## errors. Additionally, if repeated calls to @dfn{decode} will be performed, +## it is often faster to create a generator matrix externally with the +## functions @dfn{hammgen} or @dfn{cyclgen}, rather than let @dfn{decode} +## recalculate this matrix at each iteration. In this case @var{typ} should +## be 'linear'. The exception to this case is BCH codes, where the required +## syndrome table is too large. The BCH decoder, decodes directly from the +## polynomial never explicitly forming the syndrome table. +## +## @end deftypefn +## @seealso{encode,cyclgen,cyclpoly,hammgen,bchdeco,bchpoly,syndtable} + +function [msg, err, ccode, cerr] = decode(code, n, k, typ, opt1, opt2) + + if ((nargin < 3) || (nargin > 6)) + usage ("[msg, err, ccode] = decode (code, n, k [, typ [, opt1 [, opt2]]])"); + endif + + if (!isscalar(n) || (n != floor(n)) || (n < 3)) + error ("decode: codeword length must be an integer greater than 3"); + endif + + if (!isscalar(k) || (k != floor(k)) || (k > n)) + error ("decode: message length must be an integer less than codeword length"); + endif + + if (nargin > 3) + if (!ischar(typ)) + error ("decode: type argument must be a string"); + else + ## Why the hell did matlab decide on such an ugly way of passing 2 args! + if (strcmp(typ,"linear") || strcmp(typ,"linear/binary")) + coding = "linear"; + msgtyp = "binary"; + elseif (strcmp(typ,"linear/decimal")) + coding = "linear"; + msgtyp = "decimal"; + elseif (strcmp(typ,"cyclic") || strcmp(typ,"cyclic/binary")) + coding = "cyclic"; + msgtyp = "binary"; + elseif (strcmp(typ,"cyclic/decimal")) + coding = "cyclic"; + msgtyp = "decimal"; + elseif (strcmp(typ,"bch") || strcmp(typ,"bch/binary")) + coding = "bch"; + msgtyp = "binary"; + elseif (strcmp(typ,"bch/decimal")) + coding = "bch"; + msgtyp = "decimal"; + elseif (strcmp(typ,"hamming") || strcmp(typ,"hamming/binary")) + coding = "hamming"; + msgtyp = "binary"; + elseif (strcmp(typ,"hamming/decimal")) + coding = "hamming"; + msgtyp = "decimal"; + else + error ("decode: unrecognized coding and/or message type"); + endif + endif + else + coding = "hamming"; + msgtyp = "binary"; + endif + + if (strcmp(msgtyp,"binary")) + vecttyp = 0; + if ((max(code(:)) > 1) || (min(code(:)) < 0)) + error ("decode: illegal value in message"); + endif + [ncodewords, n2] = size(code); + len = n2*ncodewords; + if ((n * floor(len/n)) != len) + error ("decode: coded message of incorrect length"); + endif + if (min(n2,ncodewords) == 1) + vecttyp = 1; + ncodewords = len / n; + code = reshape(code,n,ncodewords); + code = code'; + elseif (n2 != n) + error ("decode: coded message matrix must be n columns wide"); + endif + else + if (!isvector(code)) + error ("decode: decimally decoded message must be a vector"); + endif + if ((max(code) > 2^n-1) || (min(code) < 0)) + error ("decode: illegal value in message"); + endif + ncodewords = length(code); + code = de2bi(code(:),n); + endif + + if (strcmp(coding,"bch")) + if ((nargin < 5) || (isempty(opt1))) + tmp = bchpoly(n, k,"probe"); + t = tmp(3); + else + t = opt1; + endif + + if (nargin > 5) + [msg err ccode] = bchdeco(code,k,t,opt2); + else + [msg err ccode] = bchdeco(code,k,t); + endif + cerr = err; + else + if (strcmp(coding,"linear")) + if (nargin > 4) + gen = opt1; + if ((size(gen,1) != k) || (size(gen,2) != n)) + error ("decode: generator matrix is in incorrect form"); + endif + par = gen2par(gen); + if (nargin > 5) + st = opt2; + else + st = syndtable(par); + endif + else + error ("decode: linear coding must supply the generator matrix"); + endif + elseif (strcmp(coding,"cyclic")) + if (nargin > 4) + [par, gen] = cyclgen(n,opt1); + else + [par, gen] = cyclgen(n,cyclpoly(n,k)); + endif + if (nargin > 5) + ## XXX FIXME XXX Should we check that the generator polynomial is + ## consistent with the syndrome table. Where is the acceleration in + ## this case??? + st = opt2; + else + st = syndtable(par); + endif + else + m = log2(n + 1); + if ((m != floor(m)) || (m < 3) || (m > 16)) + error ("decode: codeword length must be of the form '2^m-1' with integer m"); + endif + if (k != (n-m)) + error ("decode: illegal message length for hamming code"); + endif + if (nargin > 4) + [par, gen] = hammgen(m, opt1); + else + [par, gen] = hammgen(m); + endif + if (nargin > 5) + error ("decode: illegal call for hamming coding"); + else + st = syndtable(par); + endif + endif + + errvec = st(bi2de((mod(par * code',2))',"left-msb")+1,:); + ccode = mod(code+errvec,2); + err = sum(errvec'); + cerr = err; + if (isequal(gen(:,1:k),eye(k))) + msg = ccode(:,1:k); + elseif (isequal(gen(:,n-k+1:n),eye(k))) + msg = ccode(:,n-k+1:n); + else + error ("decode: generator matrix must be in standard form"); + endif + endif + + if (strcmp(msgtyp,"binary") && (vecttyp == 1)) + msg = msg'; + msg = msg(:); + ccode = ccode'; + ccode = ccode(:); + err = ones(k,1) * err; + err = err(:); + cerr = ones(n,1) * cerr; + cerr = cerr(:); + else + err = err(:); + cerr = cerr(:); + if (strcmp(msgtyp,"decimal")) + msg = bi2de(msg); + ccode = bi2de(ccode); + endif + endif + +endfunction diff --git a/octave_packages/communications-1.1.1/deintrlv.m b/octave_packages/communications-1.1.1/deintrlv.m new file mode 100644 index 0000000..031451b --- /dev/null +++ b/octave_packages/communications-1.1.1/deintrlv.m @@ -0,0 +1,44 @@ +## Copyright (C) 2008 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{deintrlvd} =} deintrlv (@var{data}, @var{elements}) +## Restore elements of @var{data} according to @var{elements}. +## @seealso{intrlv} +## @end deftypefn + +function deintrlvd = deintrlv(data,elements) + if(nargin < 2 || nargin >2) + error('usage : deinterlvd = deinterlv(data,elements)'); + end + + if(~isvector(elements)) + error("Elements must be a vector"); + end + + ind = 1:length(elements); + invperm(elements) = ind; + + if(isvector(data)) + if(length(elements) ~= length(data) || any(sort(elements) ~= 1:length(data))) + error("elements must be a permutation of data indices"); + end + deintrlvd = data(invperm); + else + if(length(elements) ~= size(data,1) || any(sort(elements) ~= 1:size(data,1))) + error("elements must be a permutation of data indices"); + end + deintrlvd = data(invperm,:); + end diff --git a/octave_packages/communications-1.1.1/demodmap.m b/octave_packages/communications-1.1.1/demodmap.m new file mode 100644 index 0000000..415d435 --- /dev/null +++ b/octave_packages/communications-1.1.1/demodmap.m @@ -0,0 +1,240 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {z = } demodmap (@var{y},@var{fd},@var{fs},'ask',@var{m}) +## @deftypefnx {Function File} {z = } demodmap (@var{y},@var{fd},@var{fs},'fsk',@var{m},@var{tone}) +## @deftypefnx {Function File} {z = } demodmap (@var{y},@var{fd},@var{fs},'msk') +## @deftypefnx {Function File} {z = } demodmap (@var{y},@var{fd},@var{fs},'psk',@var{m}) +## @deftypefnx {Function File} {z = } demodmap (@var{y},@var{fd},@var{fs},'qask',@var{m}) +## @deftypefnx {Function File} {z = } demodmap (@var{y},@var{fd},@var{fs},'qask/cir',@var{nsig},@var{amp},@var{phs}) +## @deftypefnx {Function File} {z = } demodmap (@var{y},@var{fd},@var{fs},'qask/arb',@var{inphase},@var{quadr}) +## @deftypefnx {Function File} {z = } demodmap (@var{y},@var{fd},@var{fs},'qask/arb',@var{map}) +## @deftypefnx {Function File} {z = } demodmap (@var{y},[@var{fd}, @var{off}],@var{...}) +## +## Demapping of an analog signal to a digital signal. The function +## @dfn{demodmap} must have at least three input arguments and one +## output argument. Argument @var{y} is a complex variable representing +## the analog signal to be demapped. The variables @var{fd} and @var{fs} are +## the sampling rate of the of digital signal and the sampling rate of the +## analog signal respectively. It is required that @code{@var{fs}/@var{fd}} +## is an integer. +## +## The available mapping of the digital signal are +## +## @table @asis +## @item 'ask' +## Amplitude shift keying +## @item 'fsk' +## Frequency shift keying +## @item 'msk' +## Minimum shift keying +## @item 'psk' +## Phase shift keying +## @item 'qask' +## @itemx 'qsk' +## @itemx 'qam' +## Quadraure amplitude shift keying +## @end table +## +## In addition the 'qask', 'qsk' and 'qam' method can be modified with the +## flags '/cir' or '/arb'. That is 'qask/cir' and 'qask/arb', etc are valid +## methods and give circular- and arbitrary-qask mappings respectively. Also +## the method 'fsk' and 'msk' can be modified with the flag '/max', in +## which case @var{y} is assumed to be a matrix with @var{m} columns, +## representing the symbol correlations. +## +## The variable @var{m} is the order of the modulation to use. By default +## this is 2, and in general should be specified. +## +## For 'qask/cir', the additional arguments are the same as for +## @dfn{apkconst}, and you are referred to @dfn{apkconst} for the definitions +## of the additional variables. +## +## For 'qask/arb', the additional arguments @var{inphase} and @var{quadr} give +## the in-phase and quadrature components of the mapping, in a similar mapping +## to the outputs of @dfn{qaskenco} with one argument. Similar @var{map} +## represents the in-phase and quadrature components of the mapping as +## the real and imaginary parts of the variable @var{map}. +## @end deftypefn +## @seealso{modmap,ddemodce,ademodce,apkconst,qaskenco} + +function z = demodmap (y, fd, fs, varargin) + + if (nargin < 3) + error ("demodmap: too few arguments"); + endif + + if (!isscalar(fs) || !isreal(fs) || !isreal(fd) ||(fs <= 0) || (fd <= 0)) + error ("demodmap: sampling rates must be positive real values"); + endif + if (abs(fs/fd - floor(fs/fd)) > eps) + error ("demodmap: the sample rate Fs must be an integer multiple of Fd"); + endif + + if (!isscalar(fd)) + if (isequal(size(fd),[1,2])) + off = fd(2); + fd = fd(1); + else + error ("demodmap: sampling rate Fd must be a scalar or two-element row-vector"); + endif + else + off = 0; + endif + + if (nargin > 3) + method = varargin{1}; + if (!ischar(method) || (!strcmp(method,"ask") && ... + isempty(findstr(method,"msk")) && isempty(findstr(method,"fsk")) && ... + isempty(findstr(method,"samp")) && !strcmp(method,"psk") && ... + !strcmp(method,"qask") && !strcmp(method,"qam") && ... + !strcmp(method,"qsk") && !strcmp(method,"qask/cir") && ... + !strcmp(method,"qam/cir") && !strcmp(method,"qsk/cir") && ... + !strcmp(method,"qask/arb") && !strcmp(method,"qam/arb") && ... + !strcmp(method,"qsk/arb"))) + error ("modmap: unknown mapping method"); + endif + else + method = "sample"; + endif + + if (!isreal(off) || (off < 0) || (off != floor(off)) || ... + (off >= fs/fd)) + error ("demodmap: offset must be an integer in the range [0, Fs/Fd)"); + endif + if (off == 0) + off = round(fs/fd); + endif + + if (min(size(y)) == 1) + y = y(off:round(fs/fd):length(y)); + else + y = y(off:round(fs/fd):size(y,1),:); + endif + + if (strcmp(method,"ask") || !isempty(findstr(method,"fsk")) || ... + strcmp(method,"psk") || strcmp(method,"qask") || ... + strcmp(method,"qam") || strcmp(method,"qsk")) + if (nargin > 4) + M = varargin{2}; + else + M = 2; + endif + if (!isempty(findstr(method,"fsk")) && (nargin > 5)) + error ("demodmap: too many arguments"); + endif + endif + + z = []; + if (!isempty(findstr(method,"fsk")) || !isempty(findstr(method,"msk"))) + if (findstr(method,"msk")) + if (nargin > 4) + error ("demodmap: too many arguments"); + endif + M = 2; + tone = fd/2; + else + if (nargin > 5) + tone = varargin{3}; + else + tone = fd; + endif + if (nargin > 6) + error ("demodmap: too many arguments"); + endif + endif + + if (findstr(method,"/max")) + if (size(y,2) != M) + error ("demodmap: when using correlation must have M columns"); + endif + ## We have an M-column maximum from which with pick index of the maximum + ## value in each row as the decoded value + [a, b] = max(y'); + z = (b - 1)'; + else + c = [0:M-1]*tone; + endif + elseif (strcmp(method,"ask")) + if (floor(M/2) == M/2) + c = [ -2*([M/2:-1:1]-0.5)/(M-1), 2*([1:M/2]-0.5)/(M-1)]; + else + c = [ -2*([floor(M/2):-1:1])/(M-1), 0, 2*([1:floor(M/2)])/(M-1)]; + endif + elseif (strcmp(method,"psk")) + c = apkconst(M,[],[]); + elseif (!isempty(findstr(method,"qask")) || ... + !isempty(findstr(method,"qsk")) || ... + !isempty(findstr(method,"qam"))) + if (findstr(method,"/cir")) + nsig = 2; + amp = []; + phs = []; + if (nargin > 4) + nsig = varargin{2}; + if (!isvector(nsig)) + error ("modmap: invalid number of constellation point in qask/cir"); + endif + endif + if (nargin > 5) + amp = varargin{3}; + endif + if (nargin > 6) + phs = varargin{4}; + endif + c = apkconst(nsig,amp,phs); + M = length(c); + elseif (findstr(method,"/arb")) + if (nargin == 4) + c = qaskenco(2); + elseif (nargin == 5) + c = varargin{2}; + elseif (nargin == 6) + inphase = varargin{2}; + quadr = varargin{3}; + c = inphase + 1i*quadr; + elseif (nargin > 6) + error ("demodmap: too many arguments"); + endif + M = length(c); + else + ## Could do "c = qaskenco(M)", but qaskdeco's speed is not dependent + ## on M, while speed of code below is O(M). + z = qaskdeco(y,M); + endif + endif + + ## Have we decoded yet? If not have a mapping that we can use. + if (isempty(z)) + c = c(:); + z = zeros(size(y)); + if (size(y,1) == 1) + [a, b] = min(abs(repmat(y(:).',M,1) - repmat(c,1,size(y,2)))); + z = b - 1; + elseif (size(y,1) == 1) + [a, b] = min(abs(repmat(y(:),M,1) - repmat(c,1,size(y,1)))); + z = (b - 1).'; + else + for i=1:size(y,1) + [a, b] = min(abs(repmat(y(i,:),M,1) - repmat(c,1,size(y,2)))); + z(i,:) = b - 1; + end + endif + endif + +endfunction + + diff --git a/octave_packages/communications-1.1.1/doc-cache b/octave_packages/communications-1.1.1/doc-cache new file mode 100644 index 0000000..87724a6 --- /dev/null +++ b/octave_packages/communications-1.1.1/doc-cache @@ -0,0 +1,3942 @@ +# Created by Octave 3.6.1, Mon May 21 07:07:01 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 88 +# name: +# type: sq_string +# elements: 1 +# length: 8 +ademodce + + +# name: +# type: sq_string +# elements: 1 +# length: 2038 + -- Function File: Y = ademodce (X,FS,'amdsb-tc',offset) + -- Function File: Y = ademodce (X,FS,'amdsb-tc/costas',offset) + -- Function File: Y = ademodce (X,FS,'amdsb-sc') + -- Function File: Y = ademodce (X,FS,'amdsb-sc/costas') + -- Function File: Y = ademodce (X,FS,'amssb') + -- Function File: Y = ademodce (X,FS,'qam') + -- Function File: Y = ademodce (X,FS,'qam/cmplx') + -- Function File: Y = ademodce (X,FS,'fm',DEV) + -- Function File: Y = ademodce (X,FS,'pm',DEV) + -- Function File: Y = ademodce (X,[FS,IPHS],...) + -- Function File: Y = ademodce (...,NUM,DEN) + Baseband demodulator for analog signals. The input signal is + specified by X, its sampling frequency by FS and the type of + modulation by the third argument, TYP. The default values of FS is + 1 and TYP is 'amdsb-tc'. + + If the argument FS is a two element vector, the the first element + represents the sampling rate and the second the initial phase. + + The different types of demodulations that are available are + + 'am' + 'amdsb-tc' + Double-sideband with carrier + + 'amdsb-tc/costas' + Double-sideband with carrier and Costas phase locked loop + + 'amdsb-sc' + Double-sideband with suppressed carrier + + 'amssb' + Single-sideband with frequency domain Hilbert filtering + + 'qam' + Quadrature amplitude demodulation. In-phase in odd-columns + and quadrature in even-columns + + 'qam/cmplx' + Quadrature amplitude demodulation with complex return value. + + 'fm' + Frequency demodulation + + 'pm' + Phase demodulation + + Additional arguments are available for the demodulations + 'amdsb-tc', 'fm', 'pm'. These arguments are + + `offset' + The offset in the input signal for the transmitted carrier. + + `dev' + The deviation of the phase and frequency modulation + + It is possible to specify a low-pass filter, by the numerator NUM + and denominator DEN that will be applied to the returned vector. + + + See also: ademodce, dmodce + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Baseband demodulator for analog signals. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +amdemod + + +# name: +# type: sq_string +# elements: 1 +# length: 191 + -- Function File: [M] = amdemod (S, FC, FS) + Compute the amplitude demodulation of the signal S with a carrier + frequency of FC and a sample frequency of FS. + + See also: ammod + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the amplitude demodulation of the signal S with a carrier +frequency of F + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ammod + + +# name: +# type: sq_string +# elements: 1 +# length: 190 + -- Function File: ammod (X,FC,FS) + Create the AM modulation of the signal x with carrier frequency + fs. Where x is sample at frequency fs. + + See also: amdemod, fmmod, fmdemod + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 +Create the AM modulation of the signal x with carrier frequency fs. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +amodce + + +# name: +# type: sq_string +# elements: 1 +# length: 1785 + -- Function File: Y = amodce (X,FS,'amdsb-tc',offset) + -- Function File: Y = amodce (X,FS,'amdsb-sc') + -- Function File: Y = amodce (X,FS,'amssb') + -- Function File: Y = amodce (X,FS,'amssb/time',NUM,DEN) + -- Function File: Y = amodce (X,FS,'qam') + -- Function File: Y = amodce (X,FS,'fm',DEV) + -- Function File: Y = amodce (X,FS,'pm',DEV) + -- Function File: Y = amodce (X,[FS,IPHS],...) + Baseband modulator for analog signals. The input signal is + specified by X, its sampling frequency by FS and the type of + modulation by the third argument, TYP. The default values of FS is + 1 and TYP is 'amdsb-tc'. + + If the argument FS is a two element vector, the the first element + represents the sampling rate and the second the initial phase. + + The different types of modulations that are available are + + 'am' + 'amdsb-tc' + Double-sideband with carrier + + 'amdsb-sc' + Double-sideband with suppressed carrier + + 'amssb' + Single-sideband with frequency domain Hilbert filtering + + 'amssb/time' + Single-sideband with time domain filtering. Hilbert filter is + used by default, but the filter can be specified + + 'qam' + Quadrature amplitude modulation + + 'fm' + Frequency modulation + + 'pm' + Phase modulation + + Additional arguments are available for the modulations 'amdsb-tc', + 'fm, 'pm' and 'amssb/time'. These arguments are + + `offset' + The offset in the input signal for the transmitted carrier. + + `dev' + The deviation of the phase and frequency modulation + + `num' + `den' + The numerator and denominator of the filter transfer function + for the time domain filtering of the SSB modulation + + + See also: ademodce, dmodce + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Baseband modulator for analog signals. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +apkconst + + +# name: +# type: sq_string +# elements: 1 +# length: 1624 + -- Function File: apkconst (NSIG) + -- Function File: apkconst (NSIG,AMP) + -- Function File: apkconst (NSIG,AMP,PHS) + -- Function File: apkconst (...,"n") + -- Function File: apkconst (...,STR) + -- Function File: Y = apkconst (...) + Plots a ASK/PSK signal constellation. Argument NSIG is a real + vector whose length determines the number of ASK radii in the + constellation. The values of vector NSIG determine the number of + points in each ASK radii. + + By default the radii of each ASK modulated level is given by the + index of NSIG. The amplitudes can be defined explictly in the + variable AMP, which is a vector of the same length as NSIG. + + By default the first point in each ASK radii has zero phase, and + following points are coding in an anti-clockwise manner. If PHS is + defined then it is a vector of the same length as NSIG defining + the initial phase in each ASK radii. + + In addition "apkconst" takes two string arguments 'n' and and STR. + If the string 'n' is included in the arguments, then a number is + printed next to each constellation point giving the symbol value + that would be mapped to this point by the "modmap" function. The + argument STR is a plot style string (example 'r+') and determines + the default gnuplot point style to use for plot points in the + constellation. + + If "apskconst" is called with a return argument, then no plot is + created. However the return value is a vector giving the in-phase + and quadrature values of the symbols in the constellation. + + See also: dmod, ddemod, modmap, demodmap + + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 +Plots a ASK/PSK signal constellation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +awgn + + +# name: +# type: sq_string +# elements: 1 +# length: 1122 + -- Function File: Y = awgn (X,SNR) + -- Function File: Y = awgn (X,SNR,PWR) + -- Function File: Y = awgn (X,SNR, PWR,SEED) + -- Function File: Y = awgn (..., 'TYPE') + Add white Gaussian noise to a voltage signal. + + The input X is assumed to be a real or complex voltage signal. The + returned value Y will be the same form and size as X but with + Gaussian noise added. Unless the power is specified in PWR, the + signal power is assumed to be 0dBW, and the noise of SNR dB will be + added with respect to this. If PWR is a numeric value then the + signal X is assumed to be PWR dBW, otherwise if PWR is 'measured', + then the power in the signal will be measured and the noise added + relative to this measured power. + + If SEED is specified, then the random number generator seed is + initialized with this value + + By default the SNR and PWR are assumed to be in dB and dBW + respectively. This default behaviour can be chosen with TYPE set + to 'dB'. In the case where TYPE is set to 'linear', PWR is assumed + to be in Watts and SNR is a ratio. + + See also: randn, wgn + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Add white Gaussian noise to a voltage signal. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +bchpoly + + +# name: +# type: sq_string +# elements: 1 +# length: 3093 + -- Function File: P = bchpoly () + -- Function File: P = bchpoly (N) + -- Function File: P = bchpoly (N,K) + -- Function File: P = bchpoly (PRIM,K) + -- Function File: P = bchpoly (N,K,PRIM) + -- Function File: P = bchpoly (...,PROBE) + -- Function File: [P,F] = bchpoly (...) + -- Function File: [P,F,C] = bchpoly (...) + -- Function File: [P,F,C,PAR] = bchpoly (...) + -- Function File: [P,F,C,PAR,T] = bchpoly (...) + Calculates the generator polynomials for a BCH coder. Called with + no input arguments "bchpoly" returns a list of all of the valid + BCH codes for the codeword length 7, 15, 31, 63, 127, 255 and 511. + A three column matrix is returned with each row representing a + seperate valid BCH code. The first column is the codeword length, + the second the message length and the third the error correction + capability of the code. + + Called with a single input argument, "bchpoly" returns the valid + BCH codes for the specified codeword length N. The output format + is the same as above. + + When called with two or more arguments, "bchpoly" calculates the + generator polynomial of a particular BCH code. The generator + polynomial is returned in P as a vector representation of a + polynomial in GF(2). The terms of the polynomial are listed + least-significant term first. + + The desired BCH code can be specified by its codeword length N and + its message length K. Alternatively, the primitive polynomial over + which to calculate the polynomial can be specified as PRIM. If a + vector representation of the primitive polynomial is given, then + PRIM can be specified as the first argument of two arguments, or + as the third argument. However, if an integer representation of the + primitive polynomial is used, then the primitive polynomial must be + specified as the third argument. + + When called with two or more arguments, "bchpoly" can also return + the factors F of the generator polynomial P, the cyclotomic coset + for the Galois field over which the BCH code is calculated, the + parity check matrix PAR and the error correction capability T. It + should be noted that the parity check matrix is calculated with + "cyclgen" and limitations in this function means that the parity + check matrix is only available for codeword length upto 63. For + codeword length longer than this PAR returns an empty matrix. + + With a string argument PROBE defined, the action of "bchpoly" is + to calculate the error correcting capability of the BCH code + defined by N, K and PRIM and return it in P. This is similar to a + call to "bchpoly" with zero or one argument, except that only a + single code is checked. Any string value for PROBE will force this + action. + + In general the codeword length N can be expressed as `2^M-1', + where M is an integer. However, if [N,K] is a valid BCH code, then + a shortened BCH code of the form [N-X,K-X] can be created with the + same generator polynomial + + + See also: cyclpoly, encode, decode, cosets + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Calculates the generator polynomials for a BCH coder. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +bi2de + + +# name: +# type: sq_string +# elements: 1 +# length: 695 + -- Function File: D = bi2de (B) + -- Function File: D = bi2de (B,F) + -- Function File: D = bi2de (B,P) + -- Function File: D = bi2de (B,P,F) + Convert bit matrix to a vector of integers + + Each row of the matrix B is treated as a single integer represented + in binary form. The elements of B, must therefore be '0' or '1' + + If P is defined then it is treated as the base of the decomposition + and the elements of B must then lie between '0' and 'p-1'. + + The variable F defines whether the first or last element of B is + considered to be the most-significant. Valid values of F are + 'right-msb' or 'left-msb'. By default F is 'right-msb'. + + See also: de2bi + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Convert bit matrix to a vector of integers + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +biterr + + +# name: +# type: sq_string +# elements: 1 +# length: 1878 + -- Function File: [NUM, RATE] = biterr (A,B) + -- Function File: [NUM, RATE] = biterr (...,K) + -- Function File: [NUM, RATE] = biterr (...,FLAG) + -- Function File: [NUM, RATE IND] = biterr (...) + Compares two matrices and returns the number of bit errors and the + bit error rate. The binary representations of the variables A and + B are treated and A and B can be either: + + Both matrices + In this case both matrices must be the same size and then by + default the the return values NUM and RATE are the overall + number of bit errors and the overall bit error rate. + + One column vector + In this case the column vector is used for bit error + comparision column-wise with the matrix. The returned values + NUM and RATE are then row vectors containing the num of bit + errors and the bit error rate for each of the column-wise + comparisons. The number of rows in the matrix must be the + same as the length of the column vector + + One row vector + In this case the row vector is used for bit error comparision + row-wise with the matrix. The returned values NUM and RATE + are then column vectors containing the num of bit errors and + the bit error rate for each of the row-wise comparisons. The + number of columns in the matrix must be the same as the + length of the row vector + + This behaviour can be overridden with the variable FLAG. FLAG can + take the value 'column-wise', 'row-wise' or 'overall'. A + column-wise comparision is not possible with a row vector and + visa-versa. + + By default the number of bits in each symbol is assumed to be give + by the number required to represent the maximum value of A and B. + The number of bits to represent a symbol can be overridden by the + variable K. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compares two matrices and returns the number of bit errors and the bit +error rat + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +bsc + + +# name: +# type: sq_string +# elements: 1 +# length: 134 + -- Function File: Y = bsc (DATA, P) + Send DATA into a binary symetric channel with probability P of + error one each symbol. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Send DATA into a binary symetric channel with probability P of error +one each sy + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +comms + + +# name: +# type: sq_string +# elements: 1 +# length: 1433 + -- Function File: comms ('help') + -- Function File: comms ('info') + -- Function File: comms ('info', MOD) + -- Function File: comms ('test') + -- Function File: comms ('test', MOD) + Manual and test code for the Octave Communications toolbox. There + are 5 possible ways to call this function. + + `comms ('help')' + Display this help message. Called with no arguments, this + function also displays this help message + + `comms ('info')' + Open the Commumications toolbox manual + + `comms ('info', MOD)' + Open the Commumications toolbox manual at the section + specified by MOD + + `comms ('test')' + Run all of the test code for the Communications toolbox. + + `comms ('test', MOD)' + Run only the test code for the Communications toolbox in the + module MOD. + + Valid values for the varibale MOD are + + 'all' + All of the toolbox + + 'random' + The random signal generation and analysis package + + 'source' + The source coding functions of the package + + 'block' + The block coding functions + + 'convol' + The convolution coding package + + 'modulation' + The modulation package + + 'special' + The special filter functions + + 'galois' + The Galois fields package + + Please note that this function file should be used as an example + of the use of this toolbox. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 +Manual and test code for the Octave Communications toolbox. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +compand + + +# name: +# type: sq_string +# elements: 1 +# length: 1154 + -- Function File: Y = compand (X, MU, V, 'mu/compressor') + -- Function File: Y = compand (X, MU, V, 'mu/expander') + -- Function File: Y = compand (X, MU, V, 'A/compressor') + -- Function File: Y = compand (X, MU, V, 'A/expander') + Compresses and expanding the dynamic range of a signal using a + mu-law or or A-law algorithm. + + The mu-law compressor/expander for reducing the dynamic range, is + used if the fourth argument of "compand" starts with 'mu/'. + Whereas the A-law compressor/expander is used if "compand" starts + with 'A/'. The mu-law algorithm uses the formulation + + + V log (1 + \mu/V |x|) + y = -------------------- sgn(x) + log (1 + \mu) + + while the A-law algorithm used the formulation + + + / A / (1 + log A) x, 0 <= |x| <= V/A + | + y = < V ( 1 + log (A/V |x|) ) + | ----------------------- sgn(x), V/A < |x| <= V + \ 1 + log A + + Neither converts from or to audio file ulaw format. Use mu2lin or + lin2mu instead. + + + See also: m2ulin, lin2mu + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compresses and expanding the dynamic range of a signal using a mu-law or +or A-la + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +convenc + + +# name: +# type: sq_string +# elements: 1 +# length: 1121 + -- Function File: X = convenc (M, G, K) + Compute output of an (n, K, L) convolutional encoder with vector + input M and matrix of generator polynomials G. + + The input vector M can be of arbitrary length. G is a matrix with + n rows and K*(L+1) columns. The rows of G are the generator + polynomials for each of the n output bits (per K input bits). + + The output is a vector whose length is + n*floor([length(M)+K*(L+1)-1]/K). If unspecified, K defaults to 1. + + Example 1: Compute the output from a (2, 1, 2) convolutional + encoder + m = [ 1 1 0 1 1 1 0 0 1 0 0 0]; + g1 = [1 1 1]; + g2 = [1 0 1]; + convenc (m, [g1; g2]) + => [1 1 0 1 0 1 0 0 0 1 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 0] + + Example 2: Compute the output from a (3, 2, 1) convolutional + encoder + m = [0 1 1 0 0 0 1 1 ]; + g1 = [1 0 1 1]; + g2 = [1 1 0 1]; + g3 = [1 0 1 0]; + convenc (m, [g1; g2; g3], 2) + => [1 1 1 1 1 1 1 1 0 1 0 1] + + *Caution:*: this function is not compatible with MATLAB's + convenc(). + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute output of an (n, K, L) convolutional encoder with vector input +M and mat + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +cosets + + +# name: +# type: sq_string +# elements: 1 +# length: 209 + -- Function File: cosets (M, PRIM) + Finds the elements of GF(2^M) with primitive polynomial PRIM, that + share the same minimum polynomial. Returns a cell array of the + paratitioning of GF(2^M). + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Finds the elements of GF(2^M) with primitive polynomial PRIM, that +share the sam + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +de2bi + + +# name: +# type: sq_string +# elements: 1 +# length: 1082 + -- Function File: B = de2bi (D) + -- Function File: B = de2bi (D,N) + -- Function File: B = de2bi (D,N,P) + -- Function File: B = de2bi (D,N,P,F) + Convert a non-negative integer to bit vector. + + The variable D must be a vector of non-negative integers. "de2bi" + then returns a matrix where each row represents the binary + representation of elements of D. If N is defined then the returned + matrix will have N columns. This number of columns can be either + larger than the minimum needed and zeros will be added to the msb + of the binary representation or smaller than the minimum in which + case the least-significant part of the element is returned. + + If P is defined then it is used as the base for the decomposition + of the returned values. That is the elements of the returned value + are between '0' and 'p-1'. + + The variable F defines whether the first or last element of B is + considered to be the most-significant. Valid values of F are + 'right-msb' or 'left-msb'. By default F is 'right-msb'. + + See also: bi2de + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Convert a non-negative integer to bit vector. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +decode + + +# name: +# type: sq_string +# elements: 1 +# length: 4528 + -- Function File: MSG = decode (CODE,N,K) + -- Function File: MSG = decode (CODE,N,K,TYP) + -- Function File: MSG = decode (CODE,N,K,TYP,OPT1) + -- Function File: MSG = decode (CODE,N,K,TYP,OPT1,OPT2) + -- Function File: [MSG, ERR] = decode (...) + -- Function File: [MSG, ERR, CCODE] = decode (...) + -- Function File: [MSG, ERR, CCODE, CERR] = decode (...) + Top level block decoder. This function makes use of the lower level + functions such as "cyclpoly", "cyclgen", "hammgen", and "bchenco". + The coded message to decode is pass in CODE, the codeword length + is N and the message length is K. This function is used to decode + messages using either: + + A [n,k] linear block code defined by a generator matrix + + A [n,k] cyclic code defined by a generator polynomial + + A [n,k] Hamming code defined by a primitive polynomial + + A [n,k] BCH code code defined by a generator polynomial + + The type of coding to use is defined by the variable TYP. This + variable is a string taking one of the values + + `'linear' or 'linear/binary'' + A linear block code is assumed with the message MSG being in a + binary format. In this case the argument OPT1 is the generator + matrix, and is required. Additionally, OPT2 containing the + syndrome lookup table (see "syndtable") can also be passed. + + `'cyclic' or 'cyclic/binary'' + A cyclic code is assumed with the message MSG being in a + binary format. The generator polynomial to use can be defined + in OPT1. The default generator polynomial to use will be + "cyclpoly(N,K)". Additionally, OPT2 containing the syndrome + lookup table (see "syndtable") can also be passed. + + `'hamming' or 'hamming/binary'' + A Hamming code is assumed with the message MSG being in a + binary format. In this case N must be of an integer of the + form `2^M-1', where M is an integer. In addition K must be + `N-M'. The primitive polynomial to use can be defined in + OPT1. The default primitive polynomial to use is the same as + defined by "hammgen". The variable OPT2 should not be defined. + + `'bch' or 'bch/binary'' + A BCH code is assumed with the message MSG being in a binary + format. The primitive polynomial to use can be defined in + OPT2. The error correction capability of the code can also + be defined in OPT1. Use the empty matrix [] to let the error + correction capability take the default value. + + In addition the argument 'binary' above can be replaced with + 'decimal', in which case the message is assumed to be a decimal + vector, with each value representing a symbol to be coded. The + binary format can be in two forms + + `An X-by-N matrix' + Each row of this matrix represents a symbol to be decoded + + `A vector with length divisible by N' + The coded symbols are created from groups of N elements of + this vector + + The decoded message is return in MSG. The number of errors + encountered is returned in ERR. If the coded message format is + 'decimal' or a 'binary' matrix, then ERR is a column vector having + a length equal to the number of decoded symbols. If CODE is a + 'binary' vector, then ERR is the same length as MSG and indicated + the number of errors in each symbol. If the value ERR is positive + it indicates the number of errors corrected in the corresponding + symbol. A negative value indicates an uncorrectable error. The + corrected code is returned in CCODE in a similar format to the + coded message MSG. The variable CERR contains similar data to ERR + for CCODE. + + It should be noted that all internal calculations are performed in + the binary format. Therefore for large values of N, it is + preferable to use the binary format to pass the messages to avoid + possible rounding errors. Additionally, if repeated calls to + "decode" will be performed, it is often faster to create a + generator matrix externally with the functions "hammgen" or + "cyclgen", rather than let "decode" recalculate this matrix at + each iteration. In this case TYP should be 'linear'. The exception + to this case is BCH codes, where the required syndrome table is + too large. The BCH decoder, decodes directly from the polynomial + never explicitly forming the syndrome table. + + + See also: encode, cyclgen, cyclpoly, hammgen, bchdeco, bchpoly, +syndtable + + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +Top level block decoder. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +deintrlv + + +# name: +# type: sq_string +# elements: 1 +# length: 135 + -- Function File: DEINTRLVD = deintrlv (DATA, ELEMENTS) + Restore elements of DATA according to ELEMENTS. + + See also: intrlv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Restore elements of DATA according to ELEMENTS. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +demodmap + + +# name: +# type: sq_string +# elements: 1 +# length: 2342 + -- Function File: z = demodmap (Y,FD,FS,'ask',M) + -- Function File: z = demodmap (Y,FD,FS,'fsk',M,TONE) + -- Function File: z = demodmap (Y,FD,FS,'msk') + -- Function File: z = demodmap (Y,FD,FS,'psk',M) + -- Function File: z = demodmap (Y,FD,FS,'qask',M) + -- Function File: z = demodmap (Y,FD,FS,'qask/cir',NSIG,AMP,PHS) + -- Function File: z = demodmap (Y,FD,FS,'qask/arb',INPHASE,QUADR) + -- Function File: z = demodmap (Y,FD,FS,'qask/arb',MAP) + -- Function File: z = demodmap (Y,[FD, OFF],...) + Demapping of an analog signal to a digital signal. The function + "demodmap" must have at least three input arguments and one output + argument. Argument Y is a complex variable representing the analog + signal to be demapped. The variables FD and FS are the sampling + rate of the of digital signal and the sampling rate of the analog + signal respectively. It is required that `FS/FD' is an integer. + + The available mapping of the digital signal are + + 'ask' + Amplitude shift keying + + 'fsk' + Frequency shift keying + + 'msk' + Minimum shift keying + + 'psk' + Phase shift keying + + 'qask' + 'qsk' + 'qam' + Quadraure amplitude shift keying + + In addition the 'qask', 'qsk' and 'qam' method can be modified + with the flags '/cir' or '/arb'. That is 'qask/cir' and + 'qask/arb', etc are valid methods and give circular- and + arbitrary-qask mappings respectively. Also the method 'fsk' and + 'msk' can be modified with the flag '/max', in which case Y is + assumed to be a matrix with M columns, representing the symbol + correlations. + + The variable M is the order of the modulation to use. By default + this is 2, and in general should be specified. + + For 'qask/cir', the additional arguments are the same as for + "apkconst", and you are referred to "apkconst" for the definitions + of the additional variables. + + For 'qask/arb', the additional arguments INPHASE and QUADR give + the in-phase and quadrature components of the mapping, in a + similar mapping to the outputs of "qaskenco" with one argument. + Similar MAP represents the in-phase and quadrature components of + the mapping as the real and imaginary parts of the variable MAP. + + See also: modmap, ddemodce, ademodce, apkconst, qaskenco + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Demapping of an analog signal to a digital signal. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +egolaydec + + +# name: +# type: sq_string +# elements: 1 +# length: 1044 + -- Function File: egolaydec (R) + Given R, the received Extended Golay code, this function tries to + decode R using the Extended Golay code parity check matrix. + Extended Golay code (24,12) which can correct upto 3 errors. + + The received code R, needs to be of length Nx24, for encoding. We + can decode several codes at once, if they are stacked as a matrix + of 24columns, each code in a separate row. + + The generator G used in here is same as obtained from the function + egolaygen. + + The function returns the error-corrected code word from the + received word. If decoding failed, the second return value is 1, + otherwise it is 0. + + Extended Golay code (24,12) which can correct upto 3 errors. + Decoding algorithm follows from Lin & Costello. + + Ref: Lin & Costello, pg 128, Ch4, 'Error Control Coding', 2nd ed, + Pearson. + + M=[rand(10,12)>0.5]; + C1=egolayenc(M); + C1(:,1)=mod(C1(:,1)+1,2) + C2=egolaydec(C1) + + + See also: egolaygen, egolayenc + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Given R, the received Extended Golay code, this function tries to +decode R using + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +egolayenc + + +# name: +# type: sq_string +# elements: 1 +# length: 505 + -- Function File: egolayenc (M) + Given M, encode M using the Extended Golay code. + + The message M, needs to be of size Nx12, for encoding. We can + encode several messages, into codes at once, if they are stacked + in the order suggested. + + The generator G used in here is same as obtained from the function + egolaygen. Extended Golay code (24,12) which can correct upto 3 + errors. + + M=(rand(10,12)>0.5); + C=egolayenc(M) + + + See also: egolaygen, egolaydec + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Given M, encode M using the Extended Golay code. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +egolaygen + + +# name: +# type: sq_string +# elements: 1 +# length: 239 + -- Function File: egolaygen () + Returns the Extended Golay code (24,12) generator matrix, which + can correct upto 3 errors. The second argument is the partiy check + matrix, for this code. + + + See also: egolaydec, egolayenc + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Returns the Extended Golay code (24,12) generator matrix, which can +correct upto + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +encode + + +# name: +# type: sq_string +# elements: 1 +# length: 3341 + -- Function File: CODE = encode (MSG,N,K) + -- Function File: CODE = encode (MSG,N,K,TYP) + -- Function File: CODE = encode (MSG,N,K,TYP,OPT) + -- Function File: [CODE, ADDED] = encode (...) + Top level block encoder. This function makes use of the lower level + functions such as "cyclpoly", "cyclgen", "hammgen", and "bchenco". + The message to code is pass in MSG, the codeword length is N and + the message length is K. This function is used to encode messages + using either: + + A [n,k] linear block code defined by a generator matrix + + A [n,k] cyclic code defined by a generator polynomial + + A [n,k] Hamming code defined by a primitive polynomial + + A [n,k] BCH code code defined by a generator polynomial + + The type of coding to use is defined by the variable TYP. This + variable is a string taking one of the values + + `'linear' or 'linear/binary'' + A linear block code is assumed with the coded message CODE + being in a binary format. In this case the argument OPT is + the generator matrix, and is required. + + `'cyclic' or 'cyclic/binary'' + A cyclic code is assumed with the coded message CODE being in + a binary format. The generator polynomial to use can be + defined in OPT. The default generator polynomial to use will + be "cyclpoly(N,K)" + + `'hamming' or 'hamming/binary'' + A Hamming code is assumed with the coded message CODE being + in a binary format. In this case N must be of an integer of + the form `2^M-1', where M is an integer. In addition K must + be `N-M'. The primitive polynomial to use can be defined in + OPT. The default primitive polynomial to use is the same as + defined by "hammgen". + + `'bch' or 'bch/binary'' + A BCH code is assumed with the coded message CODE being in a + binary format. The generator polynomial to use can be defined + in OPT. The default generator polynomial to use will be + "bchpoly(N,K)" + + In addition the argument 'binary' above can be replaced with + 'decimal', in which case the message is assumed to be a decimal + vector, with each value representing a symbol to be coded. The + binary format can be in two forms + + `An X-by-K matrix' + Each row of this matrix represents a symbol to be coded + + `A vector' + The symbols are created from groups of K elements of this + vector. If the vector length is not divisble by K, then + zeros are added and the number of zeros added is returned in + ADDED. + + It should be noted that all internal calculations are performed in + the binary format. Therefore for large values of N, it is + preferable to use the binary format to pass the messages to avoid + possible rounding errors. Additionally, if repeated calls to + "encode" will be performed, it is often faster to create a + generator matrix externally with the functions "hammgen" or + "cyclgen", rather than let "encode" recalculate this matrix at + each iteration. In this case TYP should be 'linear'. The exception + to this case is BCH codes, whose encoder is implemented directly + from the polynomial and is significantly faster. + + + See also: decode, cyclgen, cyclpoly, hammgen, bchenco, bchpoly + + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +Top level block encoder. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +eyediagram + + +# name: +# type: sq_string +# elements: 1 +# length: 1488 + -- Function File: eyediagram (X,N) + -- Function File: eyediagram (X,N,PER) + -- Function File: eyediagram (X,N,PER,OFF) + -- Function File: eyediagram (X,N,PER,OFF,STR) + -- Function File: eyediagram (X,N,PER,OFF,STR,H) + -- Function File: H = eyediagram (...) + Plot the eye-diagram of a signal. The signal X can be either in one + of three forms + + A real vector + In this case the signal is assumed to be real and represented + by the vector X. A single eye-diagram representing this + signal is plotted. + + A complex vector + In this case the in-phase and quadrature components of the + signal are plotted seperately. + + A matrix with two columns + In this case the first column represents the in-phase and the + second the quadrature components of a complex signal. + + Each line of the eye-diagram has N elements and the period is + assumed to be given by PER. The time axis is then [-PER/2 PER/2]. + By default PER is 1. + + By default the signal is assumed to start at -PER/2. This can be + overridden by the OFF variable, which gives the number of samples + to delay the signal. + + The string STR is a plot style string (example 'r+'), and by + default is the default gnuplot line style. + + The figure handle to use can be defined by H. If H is not given, + then the next available figure handle is used. The figure handle + used in returned on HOUT. + + See also: scatterplot + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Plot the eye-diagram of a signal. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +fibodeco + + +# name: +# type: sq_string +# elements: 1 +# length: 860 + -- Function File: fibodeco (CODE) + Returns the decoded fibonacci value from the binary vectors CODE. + Universal codes like fibonacci codes Have a useful synchronization + property, only for 255 maximum value we have designed these + routines. We assume user has partitioned the code into several + unique segments based on the suffix property of unique strings + "11" and we just decode the parts. Partitioning the stream is as + simple as identifying the "11" pairs that occur, at the + terminating ends. This system implements the standard binaary + Fibonacci codes, which means that row vectors can only contain 0 + or 1. Ref: `http://en.wikipedia.org/wiki/Fibonacci_coding' + + fibodeco({[0 1 0 0 1 1]}) %decoded to 10 + fibodeco({[1 1],[0 1 1],[0 0 1 1],[1 0 1 1]}) %[1:4] + + See also: fiboenco + + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 +Returns the decoded fibonacci value from the binary vectors CODE. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +fiboenco + + +# name: +# type: sq_string +# elements: 1 +# length: 1121 + -- Function File: fiboenco (NUM) + Returns the cell-array of encoded fibonacci value from the column + vectors NUM. Universal codes like fibonacci codes have a useful + synchronization property, only for 255 maximum value we have + designed these routines. We assume user has partitioned the code + into several unique segments based on the suffix property of + unique elements [1 1] and we just decode the parts. Partitioning + the stream is as simple as identifying the [1 1] pairs that occur, + at the terminating ends. This system implements the standard + binaary Fibonacci codes, which means that row vectors can only + contain 0 or 1. Ref: http://en.wikipedia.org/wiki/Fibonacci_coding + Ugly O(k.N^2) encoder.Ref: Wikipedia article accessed March, 2006. + `http://en.wikipedia.org/wiki/Fibonacci_coding', UCI Data + Compression Book, `http://www.ics.uci.edu/~dan/pubs/DC-Sec3.html', + (accessed October 2006) + + fiboenco(10) #= code is {[ 0 1 0 0 1 1]} + fiboenco(1:4) #= code is {[1 1],[0 1 1],[0 0 1 1],[1 0 1 1]} + + See also: fibodeco + + + + +# name: +# type: sq_string +# elements: 1 +# length: 78 +Returns the cell-array of encoded fibonacci value from the column +vectors NUM. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +fibosplitstream + + +# name: +# type: sq_string +# elements: 1 +# length: 727 + -- Function File: fibosplitstream (CODE) + Returns the split data stream at the word boundaries. Assuming + the stream was originally encoded using `fiboenco' and this + routine splits the stream at the points where '11' occur together + & gives us the code-words which can later be decoded from the + `fibodeco' This however doesnt mean that we intend to verify if + all the codewords are correct, and infact the last symbol in th + return list can or can-not be a valid codeword. + + A example use of `fibosplitstream' would be + + fibodeco(fibosplitstream([fiboenco(randint(1,100,[0 255])){:}])) + fibodeco(fibosplitstream([fiboenco(1:10){:}])) + + See also: fiboenco, fibodeco + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Returns the split data stream at the word boundaries. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +fmdemod + + +# name: +# type: sq_string +# elements: 1 +# length: 192 + -- Function File: fmdemod (X,FC,FS) + Create the FM demodulation of the signal x with carrier frequency + fs. Where x is sample at frequency fs. + + See also: ammod, amdemod, fmmod + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +Create the FM demodulation of the signal x with carrier frequency fs. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +fmmod + + +# name: +# type: sq_string +# elements: 1 +# length: 190 + -- Function File: fmmod (X,FC,FS) + Create the FM modulation of the signal x with carrier frequency + fs. Where x is sample at frequency fs. + + See also: ammod, fmdemod, amdemod + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 +Create the FM modulation of the signal x with carrier frequency fs. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +gen2par + + +# name: +# type: sq_string +# elements: 1 +# length: 436 + -- Function File: PAR = gen2par (GEN) + -- Function File: GEN = gen2par (PAR) + Converts binary generator matrix GEN to the parity chack matrix + PAR and visa-versa. The input matrix must be in standard form. + That is a generator matrix must be k-by-n and in the form [eye(k) + P] or [P eye(k)], and the parity matrix must be (n-k)-by-n and of + the form [eye(n-k) P'] or [P' eye(n-k)]. + + + See also: cyclgen, hammgen + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Converts binary generator matrix GEN to the parity chack matrix PAR and +visa-ver + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +genqamdemod + + +# name: +# type: sq_string +# elements: 1 +# length: 158 + -- Function File: [Z] = genqamdemod(Y,CONST) + Compute the general quadrature amplitude demodulation of y. + + See also: genqammod, qammod, qamdemod + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 + Compute the general quadrature amplitude demodulation of y. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +genqammod + + +# name: +# type: sq_string +# elements: 1 +# length: 556 + -- Function File: Y = genqammod (X, C) + Modulates an information sequence of intergers X in the range `[0 + ... M-1]' onto a quadrature amplitude modulated signal Y, where + `M = length(c) - 1' and C is a 1D vector specifing the signal + constellation mapping to be used. An example of combined 4PAM-4PSK + is + + d = randint(1,1e4,8); + c = [1+j -1+j -1-j 1-j 1+sqrt(3) j*(1+sqrt(3)) -1-sqrt(3) -j*(1+sqrt(3))]; + y = genqammod(d,c); + z = awgn(y,20); + plot(z,'rx') + + See also: genqamdemod + + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 +Modulates an information sequence of intergers X in the range `[0 . + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +gftable + + +# name: +# type: sq_string +# elements: 1 +# length: 265 + -- Function File: gftable (M, PRIMPOLY) + This function exists for compatiability with matlab. As the octave + galois fields store a copy of the lookup tables for every field in + use internally, there is no need to use this function. + + + See also: gf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +This function exists for compatiability with matlab. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +gfweight + + +# name: +# type: sq_string +# elements: 1 +# length: 820 + -- Function File: W = gfweight (GEN) + -- Function File: W = gfweight (GEN,'gen') + -- Function File: W = gfweight (PAR,'par') + -- Function File: W = gfweight (P,n) + Calculate the minimum weight or distance of a linear block code. + The code can be either defined by its generator or parity check + matrix, or its generator polynomial. By default if the first + argument is a matrix, it is assumed to be the generator matrix of + the code. The type of the matrix can be defined by a flag 'gen' + for the generator matrix or 'par' for the parity check matrix. + + If the first argument is a vector, it is assumed that it defines + the generator polynomial of the code. In this case a second + argument is required that defines the codeword length. + + + See also: hammgen, cyclpoly, bchpoly + + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 +Calculate the minimum weight or distance of a linear block code. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +golombdeco + + +# name: +# type: sq_string +# elements: 1 +# length: 931 + -- Function File: golombdeco (CODE, M) + Returns the Golomb decoded signal vector using CODE and M. + Compulsory m is need to be specified. A restrictions is that a + signal set must strictly be non-negative. The value of code is a + cell array of row-vectors which have the encoded golomb value for + a single sample. The Golomb algorithm is, used to encode the + 'code' and only that can be meaningfully decoded. CODE is assumed + to have been of format generated by the function `golombenco'. + Also the parameter M need to be a non-zero number, unless which it + makes divide-by-zero errors. This function works backward the + Golomb algorithm see `golombenco' for more detials on that. + Reference: Solomon Golomb, Run length Encodings, 1966 IEEE Trans + Info' Theory + + An exmaple of the use of `golombdeco' is + golombdeco(golombenco(1:4,2),2) + + See also: golombenco + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Returns the Golomb decoded signal vector using CODE and M. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +golombenco + + +# name: +# type: sq_string +# elements: 1 +# length: 1615 + -- Function File: golombenco (SIG, M) + Returns the Golomb coded signal as cell array. Also total length + of output code in bits can be obtained. This function uses a M + need to be supplied for encoding signal vector into a golomb coded + vector. A restrictions is that a signal set must strictly be + non-negative. Also the parameter M need to be a non-zero number, + unless which it makes divide-by-zero errors. The Golomb algorithm + [1], is used to encode the data into unary coded quotient part + which is represented as a set of 1's separated from the K-part + (binary) using a zero. This scheme doesnt need any kind of + dictionaries, it is a parameterized prefix codes. Implementation + is close to O(N^2), but this implementation *may be* sluggish, + though correct. Details of the scheme are, to encode the + remainder(r of number N) using the floor(log2(m)) bits when rem is + in range 0:(2^ceil(log2(m)) - N), and encode it as + r+(2^ceil(log2(m)) - N), using total of 2^ceil(log2(m)) bits in + other instance it doesnt belong to case 1. Quotient is coded + simply just using the unary code. Also accroding to [2] Golomb + codes are optimal for sequences using the bernoulli probability + model: P(n)=p^n-1.q & p+q=1, and when M=[1/log2(p)], or P=2^(1/M). + + Reference: 1. Solomon Golomb, Run length Encodings, 1966 IEEE Trans + Info' Theory. 2. Khalid Sayood, Data Compression, 3rd Edition + + An exmaple of the use of `golombenco' is + golombenco(1:4,2) # + golombenco(1:10,2) # + + See also: golombdeco + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Returns the Golomb coded signal as cell array. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +hammgen + + +# name: +# type: sq_string +# elements: 1 +# length: 784 + -- Function File: H = hammgen (M) + -- Function File: H = hammgen (M,P) + -- Function File: [H,G] = hammgen (...) + -- Function File: [H,G,N,K] = hammgen (...) + Produce the parity check and generator matrices of a Hamming code. + The variable M defines the [N,K] Hamming code where `N = 2 ^ M - + 1' and `K = N - M'. M must be between 3 and 16. + + The parity check matrix is generated relative to the primitive + polynomial of GF(2^M). If P is specified the default primitive + polynomial of GF(2^M) is overridden. P must be a valid primitive + polynomial of the correct order for GF(2^M). + + The parity check matrix is returned in the M by N matrix H, and if + requested the generator matrix is returned in the K by N matrix G. + + + See also: gen2par + + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +Produce the parity check and generator matrices of a Hamming code. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +helintrlv + + +# name: +# type: sq_string +# elements: 1 +# length: 109 + -- Function File: OUTDATA = helintrlv (DATA, COL, NGRP,STP) + COL-by-NGRP. + + See also: heldeintrlv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +COL-by-NGRP. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +helscandeintrlv + + +# name: +# type: sq_string +# elements: 1 +# length: 128 + -- Function File: OUTDATA = helscandeintrlv (DATA, NROWS, NCOLS,NSHIFT) + NROWS-by-NCOLS. + + See also: helscandeintrlv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +NROWS-by-NCOLS. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +helscanintrlv + + +# name: +# type: sq_string +# elements: 1 +# length: 126 + -- Function File: OUTDATA = helscanintrlv (DATA, NROWS, NCOLS,NSHIFT) + NROWS-by-NCOLS. + + See also: helscandeintrlv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +NROWS-by-NCOLS. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +huffmandeco + + +# name: +# type: sq_string +# elements: 1 +# length: 893 + -- Function File: SIG = huffmandeco (HCODE, DICT) + Decode signal encoded by `huffmanenco'. + + This function uses a dict built from the `huffmandict' and uses it + to decode a signal list into a huffman list. A restriction is that + HCODE is expected to be a binary code + + The returned SIG set that strictly belongs in the range `[1,N]' + with `N = length(DICT)'. Also DICT can only be from the + `huffmandict' routine. Whenever decoding fails, those signal + values a re indicated by `-1', and we successively try to restart + decoding from the next bit that hasn't failed in decoding, + ad-infinitum. An example of the use of `huffmandeco' is: + + hd = huffmandict (1:4, [0.5 0.25 0.15 0.10]); + hcode = huffmanenco (1:4, hd); + back = huffmandeco (hcode, hd) + => [1 2 3 4] + + See also: huffmandict, huffmanenco + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 +Decode signal encoded by `huffmanenco'. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +huffmandict + + +# name: +# type: sq_string +# elements: 1 +# length: 1497 + -- Function File: huffmandict (SYMB, PROB) + -- Function File: huffmandict (SYMB, PROB, TOGGLE) + -- Function File: huffmandict (SYMB, PROB, TOGGLE, MINVAR) + Builds a Huffman code, given a probability list. The Huffman codes + per symbol are output as a list of strings-per-source symbol. A + zero probability symbol is NOT assigned any codeword as this + symbol doesn't occur in practice anyway. + + TOGGLE is an optional argument with values 1 or 0, that starts + building a code based on 1's or 0's, defaulting to 0. Also MINVAR + is a boolean value that is useful in choosing if you want to + optimize buffer for transmission in the applications of Huffman + coding, however it doesn't affect the type or average codeword + length of the generated code. An example of the use of + `huffmandict' is + + huffmandict(symbols, [0.5 0.25 0.15 0.1]) => CW(0,10,111,110) + huffmandict(symbols, 0.25*ones(1,4)) => CW(11,10,01,00) + + prob=[0.5 0 0.25 0.15 0.1] + dict=huffmandict(1:5,[0.5 0 0.25 0.15 0.1],1) + entropy(prob) + laverage(dict,prob) + + x = [0.20000 0.40000 0.20000 0.10000 0.10000]; + #illustrates the minimum variance thing. + huffmandict(1,x,0,true) #min variance tree. + huffmandict(1,x) #normal huffman tree. + + Reference: Dr.Rao's course EE5351 Digital Video Coding, at + UT-Arlington. + + See also: huffmandeco, huffmanenco + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Builds a Huffman code, given a probability list. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +huffmanenco + + +# name: +# type: sq_string +# elements: 1 +# length: 605 + -- Function File: huffmanenco (SIG, DICT) + Returns the Huffman encoded signal using DICT. This function uses + a DICT built from the `huffmandict' and uses it to encode a signal + list into a huffman list. A restrictions is that a signal set must + strictly belong in the range `[1,N]' with `N = length(dict)'. + Also DICT can only be from the `huffmandict' routine. An exmaple + of the use of `huffmanenco' is + + hd = huffmandict (1:4, [0.5 0.25 0.15 0.10]); + huffmanenco (1:4, hd); + => [1 0 1 0 0 0 0 0 1] + + See also: huffmandict, huffmandeco + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Returns the Huffman encoded signal using DICT. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +intrlv + + +# name: +# type: sq_string +# elements: 1 +# length: 137 + -- Function File: INTRLVD = intrlv (DATA, ELEMENTS) + Interleaved elements of DATA according to ELEMENTS. + + See also: deintrlv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Interleaved elements of DATA according to ELEMENTS. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +lloyds + + +# name: +# type: sq_string +# elements: 1 +# length: 1895 + -- Function File: [TABLE, CODES] = lloyds (SIG,INIT_CODES) + -- Function File: [TABLE, CODES] = lloyds (SIG,LEN) + -- Function File: [TABLE, CODES] = lloyds (SIG,...,TOL) + -- Function File: [TABLE, CODES] = lloyds (SIG,...,TOL,TYPE) + -- Function File: [TABLE, CODES, DIST] = lloyds (...) + -- Function File: [TABLE, CODES, DIST, RELDIST] = lloyds (...) + Optimize the quantization table and codes to reduce distortion. + This is based on the article by Lloyd + + S. Lloyd _Least squared quantization in PCM_, IEEE Trans Inform + Thoery, Mar 1982, no 2, p129-137 + + which describes an iterative technique to reduce the quantization + error by making the intervals of the table such that each interval + has the same area under the PDF of the training signal SIG. The + initial codes to try can either be given in the vector INIT_CODES + or as scalar LEN. In the case of a scalar the initial codes will + be an equi-spaced vector of length LEN between the minimum and + maximum value of the training signal. + + The stopping criteria of the iterative algorithm is given by + + abs(DIST(n) - DIST(n-1)) < max(TOL, abs(EPS*max(SIG)) + + By default TOL is 1.e-7. The final input argument determines how + the updated table is created. By default the centroid of the + values of the training signal that fall within the interval + described by CODES are used to update TABLE. If TYPE is any other + string than "centroid", this behaviour is overriden and TABLE is + updated as follows. + + TABLE = (CODE(2:length(CODE)) + CODE(1:length(CODE-1))) / 2 + + The optimized values are returned as TABLE and CODE. In addition + the distortion of the the optimized codes representing the + training signal is returned as DIST. The relative distortion in + the final iteration is also returned as RELDIST. + + + See also: quantiz + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Optimize the quantization table and codes to reduce distortion. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +lz77deco + + +# name: +# type: sq_string +# elements: 1 +# length: 347 + -- Function File: M = lz77deco (C, ALPH, LA, N) + Lempel-Ziv 77 source algorithm decoding implementation. Where + + M + message decoded (1xN). + + C + encoded message (Mx3). + + ALPH + size of alphabet. + + LA + lookahead buffer size. + + N + sliding window buffer size. + + See also: lz77enco + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Lempel-Ziv 77 source algorithm decoding implementation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +lz77enco + + +# name: +# type: sq_string +# elements: 1 +# length: 298 + -- Function File: C = lz77enco (M, ALPH, LA, N) + Lempel-Ziv 77 source algorithm implementation. Where + + C + encoded message (Mx3). + + ALPH + size of alphabet. + + LA + lookahead buffer size. + + N + sliding window buffer size. + + See also: lz77deco + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Lempel-Ziv 77 source algorithm implementation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +matdeintrlv + + +# name: +# type: sq_string +# elements: 1 +# length: 171 + -- Function File: INTRLVD = matdeintrlv (DATA, NROWS, NCOLS) + Restore elements of DATA with a tempory matrix of size + NROWS-by-NCOLS. + + See also: matintrlv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +Restore elements of DATA with a tempory matrix of size NROWS-by-NCOLS. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +matintrlv + + +# name: +# type: sq_string +# elements: 1 +# length: 175 + -- Function File: INTRLVD = matintrlv (DATA, NROWS, NCOLS) + Interleaved elements of DATA with a tempory matrix of size + NROWS-by-NCOLS. + + See also: matdeintrlv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 74 +Interleaved elements of DATA with a tempory matrix of size +NROWS-by-NCOLS. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +minpol + + +# name: +# type: sq_string +# elements: 1 +# length: 262 + -- Function File: minpol (V) + Finds the minimum polynomial for elements of a Galois Field. For a + vector V with N components, representing N values in a Galois + Field GF(2^M), return the minimum polynomial in GF(2) representing + thos values. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 +Finds the minimum polynomial for elements of a Galois Field. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +modmap + + +# name: +# type: sq_string +# elements: 1 +# length: 2594 + -- Function File: modmap (METHOD,...) + -- Function File: y = modmap (X,FD,FS,'ask',M) + -- Function File: y = modmap (X,FD,FS,'fsk',M,TONE) + -- Function File: y = modmap (X,FD,FS,'msk') + -- Function File: y = modmap (X,FD,FS,'psk',M) + -- Function File: y = modmap (X,FD,FS,'qask',M) + -- Function File: y = modmap (X,FD,FS,'qask/cir',NSIG,AMP,PHS) + -- Function File: y = modmap (X,FD,FS,'qask/arb',INPHASE,QUADR) + -- Function File: y = modmap (X,FD,FS,'qask/arb',MAP) + Mapping of a digital signal to an analog signal. With no output + arguments "modmap" plots the constellation of the mapping. In this + case the first argument must be the string METHOD defining one of + 'ask', 'fsk', 'msk', 'qask', 'qask/cir' or 'qask/arb'. The + arguments following the string METHOD are generally the same as + those after the corresponding string in the fucntion call without + output arguments. The exception is `modmap('msk',FD)'. + + With an output argument, Y is the complex mapped analog signal. In + this case the arguments X, FD and FS are required. The variable X + is the digital signal to be mapped, FD is the sampling rate of the + of digital signal and the FS is the sampling rate of the analog + signal. It is required that `FS/FD' is an integer. + + The available mapping of the digital signal are + + 'ask' + Amplitude shift keying + + 'fsk' + Frequency shift keying + + 'msk' + Minimum shift keying + + 'psk' + Phase shift keying + + 'qask' + 'qsk' + 'qam' + Quadraure amplitude shift keying + + In addition the 'qask', 'qsk' and 'qam' method can be modified + with the flags '/cir' or '/arb'. That is 'qask/cir' and + 'qask/arb', etc are valid methods and give circular- and + arbitrary-qask mappings respectively. + + The additional argument M is the order of the modulation to use. + M must be larger than the largest element of X. The variable TONE + is the FSK tone to use in the modulation. + + For 'qask/cir', the additional arguments are the same as for + "apkconst", and you are referred to "apkconst" for the definitions + of the additional variables. + + For 'qask/arb', the additional arguments INPHASE and QUADR give + the in-phase and quadrature components of the mapping, in a + similar mapping to the outputs of "qaskenco" with one argument. + Similar MAP represents the in-phase and quadrature components of + the mapping as the real and imaginary parts of the variable MAP. + + See also: demodmap, dmodce, amodce, apkconst, qaskenco + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Mapping of a digital signal to an analog signal. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +oct2dec + + +# name: +# type: sq_string +# elements: 1 +# length: 192 + -- Function File: D = oct2dec (C) + Convert octal to decimal values. + + Each element of the octal matrix C is converted to a decimal value. + + See also: base2dec, bin2dec, dec2bin + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 +Convert octal to decimal values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +pamdemod + + +# name: +# type: sq_string +# elements: 1 +# length: 717 + -- Function File: Y = pamdemod (X, M) + -- Function File: Y = pamdemod (X, M, PHI) + -- Function File: Y = pamdemod (X, M, PHI, TYPE) + Demodulates a pulse amplitude modulated signal X into an + information sequence of integers in the range `[0 ... M-1]'. PHI + controls the initial phase and TYPE controls the constellation + mapping. If TYPE is set to 'Bin' will result in binary encoding, + in contrast, if set to 'Gray' will give Gray encoding. An example + of Gray-encoded 8-PAM is + + d = randint(1,1e4,8); + y = pammod(d,8,0,'Gray'); + z = awgn(y,20); + d_est = pamdemod(z,8,0,'Gray'); + plot(z,'rx') + biterr(d,d_est) + + See also: pammod + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Demodulates a pulse amplitude modulated signal X into an information +sequence of + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +pammod + + +# name: +# type: sq_string +# elements: 1 +# length: 645 + -- Function File: Y = pammod (X, M) + -- Function File: Y = pammod (X, M, PHI) + -- Function File: Y = pammod (X, M, PHI, TYPE) + Modulates an information sequence of integers X in the range `[0 + ... M-1]' onto a pulse amplitude modulated signal Y. PHI controls + the initial phase and TYPE controls the constellation mapping. If + TYPE is set to 'Bin' will result in binary encoding, in contrast, + if set to 'Gray' will give Gray encoding. An example of + Gray-encoded 8-PAM is + + d = randint(1,1e4,8); + y = pammod(d,8,0,'Gray'); + z = awgn(y,20); + plot(z,'rx') + + See also: pamdemod + + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +Modulates an information sequence of integers X in the range `[0 . + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +prbs_generator + + +# name: +# type: sq_string +# elements: 1 +# length: 1534 + Implement book keeping for a Pseudo-Random Binary Sequence ( PRBS ) + also called as a Linear Feedback Shift Register. + + Given a polynomial create a PRBS structure for that polynomial. + Now all we need is to just create this polynomial and make it work. + polynomial must be a vector containing the powers of x and an optional + value 1. eg: x^3 + x^2 + x + 1 must be written as [3 2 1 0] + all the coefficients are either 1 or 0. It generates only a Binary \ + sequence, and the generator polynomial need to be only a binary + polynomial in GF(2). + + connections, contains a struct of vectors where each vector is the + connection list mapping its vec(2:end) elements to the vec(1) output. + + Example: If you had a PRBS shift register like the diagram + below with 4 registers we use representation by polynomial + of [ 1 2 3 4], and feedback connections between [ 1 3 4 ]. + The output PRBS sequence is taken from the position 4. + + +---+ +----+ +---+ +---+ + | D |----| D |---| D |---| D | + +---+ +----+ +---+ +---+ + | | | + \ / / + [+]---------------+------+ + 1 + 0.D + 1.D^2 + 1.D^3 + + The code to implement this PRBS with a start state of [1 0 1 1] + will be: + + prbs=prbs_generator([1 3 4],{[1 3 4]},[1 0 1 1]); + x = prbs_sequence(prbs) #gives 15 + + prbs_iterator( prbs, 15 ) #15 binary digits seen + [ 1 1 0 1 0 1 1 1 1 0 0 0 1 0 0 ] + + See Also: This function is to be used along with functions + prbs_iterator, and prbs_sequence. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Implement book keeping for a Pseudo-Random Binary Sequence ( PRBS ) + also calle + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +prbs_iterator + + +# name: +# type: sq_string +# elements: 1 +# length: 1172 + This function generates the output bits from the PRBS + state, for the number of iterations specified. + + First argument is the PRBS structure obtained from prbs_generator. + PRBS iterations is specified in the second argument. + PRBS start state is taken from the prbs.sregs. + + Second argument of the output is PRBS structure with a new + state. This allows usage like: + + [ seq, prbs ] = prbs_iterator( prbs, niterations ); + + while the state of the PRBS is updated. + + Example: If you had a PRBS shift register like the diagram + below with 4 registers we use representation by polynomial + of [ 1 2 3 4], and feedback connections between [ 1 3 4 ]. + The output PRBS sequence is taken from the position 4. + + +---+ +----+ +---+ +---+ + | D |----| D |---| D |---| D | + +---+ +----+ +---+ +---+ + | | | + \ / / + [+]---------------+------+ + 1 + 0.D + 1.D^2 + 1.D^3 + + The code to implement this PRBS will be + prbs=prbs_generator([1 3 4],{[1 3 4]},[1 0 1 1]); + x = prbs_iterator(prbs,15) + + See Also: This function is to be used along with functions + prbs_iterator, prbs_generator and prbs_sequence. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + This function generates the output bits from the PRBS + state, for the number of + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +prbs_sequence + + +# name: +# type: sq_string +# elements: 1 +# length: 960 + Implement book keeping for a Pseudo-Random Binary Sequence ( PRBS ) + also called as a Linear Feedback Shift Register. + + For the given PRBS in a intial state, compute the PRBS sequence length. + Length is period of output when the PRBS state is same as + the start state of PRBS. + + Example: If you had a PRBS shift register like the diagram + below with 4 registers we use representation by polynomial + of [ 1 2 3 4], and feedback connections between [ 1 3 4 ]. + The output PRBS sequence is taken from the position 4. + + +---+ +----+ +---+ +---+ + | D |----| D |---| D |---| D | + +---+ +----+ +---+ +---+ + | | | + \ / / + [+]---------------+------+ + 1 + 0.D + 1.D^2 + 1.D^3 + + The code to implement this PRBS will be + prbs=prbs_generator([1 3 4],{[1 3 4]},[1 0 1 1]); + x = prbs_sequence(prbs) #gives 15 + + + See Also: This function is to be used along with functions + prbs_generator. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Implement book keeping for a Pseudo-Random Binary Sequence ( PRBS ) + also calle + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +pskdemod + + +# name: +# type: sq_string +# elements: 1 +# length: 734 + -- Function File: Y = pamdemod (X, M) + -- Function File: Y = pamdemod (X, M, PHI) + -- Function File: Y = pamdemod (X, M, PHI, TYPE) + Demodulates a complex-baseband phase shift keying modulated signal + into an information sequence of integers in the range `[0 ... + M-1]'. PHI controls the initial phase and TYPE controls the + constellation mapping. If TYPE is set to 'Bin' will result in + binary encoding, in contrast, if set to 'Gray' will give Gray + encoding. An example of Gray-encoded 8-PSK is + + d = randint(1,1e3,8); + y = pskmod(d,8,0,'Gray'); + z = awgn(y,20); + d_est = pskdemod(z,8,0,'Gray'); + plot(z,'rx') + biterr(d,d_est) + + See also: pskmod + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Demodulates a complex-baseband phase shift keying modulated signal into +an infor + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +pskmod + + +# name: +# type: sq_string +# elements: 1 +# length: 662 + -- Function File: Y = pskmod (X, M) + -- Function File: Y = pskmod (X, M, PHI) + -- Function File: Y = pskmod (X, M, PHI, TYPE) + Modulates an information sequence of integers X in the range `[0 + ... M-1]' onto a complex baseband phase shift keying modulated + signal Y. PHI controls the initial phase and TYPE controls the + constellation mapping. If TYPE is set to 'Bin' will result in + binary encoding, in contrast, if set to 'Gray' will give Gray + encoding. An example of Gray-encoded QPSK is + + d = randint(1,5e3,4); + y = pskmod(d,4,0,'Gray'); + z = awgn(y,30); + plot(z,'rx') + + See also: pskdemod + + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +Modulates an information sequence of integers X in the range `[0 . + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +qamdemod + + +# name: +# type: sq_string +# elements: 1 +# length: 142 + -- Function File: qamdemod (X,M) + Create the QAM demodulation of x with a size of alphabet m. + + See also: qammod, pskmod, pskdemod + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 +Create the QAM demodulation of x with a size of alphabet m. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +qammod + + +# name: +# type: sq_string +# elements: 1 +# length: 140 + -- Function File: qammod (X,M) + Create the QAM modulation of x with a size of alphabet m. + + See also: qamdemod, pskmod, pskdemod + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 +Create the QAM modulation of x with a size of alphabet m. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +qaskdeco + + +# name: +# type: sq_string +# elements: 1 +# length: 1177 + -- Function File: MSG = qaskdeco (C,M) + -- Function File: MSG = qaskdeco (INPHASE,QUADR,M) + -- Function File: MSG = qaskdeco (...,MNMX) + Demaps an analog signal using a square QASK constellation. The + input signal maybe either a complex variable C, or as two real + variables INPHASE and QUADR representing the in-phase and + quadrature components of the signal. + + The argument M must be a positive integer power of 2. By deafult + the same constellation as created in "qaskenco" is used by + "qaskdeco". If is possible to change the values of the minimum + and maximum of the in-phase and quadrature components of the + constellation to account for linear changes in the signal values + in the received signal. The variable MNMX is a 2-by-2 matrix of + the following form + + | min in-phase , max in-phase | + | min quadrature , max quadrature | + + If `sqrt(M)' is an integer, then "qaskenco" uses a Gray mapping. + Otherwise, an attempt is made to create a nearly square mapping + with a minimum Hamming distance between adjacent constellation + points. + + See also: qaskenco + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Demaps an analog signal using a square QASK constellation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +qaskenco + + +# name: +# type: sq_string +# elements: 1 +# length: 1685 + -- Function File: qaskenco (M) + -- Function File: qaskenco (MSG,M) + -- Function File: Y = qaskenco (...) + -- Function File: [INPHASE, QUADR] = qaskenco (...) + Map a digital signal using a square QASK constellation. The + argument M must be a positive integer power of 2. With two input + arguments the variable MSG represents the message to be encoded. + The values of MSG must be between 0 and `M-1'. In all cases + `qaskenco(M)' is equivalent to `qaskenco(1:M,M)' + + Three types of outputs can be created depending on the number of + output arguments. That is + + No output arguments + In this case "qaskenco" plots the constellation. Only the + points in MSG are plotted, which in the case of a single input + argument is all constellation points. + + A single output argument + The returned variable is a complex variable representing the + in-phase and quadrature components of the mapped message + MSG. With, a single input argument this effectively gives the + mapping from symbols to constellation points + + Two output arguments + This is the same as two ouput arguments, expect that the + in-phase and quadrature components are returned explicitly. + That is + + octave> c = qaskenco(msg, m); + octave> [a, b] = qaskenco(msg, m); + octave> all(c == a + 1i*b) + ans = 1 + + If `sqrt(M)' is an integer, then "qaskenco" uses a Gray mapping. + Otherwise, an attempt is made to create a nearly square mapping + with a minimum Hamming distance between adjacent constellation + points. + + See also: qaskdeco + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Map a digital signal using a square QASK constellation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +qfunc + + +# name: +# type: sq_string +# elements: 1 +# length: 92 + -- Function File: [Y] = qfunc (X) + Compute the Q function. + + See also: erfc, erf + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 23 +Compute the Q function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +qfuncinv + + +# name: +# type: sq_string +# elements: 1 +# length: 103 + -- Function File: [Y] = qfuncinv (X) + Compute the inverse Q function. + + See also: erfc, erf + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 +Compute the inverse Q function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +quantiz + + +# name: +# type: sq_string +# elements: 1 +# length: 813 + -- Function File: QIDX = quantiz (X, TABLE) + -- Function File: [QIDX, Q] = quantiz (X, TABLE, CODES) + -- Function File: [ QIDX, Q, D] = quantiz (...) + Quantization of an arbitrary signal relative to a paritioning. + + `qidx = quantiz(x, table)' + Determine position of x in strictly monotonic table. The + first interval, using index 0, corresponds to x <= table(1). + Subsequent intervals are table(i-1) < x <= table(i). + + `[qidx, q] = quantiz(x, table, codes)' + Associate each interval of the table with a code. Use + codes(1) for x <= table(1) and codes(n+1) for table(n) < x + <= table(n+1). + + `[qidx, q, d] = quantiz(...)' + Compute distortion as mean squared distance of x from the + corresponding quantization values. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +Quantization of an arbitrary signal relative to a paritioning. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +randdeintrlv + + +# name: +# type: sq_string +# elements: 1 +# length: 160 + -- Function File: INTRLVD = randdeintrlv (DATA, STATE) + Restore elements of DATA with a random permutation. + + See also: randintrlv, intrlv, deintrlv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Restore elements of DATA with a random permutation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +randerr + + +# name: +# type: sq_string +# elements: 1 +# length: 987 + -- Function File: B = randerr (N) + -- Function File: B = randerr (N,M) + -- Function File: B = randerr (N,M,ERR) + -- Function File: B = randerr (N,M,ERR,SEED) + Generate a matrix of random bit errors. The size of the matrix is + N rows by M columns. By default M is equal to N. Bit errors in + the matrix are indicated by a 1. + + The variable ERR determines the number of errors per row. By + default the return matrix B has exactly one bit error per row. If + ERR is a scalar, there each row of B has exactly this number of + errors per row. If ERR is a vector then each row has a number of + errors that is in this vector. Each number of errors has an equal + probability. If ERR is a matrix with two rows, then the first row + determines the number of errors and the second their probabilities. + + The variable SEED allows the random number generator to be seeded + with a fixed value. The initial seed will be restored when + returning. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 +Generate a matrix of random bit errors. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +randint + + +# name: +# type: sq_string +# elements: 1 +# length: 800 + -- Function File: B = randint (N) + -- Function File: B = randint (N,M) + -- Function File: B = randint (N,M,RANGE) + -- Function File: B = randint (N,M,RANGE,SEED) + Generate a matrix of random binary numbers. The size of the matrix + is N rows by M columns. By default M is equal to N. + + The range in which the integers are generated will is determined by + the variable RANGE. If RANGE is an integer, the value will lie in + the range [0,RANGE-1], or [RANGE+1,0] if RANGE is negative. If + RANGE contains two elements the intgers will lie within these two + elements, inclusive. By default RANGE is assumed to be [0:1]. + + The variable SEED allows the random number generator to be seeded + with a fixed value. The initial seed will be restored when + returning. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Generate a matrix of random binary numbers. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +randintrlv + + +# name: +# type: sq_string +# elements: 1 +# length: 150 + -- Function File: INTRLVD = randintrlv (DATA, STATE) + Interleaves elements of DATA with a random permutation. + + See also: intrlv, deintrlv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Interleaves elements of DATA with a random permutation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +randsrc + + +# name: +# type: sq_string +# elements: 1 +# length: 845 + -- Function File: B = randsrc (N) + -- Function File: B = randsrc (N,M) + -- Function File: B = randsrc (N,M,ALPHABET) + -- Function File: B = randsrc (N,M,ALPHABET,SEED) + Generate a matrix of random symbols. The size of the matrix is N + rows by M columns. By default M is equal to N. + + The variable ALPHABET can be either a row vector or a matrix with + two rows. When ALPHABET is a row vector the symbols returned in B + are chosen with equal probability from ALPHABET. When ALPHABET has + two rows, the second row determines the probabilty with which each + of the symbols is chosen. The sum of the probabilities must equal + 1. By default ALPHABET is [-1 1]. + + The variable SEED allows the random number generator to be seeded + with a fixed value. The initial seed will be restored when + returning. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Generate a matrix of random symbols. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +reedmullerdec + + +# name: +# type: sq_string +# elements: 1 +# length: 1165 + -- Function File: reedmullerdec (VV,G,R,M) + Decode the received code word VV using the RM-generator matrix G, + of order R, M, returning the code-word C. We use the standard + majority logic vote method due to Irving S. Reed. The received + word has to be a matrix of column size equal to to code-word size + (i.e 2^m). Each row is treated as a separate received word. + + The second return value is the message M got from C. + + G is obtained from definition type construction of Reed Muller + code, of order R, length 2^M. Use the function reedmullergen, for + the generator matrix for the (R,M) order RM code. + + Faster code constructions (also easier) exist, but since finding + permutation order of the basis vectors, is important, we stick + with the standard definitions. To use decoder function + reedmullerdec, you need to use this specific generator function. + + see: Lin & Costello, Ch.4, "Error Control Coding", 2nd Ed, Pearson. + + G=reedmullergen(2,4); + M=[rand(1,11)>0.5]; + C=mod(M*G,2); + [dec_C,dec_M]=reedmullerdec(C,G,2,4) + + + See also: reedmullergen, reedmullerenc + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Decode the received code word VV using the RM-generator matrix G, of +order R, M + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +reedmullerenc + + +# name: +# type: sq_string +# elements: 1 +# length: 581 + -- Function File: reedmullerenc (MSG,R,M) + Definition type construction of Reed Muller code, of order R, + length 2^M. This function returns the generator matrix for the + said order RM code. + + Encodes the given message word/block, of column size k, + corresponding to the RM(R,M), and outputs a code matrix C, on each + row with corresponding codeword. The second return value is the + G, which is generator matrix used for this code. + + MSG=[rand(10,11)>0.5]; + [C,G]=reedmullerenc(MSG,2,4); + + + See also: reedmullerdec, reedmullergen + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 +Definition type construction of Reed Muller code, of order R, length +2^M. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +reedmullergen + + +# name: +# type: sq_string +# elements: 1 +# length: 848 + -- Function File: reedmullergen (R,M) + Definition type construction of Reed Muller code, of order R, + length 2^M. This function returns the generator matrix for the + said order RM code. + + RM(r,m) codes are characterized by codewords, `sum ( (m,0) + (m,1) + + ... + (m,r)'. Each of the codeword is got through spanning the + space, using the finite set of m-basis codewords. Each codeword + is 2^M elements long. see: Lin & Costello, "Error Control + Coding", 2nd Ed. + + Faster code constructions (also easier) exist, but since finding + permutation order of the basis vectors, is important, we stick + with the standard definitions. To use decoder function + reedmullerdec, you need to use this specific generator function. + + G=reedmullergen(2,4); + + + See also: reedmullerdec, reedmullerenc + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 +Definition type construction of Reed Muller code, of order R, length +2^M. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +ricedeco + + +# name: +# type: sq_string +# elements: 1 +# length: 708 + -- Function File: ricedeco (CODE, K) + Returns the Rice decoded signal vector using CODE and K. + Compulsory K is need to be specified. A restrictions is that a + signal set must strictly be non-negative. The value of code is a + cell array of row-vectors which have the encoded rice value for a + single sample. The Rice algorithm is used to encode the 'code' + and only that can be meaningfully decoded. CODE is assumed to have + been of format generated by the function `riceenco'. + + Reference: Solomon Golomb, Run length Encodings, 1966 IEEE Trans + Info' Theory + + An exmaple of the use of `ricedeco' is + ricedec(riceenco(1:4,2),2) + + See also: riceenco + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 +Returns the Rice decoded signal vector using CODE and K. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +riceenco + + +# name: +# type: sq_string +# elements: 1 +# length: 1101 + -- Function File: riceenco (SIG, K) + Returns the Rice encoded signal using K or optimal K . Default + optimal K is chosen between 0-7. Currently no other way to + increase the range except to specify explicitly. Also returns K + parameter used (in case it were to be chosen optimally) and LTOT + the total length of output code in bits. This function uses a K + if supplied or by default chooses the optimal K for encoding + signal vector into a rice coded vector. A restrictions is that a + signal set must strictly be non-negative. The Rice algorithm is + used to encode the data into unary coded quotient part which is + represented as a set of 1's separated from the K-part (binary) + using a zero. This scheme doesnt need any kind of dictionaries and + its close to O(N), but this implementation *may be* sluggish, + though correct. + + Reference: Solomon Golomb, Run length Encodings, 1966 IEEE Trans + Info' Theory + + An exmaple of the use of `riceenco' is + riceenco(1:4) # + riceenco(1:10,2) # + + See also: ricedeco + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Returns the Rice encoded signal using K or optimal K . + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +rledeco + + +# name: +# type: sq_string +# elements: 1 +# length: 422 + -- Function File: rledeco (MESSAGE) + Returns decoded run-length MESSAGE. The RLE encoded MESSAGE has + to be in the form of a row-vector. The message format (encoded + RLE) is like repetition [factor, value]+. + + An example use of `rledeco' is + message=[1 5 2 4 3 1]; + rledeco(message) #gives + ans = [ 5 4 4 1 1 1] + + See also: rledeco + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Returns decoded run-length MESSAGE. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +rleenco + + +# name: +# type: sq_string +# elements: 1 +# length: 468 + -- Function File: rleenco (MESSAGE) + Returns run-length encoded MESSAGE. The rle form is built from + MESSAGE. The original MESSAGE has to be in the form of a + row-vector. The encoded MESSAGE format (encoded RLE) is like + [repetition factor]+, values. + + An example use of `rleenco' is + message=[ 5 4 4 1 1 1] + rleenco(message) #gives + ans = [1 5 2 4 3 1]; + + See also: rleenco + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Returns run-length encoded MESSAGE. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +rsdecof + + +# name: +# type: sq_string +# elements: 1 +# length: 832 + -- Function File: rsdecof (IN,OUT) + -- Function File: rsdecof (IN,OUT,T) + Decodes an ascii file using a Reed-Solomon coder. The input file is + defined by IN and the result is written to the output file OUT. + The type of coding to use is determined by whether the input file + is 7- or 8-bit. If the input file is 7-bit, the default coding is + [127,117]. while the default coding for an 8-bit file is a [255, + 235]. This allows for 5 or 10 error characters in 127 or 255 + symbols to be corrected respectively. The number of errors that + can be corrected can be overridden by the variable T. + + If the file is not an integer multiple of the message size (127 or + 255) in length, then the file is padded with the EOT (ascii + character 4) character before decoding. + + + See also: rsencof + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Decodes an ascii file using a Reed-Solomon coder. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +rsencof + + +# name: +# type: sq_string +# elements: 1 +# length: 1070 + -- Function File: rsencof (IN,OUT) + -- Function File: rsencof (IN,OUT,T) + -- Function File: rsencof (...,PAD) + Encodes an ascii file using a Reed-Solomon coder. The input file is + defined by IN and the result is written to the output file OUT. + The type of coding to use is determined by whether the input file + is 7- or 8-bit. If the input file is 7-bit, the default coding is + [127,117]. while the default coding for an 8-bit file is a [255, + 235]. This allows for 5 or 10 error characters in 127 or 255 + symbols to be corrected respectively. The number of errors that + can be corrected can be overridden by the variable T. + + If the file is not an integer multiple of the message size (127 or + 255) in length, then the file is padded with the EOT (ascii + character 4) characters before coding. Whether these characters + are written to the output is defined by the PAD variable. Valid + values for PAD are "pad" (the default) and "nopad", which write or + not the padding respectively. + + + See also: rsdecof + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Encodes an ascii file using a Reed-Solomon coder. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +rsgenpoly + + +# name: +# type: sq_string +# elements: 1 +# length: 1634 + -- Function File: G = rsgenpoly (N,K) + -- Function File: G = rsgenpoly (N,K,P) + -- Function File: G = rsgenpoly (N,K,P,B,S) + -- Function File: G = rsgenpoly (N,K,P,B) + -- Function File: [G, T] = rsgenpoly (...) + Creates a generator polynomial for a Reed-Solomon coding with + message length of K and codelength of N. N must be greater than K + and their difference must be even. The generator polynomial is + returned on G as a polynomial over the Galois Field GF(2^M) where + N is equal to `2^M-1'. If M is not integer the next highest + integer value is used and a generator for a shorten Reed-Solomon + code is returned. + + The elements of G represent the coefficients of the polynomial in + descending order. If the length of G is lg, then the generator + polynomial is given by + + G(0) * x^(lg-1) + G(1) * x^(lg-2) + ... + G(lg-1) * x + G(lg). + + If P is defined then it is used as the primitive polynomial of the + the Galois Field GF(2^M). The default primitive polynomial will be + used if P is equal to []. + + The variables B and S determine the form of the generator + polynomial in the following manner. + + G = (X - A^(B*S)) * (X - A^((B+1)*S)) * ... * (X - A^((B+2*T-1)*S)). + + where T is `(N-K)/2', and A is the primitive element of the Galois + Field. Therefore B is the first consecutive root of the generator + polynomial and S is the primitive element to generate the the + polynomial roots. + + If requested the variable T, which gives the error correction + capability of the the Reed-Solomon code + + See also: gf, rsenc, rsdec + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Creates a generator polynomial for a Reed-Solomon coding with message +length of + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +scatterplot + + +# name: +# type: sq_string +# elements: 1 +# length: 1438 + -- Function File: scatterplot (X) + -- Function File: scatterplot (X,N) + -- Function File: scatterplot (X,N,OFF) + -- Function File: scatterplot (X,N,OFF,STR) + -- Function File: scatterplot (X,N,OFF,STR,H) + -- Function File: H = scatterplot (...) + Display the scatter plot of a signal. The signal X can be either in + one of three forms + + A real vector + In this case the signal is assumed to be real and represented + by the vector X. The scatterplot is plotted along the x axis + only. + + A complex vector + In this case the in-phase and quadrature components of the + signal are plotted seperately on the x and y axes + respectively. + + A matrix with two columns + In this case the first column represents the in-phase and the + second the quadrature components of a complex signal and are + plotted on the x and y axes respectively. + + Each point of the scatter plot is assumed to be seperated by N + elements in the signal. The first element of the signal to plot is + determined by OFF. By default N is 1 and OFF is 0. + + The string STR is a plot style string (example 'r+'), and by + default is the default gnuplot point style. + + The figure handle to use can be defined by H. If H is not given, + then the next available figure handle is used. The figure handle + used in returned on HOUT. + + See also: eyediagram + + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 +Display the scatter plot of a signal. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +shannonfanodeco + + +# name: +# type: sq_string +# elements: 1 +# length: 1012 + -- Function File: shannonfanodeco (HCODE,DICT) + Returns the original signal that was Shannonfano encoded. The + signal was encoded using `shannonfanoenco'. This function uses a + dict built from the `shannonfanodict' and uses it to decode a + signal list into a shannonfano list. Restrictions include hcode is + expected to be a binary code; returned signal set that strictly + belongs in the `range [1,N]', with `N=length(dict)'. Also dict can + only be from the `shannonfanodict(...)' routine. Whenever decoding + fails, those signal values are indicated by -1, and we successively + try to restart decoding from the next bit that hasnt failed in + decoding, ad-infinitum. + + An example use of `shannonfanodeco' is + hd=shannonfanodict(1:4,[0.5 0.25 0.15 0.10]) + hcode=shannonfanoenco(1:4,hd) # [ 1 0 1 0 0 0 0 0 1 ] + shannonfanodeco(hcode,hd) # [1 2 3 4] + + See also: shannonfanoenco, shannonfanodict + + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 +Returns the original signal that was Shannonfano encoded. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +shannonfanodict + + +# name: +# type: sq_string +# elements: 1 +# length: 654 + -- Function File: shannonfanodict (SYMBOLS,SYMBOL_PROBABILITES) + Returns the code dictionary for source using shanno fano algorithm. + Dictionary is built from SYMBOL_PROBABILITIES using the shannon + fano scheme. Output is a dictionary cell-array, which are + codewords, and correspond to the order of input probability. + + CW=shannonfanodict(1:4,[0.5 0.25 0.15 0.1]); + assert(redundancy(CW,[0.5 0.25 0.15 0.1]),0.25841,0.001) + shannonfanodict(1:5,[0.35 0.17 0.17 0.16 0.15]) + shannonfanodict(1:8,[8 7 6 5 5 4 3 2]./40) + + See also: shannonfanoenc, shannonfanodec + + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 +Returns the code dictionary for source using shanno fano algorithm. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +shannonfanoenco + + +# name: +# type: sq_string +# elements: 1 +# length: 662 + -- Function File: shannonfanoenco (HCODE,DICT) + Returns the Shannon Fano encoded signal using DICT. This function + uses a DICT built from the `shannonfanodict' and uses it to encode + a signal list into a shannon fano code. Restrictions include a + signal set that strictly belongs in the `range [1,N]' with + `N=length(dict)'. Also dict can only be from the + `shannonfanodict()' routine. An example use of `shannonfanoenco' + is + + hd=shannonfanodict(1:4,[0.5 0.25 0.15 0.10]) + shannonfanoenco(1:4,hd) # [ 0 1 0 1 1 0 1 1 1 0] + + See also: shannonfanodeco, shannonfanodict + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Returns the Shannon Fano encoded signal using DICT. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +symerr + + +# name: +# type: sq_string +# elements: 1 +# length: 1568 + -- Function File: [NUM, RATE] = symerr (A,B) + -- Function File: [NUM, RATE] = symerr (...,FLAG) + -- Function File: [NUM, RATE IND] = symerr (...) + Compares two matrices and returns the number of symbol errors and + the symbol error rate. The variables A and B can be either: + + Both matrices + In this case both matrices must be the same size and then by + default the the return values NUM and RATE are the overall + number of symbol errors and the overall symbol error rate. + + One column vector + In this case the column vector is used for symbol error + comparision column-wise with the matrix. The returned values + NUM and RATE are then row vectors containing the num of + symbol errors and the symbol error rate for each of the + column-wise comparisons. The number of rows in the matrix + must be the same as the length of the column vector + + One row vector + In this case the row vector is used for symbol error + comparision row-wise with the matrix. The returned values NUM + and RATE are then column vectors containing the num of symbol + errors and the symbol error rate for each of the row-wise + comparisons. The number of columns in the matrix must be the + same as the length of the row vector + + This behaviour can be overridden with the variable FLAG. FLAG can + take the value 'column-wise', 'row-wise' or 'overall'. A + column-wise comparision is not possible with a row vector and + visa-versa. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compares two matrices and returns the number of symbol errors and the +symbol err + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +systematize + + +# name: +# type: sq_string +# elements: 1 +# length: 729 + -- Function File: systematize (G) + Given G, extract P partiy check matrix. Assume row-operations in + GF(2). G is of size KxN, when decomposed through row-operations + into a I of size KxK identity matrix, and a parity check matrix P + of size Kx(N-K). + + Most arbitrary code with a given generator matrix G, can be + converted into its systematic form using this function. + + This function returns 2 values, first is default being GX the + systematic version of the G matrix, and then the parity check + matrix P. + + G=[1 1 1 1; 1 1 0 1; 1 0 0 1]; + [Gx,P]=systematize(G); + + Gx = [1 0 0 1; 0 1 0 0; 0 0 1 0]; + P = [1 0 0]; + + + See also: bchpoly, biterr + + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 +Given G, extract P partiy check matrix. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +vec2mat + + +# name: +# type: sq_string +# elements: 1 +# length: 376 + -- Function File: M = vec2mat (V, C) + -- Function File: M = vec2mat (V, C, D) + -- Function File: [M, ADD] = vec2mat (...) + Converts the vector V into a C column matrix with row priority + arrangement and with the final column padded with the value D to + the correct length. By default D is 0. The amount of padding added + to the matrix is returned in ADD. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Converts the vector V into a C column matrix with row priority +arrangement and w + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +wgn + + +# name: +# type: sq_string +# elements: 1 +# length: 1012 + -- Function File: Y = wgn (M,N,P) + -- Function File: Y = wgn (M,N,P,IMP) + -- Function File: Y = wgn (M,N,P,IMP,SEED,) + -- Function File: Y = wgn (...,'TYPE') + -- Function File: Y = wgn (...,'OUTPUT') + Returns a M-by-N matrix Y of white Gaussian noise. P specifies the + power of the output noise, which is assumed to be referenced to an + impedance of 1 Ohm, unless IMP explicitly defines the impedance. + + If SEED is defined then the randn function is seeded with this + value. + + The arguments TYPE and OUTPUT must follow the above numerial + arguments, but can be specified in any order. TYPE specifies the + units of P, and can be 'dB', 'dBW', 'dBm' or 'linear'. 'dB' is in + fact the same as 'dBW' and is keep as a misnomer of Matlab. The + units of 'linear' are in Watts. + + The OUTPUT variable should be either 'real' or 'complex'. If the + output is complex then the power P is divided equally betwen the + real and imaginary parts. + + See also: randn, awgn + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Returns a M-by-N matrix Y of white Gaussian noise. + + + + + diff --git a/octave_packages/communications-1.1.1/egolaydec.m b/octave_packages/communications-1.1.1/egolaydec.m new file mode 100644 index 0000000..d816671 --- /dev/null +++ b/octave_packages/communications-1.1.1/egolaydec.m @@ -0,0 +1,126 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} egolaydec (@var{R}) +## +## Given @var{R}, the received Extended Golay code, this function tries to +## decode @var{R} using the Extended Golay code parity check matrix. +## Extended Golay code (24,12) which can correct upto 3 errors. +## +## The received code @var{R}, needs to be of length Nx24, for encoding. We can +## decode several codes at once, if they are stacked as a matrix of 24columns, +## each code in a separate row. +## +## The generator G used in here is same as obtained from the +## function egolaygen. +## +## The function returns the error-corrected code word from the received +## word. If decoding failed, the second return value is 1, otherwise it is 0. +## +## Extended Golay code (24,12) which can correct upto 3 +## errors. Decoding algorithm follows from Lin & Costello. +## +## Ref: Lin & Costello, pg 128, Ch4, 'Error Control Coding', 2nd ed, Pearson. +## +## @example +## @group +## M=[rand(10,12)>0.5]; +## C1=egolayenc(M); +## C1(:,1)=mod(C1(:,1)+1,2) +## C2=egolaydec(C1) +## @end group +## @end example +## +## @end deftypefn +## @seealso{egolaygen,egolayenc} + +function [C,dec_error]=egolaydec(R) + + if ( nargin < 1 ) + error('usage: C=egolaydec(R)'); + elseif ( columns(R) ~= 24 ) + error('extended golay code is (24,12), use rx codeword of 24 bit column size'); + end + + I=eye(12); + %P is 12x12 matrix + P=[1 0 0 0 1 1 1 0 1 1 0 1; + 0 0 0 1 1 1 0 1 1 0 1 1; + 0 0 1 1 1 0 1 1 0 1 0 1; + 0 1 1 1 0 1 1 0 1 0 0 1; + 1 1 1 0 1 1 0 1 0 0 0 1; + 1 1 0 1 1 0 1 0 0 0 1 1; + 1 0 1 1 0 1 0 0 0 1 1 1; + 0 1 1 0 1 0 0 0 1 1 1 1; + 1 1 0 1 0 0 0 1 1 1 0 1; + 1 0 1 0 0 0 1 1 1 0 1 1; + 0 1 0 0 0 1 1 1 0 1 1 1; + 1 1 1 1 1 1 1 1 1 1 1 0;]; + + H=[I; P]; %partiy check matrix transpose. + + dec_error=[]; + C=zeros(size(R)); + + for rspn=1:rows(R) + RR=R(rspn,:); + S=mod(RR*H,2); + wt=sum(S); + done=0; + if (wt <= 3) + E=[S, zeros(1,12)]; + done=1; + else + SP = mod(repmat(S,[12, 1])+P,2); + idx = find( sum(SP,2) <= 2 ); + if ( idx ) + idx=idx(1); %pick first of matches. + Ui=zeros(1,12); Ui(idx)=1; + E=[SP(idx,:),Ui]; + done=1; + end + end + + if ( ~done ) + X=mod(S*P,2); + wt=sum(X); + if (wt==2 || wt==3) + E=[zeros(1,12), X]; + done=1; + else + SP = mod(repmat(X,[12, 1])+P,2); + idx = find( sum(SP,2) == 2 ); + if ( idx ) + idx=idx(1); + Ui=zeros(1,12); Ui(idx)=1; + E=[Ui,SP(idx,:)]; + done=1; + end + end + end + + dec_error=[dec_error; 1-done]; + C(rspn,:)=mod(E+RR,2); + end + + return; +end + %! + %!assert(egolaydec([1 1 1 zeros(1,21)]),zeros(1,24)) + %!assert(egolaydec([1 0 1 zeros(1,20) 1]),zeros(1,24)) + %! + + diff --git a/octave_packages/communications-1.1.1/egolayenc.m b/octave_packages/communications-1.1.1/egolayenc.m new file mode 100644 index 0000000..2421954 --- /dev/null +++ b/octave_packages/communications-1.1.1/egolayenc.m @@ -0,0 +1,70 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} egolayenc (@var{M}) +## +## +## Given @var{M}, encode M using the Extended Golay code. +## +## The message @var{M}, needs to be of size Nx12, for encoding. +## We can encode several messages, into codes at once, if they +## are stacked in the order suggested. +## +## The generator G used in here is same as obtained from the +## function egolaygen. Extended Golay code (24,12) which can correct +## upto 3 errors. +## +## @example +## @group +## M=(rand(10,12)>0.5); +## C=egolayenc(M) +## +## @end group +## @end example +## +## @end deftypefn +## @seealso{egolaygen,egolaydec} + +function C=egolayenc(M) + if ( nargin < 1 ) + error('usage: C=egolayenc(M)'); + elseif ( columns(M) ~= 12 ) + error('extended golay code is (24,12), use message of column size 12'); + end + + I=eye(12); + P=[1 0 0 0 1 1 1 0 1 1 0 1; + 0 0 0 1 1 1 0 1 1 0 1 1; + 0 0 1 1 1 0 1 1 0 1 0 1; + 0 1 1 1 0 1 1 0 1 0 0 1; + 1 1 1 0 1 1 0 1 0 0 0 1; + 1 1 0 1 1 0 1 0 0 0 1 1; + 1 0 1 1 0 1 0 0 0 1 1 1; + 0 1 1 0 1 0 0 0 1 1 1 1; + 1 1 0 1 0 0 0 1 1 1 0 1; + 1 0 1 0 0 0 1 1 1 0 1 1; + 0 1 0 0 0 1 1 1 0 1 1 1; + 1 1 1 1 1 1 1 1 1 1 1 0;]; + G=[P I]; %generator. + + ##for rowi=1:rows(M) + ## C(rowi,:)=mod(M(rowi,:)*G,2); %code. + ##end + + C=mod(M*repmat(G,[1,rows(M)]),2); + C=C(:,1:24); + +end diff --git a/octave_packages/communications-1.1.1/egolaygen.m b/octave_packages/communications-1.1.1/egolaygen.m new file mode 100644 index 0000000..95662a3 --- /dev/null +++ b/octave_packages/communications-1.1.1/egolaygen.m @@ -0,0 +1,41 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} egolaygen () +## +## Returns the Extended Golay code (24,12) generator matrix, +## which can correct upto 3 errors. The second argument is the partiy +## check matrix, for this code. +## +## @end deftypefn +## @seealso{egolaydec,egolayenc} + +function [G,P]=egolaygen() + I=eye(12); + P=[1 0 0 0 1 1 1 0 1 1 0 1; + 0 0 0 1 1 1 0 1 1 0 1 1; + 0 0 1 1 1 0 1 1 0 1 0 1; + 0 1 1 1 0 1 1 0 1 0 0 1; + 1 1 1 0 1 1 0 1 0 0 0 1; + 1 1 0 1 1 0 1 0 0 0 1 1; + 1 0 1 1 0 1 0 0 0 1 1 1; + 0 1 1 0 1 0 0 0 1 1 1 1; + 1 1 0 1 0 0 0 1 1 1 0 1; + 1 0 1 0 0 0 1 1 1 0 1 1; + 0 1 0 0 0 1 1 1 0 1 1 1; + 1 1 1 1 1 1 1 1 1 1 1 0;]; + G=[P I]; %generator. +end diff --git a/octave_packages/communications-1.1.1/encode.m b/octave_packages/communications-1.1.1/encode.m new file mode 100644 index 0000000..d7963d0 --- /dev/null +++ b/octave_packages/communications-1.1.1/encode.m @@ -0,0 +1,213 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{code} =} encode (@var{msg},@var{n},@var{k}) +## @deftypefnx {Function File} {@var{code} =} encode (@var{msg},@var{n},@var{k},@var{typ}) +## @deftypefnx {Function File} {@var{code} =} encode (@var{msg},@var{n},@var{k},@var{typ},@var{opt}) +## @deftypefnx {Function File} {[@var{code}, @var{added}] =} encode (@var{...}) +## +## Top level block encoder. This function makes use of the lower level +## functions such as @dfn{cyclpoly}, @dfn{cyclgen}, @dfn{hammgen}, and +## @dfn{bchenco}. The message to code is pass in @var{msg}, the +## codeword length is @var{n} and the message length is @var{k}. This +## function is used to encode messages using either: +## +## @table @asis +## @item A [n,k] linear block code defined by a generator matrix +## @item A [n,k] cyclic code defined by a generator polynomial +## @item A [n,k] Hamming code defined by a primitive polynomial +## @item A [n,k] BCH code code defined by a generator polynomial +## @end table +## +## The type of coding to use is defined by the variable @var{typ}. This +## variable is a string taking one of the values +## +## @table @code +## @item 'linear' or 'linear/binary' +## A linear block code is assumed with the coded message @var{code} being in +## a binary format. In this case the argument @var{opt} is the generator +## matrix, and is required. +## @item 'cyclic' or 'cyclic/binary' +## A cyclic code is assumed with the coded message @var{code} being in a +## binary format. The generator polynomial to use can be defined in @var{opt}. +## The default generator polynomial to use will be +## @dfn{cyclpoly(@var{n},@var{k})} +## @item 'hamming' or 'hamming/binary' +## A Hamming code is assumed with the coded message @var{code} being in a +## binary format. In this case @var{n} must be of an integer of the form +## @code{2^@var{m}-1}, where @var{m} is an integer. In addition @var{k} +## must be @code{@var{n}-@var{m}}. The primitive polynomial to use can +## be defined in @var{opt}. The default primitive polynomial to use is +## the same as defined by @dfn{hammgen}. +## @item 'bch' or 'bch/binary' +## A BCH code is assumed with the coded message @var{code} being in a binary +## format. The generator polynomial to use can be defined in @var{opt}. +## The default generator polynomial to use will be +## @dfn{bchpoly(@var{n},@var{k})} +## @end table +## +## In addition the argument 'binary' above can be replaced with 'decimal', +## in which case the message is assumed to be a decimal vector, with each +## value representing a symbol to be coded. The binary format can be in two +## forms +## +## @table @code +## @item An @var{x}-by-@var{k} matrix +## Each row of this matrix represents a symbol to be coded +## @item A vector +## The symbols are created from groups of @var{k} elements of this vector. +## If the vector length is not divisble by @var{k}, then zeros are added +## and the number of zeros added is returned in @var{added}. +## @end table +## +## It should be noted that all internal calculations are performed in the +## binary format. Therefore for large values of @var{n}, it is preferable +## to use the binary format to pass the messages to avoid possible rounding +## errors. Additionally, if repeated calls to @dfn{encode} will be performed, +## it is often faster to create a generator matrix externally with the +## functions @dfn{hammgen} or @dfn{cyclgen}, rather than let @dfn{encode} +## recalculate this matrix at each iteration. In this case @var{typ} should +## be 'linear'. The exception to this case is BCH codes, whose encoder +## is implemented directly from the polynomial and is significantly faster. +## +## @end deftypefn +## @seealso{decode,cyclgen,cyclpoly,hammgen,bchenco,bchpoly} + +function [code, added] = encode(msg, n, k, typ, opt) + + if ((nargin < 3) || (nargin > 5)) + usage ("[code, added] = encode (msg, n, k [, typ [, opt]])"); + endif + + if (!isscalar(n) || (n != floor(n)) || (n < 3)) + error ("encode: codeword length must be an integer greater than 3"); + endif + + if (!isscalar(k) || (k != floor(k)) || (k > n)) + error ("encode: message length must be an integer less than codeword length"); + endif + + if (nargin > 3) + if (!ischar(typ)) + error ("encode: type argument must be a string"); + else + ## Why the hell did matlab decide on such an ugly way of passing 2 args! + if (strcmp(typ,"linear") || strcmp(typ,"linear/binary")) + coding = "linear"; + msgtyp = "binary"; + elseif (strcmp(typ,"linear/decimal")) + coding = "linear"; + msgtyp = "decimal"; + elseif (strcmp(typ,"cyclic") || strcmp(typ,"cyclic/binary")) + coding = "cyclic"; + msgtyp = "binary"; + elseif (strcmp(typ,"cyclic/decimal")) + coding = "cyclic"; + msgtyp = "decimal"; + elseif (strcmp(typ,"bch") || strcmp(typ,"bch/binary")) + coding = "bch"; + msgtyp = "binary"; + elseif (strcmp(typ,"bch/decimal")) + coding = "bch"; + msgtyp = "decimal"; + elseif (strcmp(typ,"hamming") || strcmp(typ,"hamming/binary")) + coding = "hamming"; + msgtyp = "binary"; + elseif (strcmp(typ,"hamming/decimal")) + coding = "hamming"; + msgtyp = "decimal"; + else + error ("encode: unrecognized coding and/or message type"); + endif + endif + else + coding = "hamming"; + msgtyp = "binary"; + endif + + added = 0; + if (strcmp(msgtyp,"binary")) + vecttyp = 0; + if ((max(msg(:)) > 1) || (min(msg(:)) < 0)) + error ("encode: illegal value in message"); + endif + [ncodewords, k2] = size(msg); + len = k2*ncodewords; + if (min(k2,ncodewords) == 1) + vecttyp = 1; + msg = vec2mat(msg,k); + ncodewords = size(msg,1); + elseif (k2 != k) + error ("encode: message matrix must be k columns wide"); + endif + else + if (!isvector(msg)) + error ("encode: decimally encoded message must be a vector"); + endif + if ((max(msg) > 2^k-1) || (min(msg) < 0)) + error ("encode: illegal value in message"); + endif + ncodewords = length(msg); + msg = de2bi(msg(:),k); + endif + + if (strcmp(coding,"bch")) + if (nargin > 4) + code = bchenco(msg,n,k,opt); + else + code = bchenco(msg,n,k); + endif + else + if (strcmp(coding,"linear")) + if (nargin > 4) + gen = opt; + if ((size(gen,1) != k) || (size(gen,2) != n)) + error ("encode: generator matrix is in incorrect form"); + endif + else + error ("encode: linear coding must supply the generator matrix"); + endif + elseif (strcmp(coding,"cyclic")) + if (nargin > 4) + [par, gen] = cyclgen(n,opt); + else + [par, gen] = cyclgen(n,cyclpoly(n,k)); + endif + else + m = log2(n + 1); + if ((m != floor(m)) || (m < 3) || (m > 16)) + error ("encode: codeword length must be of the form '2^m-1' with integer m"); + endif + if (k != (n-m)) + error ("encode: illegal message length for hamming code"); + endif + if (nargin > 4) + [par, gen] = hammgen(m, opt); + else + [par, gen] = hammgen(m); + endif + endif + code = mod(msg * gen, 2); + endif + + if (strcmp(msgtyp,"binary") && (vecttyp == 1)) + code = code'; + code = code(:); + elseif (strcmp(msgtyp,"decimal")) + code = bi2de(code); + endif + +endfunction diff --git a/octave_packages/communications-1.1.1/eyediagram.m b/octave_packages/communications-1.1.1/eyediagram.m new file mode 100644 index 0000000..a100a3d --- /dev/null +++ b/octave_packages/communications-1.1.1/eyediagram.m @@ -0,0 +1,199 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} eyediagram (@var{x},@var{n}) +## @deftypefnx {Function File} {} eyediagram (@var{x},@var{n},@var{per}) +## @deftypefnx {Function File} {} eyediagram (@var{x},@var{n},@var{per},@var{off}) +## @deftypefnx {Function File} {} eyediagram (@var{x},@var{n},@var{per},@var{off},@var{str}) +## @deftypefnx {Function File} {} eyediagram (@var{x},@var{n},@var{per},@var{off},@var{str},@var{h}) +## @deftypefnx {Function File} {@var{h} =} eyediagram (@var{...}) +## +## Plot the eye-diagram of a signal. The signal @var{x} can be either in one +## of three forms +## +## @table @asis +## @item A real vector +## In this case the signal is assumed to be real and represented by the vector +## @var{x}. A single eye-diagram representing this signal is plotted. +## @item A complex vector +## In this case the in-phase and quadrature components of the signal are +## plotted seperately. +## @item A matrix with two columns +## In this case the first column represents the in-phase and the second the +## quadrature components of a complex signal. +## @end table +## +## Each line of the eye-diagram has @var{n} elements and the period is assumed +## to be given by @var{per}. The time axis is then [-@var{per}/2 @var{per}/2]. +## By default @var{per} is 1. +## +## By default the signal is assumed to start at -@var{per}/2. This can be +## overridden by the @var{off} variable, which gives the number of samples +## to delay the signal. +## +## The string @var{str} is a plot style string (example 'r+'), +## and by default is the default gnuplot line style. +## +## The figure handle to use can be defined by @var{h}. If @var{h} is not +## given, then the next available figure handle is used. The figure handle +## used in returned on @var{hout}. +## @end deftypefn +## @seealso{scatterplot} + +## 2005-04-23 Dmitri A. Sergatskov +## * modified for new gnuplot interface (octave > 2.9.0) + +function varargout = eyediagram (x, n, _per, _off, str, h) + + if ((nargin < 2) || (nargin > 6)) + usage (" h = eyediagram (x, n [, per [, off [, str [, h]]]])"); + endif + + if (isreal(x)) + if (min(size(x)) == 1) + signal = "real"; + xr = x(:); + elseif (size(x,2) == 2) + signal = "complex"; + xr = x(:,1); + xr = x(:,2); + else + error ("eyediagram: real signal input must be a vector"); + endif + else + signal = "complex"; + if (min(size(x)) != 1) + error ("eyediagram: complex signal input must be a vector"); + endif + xr = real(x(:)); + xi = imag(x(:)); + endif + + if (!length(xr)) + error ("eyediagram: zero length signal"); + endif + + if (!isscalar(n) || !isreal(n) || (floor(n) != n) || (n < 1)) + error ("eyediagram: n must be a positive non-zero integer"); + endif + + if (nargin > 2) + if (isempty(_per)) + per = 1; + elseif (isscalar(_per) && isreal(_per)) + per = _per; + else + error ("eyediagram: period must be a real scalar"); + endif + else + per = 1; + endif + + if (nargin > 3) + if (isempty(_off)) + off = 0; + elseif (!isscalar(_off) || !isreal(_off) || (floor(_off) != _off) || ... + (_off < 0) || (_off > (n-1))) + error ("eyediagram: offset must be an integer between 0 and n"); + else + off = _off; + endif + else + off = 0; + endif + + if (nargin > 4) + if (isempty(str)) + fmt = "-r"; + elseif (ischar(str)) + fmt = str; + else + error ("eyediagram: plot format must be a string"); + endif + else + fmt = "-r"; + endif + + if (nargin > 5) + if (isempty(h)) + hout = figure (); + else + hout = figure (h); + endif + else + hout = figure (); + endif + + horiz = (per*[0:n]/n - per/2)'; + if (2*floor(n/2) != n) + horiz = horiz - per / n / 2; + endif + lx = length(xr); + off = mod(off+ceil(n/2),n); + Nn = ceil((off + lx) / n); + post = Nn*n - off - lx; + xr = reshape([NaN * ones(off,1); xr; NaN * ones(post,1)],n,Nn); + xr = [xr ; [xr(1,2:end), NaN]]; + xr = [xr; NaN*ones(1,Nn)]; + if (all(isnan(xr(2:end,end)))) + xr(:,end) = []; + horiz = [repmat(horiz(1:n+1),1,Nn-1);NaN*ones(1,Nn-1)](:); + else + horiz = [repmat(horiz(1:n+1),1,Nn);NaN*ones(1,Nn)](:); + endif + + if (strcmp(signal,"complex")) + xi = reshape([NaN * ones(off,1); xi; NaN * ones(post,1)],n,Nn); + xi = [xi ; [xi(1,2:end), NaN]]; + xi = [xi; NaN*ones(1,Nn)]; + if (all(isnan(xi(2:end,end)))) + xi(:,end) = []; + endif + endif + + if (strcmp(signal,"complex")) + subplot(2,1,1); + plot(horiz,xr(:),fmt); + title("Eye-diagram for in-phase signal"); + xlabel("Time"); + ylabel("Amplitude"); + subplot(2,1,2); + plot(horiz,xi(:),fmt); + title("Eye-diagram for quadrature signal"); + xlabel("Time"); + ylabel("Amplitude"); + else + plot(horiz,xr(:),fmt); + title("Eye-diagram for signal"); + xlabel("Time"); + ylabel("Amplitude"); + endif + + if (nargout > 0) + varargout{1} = hout; + endif + +endfunction + +%!demo +%! n = 50; +%! ovsp=50; +%! x = 1:n; +%! xi = [1:1/ovsp:n-0.1]; +%! y = randsrc(1,n,[1 + 1i, 1 - 1i, -1 - 1i, -1 + 1i]) ; +%! yi = interp1(x,y,xi); +%! noisy = awgn(yi,15,"measured"); +%! eyediagram(noisy,ovsp); diff --git a/octave_packages/communications-1.1.1/fibodeco.m b/octave_packages/communications-1.1.1/fibodeco.m new file mode 100644 index 0000000..781394e --- /dev/null +++ b/octave_packages/communications-1.1.1/fibodeco.m @@ -0,0 +1,81 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} { } fibodeco (@var{code}) +## +## Returns the decoded fibonacci value from the binary vectors @var{code}. +## Universal codes like fibonacci codes Have a useful synchronization property, +## only for 255 maximum value we have designed these routines. We assume +## user has partitioned the code into several unique segments based on +## the suffix property of unique strings "11" and we just decode the +## parts. Partitioning the stream is as simple as identifying the +## "11" pairs that occur, at the terminating ends. This system implements +## the standard binaary Fibonacci codes, which means that row vectors +## can only contain 0 or 1. Ref: @url{http://en.wikipedia.org/wiki/Fibonacci_coding} +## +## @example +## @group +## fibodeco(@{[0 1 0 0 1 1]@}) %decoded to 10 +## fibodeco(@{[1 1],[0 1 1],[0 0 1 1],[1 0 1 1]@}) %[1:4] +## @end group +## @end example +## @end deftypefn +## @seealso{fiboenco} + +function num=fibodeco(code) + ## + ## generate fibonacci series table. + ## + ## f(1)=1; + ## f(2)=1; + ## + ## while ((f(end-1)+f(end)) < 256) + ## val=(f(end-1)+f(end)); + ## f=[f val]; + ## end + ## f=f(2:end); + ## + ##all numbers terminate with 1 except 0 itself. + ## + ## + ##f= [75025 46368 28657 17711 10946 6765 4181 2584 \ + ## 1597 987 610 377 233 144 89 55 \ + ## 34 21 13 8 5 3 2 1]; + ## + ##f= [ 233 144 89 55 34 21 13 8 5 3 2 1]; + + f= [ 1 2 3 5 8 13 21 34 55 89 144 233]; + L_C=length(code); + + if (nargin < 1) + error("Usage:fibodec(cell-array vectors), where each vector is +ve sequence of numbers ... + either 1 or 0"); + end + + for j=1:L_C + word=code{j}; + ##discard the terminating 1. + word=word(1:end-1); + L=length(word); + num(j)=sum(word.*f(1:L)); + end + + return +end +%! +%! assert(fibodeco({[1 1],[0 1 1],[0 0 1 1],[1 0 1 1]}),[1:4]) +%! assert(fibodeco({[0 1 0 0 1 1]}),10) +%! diff --git a/octave_packages/communications-1.1.1/fiboenco.m b/octave_packages/communications-1.1.1/fiboenco.m new file mode 100644 index 0000000..c17346a --- /dev/null +++ b/octave_packages/communications-1.1.1/fiboenco.m @@ -0,0 +1,89 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fiboenco (@var{num}) +## +## Returns the cell-array of encoded fibonacci value from the column vectors @var{num}. +## Universal codes like fibonacci codes have a useful synchronization +## property, only for 255 maximum value we have designed these routines. We assume +## user has partitioned the code into several unique segments based on +## the suffix property of unique elements [1 1] and we just decode the +## parts. Partitioning the stream is as simple as identifying the [1 1] +## pairs that occur, at the terminating ends. This system implements +## the standard binaary Fibonacci codes, which means that row vectors +## can only contain 0 or 1. Ref: http://en.wikipedia.org/wiki/Fibonacci_coding +## Ugly O(k.N^2) encoder.Ref: Wikipedia article accessed March, 2006. +## @url{http://en.wikipedia.org/wiki/Fibonacci_coding}, UCI Data Compression +## Book, @url{http://www.ics.uci.edu/~dan/pubs/DC-Sec3.html}, (accessed +## October 2006) +## +## @example +## @group +## fiboenco(10) #= code is @{[ 0 1 0 0 1 1]@} +## fiboenco(1:4) #= code is @{[1 1],[0 1 1],[0 0 1 1],[1 0 1 1]@} +## @end group +## @end example +## @end deftypefn +## @seealso{fibodeco} + +function op_num=fiboenco(num) + % + % generate fibonacci series table. + % + % f(1)=1; + % f(2)=1; + % + % while ((f(end-1)+f(end)) < 256) + % val=(f(end-1)+f(end)); + % f=[f val]; + % end + % f=sort(f(2:end),"descend"); + % + + %f= [75025 46368 28657 17711 10946 6765 4181 2584 \ + % 1597 987 610 377 233 144 89 55 \ + % 34 21 13 8 5 3 2 1]; + + if(nargin < 1) || (min(num) <= 0 || max(num) > 608) + error("Usage:fiboenco(num), where num is +ve sequence of numbers ... + and less than equal to 608"); + end + f= [ 233 144 89 55 34 21 13 8 5 3 2 1]; + + onum=num; + LEN_F=length(f); + LEN_N=length(num); + + for j=1:LEN_N + N=num(j); + rval=[]; + + %create Fibonacci encoding of a number + for i=find(f<=N):LEN_F + if(N >= f(i)) + N=N-f(i); + rval=[1 rval]; + else + rval=[0 rval]; + end + end + op_num{j}=[rval 1]; + end + return +end +%! +%!assert(fibodeco(fiboenco(1:600)),[1:600]) +%! diff --git a/octave_packages/communications-1.1.1/fibosplitstream.m b/octave_packages/communications-1.1.1/fibosplitstream.m new file mode 100644 index 0000000..d931697 --- /dev/null +++ b/octave_packages/communications-1.1.1/fibosplitstream.m @@ -0,0 +1,81 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} { } fibosplitstream (@var{code}) +## +## Returns the split data stream at the word boundaries. +## Assuming the stream was originally encoded using @code{fiboenco} +## and this routine splits the stream at the points where '11' +## occur together & gives us the code-words which +## can later be decoded from the @code{fibodeco} This however doesnt +## mean that we intend to verify if all the codewords are correct, +## and infact the last symbol in th return list can or can-not be +## a valid codeword. +## +## A example use of @code{fibosplitstream} would be +## @example +## @group +## +## fibodeco(fibosplitstream([fiboenco(randint(1,100,[0 255]))@{:@}])) +## fibodeco(fibosplitstream([fiboenco(1:10)@{:@}])) +## +## @end group +## @end example +## @seealso{fiboenco,fibodeco} +## @end deftypefn + +function symbols=fibosplitstream(stream) + if nargin < 1 + error('usage: fibosplitstream(stream); see help') + end + + symbols={}; + itr=1; + L=length(stream); + + % + % Plain & Simple Algorithm. O(N) + % Walk till marker '11' or find it. + % Then split & save. A little tricky to + % handle the edge case_ without tripping over. + % + idx=[]; + mark=1; + prev_bit=stream(1); + just_decoded=0; + + for i=2:L + if(~just_decoded && (stream(i)+prev_bit)==2 ) + symbols{itr}=[stream(mark:i)]; + mark=i+1; + prev_bit=0; + just_decoded=1; + itr=itr+1; + else + prev_bit=stream(i); + just_decoded=0; + end + + end + if(mark < L) + symbols{itr}=stream(mark:end); + end + + return +end +%! +%!assert(fibodeco(fibosplitstream([fiboenco(1:10){:}])),[1:10]) +%! diff --git a/octave_packages/communications-1.1.1/fmdemod.m b/octave_packages/communications-1.1.1/fmdemod.m new file mode 100644 index 0000000..846d96e --- /dev/null +++ b/octave_packages/communications-1.1.1/fmdemod.m @@ -0,0 +1,29 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} fmdemod (@var{x},@var{fc},@var{fs}) +## Create the FM demodulation of the signal x with carrier frequency fs. Where x is sample at frequency fs. +## @seealso{ammod,amdemod,fmmod} +## @end deftypefn + + +function m = fmdemod(s,fc,fs) + if (nargin != 3) + usage ("fmdemod(x,fs,fc)"); + endif + + ds = diff(s); + m = amdemod(abs(ds),fc,fs); diff --git a/octave_packages/communications-1.1.1/fmmod.m b/octave_packages/communications-1.1.1/fmmod.m new file mode 100644 index 0000000..a110016 --- /dev/null +++ b/octave_packages/communications-1.1.1/fmmod.m @@ -0,0 +1,30 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} fmmod (@var{x},@var{fc},@var{fs}) +## Create the FM modulation of the signal x with carrier frequency fs. Where x is sample at frequency fs. +## @seealso{ammod,fmdemod,amdemod} +## @end deftypefn + +function [s] = fmmod(m,fc,fs,freqdev) + if(nargin < 3) + usage('s = my_fmmod(m,fc,fs,freqdev)'); + end + l = length(m); + t=0:1./fs:(l-1)./fs; + int_m = cumsum(m)./fs; + + s = cos(2*pi.*fc.*t + 2*pi.*freqdev.*int_m); diff --git a/octave_packages/communications-1.1.1/gen2par.m b/octave_packages/communications-1.1.1/gen2par.m new file mode 100644 index 0000000..bfcacb5 --- /dev/null +++ b/octave_packages/communications-1.1.1/gen2par.m @@ -0,0 +1,50 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{par} =} gen2par (@var{gen}) +## @deftypefnx {Function File} {@var{gen} =} gen2par (@var{par}) +## +## Converts binary generator matrix @var{gen} to the parity chack matrix +## @var{par} and visa-versa. The input matrix must be in standard form. +## That is a generator matrix must be k-by-n and in the form [eye(k) P] +## or [P eye(k)], and the parity matrix must be (n-k)-by-n and of the +## form [eye(n-k) P'] or [P' eye(n-k)]. +## +## @end deftypefn +## @seealso{cyclgen,hammgen} + +function par = gen2par (gen) + + if (nargin != 1) + usage (" par = gen2par (gen)"); + endif + + [gr, gc] = size(gen); + + if (gr > gc) + error ("gen2par: input matrix must be in standard form"); + endif + + ## Identify where is the identity matrix + if (isequal(gen(:,1:gr),eye(gr))) + par = [gen(:,gr+1:gc)', eye(gc-gr)]; + elseif (isequal(gen(:,gc-gr+1:gc),eye(gr))) + par = [eye(gc-gr), gen(:,1:gc-gr)']; + else + error ("gen2par: input matrix must be in standard form"); + endif + +endfunction diff --git a/octave_packages/communications-1.1.1/genqamdemod.m b/octave_packages/communications-1.1.1/genqamdemod.m new file mode 100644 index 0000000..b98c87c --- /dev/null +++ b/octave_packages/communications-1.1.1/genqamdemod.m @@ -0,0 +1,38 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{z}] =} genqamdemod(@var{y},@var{const}) +## Compute the general quadrature amplitude demodulation of y. +## @seealso{genqammod,qammod,qamdemod} +## @end deftypefn + +function z = genqamdemod(y,const) + if ( nargin < 1 || nargin > 2) + error('usage : z = genqamdemod(y,const)'); + end + + if(isvector(const) ~= 1) + error('const must be a vector'); + end + + for k = 1:size(y,1) + for l = 1:size(y,2) + [val z(k,l)] = min(abs(y(k,l)-const)); + end + end + + z = z -1; + diff --git a/octave_packages/communications-1.1.1/genqammod.m b/octave_packages/communications-1.1.1/genqammod.m new file mode 100644 index 0000000..09c015d --- /dev/null +++ b/octave_packages/communications-1.1.1/genqammod.m @@ -0,0 +1,51 @@ +## Copyright (C) 2006 Charalampos C. Tsimenidis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} genqammod (@var{x}, @var{c}) +## +## Modulates an information sequence of intergers @var{x} in the range +## @code{[0 @dots{} M-1]} onto a quadrature amplitude modulated signal +## @var{y}, where @code{M = length(c) - 1} and @var{c} is a 1D vector +## specifing the signal constellation mapping to be used. An example of +## combined 4PAM-4PSK is +## +## @example +## @group +## d = randint(1,1e4,8); +## c = [1+j -1+j -1-j 1-j 1+sqrt(3) j*(1+sqrt(3)) -1-sqrt(3) -j*(1+sqrt(3))]; +## y = genqammod(d,c); +## z = awgn(y,20); +## plot(z,'rx') +## @end group +## @end example +## @end deftypefn +## @seealso{genqamdemod} + +function y=genqammod(x,c) + +if nargin<2 + usage("y = genqammod (x, c)"); +endif + +m=0:length(c)-1; +if ~isempty(find(ismember(x,m)==0)) + error("x elements should be integers in the set [0, length(c)-1]."); +endif + +y=c(x+1); + +%!assert(genqammod([0:7],[-7:2:7]),[-7:2:7]) +%!assert(genqammod([0:7],[-7 -5 -1 -3 7 5 1 3]),[-7 -5 -1 -3 7 5 1 3]) diff --git a/octave_packages/communications-1.1.1/gftable.m b/octave_packages/communications-1.1.1/gftable.m new file mode 100644 index 0000000..ceb99b7 --- /dev/null +++ b/octave_packages/communications-1.1.1/gftable.m @@ -0,0 +1,28 @@ +## Copyright (C) 2002 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gftable (@var{m}, @var{primpoly}) +## +## This function exists for compatiability with matlab. As the octave galois +## fields store a copy of the lookup tables for every field in use internally, +## there is no need to use this function. +## +## @end deftypefn +## @seealso{gf} + +function r = gftable(m, prim) + +endfunction diff --git a/octave_packages/communications-1.1.1/gfweight.m b/octave_packages/communications-1.1.1/gfweight.m new file mode 100644 index 0000000..f3ea95c --- /dev/null +++ b/octave_packages/communications-1.1.1/gfweight.m @@ -0,0 +1,78 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{w} = } gfweight (@var{gen}) +## @deftypefnx {Function File} {@var{w} = } gfweight (@var{gen},'gen') +## @deftypefnx {Function File} {@var{w} = } gfweight (@var{par},'par') +## @deftypefnx {Function File} {@var{w} = } gfweight (@var{p},n) +## +## Calculate the minimum weight or distance of a linear block code. The +## code can be either defined by its generator or parity check matrix, or +## its generator polynomial. By default if the first argument is a matrix, +## it is assumed to be the generator matrix of the code. The type of the +## matrix can be defined by a flag 'gen' for the generator matrix or +## 'par' for the parity check matrix. +## +## If the first argument is a vector, it is assumed that it defines the +## generator polynomial of the code. In this case a second argument is +## required that defines the codeword length. +## +## @end deftypefn +## @seealso{hammgen,cyclpoly,bchpoly} + +function w = gfweight (arg1, arg2) + + if ((nargin < 1) || (nargin > 2)) + usage ("gfweight(mat,typ) or gfweight(poly,n)"); + endif + + if (isvector(arg1)) + if (nargin != 2) + error ("gfweight: need the codeword length if passing generator polynomial"); + endif + [ign, gen] = cyclgen(arg2, arg1); + elseif (ismatrix(arg1)) + if (nargin == 2) + if (ischar(arg2)) + if (strcmp(arg2,"gen")) + gen = arg1; + elseif (strcmp(arg2,"par")) + gen = gen2par(arg1); + else + error ("gfweight: unrecognized string argument"); + endif + else + error ("gfweight: if first argument is a matrix, the second must be a string"); + endif + else + gen = arg1; + endif + else + error ("gfweight: first argument must be a matrix or a vector"); + endif + + [k, n] = size(gen); + if (n < k) + error ("gfweight: generator matrix in an illegal form"); + endif + + ## We only need to test codewords 1:2^k-1 against the zero code word + ## We do the equivalent of + ## w = min(sum((mod(de2bi([1:2^k-1]') * gen, 2))')); + ## But in a more memory efficient manner in an oct-file + w = __gfweight__(gen); + +endfunction diff --git a/octave_packages/communications-1.1.1/golombdeco.m b/octave_packages/communications-1.1.1/golombdeco.m new file mode 100644 index 0000000..9bb3004 --- /dev/null +++ b/octave_packages/communications-1.1.1/golombdeco.m @@ -0,0 +1,92 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} golombdeco (@var{code}, @var{m}) +## +## Returns the Golomb decoded signal vector using @var{code} and @var{m}. +## Compulsory m is need to be specified. A restrictions is that a +## signal set must strictly be non-negative. The value of code +## is a cell array of row-vectors which have the encoded golomb value +## for a single sample. The Golomb algorithm is, +## used to encode the 'code' and only that can be meaningfully +## decoded. @var{code} is assumed to have been of format generated +## by the function @code{golombenco}. Also the parameter @var{m} need to +## be a non-zero number, unless which it makes divide-by-zero errors. +## This function works backward the Golomb algorithm see +## @code{golombenco} for more detials on that. +## Reference: Solomon Golomb, Run length Encodings, 1966 IEEE Trans Info' Theory +## +## An exmaple of the use of @code{golombdeco} is +## @example +## @group +## golombdeco(golombenco(1:4,2),2) +## @end group +## @end example +## @end deftypefn +## @seealso{golombenco} + +##! /usr/bin/octave -q +#A stress test routine +#for i=1:100 +# sig=abs(randint(1,10,[0,255])); +# k=mod(i,10)+1; +# code=golombenco(sig,k); +# assert(golombdeco(code,k),sig) +#end +# +#for k=1:10; +# assert(golombdeco(golombenco(4:10,k),k),[4:10]); +#end +# +function sig_op=golombdeco(code,m) + if ( nargin < 2 ) || (strcmp(class(code),"cell")~=1 || m<=0) + error('usage: golombdeco(code,m)'); + end + + L=length(code); + C=ceil(log2(m)); + partition_limit=2**C-m; + + + power_seq=[2.^(ceil(log2(m))-1:-1:0)]; + power_seq_mod=power_seq(2:end); + + for j=1:L + word=code{j}; + WL=length(word); + idx=find(word==0)(1); + q=sum(word(1:idx)); + + idx2=(WL-idx); + word_tail=word(idx+1:end); + + if(length(word_tail) == C) + r=sum(word_tail.*power_seq); + r=r-(partition_limit); + else + r=sum(word_tail.*power_seq_mod); + end + + quot(j)=q; + rem(j)=r; + end + sig_op=quot.*m + rem; + + return +end +%! +%! assert(golombdeco(golombenco(1:4,2),2),[1:4]) +%! diff --git a/octave_packages/communications-1.1.1/golombenco.m b/octave_packages/communications-1.1.1/golombenco.m new file mode 100644 index 0000000..88c75fa --- /dev/null +++ b/octave_packages/communications-1.1.1/golombenco.m @@ -0,0 +1,104 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} golombenco (@var{sig}, @var{m}) +## +## Returns the Golomb coded signal as cell array. +## Also total length of output code in bits can be obtained. +## This function uses a @var{m} need to be supplied for encoding signal vector +## into a golomb coded vector. A restrictions is that +## a signal set must strictly be non-negative. Also the parameter @var{m} need to +## be a non-zero number, unless which it makes divide-by-zero errors. +## The Golomb algorithm [1], is used to encode the data into unary coded +## quotient part which is represented as a set of 1's separated from +## the K-part (binary) using a zero. This scheme doesnt need any +## kind of dictionaries, it is a parameterized prefix codes. +## Implementation is close to O(N^2), but this implementation +## *may be* sluggish, though correct. Details of the scheme are, to +## encode the remainder(r of number N) using the floor(log2(m)) bits +## when rem is in range 0:(2^ceil(log2(m)) - N), and encode it as +## r+(2^ceil(log2(m)) - N), using total of 2^ceil(log2(m)) bits +## in other instance it doesnt belong to case 1. Quotient is coded +## simply just using the unary code. Also accroding to [2] Golomb codes +## are optimal for sequences using the bernoulli probability model: +## P(n)=p^n-1.q & p+q=1, and when M=[1/log2(p)], or P=2^(1/M). +## +## Reference: 1. Solomon Golomb, Run length Encodings, 1966 IEEE Trans +## Info' Theory. 2. Khalid Sayood, Data Compression, 3rd Edition +## +## An exmaple of the use of @code{golombenco} is +## @example +## @group +## golombenco(1:4,2) # +## golombenco(1:10,2) # +## @end group +## @end example +## @end deftypefn +## @seealso{golombdeco} + +function [gcode,Ltot]=golombenco(sig,m) + if ( nargin < 2 || m<=0) + error('usage: golombenco(sig,m); see help'); + end + + if (min(sig) < 0) + error("signal has elements that are outside alphabet set ... + . Accepts only non-negative numbers. Cannot encode."); + end + + L=length(sig); + quot=floor(sig./m); + rem=sig-quot.*m; + + + C=ceil(log2(m)); + partition_limit=2**C-m; + Ltot=0; + for j=1:L + if( rem(j) < partition_limit ) + BITS=C-1; + else + rem(j)=rem(j)+partition_limit; + BITS=C; + end + Ltot=Ltot+BITS+1; + golomb_part=zeros(1,BITS); + + % + % How can we eliminate this loop? + % I essentially need to get the binary + % representation of rem(j) in the golomb_part(i); + % -maybe when JWE or someone imports dec2binvec. + % This does MSB -> LSB + for i=BITS:-1:1 + golomb_part(i)=mod(rem(j),2); + rem(j)=floor(rem(j)/2); + end + + % + %actual golomb code: sandwich the unary coded quotient, + %and the remainder. + % + gcode{j}=[ones(1,quot(j)) 0 golomb_part]; + end + Ltot=sum(quot)+Ltot; + + return +end +%! +%! assert(golombenco(3:5,5),{[0 1 1 0],[0 1 1 1],[1 0 0 0 ]}) +%! assert(golombenco(3:5,3),{[1 0 0] , [1 0 1 0],[1 0 1 1]}) +%! diff --git a/octave_packages/communications-1.1.1/hammgen.m b/octave_packages/communications-1.1.1/hammgen.m new file mode 100644 index 0000000..abd3e18 --- /dev/null +++ b/octave_packages/communications-1.1.1/hammgen.m @@ -0,0 +1,73 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} = } hammgen (@var{m}) +## @deftypefnx {Function File} {@var{h} = } hammgen (@var{m},@var{p}) +## @deftypefnx {Function File} {[@var{h},@var{g}] = } hammgen (@var{...}) +## @deftypefnx {Function File} {[@var{h},@var{g},@var{n},@var{k}] = } hammgen (@var{...}) +## +## Produce the parity check and generator matrices of a Hamming code. The +## variable @var{m} defines the [@var{n},@var{k}] Hamming code where +## @code{@var{n} = 2 ^ @var{m} - 1} and @code{@var{k} = @var{n} - @var{m}}. +## @var{m} must be between 3 and 16. +## +## The parity check matrix is generated relative to the primitive polynomial +## of GF(2^@var{m}). If @var{p} is specified the default primitive polynomial +## of GF(2^@var{m}) is overridden. @var{p} must be a valid primitive +## polynomial of the correct order for GF(2^@var{m}). +## +## The parity check matrix is returned in the @var{m} by @var{n} matrix +## @var{h}, and if requested the generator matrix is returned in the @var{k} +## by @var{n} matrix @var{g}. +## +## @end deftypefn +## @seealso{gen2par} + +function [h, g, n, k] = hammgen(m, p) + + if ((nargin < 1) || (nargin > 2)) + usage ("[h [, g [, n, k]]] = hammgen (m [, p])"); + endif + + if (!isscalar(m) || (floor(m) != m) || (m < 3) || (m > 16)) + error ("hammgen: m must be an integer between 3 and 16"); + endif + + if (nargin > 1) + if (!isscalar(p)) + p = bi2de(p); + endif + if ((floor(p) != p) || (p < 2^m) || (p > 2^(m+1)) || !isprimitive(p)) + error ("hammgen: p must be a primitive polynomial of GF(2^m)"); + endif + else + ## Get the primitive polynomial of GF(2^M). Note that the default + ## primitive polynomial is not necessarily primpoly(m,"min"), so + ## have to create a Galois variable to extract the default primitive. + ## The problem is, this limits m to be less than or equal to 16, + ## as the Galois type itself is limited to this value + p = gf(0,m).prim_poly; + endif + + n = 2^m -1; + k = n - m; + if (nargout > 1) + [h, g] = cyclgen(n, p); + else + h = cyclgen(n,p); + endif + +endfunction diff --git a/octave_packages/communications-1.1.1/helintrlv.m b/octave_packages/communications-1.1.1/helintrlv.m new file mode 100644 index 0000000..9946de0 --- /dev/null +++ b/octave_packages/communications-1.1.1/helintrlv.m @@ -0,0 +1,71 @@ +## Copyright (C) 2010 Mark Borgerding +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{outdata} =} helintrlv (@var{data}, @var{col}, @var{ngrp},@var{stp}) +## @var{col}-by-@var{ngrp}. +## @seealso{heldeintrlv} +## @end deftypefn + +function [outdata,outstate] = helintrlv(data,col,ngrp,stp,init_state) + + if (nargin < 4 ||nargin>5) + error('usage : interlvd = helintrlv(data,col,ngrp,stp)'); + end + + if(~isscalar(col) || ~isscalar(ngrp)) + error("col and ngrp must be integers"); + end + + if( col ~= floor(col)|| ngrp ~= floor(ngrp)) + error("col and ngrp must be integers"); + end + + didTranspose=0; + if ( isvector(data) && columns(data) > rows(data) ) + data = data.'; + didTranspose=1; + end + + s = size(data); + + if s(1) ~= col*ngrp + error("The length of data must be equals to ngrp*col"); + end + + if nargin==4 + init_state = zeros(stp*col*(col-1)/2,s(2)); + end + + outstate =[]; + # for each column + for k = 1:s(2) + tmp = reshape( data(:,k) , ngrp, col ); + instate = init_state(:,k); + outstateCol=[]; + for k1=2:col + curStepSize = (k1-1)*stp; + tmpCol= [instate(1:curStepSize) ;tmp(:,k1)]; + tmp(:,k1) = tmpCol(1:ngrp); + outstateCol=[outstateCol;tmpCol(end+1-curStepSize:end)]; + instate = instate(curStepSize+1:end); + end + outdata(:,k) = reshape(tmp.',s(1),1); + outstate = [outstate outstateCol]; + end + + if didTranspose + outdata = outdata.'; + end diff --git a/octave_packages/communications-1.1.1/helscandeintrlv.m b/octave_packages/communications-1.1.1/helscandeintrlv.m new file mode 100644 index 0000000..fc1975a --- /dev/null +++ b/octave_packages/communications-1.1.1/helscandeintrlv.m @@ -0,0 +1,23 @@ +## Copyright (C) 2010 Mark Borgerding +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{outdata} =} helscandeintrlv (@var{data}, @var{nrows}, @var{ncols},@var{Nshift}) +## @var{nrows}-by-@var{ncols}. +## @seealso{helscandeintrlv} +## @end deftypefn + +function outdata = helscandeintrlv(data,Nrows,Ncols,Nshift) + outdata = helscanintrlv(data,Nrows,Ncols,Nrows-Nshift); diff --git a/octave_packages/communications-1.1.1/helscanintrlv.m b/octave_packages/communications-1.1.1/helscanintrlv.m new file mode 100644 index 0000000..891a232 --- /dev/null +++ b/octave_packages/communications-1.1.1/helscanintrlv.m @@ -0,0 +1,61 @@ +## Copyright (C) 2010 Mark Borgerding +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{outdata} =} helscanintrlv (@var{data}, @var{nrows}, @var{ncols},@var{Nshift}) +## @var{nrows}-by-@var{ncols}. +## @seealso{helscandeintrlv} +## @end deftypefn + +function outdata = helscanintrlv(data,Nrows,Ncols,Nshift) + + if(nargin ~= 4 ) + error('usage : interlvd = helscanintrlv(data,Nrows,Ncols,Nshift)'); + end + + if(~isscalar(Nrows) || ~isscalar(Ncols)) + error("Nrows and Ncols must be integers"); + end + + if( Nrows ~= floor(Nrows)|| Ncols ~= floor(Ncols)) + error("Nrows and Ncols must be integers"); + end + + didTranspose=0; + if ( isvector(data) && columns(data) > rows(data) ) + data = data.'; + didTranspose=1; + end + + s = size(data); + + if size(data,1) ~= Nrows*Ncols + error("The length of data must be equals to Ncols*Nrows"); + end + + # create the interleaving indices + idx0 = 0:Nrows*Ncols-1; + idxMod = rem(idx0,Ncols); + idxFlr = idx0 - idxMod; + inds = 1+rem(idxFlr + idxMod * Ncols * Nshift + idxMod,Nrows*Ncols); + + # for each column + for k = 1:s(2) + outdata(:,k) = data(inds,k); + end + + if didTranspose + outdata = outdata.'; + end diff --git a/octave_packages/communications-1.1.1/huffmandeco.m b/octave_packages/communications-1.1.1/huffmandeco.m new file mode 100644 index 0000000..9223a28 --- /dev/null +++ b/octave_packages/communications-1.1.1/huffmandeco.m @@ -0,0 +1,102 @@ +## Copyright (C) 2006 Muthiah Annamalai +## Copyright (C) 2011 Ferran Mesas Garcia +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sig} =} huffmandeco (@var{hcode}, @var{dict}) +## Decode signal encoded by @code{huffmanenco}. +## +## This function uses a dict built from the +## @code{huffmandict} and uses it to decode a signal list into a huffman +## list. A restriction is that @var{hcode} is expected to be a binary code +## +## The returned @var{sig} set that strictly belongs in the range @code{[1,N]} +## with @code{N = length(@var{dict})}. Also @var{dict} can only be from the +## @code{huffmandict} routine. Whenever decoding fails, those signal values a +## re indicated by @code{-1}, and we successively try to restart decoding +## from the next bit that hasn't failed in decoding, ad-infinitum. An example +## of the use of @code{huffmandeco} is: +## +## @example +## @group +## hd = huffmandict (1:4, [0.5 0.25 0.15 0.10]); +## hcode = huffmanenco (1:4, hd); +## back = huffmandeco (hcode, hd) +## @result{} [1 2 3 4] +## @end group +## @end example +## @seealso{huffmandict, huffmanenco} +## @end deftypefn + +function symbols = huffmandeco (hcode, dict) + + if (nargin != 2) + print_usage(); + elseif (!all((hcode == 1) + (hcode == 0)) || !isvector(hcode)) + error ("first argument must be a binary array"); + elseif (!strcmp (class (dict), "cell")) + error ("second argument must be of the class dict (from `huffmandict')"); + end + + ## Convert the Huffman Dictionary to a Huffman Tree represented by + ## an array. + tree = dict2tree(dict); + + ## Traverse the tree and store the symbols. + symbols = []; + pointer = 1; # a pointer to a node of the tree. + for i = 1:length (hcode); + if (tree(pointer) != -1) + symbols = [symbols, tree(pointer)]; + pointer = 1; + endif + pointer = 2 * pointer + hcode(i); + endfor + + ## Check if decodification was successful + if (tree(pointer) == -1) + warning ("could not decode last symbol.") + endif + symbols = [symbols, tree(pointer)]; +endfunction + +function tree = dict2tree (dict) + L = length(dict); + lengths = zeros(1,L); + + ## the depth of the tree is limited by the maximum word length. + for i = 1:L + lengths(i) = length (dict{i}); + endfor + m = max (lengths); + + tree = zeros(1,2^(m+1)-1)-1; + + for i = 1:L + pointer = 1; + word = dict{i}; + for bit = word + pointer = 2 * pointer + bit; + endfor + tree(pointer) = i; + endfor +endfunction + +%!assert(huffmandeco(huffmanenco(1:4, huffmandict(1:4,[0.5 0.25 0.15 0.10])), huffmandict(1:4,[0.5 0.25 0.15 0.10])), [1:4],0) +%!assert(huffmandeco(huffmanenco([1:100 100:-1:1], huffmandict(1:100,ones(1,100)/100)), huffmandict(1:100,ones(1,100)/100)), [1:100 100:-1:1],0) +%!assert(huffmandeco([huffmanenco(1:4, huffmandict(1:4,[0.5 0.25 0.15 0.10])) 0], huffmandict(1:4,[0.5 0.25 0.15 0.10])), [1:4 -1],0) +%!fail('huffmandeco([huffmanenco(1:4, huffmandict(1:4,[0.5 0.25 0.15 0.10])) 0], huffmandict(1:4,[0.5 0.25 0.15 0.10]))','warning') +%!fail('huffmandeco(''this is not a code'',huffmandict(1:4,[0.5 0.25 0.15 0.10]))') +%!fail('huffmandeco([1 0 1 0],''this is not a dictionary'')') diff --git a/octave_packages/communications-1.1.1/huffmandict.m b/octave_packages/communications-1.1.1/huffmandict.m new file mode 100644 index 0000000..17415ef --- /dev/null +++ b/octave_packages/communications-1.1.1/huffmandict.m @@ -0,0 +1,222 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} huffmandict (@var{symb}, @var{prob}) +## @deftypefnx {Function File} {} huffmandict (@var{symb}, @var{prob}, @var{toggle}) +## @deftypefnx {Function File} {} huffmandict (@var{symb}, @var{prob}, @var{toggle}, @var{minvar}) +## +## Builds a Huffman code, given a probability list. The Huffman codes +## per symbol are output as a list of strings-per-source symbol. A zero +## probability symbol is NOT assigned any codeword as this symbol doesn't +## occur in practice anyway. +## +## @var{toggle} is an optional argument with values 1 or 0, that starts +## building a code based on 1's or 0's, defaulting to 0. Also @var{minvar} +## is a boolean value that is useful in choosing if you want to optimize +## buffer for transmission in the applications of Huffman coding, however +## it doesn't affect the type or average codeword length of the generated +## code. An example of the use of @code{huffmandict} is +## +## @example +## @group +## huffmandict(symbols, [0.5 0.25 0.15 0.1]) => CW(0,10,111,110) +## huffmandict(symbols, 0.25*ones(1,4)) => CW(11,10,01,00) +## +## prob=[0.5 0 0.25 0.15 0.1] +## dict=huffmandict(1:5,[0.5 0 0.25 0.15 0.1],1) +## entropy(prob) +## laverage(dict,prob) +## +## x = [0.20000 0.40000 0.20000 0.10000 0.10000]; +## #illustrates the minimum variance thing. +## huffmandict(1,x,0,true) #min variance tree. +## huffmandict(1,x) #normal huffman tree. +## @end group +## @end example +## +## Reference: Dr.Rao's course EE5351 Digital Video Coding, at UT-Arlington. +## @seealso{huffmandeco, huffmanenco} +## @end deftypefn + +## Huffman code algorithm. +## while (uncombined_symbols_remain) +## combine least probable symbols into one with, +## their probability being the sum of the two. +## save this result as a stage at lowest order rung. +## (Moving to lowest position possible makes it non-minimum variance +## entropy coding) +## end +## +## for each (stage) +## Walk the tree we built, and assign each row either 1, +## or 0 of +## end +## +## reverse each symbol, and dump it out. +## + +function cw_list = huffmandict (sym, source_prob, togglecode = 0, minvar = 0) + if nargin < 2 + print_usage; + ## need to compare to 1 + elseif((sum(source_prob)-1.0) > 1e-7 ) + error("source probabilities must add up to 1.0"); + end + + % + %need to find & eliminate the zero-probability code words. + %in practice we donot need to assign anything to them. Reasoning + %being that if_ it doesnt occur why bother saving its value anyway? + %--(Oct 9) Actually some experts in the area dont agree to this, + %and being a generic implementation we should stick to generating + %CW's for_ zero symbols. Why impose a bad implementation? --Muthu + % + + origsource_prob=source_prob; + + % + %sort the list and know the index transpositions. kills the speed O(n^2). + % + L=length(source_prob); + index=[1:L]; + for itr1=1:L + for itr2=itr1:L + if(source_prob(itr1) < source_prob(itr2)) + t=source_prob(itr1); + source_prob(itr1)=source_prob(itr2); + source_prob(itr2)=t; + + t=index(itr1); + index(itr1)=index(itr2); + index(itr2)=t; + end + end + end + + stage_list = {}; + cw_list = cell(1,L); + + stage_curr={}; + stage_curr.prob_list=source_prob; + stage_curr.sym_list={}; + S=length(source_prob); + for i=1:S; + stage_curr.sym_list{i}=[i]; + #cw_list{i}=""; + end + + % + % another O(n^2) part. + % + I=1; + while (I0) + stage_curr=stage_list{I}; + L=length(stage_curr.sym_list); + + clist=stage_curr.sym_list{L}; + for k=1:length(clist) + cw_list{1,clist(k)}=[cw_list{1,clist(k)} one_cw]; + end + + clist=stage_curr.sym_list{L-1}; + for k=1:length(clist) + cw_list{1,clist(k)}=[cw_list{1,clist(k)}, zero_cw]; + end + + % Loopie + I=I-1; + end + + % + %zero all the code-words of zero-probability length, 'cos they + %never occur. + % + S=length(source_prob); + for itr=(S+1):length(origsource_prob) + cw_list{1,itr}=-1; + end + + %disp('Before resorting') + %cw_list + + nw_list = cell(1,L); + % + % Re-sort the indices according to the probability list. + % + L=length(source_prob); + for itr=1:(L) + t=cw_list{index(itr)}; + nw_list{index(itr)}=cw_list{itr}; + end + cw_list=nw_list; + + %zero all the code-words of zero-probability length, 'cos they + %never occur. + + %for itr=1:L + % if(origsource_prob(itr)==0) + % cw_list{itr}=""; + % end + %end + + return +end + +%!assert(huffmandict(1:4,[0.5 0.25 0.15 0.1],1), {[0],[1 0],[1 1 1],[1 1 0]},0) +%!assert(huffmandict(1:4,0.25*ones(1,4),1),{[1 1],[1 0],[0 1],[0 0]},0) +%!assert(huffmandict(1:4,[1 0 0 0 ]),{[1],[0 1],[0 0 0],[0 0 1]},0) diff --git a/octave_packages/communications-1.1.1/huffmanenco.m b/octave_packages/communications-1.1.1/huffmanenco.m new file mode 100644 index 0000000..a7967d4 --- /dev/null +++ b/octave_packages/communications-1.1.1/huffmanenco.m @@ -0,0 +1,46 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} huffmanenco (@var{sig}, @var{dict}) +## +## Returns the Huffman encoded signal using @var{dict}. This function uses +## a @var{dict} built from the @code{huffmandict} and uses it to encode a +## signal list into a huffman list. A restrictions is that a signal set must +## strictly belong in the range @code{[1,N]} with @code{N = length(dict)}. +## Also @var{dict} can only be from the @code{huffmandict} routine. +## An exmaple of the use of @code{huffmanenco} is +## +## @example +## @group +## hd = huffmandict (1:4, [0.5 0.25 0.15 0.10]); +## huffmanenco (1:4, hd); +## @result{} [1 0 1 0 0 0 0 0 1] +## @end group +## @end example +## @seealso{huffmandict, huffmandeco} +## @end deftypefn + +function hcode = huffmanenco (sig, dict) + if (nargin != 2 || strcmp (class (dict),"cell") != 1) + print_usage; + elseif (max (sig) > length (dict) || min (sig) < 1) + error("signal has elements that are outside alphabet set. Cannot encode."); + endif + hcode = [dict{sig}]; + return +end + +%!assert(huffmanenco(1:4, huffmandict(1:4,[0.5 0.25 0.15 0.10])), [ 1 0 1 0 0 0 0 0 1 ],0) diff --git a/octave_packages/communications-1.1.1/intrlv.m b/octave_packages/communications-1.1.1/intrlv.m new file mode 100644 index 0000000..71a282d --- /dev/null +++ b/octave_packages/communications-1.1.1/intrlv.m @@ -0,0 +1,41 @@ +## Copyright (C) 2008 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{intrlvd} =} intrlv (@var{data}, @var{elements}) +## Interleaved elements of @var{data} according to @var{elements}. +## @seealso{deintrlv} +## @end deftypefn + +function intrlvd = intrlv(data,elements) + if(nargin < 2 || nargin >2) + error('usage : interlvd = interlv(data,elements)'); + end + + if(~isvector(elements)) + error("Elements must be a vector"); + end + + if(isvector(data)) + if(length(elements) ~= length(data) || any(sort(elements) ~= 1:length(data))) + error("elements must be a permutation of data indices"); + end + intrlvd = data(elements); + else + if(length(elements) ~= size(data,1) || any(sort(elements) ~= 1:size(data,1))) + error("elements must be a permutation of data indices"); + end + intrlvd = data(elements,:); + end diff --git a/octave_packages/communications-1.1.1/lloyds.m b/octave_packages/communications-1.1.1/lloyds.m new file mode 100644 index 0000000..4ba9c05 --- /dev/null +++ b/octave_packages/communications-1.1.1/lloyds.m @@ -0,0 +1,170 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{table}, @var{codes}] = } lloyds (@var{sig},@var{init_codes}) +## @deftypefnx {Function File} {[@var{table}, @var{codes}] = } lloyds (@var{sig},@var{len}) +## @deftypefnx {Function File} {[@var{table}, @var{codes}] = } lloyds (@var{sig},@var{...},@var{tol}) +## @deftypefnx {Function File} {[@var{table}, @var{codes}] = } lloyds (@var{sig},@var{...},@var{tol},@var{type}) +## @deftypefnx {Function File} {[@var{table}, @var{codes}, @var{dist}] = } lloyds (@var{...}) +## @deftypefnx {Function File} {[@var{table}, @var{codes}, @var{dist}, @var{reldist}] = } lloyds (@var{...}) +## +## Optimize the quantization table and codes to reduce distortion. This is +## based on the article by Lloyd +## +## S. Lloyd @emph{Least squared quantization in PCM}, IEEE Trans Inform +## Thoery, Mar 1982, no 2, p129-137 +## +## which describes an iterative technique to reduce the quantization error +## by making the intervals of the table such that each interval has the same +## area under the PDF of the training signal @var{sig}. The initial codes to +## try can either be given in the vector @var{init_codes} or as scalar +## @var{len}. In the case of a scalar the initial codes will be an equi-spaced +## vector of length @var{len} between the minimum and maximum value of the +## training signal. +## +## The stopping criteria of the iterative algorithm is given by +## +## @example +## abs(@var{dist}(n) - @var{dist}(n-1)) < max(@var{tol}, abs(@var{eps}*max(@var{sig})) +## @end example +## +## By default @var{tol} is 1.e-7. The final input argument determines how the +## updated table is created. By default the centroid of the values of the +## training signal that fall within the interval described by @var{codes} +## are used to update @var{table}. If @var{type} is any other string than +## "centroid", this behaviour is overriden and @var{table} is updated as +## follows. +## +## @example +## @var{table} = (@var{code}(2:length(@var{code})) + @var{code}(1:length(@var{code}-1))) / 2 +## @end example +## +## The optimized values are returned as @var{table} and @var{code}. In +## addition the distortion of the the optimized codes representing the +## training signal is returned as @var{dist}. The relative distortion in +## the final iteration is also returned as @var{reldist}. +## +## @end deftypefn +## @seealso{quantiz} + +function [table, code, dist, reldist] = lloyds(sig, init, tol, type) + + if ((nargin < 2) || (nargin > 4)) + usage (" [table, codes, dist, reldist] = lloyds(sig, init [, tol [,type]])"); + endif + + if (min(size(sig)) != 1) + error ("lloyds: training signal must be a vector"); + endif + + sig = sig(:); + sigmin = min(sig); + sigmax = max(sig); + + if (length(init) == 1) + len = init; + init = [0:len-1]'/(len-1) * (sigmax - sigmin) + sigmin; + elseif (min(size(init))) + len = length(init); + else + error ("lloyds: unrecognized initial codebook"); + endif + lcode = length(init); + + if (any(init != sort(init))) + ## Must be monotonically increasing + error ("lloyds: Initial codebook must be monotonically increasing"); + endif + + if (nargin < 3) + tol = 1e-7; + elseif (isempty(tol)) + tol = 1e-7; + endif + stop_criteria = max(eps * abs(sigmax), abs(tol)); + + if (nargin < 4) + type = "centroid"; + elseif (!ischar(type)) + error ("lloyds: expecting string argument for type"); + endif + + ## Setup initial codebook, table and distortion + code = init(:); + table = (code(2:lcode) + code(1:lcode-1))/2; + [indx, ignore, dist] = quantiz(sig, table, code); + reldist = abs(dist); + + while (reldist > stop_criteria) + ## The formula of the code at the new iteration is + ## + ## code = Int_{table_{i-1}}^{table_i} x PSD(sig(x)) dx / .. + ## Int_{table_{i-1}}^{table_i} PSD(sig(x)) dx + ## + ## As sig is a discrete signal, this comes down to counting the number + ## of times "sig" has values in each interval of the table, and taking + ## the mean of these values. If no value of the signals in interval, take + ## the middle of the interval. That is calculate the centroid of the data + ## of the training signal falling in the interval. We can reuse the index + ## from the previous call to quantiz to define the values in the interval. + for i=1:lcode + psd_in_interval = find(indx == i-1); + if (!isempty(psd_in_interval)) + code(i) = mean(sig(psd_in_interval)); + elseif (i == 1) + code(i) = (table(i) + sigmin) / 2; + elseif (i == lcode) + code(i) = (sigmax + table(i-1)) / 2; + else + code(i) = (table(i) + table(i-1)) / 2; + endif + end + + ## Now update the table. There is a problem here, in that I believe + ## the elements of the new table should be given by b(i)=(c(i+1)+c(i))/2, + ## but Matlab doesn't seem to do this. Matlab seems to also take the + ## centroid of the code for the table (this was a real pain to find + ## why my results and Matlab's disagreed). For this reason, I have a + ## default behaviour the same as Matlab, and allow a flag to overide + ## it to be the behaviour I expect. If any one wants to tell me what + ## the CORRECT behaviour is, then I'll get rid of of the irrelevant + ## case below. + if (strcmp(type,"centroid")) + for i=1:lcode-1; + sig_in_code = sig(find(sig >= code(i))); + sig_in_code = sig_in_code(find(sig_in_code < code(i+1))); + if (!isempty(sig_in_code)) + table(i) = mean(sig_in_code); + else + table(i) = (code(i+1) + code(i)) / 2; + endif + end + else + table = (code(2:lcode) + code(1:lcode-1))/2; + endif + + ## Update the distortion levels + reldist = dist; + [indx, ignore, dist] = quantiz(sig, table, code); + reldist = abs(reldist - dist); + endwhile + + if (size(init,1) == 1) + code = code'; + table = table'; + endif + +endfunction diff --git a/octave_packages/communications-1.1.1/lz77deco.m b/octave_packages/communications-1.1.1/lz77deco.m new file mode 100644 index 0000000..2865c0e --- /dev/null +++ b/octave_packages/communications-1.1.1/lz77deco.m @@ -0,0 +1,77 @@ +## Copyright (C) 2007 Gorka Lertxundi +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{m} =} lz77deco (@var{c}, @var{alph}, @var{la}, @var{n}) +## Lempel-Ziv 77 source algorithm decoding implementation. Where +## +## @table @asis +## @item @var{m} +## message decoded (1xN). +## @item @var{c} +## encoded message (Mx3). +## @item @var{alph} +## size of alphabet. +## @item @var{la} +## lookahead buffer size. +## @item @var{n} +## sliding window buffer size. +## @end table +## @seealso{lz77enco} +## @end deftypefn + +function m = lz77deco(c, alph, la, n) + if (la <= 0 || n <= 0) + error("lz77deco: Lookahead buffer size and window size must be higher than 0."); + endif + if n - la < la + error("lz77deco: Unreachable configuration: n - la >= la."); + endif + if alph < 2 + error("lz77deco: Alphabet size within less than 2 symbols? Is that possible?."); + endif + if columns(c) != 3 + error("lz77deco: Encoded message must be a Nx3 matrix."); + endif + + window = zeros(1,n); + x = length(c); + len = length(c); + + for x=1:len + ## update window + temp = n-la+c(x,2)-c(x,1); + for y=1:temp + window(n-la+y) = window(c(x,1)+y); + endfor + window(n-la+c(x,2)+1) = c(x,3); + + ## decoded message + m_deco = window(n-la+1:n-la+c(x,2)+1); + if x == 1 + m = m_deco; + else + m = [m m_deco]; + endif + + ## CCW shift + temp = c(x,2)+1; + window(1:n-la) = window(temp+1:n-la+temp); + endfor + +endfunction + +%!demo +%! lz77deco([8 2 1 ; 7 3 2 ; 6 7 2 ; 2 8 0],3,9,18) diff --git a/octave_packages/communications-1.1.1/lz77enco.m b/octave_packages/communications-1.1.1/lz77enco.m new file mode 100644 index 0000000..4a1b299 --- /dev/null +++ b/octave_packages/communications-1.1.1/lz77enco.m @@ -0,0 +1,93 @@ +## Copyright (C) 2007 Gorka Lertxundi +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{c} =} lz77enco (@var{m}, @var{alph}, @var{la}, @var{n}) +## Lempel-Ziv 77 source algorithm implementation. Where +## +## @table @asis +## @item @var{c} +## encoded message (Mx3). +## @item @var{alph} +## size of alphabet. +## @item @var{la} +## lookahead buffer size. +## @item @var{n} +## sliding window buffer size. +## @end table +## @seealso{lz77deco} +## @end deftypefn + +function c = lz77enco(m, alph, la, n) + + if (la <= 0 || n <= 0) + error("lz77enco: Lookahead buffer size and window size must be higher than 0.2"); + endif + if n - la < la + error("lz77enco: Unreachable configuration: n - la >= la."); + endif + if alph < 2 + error("lz77enco: Alphabet size within less than 2 symbols?"); + endif + if max(m)+1 > alph + error("lz77enco: It is not possible to codify the message, too small alphabet size."); + endif + if rows(m) != 1 + error("lz77enco: Message to encode must be a 1xN matrix."); + endif + + c = zeros(1,3); + enco = zeros(1,3); + window = zeros(1,n); + x = length(m); + len = length(m); + + while x ~= 0 + ## update window + window(1:n-la) = window(enco(2)+2:n-la+enco(2)+1); + if x < la + window(n-la+1:n) = [m(len-x+1:len) zeros(1,la-x)]; + else + window(n-la+1:n) = m(len-x+1:len-x+la); + endif + + ## get a reference (position ,length) to longest match, and next symbol + enco = [0 0 0]; + for y=(n-la):-1:1 + z = 0; + while(z ~= la && (window(y+z) == window(n-la+z+1))) + z += 1; + endwhile + + if enco(2) < z + enco(1) = y-1; + enco(2) = z; + enco(3) = window(n-la+z+1); + endif + endfor + + ## encoded message + if x == len + c = enco; + else + c = [c ; enco]; + endif + + x -= enco(2)+1; + endwhile +endfunction + +%!demo +%! lz77enco([0 0 1 0 1 0 2 1 0 2 1 0 2 1 2 0 2 1 0 2 1 2 0 0],3,9,18) diff --git a/octave_packages/communications-1.1.1/matdeintrlv.m b/octave_packages/communications-1.1.1/matdeintrlv.m new file mode 100644 index 0000000..c8557b0 --- /dev/null +++ b/octave_packages/communications-1.1.1/matdeintrlv.m @@ -0,0 +1,27 @@ +## Copyright (C) 2008 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{intrlvd} =} matdeintrlv (@var{data}, @var{nrows}, @var{ncols}) +## Restore elements of @var{data} with a tempory matrix of size +## @var{nrows}-by-@var{ncols}. +## @seealso{matintrlv} +## @end deftypefn + +function intrlvd = matdeintrlv(data,Nrows,Ncols) + if(nargin < 3 || nargin >3) + error('usage : interlvd = matdeintrlv(data,Nrows,Ncols)'); + end + intrlvd = matintrlv(data,Ncols,Nrows); diff --git a/octave_packages/communications-1.1.1/matintrlv.m b/octave_packages/communications-1.1.1/matintrlv.m new file mode 100644 index 0000000..e7a0ff8 --- /dev/null +++ b/octave_packages/communications-1.1.1/matintrlv.m @@ -0,0 +1,52 @@ +## Copyright (C) 2008 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{intrlvd} =} matintrlv (@var{data}, @var{nrows}, @var{ncols}) +## Interleaved elements of @var{data} with a tempory matrix of size +## @var{nrows}-by-@var{ncols}. +## @seealso{matdeintrlv} +## @end deftypefn + +function intrlvd = matintrlv(data,Nrows,Ncols) + + if(nargin < 3 || nargin >3) + error('usage : interlvd = matinterlv(data,Nrows,Ncols)'); + end + + if(~isscalar(Nrows) || ~isscalar(Ncols)) + error("Nrows and Ncols must be integers"); + end + + if( Nrows ~= floor(Nrows)|| Ncols ~= floor(Ncols)) + error("Nrows and Ncols must be integers"); + end + + s = size(data); + if(isvector(data)) + if(length(data) ~= Nrows*Ncols) + error("The length of data must be equals to Ncols*Nrows"); + end + data = reshape(data,Ncols,Nrows)'; + intrlvd = reshape(data,s); + else + for k = 1:s(2); + if(length(data) ~= Nrows*Ncols) + error("The number of rows of data must be equals to Ncols*Nrows"); + end + tmp(:,:,k) = reshape(data(:,k),Ncols,Nrows)'; + intrlvd(:,k) = reshape(tmp(:,:,k),s(1),1); + end + end diff --git a/octave_packages/communications-1.1.1/minpol.m b/octave_packages/communications-1.1.1/minpol.m new file mode 100644 index 0000000..13f3bcc --- /dev/null +++ b/octave_packages/communications-1.1.1/minpol.m @@ -0,0 +1,80 @@ +## Copyright (C) 2002 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} minpol (@var{v}) +## +## Finds the minimum polynomial for elements of a Galois Field. For a +## vector @var{v} with @math{N} components, representing @math{N} values +## in a Galois Field GF(2^@var{m}), return the minimum polynomial in GF(2) +## representing thos values. +## @end deftypefn + +function r = minpol (v) + + if (nargin != 1) + error("usage: r = minpol(v)"); + endif + + if (!isgalois(v)) + error("minpol: argument must be a galois variable"); + endif + + if (min (size (v)) > 1 || nargin != 1) + usage ("minpol (v), where v is a galois vector"); + endif + + n = length (v); + m = v.m; + prim_poly = v.prim_poly; + r = zeros(n,m+1); + + ## Find cosets of GF(2^m) and convert from cell array to matrix + cyclocoset = cosets(m, prim_poly); + cyclomat = zeros(max(size(cyclocoset)),m); + for j=1:max(size(cyclocoset)) + cyclomat(j,1:length(cyclocoset{j})) = cyclocoset{j}; + end + + for j =1:n + if (v(j) == 0) + ## Special case + r(j,m-1) = 1; + else + ## Find the coset within which the current element falls + [rc, ignored] = find(cyclomat == v(j)); + + rv = cyclomat(rc,:); + + ## Create the minimum polynomial from its roots + ptmp = gf([1,rv(1)], m, prim_poly); + for i=2:length(rv) + ptmp = conv(ptmp, [1,rv(i)]); + end + + ## Need to left-shift polynomial to divide by x while can + i = 0; + while (!ptmp(m+1-i)) + i = i + 1; + end + ptmp = [zeros(1,i), ptmp(1:m+1-i)]; + r(j,:) = ptmp; + endif + end + + ## Ok, now put the return value into GF(2) + r = gf(r,1); + +endfunction diff --git a/octave_packages/communications-1.1.1/modmap.m b/octave_packages/communications-1.1.1/modmap.m new file mode 100644 index 0000000..147ef63 --- /dev/null +++ b/octave_packages/communications-1.1.1/modmap.m @@ -0,0 +1,332 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} modmap (@var{method},@var{...}) +## @deftypefnx {Function File} {y = } modmap (@var{x},@var{fd},@var{fs},'ask',@var{m}) +## @deftypefnx {Function File} {y = } modmap (@var{x},@var{fd},@var{fs},'fsk',@var{m},@var{tone}) +## @deftypefnx {Function File} {y = } modmap (@var{x},@var{fd},@var{fs},'msk') +## @deftypefnx {Function File} {y = } modmap (@var{x},@var{fd},@var{fs},'psk',@var{m}) +## @deftypefnx {Function File} {y = } modmap (@var{x},@var{fd},@var{fs},'qask',@var{m}) +## @deftypefnx {Function File} {y = } modmap (@var{x},@var{fd},@var{fs},'qask/cir',@var{nsig},@var{amp},@var{phs}) +## @deftypefnx {Function File} {y = } modmap (@var{x},@var{fd},@var{fs},'qask/arb',@var{inphase},@var{quadr}) +## @deftypefnx {Function File} {y = } modmap (@var{x},@var{fd},@var{fs},'qask/arb',@var{map}) +## +## Mapping of a digital signal to an analog signal. With no output arguments +## @dfn{modmap} plots the constellation of the mapping. In this case the +## first argument must be the string @var{method} defining one of 'ask', +## 'fsk', 'msk', 'qask', 'qask/cir' or 'qask/arb'. The arguments following +## the string @var{method} are generally the same as those after the +## corresponding string in the fucntion call without output arguments. +## The exception is @code{modmap('msk',@var{Fd})}. +## +## With an output argument, @var{y} is the complex mapped analog signal. In +## this case the arguments @var{x}, @var{fd} and @var{fs} are required. The +## variable @var{x} is the digital signal to be mapped, @var{fd} is the +## sampling rate of the of digital signal and the @var{fs} is the sampling +## rate of the analog signal. It is required that @code{@var{fs}/@var{fd}} +## is an integer. +## +## The available mapping of the digital signal are +## +## @table @asis +## @item 'ask' +## Amplitude shift keying +## @item 'fsk' +## Frequency shift keying +## @item 'msk' +## Minimum shift keying +## @item 'psk' +## Phase shift keying +## @item 'qask' +## @itemx 'qsk' +## @itemx 'qam' +## Quadraure amplitude shift keying +## @end table +## +## In addition the 'qask', 'qsk' and 'qam' method can be modified with the +## flags '/cir' or '/arb'. That is 'qask/cir' and 'qask/arb', etc are valid +## methods and give circular- and arbitrary-qask mappings respectively. +## +## The additional argument @var{m} is the order of the modulation to use. +## @var{m} must be larger than the largest element of @var{x}. The variable +## @var{tone} is the FSK tone to use in the modulation. +## +## For 'qask/cir', the additional arguments are the same as for +## @dfn{apkconst}, and you are referred to @dfn{apkconst} for the definitions +## of the additional variables. +## +## For 'qask/arb', the additional arguments @var{inphase} and @var{quadr} give +## the in-phase and quadrature components of the mapping, in a similar mapping +## to the outputs of @dfn{qaskenco} with one argument. Similar @var{map} +## represents the in-phase and quadrature components of the mapping as +## the real and imaginary parts of the variable @var{map}. +## @end deftypefn +## @seealso{demodmap,dmodce,amodce,apkconst,qaskenco} + +function y = modmap(varargin) + + method = "sample"; + if (nargout == 0) + if (nargin < 1) + error ("modmap: too few arguments"); + endif + method = varargin{1}; + optarg = 1; + M = 2; + fd = 1; + fs = 1; + elseif (nargout == 1) + if (nargin < 3) + error ("modmap: too few arguments"); + endif + x = varargin{1}; + fd = varargin{2}; + fs = varargin{3}; + if (nargin > 3) + method = varargin{4}; + endif + M = max(2,2^ceil(log2(max(x(:)) + 1))); + optarg = 4; + + if (!isscalar(fs) || !isscalar(fd) || !isreal(fs) || !isreal(fd) || ... + (fs <= 0) || (fd <= 0)) + error ("modmap: sampling rates must be positive real values"); + endif + if (abs(fs/fd - floor(fs/fd)) > eps) + error ("modmap: the sample rate Fs must be an integer multiple of Fd"); + endif + + nn = round(fs/fd); + if (min(size(x)) == 1) + n = length(x); + yy = zeros(n,1); + if (size(x,1) == 1) + yy = yy'; + end + for i=1:nn + yy(i:nn:nn*n) = x; + end + else + n = size(x,1); + yy = zeros(n*nn,size(x,2)); + for i=1:nn + yy(i:nn:nn*n,:) = x; + end + endif + x = yy; + else + error ("modmap: too many output arguments"); + endif + + if (!ischar(method)) + error ("modmap: mapping method to use must be a string"); + endif + + if (isempty(findstr(method,"/arb")) && isempty(findstr(method,"/cir"))) + if (nargin > optarg) + M = varargin{optarg+1}; + if (!isscalar(M) || !isreal(M) || (M < 0) || (M != floor(M))) + error ("modmap: modulation order must be a real positive integer"); + endif + endif + if ((nargout != 0) && (M < max(x(:)) + 1)) + error ("modmap: illegal symbol in data for modulation order"); + endif + endif + + if (strcmp(method,"ask")) + if (nargin > optarg + 1) + error ("modmap: too many arguments"); + endif + + if (nargout == 0) + if (floor(M/2) == M/2) + apkconst(2*ones(1,M/2),2*([1:M/2]-0.5)/(M-1)); + else + apkconst([1,2*ones(1,floor(M/2))],2*([0:floor(M/2)])/(M-1)); + endif + else + if (floor(M/2) == M/2) + c = [ -2*([M/2:-1:1]-0.5)/(M-1), 2*([1:M/2]-0.5)/(M-1)]; + else + c = [ -2*([floor(M/2):-1:1])/(M-1), 0, 2*([1:floor(M/2)])/(M-1)]; + endif + y = c(x+1); + if (size(x,2) == 1) + y = y'; + endif + endif + elseif (strcmp(method,"psk")) + if (nargin > optarg + 1) + error ("modmap: too many arguments"); + endif + if (nargout == 0) + apkconst(M,"n"); + else + c = apkconst(M); + y = c(x+1); + if (size(x,2) == 1) + y = y'; + endif + endif + elseif (strcmp(method,"msk")) + + if (nargout == 0) + if (nargin > optarg) + fd = varargin{optarg+1}; + if (!isscalar(fd)) + error ("modmap: the sampling rate must be a scalar"); + endif + endif + if (nargin > optarg + 1) + error ("modmap: too many arguments"); + endif + + ## This is an ugly plot, with little info. But hey!!! + try stem ([0, fd], [2, 1]); + catch + error ("modmap: can not find stem-plot function"); + end + title("MSK constellation"); + xlabel("Frequency (Hz)"); + ylabel(""); + axis([-fd, 2*fd, 0, 2]); + else + if (nargin > optarg) + error ("modmap: too many arguments"); + endif + tone = fd/2; + y = tone * x; + endif + elseif (strcmp(method,"fsk")) + if (nargin > optarg + 1) + tone = varargin{optarg+2}; + if (!isscalar(tone)) + error ("modmap: the FSK tone must be a scalar"); + endif + else + tone = fd; + endif + if (nargin > optarg + 2) + error ("modmap: too many arguments"); + endif + + if (nargout == 0) + ## This is an ugly plot, with little info. But hey!!! + try stem ([0:tone:(M-1)*tone], [2, ones(1,M-1)]); + catch + error ("modmap: can not find stem-plot function"); + end + title("FSK constellation"); + xlabel("Frequency (Hz)"); + ylabel(""); + axis([-tone, M*tone, 0, 2]); + else + y = tone * x; + endif + elseif ((strcmp(method,"qask")) || (strcmp(method,"qsk")) || ... + (strcmp(method,"qam"))) + if (nargin > optarg + 1) + error ("modmap: too many arguments"); + endif + if (nargout == 0) + qaskenco(M); + else + y = qaskenco(x, M); + endif + elseif ((strcmp(method,"qask/cir")) || (strcmp(method,"qsk/cir")) || ... + (strcmp(method,"qam/cir"))) + nsig = M; + amp = []; + phs = []; + if (nargin > optarg) + nsig = varargin{optarg+1}; + if (!isvector(nsig) || (sum(nsig) < M)) + error ("modmap: insufficient number of constellation point in qask/cir"); + endif + endif + if (nargin > optarg + 1) + amp = varargin{optarg+2}; + endif + if (nargin > optarg + 2) + phs = varargin{optarg+3}; + endif + if (nargout == 0) + apkconst(nsig,amp,phs,"n"); + else + c = apkconst(nsig,amp,phs); + y = c(x+1); + if (size(x,2) == 1) + y = y'; + endif + endif + elseif ((strcmp(method,"qask/arb")) || (strcmp(method,"qsk/arb")) || ... + (strcmp(method,"qam/arb"))) + if (nargin == optarg) + [inphase, quadr] = qaskenco(M); + elseif (nargin == optarg+1) + c = varargin{optarg+1}; + inphase = real(c); + quadr = imag(c); + elseif (nargin == optarg+2) + inphase = varargin{optarg+1}; + quadr = varargin{optarg+2}; + else + error ("modmap: incorrectly defined mapping in 'qask/arb'"); + endif + if (!isreal(inphase) || !isreal(quadr) || !isvector(inphase) || ... + !isvector(quadr) || !all(isfinite(inphase)) || ... + !all(isfinite(quadr)) ||(length(inphase) < M)) + error ("modmap: invalid arbitrary qask mapping"); + endif + + if (nargout == 0) + inphase = inphase(:); + quadr = quadr(:); + plot (inphase, quadr, "+r"); + title("QASK Constellation"); + xlabel("In-phase"); + ylabel("Quadrature"); + axis([min(inphase)-1, max(inphase)+1, min(quadr)-1, max(quadr)+1]); + xd = 0.02 * max(inphase); + if (nargin == 2) + msg = msg(:); + for i=1:length(inphase) + text(inphase(i)+xd,quadr(i),num2str(msg(i))); + end + else + for i=1:length(inphase) + text(inphase(i)+xd,quadr(i),num2str(i-1)); + end + endif + refresh; + else + y = inphase(x+1) + 1i * quadr(x+1); + if (size(x,2) == 1) + y = y'; + endif + endif + elseif (strcmp(method,"sample")) + if (nargout == 0) + error ("modmap: no constellation for resampling"); + endif + ## Just for resampling !!! So don't need anything else here + y = x; + else + error ("modmap: unknown mapping method"); + endif + +endfunction diff --git a/octave_packages/communications-1.1.1/oct2dec.m b/octave_packages/communications-1.1.1/oct2dec.m new file mode 100644 index 0000000..8ce5a5b --- /dev/null +++ b/octave_packages/communications-1.1.1/oct2dec.m @@ -0,0 +1,61 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{d} = oct2dec (@var{c}) +## +## Convert octal to decimal values. +## +## Each element of the octal matrix @var{c} is converted to a decimal value. +## +## @seealso{base2dec,bin2dec,dec2bin} +## @end deftypefn + +function d = oct2dec (c) + + if (nargin != 1) + print_usage (); + endif + + # Check for negative or non-integer values + if (any (c(:) < 0) || any (c(:) != floor (c(:)))) + error ("oct2dec: c must be an octal matrix"); + endif + + d = zeros (size (c)); + l = size (c, 2); + for k = 1:l + str = num2str (c(:,k), "%ld"); + d(:,k) = base2dec (str, 8); + if (any (isnan (d(:,k)))) + error ("oct2dec: c must be an octal matrix"); + endif + endfor + +endfunction + +%!shared x,y +%! x = reshape ([0:79], 10, 8)(1:8,:); +%! y = reshape ([0:63], 8, 8); +%!assert (oct2dec (0), 0) +%!assert (oct2dec (77777777), 2^24 - 1) +%!assert (oct2dec (x), y) + +%% Test input validation +%!error oct2dec () +%!error oct2dec (0, 0) +%!error oct2dec (0.1) +%!error oct2dec (-1) +%!error oct2dec (8) diff --git a/octave_packages/communications-1.1.1/packinfo/.autoload b/octave_packages/communications-1.1.1/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/communications-1.1.1/packinfo/DESCRIPTION b/octave_packages/communications-1.1.1/packinfo/DESCRIPTION new file mode 100644 index 0000000..16a3456 --- /dev/null +++ b/octave_packages/communications-1.1.1/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: Communications +Version: 1.1.1 +Date: 2012-05-12 +Author: various authors +Maintainer: Octave-Forge community +Title: Communications. +Description: Digital Communications, Error Correcting Codes (Channel Code), Source Code functions, Modulation and Galois Fields +Depends: octave (>= 3.4), signal (>= 1.1.3) +Autoload: yes +License: GPLv3+ +Url: http://octave.sf.net diff --git a/octave_packages/communications-1.1.1/packinfo/INDEX b/octave_packages/communications-1.1.1/packinfo/INDEX new file mode 100644 index 0000000..38cebeb --- /dev/null +++ b/octave_packages/communications-1.1.1/packinfo/INDEX @@ -0,0 +1,179 @@ +communications >> Communications +Random Signals + awgn + biterr + eyediagram + randerr + randint + randsrc + scatterplot + symerr + wgn + bsc +Source Coding + arithenco + arithdeco + compand + dpcmdeco + dpcmenco + dpcmopt + huffmandeco + huffmandict + huffmanenco + lloyds + lz77deco + lz77enco + quantiz + shannonfanodict + shannonfanoenco + shannonfanodeco + rleenco + rledeco + riceenco + ricedeco + fiboenco + fibodeco + fibosplitstream + golombenco + golombdeco +Block Interleavers + intrlv + algintrlv + helscanintrlv + matintrlv + randintrlv + deintrlv + matdeintrlv + randdeintrlv +Block Coding + bchdeco + bchenco + bchpoly + convenc + cyclgen + cyclpoly + decode + encode + egolaydec + egolayenc + egolaygen + gen2par + hammgen + reedmullerdec + reedmullerenc + reedmullergen + rsgenpoly + rsdec + rsdecof + rsenc + rsencof + systematize + syndtable + vitdec +Modulations + ademod + ademodce + amod + amodce + ammod + amdemod + apkconst + ddemod + ddemodce + demodmap + dmod + dmodce + fmmod + fmdemod + genqammod + genqamdemod + modmap + pamdemod + pammod + pskdemod + pskmod + qaskdeco + qaskenco + qammod + qamdemod +Special Filters + hank2sys + hilbiir + rcosflt + rcosiir + rcosine + rcosfir +Galois Fields of Even Characateristic + + - = Addition and subtraction in a Galois Field. + * / \ = Matrix multiplication and division of Galois arrays. + .* ./ .\ = Element by element multiplication and division of Galois arrays. + ** ^ = Matrix exponentiation of Galois arrays. + .** .^ = Element by element matrix exponentiation of Galois arrays. + ' .' = Matrix transpose of Galois arrays. + == ~= != > >= < <= = Logical operators on Galois arrays. + all + any + cosets + conv + convmtx + deconv + det + dftmtx + diag + exp + gf + fft + filter + gftable + gfweight + ifft + inv + inverse + isequal + log + lu + prod + sqrt + rank + reshape + roots + sum + sumsq + isempty + isgalois + isprimitive + length + minpol + polyval + primpoly + size +Galois Fields of Odd Characteristic + gfadd + gfconv + gfcosets + gfdeconv + gfdiv + gffilter + gflineq + gfminpol + gfmul + gfpretty + gfprimck + gfprimdf + gfprimfd + gfrank + gfrepcov + gfroots + gfsub + gftrunc + gftuple +Utility Functions + comms + bi2de + de2bi + oct2dec + istrellis + poly2trellis + vec2mat + qfunc + qfuncinv diff --git a/octave_packages/communications-1.1.1/packinfo/NEWS b/octave_packages/communications-1.1.1/packinfo/NEWS new file mode 100644 index 0000000..09e6637 --- /dev/null +++ b/octave_packages/communications-1.1.1/packinfo/NEWS @@ -0,0 +1,27 @@ +Summary of important user-visible changes for communications 1.1.1: +------------------------------------------------------------------- + + ** The function `marcumq' has been moved to the signal package + + ** communications is no longer dependent on the image package + + ** The following functions are new: + + convenc + + ** The following functions have improved Matlab compatibility and tests: + bi2de + de2bi + oct2dec + + ** The function `reedmullerdec' had a bug fix introduced on the + previous release + + ** The function `huffmandeco' has been rewritten and made more + efficient and should perform faster + + ** Fixed bug in `glu' which made it unusable + + ** Use of deprecated functions has been removed + + ** Package is no longer automatically loaded. diff --git a/octave_packages/communications-1.1.1/pamdemod.m b/octave_packages/communications-1.1.1/pamdemod.m new file mode 100644 index 0000000..a44a39a --- /dev/null +++ b/octave_packages/communications-1.1.1/pamdemod.m @@ -0,0 +1,68 @@ +## Copyright (C) 2006 Charalampos C. Tsimenidis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} = } pamdemod (@var{x}, @var{m}) +## @deftypefnx {Function File} {@var{y} = } pamdemod (@var{x}, @var{m}, @var{phi}) +## @deftypefnx {Function File} {@var{y} = } pamdemod (@var{x}, @var{m}, @var{phi}, @var{type}) +## +## Demodulates a pulse amplitude modulated signal @var{x} into an +## information sequence of integers in the range @code{[0 @dots{} M-1]}. +## @var{phi} controls the initial phase and @var{type} controls the +## constellation mapping. If @var{type} is set to 'Bin' will result in +## binary encoding, in contrast, if set to 'Gray' will give Gray encoding. +## An example of Gray-encoded 8-PAM is +## +## @example +## @group +## d = randint(1,1e4,8); +## y = pammod(d,8,0,'Gray'); +## z = awgn(y,20); +## d_est = pamdemod(z,8,0,'Gray'); +## plot(z,'rx') +## biterr(d,d_est) +## @end group +## @end example +## @end deftypefn +## @seealso{pammod} + +function y=pamdemod(x,M,phi,type) + +if nargin<2 + usage("y = pamdemod (x, M, [phi, [type]])"); +endif + +if nargin<3 + phi=0; +endif + +if nargin<4 + type="Bin"; +endif + +index=genqamdemod(x,[-M+1:2:M-1].*exp(-1j*phi)); + +if (strcmp(type,"Bin")||strcmp(type,"bin")) + y=index; +elseif (strcmp(type,"Gray")||strcmp(type,"gray")) + m=0:M-1; + map=bitxor(m,bitshift(m,-1)); + y=map(index+1); +else + usage("y = pamdemod (x, M, [phi, [type]])"); +endif + +%!assert (pamdemod([-7:2:7],8,0,'Bin'),[0:7]) +%!assert (pamdemod([-7:2:7],8,0,'Gray'),[0 1 3 2 6 7 5 4]) diff --git a/octave_packages/communications-1.1.1/pammod.m b/octave_packages/communications-1.1.1/pammod.m new file mode 100644 index 0000000..6ea5b35 --- /dev/null +++ b/octave_packages/communications-1.1.1/pammod.m @@ -0,0 +1,75 @@ +## Copyright (C) 2006 Charalampos C. Tsimenidis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} = } pammod (@var{x}, @var{m}) +## @deftypefnx {Function File} {@var{y} = } pammod (@var{x}, @var{m}, @var{phi}) +## @deftypefnx {Function File} {@var{y} = } pammod (@var{x}, @var{m}, @var{phi}, @var{type}) +## +## Modulates an information sequence of integers @var{x} in the range +## @code{[0 @dots{} M-1]} onto a pulse amplitude modulated signal @var{y}. +## @var{phi} controls the initial phase and @var{type} controls the +## constellation mapping. If @var{type} is set to 'Bin' will result in +## binary encoding, in contrast, if set to 'Gray' will give Gray encoding. +## An example of Gray-encoded 8-PAM is +## +## @example +## @group +## d = randint(1,1e4,8); +## y = pammod(d,8,0,'Gray'); +## z = awgn(y,20); +## plot(z,'rx') +## @end group +## @end example +## @end deftypefn +## @seealso{pamdemod} + +function y=pammod(x,M,phi,type) + +if nargin<2 + usage("y = pammod (x, M, [phi, [type]])"); +endif + +m=0:M-1; +if ~isempty(find(ismember(x,m)==0)) + error("x elements should be integers in the set [0, M-1]."); +endif + +if nargin<3 + phi=0; +endif + +if nargin<4 + type="Bin"; +endif + +constellation=[-M+1:2:M-1].*exp(-1j*phi); + +if (strcmp(type,"Bin")||strcmp(type,"bin")) + y=constellation(x+1); +elseif (strcmp(type,"Gray")||strcmp(type,"gray")) + [a,b]=sort(bitxor(m,bitshift(m,-1))); + y=constellation(b(x+1)); +else + usage("y = pammod (x, M, [phi, [type]])"); +endif + +if (iscomplex(y) && all (imag(y(:)) == 0)) + y = real (y); +endif + + +%!assert(round(pammod([0:7],8,0,'Bin')),[-7:2:7]) +%!assert(round(pammod([0:7],8,0,'Gray')),[-7 -5 -1 -3 7 5 1 3]) diff --git a/octave_packages/communications-1.1.1/prbs_generator.m b/octave_packages/communications-1.1.1/prbs_generator.m new file mode 100644 index 0000000..4c6f281 --- /dev/null +++ b/octave_packages/communications-1.1.1/prbs_generator.m @@ -0,0 +1,61 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Implement book keeping for a Pseudo-Random Binary Sequence ( PRBS ) +## also called as a Linear Feedback Shift Register. +## +## Given a polynomial create a PRBS structure for that polynomial. +## Now all we need is to just create this polynomial and make it work. +## polynomial must be a vector containing the powers of x and an optional +## value 1. eg: x^3 + x^2 + x + 1 must be written as [3 2 1 0] +## all the coefficients are either 1 or 0. It generates only a Binary \ +## sequence, and the generator polynomial need to be only a binary +## polynomial in GF(2). +## +## connections, contains a struct of vectors where each vector is the +## connection list mapping its vec(2:end) elements to the vec(1) output. +## +## Example: If you had a PRBS shift register like the diagram +## below with 4 registers we use representation by polynomial +## of [ 1 2 3 4], and feedback connections between [ 1 3 4 ]. +## The output PRBS sequence is taken from the position 4. +## +## +---+ +----+ +---+ +---+ +## | D |----| D |---| D |---| D | +## +---+ +----+ +---+ +---+ +## | | | +## \ / / +## [+]---------------+------+ +## 1 + 0.D + 1.D^2 + 1.D^3 +## +## The code to implement this PRBS with a start state of [1 0 1 1] +## will be: +## +## prbs=prbs_generator([1 3 4],{[1 3 4]},[1 0 1 1]); +## x = prbs_sequence(prbs) #gives 15 +## +## prbs_iterator( prbs, 15 ) #15 binary digits seen +## [ 1 1 0 1 0 1 1 1 1 0 0 0 1 0 0 ] +## +## See Also: This function is to be used along with functions +## prbs_iterator, and prbs_sequence. + +function prbs=prbs_generator(polynomial,connections,initstate) + prbs.reglen=max(polynomial); + prbs.polynomial=polynomial; + prbs.sregs=initstate; + prbs.connections=connections; + prbs.conlen=length(connections); +end diff --git a/octave_packages/communications-1.1.1/prbs_iterator.m b/octave_packages/communications-1.1.1/prbs_iterator.m new file mode 100644 index 0000000..63235d9 --- /dev/null +++ b/octave_packages/communications-1.1.1/prbs_iterator.m @@ -0,0 +1,144 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## This function generates the output bits from the PRBS +## state, for the number of iterations specified. +## +## First argument is the PRBS structure obtained from prbs_generator. +## PRBS iterations is specified in the second argument. +## PRBS start state is taken from the prbs.sregs. +## +## Second argument of the output is PRBS structure with a new +## state. This allows usage like: +## +## [ seq, prbs ] = prbs_iterator( prbs, niterations ); +## +## while the state of the PRBS is updated. +## +## Example: If you had a PRBS shift register like the diagram +## below with 4 registers we use representation by polynomial +## of [ 1 2 3 4], and feedback connections between [ 1 3 4 ]. +## The output PRBS sequence is taken from the position 4. +## +## +---+ +----+ +---+ +---+ +## | D |----| D |---| D |---| D | +## +---+ +----+ +---+ +---+ +## | | | +## \ / / +## [+]---------------+------+ +## 1 + 0.D + 1.D^2 + 1.D^3 +## +## The code to implement this PRBS will be +## prbs=prbs_generator([1 3 4],{[1 3 4]},[1 0 1 1]); +## x = prbs_iterator(prbs,15) +## +## See Also: This function is to be used along with functions +## prbs_iterator, prbs_generator and prbs_sequence. + +function [outputseq, prbs] = prbs_iterator (prbs, iterations = 2^(prbs.reglen)-1) + + if ( nargin < 1 || nargin > 2 ) + print_usage; + endif + outputseq=zeros(1,iterations); + nstate=zeros(1,prbs.reglen); + + ## For each iteration, shift the output bit. Then compute the xor pattern of connections. + ## Finally apply feedback the stuff. Insert the computed pattern. + for itr=1:iterations + ## save output. + outputseq(itr)=prbs.sregs(prbs.reglen); + + ## compute the feedback. + for itr2=1:prbs.conlen + val=0; + L=length(prbs.connections{itr2}); + for itr3=2:L + val=bitxor(val,prbs.sregs(prbs.connections{itr2}(itr3))); + endfor + nstate(prbs.connections{itr2}(1))=val; + endfor + + ## rotate the output discarding the last output. + prbs.sregs=[0 prbs.sregs(1:prbs.reglen-1)]; + + ## insert the feedback. + for itr2=1:prbs.conlen + prbs.sregs(itr2)=nstate(itr2); + nstate(itr2)=0; # reset. + endfor + + endfor +endfunction + +## +## TEST CASES FOR PRBS. +## +## +## 2^31 -1 : D31 + D28 + 1 =0 inverted +## 2^23 -1 : D23 + D18 + 1 = 0 , +## 2^15 -1 : D15 + D14 + 1 = 0, +## 2^10 -1 : D10 + D7 + 1 = 0, +## 2^7 -1 : D7 + D6 + 1 = 0, +## 2^4 -1 : D3 + D2 + 1 = 0, +## +## +---+ +----+ +---+ +---+ +## | D |----| D |---| D |---| D | +## +---+ +----+ +---+ +---+ +## | | | +## \ / / +## [+]---------------+------+ +## 1 + 0.D + 1.D^2 + 1.D^3 +## +## +## prbs=prbs_generator([1 3 4],{[1 3 4]},[1 0 1 1]); +## x = prbs_iterator(prbs,15) +## y = prbs_iterator(prbs,30)(16:end) +## z = prbs_sequence(prbs) +## exit +## break + +## +## Multiple Tap, Simple Sequence Generator. +## +## n=10; +## k=8; +## inits=round(abs(rand(1,n)*1.0)) +## prbs=prbs_generator([n 1],{[1 2 k n-1 n]},inits); +## prbs_iterator(prbs,1023) +## prbs_seqlength(prbs,inits) + +##prbs=prbs_generator([1 2 3],{[1 2 3]},[1 1 1]); +##prbs_iterator(prbs,7) + +## +## 2^4 -1 : D4 + D1 + 1 = 0, +## +## +---+ +----+ +---+ +---+ +## | D |----| D |---| D |---| D | +## +---+ +----+ +---+ +---+ +## | | | +## \ / / +## [+]---------------+------+ +## 1 + 0.D + 1.D^2 + 1.D^3 +## +##prbs=prbs_generator([1 3 4],{[1 2 4]},[1 0 1 1]); +##prbs_iterator(prbs,16) +##prbs_iterator(prbs,32) + + +##prbs=prbs_generator([7],{[1 7 6]},[1 0 0 1 0 0 0]); +##y=prbs_iterator(prbs,128); +##x=prbs_iterator(prbs,256); diff --git a/octave_packages/communications-1.1.1/prbs_sequence.m b/octave_packages/communications-1.1.1/prbs_sequence.m new file mode 100644 index 0000000..6c02437 --- /dev/null +++ b/octave_packages/communications-1.1.1/prbs_sequence.m @@ -0,0 +1,81 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Implement book keeping for a Pseudo-Random Binary Sequence ( PRBS ) +## also called as a Linear Feedback Shift Register. +## +## For the given PRBS in a intial state, compute the PRBS sequence length. +## Length is period of output when the PRBS state is same as +## the start state of PRBS. +## +## Example: If you had a PRBS shift register like the diagram +## below with 4 registers we use representation by polynomial +## of [ 1 2 3 4], and feedback connections between [ 1 3 4 ]. +## The output PRBS sequence is taken from the position 4. +## +## +---+ +----+ +---+ +---+ +## | D |----| D |---| D |---| D | +## +---+ +----+ +---+ +---+ +## | | | +## \ / / +## [+]---------------+------+ +## 1 + 0.D + 1.D^2 + 1.D^3 +## +## The code to implement this PRBS will be +## prbs=prbs_generator([1 3 4],{[1 3 4]},[1 0 1 1]); +## x = prbs_sequence(prbs) #gives 15 +## +## +## See Also: This function is to be used along with functions +## prbs_generator. + +function [itrs,seq]=prbs_sequence(prbs) + if nargin != 1 + print_usage; + endif + nstate=zeros(1,prbs.reglen); + itrs=0; seq = []; + inits = prbs.sregs; + + ## For each iteration, shift the output bit. Then compute the xor pattern of connections. + ## Finally apply feedback the stuff. Insert the computed pattern. + while( true ) + itrs = itrs + 1; + + ## compute the feedback. + for itr2=1:prbs.conlen + val=0; + L=length(prbs.connections{itr2}); + for itr3=2:L + val=bitxor(val,prbs.sregs(prbs.connections{itr2}(itr3))); + endfor + nstate(prbs.connections{itr2}(1))=val; + endfor + + ## rotate the output discarding the last output. + seq = [seq, prbs.sregs(end)]; + prbs.sregs=[0 prbs.sregs(1:prbs.reglen-1)]; + + ## insert the feedback. + for itr2=1:prbs.conlen + prbs.sregs(itr2)=nstate(itr2); + nstate(itr2)=0; # reset. + endfor + + if(isequal(prbs.sregs,inits)) + break + endif + endwhile +end diff --git a/octave_packages/communications-1.1.1/pskdemod.m b/octave_packages/communications-1.1.1/pskdemod.m new file mode 100644 index 0000000..73e16af --- /dev/null +++ b/octave_packages/communications-1.1.1/pskdemod.m @@ -0,0 +1,68 @@ +## Copyright (C) 2006 Charalampos C. Tsimenidis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} = } pamdemod (@var{x}, @var{m}) +## @deftypefnx {Function File} {@var{y} = } pamdemod (@var{x}, @var{m}, @var{phi}) +## @deftypefnx {Function File} {@var{y} = } pamdemod (@var{x}, @var{m}, @var{phi}, @var{type}) +## +## Demodulates a complex-baseband phase shift keying modulated signal +## into an information sequence of integers in the range +## @code{[0 @dots{} M-1]}. @var{phi} controls the initial phase and +## @var{type} controls the constellation mapping. If @var{type} is set +## to 'Bin' will result in binary encoding, in contrast, if set to +##'Gray' will give Gray encoding. An example of Gray-encoded 8-PSK is +## +## @example +## @group +## d = randint(1,1e3,8); +## y = pskmod(d,8,0,'Gray'); +## z = awgn(y,20); +## d_est = pskdemod(z,8,0,'Gray'); +## plot(z,'rx') +## biterr(d,d_est) +## @end group +## @end example +## @end deftypefn +## @seealso{pskmod} + +function y=pskdemod(x,M,phi,type) + +if nargin<2 + usage("y = pskdemod (x, M, [phi, [type]])"); +endif + +if nargin<3 + phi=0; +endif + +if nargin<4 + type="Bin"; +endif + +m=0:M-1; +index=mod(round((arg(x)-phi)*M/2/pi),M)+1; + +if (strcmp(type,"Bin")||strcmp(type,"bin")) + y=index-1; +elseif (strcmp(type,"Gray")||strcmp(type,"gray")) + map=bitxor(m,bitshift(m,-1)); + y=map(index); +else + usage("y = pskdemod (x, M, [phi, [type]])"); +endif + +%!assert (pskdemod([1 j -1 -j],4,0,'Bin'),[0:3]) +%!assert (pskdemod([1 j -j -1],4,0,'Gray'),[0:3]) diff --git a/octave_packages/communications-1.1.1/pskmod.m b/octave_packages/communications-1.1.1/pskmod.m new file mode 100644 index 0000000..3582b98 --- /dev/null +++ b/octave_packages/communications-1.1.1/pskmod.m @@ -0,0 +1,69 @@ +## Copyright (C) 2006 Charalampos C. Tsimenidis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} = } pskmod (@var{x}, @var{m}) +## @deftypefnx {Function File} {@var{y} = } pskmod (@var{x}, @var{m}, @var{phi}) +## @deftypefnx {Function File} {@var{y} = } pskmod (@var{x}, @var{m}, @var{phi}, @var{type}) +## +## Modulates an information sequence of integers @var{x} in the range +## @code{[0 @dots{} M-1]} onto a complex baseband phase shift keying +## modulated signal @var{y}. @var{phi} controls the initial phase and +## @var{type} controls the constellation mapping. If @var{type} is set +## to 'Bin' will result in binary encoding, in contrast, if set to 'Gray' +## will give Gray encoding. An example of Gray-encoded QPSK is +## +## @example +## @group +## d = randint(1,5e3,4); +## y = pskmod(d,4,0,'Gray'); +## z = awgn(y,30); +## plot(z,'rx') +## +## @end group +## @end example +## @end deftypefn +## @seealso{pskdemod} + +function y=pskmod(x,M,phi,type) + +m=0:M-1; + +if ~isempty(find(ismember(x,m)==0)) + error("x elements should be integers in the set [0, M-1]."); +endif + +if nargin<3 + phi=0; +endif + +if nargin<4 + type="Bin"; +endif + +constellation=exp(1j*2*pi*m/M+1j*phi); + +if (strcmp(type,"Bin")||strcmp(type,"bin")) + y=constellation(x+1); +elseif (strcmp(type,"Gray")||strcmp(type,"gray")) + [a,b]=sort(bitxor(m,bitshift(m,-1))); + y=constellation(b(x+1)); +else + usage("y = pskmod (x, M, [phi, [type]])"); +endif + + +%!assert (round(pskmod([0:3],4,0,'Bin')),[1 j -1 -j]) +%!assert (round(pskmod([0:3],4,0,'Gray')),[1 j -j -1]) diff --git a/octave_packages/communications-1.1.1/qamdemod.m b/octave_packages/communications-1.1.1/qamdemod.m new file mode 100644 index 0000000..f4d9832 --- /dev/null +++ b/octave_packages/communications-1.1.1/qamdemod.m @@ -0,0 +1,40 @@ +## Copyright (C) 2007 Sylvain Pelissier +## Copyright (C) 2009 Christian Neumair +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} qamdemod (@var{x},@var{m}) +## Create the QAM demodulation of x with a size of alphabet m. +## @seealso{qammod,pskmod,pskdemod} +## @end deftypefn + +function z = qamdemod(y,m) + if(nargin < 2) + usage('y = qamdemod(x,m)'); + exit; + end + + c = sqrt(m); + if(c ~= fix(c) || log2(c) ~= fix(log2(c))) + error('m must be a square of a power of 2'); + end + + x = qammod(0:(m-1),m); + x = reshape(x,1,m); + z = zeros(size(y)); + for k = 1:numel(y) + [n z(k)] = min(abs(y(k) - x)); + end + z = z - 1; diff --git a/octave_packages/communications-1.1.1/qammod.m b/octave_packages/communications-1.1.1/qammod.m new file mode 100644 index 0000000..980dd6c --- /dev/null +++ b/octave_packages/communications-1.1.1/qammod.m @@ -0,0 +1,43 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} qammod (@var{x},@var{m}) +## Create the QAM modulation of x with a size of alphabet m. +## @seealso{qamdemod,pskmod,pskdemod} +## @end deftypefn + +function y = qammod(x,m) + if(nargin < 2) + usage('y = qammod(x,m)'); + exit; + end + if(any(x >= m)) + error('values of x must be in range [0,M-1]'); + exit; + end + + if(~any(x == fix(x))) + error('values of x must be integer'); + exit; + end + c = sqrt(m); + if(c ~= fix(c) || log2(c) ~= fix(log2(c))) + error('m must be a square of a power of 2'); + exit; + end + b = -2.*mod(x,(c))+c-1; + a = 2.*floor(x./(c))-c+1; + y = a + i.*b; diff --git a/octave_packages/communications-1.1.1/qaskdeco.m b/octave_packages/communications-1.1.1/qaskdeco.m new file mode 100644 index 0000000..05d643f --- /dev/null +++ b/octave_packages/communications-1.1.1/qaskdeco.m @@ -0,0 +1,215 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{msg} =} qaskdeco (@var{c},@var{m}) +## @deftypefnx {Function File} {@var{msg} =} qaskdeco (@var{inphase},@var{quadr},@var{m}) +## @deftypefnx {Function File} {@var{msg} =} qaskdeco (@var{...},@var{mnmx}) +## +## Demaps an analog signal using a square QASK constellation. The input signal +## maybe either a complex variable @var{c}, or as two real variables +## @var{inphase} and @var{quadr} representing the in-phase and quadrature +## components of the signal. +## +## The argument @var{m} must be a positive integer power of 2. By deafult the +## same constellation as created in @dfn{qaskenco} is used by @dfn{qaskdeco}. +## If is possible to change the values of the minimum and maximum of the +## in-phase and quadrature components of the constellation to account for +## linear changes in the signal values in the received signal. The variable +## @var{mnmx} is a 2-by-2 matrix of the following form +## +## @multitable @columnfractions 0.125 0.05 0.25 0.05 0.25 0.05 +## @item @tab | @tab min in-phase @tab , @tab max in-phase @tab | +## @item @tab | @tab min quadrature @tab , @tab max quadrature @tab | +## @end multitable +## +## If @code{sqrt(@var{m})} is an integer, then @dfn{qaskenco} uses a Gray +## mapping. Otherwise, an attempt is made to create a nearly square mapping +## with a minimum Hamming distance between adjacent constellation points. +## @end deftypefn +## @seealso{qaskenco} + +function a = qaskdeco(varargin) + + have_mnmx = 0; + if (nargin == 2) + c = varargin{1}; + inphase = real(c); + quadr = imag(c); + M = varargin{2}; + elseif (nargin == 3) + if (all(size(varargin{3}) == [2 2])) + c = varargin{1}; + inphase = real(c); + quadr = imag(c); + M = varargin{2}; + mnmx = varargin{3}; + have_mnmx = 1; + else + inphase = varargin{1}; + quadr = varargin{2}; + M = varargin{3}; + endif + elseif (nargin == 4) + inphase = varargin{1}; + quadr = varargin{2}; + M = varargin{3}; + mnmx = varargin{4}; + have_mnmx = 1; + else + error ("qaskdeco: incorrect number of arguments"); + endif + + if (iscomplex(inphase) || iscomplex(quadr)) + error ("qaskdeco: error in in-phase and/or quadrature components"); + endif + + if (!isscalar(M) || (M != ceil(M)) || (M < 2)) + error ("qaskdeco: order of modulation must be a positive integer greater than 2"); + endif + + if (log2(M) != ceil(log2(M))) + error ("qaskdeco: the order must be a power of two"); + endif + + if (have_mnmx) + if (any(size(mnmx) != [2 2])) + error ("qaskdeco: error in max/min constellation values"); + endif + else + if ((M == 2) || (M == 4)) + mnmx = [-1, 1; -1, 1]; + elseif (M == 8) + mnmx = [-3, 3; -1, 1]; + elseif (sqrt(M) == floor(sqrt(M))) + NC = 2^floor(log2(sqrt(M))); + mnmx = [-NC+1, NC-1; -NC+1, NC-1]; + else + NC = 2^floor(log2(sqrt(M))) + 2*sqrt(M/32); + mnmx = [-NC+1, NC-1; -NC+1, NC-1]; + endif + endif + + if (M == 2) + layout = [0, 1]'; + elseif (M == 4) + layout = [0, 1; 2, 3]; + elseif (M == 8) + layout = [4, 5; 0, 1; 2, 3; 6, 7]; + else + NC =2^floor(log2(sqrt(M))); + MM = NC * NC; + Gray = [0 1]; + for i=2:ceil(log2(NC)) + Gray = [Gray 2^(i-1) + fliplr(Gray)]; + end + Gray = fliplr(de2bi(shift(Gray,length(Gray)/2 - 1))); + Gray2 = zeros(MM,log2(MM)); + Gray2(:,1:2:log2(MM)) = repmat(Gray,NC,1); + for i=1:NC + Gray2(i:NC:MM,2:2:log2(MM)) = Gray; + end + layout = reshape(bi2de(fliplr(Gray2)),NC,NC); + + if (MM != M) + ## Not sure this is the best that can be done for these mappings. If + ## anyone wants to improve this, go ahead, but do it in qaskenco too. + OFF = sqrt(M/32); + NR = NC + 2*OFF; + layout2 = NaN * ones(NR); + layout2(1+OFF:OFF+NC,1+OFF:OFF+NC) = layout; + + layout2(1:OFF,1+OFF:OFF+NC) = MM + layout(OFF:-1:1,:); + layout2(NR-OFF+1:NR,1+OFF:OFF+NC) = MM + layout(NC:-1:NC-OFF+1,:); + + layout2(1+2*OFF:NC,1:OFF) = MM + layout(OFF+1:NC-OFF,OFF:-1:1); + layout2(1+2*OFF:NC,NR-OFF+1:NR) = MM + ... + layout(OFF+1:NC-OFF,NC:-1:NC-OFF+1); + + layout2(1+OFF:2*OFF,1:OFF) = MM + ... + layout(NC/2:-1:NC/2-OFF+1,NC/2:-1:OFF+1); + layout2(NC+1:OFF+NC,1:OFF) = MM + ... + layout(NC-OFF:-1:NC/2+1,NC/2:-1:OFF+1); + + layout2(1+OFF:2*OFF,NR-OFF+1:NR) = MM + ... + layout(NC/2:-1:NC/2-OFF+1,NC-OFF:-1:NC/2+1); + layout2(NC+1:OFF+NC,NR-OFF+1:NR) = MM + ... + layout(NC-OFF:-1:NC/2+1,NC-OFF:-1:NC/2+1); + layout = layout2; + endif + endif + + ix = 1 + (inphase - mnmx(1,1))/(mnmx(1,2)-mnmx(1,1))*(size(layout,1)-1); + qx = 1 + (quadr - mnmx(2,1))/(mnmx(2,2)-mnmx(2,1))*(size(layout,2)-1); + + try wfi = warning("off", "Octave:fortran-indexing"); + catch wfi = 0; + end + + unwind_protect + a = layout(size(layout,1)*(max(min(round(qx),size(layout,2)),1)-1) + ... + max(min(round(ix),size(layout,1)),1)); + ## XXX FIXME XXX Why is this necessary?? + if ((M == 2) &&(size(inphase,1) == 1)) + a = a'; + endif + + if (any(isnan(a(:)))) + ## We have a non-square constellation, with some invalid points. + ## Map to nearest valid constellation points... + indx = find(isnan(a(:))); + ix = ix(indx); + qx = qx(indx); + ang = atan2(quadr(indx),inphase(indx)); + + qx(find(ang > 3*pi/4)) = NR-OFF; + ix(find((ang <= 3*pi/4) & (ang > pi/2))) = OFF+1; + ix(find((ang <= pi/2) & (ang > pi/4))) = NR - OFF; + qx(find((ang <= pi/4) & (ang > 0))) = NR - OFF; + qx(find((ang <= 0) & (ang > -pi/4))) = OFF+1; + ix(find((ang <= -pi/4) & (ang > -pi/2))) = NR - OFF; + ix(find((ang <= -pi/2) & (ang > -3*pi/4))) = OFF+1; + qx(find(ang <= -3*pi/4)) = OFF+1; + + a(indx) = layout(size(layout,1)*(max(min(round(qx), ... + size(layout,2)),1)-1) + max(min(round(ix),size(layout,1)),1)); + endif + unwind_protect_cleanup + warning (wfi); + end_unwind_protect + +endfunction + +%!function dec = __fntestqask1__ (msg, m) +%! [inp, qudr] = qaskenco (msg, m); +%! dec = qaskdeco (inp, qudr, m); + +%!function __fntestqask2__ (m, dims) +%! msg = floor( rand(dims) * m); +%! assert (__fntestqask1__ (msg, m), msg); + +%!test __fntestqask2__ (2, [100,100]) +%!test __fntestqask2__ (4, [100,100]) +%!test __fntestqask2__ (8, [100,100]) +%!test __fntestqask2__ (16, [100,100]) +%!test __fntestqask2__ (32, [100,100]) +%!test __fntestqask2__ (64, [100,100]) + +%!test __fntestqask2__ (2, [100,100,3]) +%!test __fntestqask2__ (4, [100,100,3]) +%!test __fntestqask2__ (8, [100,100,3]) +%!test __fntestqask2__ (16, [100,100,3]) +%!test __fntestqask2__ (32, [100,100,3]) +%!test __fntestqask2__ (64, [100,100,3]) diff --git a/octave_packages/communications-1.1.1/qaskenco.m b/octave_packages/communications-1.1.1/qaskenco.m new file mode 100644 index 0000000..760d453 --- /dev/null +++ b/octave_packages/communications-1.1.1/qaskenco.m @@ -0,0 +1,180 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} qaskenco (@var{m}) +## @deftypefnx {Function File} {} qaskenco (@var{msg},@var{m}) +## @deftypefnx {Function File} {@var{y} = } qaskenco (@var{...}) +## @deftypefnx {Function File} {[@var{inphase}, @var{quadr}] =} qaskenco (@var{...}) +## +## Map a digital signal using a square QASK constellation. The argument +## @var{m} must be a positive integer power of 2. With two input arguments +## the variable @var{msg} represents the message to be encoded. The values +## of @var{msg} must be between 0 and @code{@var{m}-1}. In all cases +## @code{qaskenco(@var{M})} is equivalent to @code{qaskenco(1:@var{m},@var{m})} +## +## Three types of outputs can be created depending on the number of output +## arguments. That is +## +## @table @asis +## @item No output arguments +## In this case @dfn{qaskenco} plots the constellation. Only the +## points in @var{msg} are plotted, which in the case of a single input +## argument is all constellation points. +## @item A single output argument +## The returned variable is a complex variable representing the in-phase +## and quadrature components of the mapped message @var{msg}. With, a +## single input argument this effectively gives the mapping from symbols +## to constellation points +## @item Two output arguments +## This is the same as two ouput arguments, expect that the in-phase +## and quadrature components are returned explicitly. That is +## +## @example +## octave> c = qaskenco(msg, m); +## octave> [a, b] = qaskenco(msg, m); +## octave> all(c == a + 1i*b) +## ans = 1 +## @end example +## @end table +## +## If @code{sqrt(@var{m})} is an integer, then @dfn{qaskenco} uses a Gray +## mapping. Otherwise, an attempt is made to create a nearly square mapping +## with a minimum Hamming distance between adjacent constellation points. +## @end deftypefn +## @seealso{qaskdeco} + +## 2005-04-23 Dmitri A. Sergatskov +## * modified for new gnuplot interface (octave > 2.9.0) + +function [a, b] = qaskenco(msg, M) + + if (nargin == 1) + M = msg; + elseif (nargin == 2) + if ((min(msg(:)) < 0) || (max(msg(:)) > M-1)) + error ("qaskenco: message invalid"); + endif + else + error ("qaskenco: incorrect number of arguments"); + endif + + if (!isscalar(M) || (M != ceil(M)) || (M < 2)) + error ("qaskenco: order of modulation must be a positive integer greater than 2"); + endif + + if (log2(M) != ceil(log2(M))) + error ("qaskenco: the order must be a power of two"); + endif + + if (M == 2) + inphase = [-1, 1]; + quadr = [ 0, 0]; + elseif (M == 4) + inphase = [-1, -1, 1, 1]; + quadr = [-1, 1, -1, 1]; + elseif (M == 8) + inphase = [-1, -1, 1, 1, -3, -3, 3, 3]; + quadr = [-1, 1, -1, 1, -1, 1, -1, 1]; + else + NC =2^floor(log2(sqrt(M))); + MM = NC * NC; + Gray = [0, 1]; + for i=2:ceil(log2(NC)) + Gray = [Gray 2^(i-1) + fliplr(Gray)]; + end + Gray = fliplr(de2bi(shift(Gray,length(Gray)/2 - 1))); + Gray2 = zeros(MM,log2(MM)); + Gray2(:,1:2:log2(MM)) = repmat(Gray,NC,1); + for i=1:NC + Gray2(i:NC:MM,2:2:log2(MM)) = Gray; + end + layout = reshape(bi2de(fliplr(Gray2)),NC,NC); + + if (MM != M) + ## Not sure this is the best that can be done for these mappings. If + ## anyone wants to improve this, go ahead, but do it in qaskdeco too. + OFF = sqrt(M/32); + NR = NC + 2*OFF; + layout2 = NaN * ones(NR); + layout2(1+OFF:OFF+NC,1+OFF:OFF+NC) = layout; + + layout2(1:OFF,1+OFF:OFF+NC) = MM + layout(OFF:-1:1,:); + layout2(NR-OFF+1:NR,1+OFF:OFF+NC) = MM + layout(NC:-1:NC-OFF+1,:); + + layout2(1+2*OFF:NC,1:OFF) = MM + layout(OFF+1:NC-OFF,OFF:-1:1); + layout2(1+2*OFF:NC,NR-OFF+1:NR) = MM + ... + layout(OFF+1:NC-OFF,NC:-1:NC-OFF+1); + + layout2(1+OFF:2*OFF,1:OFF) = MM + ... + layout(NC/2:-1:NC/2-OFF+1,NC/2:-1:OFF+1); + layout2(NC+1:OFF+NC,1:OFF) = MM + ... + layout(NC-OFF:-1:NC/2+1,NC/2:-1:OFF+1); + + layout2(1+OFF:2*OFF,NR-OFF+1:NR) = MM + ... + layout(NC/2:-1:NC/2-OFF+1,NC-OFF:-1:NC/2+1); + layout2(NC+1:OFF+NC,NR-OFF+1:NR) = MM + ... + layout(NC-OFF:-1:NC/2+1,NC-OFF:-1:NC/2+1); + NC = NR; + layout = layout2; + endif + + inphase = repmat([0:NC-1]*2 - NC + 1,1,NC); + for i=1:NC + quadr(i:NC:NC*NC) = [0:NC-1]*2 - NC + 1; + end + [dummy, indx] = sort(layout(:)); + indx = indx(1:M); ## Get rid of remaining NaN's + inphase = inphase(indx); + quadr = quadr(indx); + endif + + if (nargin == 2) + inphase = inphase(msg+1); + quadr = quadr(msg+1); + ## Fix up indexing if using column vector + if (size(msg,2) == 1) + inphase = inphase'; + quadr = quadr'; + endif + endif + + if (nargout == 0) + inphase = inphase(:); + quadr = quadr(:); + plot (inphase, quadr, "r+"); + title("QASK Constellation"); + xlabel("In-phase"); + ylabel("Quadrature"); + axis([min(inphase)-1, max(inphase)+1, min(quadr)-1, max(quadr)+1]); + xd = 0.02 * max(inphase); + if (nargin == 2) + msg = msg(:); + for i=1:length(inphase) + text(inphase(i)+xd,quadr(i),num2str(msg(i))); + end + else + for i=1:length(inphase) + text(inphase(i)+xd,quadr(i),num2str(i-1)); + end + endif + elseif (nargout == 1) + a = inphase + 1i * quadr; + else + a = inphase; + b = quadr; + endif + +endfunction diff --git a/octave_packages/communications-1.1.1/qfunc.m b/octave_packages/communications-1.1.1/qfunc.m new file mode 100644 index 0000000..c8573e5 --- /dev/null +++ b/octave_packages/communications-1.1.1/qfunc.m @@ -0,0 +1,25 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y}] =} qfunc (@var{x}) +## Compute the Q function. +## @seealso{erfc, erf} +## @end deftypefn + +function y = qfunc(x) + if (nargin < 1); usage('qfunc(x)'); end + y = 1-normcdf(x); + diff --git a/octave_packages/communications-1.1.1/qfuncinv.m b/octave_packages/communications-1.1.1/qfuncinv.m new file mode 100644 index 0000000..a0e0f8c --- /dev/null +++ b/octave_packages/communications-1.1.1/qfuncinv.m @@ -0,0 +1,27 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y}] =} qfuncinv (@var{x}) +## Compute the inverse Q function. +## @seealso{erfc, erf} +## @end deftypefn + +function y = qfuncinv(x) + if (nargin < 1); + usage('qfuncinv(x)'); + end + y = -norminv(x); +endfunction diff --git a/octave_packages/communications-1.1.1/quantiz.m b/octave_packages/communications-1.1.1/quantiz.m new file mode 100644 index 0000000..45f6007 --- /dev/null +++ b/octave_packages/communications-1.1.1/quantiz.m @@ -0,0 +1,52 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{qidx} = } quantiz (@var{x}, @var{table}) +## @deftypefnx {Function File} {[@var{qidx}, @var{q}] = } quantiz (@var{x}, @var{table}, @var{codes}) +## @deftypefnx {Function File} {[ @var{qidx}, @var{q}, @var{d}] = } quantiz (@var{...}) +## +## Quantization of an arbitrary signal relative to a paritioning. +## +## @table @code +## @item qidx = quantiz(x, table) +## Determine position of x in strictly monotonic table. The first +## interval, using index 0, corresponds to x <= table(1). +## Subsequent intervals are table(i-1) < x <= table(i). +## +## @item [qidx, q] = quantiz(x, table, codes) +## Associate each interval of the table with a code. Use codes(1) +## for x <= table(1) and codes(n+1) for table(n) < x <= table(n+1). +## +## @item [qidx, q, d] = quantiz(...) +## Compute distortion as mean squared distance of x from the +## corresponding quantization values. +## @end table +## @end deftypefn + +function [qidx, q, d] = quantiz (x, table, codes) + if (nargin < 2 || nargin > 3) + usage("[qidx, q, d] = quantiz(x, table, codes)"); + endif + + qidx = length(table) - lookup(flipud(table(:)), x(:)); + if (nargin > 2 && nargout > 1) + q = codes(qidx + 1); + endif + if (nargout > 2) + table = [table(1) ; table(:) ]; + d = sumsq (x(:) - q(:)) / length(x); + endif +endfunction diff --git a/octave_packages/communications-1.1.1/randdeintrlv.m b/octave_packages/communications-1.1.1/randdeintrlv.m new file mode 100644 index 0000000..8966f26 --- /dev/null +++ b/octave_packages/communications-1.1.1/randdeintrlv.m @@ -0,0 +1,33 @@ +## Copyright (C) 2008 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{intrlvd} =} randdeintrlv (@var{data}, @var{state}) +## Restore elements of @var{data} with a random permutation. +## @seealso{randintrlv,intrlv,deintrlv} +## @end deftypefn + +function deintrlvd = randdeintrlv(data,state) + if(nargin < 2 || nargin >2) + error('usage : deinterlvd = randdeinterlv(data,state)'); + end + + if(isvector(data)) + l = length(data); + else + l = size(data,1); + end + rand('state',state); + deintrlvd = deintrlv(data,randperm(l)); diff --git a/octave_packages/communications-1.1.1/randerr.m b/octave_packages/communications-1.1.1/randerr.m new file mode 100644 index 0000000..f0ee7d5 --- /dev/null +++ b/octave_packages/communications-1.1.1/randerr.m @@ -0,0 +1,114 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{b} = } randerr (@var{n}) +## @deftypefnx {Function File} {@var{b} = } randerr (@var{n},@var{m}) +## @deftypefnx {Function File} {@var{b} = } randerr (@var{n},@var{m},@var{err}) +## @deftypefnx {Function File} {@var{b} = } randerr (@var{n},@var{m},@var{err},@var{seed}) +## +## Generate a matrix of random bit errors. The size of the matrix is +## @var{n} rows by @var{m} columns. By default @var{m} is equal to @var{n}. +## Bit errors in the matrix are indicated by a 1. +## +## The variable @var{err} determines the number of errors per row. By +## default the return matrix @var{b} has exactly one bit error per row. +## If @var{err} is a scalar, there each row of @var{b} has exactly this +## number of errors per row. If @var{err} is a vector then each row has +## a number of errors that is in this vector. Each number of errors has +## an equal probability. If @var{err} is a matrix with two rows, then +## the first row determines the number of errors and the second their +## probabilities. +## +## The variable @var{seed} allows the random number generator to be seeded +## with a fixed value. The initial seed will be restored when returning. +## @end deftypefn + +## 2003 FEB 13 +## initial release + +function b = randerr (n, m, err, seed) + + switch (nargin) + case 0, + m = 1; + n = 1; + err = 1; + seed = Inf; + case 1, + m = n; + err = 1; + seed = Inf; + case 2, + err = 1; + seed = Inf; + case 3, + seed = Inf; + case 4, + otherwise + usage ("b = randerr (n, [m, [err, [seed]]])"); + endswitch + + ## Check error vector + [ar,ac] = size (err); + if (ac == 1) + if (ar > 1) + err = err'; + endif + elseif ((ac > 1) && (ar != 1) && (ar != 2)) + error ("randerr: err must be a scalar, vector or two row matrix"); + endif + for i=1:ac + if (err(1,i) > m) + error ("randerr: illegal number of errors per row"); + endif + end + + # Use randsrc to calculate the number of errors per row + nerrs = randsrc (n, 1, err, seed); + + # Now put to errors into place in the return matrix + b = zeros (n, m); + for i=1:n + if (nerrs(i) > 0) + if (nerrs(i) == 1) + indx = sort(randint(1,nerrs(i),m,seed)); + else + do + indx = sort(randint(1,nerrs(i),m,seed)); + until (! any(indx(1:nerrs(i)-1) == indx(2:nerrs(i)))) + endif + b(i,indx+1) = ones(1,nerrs(i)); + endif + end +endfunction + + +%!shared n, err1, err2, seed, a1, a2, a3, a4, a5, a6 +%! n = 10; err1 = 2; err2 = [1,2;0.7,0.3] ; seed = 1; +%! a1 = randerr(n); a2 = randerr(n,n); +%! a3 = randerr(n,n,err1); a4 = randerr(n,n,err2); +%! a5 = randerr(n,n,err1,seed); a6 = randerr(n,n,err1,seed); + +%!error randerr (n,n,n,n,n); +%!assert (size(a1) == [n, n] && size(a2) == [n, n]); +%!assert (all (sum (a1.') == 1) && all (sum (a2.') == 1)) +%!assert (all((a1(:) == 1 | a1(:) == 0)) &&all((a2(:) == 1 | a2(:) == 0))) +%!assert (size(a3) == [n, n] && size(a4) == [n, n]); +%!assert (all (sum (a3.') == err1)) +%!assert (all((a3(:) == 1 | a3(:) == 0))) +%!assert (all ((sum (a4.') == err2(1,1)) | (sum (a4.') == err2(1,2)))) +%!assert (all((a4(:) == 1 | a4(:) == 0))) +%!assert (a5(:) == a6(:)); diff --git a/octave_packages/communications-1.1.1/randint.m b/octave_packages/communications-1.1.1/randint.m new file mode 100644 index 0000000..4c79e3c --- /dev/null +++ b/octave_packages/communications-1.1.1/randint.m @@ -0,0 +1,99 @@ +## Copyright (C) 2001 Laurent Mazet +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{b} = } randint (@var{n}) +## @deftypefnx {Function File} {@var{b} = } randint (@var{n},@var{m}) +## @deftypefnx {Function File} {@var{b} = } randint (@var{n},@var{m},@var{range}) +## @deftypefnx {Function File} {@var{b} = } randint (@var{n},@var{m},@var{range},@var{seed}) +## +## Generate a matrix of random binary numbers. The size of the matrix is +## @var{n} rows by @var{m} columns. By default @var{m} is equal to @var{n}. +## +## The range in which the integers are generated will is determined by +## the variable @var{range}. If @var{range} is an integer, the value will +## lie in the range [0,@var{range}-1], or [@var{range}+1,0] if @var{range} +## is negative. If @var{range} contains two elements the intgers will lie +## within these two elements, inclusive. By default @var{range} is +## assumed to be [0:1]. +## +## The variable @var{seed} allows the random number generator to be seeded +## with a fixed value. The initial seed will be restored when returning. +## @end deftypefn + +## 2001 FEB 07 +## initial release + +function b = randint (n, m, range, seed) + + switch (nargin) + case 1, + m = n; + range = [0,1]; + seed = Inf; + case 2, + range = [0,1]; + seed = Inf; + case 3, + seed = Inf; + case 4, + otherwise + usage ("b = randint (n, [m, [range, [seed]]])"); + endswitch + + ## Check range + if (length (range) == 1) + if (range < 0) + range = [range+1, 0]; + else + range = [0, range-1]; + endif + elseif ( prod (size (range)) != 2) + error ("randint: range must be a 2 element vector"); + endif + range = sort (range); + + ## Check seed; + if (!isinf (seed)) + old_seed = rand ("seed"); + rand ("seed", seed); + endif + + b = range (1) - 1 + ceil (rand (n, m) * (range (2) - range (1) + 1)); + + ## Get back to the old + if (!isinf (seed)) + rand ("seed", old_seed); + endif + +endfunction + +%!shared n, m, seed, a1, a2, a3, a4, a5, a6 +%! n = 10; m = 32; seed = 1; a1 = randint(n); a2 = randint(n,n); +%! a3 = randint(n,n,m); a4 = randint(n,n,[-m,m]); +%! a5 = randint(n,n,m, seed); a6 = randint(n,n,m, seed); + +%!error randint (); +%!error randint (n,n,n,n,n); +%!assert (size(a1) == [n, n] && size(a2) == [n, n]); +%!assert (max ([a1(:); a2(:)]) <= 1 && min([a1(:); a2(:)]) >= 0); +%!assert (size(a3) == [n, n] && size(a4) == [n, n]); +%!assert (max (a3(:)) < m && min(a3(:)) >= 0); +%!assert (max (a4(:)) <= m && min(a4(:)) >= -m); +%!assert (a5(:) == a6(:)); + +%!test +%! a = randint(10,10,-32); +%! assert (max(a(:)) <= 0 && min(a(:)) > -32); diff --git a/octave_packages/communications-1.1.1/randintrlv.m b/octave_packages/communications-1.1.1/randintrlv.m new file mode 100644 index 0000000..e307bb1 --- /dev/null +++ b/octave_packages/communications-1.1.1/randintrlv.m @@ -0,0 +1,33 @@ +## Copyright (C) 2008 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{intrlvd} =} randintrlv (@var{data}, @var{state}) +## Interleaves elements of @var{data} with a random permutation. +## @seealso{intrlv,deintrlv} +## @end deftypefn + +function intrlvd = randintrlv(data,state) + if(nargin < 2 || nargin >2) + error('usage : interlvd = randinterlv(data,elements)'); + end + + if(isvector(data)) + l = length(data); + else + l = size(data,1); + end + rand('state',state); + intrlvd = intrlv(data,randperm(l)); diff --git a/octave_packages/communications-1.1.1/randsrc.m b/octave_packages/communications-1.1.1/randsrc.m new file mode 100644 index 0000000..b5009d9 --- /dev/null +++ b/octave_packages/communications-1.1.1/randsrc.m @@ -0,0 +1,120 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{b} = } randsrc (@var{n}) +## @deftypefnx {Function File} {@var{b} = } randsrc (@var{n},@var{m}) +## @deftypefnx {Function File} {@var{b} = } randsrc (@var{n},@var{m},@var{alphabet}) +## @deftypefnx {Function File} {@var{b} = } randsrc (@var{n},@var{m},@var{alphabet},@var{seed}) +## +## Generate a matrix of random symbols. The size of the matrix is +## @var{n} rows by @var{m} columns. By default @var{m} is equal to @var{n}. +## +## The variable @var{alphabet} can be either a row vector or a matrix with +## two rows. When @var{alphabet} is a row vector the symbols returned in +## @var{b} are chosen with equal probability from @var{alphabet}. When +## @var{alphabet} has two rows, the second row determines the probabilty +## with which each of the symbols is chosen. The sum of the probabilities +## must equal 1. By default @var{alphabet} is [-1 1]. +## +## The variable @var{seed} allows the random number generator to be seeded +## with a fixed value. The initial seed will be restored when returning. +## @end deftypefn + +## 2003 FEB 13 +## initial release + +function b = randsrc (n, m, alphabet, seed) + + switch (nargin) + case 0, + m = 1; + n = 1; + alphabet = [-1,1]; + seed = Inf; + case 1, + m = n; + alphabet = [-1,1]; + seed = Inf; + case 2, + alphabet = [-1,1]; + seed = Inf; + case 3, + seed = Inf; + case 4, + otherwise + usage ("b = randsrc (n, [m, [alphabet, [seed]]])"); + endswitch + + ## Check alphabet + [ar,ac] = size (alphabet); + if (ac == 1) + b = alphabet (1, 1) * ones (n, m); + return; + endif + + if (ar == 1) + prob = [1:ac] / ac; + elseif (ar == 2) + prob = alphabet(2,:); + alphabet = alphabet(1,:); + if (abs(1-sum(prob)) > eps) + error ("randsrc: probabilities must added up to one"); + endif + prob = cumsum(prob); + else + error ("randsrc: alphabet must have 1 or 2 rows"); + endif + + ## Check seed; + if (!isinf (seed)) + old_seed = rand ("seed"); + rand ("seed", seed); + endif + + ## Create indexes with the right probabilities + tmp = rand (n, m); + b = ones (n, m); + for i = 1:ac-1 + b = b + (tmp > prob(i)); + end + + ## Map the indexes to the symbols + b = alphabet(b); + + ## BUG: the above gives a row vector for some reason. Force what we want + b = reshape(b, n, m); + + ## Get back to the old + if (!isinf (seed)) + rand ("seed", old_seed); + endif + +endfunction + +%!shared n, alph1, alph2, seed, a1, a2, a3, a4, a5, a6 +%! n = 10; alph1 = [0,1;0.3,0.7]; alph2 = ['a','b']; seed = 1; +%! a1 = randsrc(n); a2 = randsrc(n,n); +%! a3 = randsrc(n,n,alph1); a4 = randsrc(n,n,alph2); +%! a5 = randsrc(n,n,alph1,seed); a6 = randsrc(n,n,alph1,seed); + +%!error randsrc (n,n,n,n,n); +%!assert (size(a1) == [n, n] && size(a2) == [n, n]); +%!assert (max ([a1(:); a2(:)]) <= 1 && min([a1(:); a2(:)]) >= -1); +%!assert (size(a3) == [n, n] && size(a4) == [n, n]); +%!assert (max (a3(:)) <= 1 && min(a3(:)) >= 0); +%!assert (max(toascii(a4(:))) <= toascii('b')) +%!assert (max(toascii(a4(:))) >= toascii('a')) +%!assert (a5(:) == a6(:)); diff --git a/octave_packages/communications-1.1.1/reedmullerdec.m b/octave_packages/communications-1.1.1/reedmullerdec.m new file mode 100644 index 0000000..5feec06 --- /dev/null +++ b/octave_packages/communications-1.1.1/reedmullerdec.m @@ -0,0 +1,266 @@ +## Copyright (C) 2007, 2011 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} reedmullerdec (@var{VV},@var{G},@var{R},@var{M}) +## +## Decode the received code word @var{VV} using the RM-generator matrix @var{G}, +## of order @var{R}, @var{M}, returning the code-word C. We use the standard +## majority logic vote method due to Irving S. Reed. The received word has to be +## a matrix of column size equal to to code-word size (i.e @math{2^m}). Each row +## is treated as a separate received word. +## +## The second return value is the message @var{M} got from @var{C}. +## +## G is obtained from definition type construction of Reed Muller code, +## of order @var{R}, length @math{2^M}. Use the function reedmullergen, +## for the generator matrix for the (@var{R},@var{M}) order RM code. +## +## Faster code constructions (also easier) exist, but since +## finding permutation order of the basis vectors, is important, we +## stick with the standard definitions. To use decoder +## function reedmullerdec, you need to use this specific +## generator function. +## +## see: Lin & Costello, Ch.4, "Error Control Coding", 2nd Ed, Pearson. +## +## @example +## @group +## G=reedmullergen(2,4); +## M=[rand(1,11)>0.5]; +## C=mod(M*G,2); +## [dec_C,dec_M]=reedmullerdec(C,G,2,4) +## +## @end group +## @end example +## +## @end deftypefn +## @seealso{reedmullergen,reedmullerenc} + +## FIXME: make possible to use different generators, if permutation +## matrix (i.e polynomial vector elements of rows of G are given +function [C,CMM]=reedmullerdec(VV,G,R,M) + if ( nargin < 4 ) + print_usage(); + end + + % + % we do a R+1 level majority logic decoding. + % at each order of polynomial modifying the code-word. + % + U=0:M-1; %allowed basis vectors in V2^M. + C=-1*ones(size(VV)); %preset the output word. + [Rows,Cols]=size(G);%rows shadows 'rows()' + + % + %first get the row index of G & its corresponding permutation + %elements. + % + P{1}=[0]; + for idx=1:M + P{idx+1}=idx; + end + idx=idx+1; + + Ufull=1:M; + r=2; + while r <= R + TMP=nchoosek(Ufull,r); + for idy=1:nchoosek(M,r) + P{idx+idy}=TMP(idy,:); + end + idx=idx+idy; + r=r+1; + end + + % + %enter majority logic decoding loop, R+1 order polynomial, + %but we do it here for n-k times, both are equivalent. + % + + NCODES=size(VV); + NCODES=NCODES(1); + v_adjust=[]; + + for row_v=1:1:NCODES + V=VV(row_v,:); + CM=-1*ones(1,Rows); + + % + %Now start at bottom row, and get the index set, + %for each until the 2nd most row. + % + + %special case, r=0, parity check, so just sum-up. + if ( R == 0 ) + wt=__majority_logic_vote(V); + CMM(row_v,:)=wt; + C(row_v,:)=mod(wt*G,2); + continue; + end + + order=R; + Gadj=G; + prev_len=length(P{Rows}); + for idx=Rows:-1:1 + % + %adjust the 'V' received vector, at change of each order. + % + if ( prev_len ~= length(P{idx}) || idx == 1 ) %force for_ idx=1 + v_adjust=mod(CM(idx+1:end)*Gadj(idx+1:end,:),2); + Gadj(idx+1:end,:)=0; + V=mod(V+ v_adjust,2); % + = - in GF(2). + order = order - 1; + if ( order == 0 ) %special handling of the all-1's basis vector. + CM(idx)=__majority_logic_vote(V); + break + end + end + + prev_len=length(P{idx}); + Si=P{idx};% index identifier + Si=sort(Si,'descend'); + + %generate index elements + B=__binvec(0:(2.^length(Si)-1)); + WTS=2.^[Si-1]; + %actual index set elements. + S=sum(B.*repmat(WTS,[2^length(Si),1]),2); + + %doing the operation set difference U \ S to get SCi + SCi=U; + Si_diff=Si-1; + rmidx=[]; + for idy=1:M + if( any( Si_diff==SCi(idy) ) ) + rmidx=[rmidx, idy]; + end + end + SCi(rmidx)=[]; + SCi=sort(SCi,'descend'); + + %corner case RM(r=m,m) case + if (length(SCi) > 0 ) + %generate the set SC, + B=__binvec(0:(2.^length(SCi)-1)); + WTS=2.^[SCi]; + %actual index set elements. + SC=sum(B.*repmat(WTS,[2^length(SCi),1]),2); + else + SC=[0]; %default, has to be empty set mathematically; + end + + % + %next compute the checksums & form the weights. + % + wts=[]; %clear prev history + for id_el = 1:length(SC) + sc_el=SC(id_el); + elems=sc_el + S; + elems=elems+1; %adjust indexing + wt=mod(sum(V(elems)),2);%add elements of V, rx vector. + wts(id_el)= wt;%this is checksum + end + + % + %do the majority logic vote. + % + CM(idx)=__majority_logic_vote(wts); + end + + CMM(row_v,:)=CM; + C(row_v,:)=mod(CM*G,2); + end + return; +end + +% +% utility functions +% +function bvec=__binvec(dec_vec) + maxlen=ceil(log2(max(dec_vec)+1)); + x=[]; bvec=zeros(length(dec_vec),maxlen); + for idx=maxlen:-1:1 + tmp=mod(dec_vec,2); + bvec(:,idx)=tmp.'; + dec_vec=(dec_vec-tmp)./2; + end + return +end + +% +% crude majority logic decoding; force the = case to 0 by default. +% +function wt=__majority_logic_vote(wts) + wt=sum(wts)-sum(1-wts);%count no of 1's - no of 0's. + if ( wt ~= 0 ) + wt = (wt > 0); + %else + %wt = rand() > 0.5; %break the tie. + %end + end +end + +% +% majority logic decoding, tie-break using random. +% +function wt=__majority_logic_vote_random(wts) + wt=(1+sign( sum(wts)-sum(1-wts) ))/2; + if ( wt == 0.5 ) + wt = (rand()>0.5); + end +end + +% test cases +%G=[1 1 1 1,1 1 1 1; +% 0 1 0 1,0 1 0 1; +% 0 0 1 1,0 0 1 1; +% 0 0 0 0 1 1 1 1]; +%m=[1 0 0 1]; +%c=mod(m*G,2); +%c(1)=1-c(1); %corrects errors! +%[dc,dm]=reedmullerdec(c,G,1,3) +%pause +% +%G=reedmullergen(1,4); +%m=[1 0 0 0 1]; +%c=mod(m*G,2); +%[dc,dm]=reedmullerdec(c,G,1,4) +%pause +% +%G=reedmullergen(3,4); +%m=[ones(1,15)]; +%c=mod(m*G,2); +%[dc,dm]=reedmullerdec(c,G,3,4) +%pause +% +%G=reedmullergen(2,3); +%m=[0 0 0 1 1 1 1] +%c=mod(m*G,2) +%[dc,dm]=reedmullerdec(c,G,2,3) +%pause +% +%G=reedmullergen(3,3); +%c1=mod([ones(1,8)]*G,2); +%c2=mod([ones(1,4),zeros(1,4)]*G,2); +%[dC,dM]=reedmullerdec([c2;c2;c1;c2],G,3,3) +% +% %special case of repetition code. +% G=reedmullergen(0,3); +% G +% c1=1*G; +% c2=0*G; C=[c1; c2] +% [dC,dM]=reedmullerdec(C,G,0,3) +% diff --git a/octave_packages/communications-1.1.1/reedmullerenc.m b/octave_packages/communications-1.1.1/reedmullerenc.m new file mode 100644 index 0000000..fc070e9 --- /dev/null +++ b/octave_packages/communications-1.1.1/reedmullerenc.m @@ -0,0 +1,52 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} reedmullerenc (@var{MSG},@var{R},@var{M}) +## +## Definition type construction of Reed Muller code, +## of order @var{R}, length @math{2^M}. This function +## returns the generator matrix for the said order RM code. +## +## Encodes the given message word/block, of column size k, +## corresponding to the RM(@var{R},@var{M}), and outputs a +## code matrix @var{C}, on each row with corresponding codeword. +## The second return value is the @var{G}, which is generator matrix +## used for this code. +## +## @example +## @group +## MSG=[rand(10,11)>0.5]; +## [C,G]=reedmullerenc(MSG,2,4); +## +## @end group +## @end example +## +## @end deftypefn +## @seealso{reedmullerdec,reedmullergen} +function [C,G]=reedmullerenc(MSG,R,M) + if ( nargin < 3 ) + print_usage(); + end + G=reedmullergen(R,M); + if ( columns(MSG) ~= rows(G) ) + error('MSG size must be corresponding to (R,M) message size'); + end + C=zeros(rows(MSG),2.^M); + for idx=1:rows(MSG) + C(idx,:)=mod(MSG(idx,:)*G,2); + end + return +end diff --git a/octave_packages/communications-1.1.1/reedmullergen.m b/octave_packages/communications-1.1.1/reedmullergen.m new file mode 100644 index 0000000..59cb37c --- /dev/null +++ b/octave_packages/communications-1.1.1/reedmullergen.m @@ -0,0 +1,81 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} reedmullergen (@var{R},@var{M}) +## +## Definition type construction of Reed Muller code, +## of order @var{R}, length @math{2^M}. This function +## returns the generator matrix for the said order RM code. +## +## RM(r,m) codes are characterized by codewords, +## @code{sum ( (m,0) + (m,1) + @dots{} + (m,r)}. +## Each of the codeword is got through spanning the +## space, using the finite set of m-basis codewords. +## Each codeword is @math{2^M} elements long. +## see: Lin & Costello, "Error Control Coding", 2nd Ed. +## +## Faster code constructions (also easier) exist, but since +## finding permutation order of the basis vectors, is important, we +## stick with the standard definitions. To use decoder +## function reedmullerdec, you need to use this specific +## generator function. +## +## @example +## @group +## G=reedmullergen(2,4); +## @end group +## @end example +## +## @end deftypefn +## @seealso{reedmullerdec,reedmullerenc} +function G=reedmullergen(R,M) + if ( nargin < 2 ) + print_usage(); + end + + G=ones(1,2^M); + if ( R == 0 ) + return; + end + + a=[0]; + b=[1]; + V=[]; + for idx=1:M; + row=repmat([a,b],[1,2^(M-idx)]); + V(idx,:)=row; + a=[a,a]; + b=[b,b]; + end + + G=[G; V]; + + if ( R == 1 ) + return + else + r=2; + while r <= R + p=nchoosek(1:M,r); + prod=V(p(:,1),:).*V(p(:,2),:); + for idx=3:r + prod=prod.*V(p(:,idx),:); + end + G=[G; prod]; + r=r+1; + end + end + return +end diff --git a/octave_packages/communications-1.1.1/ricedeco.m b/octave_packages/communications-1.1.1/ricedeco.m new file mode 100644 index 0000000..ddf46fb --- /dev/null +++ b/octave_packages/communications-1.1.1/ricedeco.m @@ -0,0 +1,80 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ricedeco (@var{code}, @var{K}) +## +## Returns the Rice decoded signal vector using @var{code} and @var{K}. +## Compulsory K is need to be specified. +## A restrictions is that a signal set must strictly be non-negative. +## The value of code is a cell array of row-vectors which have the +## encoded rice value for a single sample. The Rice algorithm is +## used to encode the 'code' and only that can be meaningfully +## decoded. @var{code} is assumed to have been of format generated +## by the function @code{riceenco}. +## +## Reference: Solomon Golomb, Run length Encodings, 1966 IEEE Trans Info' Theory +## +## An exmaple of the use of @code{ricedeco} is +## @example +## @group +## ricedec(riceenco(1:4,2),2) +## +## @end group +## @end example +## @end deftypefn +## @seealso{riceenco} + +## +## +##! /usr/bin/octave -q +##A stress test routine +##for i=1:100 +## sig=abs(randint(1,10,[0,255])); +## [code,k]=riceenco(sig) +## sig_d=ricedeco(code,k) +## if(isequal(sig_d,sig)~=1) +## error('Some mistake in ricedeco/enco pair'); +## end +##end +## +function sig_op=ricedeco(code,K) + if ( nargin < 2 ) || (strcmp(class(code),"cell")~=1) + error('usage: ricedeco(code,K)'); + end + + L=length(code); + + K_pow_2=2**K; + + if(K ~= 0) + power_seq=[2.^((K-1):-1:0)]; + for j=1:L + word=code{j}; + idx=find(word==0)(1); + val=sum(word(1:idx)); + sig_op(j)=val*K_pow_2 + sum(word(idx+1:end).*power_seq); + end + else + for j=1:L + sig_op(j)=sum(code{j}); + end + end + + return +end +%! +%! assert(ricedeco(riceenco(1:4,2),2),[1:4]) +%! diff --git a/octave_packages/communications-1.1.1/riceenco.m b/octave_packages/communications-1.1.1/riceenco.m new file mode 100644 index 0000000..5fa04e0 --- /dev/null +++ b/octave_packages/communications-1.1.1/riceenco.m @@ -0,0 +1,108 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} riceenco (@var{sig}, @var{K}) +## +## Returns the Rice encoded signal using @var{K} or optimal K . +## Default optimal K is chosen between 0-7. Currently no other way +## to increase the range except to specify explicitly. Also returns +## @var{K} parameter used (in case it were to be chosen optimally) +## and @var{Ltot} the total length of output code in bits. +## This function uses a @var{K} if supplied or by default chooses +## the optimal K for encoding signal vector into a rice coded vector. +## A restrictions is that a signal set must strictly be non-negative. +## The Rice algorithm is used to encode the data into unary coded +## quotient part which is represented as a set of 1's separated from +## the K-part (binary) using a zero. This scheme doesnt need any +## kind of dictionaries and its close to O(N), but this implementation +## *may be* sluggish, though correct. +## +## Reference: Solomon Golomb, Run length Encodings, 1966 IEEE Trans +## Info' Theory +## +## An exmaple of the use of @code{riceenco} is +## @example +## @group +## riceenco(1:4) # +## riceenco(1:10,2) # +## @end group +## @end example +## @end deftypefn +## @seealso{ricedeco} + +function [rcode,K,Ltot]=riceenco(sig,K) + if ( nargin < 1 ) + error('usage: riceenco(sig,{K})'); + elseif (nargin < 2) + use_optimal_k=1; + else + use_optimal_k=0; + end + + if (min(sig) < 0) + error("signal has elements that are outside alphabet set ... + . Accepts only non-negative numbers. Cannot encode."); + end + + + L=length(sig); + + ##compute the optimal rice parameter. + if(use_optimal_k) + k_opt=0; + len_past=sum(sig)+L+k_opt*L; + quot=sig; + + for k=1:7 + k_pow_2=2**k; + quot_k=floor(sig./k_pow_2); + len=sum(quot_k)+L+k*L; + if(len < len_past) + len_past=len; + k_opt=k; + rem=mod(sig,k_pow_2); + quot=quot_k; + end + end + Ltot=len_past; + K=k_opt; + K_pow_2=2**K; + else + K_pow_2=2**K; + quot=floor(sig./K_pow_2); + rem=mod(sig,K_pow_2); + end + + for j=1:L + rice_part=zeros(1,K); + % + % How can we eliminate this loop? + % I essentially need to get the binary + % representation of rem(j) in the rice_part(i) + % + for i=K:-1:1 + rice_part(i)=mod(rem(j),2); + rem(j)=floor(rem(j)/2); + end + rcode{j}=[ones(1,quot(j)) 0 rice_part]; + end + Ltot=sum(quot)+L+K*L; + + return +end +%! +%! assert(riceenco(1:4,2),{[0 0 1],[0 1 0], [0 1 1], [ 1 0 0 0]}) +%! diff --git a/octave_packages/communications-1.1.1/rledeco.m b/octave_packages/communications-1.1.1/rledeco.m new file mode 100644 index 0000000..6c5e0b6 --- /dev/null +++ b/octave_packages/communications-1.1.1/rledeco.m @@ -0,0 +1,52 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rledeco (@var{message}) +## +## Returns decoded run-length @var{message}. +## The RLE encoded @var{message} has to be in the form of a +## row-vector. The message format (encoded RLE) is like repetition +## [factor, value]+. +## +## An example use of @code{rledeco} is +## @example +## @group +## message=[1 5 2 4 3 1]; +## rledeco(message) #gives +## ans = [ 5 4 4 1 1 1] +## @end group +## @end example +## @end deftypefn +## @seealso{rledeco} + +function rmsg=rledeco(message) + if nargin < 1 + error('Usage: rledeco(message)') + end + rmsg=[]; + L=length(message); + itr=1; + while itr < L + times=message(itr); + val=message(itr+1); + rmsg=[rmsg val*(ones(1,times))]; + itr=itr+2; + end + return +end +%! +%!assert( rledeco([1 5 2 4 3 1]),[5 4 4 1 1 1]) +%! diff --git a/octave_packages/communications-1.1.1/rleenco.m b/octave_packages/communications-1.1.1/rleenco.m new file mode 100644 index 0000000..598d68b --- /dev/null +++ b/octave_packages/communications-1.1.1/rleenco.m @@ -0,0 +1,55 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rleenco (@var{message}) +## +## Returns run-length encoded @var{message}. The +## rle form is built from @var{message}. The original @var{message} +## has to be in the form of a row-vector. The encoded @var{message} +## format (encoded RLE) is like [repetition factor]+, values. +## +## An example use of @code{rleenco} is +## @example +## @group +## message=[ 5 4 4 1 1 1] +## rleenco(message) #gives +## ans = [1 5 2 4 3 1]; +## @end group +## @end example +## @end deftypefn +## @seealso{rleenco} + +function rmsg=rleenco(message) + if nargin < 1 + error('Usage: rleenco(message)') + end + rmsg=[]; + L=length(message); + itr=1; + while itr <= L + times=0; + val=message(itr); + while(itr <= L && message(itr)==val) + itr=itr+1; + times=times+1; + end + rmsg=[rmsg times val]; + end + return +end +%! +%!assert( rleenco([5 4 4 1 1 1]),[1 5 2 4 3 1]) +%! diff --git a/octave_packages/communications-1.1.1/rsdecof.m b/octave_packages/communications-1.1.1/rsdecof.m new file mode 100644 index 0000000..2b533e8 --- /dev/null +++ b/octave_packages/communications-1.1.1/rsdecof.m @@ -0,0 +1,92 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rsdecof (@var{in},@var{out}) +## @deftypefnx {Function File} {} rsdecof (@var{in},@var{out},@var{t}) +## +## Decodes an ascii file using a Reed-Solomon coder. The input file is +## defined by @var{in} and the result is written to the output file @var{out}. +## The type of coding to use is determined by whether the input file is 7- +## or 8-bit. If the input file is 7-bit, the default coding is [127,117]. +## while the default coding for an 8-bit file is a [255, 235]. This allows +## for 5 or 10 error characters in 127 or 255 symbols to be corrected +## respectively. The number of errors that can be corrected can be overridden +## by the variable @var{t}. +## +## If the file is not an integer multiple of the message size (127 or 255) +## in length, then the file is padded with the EOT (ascii character 4) +## character before decoding. +## +## @end deftypefn +## @seealso{rsencof} + +function rsdecof(in, out, t) + + if ((nargin < 2) || (nargin > 3)) + usage("rsdecof (in, out [, t])"); + endif + + if (!ischar(in) || !ischar(out)) + error ("rsdecof: input and output filenames must be strings"); + endif + + if (nargin != 3) + t = 0; + else + if (!isscalar(t) || (t != floor(d)) || (t < 1)) + error ("rsdecof: t must be a postive, non-zero integer"); + endif + endif + + try fid = fopen(in, "rt"); + catch + error ("rsdecof: can not open input file"); + end + [code, count] = fread(fid, Inf, "char"); + fclose(fid); + + is8bit = (max(code) > 127); + + if (is8bit) + m = 8; + n = 255; + if (t == 0) + t = 10; + endif + else + m = 7; + n = 127; + if (t == 0) + t = 5; + endif + endif + k = n - 2 * t; + + ncodewords = ceil(count / n); + npad = n * ncodewords - count; + code = reshape([code ; 4 * ones(npad,1)],n,ncodewords)'; + + msg = rsdec(gf(code,m), n, k, "beginning")'; + msg = msg(:); + + try fid = fopen(out, "w+t"); + catch + error ("rsdecof; can not open output file"); + end + fwrite(fid, msg(1:(ncodewords*k-npad)), "char"); + fclose(fid); + +endfunction diff --git a/octave_packages/communications-1.1.1/rsencof.m b/octave_packages/communications-1.1.1/rsencof.m new file mode 100644 index 0000000..afe1c5d --- /dev/null +++ b/octave_packages/communications-1.1.1/rsencof.m @@ -0,0 +1,111 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rsencof (@var{in},@var{out}) +## @deftypefnx {Function File} {} rsencof (@var{in},@var{out},@var{t}) +## @deftypefnx {Function File} {} rsencof (@var{...},@var{pad}) +## +## Encodes an ascii file using a Reed-Solomon coder. The input file is +## defined by @var{in} and the result is written to the output file @var{out}. +## The type of coding to use is determined by whether the input file is 7- +## or 8-bit. If the input file is 7-bit, the default coding is [127,117]. +## while the default coding for an 8-bit file is a [255, 235]. This allows +## for 5 or 10 error characters in 127 or 255 symbols to be corrected +## respectively. The number of errors that can be corrected can be overridden +## by the variable @var{t}. +## +## If the file is not an integer multiple of the message size (127 or 255) +## in length, then the file is padded with the EOT (ascii character 4) +## characters before coding. Whether these characters are written to the +## output is defined by the @var{pad} variable. Valid values for @var{pad} +## are "pad" (the default) and "nopad", which write or not the padding +## respectively. +## +## @end deftypefn +## @seealso{rsdecof} + +function rsencof(in, out, varargin) + + if ((nargin < 2) || (nargin > 4)) + usage("rsencof (in, out [, t [, pad]])"); + endif + + if (!ischar(in) || !ischar(out)) + error ("rsencof: input and output filenames must be strings"); + endif + + t = 0; + pad = 1; + for i=1:length(varargin) + arg = varargin{i}; + if (ischar(arg)) + if (strcmp(arg,"pad")) + pad = 1; + elseif (strcmp(arg,"nopad")) + pad = 0; + else + error ("rsencof: unrecognized string argument"); + endif + else + if (!isscalar(t) || (t != floor(d)) || (t < 1)) + error ("rsencof: t must be a postive, non-zero integer"); + endif + endif + end + + try fid = fopen(in, "r"); + catch + error ("rsencof: can not open input file"); + end + [msg, count] = fread(fid, Inf, "char"); + fclose(fid); + + is8bit = (max(msg) > 127); + + if (is8bit) + m = 8; + n = 255; + if (t == 0) + t = 10; + endif + else + m = 7; + n = 127; + if (t == 0) + t = 5; + endif + endif + k = n - 2 * t; + + ncodewords = ceil(count / k); + npad = k * ncodewords - count; + msg = reshape([msg ; 4 * ones(npad,1)],k,ncodewords)'; + + code = rsenc(gf(msg,m), n, k,"beginning")'; + code = code(:); + + try fid = fopen(out, "w"); + catch + error ("rsencof: can not open output file"); + end + if (pad) + fwrite(fid, code, "char"); + else + fwrite(fid, code(1:(ncodewords*n-npad)), "char"); + endif + fclose(fid); + +endfunction diff --git a/octave_packages/communications-1.1.1/rsgenpoly.m b/octave_packages/communications-1.1.1/rsgenpoly.m new file mode 100644 index 0000000..38ac8a7 --- /dev/null +++ b/octave_packages/communications-1.1.1/rsgenpoly.m @@ -0,0 +1,151 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{g} = } rsgenpoly (@var{n},@var{k}) +## @deftypefnx {Function File} {@var{g} = } rsgenpoly (@var{n},@var{k},@var{p}) +## @deftypefnx {Function File} {@var{g} = } rsgenpoly (@var{n},@var{k},@var{p},@var{b},@var{s}) +## @deftypefnx {Function File} {@var{g} = } rsgenpoly (@var{n},@var{k},@var{p},@var{b}) +## @deftypefnx {Function File} {[@var{g}, @var{t}] = } rsgenpoly (@var{...}) +## +## Creates a generator polynomial for a Reed-Solomon coding with message +## length of @var{k} and codelength of @var{n}. @var{n} must be greater +## than @var{k} and their difference must be even. The generator polynomial +## is returned on @var{g} as a polynomial over the Galois Field GF(2^@var{m}) +## where @var{n} is equal to @code{2^@var{m}-1}. If @var{m} is not integer +## the next highest integer value is used and a generator for a shorten +## Reed-Solomon code is returned. +## +## The elements of @var{g} represent the coefficients of the polynomial in +## descending order. If the length of @var{g} is lg, then the generator +## polynomial is given by +## @iftex +## @tex +## $$ +## g_0 x^{lg-1} + g_1 x^{lg-2} + \cdots + g_{lg-1} x + g_lg. +## $$ +## @end tex +## @end iftex +## @ifinfo +## +## @example +## @var{g}(0) * x^(lg-1) + @var{g}(1) * x^(lg-2) + ... + @var{g}(lg-1) * x + @var{g}(lg). +## @end example +## @end ifinfo +## +## If @var{p} is defined then it is used as the primitive polynomial of the +## the Galois Field GF(2^@var{m}). The default primitive polynomial will +## be used if @var{p} is equal to []. +## +## The variables @var{b} and @var{s} determine the form of the generator +## polynomial in the following manner. +## @iftex +## @tex +## $$ +## g = (x - A^{bs}) (x - A^{(b+1)s}) \cdots (x - A ^{(b+2t-1)s}). +## $$ +## @end tex +## @end iftex +## @ifinfo +## +## @example +## @var{g} = (@var{x} - A^(@var{b}*@var{s})) * (@var{x} - A^((@var{b}+1)*@var{s})) * ... * (@var{x} - A^((@var{b}+2*@var{t}-1)*@var{s})). +## @end example +## @end ifinfo +## +## where @var{t} is @code{(@var{n}-@var{k})/2}, and A is the primitive element +## of the Galois Field. Therefore @var{b} is the first consecutive root of the +## generator polynomial and @var{s} is the primitive element to generate the +## the polynomial roots. +## +## If requested the variable @var{t}, which gives the error correction +## capability of the the Reed-Solomon code +## @end deftypefn +## @seealso{gf,rsenc,rsdec} + +function [g, t] = rsgenpoly(n, k, _prim, _b, _s) + + if ((nargin < 2) || (nargin > 5)) + error ("usage: [g, t] = rsgenpoly(n, k, p, b, s)"); + endif + + if (!isscalar(n) || (n < 3) || ((n - floor(n)) != 0)) + error ("rsgenpoly: invalid codeword length"); + endif + + if (!isscalar(k) || (k < 1) || ((k- floor(k)) != 0)) + error ("rsgenpoly: invalid message length"); + endif + + if (((n-k)/2 - floor((n-k)/2)) != 0) + error ("rsgenpoly: difference of codeword and message lengths must be even"); + endif + + m = ceil(log2(n+1)); + ## Adjust n and k if n not equal to 2^m-1 + dif = 2^m - 1 - n; + n = n + dif; + k = k + dif; + + prim = 0; + if (nargin > 2) + if (isempty(_prim)) + prim = 0; + else + prim = _prim; + endif + endif + + if (!isscalar(prim) || (prim<0) || ((prim - floor(prim)) != 0)) + error ("rsgenpoly: primitive polynomial must use integer representation"); + endif + + if (prim != 0) + if (!isprimitive(prim)) + error ("rsgenpoly: polynomial is not primitive"); + endif + + if ((prim < 2^m) || (prim > 2^(m+1))) + error ("rsgenpoly: invalid order of the primitive polynomial"); + endif + endif + + b = 1; + if (nargin > 3) + b = _b; + endif + + if (!isscalar(b) || (b < 0) || ((b - floor(b)) != 0)) + error ("rsgenpoly: invalid value of b"); + endif + + s = 1; + if (nargin > 4) + s = _s; + endif + + if (!isscalar(s) || (s < 0) || ((s - floor(s)) != 0)) + error ("rsgenpoly: invalid value of s"); + endif + + alph = gf(2, m, prim); + t = (n - k) / 2; + + g = gf(1, m, prim); + for i= 1:2*t + g = conv(g, gf([1,alph^((b+i-1)*s)], m, prim)); + end + +endfunction diff --git a/octave_packages/communications-1.1.1/scatterplot.m b/octave_packages/communications-1.1.1/scatterplot.m new file mode 100644 index 0000000..ca62e69 --- /dev/null +++ b/octave_packages/communications-1.1.1/scatterplot.m @@ -0,0 +1,158 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} scatterplot (@var{x}) +## @deftypefnx {Function File} {} scatterplot (@var{x},@var{n}) +## @deftypefnx {Function File} {} scatterplot (@var{x},@var{n},@var{off}) +## @deftypefnx {Function File} {} scatterplot (@var{x},@var{n},@var{off},@var{str}) +## @deftypefnx {Function File} {} scatterplot (@var{x},@var{n},@var{off},@var{str},@var{h}) +## @deftypefnx {Function File} {@var{h} =} scatterplot (@var{...}) +## +## Display the scatter plot of a signal. The signal @var{x} can be either in +## one of three forms +## +## @table @asis +## @item A real vector +## In this case the signal is assumed to be real and represented by the vector +## @var{x}. The scatterplot is plotted along the x axis only. +## @item A complex vector +## In this case the in-phase and quadrature components of the signal are +## plotted seperately on the x and y axes respectively. +## @item A matrix with two columns +## In this case the first column represents the in-phase and the second the +## quadrature components of a complex signal and are plotted on the x and +## y axes respectively. +## @end table +## +## Each point of the scatter plot is assumed to be seperated by @var{n} +## elements in the signal. The first element of the signal to plot is +## determined by @var{off}. By default @var{n} is 1 and @var{off} is 0. +## +## The string @var{str} is a plot style string (example 'r+'), +## and by default is the default gnuplot point style. +## +## The figure handle to use can be defined by @var{h}. If @var{h} is not +## given, then the next available figure handle is used. The figure handle +## used in returned on @var{hout}. +## @end deftypefn +## @seealso{eyediagram} + +## 2005-04-23 Dmitri A. Sergatskov +## * modified for new gnuplot interface (octave > 2.9.0) + +function varargout = scatterplot (x, n, _off, str, h) + + if ((nargin < 1) || (nargin > 5)) + usage (" h = scatterplot (x, n [, off [, str [, h]]]])"); + endif + + if (isreal(x)) + if (min(size(x)) == 1) + signal = "real"; + xr = x(:); + xi = zeros(size(xr)); + elseif (size(x,2) == 2) + signal = "complex"; + xr = x(:,1); + xi = x(:,2); + else + error ("scatterplot: real signal input must be a vector"); + endif + else + signal = "complex"; + if (min(size(x)) != 1) + error ("scatterplot: complex signal input must be a vector"); + endif + xr = real(x(:)); + xi = imag(x(:)); + endif + + if (!length(xr)) + error ("scatterplot: zero length signal"); + endif + + if (nargin > 1) + if (!isscalar(n) || !isreal(n) || (floor(n) != n) || (n < 1)) + error ("scatterplot: n must be a positive non-zero integer"); + endif + else + n = 1; + endif + + if (nargin > 2) + if (!isscalar(_off) || !isreal(_off) || (floor(_off) != _off) || ... + (_off < 0) || (_off > length(x)-1)) + error ("scatterplot: offset must be an integer between 0 and length(x)-1"); + endif + off = _off; + else + off = 0; + endif + + if (nargin > 3) + if (isempty(str)) + fmt = "-r"; + elseif (ischar(str)) + fmt = str; + else + error ("scatterplot: plot format must be a string"); + endif + else + fmt = "-r"; + endif + + if (nargin > 4) + hout = figure (h); + else + hout = figure (); + endif + + xr = xr(off+1:n:rows(xr)); + xi = xi(off+1:n:rows(xi)); + + plot(xr,xi,fmt); + if (!strcmp(signal,"complex")) + ## FIXME: What is the appropriate xrange + xmax = max(xr); + xmin = min(xr); + xran = xmax - xmin + xmax = ceil(2 * xmax / xran) / 2 * xran; + xmin = floor(2 * xmin / xran) / 2 * xran; + axis([xmin, xmax, -1, 1]); + endif + title("Scatter plot"); + xlabel("In-phase"); + ylabel("Quadrature"); + legend("off"); + + if (nargout > 0) + varargout{1} = hout; + endif + +endfunction + +%!demo +%! n = 200; +%! ovsp=5; +%! x = 1:n; +%! xi = [1:1/ovsp:n-0.1]; +%! y = randsrc(1,n,[1 + 1i, 1 - 1i, -1 - 1i, -1 + 1i]) ; +%! yi = interp1(x,y,xi); +%! noisy = awgn(yi,15,"measured"); +%! hold off; +%! h = scatterplot(noisy,1,0,"b",1); +%! hold on; +%! scatterplot(noisy,ovsp,0,"r+",h); diff --git a/octave_packages/communications-1.1.1/shannonfanodeco.m b/octave_packages/communications-1.1.1/shannonfanodeco.m new file mode 100644 index 0000000..2478448 --- /dev/null +++ b/octave_packages/communications-1.1.1/shannonfanodeco.m @@ -0,0 +1,142 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} shannonfanodeco (@var{hcode},@var{dict}) +## +## Returns the original signal that was Shannonfano encoded. The signal +## was encoded using @code{shannonfanoenco}. This function uses +## a dict built from the @code{shannonfanodict} and uses it to decode a signal +## list into a shannonfano list. Restrictions include hcode is expected to be a binary code; +## returned signal set that strictly belongs in the @code{range [1,N]}, +## with @code{N=length(dict)}. Also dict can only be from the +## @code{shannonfanodict(...)} routine. Whenever decoding fails, +## those signal values are indicated by -1, and we successively +## try to restart decoding from the next bit that hasnt failed in +## decoding, ad-infinitum. +## +## An example use of @code{shannonfanodeco} is +## @example +## @group +## hd=shannonfanodict(1:4,[0.5 0.25 0.15 0.10]) +## hcode=shannonfanoenco(1:4,hd) # [ 1 0 1 0 0 0 0 0 1 ] +## shannonfanodeco(hcode,hd) # [1 2 3 4] +## +## @end group +## @end example +## @end deftypefn +## @seealso{shannonfanoenco, shannonfanodict} + +function sig=shannonfanodeco(hcode,dict) + if ( nargin < 2 || strcmp(class(dict),"cell")~=1 ) + error('usage: shannonfanoenco(sig,dict)'); + end + if (max(hcode) > 1 || min(hcode) < 0) + error("hcode has elements that are outside alphabet set ... + Cannot decode."); + end + +# TODO: +# O(log(N)) algorithms exist, but we need some effort to implement those +# Maybe sometime later, it would be a nice 1-day project +# Ref: A memory efficient Shannonfano Decoding Algorithm, AINA 2005, IEEE +# + +# TODO: Somebody can implement a 'faster' algorithm than O(N^3) at present +# Decoding Algorithm O(N+k*log(N)) which is approximately O(N+Nlog(N)) +# +# 1. Separate the dictionary by the lengths +# and knows symbol correspondence. +# +# 2. Find the symbol in the dict of lengths l,h where +# l = smallest cw length ignoring 0 length CW, and +# h = largest cw length , with k=h-l+1; +# +# 3. Match the k codewords to the dict using binary +# search, and then you can declare decision. +# +# 4. In case of non-decodable words skip the start-bit +# used in the previous case, and then restart the same +# procedure from the next bit. +# + L=length(dict); + lenL=length(dict{1}); + lenH=0; + +# +# Know the ranges of operation +# + for itr=1:L + t=length(dict{itr}); + if(t < lenL) + lenL=t; + end + if(t > lenH) + lenH=t; + end + end + +# +# Now do a O(N^4) algorithm +# + itr=0; #offset into the hcode + sig=[]; #output + CL=length(hcode); + + %whole decoding loop. + while ( itr < CL ) + %decode one element (or just try to). + for itr_y=lenL:lenH + %look for word in dictionary. + %with flag to indicate found + %or not found. Detect end of buffer. + + if ( (itr+itr_y) > CL ) + break; + end + + word=hcode(itr+1:itr+itr_y); + flag=0; + + %word + + %search loop. + for itr_z=1:L + if(isequal(dict{itr_z},word)) + itr=itr+itr_y; + sig=[sig itr_z]; + flag=1; + break; + end + end %for_ loop breaker + + if( flag == 1 ) + break; %also need to break_ above then. + end + + end %for_ loop + + + #could not decode + if( flag == 0 ) + itr=itr+1; + sig=[sig -1]; + end + + end %while_ loop +end +%! +%! assert(shannonfanodeco(shannonfanoenco(1:4, shannonfanodict(1:4,[0.5 0.25 0.15 0.10])), shannonfanodict(1:4,[0.5 0.25 0.15 0.10])), [1:4],0) +%! diff --git a/octave_packages/communications-1.1.1/shannonfanodict.m b/octave_packages/communications-1.1.1/shannonfanodict.m new file mode 100644 index 0000000..9329407 --- /dev/null +++ b/octave_packages/communications-1.1.1/shannonfanodict.m @@ -0,0 +1,118 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} shannonfanodict (@var{symbols},@var{symbol_probabilites}) +## +## Returns the code dictionary for source using shanno fano algorithm. +## Dictionary is built from @var{symbol_probabilities} using the shannon +## fano scheme. Output is a dictionary cell-array, which +## are codewords, and correspond to the order of input probability. +## +## @example +## @group +## CW=shannonfanodict(1:4,[0.5 0.25 0.15 0.1]); +## assert(redundancy(CW,[0.5 0.25 0.15 0.1]),0.25841,0.001) +## shannonfanodict(1:5,[0.35 0.17 0.17 0.16 0.15]) +## shannonfanodict(1:8,[8 7 6 5 5 4 3 2]./40) +## @end group +## @end example +## @end deftypefn +## @seealso{shannonfanoenc, shannonfanodec} +## +function cw_list=shannonfanodict(symbol,P) + + if nargin < 2 + error('Usage: shannonfanodict(symbol,P); see help'); + end + + DMAX=length(P); + S=1:DMAX; + + if(sum(P)-1.000 > 1e-7) + error('Sum of probabilities must be 1.000'); + end +# +#FIXME: Is there any other way of doing the +#topological sort? Insertion sort is bad. +# +#Sort the probability list in +#descending/non-increasing order. +#Using plain vanilla insertion sort. +# + for i=1:DMAX + for j=i:DMAX + + if(P(i) < P(j)) + + #Swap prob + t=P(i); + P(i)=P(j); + P(j)=t; + + #Swap symb + t=S(i); + S(i)=S(j); + S(j)=t; + end + + end + end + + + #Now for each symbol you need to + #create code as first [-log p(i)] bits of + #cumulative function sum(p(1:i)) + # + #printf("Shannon Codes\n"); + #data_table=zeros(1,DMAX); + cw_list={}; + + for itr=1:DMAX + if(P(itr)~=0) + digits=ceil(-log2(P(itr))); #somany digits needed. + else + digits=0; #dont assign digits for zero probability symbols. + end + + Psum = sum([0 P](1:itr)); #Cumulative probability + s=[]; + for i=1:digits; + Psum=2*Psum; + if(Psum >= 1.00) + s=[s 1]; + Psum=Psum-1.00; + else + s=[s 0]; + end + end + cw_list{itr}=s; + end + + #re-arrange the list accroding to input prob list. + cw_list2={}; + for i=1:length(cw_list) + cw_list2{i}=cw_list{S(i)}; + end + cw_list=cw_list2; + + return; +end + +%!shared CW,P +%!test +%! P = [0.5 0.25 0.15 0.1]; +%! assert(shannonfanodict(1:4,P),{[0],[1 0],[1 1 0],[1 1 1 0]}) +%! diff --git a/octave_packages/communications-1.1.1/shannonfanoenco.m b/octave_packages/communications-1.1.1/shannonfanoenco.m new file mode 100644 index 0000000..9e528f3 --- /dev/null +++ b/octave_packages/communications-1.1.1/shannonfanoenco.m @@ -0,0 +1,50 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} shannonfanoenco (@var{hcode},@var{dict}) +## +## Returns the Shannon Fano encoded signal using @var{dict}. +## This function uses a @var{dict} built from the @code{shannonfanodict} +## and uses it to encode a signal list into a shannon fano code. +## Restrictions include a signal set that strictly belongs in the +## @code{range [1,N]} with @code{N=length(dict)}. Also dict can only be +## from the @code{shannonfanodict()} routine. +## An example use of @code{shannonfanoenco} is +## +## @example +## @group +## hd=shannonfanodict(1:4,[0.5 0.25 0.15 0.10]) +## shannonfanoenco(1:4,hd) # [ 0 1 0 1 1 0 1 1 1 0] +## @end group +## @end example +## @end deftypefn +## @seealso{shannonfanodeco, shannonfanodict} +## + +function sf_code=shannonfanoenco(sig,dict) + if nargin < 2 + error('usage: huffmanenco(sig,dict)'); + end + if (max(sig) > length(dict)) || ( min(sig) < 1) + error("signal has elements that are outside alphabet set ... + Cannot encode."); + end + sf_code=[dict{sig}]; + return +end +%! +%! assert(shannonfanoenco(1:4, shannonfanodict(1:4,[0.5 0.25 0.15 0.10])),[ 0 1 0 1 1 0 1 1 1 0],0) +%! diff --git a/octave_packages/communications-1.1.1/symerr.m b/octave_packages/communications-1.1.1/symerr.m new file mode 100644 index 0000000..b19ec09 --- /dev/null +++ b/octave_packages/communications-1.1.1/symerr.m @@ -0,0 +1,143 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{num}, @var{rate}] = } symerr (@var{a},@var{b}) +## @deftypefnx {Function File} {[@var{num}, @var{rate}] = } symerr (@var{...},@var{flag}) +## @deftypefnx {Function File} {[@var{num}, @var{rate} @var{ind}] = } symerr (@var{...}) +## +## Compares two matrices and returns the number of symbol errors and the +## symbol error rate. The variables @var{a} and @var{b} can be either: +## +## @table @asis +## @item Both matrices +## In this case both matrices must be the same size and then by default the +## the return values @var{num} and @var{rate} are the overall number of symbol +## errors and the overall symbol error rate. +## @item One column vector +## In this case the column vector is used for symbol error comparision +## column-wise with the matrix. The returned values @var{num} and @var{rate} +## are then row vectors containing the num of symbol errors and the symbol +## error rate for each of the column-wise comparisons. The number of rows in +## the matrix must be the same as the length of the column vector +## @item One row vector +## In this case the row vector is used for symbol error comparision row-wise +## with the matrix. The returned values @var{num} and @var{rate} are then +## column vectors containing the num of symbol errors and the symbol error rate +## for each of the row-wise comparisons. The number of columns in the matrix +## must be the same as the length of the row vector +## @end table +## +## This behaviour can be overridden with the variable @var{flag}. @var{flag} +## can take the value 'column-wise', 'row-wise' or 'overall'. A column-wise +## comparision is not possible with a row vector and visa-versa. +## @end deftypefn + +## 2003 FEB 13 +## initial release + +function [num, rate, ind] = symerr (a, b, _flag) + + if ((nargin < 2) || (nargin > 4)) + usage ("[num rate ind] = symerr (a, b [,flag])"); + endif + if (any(any(isinf(a))) || any(any(isnan(a))) || any(any(isinf(b))) || ... + any(any(isnan(b))) || !real(a) || !real(b) || ... + any(any((floor(a)) != a)) || any(any((floor(b)) != b)) || ... + any(any(a < 0)) || any(any(b < 0))) + error ("symerr: a and b must contain only postive integers"); + endif + + [ar,ac] = size(a); + [br,bc] = size(b); + + if ((ar == br) && (ac == bc)) + type = "matrix"; + flag = "overall"; + c = 1; + elseif (any([ar,br] == 1)) + type = "row"; + flag = "row"; + if (ac != bc) + error ("symerr: row-wise comparison must have the same number of columns in inputs"); + endif + if (ar == 1) + a = ones(br,1) * a; + else + b = ones(ar,1) * b; + endif + elseif (any([ac,bc] == 1)) + type = "column"; + flag = "column"; + if (ar != br) + error ("symerr: column-wise comparison must have the same number of rows in inputs"); + endif + if (ac == 1) + a = a * ones(1,bc); + else + b = b * ones(1,ac); + endif + else + error ("symerr: matrix sizes must match"); + endif + + if (nargin > 2) + if (ischar(_flag)) + if (strcmp(_flag,"row-wise")) + if (strcmp(type,"column")) + error ("symerr: row-wise comparison not possible with column inputs"); + endif + flag = "row"; + elseif (strcmp(_flag,"column-wise")) + if (strcmp(type,"row")) + error ("symerr: column-wise comparison not possible with row inputs"); + endif + flag = "column"; + elseif (strcmp(_flag,"overall")) + flag = "overall"; + else + error ("symerr: unrecognized string argument"); + endif + else + error ("symerr: unrecognized argument"); + endif + endif + + ## Call the core error function to count the bit errors + ind = (__errcore__(a,b) != 0); + + switch (flag) + case 'row', + if (strcmp(type,"matrix") && (ac == 1)) + num = ind; + else + num = sum(ind')'; + endif + rate = num / max(ac,bc); + case 'column', + if (strcmp(type,"matrix") && (ar == 1)) + num = ind; + else + num = sum(ind); + endif + rate = num / max(ar,br); + case 'overall', + num = sum(sum(ind)); + rate = num / max(ar,br) / max(ac,bc); + otherwise + error("impossible"); + endswitch + +endfunction diff --git a/octave_packages/communications-1.1.1/systematize.m b/octave_packages/communications-1.1.1/systematize.m new file mode 100644 index 0000000..5cdcf2b --- /dev/null +++ b/octave_packages/communications-1.1.1/systematize.m @@ -0,0 +1,121 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} systematize (@var{G}) +## +## Given @var{G}, extract P partiy check matrix. Assume row-operations in GF(2). +## @var{G} is of size KxN, when decomposed through row-operations into a @var{I} of size KxK +## identity matrix, and a parity check matrix @var{P} of size Kx(N-K). +## +## Most arbitrary code with a given generator matrix @var{G}, can be converted into its +## systematic form using this function. +## +## This function returns 2 values, first is default being @var{Gx} the systematic version of +## the @var{G} matrix, and then the parity check matrix @var{P}. +## +## @example +## @group +## G=[1 1 1 1; 1 1 0 1; 1 0 0 1]; +## [Gx,P]=systematize(G); +## +## Gx = [1 0 0 1; 0 1 0 0; 0 0 1 0]; +## P = [1 0 0]; +## @end group +## @end example +## +## @end deftypefn +## @seealso{bchpoly,biterr} +function [G,P]=systematize(G) + if ( nargin < 1 ) + print_usage(); + end + + [K,N]=size(G); + + if ( K >= N ) + error('G matrix must be ordered as KxN, with K < N'); + end + + % + % gauss-jordan echelon formation, + % and then back-operations to get I of size KxK + % remaining is the P matrix. + % + + for row=1:K + + % + %pick a pivot for this row, by finding the + %first of remaining rows that have non-zero element + %in the pivot. + % + + found_pivot=0; + if ( G(row,row) > 0 ) + found_pivot=1; + else + % + % next step of Gauss-Jordan, you need to + % re-sort the remaining rows, such that their + % pivot element is non-zero. + % + for idx=row+1:K + if ( G(idx,row) > 0 ) + tmp=G(row,:); + G(row,:)=G(idx,:); + G(idx,:)=tmp; + found_pivot=1; + break; + end + end + end + + % + %some linearly dependent problems: + % + if ( ~found_pivot ) + error('cannot systematize matrix G'); + return + end + + % + % Gauss-Jordan method: + % pick pivot element, then remove it + % from the rest of the rows. + % + for idx=row+1:K + if( G(idx,row) > 0 ) + G(idx,:)=mod(G(idx,:)+G(row,:),2); + end + end + + end + + % + % Now work-backward. + % + for row=K:-1:2 + for idx=row-1:-1:1 + if( G(idx,row) > 0 ) + G(idx,:)=mod(G(idx,:)+G(row,:),2); + end + end + end + + %I=G(:,1:K); + P=G(:,K+1:end); + return; +end diff --git a/octave_packages/communications-1.1.1/vec2mat.m b/octave_packages/communications-1.1.1/vec2mat.m new file mode 100644 index 0000000..123d143 --- /dev/null +++ b/octave_packages/communications-1.1.1/vec2mat.m @@ -0,0 +1,56 @@ +## Copyright (C) 2001 Laurent Mazet +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{m} = } vec2mat (@var{v}, @var{c}) +## @deftypefnx {Function File} {@var{m} = } vec2mat (@var{v}, @var{c}, @var{d}) +## @deftypefnx {Function File} {[@var{m}, @var{add}] = } vec2mat (@dots{}) +## +## Converts the vector @var{v} into a @var{c} column matrix with row priority +## arrangement and with the final column padded with the value @var{d} to the +## correct length. By default @var{d} is 0. The amount of padding added to +## the matrix is returned in @var{add}. +## @end deftypefn + +## 2001-02-02 +## initial release + +function [M, d] = vec2mat (V, c, val) + + switch (nargin) + case 1, + M = V; + return; + case 2, + val = 0; + case 3, + val = val; + otherwise + error ("usage: [M, add] = vec2mat (V, c [, d])"); + endswitch + + V = V.'; + V = V(:); + + r = ceil (length (V) / c); + + d = r * c - length (V); + if (d != 0) + V = [ V ; val*ones(d, 1) ]; + endif + + M = reshape (V, c, r).'; + +endfunction diff --git a/octave_packages/communications-1.1.1/wgn.m b/octave_packages/communications-1.1.1/wgn.m new file mode 100644 index 0000000..fcacc29 --- /dev/null +++ b/octave_packages/communications-1.1.1/wgn.m @@ -0,0 +1,143 @@ +## Copyright (C) 2002 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} wgn (@var{m},@var{n},@var{p}) +## @deftypefnx {Function File} {@var{y} =} wgn (@var{m},@var{n},@var{p},@var{imp}) +## @deftypefnx {Function File} {@var{y} =} wgn (@var{m},@var{n},@var{p},@var{imp},@var{seed},) +## @deftypefnx {Function File} {@var{y} =} wgn (@var{...},'@var{type}') +## @deftypefnx {Function File} {@var{y} =} wgn (@var{...},'@var{output}') +## +## Returns a M-by-N matrix @var{y} of white Gaussian noise. @var{p} specifies +## the power of the output noise, which is assumed to be referenced to an +## impedance of 1 Ohm, unless @var{imp} explicitly defines the impedance. +## +## If @var{seed} is defined then the randn function is seeded with this +## value. +## +## The arguments @var{type} and @var{output} must follow the above numerial +## arguments, but can be specified in any order. @var{type} specifies the +## units of @var{p}, and can be 'dB', 'dBW', 'dBm' or 'linear'. 'dB' is +## in fact the same as 'dBW' and is keep as a misnomer of Matlab. The +## units of 'linear' are in Watts. +## +## The @var{output} variable should be either 'real' or 'complex'. If the +## output is complex then the power @var{p} is divided equally betwen the +## real and imaginary parts. +## +## @seealso{randn,awgn} +## @end deftypefn + +## 2003-01-28 +## initial release + +function y = wgn (m, n, p, varargin) + + if ((nargin < 3) || (nargin > 7)) + error ("usage: wgn(m, n, p, imp, seed, type, output)"); + endif + + if (!isscalar(m) || !isreal(m) || (m < 0) || !isscalar(n) || ... + !isreal(n) || (n<0)) + error ("wgn: matrix dimension error"); + endif + + type = "dBW"; + out = "real"; + imp = 1; + seed = []; + narg = 0; + + for i=1:length(varargin) + arg = varargin{i}; + if (ischar(arg)) + if (strcmp(arg,"real")) + out = "real"; + elseif (strcmp(arg,"complex")) + out = "complex"; + elseif (strcmp(arg,"dB")) + type = "dBW"; + elseif (strcmp(arg,"dBW")) + type = "dBW"; + elseif (strcmp(arg,"dBm")) + type = "dBm"; + elseif (strcmp(arg,"linear")) + type = "linear"; + else + error ("wgn: invalid argument"); + endif + else + narg++; + switch (narg) + case 1, + imp = arg; + case 2, + seed = arg; + otherwise + error ("wgn: too many arguments"); + endswitch + endif + end + + if (isempty(imp)) + imp = 1; + elseif (!isscalar(imp) || !isreal(imp) || (imp < 0)) + error ("wgn: impedance value illegal"); + endif + + if (!isempty(seed)) + if (!isscalar(seed) || !isreal(seed) || (seed < 0) || + ((seed-floor(seed)) != 0)) + error ("wgn: random seed must be integer"); + endif + endif + + if (!isscalar(p) || !isreal(p)) + error("wgn: invalid power"); + endif + if (strcmp(type,"linear") && (p < 0)) + error("wgn: invalid power"); + endif + + if (strcmp(type,"dBW")) + np = 10 ^ (p/10); + elseif (strcmp(type,"dBm")) + np = 10 ^((p - 30)/10); + elseif (strcmp(type,"linear")) + np = p; + endif + + if(!isempty(seed)) + randn("state",seed); + endif + + if (strcmp(out,"complex")) + y = (sqrt(imp*np/2))*(randn(m,n)+1i*randn(m,n)); + else + y = (sqrt(imp*np))*randn(m,n); + endif + +endfunction + +## Allow 30% error in standard deviation, due to randomness +%!error wgn (); +%!error wgn (1); +%!error wgn (1,1); +%!error wgn (1,1,1,1,1,1); +%!assert (isreal(wgn(10,10,30,1,"dBm","real"))); +%!assert (iscomplex(wgn(10,10,30,1,"dBm","complex"))); +%!assert (abs(std(wgn(10000,1,30,1,"dBm")) - 1) < 0.3); +%!assert (abs(std(wgn(10000,1,0,1,"dBW")) - 1) < 0.3); +%!assert (abs(std(wgn(10000,1,1,1,"linear")) - 1) < 0.3); diff --git a/octave_packages/control-2.3.52/@frd/__c2d__.m b/octave_packages/control-2.3.52/@frd/__c2d__.m new file mode 100644 index 0000000..0ca1c61 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__c2d__.m @@ -0,0 +1,31 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Convert the continuous FRD object into its discrete-time equivalent. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function sys = __c2d__ (sys, tsam, method = "zoh") + + error ("frd: c2d: conversion not possible"); + + ## NOTE: changing just the sampling time wouldn't make sense here + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__ctranspose__.m b/octave_packages/control-2.3.52/@frd/__ctranspose__.m new file mode 100644 index 0000000..8222c63 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__ctranspose__.m @@ -0,0 +1,35 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Conjugate transpose of FRD objects. + +## Author: Lukas Reichlin +## Created: May 2012 +## Version: 0.1 + +function sys = __ctranspose__ (sys) + + [p, m, l] = size (sys.H); + + H = mat2cell (sys.H, p, m, ones (1, l))(:); + + H = cellfun (@ctranspose, H, "uniformoutput", false); + + sys.H = cat (3, H{:}); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__d2c__.m b/octave_packages/control-2.3.52/@frd/__d2c__.m new file mode 100644 index 0000000..cefb8cc --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__d2c__.m @@ -0,0 +1,31 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Convert the discrete FRD object into its continuous-time equivalent. + +## Author: Lukas Reichlin +## Created: September 2011 +## Version: 0.1 + +function sys = __d2c__ (sys, tsam, method = "zoh") + + error ("frd: d2c: conversion not possible"); + + ## NOTE: changing just the sampling time wouldn't make sense here + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__freqresp__.m b/octave_packages/control-2.3.52/@frd/__freqresp__.m new file mode 100644 index 0000000..2e0233e --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__freqresp__.m @@ -0,0 +1,81 @@ +## Copyright (C) 2010, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Frequency response of FRD models :-) + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.2 + +function H = __freqresp__ (sys, w, resptype = 0, cellflag = false) + + [H, w_sys, tsam] = frdata (sys, "array"); + + if (! isempty (w)) # freqresp (frdsys, w), sigma (frdsys, w), ... + tol = sqrt (eps); + w_idx = arrayfun (@(x) find (abs (w_sys - x) < tol), w, "uniformoutput", false); + w_idx = vertcat (w_idx{:}); + + ## NOTE: There are problems when cellfun uses "uniformoutput", true + ## and find returns an empty matrix, + + if (length (w_idx) != numel (w)) + error ("frd: freqresp: some frequencies are not within tolerance %g", tol); + endif + + H = H(:, :, w_idx); + endif + + [p, m, l] = size (H); + + if (resptype == 0) + + if (cellflag) + H = mat2cell (H, p, m, ones (1, l))(:); + endif + + else + + if (m != p) + error ("tf: freqresp: system must be square for response type %d", resptype); + endif + + H = mat2cell (H, p, m, ones (1, l))(:); + j = eye (p); + + switch (resptype) + case 1 # inversed system + H = cellfun (@inv, H, "uniformoutput", false); + + case 2 # inversed sensitivity + H = cellfun (@(x) j + x, H, "uniformoutput", false); + + case 3 # inversed complementary sensitivity + H = cellfun (@(x) j + inv (x), H, "uniformoutput", false); + + otherwise + error ("frd: freqresp: invalid response type"); + endswitch + + if (! cellflag) + H = cat (3, H{:}); + endif + + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@frd/__get__.m b/octave_packages/control-2.3.52/@frd/__get__.m new file mode 100644 index 0000000..2ed11c3 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__get__.m @@ -0,0 +1,39 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Access property values of FRD objects. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function val = __get__ (sys, prop) + + switch (prop) # {, } + case {"h", "r", "resp", "response"} + val = sys.H; + + case {"w", "f", "freq", "frequency"} + val = sys.w; + + otherwise + error ("frd: get: invalid property name"); + + endswitch + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__minreal__.m b/octave_packages/control-2.3.52/@frd/__minreal__.m new file mode 100644 index 0000000..14b0c47 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__minreal__.m @@ -0,0 +1,29 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Minimal realization of FRD objects. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function sys = __minreal__ (sys, tol) + + warning ("frd: minreal: frequency responses are always minimal"); + +endfunction diff --git a/octave_packages/control-2.3.52/@frd/__pole__.m b/octave_packages/control-2.3.52/@frd/__pole__.m new file mode 100644 index 0000000..52b0d8b --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__pole__.m @@ -0,0 +1,29 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Poles of FRD object. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function pol = __pole__ (sys) + + error ("frd: pole: this is not possible"); + +endfunction diff --git a/octave_packages/control-2.3.52/@frd/__property_names__.m b/octave_packages/control-2.3.52/@frd/__property_names__.m new file mode 100644 index 0000000..f3957d6 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__property_names__.m @@ -0,0 +1,46 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{props}, @var{vals}] =} __property_names__ (@var{sys}) +## @deftypefnx {Function File} {[@var{props}, @var{vals}] =} __property_names__ (@var{sys}, @var{"specific"}) +## Return the list of properties as well as the assignable values for a frd object sys. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function [props, vals] = __property_names__ (sys, flg) + + ## cell vector of tf-specific properties + props = {"H"; + "w"}; + + ## cell vector of frd-specific assignable values + vals = {"p-by-m-by-l array of complex frequency responses"; + "l-by-1 vector of real frequencies (l = length (w))"}; + + if (nargin == 1) + [ltiprops, ltivals] = __property_names__ (sys.lti); + + props = [props; + ltiprops]; + + vals = [vals; + ltivals]; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__set__.m b/octave_packages/control-2.3.52/@frd/__set__.m new file mode 100644 index 0000000..25a2391 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__set__.m @@ -0,0 +1,43 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Set or modify properties of FRD objects. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function sys = __set__ (sys, prop, val) + + switch (prop) # {, } + case {"h", "r", "resp", "response"} + val = __adjust_frd_data__ (val, sys.w); + __frd_dim__ (val, sys.w); + sys.H = val; + + case {"w", "f", "freq", "frequency"} + [~, val] = __adjust_frd_data__ (sys.H, val); + __frd_dim__ (sys.H, val); + sys.w = val; + + otherwise + error ("frd: set: invalid property name"); + + endswitch + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__sys2ss__.m b/octave_packages/control-2.3.52/@frd/__sys2ss__.m new file mode 100644 index 0000000..def60d0 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__sys2ss__.m @@ -0,0 +1,32 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## FRD to SS conversion. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function [retsys, retlti] = __sys2ss__ (sys) + + error ("frd: frd2ss: system identification not implemented yet"); + + retsys = dss (a, b, c, d, e); + retlti = sys.lti; # preserve lti properties + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__sys2tf__.m b/octave_packages/control-2.3.52/@frd/__sys2tf__.m new file mode 100644 index 0000000..771ec29 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__sys2tf__.m @@ -0,0 +1,32 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## FRD to TF conversion. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function [retsys, retlti] = __sys2tf__ (sys) + + error ("frd: frd2tf: system identification not implemented yet"); + + retsys = tf (num, den, get (sys, "tsam")); # tsam needed to set appropriate tfvar + retlti = sys.lti; # preserve lti properties + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__sys_connect__.m b/octave_packages/control-2.3.52/@frd/__sys_connect__.m new file mode 100644 index 0000000..97b6321 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__sys_connect__.m @@ -0,0 +1,54 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{retsys} =} __sys_connect__ (@var{sys}, @var{M}) +## This function is part of the Model Abstraction Layer. No argument checking. +## For internal use only. +## @example +## @group +## Problem: Solve the system equations of +## Y(s) = G(s) E(s) +## E(s) = U(s) + M Y(s) +## in order to build +## Y(s) = H(s) U(s) +## Solution: +## Y(s) = G(s) [U(s) + M Y(s)] +## Y(s) = G(s) U(s) + G(s) M Y(s) +## Y(s) = [I - G(s) M]^-1 G(s) U(s) +## \_______ _______/ +## H(s) +## @end group +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function sys = __sys_connect__ (sys, M) + + [p, m, l] = size (sys.H); + + I = eye (p); + H = mat2cell (sys.H, p, m, ones (1, l))(:); + + H = cellfun (@(x) (I - x*M) \ x, H, "uniformoutput", false); + + sys.H = cat (3, H{:}); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__sys_data__.m b/octave_packages/control-2.3.52/@frd/__sys_data__.m new file mode 100644 index 0000000..6828d67 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__sys_data__.m @@ -0,0 +1,30 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Used by frdata instead of multiple get calls. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function [H, w] = __sys_data__ (sys) + + H = sys.H; + w = sys.w; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__sys_group__.m b/octave_packages/control-2.3.52/@frd/__sys_group__.m new file mode 100644 index 0000000..542049c --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__sys_group__.m @@ -0,0 +1,77 @@ +## Copyright (C) 2010, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Block diagonal concatenation of two FRD models. +## This file is part of the Model Abstraction Layer. +## For internal use only. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.2 + +function retsys = __sys_group__ (sys1, sys2) + + if (! isa (sys1, "frd")) + sys1 = frd (sys1, sys2.w); + endif + + if (! isa (sys2, "frd")) + sys2 = frd (sys2, sys1.w); + endif + + retsys = frd (); + retsys.lti = __lti_group__ (sys1.lti, sys2.lti); + + lw1 = length (sys1.w); + lw2 = length (sys2.w); + + [p1, m1, l1] = size (sys1.H); + [p2, m2, l2] = size (sys2.H); + + ## TODO: tolerances for frequencies, i.e. don't check for equality + + ## find intersection of frequency vectors + if (lw1 == lw2 && all (sys1.w == sys2.w)) # identical frequency vectors + retsys.w = sys1.w; + H1 = sys1.H; + H2 = sys2.H; + else # differing frequency vectors + ## find common frequencies + retsys.w = w = intersect (sys1.w, sys2.w); + + ## indices of common frequencies + w1_idx = arrayfun (@(x) find (sys1.w == x), w); + w2_idx = arrayfun (@(x) find (sys2.w == x), w); + + ## extract common responses + H1 = sys1.H(:, :, w1_idx); + H2 = sys2.H(:, :, w2_idx); + endif + + ## block-diagonal concatenation + lw = length (retsys.w); + z12 = zeros (p1, m2); + z21 = zeros (p2, m1); + H1 = mat2cell (H1, p1, m1, ones (1, lw))(:); + H2 = mat2cell (H2, p2, m2, ones (1, lw))(:); + + H = cellfun (@(x, y) [x, z12; z21, y], H1, H2, "uniformoutput", false); + + retsys.H = cat (3, H{:}); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__sys_inverse__.m b/octave_packages/control-2.3.52/@frd/__sys_inverse__.m new file mode 100644 index 0000000..0876d31 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__sys_inverse__.m @@ -0,0 +1,35 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Inversion of FRD objects. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function sys = __sys_inverse__ (sys) + + [p, m, l] = size (sys.H); + + H = mat2cell (sys.H, p, m, ones (1, l))(:); + + H = cellfun (@inv, H, "uniformoutput", false); + + sys.H = cat (3, H{:}); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__sys_prune__.m b/octave_packages/control-2.3.52/@frd/__sys_prune__.m new file mode 100644 index 0000000..8af6e4a --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__sys_prune__.m @@ -0,0 +1,33 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Submodel extraction and reordering for FRD objects. +## This file is part of the Model Abstraction Layer. +## For internal use only. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function sys = __sys_prune__ (sys, out_idx, in_idx, w_idx = ":") + + sys.lti = __lti_prune__ (sys.lti, out_idx, in_idx); + + sys.H = sys.H(out_idx, in_idx, w_idx); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__transpose__.m b/octave_packages/control-2.3.52/@frd/__transpose__.m new file mode 100644 index 0000000..8781a9c --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__transpose__.m @@ -0,0 +1,35 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Transpose of FRD objects. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function sys = __transpose__ (sys) + + [p, m, l] = size (sys.H); + + H = mat2cell (sys.H, p, m, ones (1, l))(:); + + H = cellfun (@transpose, H, "uniformoutput", false); + + sys.H = cat (3, H{:}); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/__zero__.m b/octave_packages/control-2.3.52/@frd/__zero__.m new file mode 100644 index 0000000..b635bde --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/__zero__.m @@ -0,0 +1,29 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Transmission zeros of FRD object. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function [zer, gain] = __zero__ (sys) + + error ("frd: zero: this is not possible"); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@frd/display.m b/octave_packages/control-2.3.52/@frd/display.m new file mode 100644 index 0000000..05abeb9 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/display.m @@ -0,0 +1,138 @@ +## Copyright (C) 2010, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Display routine for FRD objects. + +## Author: Lukas Reichlin +## Created: February 2010 +## Version: 0.2 + +function display (sys) + + sysname = inputname (1); + [inname, outname, tsam] = __lti_data__ (sys.lti); + + [inname, m] = __labels__ (inname, "u"); + [outname, p] = __labels__ (outname, "y"); + + w = __freq2str__ (sys.w); + + disp (""); + + for k = 1 : m + disp (["Frequency response '", sysname, "' from input '", inname{k}, "' to output ..."]); + disp (""); + __disp_resp__ (sys.H(:,k,:), w, outname); + endfor + + display (sys.lti); # display sampling time + + if (tsam == -2) + disp ("Static gain."); + elseif (tsam == 0) + disp ("Continuous-time frequency response."); + else + disp ("Discrete-time frequency response."); + endif + +endfunction + + +function __disp_resp__ (H, w, outname) + + p = rows (H); # number of outputs + len = size (H, 3); # number of frequencies + + H = mat2cell (H, ones (1, p), 1, len)(:); + H = cellfun (@__resp2str__, H, outname, "uniformoutput", false); + + tsize = terminal_size (); + col_freq = columns (w); + col_resp = cellfun (@columns, H); + col_max = tsize(2) - col_freq; + width = cumsum (col_resp); + + start = 0; + stop = col_max; + while (start < width(end)) + idx = find (width > start & width <= stop); + disp ([w, H{idx}]); + disp (""); + start = width(idx(end)); + stop = start + col_max; + endwhile + + ## FIXME: Handle case where tsize(2) is not enough + ## to display frequencies and one output. + +endfunction + + +function str = __freq2str__ (w, title = "w [rad/s]") + + len = rows (w); + str = __vec2str__ (w); + line = repmat ("-", 1, max (columns (str), columns (title))); + str = strvcat (title, line, str); + space = repmat (" ", len+2, 1); + str = [space, str]; + +endfunction + + +function str = __resp2str__ (H, outname) + + H = H(:); + len = length (H); + real_str = __vec2str__ (real (H)); + im = imag (H); + if (any (im)) + imag_str = __vec2str__ (abs (im), "i"); + sign_str = repmat (" + ", len, 1); + neg = im < 0; + sign_str(neg, 2) = "-"; + str = [real_str, sign_str, imag_str]; + else + str = real_str; + endif + line = repmat ("-", 1, max (columns (str), columns (outname))); + str = strvcat (outname, line, str); + space = repmat (" ", len+2, 1); + str = [space, str]; + +endfunction + + +function str = __vec2str__ (vec, post) + + vec = vec(:); + tmp = isfinite (vec); + tmp = abs (vec(tmp & vec != 0)); + if (isempty (tmp) || min (tmp) < 1e-3 || max (tmp) > 1e4) + str = arrayfun (@(x) sprintf ("%.3e", x), vec, "uniformoutput", false); + elseif (all (floor (tmp) == tmp)) + str = arrayfun (@(x) sprintf ("%d", x), vec, "uniformoutput", false); + else + str = arrayfun (@(x) sprintf ("%.4f", x), vec, "uniformoutput", false); + endif + str = strjust (char (str), "right"); + if (nargin > 1) + str = [str, repmat(post, length (vec), 1)]; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@frd/frd.m b/octave_packages/control-2.3.52/@frd/frd.m new file mode 100644 index 0000000..e12f522 --- /dev/null +++ b/octave_packages/control-2.3.52/@frd/frd.m @@ -0,0 +1,127 @@ +## Copyright (C) 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} frd (@var{sys}) +## @deftypefnx {Function File} {@var{sys} =} frd (@var{sys}, @var{w}) +## @deftypefnx {Function File} {@var{sys} =} frd (@var{H}, @var{w}, @dots{}) +## @deftypefnx {Function File} {@var{sys} =} frd (@var{H}, @var{w}, @var{tsam}, @dots{}) +## Create or convert to frequency response data. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model to be converted to frequency response data. +## If second argument @var{w} is omitted, the interesting +## frequency range is calculated by the zeros and poles of @var{sys}. +## @item H +## Frequency response array (p-by-m-by-lw). H(i,j,k) contains the +## response from input j to output i at frequency k. In the SISO case, +## a vector (lw-by-1) or (1-by-lw) is accepted as well. +## @item w +## Frequency vector (lw-by-1) in radian per second [rad/s]. +## Frequencies must be in ascending order. +## @item tsam +## Sampling time in seconds. If @var{tsam} is not specified, +## a continuous-time model is assumed. +## @item @dots{} +## Optional pairs of properties and values. +## Type @command{set (frd)} for more information. +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## Frequency response data object. +## @end table +## +## @seealso{dss, ss, tf} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: February 2010 +## Version: 0.1 + +function sys = frd (H = [], w = [], varargin) + + ## NOTE: * There's no such thing as a static gain + ## because FRD objects are measurements, + ## not models. + ## * If something like sys1 = frd (5) existed, + ## it would cause troubles in cases like + ## sys2 = ss (...), sys = sys1 * sys2 + ## because sys2 needs to be converted to FRD, + ## but sys1 contains no valid frequencies. + ## * However, things like frd (ss (5)) should + ## be possible. + + ## model precedence: frd > ss > zpk > tf > double + superiorto ("ss", "zpk", "tf", "double"); + + argc = 0; # initialize argument count + + switch (nargin) + case 0 # empty object sys = frd () + tsam = -2; # undefined sampling time + + case 1 + if (isa (H, "frd")) # already in frd form sys = frd (frdsys) + sys = H; + return; # nothing more to do here + elseif (isa (H, "lti")) # another lti object sys = frd (sys) + [sys, alti] = __sys2frd__ (H); + sys.lti = alti; # preserve lti properties + return; # nothing more to do here + else # sys = frd (H) *must* fail + print_usage (); + endif + + case 2 + if (isa (H, "lti")) # another lti object sys = frd (sys, w) + [sys, alti] = __sys2frd__ (H, w); + sys.lti = alti; # preserve lti properties + return; # nothing more to do here + else # sys = frd (H, w) + tsam = 0; # continuous-time + endif + + otherwise # default case + argc = numel (varargin); # number of additional arguments after H and w + if (issample (varargin{1}, -10)) # sys = frd (H, w, tsam, "prop1", val1, ...) + tsam = varargin{1}; # sampling time, could be 0 as well + argc--; # tsam is not a property-value pair + if (argc > 0) # if there are any properties and values ... + varargin = varargin(2:end); # remove tsam from property-value list + endif + else # sys = frd (H, w, "prop1", val1, ...) + tsam = 0; # continuous-time + endif + endswitch + + [H, w] = __adjust_frd_data__ (H, w); + [p, m] = __frd_dim__ (H, w); # determine number of outputs and inputs + + frdata = struct ("H", H, "w", w); # struct for frd-specific data + ltisys = lti (p, m, tsam); # parent class for general lti data + + sys = class (frdata, "frd", ltisys); # create frd object + + if (argc > 0) # if there are any properties and values, ... + sys = set (sys, varargin{:}); # use the general set function + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/__lti_data__.m b/octave_packages/control-2.3.52/@lti/__lti_data__.m new file mode 100644 index 0000000..bc33a54 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/__lti_data__.m @@ -0,0 +1,31 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Used by display routines instead of multiple get calls. + +## Author: Lukas Reichlin +## Created: September 2010 +## Version: 0.1 + +function [inname, outname, tsam] = __lti_data__ (sys) + + inname = sys.inname; + outname = sys.outname; + tsam = sys.tsam; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/__lti_group__.m b/octave_packages/control-2.3.52/@lti/__lti_group__.m new file mode 100644 index 0000000..412bbe6 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/__lti_group__.m @@ -0,0 +1,51 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Block diagonal concatenation of two LTI models. +## This file is part of the Model Abstraction Layer. +## For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function retlti = __lti_group__ (lti1, lti2) + + retlti = lti (); + + retlti.inname = [lti1.inname; + lti2.inname]; + + retlti.outname = [lti1.outname; + lti2.outname]; + + if (lti1.tsam == lti2.tsam) + retlti.tsam = lti1.tsam; + elseif (lti1.tsam == -2) + retlti.tsam = lti2.tsam; + elseif (lti2.tsam == -2) + retlti.tsam = lti1.tsam; + elseif (lti1.tsam == -1 && lti2.tsam > 0) + retlti.tsam = lti2.tsam; + elseif (lti2.tsam == -1 && lti1.tsam > 0) + retlti.tsam = lti1.tsam; + else + error ("lti_group: systems must have identical sampling times"); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/__lti_prune__.m b/octave_packages/control-2.3.52/@lti/__lti_prune__.m new file mode 100644 index 0000000..a86b3e4 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/__lti_prune__.m @@ -0,0 +1,32 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Submodel extraction and reordering for LTI objects. +## This file is part of the Model Abstraction Layer. +## For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function lti = __lti_prune__ (lti, out_idx, in_idx) + + lti.inname = lti.inname(in_idx); + lti.outname = lti.outname(out_idx); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/__property_names__.m b/octave_packages/control-2.3.52/@lti/__property_names__.m new file mode 100644 index 0000000..2f18750 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/__property_names__.m @@ -0,0 +1,45 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{props}, @var{vals}] =} __property_names__ (@var{sys}) +## Return the list of properties as well as the assignable values for an LTI object sys. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function [props, vals] = __property_names__ (sys) + + ## cell vector of lti-specific properties + props = {"tsam"; + "inname"; + "outname"; + "name"; + "notes"; + "userdata"}; + + ## cell vector of lti-specific assignable values + vals = {"scalar (sample time in seconds)"; + "m-by-1 cell vector of strings"; + "p-by-1 cell vector of strings"; + "string"; + "string or cell of strings"; + "any data type"}; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/append.m b/octave_packages/control-2.3.52/@lti/append.m new file mode 100644 index 0000000..09e3069 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/append.m @@ -0,0 +1,37 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} append (@var{sys1}, @var{sys2}) +## Group LTI models by appending their inputs and outputs. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function sys = append (varargin) + + sys = varargin{1}; + + if (nargin > 1) + for k = 2 : nargin + sys = __sys_group__ (sys, varargin{k}); + endfor + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/blkdiag.m b/octave_packages/control-2.3.52/@lti/blkdiag.m new file mode 100644 index 0000000..916a2cd --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/blkdiag.m @@ -0,0 +1,31 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} blkdiag (@var{sys1}, @var{sys2}) +## Block-diagonal concatenation of LTI models. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function sys = blkdiag (varargin) + + sys = append (varargin{:}); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/c2d.m b/octave_packages/control-2.3.52/@lti/c2d.m new file mode 100644 index 0000000..397ce76 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/c2d.m @@ -0,0 +1,222 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} c2d (@var{sys}, @var{tsam}) +## @deftypefnx {Function File} {@var{sys} =} c2d (@var{sys}, @var{tsam}, @var{method}) +## @deftypefnx {Function File} {@var{sys} =} c2d (@var{sys}, @var{tsam}, @var{"prewarp"}, @var{w0}) +## Convert the continuous lti model into its discrete-time equivalent. +## +## @strong{Inputs} +## @table @var +## @item sys +## Continuous-time LTI model. +## @item tsam +## Sampling time in seconds. +## @item method +## Optional conversion method. If not specified, default method @var{"zoh"} +## is taken. +## @table @var +## @item "zoh" +## Zero-order hold or matrix exponential. +## @item "tustin", "bilin" +## Bilinear transformation or Tustin approximation. +## @item "prewarp" +## Bilinear transformation with pre-warping at frequency @var{w0}. +## @end table +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## Discrete-time LTI model. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function sys = c2d (sys, tsam, method = "std", w0 = 0) + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + if (! isa (sys, "lti")) + error ("c2d: first argument is not an lti model"); + endif + + if (isdt (sys)) + error ("c2d: system is already discrete-time"); + endif + + if (! issample (tsam)) + error ("c2d: second argument is not a valid sample time"); + endif + + if (! ischar (method)) + error ("c2d: third argument is not a string"); + endif + + if (! issample (w0, 0)) + error ("c2d: fourth argument is not a valid pre-warping frequency"); + endif + + sys = __c2d__ (sys, tsam, lower (method), w0); + sys.tsam = tsam; + +endfunction + + +## bilinear transformation +## using oct-file directly +%!shared Mo, Me +%! A = [ 1.0 0.5 +%! 0.5 1.0 ].'; +%! +%! B = [ 0.0 -1.0 +%! 1.0 0.0 ].'; +%! +%! C = [ -1.0 0.0 +%! 0.0 1.0 ].'; +%! +%! D = [ 1.0 0.0 +%! 0.0 -1.0 ].'; +%! +%! [Ao, Bo, Co, Do] = slab04md (A, B, C, D, 1.0, 1.0, false); +%! +%! Ae = [ -1.0000 -4.0000 +%! -4.0000 -1.0000 ]; +%! +%! Be = [ 2.8284 0.0000 +%! 0.0000 -2.8284 ]; +%! +%! Ce = [ 0.0000 2.8284 +%! -2.8284 0.0000 ]; +%! +%! De = [ -1.0000 0.0000 +%! 0.0000 -3.0000 ]; +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (Mo, Me, 1e-4); + + +## bilinear transformation +## user function +%!shared Mo, Me +%! A = [ 1.0 0.5 +%! 0.5 1.0 ].'; +%! +%! B = [ 0.0 -1.0 +%! 1.0 0.0 ].'; +%! +%! C = [ -1.0 0.0 +%! 0.0 1.0 ].'; +%! +%! D = [ 1.0 0.0 +%! 0.0 -1.0 ].'; +%! +%! [Ao, Bo, Co, Do] = ssdata (c2d (ss (A, B, C, D), 2, "tustin")); +%! +%! Ae = [ -1.0000 -4.0000 +%! -4.0000 -1.0000 ]; +%! +%! Be = [ 2.8284 0.0000 +%! 0.0000 -2.8284 ]; +%! +%! Ce = [ 0.0000 2.8284 +%! -2.8284 0.0000 ]; +%! +%! De = [ -1.0000 0.0000 +%! 0.0000 -3.0000 ]; +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (Mo, Me, 1e-4); + + +## bilinear transformation +## both directions +%!shared Mo, Me +%! A = [ 1.0 0.5 +%! 0.5 1.0 ]; +%! +%! B = [ 0.0 -1.0 +%! 1.0 0.0 ]; +%! +%! C = [ -1.0 0.0 +%! 0.0 1.0 ]; +%! +%! D = [ 1.0 0.0 +%! 0.0 -1.0 ]; +%! +%! [Ao, Bo, Co, Do] = ssdata (d2c (c2d (ss (A, B, C, D), 2, "tustin"), "tustin")); +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [A, B; C, D]; +%! +%!assert (Mo, Me, 1e-4); + + +## zero-order hold +## both directions +%!shared Mo, Me +%! A = [ 1.0 0.5 +%! 0.5 1.0 ]; +%! +%! B = [ 0.0 -1.0 +%! 1.0 0.0 ]; +%! +%! C = [ -1.0 0.0 +%! 0.0 1.0 ]; +%! +%! D = [ 1.0 0.0 +%! 0.0 -1.0 ]; +%! +%! [Ao, Bo, Co, Do] = ssdata (d2c (c2d (ss (A, B, C, D), 2, "zoh"), "zoh")); +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [A, B; C, D]; +%! +%!assert (Mo, Me, 1e-4); + + +## bilinear transformation with pre-warping +## both directions +%!shared Mo, Me +%! A = [ 1.0 0.5 +%! 0.5 1.0 ]; +%! +%! B = [ 0.0 -1.0 +%! 1.0 0.0 ]; +%! +%! C = [ -1.0 0.0 +%! 0.0 1.0 ]; +%! +%! D = [ 1.0 0.0 +%! 0.0 -1.0 ]; +%! +%! [Ao, Bo, Co, Do] = ssdata (d2c (c2d (ss (A, B, C, D), 2, "prewarp", 1000), "prewarp", 1000)); +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [A, B; C, D]; +%! +%!assert (Mo, Me, 1e-4); diff --git a/octave_packages/control-2.3.52/@lti/connect.m b/octave_packages/control-2.3.52/@lti/connect.m new file mode 100644 index 0000000..4d6b58e --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/connect.m @@ -0,0 +1,59 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} connect (@var{sys}, @var{cm}, @var{inputs}, @var{outputs}) +## Arbitrary interconnections between the inputs and outputs of an LTI model. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function sys = connect (sys, cm, in_idx, out_idx) + + if (nargin != 4) + print_usage (); + endif + + [p, m] = size (sys); + [cmrows, cmcols] = size (cm); + + ## TODO: proper argument checking + ## TODO: name-based interconnections + ## TODO: replace nested for-if statement + + if (! is_real_matrix (cm)) + error ("connect: second argument must be a matrix with real coefficients"); + endif + + M = zeros (m, p); + in = cm(:, 1); + out = cm(:, 2:cmcols); + + for a = 1 : cmrows + for b = 1 : cmcols-1 + if (out(a, b) != 0) + M(in(a, 1), abs (out(a, b))) = sign (out(a, b)); + endif + endfor + endfor + + sys = __sys_connect__ (sys, M); + sys = __sys_prune__ (sys, out_idx, in_idx); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/ctranspose.m b/octave_packages/control-2.3.52/@lti/ctranspose.m new file mode 100644 index 0000000..9837f5b --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/ctranspose.m @@ -0,0 +1,48 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Conjugate transpose or pertransposition of LTI objects. +## Used by Octave for "sys'". +## For a transfer-function matrix G, G' denotes the conjugate +## of G given by G.'(-s) for a continuous-time system or G.'(1/z) +## for a discrete-time system. +## The frequency response of the pertransposition of G is the +## Hermitian (conjugate) transpose of G(jw), i.e. +## freqresp (G', w) = freqresp (G, w)'. +## @strong{WARNING:} Do @strong{NOT} use this for dual problems, +## use the transpose "sys.'" (note the dot) instead. + +## Author: Lukas Reichlin +## Created: May 2012 +## Version: 0.1 + +function sys = ctranspose (sys) + + if (nargin != 1) # prevent sys = ctranspose (sys1, sys2, sys3, ...) + error ("lti: ctranspose: this is an unary operator"); + endif + + [p, m] = size (sys); + ct = isct (sys); + + sys = __ctranspose__ (sys, ct); + + sys.inname = repmat ({""}, p, 1); + sys.outname = repmat ({""}, m, 1); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/d2c.m b/octave_packages/control-2.3.52/@lti/d2c.m new file mode 100644 index 0000000..63a165c --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/d2c.m @@ -0,0 +1,146 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} d2c (@var{sys}) +## @deftypefnx {Function File} {@var{sys} =} d2c (@var{sys}, @var{method}) +## @deftypefnx {Function File} {@var{sys} =} d2c (@var{sys}, @var{"prewarp"}, @var{w0}) +## Convert the discrete lti model into its continuous-time equivalent. +## +## @strong{Inputs} +## @table @var +## @item sys +## Discrete-time LTI model. +## @item method +## Optional conversion method. If not specified, default method @var{"zoh"} +## is taken. +## @table @var +## @item "zoh" +## Zero-order hold or matrix logarithm. +## @item "tustin", "bilin" +## Bilinear transformation or Tustin approximation. +## @item "prewarp" +## Bilinear transformation with pre-warping at frequency @var{w0}. +## @end table +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## Continuous-time LTI model. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2011 +## Version: 0.2 + +function sys = d2c (sys, method = "std", w0 = 0) + + if (nargin == 0 || nargin > 3) + print_usage (); + endif + + if (! isa (sys, "lti")) + error ("d2c: first argument is not an lti model"); + endif + + if (isct (sys)) + error ("d2c: system is already continuous-time"); + endif + + if (! ischar (method)) + error ("d2c: second argument is not a string"); + endif + + if (! issample (w0, 0)) + error ("d2c: third argument is not a valid pre-warping frequency"); + endif + + sys = __d2c__ (sys, sys.tsam, lower (method), w0); + sys.tsam = 0; + +endfunction + + +## bilinear transformation +## both directions +%!shared Mo, Me +%! A = [ 1.0 0.5 +%! 0.5 1.0 ]; +%! +%! B = [ 0.0 -1.0 +%! 1.0 0.0 ]; +%! +%! C = [ -1.0 0.0 +%! 0.0 1.0 ]; +%! +%! D = [ 1.0 0.0 +%! 0.0 -1.0 ]; +%! +%! [Ao, Bo, Co, Do] = ssdata (d2c (c2d (ss (A, B, C, D), 2, "tustin"), "tustin")); +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [A, B; C, D]; +%! +%!assert (Mo, Me, 1e-4); + + +## zero-order hold +## both directions +%!shared Mo, Me +%! A = [ 1.0 0.5 +%! 0.5 1.0 ]; +%! +%! B = [ 0.0 -1.0 +%! 1.0 0.0 ]; +%! +%! C = [ -1.0 0.0 +%! 0.0 1.0 ]; +%! +%! D = [ 1.0 0.0 +%! 0.0 -1.0 ]; +%! +%! [Ao, Bo, Co, Do] = ssdata (d2c (c2d (ss (A, B, C, D), 2, "zoh"), "zoh")); +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [A, B; C, D]; +%! +%!assert (Mo, Me, 1e-4); + + +## bilinear transformation with pre-warping +## both directions +%!shared Mo, Me +%! A = [ 1.0 0.5 +%! 0.5 1.0 ]; +%! +%! B = [ 0.0 -1.0 +%! 1.0 0.0 ]; +%! +%! C = [ -1.0 0.0 +%! 0.0 1.0 ]; +%! +%! D = [ 1.0 0.0 +%! 0.0 -1.0 ]; +%! +%! [Ao, Bo, Co, Do] = ssdata (d2c (c2d (ss (A, B, C, D), 2, "prewarp", 1000), "prewarp", 1000)); +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [A, B; C, D]; +%! +%!assert (Mo, Me, 1e-4); diff --git a/octave_packages/control-2.3.52/@lti/dcgain.m b/octave_packages/control-2.3.52/@lti/dcgain.m new file mode 100644 index 0000000..8a6d806 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/dcgain.m @@ -0,0 +1,50 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{k} =} dcgain (@var{sys}) +## DC gain of LTI model. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. +## @end table +## +## @strong{Outputs} +## @table @var +## @item k +## DC gain matrice. For a system with m inputs and p outputs, the array @var{k} +## has dimensions [p, m]. +## @end table +## +## @seealso{freqresp} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function gain = dcgain (sys) + + if (nargin != 1) # sys is always an LTI model + print_usage (); + endif + + gain = __freqresp__ (sys, 0); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/display.m b/octave_packages/control-2.3.52/@lti/display.m new file mode 100644 index 0000000..77cdc5e --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/display.m @@ -0,0 +1,33 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Display routine for LTI objects. Called by its child classes. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function display (ltisys) + + if (ltisys.tsam > 0) + disp (sprintf ("Sampling time: %g s", ltisys.tsam)); + elseif (ltisys.tsam == -1) + disp ("Sampling time: unspecified"); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/dss.m b/octave_packages/control-2.3.52/@lti/dss.m new file mode 100644 index 0000000..d32022f --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/dss.m @@ -0,0 +1,42 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Convert to descriptor state-space model. +## Since it is impossible to call a function inside @NAME without any +## argument of class NAME (except the constructor @NAME/NAME.m), +## the "constructor" for dss models is located outside folder @ss. + +## Author: Lukas Reichlin +## Created: September 2010 +## Version: 0.1 + +function sys = dss (sys) + + if (nargin != 1) + print_usage (); + endif + + if (! isa (sys, "ss")) + sys = ss (sys); + endif + + a = __sys_data__ (sys); + + sys = __set__ (sys, "e", eye (size (a))); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/dssdata.m b/octave_packages/control-2.3.52/@lti/dssdata.m new file mode 100644 index 0000000..8a940e7 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/dssdata.m @@ -0,0 +1,79 @@ +## Copyright (C) 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{a}, @var{b}, @var{c}, @var{d}, @var{e}, @var{tsam}] =} dssdata (@var{sys}) +## @deftypefnx {Function File} {[@var{a}, @var{b}, @var{c}, @var{d}, @var{e}, @var{tsam}] =} dssdata (@var{sys}, @var{[]}) +## Access descriptor state-space model data. +## Argument @var{sys} is not limited to descriptor state-space models. +## If @var{sys} is not a descriptor state-space model, it is converted automatically. +## +## @strong{Inputs} +## @table @var +## @item sys +## Any type of LTI model. +## @item [] +## In case @var{sys} is not a dss model (descriptor matrix @var{e} empty), +## @code{dssdata (sys, [])} returns the empty element @code{e = []} whereas +## @code{dssdata (sys)} returns the identity matrix @code{e = eye (size (a))}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item a +## State transition matrix (n-by-n). +## @item b +## Input matrix (n-by-m). +## @item c +## Measurement matrix (p-by-n). +## @item d +## Feedthrough matrix (p-by-m). +## @item e +## Descriptor matrix (n-by-n). +## @item tsam +## Sampling time in seconds. If @var{sys} is a continuous-time model, +## a zero is returned. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2010 +## Version: 0.2 + +function [a, b, c, d, e, tsam, scaled] = dssdata (sys, flg = 0) + + ## NOTE: In case sys is not a dss model (matrice e empty), + ## dssdata (sys, []) returns e = [] whereas + ## dssdata (sys) returns e = eye (size (a)) + + if (nargin > 2) + print_usage (); + endif + + if (! isa (sys, "ss")) + sys = ss (sys); + endif + + [a, b, c, d, e, ~, scaled] = __sys_data__ (sys); + + if (isempty (e) && ! isempty (flg)) + e = eye (size (a)); # return eye for ss models + endif + + tsam = sys.tsam; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/eig.m b/octave_packages/control-2.3.52/@lti/eig.m new file mode 100644 index 0000000..6da0434 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/eig.m @@ -0,0 +1,31 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{p} =} eig (@var{sys}) +## Compute poles of LTI system. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function pol = eig (varargin) + + pol = pole (varargin{:}); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/feedback.m b/octave_packages/control-2.3.52/@lti/feedback.m new file mode 100644 index 0000000..15dc8f6 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/feedback.m @@ -0,0 +1,263 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} feedback (@var{sys1}) +## @deftypefnx {Function File} {@var{sys} =} feedback (@var{sys1}, @var{"+"}) +## @deftypefnx {Function File} {@var{sys} =} feedback (@var{sys1}, @var{sys2}) +## @deftypefnx {Function File} {@var{sys} =} feedback (@var{sys1}, @var{sys2}, @var{"+"}) +## @deftypefnx {Function File} {@var{sys} =} feedback (@var{sys1}, @var{sys2}, @var{feedin}, @var{feedout}) +## @deftypefnx {Function File} {@var{sys} =} feedback (@var{sys1}, @var{sys2}, @var{feedin}, @var{feedout}, @var{"+"}) +## Feedback connection of two LTI models. +## +## @strong{Inputs} +## @table @var +## @item sys1 +## LTI model of forward transmission. @code{[p1, m1] = size (sys1)}. +## @item sys2 +## LTI model of backward transmission. +## If not specified, an identity matrix of appropriate size is taken. +## @item feedin +## Vector containing indices of inputs to @var{sys1} which are involved in the feedback loop. +## The number of @var{feedin} indices and outputs of @var{sys2} must be equal. +## If not specified, @code{1:m1} is taken. +## @item feedout +## Vector containing indices of outputs from @var{sys1} which are to be connected to @var{sys2}. +## The number of @var{feedout} indices and inputs of @var{sys2} must be equal. +## If not specified, @code{1:p1} is taken. +## @item "+" +## Positive feedback sign. If not specified, @var{"-"} for a negative feedback interconnection +## is assumed. @var{+1} and @var{-1} are possible as well, but only from the third argument +## onward due to ambiguity. +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## Resulting LTI model. +## @end table +## +## @strong{Block Diagram} +## @example +## @group +## u + +--------+ y +## ------>(+)----->| sys1 |-------+-------> +## ^ - +--------+ | +## | | +## | +--------+ | +## +-------| sys2 |<------+ +## +--------+ +## @end group +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.5 + +function sys = feedback (sys1, sys2, feedin, feedout, fbsign = -1) + + [p1, m1] = size (sys1); + + switch (nargin) + case 1 # sys = feedback (sys) + if (p1 != m1) + error ("feedback: argument must be a square system"); + endif + sys2 = eye (p1); + feedin = 1 : m1; + feedout = 1 : p1; + + case 2 + if (ischar (sys2)) # sys = feedback (sys, "+") + if (p1 != m1) + error ("feedback: first argument must be a square system"); + endif + fbsign = __check_fbsign__ (sys2); + sys2 = eye (p1); + endif # sys = feedback (sys1, sys2) + feedin = 1 : m1; + feedout = 1 : p1; + + case 3 # sys = feedback (sys1, sys2, "+") + fbsign = __check_fbsign__ (feedin); + feedin = 1 : m1; + feedout = 1 : p1; + + case 4 # sys = feedback (sys1, sys2, feedin, feedout) + ## nothing needs to be done here + ## case 4 required to prevent "otherwise" + + case 5 # sys = feedback (sys1, sys2, feedin, feedout, "+") + fbsign = __check_fbsign__ (fbsign); + + otherwise + print_usage (); + + endswitch + + [p2, m2] = size (sys2); + + l_feedin = length (feedin); + l_feedout = length (feedout); + + if (l_feedin != p2) + error ("feedback: feedin indices: %d, outputs sys2: %d", l_feedin, p2); + endif + + if (l_feedout != m2) + error ("feedback: feedout indices: %d, inputs sys2: %d", l_feedout, m2); + endif + + if (any (feedin > m1 | feedin < 1)) + error ("feedback: range of feedin indices exceeds dimensions of sys1"); + endif + + if (any (feedin > p1 | feedin < 1)) + error ("feedback: range of feedout indices exceeds dimensions of sys1"); + endif + + M11 = zeros (m1, p1); + M22 = zeros (m2, p2); + + M12 = full (sparse (feedin, 1:l_feedin, fbsign, m1, p2)); + M21 = full (sparse (1:l_feedout, feedout, 1, m2, p1)); + + ## NOTE: for-loops do NOT the same as + ## M12(feedin, 1:l_feedin) = fbsign; + ## M21(1:l_feedout, feedout) = 1; + ## + ## M12 = zeros (m1, p2); + ## M21 = zeros (m2, p1); + ## + ## for k = 1 : l_feedin + ## M12(feedin(k), k) = fbsign; + ## endfor + ## + ## for k = 1 : l_feedout + ## M21(k, feedout(k)) = 1; + ## endfor + + M = [M11, M12; + M21, M22]; + + in_idx = 1 : m1; + out_idx = 1 : p1; + + sys = __sys_group__ (sys1, sys2); + sys = __sys_connect__ (sys, M); + sys = __sys_prune__ (sys, out_idx, in_idx); + +endfunction + + +function fbsign = __check_fbsign__ (fbsign) + + if (is_real_scalar (fbsign)) + fbsign = sign (fbsign); + elseif (ischar (fbsign)) + if (strcmp (fbsign, "+")) + fbsign = +1; + elseif (strcmp (fbsign, "-")) + fbsign = -1; + else + error ("feedback: invalid feedback sign string"); + endif + else + error ("feedback: invalid feedback sign type"); + endif + +endfunction + + +## Feedback inter-connection of two systems in state-space form +## Test from SLICOT AB05ND +%!shared M, Me +%! A1 = [ 1.0 0.0 -1.0 +%! 0.0 -1.0 1.0 +%! 1.0 1.0 2.0 ]; +%! +%! B1 = [ 1.0 1.0 0.0 +%! 2.0 0.0 1.0 ].'; +%! +%! C1 = [ 3.0 -2.0 1.0 +%! 0.0 1.0 0.0 ]; +%! +%! D1 = [ 1.0 0.0 +%! 0.0 1.0 ]; +%! +%! A2 = [-3.0 0.0 0.0 +%! 1.0 0.0 1.0 +%! 0.0 -1.0 2.0 ]; +%! +%! B2 = [ 0.0 -1.0 0.0 +%! 1.0 0.0 2.0 ].'; +%! +%! C2 = [ 1.0 1.0 0.0 +%! 1.0 1.0 -1.0 ]; +%! +%! D2 = [ 1.0 1.0 +%! 0.0 1.0 ]; +%! +%! sys1 = ss (A1, B1, C1, D1); +%! sys2 = ss (A2, B2, C2, D2); +%! sys = feedback (sys1, sys2); +%! [A, B, C, D] = ssdata (sys); +%! M = [A, B; C, D]; +%! +%! Ae = [-0.5000 -0.2500 -1.5000 -1.2500 -1.2500 0.7500 +%! -1.5000 -0.2500 0.5000 -0.2500 -0.2500 -0.2500 +%! 1.0000 0.5000 2.0000 -0.5000 -0.5000 0.5000 +%! 0.0000 0.5000 0.0000 -3.5000 -0.5000 0.5000 +%! -1.5000 1.2500 -0.5000 1.2500 0.2500 1.2500 +%! 0.0000 1.0000 0.0000 -1.0000 -2.0000 3.0000 ]; +%! +%! Be = [ 0.5000 0.7500 +%! 0.5000 -0.2500 +%! 0.0000 0.5000 +%! 0.0000 0.5000 +%! -0.5000 0.2500 +%! 0.0000 1.0000 ]; +%! +%! Ce = [ 1.5000 -1.2500 0.5000 -0.2500 -0.2500 -0.2500 +%! 0.0000 0.5000 0.0000 -0.5000 -0.5000 0.5000 ]; +%! +%! De = [ 0.5000 -0.2500 +%! 0.0000 0.5000 ]; +%! +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (M, Me, 1e-4); + + +## sensitivity function +## Note the correct physical meaning of the states. +## Test would fail on a commercial octave clone +## because of wrong signs of matrices B and C. +## NOTE: Don't use T = I - S for complementary sensitivity, +## use T = feedback (L) instead! +%!shared S1, S2 +%! P = ss (-2, 3, 4, 5); # meaningless numbers +%! C = ss (-1, 1, 1, 0); # ditto +%! L = P * C; +%! I = eye (size (L)); +%! S1 = feedback (I, L*-I, "+"); # draw a block diagram for better understanding +%! S2 = inv (I + L); +%!assert (S1.a, S2.a, 1e-4); +%!assert (S1.b, S2.b, 1e-4); +%!assert (S1.c, S2.c, 1e-4); +%!assert (S1.d, S2.d, 1e-4); diff --git a/octave_packages/control-2.3.52/@lti/filtdata.m b/octave_packages/control-2.3.52/@lti/filtdata.m new file mode 100644 index 0000000..212283c --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/filtdata.m @@ -0,0 +1,87 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{num}, @var{den}, @var{tsam}] =} filtdata (@var{sys}) +## @deftypefnx {Function File} {[@var{num}, @var{den}, @var{tsam}] =} filtdata (@var{sys}, @var{"vector"}) +## Access discrete-time transfer function data in DSP format. +## Argument @var{sys} is not limited to transfer function models. +## If @var{sys} is not a transfer function, it is converted automatically. +## +## @strong{Inputs} +## @table @var +## @item sys +## Any type of discrete-time LTI model. +## @item "v", "vector" +## For SISO models, return @var{num} and @var{den} directly as column vectors +## instead of cells containing a single column vector. +## @end table +## +## @strong{Outputs} +## @table @var +## @item num +## Cell of numerator(s). Each numerator is a row vector +## containing the coefficients of the polynomial in ascending powers of z^-1. +## num@{i,j@} contains the numerator polynomial from input j to output i. +## In the SISO case, a single vector is possible as well. +## @item den +## Cell of denominator(s). Each denominator is a row vector +## containing the coefficients of the polynomial in ascending powers of z^-1. +## den@{i,j@} contains the denominator polynomial from input j to output i. +## In the SISO case, a single vector is possible as well. +## @item tsam +## Sampling time in seconds. If @var{tsam} is not specified, -1 is returned. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: April 2012 +## Version: 0.1 + +function [num, den, tsam] = filtdata (sys, rtype = "cell") + + if (nargin > 2) + print_usage (); + endif + + if (! isdt (sys)) + error ("lti: filtdata: require discrete-time system"); + endif + + [num, den, tsam] = tfdata (sys); + + ## make numerator and denominator polynomials equally long + ## by adding leading zeros + lnum = cellfun (@length, num, "uniformoutput", false); + lden = cellfun (@length, den, "uniformoutput", false); + + lmax = cellfun (@max, lnum, lden, "uniformoutput", false); + + num = cellfun (@prepad, num, lmax, "uniformoutput", false); + den = cellfun (@prepad, den, lmax, "uniformoutput", false); + + ## remove trailing zeros + ## such that polynomials are as short as possible + num = cellfun (@__remove_trailing_zeros__, num, "uniformoutput", false); + den = cellfun (@__remove_trailing_zeros__, den, "uniformoutput", false); + + if (strncmpi (rtype, "v", 1) && issiso (sys)) + num = num{1}; + den = den{1}; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/frdata.m b/octave_packages/control-2.3.52/@lti/frdata.m new file mode 100644 index 0000000..44d7dee --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/frdata.m @@ -0,0 +1,67 @@ +## Copyright (C) 2010, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{H}, @var{w}, @var{tsam}] =} frdata (@var{sys}) +## @deftypefnx {Function File} {[@var{H}, @var{w}, @var{tsam}] =} frdata (@var{sys}, @var{"vector"}) +## Access frequency response data. +## Argument @var{sys} is not limited to frequency response data objects. +## If @var{sys} is not a frd object, it is converted automatically. +## +## @strong{Inputs} +## @table @var +## @item sys +## Any type of LTI model. +## @item "v", "vector" +## In case @var{sys} is a SISO model, this option returns the frequency response +## as a column vector (lw-by-1) instead of an array (p-by-m-by-lw). +## @end table +## +## @strong{Outputs} +## @table @var +## @item H +## Frequency response array (p-by-m-by-lw). H(i,j,k) contains the +## response from input j to output i at frequency k. In the SISO case, +## a vector (lw-by-1) is possible as well. +## @item w +## Frequency vector (lw-by-1) in radian per second [rad/s]. +## Frequencies are in ascending order. +## @item tsam +## Sampling time in seconds. If @var{sys} is a continuous-time model, +## a zero is returned. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.3 + +function [H, w, tsam] = frdata (sys, rtype = "array") + + if (! isa (sys, "frd")) + sys = frd (sys); + endif + + [H, w] = __sys_data__ (sys); + + tsam = sys.tsam; + + if (strncmpi (rtype, "v", 1) && issiso (sys)) + H = reshape (H, [], 1); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/freqresp.m b/octave_packages/control-2.3.52/@lti/freqresp.m new file mode 100644 index 0000000..921a43a --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/freqresp.m @@ -0,0 +1,57 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{H} =} freqresp (@var{sys}, @var{w}) +## Evaluate frequency response at given frequencies. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. +## @item w +## Vector of frequency values. +## @end table +## +## @strong{Outputs} +## @table @var +## @item H +## Array of frequency response. For a system with m inputs and p outputs, the array @var{H} +## has dimensions [p, m, length (w)]. +## The frequency response at the frequency w(k) is given by H(:,:,k). +## @end table +## +## @seealso{dcgain} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function H = freqresp (sys, w) + + if (nargin != 2) # case freqresp () not possible + print_usage (); + endif + + if (! is_real_vector (w)) # catches freqresp (sys, sys) and freqresp (w, sys) as well + error ("freqresp: second argument must be a real vector"); + endif + + H = __freqresp__ (sys, w); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/get.m b/octave_packages/control-2.3.52/@lti/get.m new file mode 100644 index 0000000..9017081 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/get.m @@ -0,0 +1,61 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} get (@var{sys}) +## @deftypefnx {Function File} {@var{value} =} get (@var{sys}, @var{"property"}) +## Access property values of LTI objects. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function varargout = get (sys, varargin) + + if (nargin == 1) + [props, vals] = __property_names__ (sys); + nrows = numel (props); + str = strjust (strvcat (props), "right"); + str = horzcat (repmat (" ", nrows, 1), str, repmat (": ", nrows, 1), strvcat (vals)); + disp (str); + else + for k = 1 : (nargin-1) + prop = lower (varargin{k}); + + switch (prop) + case {"inname", "inputname"} + val = sys.inname; + case {"outname", "outputname"} + val = sys.outname; + case {"tsam", "ts"} + val = sys.tsam; + case "name" + val = sys.name; + case "notes" + val = sys.notes; + case "userdata" + val = sys.userdata; + otherwise + val = __get__ (sys, prop); + endswitch + + varargout{k} = val; + endfor + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/horzcat.m b/octave_packages/control-2.3.52/@lti/horzcat.m new file mode 100644 index 0000000..c693b32 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/horzcat.m @@ -0,0 +1,109 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Horizontal concatenation of LTI objects. If necessary, object conversion +## is done by sys_group. Used by Octave for "[sys1, sys2]". + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function sys = horzcat (sys, varargin) + + for k = 1 : (nargin-1) + + sys1 = sys; + sys2 = varargin{k}; + + [p1, m1] = size (sys1); + [p2, m2] = size (sys2); + + if (p1 != p2) + error ("lti: horzcat: number of system outputs incompatible: [(%dx%d), (%dx%d)]", + p1, m1, p2, m2); + endif + + sys = __sys_group__ (sys1, sys2); + + out_scl = [eye(p1), eye(p2)]; + + sys = out_scl * sys; + + endfor + +endfunction + + +## Rowwise concatenation of two systems in state-space form +## Test from SLICOT AB05OD +%!shared M, Me +%! A1 = [ 1.0 0.0 -1.0 +%! 0.0 -1.0 1.0 +%! 1.0 1.0 2.0 ]; +%! +%! B1 = [ 1.0 1.0 0.0 +%! 2.0 0.0 1.0 ].'; +%! +%! C1 = [ 3.0 -2.0 1.0 +%! 0.0 1.0 0.0 ]; +%! +%! D1 = [ 1.0 0.0 +%! 0.0 1.0 ]; +%! +%! A2 = [-3.0 0.0 0.0 +%! 1.0 0.0 1.0 +%! 0.0 -1.0 2.0 ]; +%! +%! B2 = [ 0.0 -1.0 0.0 +%! 1.0 0.0 2.0 ].'; +%! +%! C2 = [ 1.0 1.0 0.0 +%! 1.0 1.0 -1.0 ]; +%! +%! D2 = [ 1.0 1.0 +%! 0.0 1.0 ]; +%! +%! sys1 = ss (A1, B1, C1, D1); +%! sys2 = ss (A2, B2, C2, D2); +%! sys = [sys1, sys2]; +%! [A, B, C, D] = ssdata (sys); +%! M = [A, B; C, D]; +%! +%! Ae = [ 1.0000 0.0000 -1.0000 0.0000 0.0000 0.0000 +%! 0.0000 -1.0000 1.0000 0.0000 0.0000 0.0000 +%! 1.0000 1.0000 2.0000 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 -3.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 1.0000 0.0000 1.0000 +%! 0.0000 0.0000 0.0000 0.0000 -1.0000 2.0000 ]; +%! +%! Be = [ 1.0000 2.0000 0.0000 0.0000 +%! 1.0000 0.0000 0.0000 0.0000 +%! 0.0000 1.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 1.0000 +%! 0.0000 0.0000 -1.0000 0.0000 +%! 0.0000 0.0000 0.0000 2.0000 ]; +%! +%! Ce = [ 3.0000 -2.0000 1.0000 1.0000 1.0000 0.0000 +%! 0.0000 1.0000 0.0000 1.0000 1.0000 -1.0000 ]; +%! +%! De = [ 1.0000 0.0000 1.0000 1.0000 +%! 0.0000 1.0000 0.0000 1.0000 ]; +%! +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (M, Me, 1e-4); diff --git a/octave_packages/control-2.3.52/@lti/inv.m b/octave_packages/control-2.3.52/@lti/inv.m new file mode 100644 index 0000000..ae11743 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/inv.m @@ -0,0 +1,84 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Inversion of LTI objects. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function retsys = inv (sys) + + if (nargin != 1) # prevent sys = inv (sys1, sys2, sys3, ...) + error ("lti: inv: this is an unary operator"); + endif + + [p, m] = size (sys); + + if (p != m) + error ("lti: inv: system must be square"); + endif + + retsys = __sys_inverse__ (sys); + + ## TODO: handle i/o names + +endfunction + + +## inverse of state-space models +## test from SLICOT AB07ND +## result differs intentionally from a commercial +## implementation of an octave-like language +%!shared M, Me +%! A = [ 1.0 2.0 0.0 +%! 4.0 -1.0 0.0 +%! 0.0 0.0 1.0 ]; +%! +%! B = [ 1.0 0.0 +%! 0.0 1.0 +%! 1.0 0.0 ]; +%! +%! C = [ 0.0 1.0 -1.0 +%! 0.0 0.0 1.0 ]; +%! +%! D = [ 4.0 0.0 +%! 0.0 1.0 ]; +%! +%! sys = ss (A, B, C, D); +%! sysinv = inv (sys); +%! [Ai, Bi, Ci, Di] = ssdata (sysinv); +%! M = [Ai, Bi; Ci, Di]; +%! +%! Ae = [ 1.0000 1.7500 0.2500 +%! 4.0000 -1.0000 -1.0000 +%! 0.0000 -0.2500 1.2500 ]; +%! +%! Be = [-0.2500 0.0000 +%! 0.0000 -1.0000 +%! -0.2500 0.0000 ]; +%! +%! Ce = [ 0.0000 0.2500 -0.2500 +%! 0.0000 0.0000 1.0000 ]; +%! +%! De = [ 0.2500 0.0000 +%! 0.0000 1.0000 ]; +%! +%! Me = [Ae, Be; Ce, De]; # Me = [Ae, -Be; -Ce, De]; +%! +%!assert (M, Me, 1e-4); diff --git a/octave_packages/control-2.3.52/@lti/isct.m b/octave_packages/control-2.3.52/@lti/isct.m new file mode 100644 index 0000000..837cb94 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/isct.m @@ -0,0 +1,49 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{bool} =} isct (@var{sys}) +## Determine whether LTI model is a continuous-time system. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. +## @end table +## +## @strong{Outputs} +## @table @var +## @item bool = 0 +## @var{sys} is a discrete-time system. +## @item bool = 1 +## @var{sys} is a continuous-time system or a static gain. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function bool = isct (ltisys) + + if (nargin != 1) + print_usage (); + endif + + bool = (ltisys.tsam == 0 || ltisys.tsam == -2); + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/isdt.m b/octave_packages/control-2.3.52/@lti/isdt.m new file mode 100644 index 0000000..8181731 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/isdt.m @@ -0,0 +1,49 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{bool} =} isdt (@var{sys}) +## Determine whether LTI model is a discrete-time system. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. +## @end table +## +## @strong{Outputs} +## @table @var +## @item bool = 0 +## @var{sys} is a continuous-time system. +## @item bool = 1 +## @var{sys} is a discrete-time system or a static gain. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function bool = isdt (ltisys) + + if (nargin != 1) + print_usage (); + endif + + bool = (ltisys.tsam != 0); + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/isminimumphase.m b/octave_packages/control-2.3.52/@lti/isminimumphase.m new file mode 100644 index 0000000..059340e --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/isminimumphase.m @@ -0,0 +1,65 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{bool} =} isminimumphase (@var{sys}) +## @deftypefnx {Function File} {@var{bool} =} isminimumphase (@var{sys}, @var{tol}) +## Determine whether LTI system is minimum phase. +## The zeros must lie in the left complex half-plane. +## The name minimum-phase refers to the fact that such a system has the +## minimum possible phase lag for the given magnitude response |sys(jw)|. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. +## @item tol +## Optional tolerance. Default value is 0. +## @end table +## +## @strong{Outputs} +## @table @var +## @item bool = 0 +## System is not minimum phase. +## @item bool = 1 +## System is minimum phase. +## @end table +## +## @example +## @group +## real (z) < -tol*(1 + abs (z)) continuous-time +## abs (z) < 1 - tol discrete-time +## @end group +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: January 2011 +## Version: 0.1 + +function bool = isminimumphase (sys, tol = 0) + + if (nargin > 2) + print_usage (); + endif + + z = zero (sys); + ct = isct (sys); + + bool = __is_stable__ (z, ct, tol); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/issiso.m b/octave_packages/control-2.3.52/@lti/issiso.m new file mode 100644 index 0000000..aed4ebf --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/issiso.m @@ -0,0 +1,35 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{bool} =} issiso (@var{sys}) +## Determine whether LTI model is single-input/single-output (SISO). +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function bool = issiso (sys) + + if (nargin != 1) + print_usage (); + endif + + bool = all (size (sys) == 1); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/isstable.m b/octave_packages/control-2.3.52/@lti/isstable.m new file mode 100644 index 0000000..e54b959 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/isstable.m @@ -0,0 +1,62 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{bool} =} isstable (@var{sys}) +## @deftypefnx {Function File} {@var{bool} =} isstable (@var{sys}, @var{tol}) +## Determine whether LTI system is stable. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. +## @item tol +## Optional tolerance for stability. Default value is 0. +## @end table +## +## @strong{Outputs} +## @table @var +## @item bool = 0 +## System is not stable. +## @item bool = 1 +## System is stable. +## @end table +## +## @example +## @group +## real (p) < -tol*(1 + abs (p)) continuous-time +## abs (p) < 1 - tol discrete-time +## @end group +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function bool = isstable (sys, tol = 0) + + if (nargin > 2) + print_usage (); + endif + + pol = pole (sys); + ct = isct (sys); + + bool = __is_stable__ (pol, ct, tol); + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/lft.m b/octave_packages/control-2.3.52/@lti/lft.m new file mode 100644 index 0000000..5f037ba --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/lft.m @@ -0,0 +1,156 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} lft (@var{sys1}, @var{sys2}) +## @deftypefnx {Function File} {@var{sys} =} lft (@var{sys1}, @var{sys2}, @var{nu}, @var{ny}) +## Linear fractional tranformation, also known as Redheffer star product. +## +## @strong{Inputs} +## @table @var +## @item sys1 +## Upper LTI model. +## @item sys2 +## Lower LTI model. +## @item nu +## The last nu inputs of @var{sys1} are connected with the first nu outputs of @var{sys2}. +## If not specified, @code{min (m1, p2)} is taken. +## @item ny +## The last ny outputs of @var{sys1} are connected with the first ny inputs of @var{sys2}. +## If not specified, @code{min (p1, m2)} is taken. +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## Resulting LTI model. +## @end table +## +## @strong{Block Diagram} +## @example +## @group +## .............sys.............. +## : +--------+ : +## w1 ------------>| |------------> z1 +## : | sys1 | : +## : u +---->| |-----+ y : +## : | +--------+ | : Lower LFT +## : | | : +## : | +--------+ | : lft (sys1, sys2) +## : +-----| sys2 |<----+ : +## : +--------+ : +## :............................: +## @end group +## @end example +## @example +## @group +## .............sys.............. +## : +--------+ : +## : u +---->| sys1 |-----+ y : +## : | +--------+ | : Upper LFT +## : | | : +## : | +--------+ | : lft (sys1, sys2) +## : +-----| |<----+ : +## : | sys2 | : +## z2 <------------| |<------------ w2 +## : +--------+ : +## :............................: +## @end group +## @end example +## @example +## @group +## .............sys.............. +## : +--------+ : +## w1 ------------>| |------------> z1 +## : | sys1 | : +## : u +---->| |-----+ y : +## : | +--------+ | : +## : | | : lft (sys1, sys2, nu, ny) +## : | +--------+ | : +## : +-----| |<----+ : +## : | sys2 | : +## z2 <------------| |<------------ w2 +## : +--------+ : +## :............................: +## @end group +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function sys = lft (sys1, sys2, nu, ny) + + if (nargin != 2 && nargin != 4) + print_usage (); + endif + + ## object conversion done by sys_group if necessary + + [p1, m1] = size (sys1); + [p2, m2] = size (sys2); + + nu_max = min (m1, p2); + ny_max = min (m2, p1); + + if (nargin == 2) # sys = lft (sys1, sys2) + nu = nu_max; + ny = ny_max; + else # sys = lft (sys1, sys2, nu, ny) + if (! is_real_scalar (nu) || nu < 0) + error ("lft: argument nu must be a positive integer"); + endif + + if (! is_real_scalar (ny) || ny < 0) + error ("lft: argument ny must be a positive integer"); + endif + + if (nu > nu_max) + error ("lft: argument nu (%d) must be at most %d", nu, nu_max); + endif + + if (ny > ny_max) + error ("lft: argument ny (%d) must be at most %d", ny, ny_max); + endif + endif + + M11 = zeros (m1, p1); + M12 = [zeros(m1-nu, p2); eye(nu), zeros(nu, p2-nu)]; + M21 = [zeros(ny, p1-ny), eye(ny); zeros(m2-ny, p1)]; + M22 = zeros (m2, p2); + + M = [M11, M12; M21, M22]; + + in_idx = [1 : (m1-nu), m1 + (ny+1 : m2)]; + out_idx = [1 : (p1-ny), p1 + (nu+1 : p2)]; + + sys = __sys_group__ (sys1, sys2); + sys = __sys_connect__ (sys, M); + sys = __sys_prune__ (sys, out_idx, in_idx); + + [p, m] = size (sys); + + if (m == 0) + warning ("lft: resulting system has no inputs"); + endif + + if (p == 0) + warning ("lft: resulting system has no outputs"); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/lti.m b/octave_packages/control-2.3.52/@lti/lti.m new file mode 100644 index 0000000..cd96f56 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/lti.m @@ -0,0 +1,39 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Constructor for LTI objects. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function ltisys = lti (p = 0, m = 0, tsam = -2) + + inname = repmat ({""}, m, 1); + outname = repmat ({""}, p, 1); + + ltisys = struct ("tsam", tsam, + "inname", {inname}, + "outname", {outname}, + "name", "", + "notes", {{}}, + "userdata", []); + + ltisys = class (ltisys, "lti"); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/mconnect.m b/octave_packages/control-2.3.52/@lti/mconnect.m new file mode 100644 index 0000000..2b172a4 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/mconnect.m @@ -0,0 +1,89 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} mconnect (@var{sys}, @var{m}) +## @deftypefnx {Function File} {@var{sys} =} mconnect (@var{sys}, @var{m}, @var{inputs}, @var{outputs}) +## Arbitrary interconnections between the inputs and outputs of an LTI model. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. +## @item m +## Connection matrix. Each row belongs to an input and each column represents an output. +## @item inputs +## Vector of indices of those inputs which are retained. If not specified, all inputs are kept. +## @item outputs +## Vector of indices of those outputs which are retained. If not specified, all outputs are kept. +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## Interconnected system. +## @end table +## +## @strong{Example} +## @example +## @group +## Solve the system equations of +## y(t) = G e(t) +## e(t) = u(t) + M y(t) +## in order to build +## y(t) = H u(t) +## The matrix M for a (p-by-m) system G +## has m rows and p columns (m-by-p). +## +## Example for a 3x2 system: +## u1 = -1*y1 + 5*y2 + 0*y3 +## u2 = pi*y1 + 0*y2 - 7*y3 +## +## | -1 5 0 | +## M = | pi 0 7 | +## @end group +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function sys = mconnect (sys, M, in_idx, out_idx = ":") + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + [p, m] = size (sys); + [mrows, mcols] = size (M); + + if (p != mcols || m != mrows) + error ("mconnect: second argument must be a (%dx%d) matrix", m, p); + endif + + if (! is_real_matrix (M)) + error ("mconnect: second argument must be a matrix with real coefficients"); + endif + + sys = __sys_connect__ (sys, M); + + if (nargin > 2) + sys = __sys_prune__ (sys, out_idx, in_idx); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/minreal.m b/octave_packages/control-2.3.52/@lti/minreal.m new file mode 100644 index 0000000..6d37d7f --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/minreal.m @@ -0,0 +1,185 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} minreal (@var{sys}) +## @deftypefnx {Function File} {@var{sys} =} minreal (@var{sys}, @var{tol}) +## Minimal realization or zero-pole cancellation of LTI models. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function sys = minreal (sys, tol = "def") + + if (nargin > 2) # nargin == 0 not possible because minreal is inside @lti + print_usage (); + endif + + if (! is_real_scalar (tol) && tol != "def") + error ("minreal: second argument must be a real scalar"); + endif + + sys = __minreal__ (sys, tol); + +endfunction + + +## ss: minreal (SLICOT TB01PD) +%!shared C, D +%! +%! A = ss (-2, 3, 4, 5); +%! B = A / A; +%! C = minreal (B, 1e-15); +%! D = ss (1); +%! +%!assert (C.a, D.a); +%!assert (C.b, D.b); +%!assert (C.c, D.c); +%!assert (C.d, D.d); + +%!shared M, Me +%! A = [ 1.0 2.0 0.0 +%! 4.0 -1.0 0.0 +%! 0.0 0.0 1.0 ]; +%! +%! B = [ 1.0 +%! 0.0 +%! 1.0 ]; +%! +%! C = [ 0.0 1.0 -1.0 +%! 0.0 0.0 1.0 ]; +%! +%! D = zeros (2, 1); +%! +%! sys = ss (A, B, C, D, "scaled", true); +%! sysmin = minreal (sys, 0.0); +%! [Ar, Br, Cr, Dr] = ssdata (sysmin); +%! M = [Ar, Br; Cr, Dr]; +%! +%! Ae = [ 1.0000 -1.4142 1.4142 +%! -2.8284 0.0000 1.0000 +%! 2.8284 1.0000 0.0000 ]; +%! +%! Be = [-1.0000 +%! 0.7071 +%! 0.7071 ]; +%! +%! Ce = [ 0.0000 0.0000 -1.4142 +%! 0.0000 0.7071 0.7071 ]; +%! +%! De = zeros (2, 1); +%! +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (M, Me, 1e-4); + + +## dss: minreal (SLICOT TG01JD) +## FIXME: Test fails with larger ldwork in sltg01jd.cc +%!shared Ar, Br, Cr, Dr, Er, Ae, Be, Ce, De, Ee +%! A = [ -2 -3 0 0 0 0 0 0 0 +%! 1 0 0 0 0 0 0 0 0 +%! 0 0 -2 -3 0 0 0 0 0 +%! 0 0 1 0 0 0 0 0 0 +%! 0 0 0 0 1 0 0 0 0 +%! 0 0 0 0 0 1 0 0 0 +%! 0 0 0 0 0 0 1 0 0 +%! 0 0 0 0 0 0 0 1 0 +%! 0 0 0 0 0 0 0 0 1 ]; +%! +%! E = [ 1 0 0 0 0 0 0 0 0 +%! 0 1 0 0 0 0 0 0 0 +%! 0 0 1 0 0 0 0 0 0 +%! 0 0 0 1 0 0 0 0 0 +%! 0 0 0 0 0 0 0 0 0 +%! 0 0 0 0 1 0 0 0 0 +%! 0 0 0 0 0 0 0 0 0 +%! 0 0 0 0 0 0 1 0 0 +%! 0 0 0 0 0 0 0 1 0 ]; +%! +%! B = [ 1 0 +%! 0 0 +%! 0 1 +%! 0 0 +%! -1 0 +%! 0 0 +%! 0 -1 +%! 0 0 +%! 0 0 ]; +%! +%! C = [ 1 0 1 -3 0 1 0 2 0 +%! 0 1 1 3 0 1 0 0 1 ]; +%! +%! D = zeros (2, 2); +%! +%! sys = dss (A, B, C, D, E, "scaled", true); +%! sysmin = minreal (sys, 0.0); +%! [Ar, Br, Cr, Dr, Er] = dssdata (sysmin); +%! +%! Ae = [ 1.0000 -0.0393 -0.0980 -0.1066 0.0781 -0.2330 0.0777 +%! 0.0000 1.0312 0.2717 0.2609 -0.1533 0.6758 -0.3553 +%! 0.0000 0.0000 1.3887 0.6699 -0.4281 1.6389 -0.7615 +%! 0.0000 0.0000 0.0000 -1.2147 0.2423 -0.9792 0.4788 +%! 0.0000 0.0000 0.0000 0.0000 -1.0545 0.5035 -0.2788 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 1.6355 -0.4323 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 1.0000 ]; +%! +%! Ee = [ 0.4100 0.2590 0.5080 -0.3109 0.0705 0.1429 -0.1477 +%! -0.7629 -0.3464 0.0992 -0.3007 0.0619 0.2483 -0.0152 +%! 0.1120 -0.2124 -0.4184 -0.1288 0.0569 -0.4213 -0.6182 +%! 0.0000 0.1122 -0.0039 0.2771 -0.0758 0.0975 0.3923 +%! 0.0000 0.0000 0.3708 -0.4290 0.1006 0.1402 -0.2699 +%! 0.0000 0.0000 0.0000 0.0000 0.9458 -0.2211 0.2378 +%! 0.0000 0.0000 0.0000 0.5711 0.2648 0.5948 -0.5000 ]; +%! +%! Be = [ -0.5597 0.2363 +%! -0.4843 -0.0498 +%! -0.4727 -0.1491 +%! 0.1802 1.1574 +%! 0.5995 0.1556 +%! -0.1729 -0.3999 +%! 0.0000 0.2500 ]; +%! +%! Ce = [ 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 4.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 3.1524 -1.7500 ]; +%! +%! De = zeros (2, 2); +%! +%!assert (Ar, Ae, 1e-4); +%!assert (Br, Be, 1e-4); +%!assert (Cr, Ce, 1e-4); +%!assert (Dr, De, 1e-4); +%!assert (Er, Ee, 1e-4); + + +## tf: minreal +%!shared a, b, c, d +%! s = tf ("s"); +%! G1 = (s+1)*s*5/(s+1)/(s^2+s+1); +%! G2 = tf ([1, 1, 1], [2, 2, 2]); +%! G1min = minreal (G1); +%! G2min = minreal (G2); +%! a = G1min.num{1, 1}; +%! b = G1min.den{1, 1}; +%! c = G2min.num{1, 1}; +%! d = G2min.den{1, 1}; +%!assert (a, [5, 0], 1e-4); +%!assert (b, [1, 1, 1], 1e-4); +%!assert (c, 0.5, 1e-4); +%!assert (d, 1, 1e-4); diff --git a/octave_packages/control-2.3.52/@lti/minus.m b/octave_packages/control-2.3.52/@lti/minus.m new file mode 100644 index 0000000..b6da14c --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/minus.m @@ -0,0 +1,47 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Binary subtraction of LTI objects. If necessary, object conversion +## is done by sys_group. Used by Octave for "sys1 - sys2". + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function sys = minus (sys1, sys2) + + if (nargin != 2) # prevent sys = minus (sys1, sys2, sys3, ...) + error ("lti: minus: this is a binary operator"); + endif + + [p1, m1] = size (sys1); + [p2, m2] = size (sys2); + + if (p1 != p2 || m1 != m2) + error ("lti: minus: system dimensions incompatible: (%dx%d) - (%dx%d)", + p1, m1, p2, m2); + endif + + sys = __sys_group__ (sys1, sys2); + + in_scl = [eye(m1); eye(m2)]; + out_scl = [eye(p1), -eye(p2)]; + + sys = out_scl * sys * in_scl; + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/mldivide.m b/octave_packages/control-2.3.52/@lti/mldivide.m new file mode 100644 index 0000000..9c2b864 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/mldivide.m @@ -0,0 +1,45 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Matrix left division of LTI objects. If necessary, object conversion +## is done by sys_group in mtimes. Used by Octave for "sys1 \\ sys2". + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function sys = mldivide (sys1, sys2) + + if (nargin != 2) # prevent sys = mldivide (sys1, sys2, sys3, ...) + error ("lti: mldivide: this is a binary operator"); + endif + + sys1 = inv (sys1); # let octave decide which inv() it uses + + [p1, m1] = size (sys1); + [p2, m2] = size (sys2); + + if (m2 != p1) + error ("lti: mldivide: system dimensions incompatible: (%dx%d) \ (%dx%d)", + p1, m1, p2, m2); + endif + + sys = sys1 * sys2; + +endfunction + diff --git a/octave_packages/control-2.3.52/@lti/mpower.m b/octave_packages/control-2.3.52/@lti/mpower.m new file mode 100644 index 0000000..a1aa4ca --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/mpower.m @@ -0,0 +1,59 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Matrix power of LTI objects. The exponent must be an integer. +## Used by Octave for "sys^int". + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function retsys = mpower (sys, e) + + if (nargin != 2) # prevent sys = mpower (a, b, c, ...) + error ("lti: mpower: this is a binary operator"); + endif + + if (! is_real_scalar (e) || e != round (e)) + error ("lti: mpower: exponent must be an integer"); + endif + + [p, m] = size (sys); + + if (p != m) + error ("lti: mpower: system must be square"); + endif + + ex = round (abs (e)); # make sure ex is a positive integer + + switch (sign (e)) + case -1 # lti^-ex + sys = inv (sys); + retsys = sys; + case 0 # lti^0 + retsys = eye (p); + return; + case 1 # lti^ex + retsys = sys; + endswitch + + for k = 2 : ex + retsys = retsys * sys; + endfor + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/mrdivide.m b/octave_packages/control-2.3.52/@lti/mrdivide.m new file mode 100644 index 0000000..117dc44 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/mrdivide.m @@ -0,0 +1,45 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Matrix right division of LTI objects. If necessary, object conversion +## is done by sys_group in mtimes. Used by Octave for "sys1 / sys2". + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function sys = mrdivide (sys1, sys2) + + if (nargin != 2) # prevent sys = mrdivide (sys1, sys2, sys3, ...) + error ("lti: mrdivide: this is a binary operator"); + endif + + sys2 = inv (sys2); # let octave decide which inv() it uses + + [p1, m1] = size (sys1); + [p2, m2] = size (sys2); + + if (m2 != p1) + error ("lti: mrdivide: system dimensions incompatible: (%dx%d) / (%dx%d)", + p1, m1, p2, m2); + endif + + sys = sys1 * sys2; + +endfunction + diff --git a/octave_packages/control-2.3.52/@lti/mtimes.m b/octave_packages/control-2.3.52/@lti/mtimes.m new file mode 100644 index 0000000..019af1f --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/mtimes.m @@ -0,0 +1,154 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Matrix multiplication of LTI objects. If necessary, object conversion +## is done by sys_group. Used by Octave for "sys1 * sys2". + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function sys = mtimes (sys2, sys1) + + if (nargin != 2) # prevent sys = mtimes (sys1, sys2, sys3, ...) + error ("lti: mtimes: this is a binary operator"); + endif + + [p1, m1] = size (sys1); + [p2, m2] = size (sys2); + + if (m2 != p1) + error ("lti: mtimes: system dimensions incompatible: (%dx%d) * (%dx%d)", + p2, m2, p1, m1); + endif + + M22 = zeros (m2, p2); + M21 = eye (m2, p1); + M12 = zeros (m1, p2); + M11 = zeros (m1, p1); + + M = [M22, M21; + M12, M11]; + + out_idx = 1 : p2; + in_idx = m2 + (1 : m1); + + sys = __sys_group__ (sys2, sys1); + sys = __sys_connect__ (sys, M); + sys = __sys_prune__ (sys, out_idx, in_idx); + +endfunction + + +## Alternative code: consistency vs. compatibility +#{ + M11 = zeros (m1, p1); + M12 = zeros (m1, p2); + M21 = eye (m2, p1); + M22 = zeros (m2, p2); + + + M = [M11, M12; + M21, M22]; + + out_idx = p1 + (1 : p2); + in_idx = 1 : m1; + + sys = __sys_group__ (sys1, sys2); +#} +## Don't forget to adapt @tf/__sys_connect__.m draft code + + +## mtimes +%!shared sysmat, sysmat_exp +%! sys1 = ss ([0, 1; -3, -2], [0; 1], [-5, 1], [2]); +%! sys2 = ss ([-10], [1], [-40], [5]); +%! sys3 = sys2 * sys1; +%! [A, B, C, D] = ssdata (sys3); +%! sysmat = [A, B; C, D]; +%! A_exp = [ -10 -5 1 +%! 0 0 1 +%! 0 -3 -2 ]; +%! B_exp = [ 2 +%! 0 +%! 1 ]; +%! C_exp = [ -40 -25 5 ]; +%! D_exp = [ 10 ]; +%! sysmat_exp = [A_exp, B_exp; C_exp, D_exp]; +%!assert (sysmat, sysmat_exp) + + +## Cascade inter-connection of two systems in state-space form +## Test from SLICOT AB05MD +## TODO: order of united state vector: consistency vs. compatibility? +#%!shared M, Me +#%! A1 = [ 1.0 0.0 -1.0 +#%! 0.0 -1.0 1.0 +#%! 1.0 1.0 2.0 ]; +#%! +#%! B1 = [ 1.0 1.0 0.0 +#%! 2.0 0.0 1.0 ].'; +#%! +#%! C1 = [ 3.0 -2.0 1.0 +#%! 0.0 1.0 0.0 ]; +#%! +#%! D1 = [ 1.0 0.0 +#%! 0.0 1.0 ]; +#%! +#%! A2 = [-3.0 0.0 0.0 +#%! 1.0 0.0 1.0 +#%! 0.0 -1.0 2.0 ]; +#%! +#%! B2 = [ 0.0 -1.0 0.0 +#%! 1.0 0.0 2.0 ].'; +#%! +#%! C2 = [ 1.0 1.0 0.0 +#%! 1.0 1.0 -1.0 ]; +#%! +#%! D2 = [ 1.0 1.0 +#%! 0.0 1.0 ]; +#%! +#%! sys1 = ss (A1, B1, C1, D1); +#%! sys2 = ss (A2, B2, C2, D2); +#%! sys = sys2 * sys1; +#%! [A, B, C, D] = ssdata (sys); +#%! M = [A, B; C, D]; +#%! +#%! Ae = [ 1.0000 0.0000 -1.0000 0.0000 0.0000 0.0000 +#%! 0.0000 -1.0000 1.0000 0.0000 0.0000 0.0000 +#%! 1.0000 1.0000 2.0000 0.0000 0.0000 0.0000 +#%! 0.0000 1.0000 0.0000 -3.0000 0.0000 0.0000 +#%! -3.0000 2.0000 -1.0000 1.0000 0.0000 1.0000 +#%! 0.0000 2.0000 0.0000 0.0000 -1.0000 2.0000 ]; +#%! +#%! Be = [ 1.0000 2.0000 +#%! 1.0000 0.0000 +#%! 0.0000 1.0000 +#%! 0.0000 1.0000 +#%! -1.0000 0.0000 +#%! 0.0000 2.0000 ]; +#%! +#%! Ce = [ 3.0000 -1.0000 1.0000 1.0000 1.0000 0.0000 +#%! 0.0000 1.0000 0.0000 1.0000 1.0000 -1.0000 ]; +#%! +#%! De = [ 1.0000 1.0000 +#%! 0.0000 1.0000 ]; +#%! +#%! Me = [Ae, Be; Ce, De]; +#%! +#%!assert (M, Me, 1e-4); diff --git a/octave_packages/control-2.3.52/@lti/norm.m b/octave_packages/control-2.3.52/@lti/norm.m new file mode 100644 index 0000000..0934916 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/norm.m @@ -0,0 +1,144 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{gain} =} norm (@var{sys}, @var{2}) +## @deftypefnx {Function File} {[@var{gain}, @var{wpeak}] =} norm (@var{sys}, @var{inf}) +## @deftypefnx {Function File} {[@var{gain}, @var{wpeak}] =} norm (@var{sys}, @var{inf}, @var{tol}) +## Return H-2 or L-inf norm of LTI model. +## +## @strong{Algorithm}@* +## Uses SLICOT AB13BD and AB13DD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.5 + +function [gain, varargout] = norm (sys, ntype = "2", tol = 0.01) + + if (nargin > 3) # norm () is caught by built-in function + print_usage (); + endif + + if (is_real_scalar (ntype)) + if (ntype == 2) + ntype = "2"; + elseif (isinf (ntype)) + ntype = "inf"; + else + error ("lti: norm: invalid norm type"); + endif + elseif (ischar (ntype)) + ntype = lower (ntype); + else + error ("lti: norm: invalid norm type"); + endif + + switch (ntype) + case "2" + gain = h2norm (sys); + + case "inf" + [gain, varargout{1}] = linfnorm (sys, tol); + + otherwise + error ("lti: norm: invalid norm type"); + endswitch + +endfunction + + +function gain = h2norm (sys) + + if (isstable (sys)) + [a, b, c, d] = ssdata (sys); + discrete = ! isct (sys); + if (! discrete && any (d(:))) # continuous and non-zero feedthrough + gain = inf; + else + gain = slab13bd (a, b, c, d, discrete); + endif + else + gain = inf; + endif + +endfunction + + +function [gain, wpeak] = linfnorm (sys, tol = 0.01) + + [a, b, c, d, e, tsam, scaled] = dssdata (sys, []); + discrete = ! isct (sys); + tol = max (tol, 100*eps); + + if (isempty (e)) + [fpeak, gpeak] = slab13dd (a, a, b, c, d, discrete, false, tol, scaled); # TODO: avoid dummy argument + else + if (rcond (e) < eps) + gain = inf; + wpeak = inf; + return; + else + [fpeak, gpeak] = slab13dd (a, e, b, c, d, discrete, true, tol, scaled); + endif + endif + + if (fpeak(2) > 0) + if (discrete) + wpeak = fpeak(1) / abs (tsam); # tsam could be -1 + else + wpeak = fpeak(1); + endif + else + wpeak = inf; + endif + + if (gpeak(2) > 0) + gain = gpeak(1); + else + gain = inf; + endif + +endfunction + + +## norm ct +%!shared H2, Hinf +%! sys = ss (-1, 1, 1, 0); +%! H2 = norm (sys, 2); +%! Hinf = norm (sys, inf); +%!assert (H2, 0.7071, 1.5e-5); +%!assert (Hinf, 1, 5e-4); + + +## norm dt +%!shared H2, Hinf +%! a = [ 2.417 -1.002 0.5488 +%! 2 0 0 +%! 0 0.5 0 ]; +%! b = [ 1 +%! 0 +%! 0 ]; +%! c = [-0.424 0.436 -0.4552 ]; +%! d = [ 1 ]; +%! sys = ss (a, b, c, d, 0.1); +%! H2 = norm (sys, 2); +%! Hinf = norm (sys, inf); +%!assert (H2, 1.2527, 1.5e-5); +%!assert (Hinf, 2.7, 0.1); diff --git a/octave_packages/control-2.3.52/@lti/parallel.m b/octave_packages/control-2.3.52/@lti/parallel.m new file mode 100644 index 0000000..0f75682 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/parallel.m @@ -0,0 +1,56 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{sys} =} parallel (@var{sys1}, @var{sys2}) +## Parallel connection of two LTI systems. +## +## @strong{Block Diagram} +## @example +## @group +## .......................... +## : +--------+ : +## : +-->| sys1 |---+ : +## u : | +--------+ | + : y +## -------+ O---------> +## : | +--------+ | + : +## : +-->| sys2 |---+ : +## : +--------+ : +## :.........sys............: +## +## sys = parallel (sys1, sys2) +## @end group +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function sys = parallel (sys1, sys2) + + if (nargin == 2) + sys = sys1 + sys2; + ## elseif (nargin == 6) + + ## TODO: implement "complicated" case sys = parallel (sys1, sys2, in1, in2, out1, out2) + + else + print_usage (); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/plus.m b/octave_packages/control-2.3.52/@lti/plus.m new file mode 100644 index 0000000..7717477 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/plus.m @@ -0,0 +1,108 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Binary addition of LTI objects. If necessary, object conversion +## is done by sys_group. Used by Octave for "sys1 + sys2". +## Operation is also known as "parallel connection". + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function sys = plus (sys1, sys2) + + if (nargin != 2) # prevent sys = plus (sys1, sys2, sys3, ...) + error ("lti: plus: this is a binary operator"); + endif + + [p1, m1] = size (sys1); + [p2, m2] = size (sys2); + + if (p1 != p2 || m1 != m2) + error ("lti: plus: system dimensions incompatible: (%dx%d) + (%dx%d)", + p1, m1, p2, m2); + endif + + sys = __sys_group__ (sys1, sys2); + + in_scl = [eye(m1); eye(m2)]; + out_scl = [eye(p1), eye(p2)]; + + sys = out_scl * sys * in_scl; + +endfunction + + +## Parallel inter-connection of two systems in state-space form +## Test from SLICOT AB05PD +%!shared M, Me +%! A1 = [ 1.0 0.0 -1.0 +%! 0.0 -1.0 1.0 +%! 1.0 1.0 2.0 ]; +%! +%! B1 = [ 1.0 1.0 0.0 +%! 2.0 0.0 1.0 ].'; +%! +%! C1 = [ 3.0 -2.0 1.0 +%! 0.0 1.0 0.0 ]; +%! +%! D1 = [ 1.0 0.0 +%! 0.0 1.0 ]; +%! +%! A2 = [-3.0 0.0 0.0 +%! 1.0 0.0 1.0 +%! 0.0 -1.0 2.0 ]; +%! +%! B2 = [ 0.0 -1.0 0.0 +%! 1.0 0.0 2.0 ].'; +%! +%! C2 = [ 1.0 1.0 0.0 +%! 1.0 1.0 -1.0 ]; +%! +%! D2 = [ 1.0 1.0 +%! 0.0 1.0 ]; +%! +%! sys1 = ss (A1, B1, C1, D1); +%! sys2 = ss (A2, B2, C2, D2); +%! sys = sys1 + sys2; +%! [A, B, C, D] = ssdata (sys); +%! M = [A, B; C, D]; +%! +%! Ae = [ 1.0000 0.0000 -1.0000 0.0000 0.0000 0.0000 +%! 0.0000 -1.0000 1.0000 0.0000 0.0000 0.0000 +%! 1.0000 1.0000 2.0000 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 -3.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 1.0000 0.0000 1.0000 +%! 0.0000 0.0000 0.0000 0.0000 -1.0000 2.0000 ]; +%! +%! Be = [ 1.0000 2.0000 +%! 1.0000 0.0000 +%! 0.0000 1.0000 +%! 0.0000 1.0000 +%! -1.0000 0.0000 +%! 0.0000 2.0000 ]; +%! +%! Ce = [ 3.0000 -2.0000 1.0000 1.0000 1.0000 0.0000 +%! 0.0000 1.0000 0.0000 1.0000 1.0000 -1.0000 ]; +%! +%! De = [ 2.0000 1.0000 +%! 0.0000 2.0000 ]; +%! +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (M, Me, 1e-4); diff --git a/octave_packages/control-2.3.52/@lti/pole.m b/octave_packages/control-2.3.52/@lti/pole.m new file mode 100644 index 0000000..82d7173 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/pole.m @@ -0,0 +1,47 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{p} =} pole (@var{sys}) +## Compute poles of LTI system. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. +## @end table +## +## @strong{Outputs} +## @table @var +## @item p +## Poles of @var{sys}. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function pol = pole (sys) + + if (nargin > 1) + print_usage (); + endif + + pol = __pole__ (sys); + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/prescale.m b/octave_packages/control-2.3.52/@lti/prescale.m new file mode 100644 index 0000000..f10ed12 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/prescale.m @@ -0,0 +1,297 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{scaledsys}, @var{info}] =} prescale (@var{sys}) +## Prescale state-space model. +## Frequency response commands perform automatic scaling unless model property +## @var{scaled} is set to @var{true}. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. +## @end table +## +## @strong{Outputs} +## @table @var +## @item scaledsys +## Scaled state-space model. +## @item info +## Structure containing additional information. +## @item info.SL +## Left scaling factors. @code{Tl = diag (info.SL)}. +## @item info.SR +## Right scaling factors. @code{Tr = diag (info.SR)}. +## @end table +## +## @strong{Equations} +## @example +## @group +## Es = Tl * E * Tr +## As = Tl * A * Tr +## Bs = Tl * B +## Cs = C * Tr +## Ds = D +## @end group +## @end example +## +## For proper state-space models, @var{Tl} and @var{Tr} are inverse of each other. +## +## @strong{Algorithm}@* +## Uses SLICOT TB01ID and TG01AD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.}. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: June 2011 +## Version: 0.2 + +function [retsys, varargout] = prescale (sys) + + if (nargin != 1) + print_usage (); + endif + + if (! isa (sys, "ss")) + warning ("prescale: system not in state-space form"); + sys = ss (sys); + endif + + [retsys, lscale, rscale] = __prescale__ (sys); + + if (nargout > 1) + varargout{1} = struct ("SL", lscale, "SR", rscale); + endif + +endfunction + + +## Scaling of state-space models, direct access to TB01ID +%!shared Ao, Bo, Co, SCALEo, MAXREDo, Ae, Be, Ce, SCALEe, MAXREDe +%! A = [ 0.0 1.0000e+000 0.0 0.0 0.0 +%! -1.5800e+006 -1.2570e+003 0.0 0.0 0.0 +%! 3.5410e+014 0.0 -1.4340e+003 0.0 -5.3300e+011 +%! 0.0 0.0 0.0 0.0 1.0000e+000 +%! 0.0 0.0 0.0 -1.8630e+004 -1.4820e+000 ]; +%! +%! B = [ 0.0 0.0 +%! 1.1030e+002 0.0 +%! 0.0 0.0 +%! 0.0 0.0 +%! 0.0 8.3330e-003 ]; +%! +%! C = [ 1.0000e+000 0.0 0.0 0.0 0.0 +%! 0.0 0.0 1.0000e+000 0.0 0.0 +%! 0.0 0.0 0.0 1.0000e+000 0.0 +%! 6.6640e-001 0.0 -6.2000e-013 0.0 0.0 +%! 0.0 0.0 -1.0000e-003 1.8960e+006 1.5080e+002 ]; +%! +%! MAXRED = 0.0; +%! +%! [Ao, Bo, Co, MAXREDo, SCALEo] = sltb01id (A, B, C, MAXRED); +%! +%! Ae = [ 0.0000000D+00 0.1000000D+05 0.0000000D+00 0.0000000D+00 0.0000000D+00 +%! -0.1580000D+03 -0.1257000D+04 0.0000000D+00 0.0000000D+00 0.0000000D+00 +%! 0.3541000D+05 0.0000000D+00 -0.1434000D+04 0.0000000D+00 -0.5330000D+03 +%! 0.0000000D+00 0.0000000D+00 0.0000000D+00 0.0000000D+00 0.1000000D+03 +%! 0.0000000D+00 0.0000000D+00 0.0000000D+00 -0.1863000D+03 -0.1482000D+01 ]; +%! +%! Be = [ 0.0000000D+00 0.0000000D+00 +%! 0.1103000D+04 0.0000000D+00 +%! 0.0000000D+00 0.0000000D+00 +%! 0.0000000D+00 0.0000000D+00 +%! 0.0000000D+00 0.8333000D+02 ]; +%! +%! Ce = [ 0.1000000D-04 0.0000000D+00 0.0000000D+00 0.0000000D+00 0.0000000D+00 +%! 0.0000000D+00 0.0000000D+00 0.1000000D+06 0.0000000D+00 0.0000000D+00 +%! 0.0000000D+00 0.0000000D+00 0.0000000D+00 0.1000000D-05 0.0000000D+00 +%! 0.6664000D-05 0.0000000D+00 -0.6200000D-07 0.0000000D+00 0.0000000D+00 +%! 0.0000000D+00 0.0000000D+00 -0.1000000D+03 0.1896000D+01 0.1508000D-01 ]; +%! +%! SCALEe = [0.1000000D-04 0.1000000D+00 0.1000000D+06 0.1000000D-05 0.1000000D-03 ]; +%! +%! MAXREDe = 0.3488E+10; +%! +%!assert (Ao, Ae, 1e-4); +%!assert (Bo, Be, 1e-4); +%!assert (Co, Ce, 1e-4); +%!assert (MAXREDo, MAXREDe, 1e6); +%!assert (SCALEo, SCALEe.', 1e-4); + + +## Scaling of descriptor state-space models, direct access to TG01AD +%!shared Ao, Eo, Bo, Co, LSCALEo, RSCALEo, Ae, Ee, Be, Ce, LSCALEe, RSCALEe +%! A = [ -1 0 0 0.003 +%! 0 0 0.1000 0.02 +%! 100 10 0 0.4 +%! 0 0 0 0.0]; +%! +%! E = [ 1 0.2 0 0.0 +%! 0 1 0 0.01 +%! 300 90 6 0.3 +%! 0 0 20 0.0]; +%! +%! B = [ 10 0 +%! 0 0 +%! 0 1000 +%! 10000 10000]; +%! +%! C = [ -0.1 0.0 0.001 0.0 +%! 0.0 0.01 -0.001 0.0001]; +%! +%! TRESH = 0.0; +%! +%! [Ao, Eo, Bo, Co, LSCALEo, RSCALEo] = sltg01ad (A, E, B, C, TRESH); +%! +%! Ae = [ -1.0000 0.0000 0.0000 0.3000 +%! 0.0000 0.0000 1.0000 2.0000 +%! 1.0000 0.1000 0.0000 0.4000 +%! 0.0000 0.0000 0.0000 0.0000]; +%! +%! Ee = [ 1.0000 0.2000 0.0000 0.0000 +%! 0.0000 1.0000 0.0000 1.0000 +%! 3.0000 0.9000 0.6000 0.3000 +%! 0.0000 0.0000 0.2000 0.0000 ]; +%! +%! Be = [100.0000 0.0000 +%! 0.0000 0.0000 +%! 0.0000 100.0000 +%! 100.0000 100.0000 ]; +%! +%! Ce = [ -0.0100 0.0000 0.0010 0.0000 +%! 0.0000 0.0010 -0.0010 0.0010]; +%! +%! LSCALEe = [ 10.0000 10.0000 0.1000 0.0100 ]; +%! +%! RSCALEe = [ 0.1000 0.1000 1.0000 10.0000 ]; +%! +%!assert (Ao, Ae, 1e-4); +%!assert (Eo, Ee, 1e-4); +%!assert (Bo, Be, 1e-4); +%!assert (Co, Ce, 1e-4); +%!assert (LSCALEo, LSCALEe.', 1e-4); +%!assert (RSCALEo, RSCALEe.', 1e-4); + + +## Scaling of state-space models, user function +%!shared Ao, Bo, Co, INFOo, Ae, Be, Ce, SCALEe +%! A = [ 0.0 1.0000e+000 0.0 0.0 0.0 +%! -1.5800e+006 -1.2570e+003 0.0 0.0 0.0 +%! 3.5410e+014 0.0 -1.4340e+003 0.0 -5.3300e+011 +%! 0.0 0.0 0.0 0.0 1.0000e+000 +%! 0.0 0.0 0.0 -1.8630e+004 -1.4820e+000 ]; +%! +%! B = [ 0.0 0.0 +%! 1.1030e+002 0.0 +%! 0.0 0.0 +%! 0.0 0.0 +%! 0.0 8.3330e-003 ]; +%! +%! C = [ 1.0000e+000 0.0 0.0 0.0 0.0 +%! 0.0 0.0 1.0000e+000 0.0 0.0 +%! 0.0 0.0 0.0 1.0000e+000 0.0 +%! 6.6640e-001 0.0 -6.2000e-013 0.0 0.0 +%! 0.0 0.0 -1.0000e-003 1.8960e+006 1.5080e+002 ]; +%! +%! SYS = ss (A, B, C); +%! +%! [SYSo, INFOo] = prescale (SYS); +%! +%! [Ao, Bo, Co] = ssdata (SYSo); +%! +%! Ae = [ 0.0000000D+00 0.1000000D+05 0.0000000D+00 0.0000000D+00 0.0000000D+00 +%! -0.1580000D+03 -0.1257000D+04 0.0000000D+00 0.0000000D+00 0.0000000D+00 +%! 0.3541000D+05 0.0000000D+00 -0.1434000D+04 0.0000000D+00 -0.5330000D+03 +%! 0.0000000D+00 0.0000000D+00 0.0000000D+00 0.0000000D+00 0.1000000D+03 +%! 0.0000000D+00 0.0000000D+00 0.0000000D+00 -0.1863000D+03 -0.1482000D+01 ]; +%! +%! Be = [ 0.0000000D+00 0.0000000D+00 +%! 0.1103000D+04 0.0000000D+00 +%! 0.0000000D+00 0.0000000D+00 +%! 0.0000000D+00 0.0000000D+00 +%! 0.0000000D+00 0.8333000D+02 ]; +%! +%! Ce = [ 0.1000000D-04 0.0000000D+00 0.0000000D+00 0.0000000D+00 0.0000000D+00 +%! 0.0000000D+00 0.0000000D+00 0.1000000D+06 0.0000000D+00 0.0000000D+00 +%! 0.0000000D+00 0.0000000D+00 0.0000000D+00 0.1000000D-05 0.0000000D+00 +%! 0.6664000D-05 0.0000000D+00 -0.6200000D-07 0.0000000D+00 0.0000000D+00 +%! 0.0000000D+00 0.0000000D+00 -0.1000000D+03 0.1896000D+01 0.1508000D-01 ]; +%! +%! SCALEe = [0.1000000D-04 0.1000000D+00 0.1000000D+06 0.1000000D-05 0.1000000D-03 ]; +%! +%!assert (Ao, Ae, 1e-4); +%!assert (Bo, Be, 1e-4); +%!assert (Co, Ce, 1e-4); +%!assert (INFOo.SL.^-1, SCALEe.', 1e-4); +%!assert (INFOo.SR, SCALEe.', 1e-4); + + +## Scaling of descriptor state-space models, user function +%!shared Ao, Eo, Bo, Co, INFOo, Ae, Ee, Be, Ce, LSCALEe, RSCALEe +%! A = [ -1 0 0 0.003 +%! 0 0 0.1000 0.02 +%! 100 10 0 0.4 +%! 0 0 0 0.0]; +%! +%! E = [ 1 0.2 0 0.0 +%! 0 1 0 0.01 +%! 300 90 6 0.3 +%! 0 0 20 0.0]; +%! +%! B = [ 10 0 +%! 0 0 +%! 0 1000 +%! 10000 10000]; +%! +%! C = [ -0.1 0.0 0.001 0.0 +%! 0.0 0.01 -0.001 0.0001]; +%! +%! SYS = dss (A, B, C, [], E); +%! +%! [SYSo, INFOo] = prescale (SYS); +%! +%! [Ao, Bo, Co, ~, Eo] = dssdata (SYSo); +%! +%! Ae = [ -1.0000 0.0000 0.0000 0.3000 +%! 0.0000 0.0000 1.0000 2.0000 +%! 1.0000 0.1000 0.0000 0.4000 +%! 0.0000 0.0000 0.0000 0.0000]; +%! +%! Ee = [ 1.0000 0.2000 0.0000 0.0000 +%! 0.0000 1.0000 0.0000 1.0000 +%! 3.0000 0.9000 0.6000 0.3000 +%! 0.0000 0.0000 0.2000 0.0000 ]; +%! +%! Be = [100.0000 0.0000 +%! 0.0000 0.0000 +%! 0.0000 100.0000 +%! 100.0000 100.0000 ]; +%! +%! Ce = [ -0.0100 0.0000 0.0010 0.0000 +%! 0.0000 0.0010 -0.0010 0.0010]; +%! +%! LSCALEe = [ 10.0000 10.0000 0.1000 0.0100 ]; +%! +%! RSCALEe = [ 0.1000 0.1000 1.0000 10.0000 ]; +%! +%!assert (Ao, Ae, 1e-4); +%!assert (Eo, Ee, 1e-4); +%!assert (Bo, Be, 1e-4); +%!assert (Co, Ce, 1e-4); +%!assert (INFOo.SL, LSCALEe.', 1e-4); +%!assert (INFOo.SR, RSCALEe.', 1e-4); diff --git a/octave_packages/control-2.3.52/@lti/series.m b/octave_packages/control-2.3.52/@lti/series.m new file mode 100644 index 0000000..80cbe3c --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/series.m @@ -0,0 +1,118 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} series (@var{sys1}, @var{sys2}) +## @deftypefnx {Function File} {@var{sys} =} series (@var{sys1}, @var{sys2}, @var{outputs1}, @var{inputs2}) +## Series connection of two LTI models. +## +## @strong{Block Diagram} +## @example +## @group +## ..................................... +## u : +--------+ y1 u2 +--------+ : y +## ------>| sys1 |---------->| sys2 |-------> +## : +--------+ +--------+ : +## :................sys................. +## +## sys = series (sys1, sys2) +## @end group +## @end example +## @example +## @group +## ..................................... +## : v2 +--------+ : +## : ---------->| | : y +## : +--------+ y1 u2 | sys2 |-------> +## u : | |---------->| | : +## ------>| sys1 | z1 +--------+ : +## : | |----------> : +## : +--------+ : +## :................sys................. +## +## outputs1 = [1] +## inputs2 = [2] +## sys = series (sys1, sys2, outputs1, inputs2) +## @end group +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function sys = series (sys1, sys2, out1, in2) + + if (nargin == 2) + sys = sys2 * sys1; + elseif (nargin == 4) + [p1, m1] = size (sys1); + [p2, m2] = size (sys2); + + if (! is_real_vector (out1)) + error ("series: argument 3 (outputs1) invalid"); + endif + + if (! is_real_vector (in2)) + error ("series: argument 4 (inputs2) invalid"); + endif + + l_out1 = length (out1); + l_in2 = length (in2); + + if (l_out1 > p1) + error ("series: outputs1 has too many indices for sys1"); + endif + + if (l_in2 > m2) + error ("series: inputs2 has too many indices for sys2"); + endif + + if (l_out1 != l_in2) + error ("series: number of outputs1 and inputs2 indices must be equal"); + endif + + if (any (out1 > m1 | out1 < 1)) + error ("series: range of outputs1 indices exceeds dimensions of sys1"); + endif + + if (any (in2 > p1 | in2 < 1)) + error ("series: range of inputs2 indices exceeds dimensions of sys2"); + endif + + out_scl = full (sparse (1:l_out1, out1, 1, l_out1, p1)); + in_scl = full (sparse (in2, 1:l_out1, 1, m2, l_in2)); + + ## NOTE: for-loop does NOT the same as + ## out_scl(1:l_out1, out1) = 1; + ## in_scl(in2, 1:l_out1) = 1; + ## + ## out_scl = zeros (l_out1, p1); + ## in_scl = zeros (m2, l_in2); + ## + ## for k = 1 : l_out1 + ## out_scl(k, out1(k)) = 1; + ## in_scl(in2(k), k) = 1; + ## endfor + + scl = in_scl * out_scl; + sys = sys2 * scl * sys1; + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/set.m b/octave_packages/control-2.3.52/@lti/set.m new file mode 100644 index 0000000..319ef2c --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/set.m @@ -0,0 +1,110 @@ +## Copyright (C) 2009, 2010, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} set (@var{sys}) +## @deftypefnx {Function File} set (@var{sys}, @var{"property"}, @var{value}, @dots{}) +## @deftypefnx {Function File} {@var{retsys} =} set (@var{sys}, @var{"property"}, @var{value}, @dots{}) +## Set or modify properties of LTI objects. +## If no return argument @var{retsys} is specified, the modified LTI object is stored +## in input argument @var{sys}. @command{set} can handle multiple properties in one call: +## @code{set (sys, 'prop1', val1, 'prop2', val2, 'prop3', val3)}. +## @code{set (sys)} prints a list of the object's property names. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.4 + +function retsys = set (sys, varargin) + + if (nargin == 1) # set (sys), sys = set (sys) + + [props, vals] = __property_names__ (sys); + nrows = numel (props); + + str = strjust (strvcat (props), "right"); + str = horzcat (repmat (" ", nrows, 1), str, repmat (": ", nrows, 1), strvcat (vals)); + + disp (str); + + if (nargout != 0) # function sys = set (sys, varargin) + retsys = sys; # would lead to unwanted output when using + endif # set (sys) + + else # set (sys, "prop1", val1, ...), sys = set (sys, "prop1", val1, ...) + + if (rem (nargin-1, 2)) + error ("lti: set: properties and values must come in pairs"); + endif + + [p, m] = size (sys); + + for k = 1 : 2 : (nargin-1) + prop = lower (varargin{k}); + val = varargin{k+1}; + + switch (prop) + case {"inname", "inputname"} + sys.inname = __adjust_labels__ (val, m); + + case {"outname", "outputname"} + sys.outname = __adjust_labels__ (val, p); + + case {"tsam", "ts"} + if (issample (val, -1)) + sys.tsam = val; + warning ("lti: set: use the editing of property '%s' with caution", prop); + warning (" it may lead to corrupted models"); + else + error ("lti: set: invalid sampling time"); + endif + ## TODO: use of c2d, d2c and d2d if tsam changes? + + case "name" + if (ischar (val)) + sys.name = val; + else + error ("lti: set: property 'name' requires a string"); + endif + + case "notes" + if (iscellstr (val)) + sys.notes = val; + elseif (ischar (val)) + sys.notes = {val}; + else + error ("lti: set: property 'notes' requires string or cell of strings"); + endif + + case "userdata" + sys.userdata = val; + + otherwise + sys = __set__ (sys, prop, val); + endswitch + endfor + + if (nargout == 0) # set (sys, "prop1", val1, ...) + assignin ("caller", inputname (1), sys); + else # sys = set (sys, "prop1", val1, ...) + retsys = sys; + endif + + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/size.m b/octave_packages/control-2.3.52/@lti/size.m new file mode 100644 index 0000000..e8f1a79 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/size.m @@ -0,0 +1,91 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{nvec} =} size (@var{sys}) +## @deftypefnx {Function File} {@var{n} =} size (@var{sys}, @var{dim}) +## @deftypefnx {Function File} {[@var{p}, @var{m}] =} size (@var{sys}) +## LTI model size, i.e. number of outputs and inputs. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. +## @item dim +## If given a second argument, @command{size} will return the size of the +## corresponding dimension. +## @end table +## +## @strong{Outputs} +## @table @var +## @item nvec +## Row vector. The first element is the number of outputs (rows) and the second +## element the number of inputs (columns). +## @item n +## Scalar value. The size of the dimension @var{dim}. +## @item p +## Number of outputs. +## @item m +## Number of inputs. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function [n, varargout] = size (sys, dim = 0) + + if (nargin > 2) + print_usage (); + endif + + p = numel (sys.outname); # WARNING: system matrices may change without + m = numel (sys.inname); # being noticed by the i/o names! + + switch (dim) + case 0 + switch (nargout) + case 0 + if (p == 1) + stry = ""; + else + stry = "s"; + endif + if (m == 1) + stru = ""; + else + stru = "s"; + endif + disp (sprintf ("LTI model with %d output%s and %d input%s.", p, stry, m, stru)); + case 1 + n = [p, m]; + case 2 + n = p; + varargout{1} = m; + otherwise + print_usage (); + endswitch + case 1 + n = p; + case 2 + n = m; + otherwise + print_usage (); + endswitch + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/sminreal.m b/octave_packages/control-2.3.52/@lti/sminreal.m new file mode 100644 index 0000000..8cea1ec --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/sminreal.m @@ -0,0 +1,142 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} sminreal (@var{sys}) +## @deftypefnx {Function File} {@var{sys} =} sminreal (@var{sys}, @var{tol}) +## Perform state-space model reduction based on structure. +## Remove states which have no influence on the input-output behaviour. +## The physical meaning of the states is retained. +## +## @strong{Inputs} +## @table @var +## @item sys +## State-space model. +## @item tol +## Optional tolerance for controllability and observability. +## Entries of the state-space matrices whose moduli are less or equal to @var{tol} +## are assumed to be zero. Default value is 0. +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## Reduced state-space model. +## @end table +## +## @seealso{minreal} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.4 + +function sys = sminreal (sys, tol = 0) + + if (nargin > 2) # sminreal () not possible (inside @lti) + print_usage (); + endif + + if (! isa (sys, "ss")) + warning ("sminreal: system not in state-space form"); + sys = ss (sys); # needed by __sys_prune__ + endif + + if (! (is_real_scalar (tol) && tol >= 0)) + error ("sminreal: second argument is not a valid tolerance"); + endif + + [a, b, c, d, e] = dssdata (sys, []); + + a = abs (a) > tol; + b = abs (b) > tol; + c = abs (c) > tol; + + if (! isempty (e)) + e = abs (e) > tol; + a = a | e; + endif + + co_idx = __controllable_states__ (a, b); + ob_idx = __controllable_states__ (a.', c.'); + + st_idx = intersect (co_idx, ob_idx); + + sys = __sys_prune__ (sys, ":", ":", st_idx); + +endfunction + + +function c_idx = __controllable_states__ (a, b) + + n = rows (a); # number of states + a = a & ! eye (n); # set diagonal entries to zero + + c_vec = any (b, 2); # states directly controllable + c_idx = find (c_vec); # indices of directly controllable states + c_idx_new = 0; # any vector of length > 0 possible + + while (all (length (c_idx) != [0, n]) && length(c_idx_new) != 0) + + u_idx = find (! c_vec); # indices of uncontrollable states + + #{ + ## debug code + a(u_idx, :) + repmat (c_vec.', length (u_idx), 1) + a(u_idx, :) & repmat (c_vec.', length (u_idx), 1) + any (a(u_idx, :) & repmat (c_vec.', length (u_idx), 1), 2) + find (any (a(u_idx, :) & repmat (c_vec.', length (u_idx), 1), 2)) + #} + + c_idx_new = u_idx (find (any (a(u_idx, :) & repmat (c_vec.', length (u_idx), 1), 2))); + c_idx = union (c_idx, c_idx_new); + c_vec(c_idx_new) = 1; + + endwhile + +endfunction + + +## ss: sminreal +%!shared B, C +%! +%! A = ss (-2, 3, 4, 5); +%! B = A / A; +%! C = sminreal (B); # no states should be removed +%! +%!assert (C.a, B.a); +%!assert (C.b, B.b); +%!assert (C.c, B.c); +%!assert (C.d, B.d); + +%!shared A, B, D, E +%! +%! A = ss (-1, 1, 1, 0); +%! B = ss (-2, 3, 4, 5); +%! C = [A, B]; +%! D = sminreal (C(:, 1)); +%! E = sminreal (C(:, 2)); +%! +%!assert (D.a, A.a); +%!assert (D.b, A.b); +%!assert (D.c, A.c); +%!assert (D.d, A.d); +%!assert (E.a, B.a); +%!assert (E.b, B.b); +%!assert (E.c, B.c); +%!assert (E.d, B.d); diff --git a/octave_packages/control-2.3.52/@lti/ssdata.m b/octave_packages/control-2.3.52/@lti/ssdata.m new file mode 100644 index 0000000..ddb29bd --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/ssdata.m @@ -0,0 +1,62 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{a}, @var{b}, @var{c}, @var{d}, @var{tsam}] =} ssdata (@var{sys}) +## Access state-space model data. +## Argument @var{sys} is not limited to state-space models. +## If @var{sys} is not a state-space model, it is converted automatically. +## +## @strong{Inputs} +## @table @var +## @item sys +## Any type of LTI model. +## @end table +## +## @strong{Outputs} +## @table @var +## @item a +## State transition matrix (n-by-n). +## @item b +## Input matrix (n-by-m). +## @item c +## Measurement matrix (p-by-n). +## @item d +## Feedthrough matrix (p-by-m). +## @item tsam +## Sampling time in seconds. If @var{sys} is a continuous-time model, +## a zero is returned. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.4 + +function [a, b, c, d, tsam, scaled] = ssdata (sys) + + if (! isa (sys, "ss")) + sys = ss (sys); + endif + + [a, b, c, d, e, ~, scaled] = __sys_data__ (sys); + + [a, b, c, d, e] = __dss2ss__ (a, b, c, d, e); + + tsam = sys.tsam; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/subsasgn.m b/octave_packages/control-2.3.52/@lti/subsasgn.m new file mode 100644 index 0000000..a4f6aa0 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/subsasgn.m @@ -0,0 +1,45 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Subscripted assignment for LTI objects. +## Used by Octave for "sys.property = value". + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function sys = subsasgn (sys, idx, val) + + ## TODO: enable *more* stuff like sys.a(2, 1:3) = [4, 5, 6] + ## warning ("lti: subsasgn: do not use subsasgn for development"); + + switch (idx(1).type) + case "." + if (length (idx) == 1) + sys = set (sys, idx.subs, val); + else + prop = idx(1).subs; + sys = set (sys, prop, subsasgn (get (sys, prop), idx(2:end), val)); + endif + + otherwise + error ("lti: subsasgn: invalid subscripted assignment type"); + + endswitch + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/subsref.m b/octave_packages/control-2.3.52/@lti/subsref.m new file mode 100644 index 0000000..c3d4b0a --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/subsref.m @@ -0,0 +1,60 @@ +## Copyright (C) 2009, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Subscripted reference for LTI objects. +## Used by Octave for "sys = sys(2:4, :)" or "val = sys.prop". + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.4 + +function a = subsref (a, s) + + if (numel (s) == 0) + return; + endif + + switch (s(1).type) + case "()" + idx = s(1).subs; + if (numel (idx) == 2) + a = __sys_prune__ (a, idx{1}, idx{2}); + elseif (numel (idx) == 1) + a = __freqresp__ (a, idx{1}); + else + error ("lti: subsref: need one or two indices"); + endif + case "." + fld = s(1).subs; + a = get (a, fld); + ## warning ("lti: subsref: do not use subsref for development"); + otherwise + error ("lti: subsref: invalid subscript type"); + endswitch + + a = subsref (a, s(2:end)); + +endfunction + + +## lti: subsref +%!shared a +%! s = tf ("s"); +%! G = (s+1)*s*5/(s+1)/(s^2+s+1); +%! a = G(1,1).num{1,1}(1); +%!assert (a, 5, 1e-4); diff --git a/octave_packages/control-2.3.52/@lti/tfdata.m b/octave_packages/control-2.3.52/@lti/tfdata.m new file mode 100644 index 0000000..be31e23 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/tfdata.m @@ -0,0 +1,79 @@ +## Copyright (C) 2009, 2010, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{num}, @var{den}, @var{tsam}] =} tfdata (@var{sys}) +## @deftypefnx {Function File} {[@var{num}, @var{den}, @var{tsam}] =} tfdata (@var{sys}, @var{"vector"}) +## @deftypefnx {Function File} {[@var{num}, @var{den}, @var{tsam}] =} tfdata (@var{sys}, @var{"tfpoly"}) +## Access transfer function data. +## Argument @var{sys} is not limited to transfer function models. +## If @var{sys} is not a transfer function, it is converted automatically. +## +## @strong{Inputs} +## @table @var +## @item sys +## Any type of LTI model. +## @item "v", "vector" +## For SISO models, return @var{num} and @var{den} directly as column vectors +## instead of cells containing a single column vector. +## @end table +## +## @strong{Outputs} +## @table @var +## @item num +## Cell of numerator(s). Each numerator is a row vector +## containing the coefficients of the polynomial in descending powers of +## the transfer function variable. +## num@{i,j@} contains the numerator polynomial from input j to output i. +## In the SISO case, a single vector is possible as well. +## @item den +## Cell of denominator(s). Each denominator is a row vector +## containing the coefficients of the polynomial in descending powers of +## the transfer function variable. +## den@{i,j@} contains the denominator polynomial from input j to output i. +## In the SISO case, a single vector is possible as well. +## @item tsam +## Sampling time in seconds. If @var{sys} is a continuous-time model, +## a zero is returned. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.5 + +function [num, den, tsam] = tfdata (sys, rtype = "cell") + + if (! isa (sys, "tf")) + sys = tf (sys); + endif + + [num, den] = __sys_data__ (sys); + + tsam = sys.tsam; + + if (! strncmpi (rtype, "t", 1)) # != tfpoly + num = cellfun (@get, num, "uniformoutput", false); + den = cellfun (@get, den, "uniformoutput", false); + endif + + if (strncmpi (rtype, "v", 1) && issiso (sys)) # == vector + num = num{1}; + den = den{1}; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/transpose.m b/octave_packages/control-2.3.52/@lti/transpose.m new file mode 100644 index 0000000..693de8f --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/transpose.m @@ -0,0 +1,40 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Transpose of LTI objects. Used by Octave for "sys.'". +## Useful for dual problems, i.e. controllability and observability +## or designing estimator gains with @command{lqr} and @command{place}. + +## Author: Lukas Reichlin +## Created: February 2010 +## Version: 0.1 + +function sys = transpose (sys) + + if (nargin != 1) # prevent sys = transpose (sys1, sys2, sys3, ...) + error ("lti: transpose: this is an unary operator"); + endif + + [p, m] = size (sys); + + sys = __transpose__ (sys); + + sys.inname = repmat ({""}, p, 1); + sys.outname = repmat ({""}, m, 1); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/uminus.m b/octave_packages/control-2.3.52/@lti/uminus.m new file mode 100644 index 0000000..7e6c4f6 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/uminus.m @@ -0,0 +1,37 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Unary minus of LTI object. Used by Octave for "-sys". + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function sys = uminus (sys) + + if (nargin != 1) # prevent sys = uminus (sys1, sys2, sys3, ...) + error ("lti: uminus: this is an unary operator"); + endif + + [p, m] = size (sys); + + out_scl = - eye (p); + + sys = out_scl * sys; + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/uplus.m b/octave_packages/control-2.3.52/@lti/uplus.m new file mode 100644 index 0000000..afaa90f --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/uplus.m @@ -0,0 +1,31 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Unary plus of LTI object. Used by Octave for "+sys". + +## Author: Lukas Reichlin +## Created: June 2012 +## Version: 0.1 + +function sys = uplus (sys) + + if (nargin != 1) # prevent sys = uplus (sys1, sys2, sys3, ...) + error ("lti: uplus: this is an unary operator"); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/vertcat.m b/octave_packages/control-2.3.52/@lti/vertcat.m new file mode 100644 index 0000000..32d381c --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/vertcat.m @@ -0,0 +1,49 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Vertical concatenation of LTI objects. If necessary, object conversion +## is done by sys_group. Used by Octave for "[sys1; sys2]". + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function sys = vertcat (sys, varargin) + + for k = 1 : (nargin-1) + + sys1 = sys; + sys2 = varargin{k}; + + [p1, m1] = size (sys1); + [p2, m2] = size (sys2); + + if (m1 != m2) + error ("lti: vertcat: number of system inputs incompatible: [(%dx%d); (%dx%d)]", + p1, m1, p2, m2); + endif + + sys = __sys_group__ (sys1, sys2); + + in_scl = [eye(m1); eye(m2)]; + + sys = sys * in_scl; + + endfor + +endfunction diff --git a/octave_packages/control-2.3.52/@lti/xperm.m b/octave_packages/control-2.3.52/@lti/xperm.m new file mode 100644 index 0000000..6a9514d --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/xperm.m @@ -0,0 +1,44 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} xperm (@var{sys}, @var{st_idx}) +## Reorder states in state-space models. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.1 + +function sys = xperm (sys, st_idx) + + if (nargin != 2) + print_usage (); + endif + + if (! is_real_vector (st_idx)) + error ("xperm: second argument invalid"); + endif + + if (! isa (sys, "ss")) + warning ("xperm: system not in state-space form"); + sys = ss (sys); + endif + + sys = __sys_prune__ (sys, ":", ":", st_idx); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@lti/zero.m b/octave_packages/control-2.3.52/@lti/zero.m new file mode 100644 index 0000000..78df1d7 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/zero.m @@ -0,0 +1,165 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{z} =} zero (@var{sys}) +## @deftypefnx {Function File} {[@var{z}, @var{k}] =} zero (@var{sys}) +## Compute transmission zeros and gain of LTI model. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. +## @end table +## +## @strong{Outputs} +## @table @var +## @item z +## Transmission zeros of @var{sys}. +## @item k +## Gain of @var{sys}. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function [zer, gain] = zero (sys) + + if (nargin > 1) + print_usage (); + endif + + [zer, gain] = __zero__ (sys, nargout); + +endfunction + + +## transmission zeros of state-space models +## +## Results from the "Dark Side" 7.5 and 7.8 +## +## -13.2759 +## 12.5774 +## -0.0155 +## +## Results from Scilab 5.2.0b1 (trzeros) +## +## - 13.275931 +## 12.577369 +## - 0.0155265 +## +%!shared z, z_exp +%! A = [ -0.7 -0.0458 -12.2 0 +%! 0 -0.014 -0.2904 -0.562 +%! 1 -0.0057 -1.4 0 +%! 1 0 0 0 ]; +%! +%! B = [ -19.1 -3.1 +%! -0.0119 -0.0096 +%! -0.14 -0.72 +%! 0 0 ]; +%! +%! C = [ 0 0 -1 1 +%! 0 0 0.733 0 ]; +%! +%! D = [ 0 0 +%! 0.0768 0.1134 ]; +%! +%! sys = ss (A, B, C, D, "scaled", true); +%! z = sort (zero (sys)); +%! +%! z_exp = sort ([-13.2759; 12.5774; -0.0155]); +%! +%!assert (z, z_exp, 1e-4); + + +## transmission zeros of descriptor state-space models +%!shared z, z_exp +%! A = [ 1 0 0 0 0 0 0 0 0 +%! 0 1 0 0 0 0 0 0 0 +%! 0 0 1 0 0 0 0 0 0 +%! 0 0 0 1 0 0 0 0 0 +%! 0 0 0 0 1 0 0 0 0 +%! 0 0 0 0 0 1 0 0 0 +%! 0 0 0 0 0 0 1 0 0 +%! 0 0 0 0 0 0 0 1 0 +%! 0 0 0 0 0 0 0 0 1 ]; +%! +%! E = [ 0 0 0 0 0 0 0 0 0 +%! 1 0 0 0 0 0 0 0 0 +%! 0 1 0 0 0 0 0 0 0 +%! 0 0 0 0 0 0 0 0 0 +%! 0 0 0 1 0 0 0 0 0 +%! 0 0 0 0 1 0 0 0 0 +%! 0 0 0 0 0 0 0 0 0 +%! 0 0 0 0 0 0 1 0 0 +%! 0 0 0 0 0 0 0 1 0 ]; +%! +%! B = [ -1 0 0 +%! 0 0 0 +%! 0 0 0 +%! 0 -1 0 +%! 0 0 0 +%! 0 0 0 +%! 0 0 -1 +%! 0 0 0 +%! 0 0 0 ]; +%! +%! C = [ 0 1 1 0 3 4 0 0 2 +%! 0 1 0 0 4 0 0 2 0 +%! 0 0 1 0 -1 4 0 -2 2 ]; +%! +%! D = [ 1 2 -2 +%! 0 -1 -2 +%! 0 0 0 ]; +%! +%! sys = dss (A, B, C, D, E, "scaled", true); +%! z = zero (sys); +%! +%! z_exp = 1; +%! +%!assert (z, z_exp, 1e-4); + + +## Gain of descriptor state-space models +%!shared p, pi, z, zi, k, ki, p_tf, pi_tf, z_tf, zi_tf, k_tf, ki_tf +%! P = ss (-2, 3, 4, 5); +%! Pi = inv (P); +%! +%! p = pole (P); +%! [z, k] = zero (P); +%! +%! pi = pole (Pi); +%! [zi, ki] = zero (Pi); +%! +%! P_tf = tf (P); +%! Pi_tf = tf (Pi); +%! +%! p_tf = pole (P_tf); +%! [z_tf, k_tf] = zero (P_tf); +%! +%! pi_tf = pole (Pi_tf); +%! [zi_tf, ki_tf] = zero (Pi_tf); +%! +%!assert (p, zi, 1e-4); +%!assert (z, pi, 1e-4); +%!assert (k, inv (ki), 1e-4); +%!assert (p_tf, zi_tf, 1e-4); +%!assert (z_tf, pi_tf, 1e-4); +%!assert (k_tf, inv (ki_tf), 1e-4); diff --git a/octave_packages/control-2.3.52/@lti/zpkdata.m b/octave_packages/control-2.3.52/@lti/zpkdata.m new file mode 100644 index 0000000..e2ac9a2 --- /dev/null +++ b/octave_packages/control-2.3.52/@lti/zpkdata.m @@ -0,0 +1,66 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{z}, @var{p}, @var{k}, @var{tsam}] =} zpkdata (@var{sys}) +## @deftypefnx {Function File} {[@var{z}, @var{p}, @var{k}, @var{tsam}] =} zpkdata (@var{sys}, @var{"v"}) +## Access zero-pole-gain data. +## +## @strong{Inputs} +## @table @var +## @item sys +## Any type of LTI model. +## @item "v", "vector" +## For SISO models, return @var{z} and @var{p} directly as column vectors +## instead of cells containing a single column vector. +## @end table +## +## @strong{Outputs} +## @table @var +## @item z +## Cell of column vectors containing the zeros for each channel. +## z@{i,j@} contains the zeros from input j to output i. +## @item p +## Cell of column vectors containing the poles for each channel. +## p@{i,j@} contains the poles from input j to output i. +## @item k +## Matrix containing the gains for each channel. +## k(i,j) contains the gain from input j to output i. +## @item tsam +## Sampling time in seconds. If @var{sys} is a continuous-time model, +## a zero is returned. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2011 +## Version: 0.1 + +function [z, p, k, tsam] = zpkdata (sys, rtype = "cell") + + [num, den, tsam] = tfdata (sys); + + z = cellfun (@roots, num, "uniformoutput", false); + p = cellfun (@roots, den, "uniformoutput", false); + k = cellfun (@(n,d) n(1)/d(1), num, den); + + if (strncmpi (rtype, "v", 1) && issiso (sys)) + z = z{1}; + p = p{1}; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@ss/__c2d__.m b/octave_packages/control-2.3.52/@ss/__c2d__.m new file mode 100644 index 0000000..bf76da8 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__c2d__.m @@ -0,0 +1,52 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Convert the continuous SS model into its discrete-time equivalent. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function sys = __c2d__ (sys, tsam, method = "zoh", w0 = 0) + + switch (method(1)) + case {"z", "s"} # {"zoh", "std"} + [sys.a, sys.b, sys.c, sys.d, sys.e] = __dss2ss__ (sys.a, sys.b, sys.c, sys.d, sys.e); + [n, m] = size (sys.b); # n: states, m: inputs + ## TODO: use SLICOT MB05OD + tmp = expm ([sys.a*tsam, sys.b*tsam; zeros(m, n+m)]); + sys.a = tmp (1:n, 1:n); # F + sys.b = tmp (1:n, n+(1:m)); # G + + case {"t", "b", "p"} # {"tustin", "bilin", "prewarp"} + if (method(1) == "p") # prewarping + beta = w0 / tan (w0*tsam/2); + else + beta = 2/tsam; + endif + if (isempty (sys.e)) + [sys.a, sys.b, sys.c, sys.d] = slab04md (sys.a, sys.b, sys.c, sys.d, 1, beta, false); + else + [sys.a, sys.b, sys.c, sys.d, sys.e] = __dss_bilin__ (sys.a, sys.b, sys.c, sys.d, sys.e, beta, false); + endif + + otherwise + error ("ss: c2d: %s is an invalid or missing method", method); + endswitch + +endfunction diff --git a/octave_packages/control-2.3.52/@ss/__ctranspose__.m b/octave_packages/control-2.3.52/@ss/__ctranspose__.m new file mode 100644 index 0000000..bb58c5e --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__ctranspose__.m @@ -0,0 +1,54 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Conjugate transpose of SS models. + +## Author: Lukas Reichlin +## Created: May 2012 +## Version: 0.1 + +function sys = __ctranspose__ (sys, ct) + + a = sys.a; + b = sys.b; + c = sys.c; + d = sys.d; + e = sys.e; + + if (ct) # continuous-time + sys.a = -a.'; + sys.b = -c.'; + sys.c = b.'; + sys.d = d.'; + sys.e = e.'; + sys.stname = repmat ({""}, rows (a), 1); + else # discrete-time + [n, m] = size (b); + p = rows (c); + if (isempty (e)) + e = eye (n); + endif + sys.a = blkdiag (e.', eye (p)); + sys.b = [zeros(n, p); -eye(p)]; + sys.c = [b.', zeros(m, p)]; + sys.d = d.'; + sys.e = [a.', c.'; zeros(p, n+p)]; + sys.stname = repmat ({""}, n+p, 1); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@ss/__d2c__.m b/octave_packages/control-2.3.52/@ss/__d2c__.m new file mode 100644 index 0000000..b7365a9 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__d2c__.m @@ -0,0 +1,54 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Convert the discrete SS model into its continuous-time equivalent. + +## Author: Lukas Reichlin +## Created: September 2011 +## Version: 0.2 + +function sys = __d2c__ (sys, tsam, method = "zoh", w0 = 0) + + switch (method(1)) + case {"z", "s"} # {"zoh", "std"} + [sys.a, sys.b, sys.c, sys.d, sys.e] = __dss2ss__ (sys.a, sys.b, sys.c, sys.d, sys.e); + [n, m] = size (sys.b); # n: states, m: inputs + tmp = logm ([sys.a, sys.b; zeros(m,n), eye(m)]) / tsam; + if (norm (imag (tmp), inf) > sqrt (eps)) + warning ("ss: d2c: possibly inaccurate results"); + endif + sys.a = real (tmp(1:n, 1:n)); + sys.b = real (tmp(1:n, n+1:n+m)); + + case {"t", "b", "p"} # {"tustin", "bilin", "prewarp"} + if (method(1) == "p") # prewarping + beta = w0 / tan (w0*tsam/2); + else + beta = 2/tsam; + endif + if (isempty (sys.e)) + [sys.a, sys.b, sys.c, sys.d] = slab04md (sys.a, sys.b, sys.c, sys.d, 1, beta, true); + else + [sys.a, sys.b, sys.c, sys.d, sys.e] = __dss_bilin__ (sys.a, sys.b, sys.c, sys.d, sys.e, beta, true); + endif + + otherwise + error ("ss: d2c: %s is an invalid or missing method", method); + endswitch + +endfunction diff --git a/octave_packages/control-2.3.52/@ss/__freqresp__.m b/octave_packages/control-2.3.52/@ss/__freqresp__.m new file mode 100644 index 0000000..7b00896 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__freqresp__.m @@ -0,0 +1,66 @@ +## Copyright (C) 2009, 2010, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Frequency response of SS models. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.5 + +function H = __freqresp__ (sys, w, resptype = 0, cellflag = false) + + if (sys.scaled == false) + sys = prescale (sys); + endif + + [a, b, c, d, e, tsam] = dssdata (sys); + + if (resptype != 0 && columns (b) != rows (c)) + error ("ss: freqresp: system must be square for response type %d", resptype); + endif + + if (isct (sys)) # continuous system + s = i * w; + else # discrete system + s = exp (i * w * abs (tsam)); + endif + + switch (resptype) + case 0 # default system + H = arrayfun (@(x) c/(x*e - a)*b + d, s, "uniformoutput", false); + + case 1 # inversed system + H = arrayfun (@(x) inv (c/(x*e - a)*b + d), s, "uniformoutput", false); + + case 2 # inversed sensitivity + j = eye (columns (b)); + H = arrayfun (@(x) j + c/(x*e - a)*b + d, s, "uniformoutput", false); + + case 3 # inversed complementary sensitivity + j = eye (columns (b)); + H = arrayfun (@(x) j + inv (c/(x*e - a)*b + d), s, "uniformoutput", false); + + otherwise + error ("ss: freqresp: invalid response type"); + endswitch + + if (! cellflag) + H = cat (3, H{:}); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/__get__.m b/octave_packages/control-2.3.52/@ss/__get__.m new file mode 100644 index 0000000..9fba363 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__get__.m @@ -0,0 +1,54 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Access property values of SS objects. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function val = __get__ (sys, prop) + + switch (prop) # {, } + case "a" + val = sys.a; + + case "b" + val = sys.b; + + case "c" + val = sys.c; + + case "d" + val = sys.d; + + case "e" + val = sys.e; + + case {"stname", "statename"} + val = sys.stname; + + case "scaled" + val = sys.scaled; + + otherwise + error ("ss: get: invalid property name"); + + endswitch + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/__minreal__.m b/octave_packages/control-2.3.52/@ss/__minreal__.m new file mode 100644 index 0000000..d9eb239 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__minreal__.m @@ -0,0 +1,45 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Minimal realization of SS models. The physical meaning of states is lost. +## Uses SLICOT TB01PD and TG01JD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function retsys = __minreal__ (sys, tol) + + if (tol == "def") + tol = 0; + elseif (tol > 1) + error ("ss: minreal: require tol <= 1"); + endif + + if (isempty (sys.e)) + [a, b, c] = sltb01pd (sys.a, sys.b, sys.c, tol, sys.scaled); + retsys = ss (a, b, c, sys.d); + else + [a, e, b, c] = sltg01jd (sys.a, sys.e, sys.b, sys.c, tol, sys.scaled, 0, 0); + retsys = dss (a, b, c, sys.d, e); + endif + + retsys.lti = sys.lti; # retain i/o names and tsam + +endfunction diff --git a/octave_packages/control-2.3.52/@ss/__pole__.m b/octave_packages/control-2.3.52/@ss/__pole__.m new file mode 100644 index 0000000..b973b46 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__pole__.m @@ -0,0 +1,43 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Poles of SS object. + +## Special thanks to Peter Benner for his advice. +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function pol = __pole__ (sys) + + if (isempty (sys.e)) + pol = eig (sys.a); + else + pol = eig (sys.a, sys.e); + tol = norm ([sys.a, sys.e], 2); + idx = find (abs (pol) < tol/eps); + pol = pol(idx); + endif + +endfunction + + +## sys = ss (-2, 3, 4, 0) +## sysi = inv (sys) # singular e +## p = pole (sysi) +## infinite poles correct? \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/__prescale__.m b/octave_packages/control-2.3.52/@ss/__prescale__.m new file mode 100644 index 0000000..81b97a3 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__prescale__.m @@ -0,0 +1,42 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Prescale state-space model. +## Uses SLICOT TB01ID and TG01AD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} + +## Author: Lukas Reichlin +## Created: June 2011 +## Version: 0.1 + +function [retsys, lscale, rscale] = __prescale__ (sys, optarg = 0.0) + + if (isempty (sys.e)) + [a, b, c, ~, scale] = sltb01id (sys.a, sys.b, sys.c, optarg); + retsys = ss (a, b, c, sys.d); + lscale = scale.^-1; + rscale = scale; + else + [a, e, b, c, lscale, rscale] = sltg01ad (sys.a, sys.e, sys.b, sys.c, optarg); + retsys = dss (a, b, c, sys.d, e); + endif + + retsys.scaled = true; + retsys.lti = sys.lti; # retain i/o names and tsam + +endfunction diff --git a/octave_packages/control-2.3.52/@ss/__property_names__.m b/octave_packages/control-2.3.52/@ss/__property_names__.m new file mode 100644 index 0000000..ff71b02 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__property_names__.m @@ -0,0 +1,58 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{props}, @var{vals}] =} __property_names__ (@var{sys}) +## @deftypefnx {Function File} {[@var{props}, @var{vals}] =} __property_names__ (@var{sys}, @var{"specific"}) +## Return the list of properties as well as the assignable values for a ss object sys. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function [props, vals] = __property_names__ (sys, flg) + + ## cell vector of ss-specific properties + props = {"a"; + "b"; + "c"; + "d"; + "e"; + "stname"; + "scaled"}; + + ## cell vector of ss-specific assignable values + vals = {"n-by-n matrix (n = number of states)"; + "n-by-m matrix (m = number of inputs)"; + "p-by-n matrix (p = number of outputs)"; + "p-by-m matrix"; + "n-by-n matrix"; + "n-by-1 cell vector of strings"; + "scalar logical value"}; + + if (nargin == 1) + [ltiprops, ltivals] = __property_names__ (sys.lti); + + props = [props; + ltiprops]; + + vals = [vals; + ltivals]; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/__set__.m b/octave_packages/control-2.3.52/@ss/__set__.m new file mode 100644 index 0000000..06f031c --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__set__.m @@ -0,0 +1,68 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Set or modify properties of SS objects. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function sys = __set__ (sys, prop, val) + + switch (prop) # {, } + case "a" + __ss_dim__ (val, sys.b, sys.c, sys.d); + sys.a = val; + + case "b" + __ss_dim__ (sys.a, val, sys.c, sys.d); + sys.b = val; + + case "c" + __ss_dim__ (sys.a, sys.b, val, sys.d); + sys.c = val; + + case "d" + __ss_dim__ (sys.a, sys.b, sys.c, val); + sys.d = val; + + case "e" + if (isempty (val)) + sys.e = []; # avoid [](nx0) or [](0xn) + else + __ss_dim__ (sys.a, sys.b, sys.c, sys.d, val); + sys.e = val; + endif + + case {"stname", "statename"} + n = rows (sys.a); + sys.stname = __adjust_labels__ (val, n); + + case "scaled" + if (isscalar (val)) + sys.scaled = logical (val); + else + error ("ss: set: property 'scaled' must be a logical value"); + endif + + otherwise + error ("ss: set: invalid property name"); + + endswitch + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/__sys2frd__.m b/octave_packages/control-2.3.52/@ss/__sys2frd__.m new file mode 100644 index 0000000..bd0a5c4 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__sys2frd__.m @@ -0,0 +1,36 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## SS to FRD conversion. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function [retsys, retlti] = __sys2frd__ (sys, w = []) + + if (isempty (w)) # case sys = frd (sys) + w = __frequency_vector__ (sys); + endif + + H = __freqresp__ (sys, w); + + retsys = frd (H, w); # tsam is set below + retlti = sys.lti; # preserve lti properties + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/__sys2tf__.m b/octave_packages/control-2.3.52/@ss/__sys2tf__.m new file mode 100644 index 0000000..9096297 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__sys2tf__.m @@ -0,0 +1,88 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## SS to TF conversion. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function [retsys, retlti] = __sys2tf__ (sys) + + try + [a, b, c, d, tsam, scaled] = ssdata (sys); # system could be a descriptor model + + [num, den, ign, igd, md, p, m] = sltb04bd (a, b, c, d, scaled); + + num = reshape (num, md, p, m); + den = reshape (den, md, p, m); + + num = mat2cell (num, md, ones(1,p), ones(1,m)); + den = mat2cell (den, md, ones(1,p), ones(1,m)); + + num = squeeze (num); + den = squeeze (den); + + ign = mat2cell (ign, ones(1,p), ones(1,m)); + igd = mat2cell (igd, ones(1,p), ones(1,m)); + + num = cellfun (@(x, y) x(1:y+1), num, ign, "uniformoutput", false); + den = cellfun (@(x, y) x(1:y+1), den, igd, "uniformoutput", false); + catch + ## sys.e was probably singular, therefore ssdata failed. + if (issiso (sys)) + [num, den] = __siso_ss2tf__ (sys); + else + [p, m] = size (sys); + num = cell (p, m); + den = cell (p, m); + for i = 1 : p + for j = 1 : m + idx = substruct ("()", {i, j}); + tmp = subsref (sys, idx); # extract siso model + tmp = minreal (tmp); # irreducible descriptor representation + [n, d] = __siso_ss2tf__ (tmp); + num(i, j) = n; + den(i, j) = d; + endfor + endfor + endif + tsam = get (sys, "tsam"); + end_try_catch + + retsys = tf (num, den, tsam); # tsam needed to set appropriate tfvar + retlti = sys.lti; # preserve lti properties + + ## FIXME: sys = tf (ss (5)) + +endfunction + + +function [num, den] = __siso_ss2tf__ (sys) + + if (isempty (sys.a)) # static gain + num = sys.d; + den = 1; + else # default case + [zer, gain] = zero (sys); + pol = pole (sys); + num = gain * real (poly (zer)); + den = real (poly (pol)); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@ss/__sys_connect__.m b/octave_packages/control-2.3.52/@ss/__sys_connect__.m new file mode 100644 index 0000000..2d7f204 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__sys_connect__.m @@ -0,0 +1,86 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{retsys} =} __sys_connect__ (@var{sys}, @var{M}) +## This function is part of the Model Abstraction Layer. No argument checking. +## For internal use only. +## @example +## @group +## Problem: Solve the system equations of +## . +## E x(t) = A x(t) + B e(t) +## +## y(t) = C x(t) + D e(t) +## +## e(t) = u(t) + M y(t) +## +## in order to build +## . +## K x(t) = F x(t) + G u(t) +## +## y(t) = H x(t) + J u(t) +## +## Solution: Laplace Transformation +## E s X(s) = A X(s) + B U(s) + B M Y(s) [1] +## +## Y(s) = C X(s) + D U(s) + D M Y(s) [2] +## +## solve [2] for Y(s) +## Y(s) = [I - D M]^(-1) C X(s) + [I - D M]^(-1) D U(s) +## +## substitute Z = [I - D M]^(-1) +## Y(s) = Z C X(s) + Z D U(s) [3] +## +## insert [3] in [1], solve for X(s) +## X(s) = [s E - (A + B M Z C)]^(-1) (B + B M Z D) U(s) [4] +## +## inserting [4] in [3] finally yields +## Y(s) = Z C [s E - (A + B M Z C)]^(-1) (B + B M Z D) U(s) + Z D U(s) +## \ / | \_____ _____/ \_____ _____/ \ / +## H K F G J +## @end group +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function sys = __sys_connect__ (sys, m) + + a = sys.a; + b = sys.b; + c = sys.c; + d = sys.d; + + z = eye (rows (d)) - d*m; + + if (rcond (z) < eps) # check for singularity + error ("ss: sys_connect: (I - D*M) singular"); + endif + + z = inv (z); + + sys.a = a + b*m*z*c; # F + sys.b = b + b*m*z*d; # G + sys.c = z*c; # H + sys.d = z*d; # J + + ## sys.e remains constant: [] for ss models, e for dss models + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/__sys_data__.m b/octave_packages/control-2.3.52/@ss/__sys_data__.m new file mode 100644 index 0000000..968d0e9 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__sys_data__.m @@ -0,0 +1,35 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Used by ssdata instead of multiple get calls. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.3 + +function [a, b, c, d, e, stname, scaled] = __sys_data__ (sys) + + a = sys.a; + b = sys.b; + c = sys.c; + d = sys.d; + e = sys.e; + stname = sys.stname; + scaled = sys.scaled; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/__sys_group__.m b/octave_packages/control-2.3.52/@ss/__sys_group__.m new file mode 100644 index 0000000..ff2ee65 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__sys_group__.m @@ -0,0 +1,66 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Block diagonal concatenation of two SS models. +## This file is part of the Model Abstraction Layer. +## For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function retsys = __sys_group__ (sys1, sys2) + + if (! isa (sys1, "ss")) + sys1 = ss (sys1); + endif + + if (! isa (sys2, "ss")) + sys2 = ss (sys2); + endif + + retsys = ss (); + retsys.lti = __lti_group__ (sys1.lti, sys2.lti); + + n1 = rows (sys1.a); + n2 = rows (sys2.a); + + [p1, m1] = size (sys1.d); + [p2, m2] = size (sys2.d); + + retsys.a = [sys1.a, zeros(n1,n2); zeros(n2,n1), sys2.a]; + retsys.b = [sys1.b, zeros(n1,m2); zeros(n2,m1), sys2.b]; + retsys.c = [sys1.c, zeros(p1,n2); zeros(p2,n1), sys2.c]; + retsys.d = [sys1.d, zeros(p1,m2); zeros(p2,m1), sys2.d]; + + e1 = ! isempty (sys1.e); + e2 = ! isempty (sys2.e); + + if (e1 || e2) + if (e1 && e2) + retsys.e = [sys1.e, zeros(n1,n2); zeros(n2,n1), sys2.e]; + elseif (e1) + retsys.e = [sys1.e, zeros(n1,n2); zeros(n2,n1), eye(n2)]; + else + retsys.e = [eye(n1), zeros(n1,n2); zeros(n2,n1), sys2.e]; + endif + endif + + retsys.stname = [sys1.stname; sys2.stname]; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/__sys_inverse__.m b/octave_packages/control-2.3.52/@ss/__sys_inverse__.m new file mode 100644 index 0000000..4617619 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__sys_inverse__.m @@ -0,0 +1,61 @@ +## Copyright (C) 2009, 2010, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Inversion of SS models. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function sys = __sys_inverse__ (sys) + + a = sys.a; + b = sys.b; + c = sys.c; + d = sys.d; + e = sys.e; + + if (! isempty (e) || rcond (d) < eps) # dss or strictly proper ss + + n = rows (a); + m = columns (b); # p = m (square system) + + if (isempty (e)) # avoid testing twice? + e = eye (n); + endif + + sys.a = [a, b; c, d]; + sys.b = [zeros(n, m); -eye(m)]; + sys.c = [zeros(m, n), eye(m)]; + sys.d = zeros (m); + sys.e = [e, zeros(n, m); zeros(m, n+m)]; + + sys.stname = repmat ({""}, n+m, 1); + + else # proper ss + + bid = b / d; + + sys.a = a - bid * c; + sys.b = -bid; + sys.c = d \ c; + sys.d = inv (d); + + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/__sys_prune__.m b/octave_packages/control-2.3.52/@ss/__sys_prune__.m new file mode 100644 index 0000000..02cb6fc --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__sys_prune__.m @@ -0,0 +1,42 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Submodel extraction and reordering for SS objects. +## This file is part of the Model Abstraction Layer. +## For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function sys = __sys_prune__ (sys, out_idx, in_idx, st_idx = ":") + + sys.lti = __lti_prune__ (sys.lti, out_idx, in_idx); + + sys.a = sys.a(st_idx, st_idx); + sys.b = sys.b(st_idx, in_idx); + sys.c = sys.c(out_idx, st_idx); + sys.d = sys.d(out_idx, in_idx); + + if (! isempty (sys.e)) + sys.e = sys.e(st_idx, st_idx); + endif + + sys.stname = sys.stname(st_idx); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/__transpose__.m b/octave_packages/control-2.3.52/@ss/__transpose__.m new file mode 100644 index 0000000..af0fc73 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__transpose__.m @@ -0,0 +1,41 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Transpose of SS models. + +## Author: Lukas Reichlin +## Created: February 2010 +## Version: 0.2 + +function sys = __transpose__ (sys) + + a = sys.a; + b = sys.b; + c = sys.c; + d = sys.d; + e = sys.e; + + sys.stname = repmat ({""}, rows (a), 1); + + sys.a = a.'; + sys.b = c.'; + sys.c = b.'; + sys.d = d.'; + sys.e = e.'; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/__zero__.m b/octave_packages/control-2.3.52/@ss/__zero__.m new file mode 100644 index 0000000..fc3f609 --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/__zero__.m @@ -0,0 +1,42 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Transmission zeros of SS object. +## Uses SLICOT AB08ND by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function [zer, gain] = __zero__ (sys, argc) + + if (isempty (sys.e)) + [zer, gain] = slab08nd (sys.a, sys.b, sys.c, sys.d, sys.scaled); + else + zer = slag08bd (sys.a, sys.e, sys.b, sys.c, sys.d, sys.scaled); + if (argc > 1 && issiso (sys)) + pol = pole (sys); + gain = sltg04bx (sys.a, sys.e, sys.b, sys.c, sys.d, \ + real (pol), imag (pol), real (zer), imag (zer)); + else + gain = []; + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/display.m b/octave_packages/control-2.3.52/@ss/display.m new file mode 100644 index 0000000..f739aba --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/display.m @@ -0,0 +1,97 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Display routine for SS objects. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function display (sys) + + sysname = inputname (1); + [inname, outname, tsam] = __lti_data__ (sys.lti); + stname = sys.stname; + + inname = __labels__ (inname, "u"); + outname = __labels__ (outname, "y"); + stname = __labels__ (stname, "x"); + + disp (""); + + if (! isempty (sys.e)) + __disp_mat__ (sys.e, [sysname, ".e"], stname, stname); + endif + + if (! isempty (sys.a)) + __disp_mat__ (sys.a, [sysname, ".a"], stname, stname); + __disp_mat__ (sys.b, [sysname, ".b"], stname, inname); + __disp_mat__ (sys.c, [sysname, ".c"], outname, stname); + endif + + __disp_mat__ (sys.d, [sysname, ".d"], outname, inname); + + display (sys.lti); # display sampling time + + if (tsam == -2) + disp ("Static gain."); + elseif (tsam == 0) + disp ("Continuous-time model."); + else + disp ("Discrete-time model."); + endif + +endfunction + + +function __disp_mat__ (m, mname, rname, cname) + + MAX_LEN = 12; # max length of row name and column name + [mrows, mcols] = size (m); + + row_name = strjust (strvcat (" ", rname), "left"); + row_name = row_name(:, 1 : min (MAX_LEN, end)); + row_name = horzcat (repmat (" ", mrows+1, 3), row_name); + + mat = cell (1, mcols); + + for k = 1 : mcols + cname{k} = cname{k}(:, 1 : min (MAX_LEN, end)); + acol = vertcat (cname(k), cellstr (deblank (num2str (m(:, k), 4)))); + mat{k} = strjust (strvcat (acol{:}), "right"); + endfor + + lcols = cellfun (@columns, mat); + lcols_max = 2 + max (horzcat (lcols, 1)); + + for k = 1 : mcols + mat{k} = horzcat (repmat (" ", mrows+1, lcols_max-lcols(k)), mat{k}); + endfor + + tsize = terminal_size (); + dispcols = max (1, floor ((tsize(2) - columns (row_name)) / lcols_max)); + disprows = max (1, ceil (mcols / dispcols)); + + disp ([mname, " ="]); + + for k = 1 : disprows + disp (horzcat (row_name, mat{1+(k-1)*dispcols : min (mcols, k*dispcols)})); + disp (""); + endfor + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@ss/ss.m b/octave_packages/control-2.3.52/@ss/ss.m new file mode 100644 index 0000000..72a038b --- /dev/null +++ b/octave_packages/control-2.3.52/@ss/ss.m @@ -0,0 +1,151 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} ss (@var{sys}) +## @deftypefnx {Function File} {@var{sys} =} ss (@var{d}) +## @deftypefnx {Function File} {@var{sys} =} ss (@var{a}, @var{b}) +## @deftypefnx {Function File} {@var{sys} =} ss (@var{a}, @var{b}, @var{c}) +## @deftypefnx {Function File} {@var{sys} =} ss (@var{a}, @var{b}, @var{c}, @var{d}, @dots{}) +## @deftypefnx {Function File} {@var{sys} =} ss (@var{a}, @var{b}, @var{c}, @var{d}, @var{tsam}, @dots{}) +## Create or convert to state-space model. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model to be converted to state-space. +## @item a +## State transition matrix (n-by-n). +## @item b +## Input matrix (n-by-m). +## @item c +## Measurement matrix (p-by-n). +## If @var{c} is empty @code{[]} or not specified, an identity matrix is assumed. +## @item d +## Feedthrough matrix (p-by-m). +## If @var{d} is empty @code{[]} or not specified, a zero matrix is assumed. +## @item tsam +## Sampling time in seconds. If @var{tsam} is not specified, a continuous-time model is assumed. +## @item @dots{} +## Optional pairs of properties and values. +## Type @command{set (ss)} for more information. +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## State-space model. +## @end table +## +## @strong{Example} +## @example +## @group +## octave:1> a = [1 2 3; 4 5 6; 7 8 9]; +## octave:2> b = [10; 11; 12]; +## octave:3> stname = @{"V", "A", "kJ"@}; +## octave:4> sys = ss (a, b, [], [], "stname", stname) +## +## sys.a = +## V A kJ +## V 1 2 3 +## A 4 5 6 +## kJ 7 8 9 +## +## sys.b = +## u1 +## V 10 +## A 11 +## kJ 12 +## +## sys.c = +## V A kJ +## y1 1 0 0 +## y2 0 1 0 +## y3 0 0 1 +## +## sys.d = +## u1 +## y1 0 +## y2 0 +## y3 0 +## +## Continuous-time model. +## octave:5> +## @end group +## @end example +## +## @seealso{tf, dss} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.3 + +function sys = ss (a = [], b = [], c = [], d = [], varargin) + + ## model precedence: frd > ss > zpk > tf > double + ## inferiorto ("frd"); + superiorto ("zpk", "tf", "double"); + + argc = 0; # initialize argument count + tsam = 0; # initialize sampling time + + if (nargin == 1) + if (isa (a, "ss")) # already in ss form sys = ss (sssys) + sys = a; + return; + elseif (isa (a, "lti")) # another lti object sys = ss (sys) + [sys, alti] = __sys2ss__ (a); + sys.lti = alti; # preserve lti properties + return; + elseif (is_real_matrix (a)) # static gain sys = ss (5), sys = ss (matrix) + d = a; + a = []; + else + print_usage (); + endif + elseif (nargin > 4) # default case sys = ss (a, b, c, d, "prop1", val1, ...) + argc = numel (varargin); # number of additional arguments after d + if (issample (varargin{1}, -10)) # sys = ss (a, b, c, d, tsam, "prop1, "val1", ...) + tsam = varargin{1}; # sampling time, could be 0 as well + argc--; # tsam is not a property-value pair + if (argc > 0) # if there are any properties and values ... + varargin = varargin(2:end); # remove tsam from property-value list + endif + endif + endif # nothing to do for ss (), ss (a, b), ss (a, b, c), ss (a, b, c, d) + + [a, b, c, d, tsam] = __adjust_ss_data__ (a, b, c, d, tsam); + [p, m, n] = __ss_dim__ (a, b, c, d); # determine number of outputs, inputs and states + + stname = repmat ({""}, n, 1); # cell with empty state names + + ssdata = struct ("a", a, "b", b, + "c", c, "d", d, + "e", [], + "stname", {stname}, + "scaled", false); # struct for ss-specific data + + ltisys = lti (p, m, tsam); # parent class for general lti data + + sys = class (ssdata, "ss", ltisys); # create ss object + + if (argc > 0) # if there are any properties and values, ... + sys = set (sys, varargin{:}); # use the general set function + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@tf/__c2d__.m b/octave_packages/control-2.3.52/@tf/__c2d__.m new file mode 100644 index 0000000..696a662 --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__c2d__.m @@ -0,0 +1,42 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Convert the continuous TF model into its discrete-time equivalent. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function sys = __c2d__ (sys, tsam, method = "zoh", w0 = 0) + + [p, m] = size (sys); + + for i = 1 : p + for j = 1 : m + idx = substruct ("()", {i, j}); + tmp = subsref (sys, idx); + tmp = c2d (ss (tmp), tsam, method, w0); + [num, den] = tfdata (tmp, "tfpoly"); + sys.num(i, j) = num; + sys.den(i, j) = den; + endfor + endfor + + sys.tfvar = "z"; + +endfunction diff --git a/octave_packages/control-2.3.52/@tf/__ctranspose__.m b/octave_packages/control-2.3.52/@tf/__ctranspose__.m new file mode 100644 index 0000000..627bb0e --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__ctranspose__.m @@ -0,0 +1,42 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Conjugate transpose of TF models. + +## Author: Lukas Reichlin +## Created: May 2012 +## Version: 0.1 + +function sys = __ctranspose__ (sys, ct) + + num = sys.num; + den = sys.den; + + if (ct) # continuous-time + num = cellfun (@conj_ct, num, "uniformoutput", false); + den = cellfun (@conj_ct, den, "uniformoutput", false); + else # discrete-time + num = cellfun (@conj_dt, num, "uniformoutput", false); + den = cellfun (@conj_dt, den, "uniformoutput", false); + ## TODO: shall I make "den" a monic polynomial? + endif + + sys.num = num.'; + sys.den = den.'; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tf/__d2c__.m b/octave_packages/control-2.3.52/@tf/__d2c__.m new file mode 100644 index 0000000..4472e5f --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__d2c__.m @@ -0,0 +1,42 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Convert the discrete TF model into its continuous-time equivalent. + +## Author: Lukas Reichlin +## Created: September 2011 +## Version: 0.1 + +function sys = __d2c__ (sys, tsam, method = "zoh", w0 = 0) + + [p, m] = size (sys); + + for i = 1 : p + for j = 1 : m + idx = substruct ("()", {i, j}); + tmp = subsref (sys, idx); + tmp = d2c (ss (tmp), method, w0); + [num, den] = tfdata (tmp, "tfpoly"); + sys.num(i, j) = num; + sys.den(i, j) = den; + endfor + endfor + + sys.tfvar = "s"; + +endfunction diff --git a/octave_packages/control-2.3.52/@tf/__freqresp__.m b/octave_packages/control-2.3.52/@tf/__freqresp__.m new file mode 100644 index 0000000..a55179f --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__freqresp__.m @@ -0,0 +1,71 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Frequency response of TF models. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.4 + +function H = __freqresp__ (sys, w, resptype = 0, cellflag = false) + + [num, den, tsam] = tfdata (sys, "vector"); + + if (isct (sys)) # continuous system + s = i * w; + else # discrete system + s = exp (i * w * abs (tsam)); + endif + + s = reshape (s, 1, 1, []); + + if (issiso (sys)) + H = polyval (num, s) ./ polyval (den, s); + else + H = cellfun (@(x, y) polyval (x, s) ./ polyval (y, s), num, den, "uniformoutput", false); + H = cell2mat (H); + endif + + if (resptype) + [p, m] = size (sys); + l = length (s); + if (m != p) + error ("tf: freqresp: system must be square for response type %d", resptype); + endif + H = mat2cell (H, p, m, ones (1, l))(:); + j = eye (p); + switch (resptype) + case 1 # inversed system + H = cellfun (@inv, H, "uniformoutput", false); + case 2 # inversed sensitivity + H = cellfun (@(x) j + x, H, "uniformoutput", false); + case 3 # inversed complementary sensitivity + H = cellfun (@(x) j + inv (x), H, "uniformoutput", false); + otherwise + error ("tf: freqresp: invalid response type"); + endswitch + if (! cellflag) + H = cat (3, H{:}); + endif + elseif (cellflag) + [p, m] = size (sys); + l = length (s); + H = mat2cell (H, p, m, ones (1, l))(:); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@tf/__get__.m b/octave_packages/control-2.3.52/@tf/__get__.m new file mode 100644 index 0000000..8f1263f --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__get__.m @@ -0,0 +1,44 @@ +## Copyright (C) 2009, 2010, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Access property values of TF objects. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function val = __get__ (sys, prop) + + switch (prop) # {, } + case "num" + val = cellfun (@get, sys.num, "uniformoutput", false); + + case "den" + val = cellfun (@get, sys.den, "uniformoutput", false); + + case {"tfvar", "variable"} + val = sys.tfvar; + + case "inv" + val = sys.inv; + + otherwise + error ("tf: get: invalid property name"); + endswitch + +endfunction diff --git a/octave_packages/control-2.3.52/@tf/__minreal__.m b/octave_packages/control-2.3.52/@tf/__minreal__.m new file mode 100644 index 0000000..a8de88d --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__minreal__.m @@ -0,0 +1,74 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Minimal realization of TF models. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function sys = __minreal__ (sys, tol) + + ## TODO: Once ZPK models are implemented, convert TF to ZPK, + ## do cancellations over there and convert back to TF + + sqrt_eps = sqrt (eps); # treshold for zero + + [p, m] = size (sys); + + for ny = 1 : p + for nu = 1 : m + sisosys = __sys_prune__ (sys, ny, nu); + + [zer, gain] = zero (sisosys); + pol = pole (sisosys); + + for k = length (zer) : -1 : 1 # reversed because of deleted zeros + [~, idx] = min (abs (zer(k) - pol)); # find best match + + if (tol == "def") + if (abs (zer(k)) < sqrt_eps) # catch case zer(k) = 0 + t = 1000 * eps; + else + t = 1000 * abs (zer(k)) * sqrt_eps; + endif + else + t = tol; + endif + + if (abs (zer(k) - pol(idx)) < t) + zer(k) = []; + pol(idx) = []; + endif + endfor + + num = real (gain * poly (zer)); + den = real (poly (pol)); + + num_idx = find (abs (num) < sqrt_eps); # suppress numerical noise + den_idx = find (abs (den) < sqrt_eps); # in polynomial coefficients + + num(num_idx) = 0; + den(den_idx) = 0; + + sys.num{ny, nu} = tfpoly (num); + sys.den{ny, nu} = tfpoly (den); + endfor + endfor + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tf/__pole__.m b/octave_packages/control-2.3.52/@tf/__pole__.m new file mode 100644 index 0000000..06a75df --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__pole__.m @@ -0,0 +1,34 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Poles of TF object. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function pol = __pole__ (sys) + + if (issiso (sys)) + pol = roots (sys.den{1}); + else + warning ("tf: pole: converting to minimal state-space for pole computation of mimo tf"); + pol = pole (ss (sys)); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@tf/__property_names__.m b/octave_packages/control-2.3.52/@tf/__property_names__.m new file mode 100644 index 0000000..38c6e8a --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__property_names__.m @@ -0,0 +1,52 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{props}, @var{vals}] =} __property_names__ (@var{sys}) +## @deftypefnx {Function File} {[@var{props}, @var{vals}] =} __property_names__ (@var{sys}, @var{"specific"}) +## Return the list of properties as well as the assignable values for a ss object sys. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function [props, vals] = __property_names__ (sys, flg) + + ## cell vector of tf-specific properties + props = {"num"; + "den"; + "tfvar"; + "inv"}; + + ## cell vector of tf-specific assignable values + vals = {"p-by-m cell array of row vectors (m = number of inputs)"; + "p-by-m cell array of row vectors (p = number of outputs)"; + "string (usually s or z)"; + "logical (true for negative powers of TF variable)"}; + + if (nargin == 1) + [ltiprops, ltivals] = __property_names__ (sys.lti); + + props = [props; + ltiprops]; + + vals = [vals; + ltivals]; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tf/__set__.m b/octave_packages/control-2.3.52/@tf/__set__.m new file mode 100644 index 0000000..7fd448e --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__set__.m @@ -0,0 +1,59 @@ +## Copyright (C) 2009, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Set or modify properties of TF objects. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function sys = __set__ (sys, prop, val) + + switch (prop) # {, } + case "num" + num = __vec2tfpoly__ (val); + __tf_dim__ (num, sys.den); + sys.num = num; + + case "den" + den = __vec2tfpoly__ (val); + __tf_dim__ (sys.num, den); + sys.den = den; + + case {"tfvar", "variable"} + if (ischar (val)) + sys.tfvar = val; + else + error ("tf: set: invalid transfer function variable"); + endif + + case "inv" + if (! isdt (sys)) + error ("tf: set: property 'inv' requires discrete-time system"); + elseif (! isscalar (val)) + error ("tf: set: property 'inv' must be a scalar logical"); + else + sys.inv = logical (val); + endif + + otherwise + error ("tf: set: invalid property name"); + + endswitch + +endfunction diff --git a/octave_packages/control-2.3.52/@tf/__sys2frd__.m b/octave_packages/control-2.3.52/@tf/__sys2frd__.m new file mode 100644 index 0000000..d01a06b --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__sys2frd__.m @@ -0,0 +1,36 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## TF to FRD conversion. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function [retsys, retlti] = __sys2frd__ (sys, w = []) + + if (isempty (w)) # case sys = frd (sys) + w = __frequency_vector__ (sys); + endif + + H = __freqresp__ (sys, w); + + retsys = frd (H, w); # tsam is set below + retlti = sys.lti; # preserve lti properties + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tf/__sys2ss__.m b/octave_packages/control-2.3.52/@tf/__sys2ss__.m new file mode 100644 index 0000000..d22dea4 --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__sys2ss__.m @@ -0,0 +1,177 @@ +## Copyright (C) 2009, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## TF to SS conversion. +## Reference: +## Varga, A.: Computation of irreducible generalized state-space realizations. +## Kybernetika, 26:89-106, 1990 + +## Special thanks to Vasile Sima and Andras Varga for their advice. +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.4.1 + +function [retsys, retlti] = __sys2ss__ (sys) + + ## TODO: determine appropriate tolerance from number of inputs + ## (since we multiply all denominators in a row), index, ... + ## default tolerance from TB01UD is TOLDEF = N*N*EPS + + ## SECRET WISH: a routine which accepts individual denominators for + ## each channel and which supports descriptor systems + + [p, m] = size (sys); + [num, den] = tfdata (sys); + + len_num = cellfun (@length, num); + len_den = cellfun (@length, den); + + ## check for properness + ## tfpoly ensures that there are no leading zeros + tmp = len_num > len_den; + if (any (tmp(:))) # non-proper transfer function + ## separation into strictly proper and polynomial part + [numq, numr] = cellfun (@deconv, num, den, "uniformoutput", false); + numq = cellfun (@__remove_leading_zeros__, numq, "uniformoutput", false); + numr = cellfun (@__remove_leading_zeros__, numr, "uniformoutput", false); + + ## minimal state-space realization for the proper part + [a1, b1, c1] = __proper_tf2ss__ (numr, den, p, m); + e1 = eye (size (a1)); + + ## minimal realization for the polynomial part + [e2, a2, b2, c2] = __polynomial_tf2ss__ (numq, p, m); + + ## assemble irreducible descriptor realization + e = blkdiag (e1, e2); + a = blkdiag (a1, a2); + b = vertcat (b1, b2); + c = horzcat (c1, c2); + retsys = dss (a, b, c, [], e); + else # proper transfer function + [a, b, c, d] = __proper_tf2ss__ (num, den, p, m); + retsys = ss (a, b, c, d); + endif + + retlti = sys.lti; # preserve lti properties such as tsam + +endfunction + + +## transfer function to state-space conversion for proper models +function [a, b, c, d] = __proper_tf2ss__ (num, den, p, m) + + ## new cells for the TF of same row denominators + numc = cell (p, m); + denc = cell (p, 1); + + ## multiply all denominators in a row and + ## update each numerator accordingly + ## except for single-input models and those + ## with equal denominators in a row + for i = 1 : p + if (m == 1 || isequal (den{i,:})) + denc(i) = den{i,1}; + numc(i,:) = num(i,:); + else + denc(i) = __conv__ (den{i,:}); + for j = 1 : m + idx = setdiff (1:m, j); + numc(i,j) = __conv__ (num{i,j}, den{i,idx}); + endfor + endif + endfor + + len_numc = cellfun (@length, numc); + len_denc = cellfun (@length, denc); + + ## check for properness + ## tfpoly ensures that there are no leading zeros + ## tmp = len_numc > repmat (len_denc, 1, m); + ## if (any (tmp(:))) + ## error ("tf: tf2ss: system must be proper"); + ## endif + + ## create arrays and fill in the data + ## in a way that Slicot TD04AD can use + max_len_denc = max (len_denc(:)); + ucoeff = zeros (p, m, max_len_denc); + dcoeff = zeros (p, max_len_denc); + index = len_denc-1; + + for i = 1 : p + len = len_denc(i); + dcoeff(i, 1:len) = denc{i}; + for j = 1 : m + ucoeff(i, j, len-len_numc(i,j)+1 : len) = numc{i,j}; + endfor + endfor + + tol = min (sqrt (eps), eps*prod (index)); + [a, b, c, d] = sltd04ad (ucoeff, dcoeff, index, tol); + +endfunction + + +## realization of the polynomial part according to Andras' paper +function [e2, a2, b2, c2] = __polynomial_tf2ss__ (numq, p, m) + + len_numq = cellfun (@length, numq); + max_len_numq = max (len_numq(:)); + numq = cellfun (@(x) prepad (x, max_len_numq, 0, 2), numq, "uniformoutput", false); + f = @(y) cellfun (@(x) x(y), numq); + s = 1 : max_len_numq; + D = arrayfun (f, s, "uniformoutput", false); + + e2 = diag (ones (p*(max_len_numq-1), 1), -p); + a2 = eye (p*max_len_numq); + b2 = vertcat (D{:}); + c2 = horzcat (zeros (p, p*(max_len_numq-1)), -eye (p)); + + ## remove uncontrollable part + [a2, e2, b2, c2] = sltg01jd (a2, e2, b2, c2, 0.0, true, 1, 2); + +endfunction + + +## convolution for more than two arguments +function vec = __conv__ (vec, varargin) + + if (nargin == 1) + return; + else + for k = 1 : nargin-1 + vec = conv (vec, varargin{k}); + endfor + endif + +endfunction + + +## remove leading zeros from polynomial vector +function p = __remove_leading_zeros__ (p) + + idx = find (p != 0); + + if (isempty (idx)) + p = 0; + else + p = p(idx(1) : end); # p(idx) would remove all zeros + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tf/__sys_connect__.m b/octave_packages/control-2.3.52/@tf/__sys_connect__.m new file mode 100644 index 0000000..39b7660 --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__sys_connect__.m @@ -0,0 +1,120 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{retsys} =} __sys_connect__ (@var{sys}, @var{M}) +## This function is part of the Model Abstraction Layer. No argument checking. +## For internal use only. +## @example +## @group +## Problem: Solve the system equations of +## Y(s) = G(s) E(s) +## E(s) = U(s) + M Y(s) +## in order to build +## Y(s) = H(s) U(s) +## Solution: +## Y(s) = G(s) [I - M G(s)]^-1 U(s) +## = [I - G(s) M]^-1 G(s) U(s) +## @end group +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function sys = __sys_connect__ (sys, M) + + [p, m] = size (sys); + + num = sys.num; + den = sys.den; + + ## TODO: Implementation for MIMO models. There are three possibilities: + ## 1. An _algebraic_ solution of the inversion problem in order + ## to not introduce unwanted zero/pole pairs. Difficult. + ## 2. A numeric solution of the inversion problem. Afterwards, + ## elimination of _all_ zero/pole pairs by minreal. Bad. + ## 3. Conversion to state-space, solving the problem there and + ## converting back to transfer function. Easier, but obviously, + ## this way needs MIMO __sys2ss__ and __sys2tf__ implementations + ## as described in Thomas Kailath's classic "Linear Systems". + ## Possibly this is the way to go, but it works for proper systems + ## only unless descriptor state-space models are implemented. + + ## WARNING: The code below is a cheap hack to quickly enable SISO TF connections. + + ## TODO: Check for den = 0, e.g. in feedback (tf (1), tf (-1)) + + if (p == 2 && m == 2 && num{1,2} == 0 && num{2,1} == 0 \ + && M(1,1) == 0 && M(2,2) == 0) + ## mtimes, feedback + sys.num(1,1) = num{1,1} * den{2,2}; + sys.num(1,2) = M(1,2) * num{1,1} * num{2,2}; + sys.num(2,1) = M(2,1) * num{1,1} * num{2,2}; + sys.num(2,2) = num{2,2} * den{1,1}; + + sys.den(:) = den{1,1} * den{2,2} - M(1,2) * M(2,1) * num{1,1} * num{2,2}; + + elseif (p == 3 && m == 4 && num{1,3} == 0 && num{1,4} == 0 \ + && num{2,1} == 0 && num{2,2} == 0 && num{2,4} == 0 \ + && num{3,1} == 0 && num{3,2} == 0 && num{3,3} == 0 \ + && M == [0, 1, 0; 0, 0, 1; 0, 0, 0; 0, 0, 0]) + ## horzcat [sys1, sys2], plus, minus + sys.num(:) = tfpoly (0); + sys.den(:) = tfpoly (1); + + sys.num(1,1) = num{1,1}; + sys.num(1,2) = num{1,2}; + sys.num(1,3) = num{1,1} * num{2,3}; + sys.num(1,4) = num{1,2} * num{3,4}; + sys.num(2,3) = num{2,3}; + sys.num(3,4) = num{3,4}; + + sys.den(1,3) = den{2,3}; + sys.den(1,4) = den{3,4}; + sys.den(2,3) = den{2,3}; + sys.den(3,4) = den{3,4}; + + elseif (p == 3 && m == 3 && num{1,3} == 0 \ + && num{2,1} == 0 && num{2,2} == 0 && num{2,3} == 1 \ + && num{3,1} == 0 && num{3,2} == 0 && num{3,3} == 1 \ + && M == [0, 1, 0; 0, 0, 1; 0, 0, 0]) + ## plus, minus + sys.num(1,3) = num{1,1} * den{1,2} + num{1,2} * den{1,1}; + sys.den(1,3) = den{1,1} * den{1,2}; + + elseif (p == 4 && m == 3 && num{1,2} == 0 && num{1,3} == 0 \ + && num{2,1} == 0 && num{2,3} == 0 \ + && num{3,1} == 0 && num{3,2} == 0 && num{3,3} == 1 \ + && num{4,1} == 0 && num{4,2} == 0 && num{4,3} == 1 \ + && M == [0, 0, 1, 0; 0, 0, 0, 1; 0, 0, 0, 0]) + ## vertcat [sys1; sys2] + sys.num(1,3) = num{1,1}; + sys.num(2,3) = num{2,2}; + + sys.den(1,3) = den{1,1}; + sys.den(2,3) = den{2,2}; + + else + ## MIMO case, convert to state-space and back. + warning ("tf: converting to minimal state-space for MIMO TF interconnections"); + sys = tf (__sys_connect__ (ss (sys), M)); + + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@tf/__sys_data__.m b/octave_packages/control-2.3.52/@tf/__sys_data__.m new file mode 100644 index 0000000..d5f89a3 --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__sys_data__.m @@ -0,0 +1,31 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Used by tfdata instead of multiple get calls. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function [num, den, tfvar] = __sys_data__ (sys) + + num = sys.num; + den = sys.den; + tfvar = sys.tfvar; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tf/__sys_group__.m b/octave_packages/control-2.3.52/@tf/__sys_group__.m new file mode 100644 index 0000000..69802a5 --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__sys_group__.m @@ -0,0 +1,68 @@ +## Copyright (C) 2009, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Block diagonal concatenation of two TF models. +## This file is part of the Model Abstraction Layer. +## For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function retsys = __sys_group__ (sys1, sys2) + + if (! isa (sys1, "tf")) + sys1 = tf (sys1); + endif + + if (! isa (sys2, "tf")) + sys2 = tf (sys2); + endif + + retsys = tf (); + + retsys.lti = __lti_group__ (sys1.lti, sys2.lti); + + [p1, m1] = size (sys1); + [p2, m2] = size (sys2); + + empty12 = tfpolyzeros (p1, m2); + empty21 = tfpolyzeros (p2, m1); + + retsys.num = [sys1.num, empty12 ; + empty21, sys2.num]; + + empty12 = tfpolyones (p1, m2); + empty21 = tfpolyones (p2, m1); + + retsys.den = [sys1.den, empty12 ; + empty21, sys2.den]; + + if (sys1.tfvar == sys2.tfvar) + retsys.tfvar = sys1.tfvar; + elseif (sys1.tfvar == "x") + retsys.tfvar = sys2.tfvar; + else + retsys.tfvar = sys1.tfvar; + endif + + if (sys1.inv || sys2.inv) + retsys.inv = true; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@tf/__sys_inverse__.m b/octave_packages/control-2.3.52/@tf/__sys_inverse__.m new file mode 100644 index 0000000..8268c7c --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__sys_inverse__.m @@ -0,0 +1,52 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Inversion of TF models. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function sys = __sys_inverse__ (sys) + + nvec = size (sys); + num = sys.num; + den = sys.den; + + if (all (nvec == 1)) # SISO + if (num{1,1} == 0) # catch case num = 0 + sys.num(1,1) = tfpoly (0); + sys.den(1,1) = tfpoly (1); + else + sys.num = den; + sys.den = num; + endif + elseif (all (nvec == 2)) # 2x2 MIMO + sys.num(1,1) = -den{1,1}*den{1,2}*den{2,1}*num{2,2}; + sys.num(1,2) = den{1,1}*den{2,1}*den{2,2}*num{1,2}; + sys.num(2,1) = den{1,1}*den{1,2}*den{2,2}*num{2,1}; + sys.num(2,2) = -den{1,2}*den{2,1}*den{2,2}*num{1,1}; + sys.den(:) = den{1,1}*den{2,2}*num{1,2}*num{2,1} - den{1,2}*den{2,1}*num{1,1}*num{2,2}; + else + ## I've calculated 3x3 systems with sage but the formula is quite long + [num, den] = tfdata (inv (ss (sys)), "tfpoly"); + sys.num = num; + sys.den = den; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@tf/__sys_prune__.m b/octave_packages/control-2.3.52/@tf/__sys_prune__.m new file mode 100644 index 0000000..9ef768d --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__sys_prune__.m @@ -0,0 +1,34 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Submodel extraction and reordering for TF objects. +## This file is part of the Model Abstraction Layer. +## For internal use only. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function sys = __sys_prune__ (sys, out_idx, in_idx) + + sys.lti = __lti_prune__ (sys.lti, out_idx, in_idx); + + sys.num = sys.num(out_idx, in_idx); + sys.den = sys.den(out_idx, in_idx); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tf/__transpose__.m b/octave_packages/control-2.3.52/@tf/__transpose__.m new file mode 100644 index 0000000..0751f62 --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__transpose__.m @@ -0,0 +1,33 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Transpose of TF models. + +## Author: Lukas Reichlin +## Created: February 2010 +## Version: 0.1 + +function sys = __transpose__ (sys) + + num = sys.num; + den = sys.den; + + sys.num = num.'; + sys.den = den.'; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tf/__zero__.m b/octave_packages/control-2.3.52/@tf/__zero__.m new file mode 100644 index 0000000..2d6ac8c --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/__zero__.m @@ -0,0 +1,37 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Transmission zeros of TF object. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function [zer, gain] = __zero__ (sys) + + if (issiso (sys)) + num = get (sys.num{1}); + den = get (sys.den{1}); + zer = roots (num); + gain = num(1) / den(1); + else + warning ("tf: zero: converting to minimal state-space for zero computation of mimo tf"); + [zer, gain] = zero (ss (sys)); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@tf/display.m b/octave_packages/control-2.3.52/@tf/display.m new file mode 100644 index 0000000..9594fb6 --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/display.m @@ -0,0 +1,101 @@ +## Copyright (C) 2009, 2010, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Display routine for TF objects. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.4 + +function display (sys) + + sysname = inputname (1); + [inname, outname, tsam] = __lti_data__ (sys.lti); + + [inname, m] = __labels__ (inname, "u"); + [outname, p] = __labels__ (outname, "y"); + + disp (""); + + if (sys.inv) + [num, den] = filtdata (sys); + else + num = sys.num; + den = sys.den; + endif + + for nu = 1 : m + disp (["Transfer function '", sysname, "' from input '", inname{nu}, "' to output ..."]); + disp (""); + for ny = 1 : p + __disp_frac__ (num{ny, nu}, den{ny, nu}, sys.tfvar, outname{ny}); + endfor + endfor + + display (sys.lti); # display sampling time + + if (tsam == -2) + disp ("Static gain."); + elseif (tsam == 0) + disp ("Continuous-time model."); + else + disp ("Discrete-time model."); + endif + +endfunction + + +function __disp_frac__ (num, den, tfvar, name) + + MAX_LEN = 12; # max length of output name + + tfp = isa (num, "tfpoly"); + + if (num == tfpoly (0)) + str = [" ", name, ": 0"]; + elseif ((tfp && den == 1) || (! tfp && isequal (den, 1))) + ## elseif (den == tfpoly (1)) doesn't work because it + ## would mistakingly accept non-tfpoly denominators like [0, 1] + str = [" ", name, ": "]; + numstr = tfpoly2str (num, tfvar); + str = [str, numstr]; + ##elseif (length (den) == 1) # de-comment for non-development use + ## str = [" ", name, ": "]; + ## num = num * (1/get (den)); + ## numstr = tfpoly2str (num, tfvar); + ## str = [str, numstr]; + else + numstr = tfpoly2str (num, tfvar); + denstr = tfpoly2str (den, tfvar); + fracstr = repmat ("-", 1, max (length (numstr), length (denstr))); + + str = strjust (strvcat (numstr, fracstr, denstr), "center"); + + namestr = name(:, 1 : min (MAX_LEN, end)); + namestr = [namestr, ": "]; + namestr = strjust (strvcat (" ", namestr, " "), "left"); + namestr = horzcat (repmat (" ", 3, 1), namestr); + + str = [namestr, str]; + endif + + disp (str); + disp (""); + +endfunction + diff --git a/octave_packages/control-2.3.52/@tf/tf.m b/octave_packages/control-2.3.52/@tf/tf.m new file mode 100644 index 0000000..abb0f22 --- /dev/null +++ b/octave_packages/control-2.3.52/@tf/tf.m @@ -0,0 +1,211 @@ +## Copyright (C) 2009, 2010, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{s} =} tf (@var{"s"}) +## @deftypefnx {Function File} {@var{z} =} tf (@var{"z"}, @var{tsam}) +## @deftypefnx {Function File} {@var{sys} =} tf (@var{sys}) +## @deftypefnx {Function File} {@var{sys} =} tf (@var{num}, @var{den}, @dots{}) +## @deftypefnx {Function File} {@var{sys} =} tf (@var{num}, @var{den}, @var{tsam}, @dots{}) +## Create or convert to transfer function model. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model to be converted to transfer function. +## @item num +## Numerator or cell of numerators. Each numerator must be a row vector +## containing the coefficients of the polynomial in descending powers of +## the transfer function variable. +## num@{i,j@} contains the numerator polynomial from input j to output i. +## In the SISO case, a single vector is accepted as well. +## @item den +## Denominator or cell of denominators. Each denominator must be a row vector +## containing the coefficients of the polynomial in descending powers of +## the transfer function variable. +## den@{i,j@} contains the denominator polynomial from input j to output i. +## In the SISO case, a single vector is accepted as well. +## @item tsam +## Sampling time in seconds. If @var{tsam} is not specified, a continuous-time +## model is assumed. +## @item @dots{} +## Optional pairs of properties and values. +## Type @command{set (tf)} for more information. +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## Transfer function model. +## @end table +## +## @strong{Example} +## @example +## @group +## octave:1> s = tf ("s"); +## octave:2> G = 1/(s+1) +## +## Transfer function "G" from input "u1" to output ... +## +## 1 +## y1: ----- +## s + 1 +## +## Continuous-time model. +## @end group +## @end example +## @example +## @group +## octave:3> z = tf ("z", 0.2); +## octave:4> H = 0.095/(z-0.9) +## +## Transfer function "H" from input "u1" to output ... +## +## 0.095 +## y1: ------- +## z - 0.9 +## +## Sampling time: 0.2 s +## Discrete-time model. +## @end group +## @end example +## @example +## @group +## octave:5> num = @{[1, 5, 7], [1]; [1, 7], [1, 5, 5]@}; +## octave:6> den = @{[1, 5, 6], [1, 2]; [1, 8, 6], [1, 3, 2]@}; +## octave:7> sys = tf (num, den) +## +## Transfer function "sys" from input "u1" to output ... +## +## s^2 + 5 s + 7 +## y1: ------------- +## s^2 + 5 s + 6 +## +## s + 7 +## y2: ------------- +## s^2 + 8 s + 6 +## +## Transfer function "sys" from input "u2" to output ... +## +## 1 +## y1: ----- +## s + 2 +## +## s^2 + 5 s + 5 +## y2: ------------- +## s^2 + 3 s + 2 +## +## Continuous-time model. +## octave:8> +## @end group +## @end example +## +## @seealso{ss, dss} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.3 + +function sys = tf (num = {}, den = {}, varargin) + + ## model precedence: frd > ss > zpk > tf > double + ## inferiorto ("frd", "ss", "zpk"); # error if de-commented. bug in octave? + superiorto ("double"); + + argc = 0; # initialize argument count + + switch (nargin) + case 0 # sys = tf () + tsam = -2; # undefined sampling time + tfvar = "x"; # undefined transfer function variable + + case 1 + if (isa (num, "tf")) # already in tf form sys = tf (tfsys) + sys = num; + return; + elseif (isa (num, "lti")) # another lti object sys = tf (sys) + [sys, numlti] = __sys2tf__ (num); + sys.lti = numlti; # preserve lti properties + return; + elseif (is_real_matrix (num)) # static gain sys = tf (4), sys = tf (matrix) + num = num2cell (num); + num = __vec2tfpoly__ (num); + [p, m] = size (num); + den = tfpolyones (p, m); # denominators are all 1 + tsam = -2; # undefined sampling time + tfvar = "x"; # undefined transfer function variable + elseif (ischar (num)) # s = tf ("s") + tfvar = num; + num = __vec2tfpoly__ ([1, 0]); + den = __vec2tfpoly__ ([1]); + tsam = 0; + else + print_usage (); + endif + + case 2 + if (ischar (num) && issample (den, -1)) # z = tf ("z", 0.3) + tfvar = num; + tsam = den; + num = __vec2tfpoly__ ([1, 0]); + den = __vec2tfpoly__ ([1]); + else # sys = tf (num, den) + num = __vec2tfpoly__ (num); + den = __vec2tfpoly__ (den); + tfvar = "s"; + tsam = 0; + endif + + otherwise # default case sys = tf (num, den, ...) + num = __vec2tfpoly__ (num); + den = __vec2tfpoly__ (den); + argc = numel (varargin); # number of additional arguments after num and den + if (issample (varargin{1}, -10)) # sys = tf (num, den, tsam, "prop1", val1, ...) + tsam = varargin{1}; # sampling time, could be 0 as well + argc--; # tsam is not a property-value pair + if (tsam == 0) + tfvar = "s"; + else + tfvar = "z"; + endif + if (argc > 0) # if there are any properties and values ... + varargin = varargin(2:end); # remove tsam from property-value list + endif + else # sys = tf (num, den, "prop1", val1, ...) + tsam = 0; # continuous-time + tfvar = "s"; + endif + endswitch + + [p, m] = __tf_dim__ (num, den); # determine number of outputs and inputs + + tfdata = struct ("num", {num}, + "den", {den}, + "tfvar", tfvar, + "inv", false); # struct for tf-specific data + + ltisys = lti (p, m, tsam); # parent class for general lti data + + sys = class (tfdata, "tf", ltisys); # create tf object + + if (argc > 0) # if there are any properties and values, ... + sys = set (sys, varargin{:}); # use the general set function + endif + +endfunction + diff --git a/octave_packages/control-2.3.52/@tfpoly/__make_equally_long__.m b/octave_packages/control-2.3.52/@tfpoly/__make_equally_long__.m new file mode 100644 index 0000000..76cf030 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/__make_equally_long__.m @@ -0,0 +1,35 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Make two polynomials equally long by adding leading zeros +## to the shorter one. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function [a, b] = __make_equally_long__ (a, b) + + la = length (a.poly); + lb = length (b.poly); + lmax = max (la, lb); + + a.poly = [zeros(1, lmax-la), a.poly]; + b.poly = [zeros(1, lmax-lb), b.poly]; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/__remove_leading_zeros__.m b/octave_packages/control-2.3.52/@tfpoly/__remove_leading_zeros__.m new file mode 100644 index 0000000..ed8dbe0 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/__remove_leading_zeros__.m @@ -0,0 +1,36 @@ +## Copyright (C) 2009, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Remove leading zeros from a polynomial, except for polynomials +## which are of length 1. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function p = __remove_leading_zeros__ (p) + + idx = find (p.poly != 0); + + if (isempty (idx)) + p.poly = 0; + else + p.poly = p.poly(idx(1) : end); # p.poly(idx) would remove all zeros + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/conj_ct.m b/octave_packages/control-2.3.52/@tfpoly/conj_ct.m new file mode 100644 index 0000000..a60139f --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/conj_ct.m @@ -0,0 +1,30 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Conjugate of continuous-time polynomial. Replace s by -s. +## For internal use only. + +## Author: Lukas Reichlin +## Created: May 2012 +## Version: 0.1 + +function p = conj_ct (p) + + p.poly(2:2:end) = -p.poly(2:2:end); + +endfunction diff --git a/octave_packages/control-2.3.52/@tfpoly/conj_dt.m b/octave_packages/control-2.3.52/@tfpoly/conj_dt.m new file mode 100644 index 0000000..4bb7069 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/conj_dt.m @@ -0,0 +1,30 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Conjugate of discrete-time polynomial. Replace z by 1/z. +## For internal use only. + +## Author: Lukas Reichlin +## Created: May 2012 +## Version: 0.1 + +function p = conj_dt (p) + + p.poly = fliplr (p.poly); + +endfunction diff --git a/octave_packages/control-2.3.52/@tfpoly/display.m b/octave_packages/control-2.3.52/@tfpoly/display.m new file mode 100644 index 0000000..0bd39a7 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/display.m @@ -0,0 +1,29 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Display routine. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function display (p) + + tfpoly2str (p, "s") + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/eq.m b/octave_packages/control-2.3.52/@tfpoly/eq.m new file mode 100644 index 0000000..a3f90c5 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/eq.m @@ -0,0 +1,32 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Test for equal coefficients. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function bool = eq (a, b) + + a = tfpoly (a); + b = tfpoly (b); + + bool = (length (a) == length (b)) && all (a.poly == b.poly); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/get.m b/octave_packages/control-2.3.52/@tfpoly/get.m new file mode 100644 index 0000000..694c086 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/get.m @@ -0,0 +1,29 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Return coefficients as a row vector. For internal use only. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function coeffs = get (p) + + coeffs = p.poly; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/length.m b/octave_packages/control-2.3.52/@tfpoly/length.m new file mode 100644 index 0000000..41e12b9 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/length.m @@ -0,0 +1,29 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Number of coefficients. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function l = length (p) + + l = length (p.poly); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/minus.m b/octave_packages/control-2.3.52/@tfpoly/minus.m new file mode 100644 index 0000000..258d256 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/minus.m @@ -0,0 +1,41 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Subtraction of two polynomials. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function a = minus (a, b) + + if (! isa (a, "tfpoly")) + a = tfpoly (a); + endif + + if (! isa (b, "tfpoly")) + b = tfpoly (b); + endif + + [a, b] = __make_equally_long__ (a, b); + + a.poly = a.poly - b.poly; + + a = __remove_leading_zeros__ (a); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/mpower.m b/octave_packages/control-2.3.52/@tfpoly/mpower.m new file mode 100644 index 0000000..c62dd99 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/mpower.m @@ -0,0 +1,48 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Power of a polynomial. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function p = mpower (a, b) + + if (! isa (b, "double") && ! is_real_scalar (b)) + error ("tfpoly: mpower: power must be a natural number"); + endif + + c = uint64 (b); + + if (c != b) + error ("tfpoly: mpower: power must be a positive integer"); + endif + + if (c == 0) + p = tfpoly (1); + return; + endif + + p = a; + + for k = 1 : (c-1) + p.poly = conv (p.poly, a.poly); + endfor + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/mtimes.m b/octave_packages/control-2.3.52/@tfpoly/mtimes.m new file mode 100644 index 0000000..0e9f4c9 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/mtimes.m @@ -0,0 +1,37 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Multiplication of two polynomials. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function a = mtimes (a, b) + + if (! isa (a, "tfpoly")) + a = tfpoly (a); + endif + + if (! isa (b, "tfpoly")) + b = tfpoly (b); + endif + + a.poly = conv (a.poly, b.poly); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/ne.m b/octave_packages/control-2.3.52/@tfpoly/ne.m new file mode 100644 index 0000000..e9e1ddb --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/ne.m @@ -0,0 +1,32 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Return true if polynomials are not equal. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function bool = ne (a, b) + + a = tfpoly (a); + b = tfpoly (b); + + bool = (length (a) != length (b)) || any (a.poly != b.poly); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/numel.m b/octave_packages/control-2.3.52/@tfpoly/numel.m new file mode 100644 index 0000000..ebcbb4b --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/numel.m @@ -0,0 +1,29 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Number of coefficients. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function n = numel (p) + + n = numel (p.poly); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/plus.m b/octave_packages/control-2.3.52/@tfpoly/plus.m new file mode 100644 index 0000000..87ebd05 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/plus.m @@ -0,0 +1,41 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Addition of two polynomials. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function a = plus (a, b) + + if (! isa (a, "tfpoly")) + a = tfpoly (a); + endif + + if (! isa (b, "tfpoly")) + b = tfpoly (b); + endif + + [a, b] = __make_equally_long__ (a, b); + + a.poly = a.poly + b.poly; + + a = __remove_leading_zeros__ (a); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/roots.m b/octave_packages/control-2.3.52/@tfpoly/roots.m new file mode 100644 index 0000000..4ebaf28 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/roots.m @@ -0,0 +1,29 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Compute the roots of a TFPOLY object. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function r = roots (p) + + r = roots (p.poly); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/subsref.m b/octave_packages/control-2.3.52/@tfpoly/subsref.m new file mode 100644 index 0000000..bdc9add --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/subsref.m @@ -0,0 +1,45 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Evaluate polynomial. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function b = subsref (a, s) + + if (isempty (s)) + error ("tfpoly: missing index"); + endif + + switch (s(1).type) + case "()" + idx = s(1).subs; + if (numel (idx) == 1) + b = polyval (a.poly, idx{1}); + else + error ("tfpoly: need exactly one index"); + endif + + otherwise + error ("tfpoly: invalid subscript type"); + + endswitch + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/tfpoly.m b/octave_packages/control-2.3.52/@tfpoly/tfpoly.m new file mode 100644 index 0000000..0bcd464 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/tfpoly.m @@ -0,0 +1,51 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Class constructor. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function p = tfpoly (a) + + superiorto ("double"); + + switch (nargin) + case 0 + p = struct ("poly", []); + p = class (p, "tfpoly"); + + case 1 + if (isa (a, "tfpoly")) + p = a; + return; + elseif (is_real_vector (a)) + p.poly = reshape (a, 1, []); + p = class (p, "tfpoly"); + p = __remove_leading_zeros__ (p); + else + error ("tfpoly: argument must be a real vector"); + endif + + otherwise + print_usage (); + + endswitch + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/tfpoly2str.m b/octave_packages/control-2.3.52/@tfpoly/tfpoly2str.m new file mode 100644 index 0000000..b63852a --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/tfpoly2str.m @@ -0,0 +1,113 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{str} =} tfpoly2str (@var{p}) +## @deftypefnx {Function File} {@var{str} =} tfpoly2str (@var{p}, @var{tfvar}) +## Return the string of a polynomial with string @var{tfvar} as variable. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function str = tfpoly2str (p, tfvar = "x") + + str = ""; + + lp = numel (p.poly); + + if (lp > 0) + ## first element (highest order) + a = p.poly(1); + + if (a < 0) + cs = "-"; + else + cs = ""; + endif + + if (lp == 1) + str = [cs, num2str(abs (a), 4)]; + else + if (abs (a) == 1) + str = [cs, __variable__(tfvar, lp-1)]; + else + str = [cs, __coefficient__(a), " ", __variable__(tfvar, lp-1)]; + endif + endif + + if (lp > 1) + ## elements in the middle + for k = 2 : lp-1 + a = p.poly(k); + + if (a != 0) + if (a < 0) + cs = " - "; + else + cs = " + "; + endif + + if (abs (a) == 1) + str = [str, cs, __variable__(tfvar, lp-k)]; + else + str = [str, cs, __coefficient__(a), " ", __variable__(tfvar, lp-k)]; + endif + endif + endfor + + ## last element (lowest order) + a = p.poly(lp); + + if (a != 0) + if (a < 0) + cs = " - "; + else + cs = " + "; + endif + + str = [str, cs, num2str(abs (a), 4)]; + endif + endif + endif + +endfunction + + +function str = __coefficient__ (a) + + b = abs (a); + + if (b == 1) + str = ""; + else + str = num2str (b, 4); + endif + +endfunction + + +function str = __variable__ (tfvar, n) + + if (n == 1) + str = tfvar; + else + str = [tfvar, "^", num2str(n)]; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/@tfpoly/uminus.m b/octave_packages/control-2.3.52/@tfpoly/uminus.m new file mode 100644 index 0000000..59e1ab9 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/uminus.m @@ -0,0 +1,29 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Unitary minus operator. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function a = uminus (a) + + a.poly = -a.poly; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/@tfpoly/uplus.m b/octave_packages/control-2.3.52/@tfpoly/uplus.m new file mode 100644 index 0000000..5611623 --- /dev/null +++ b/octave_packages/control-2.3.52/@tfpoly/uplus.m @@ -0,0 +1,29 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Unitary plus operator. For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function a = uplus (a) + + a.poly = +a.poly; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/Anderson.m b/octave_packages/control-2.3.52/Anderson.m new file mode 100644 index 0000000..0811cc8 --- /dev/null +++ b/octave_packages/control-2.3.52/Anderson.m @@ -0,0 +1,80 @@ +%% -*- texinfo -*- +%% Frequency-weighted coprime factorization controller reduction. + +% =============================================================================== +% Coprime Factorization Controller Reduction Lukas Reichlin December 2011 +% =============================================================================== +% Reference: Anderson, B.D.O.: Controller Reduction: Concepts and Approaches +% IEEE Transactions of Automatic Control, Vol. 34, No. 8, August 1989 +% =============================================================================== + +% Tabula Rasa +clear all, close all, clc + +% Plant +A = [ -0.161 -6.004 -0.58215 -9.9835 -0.40727 -3.982 0.0 0.0 + 1.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 + 0.0 1.0 0.0 0.0 0.0 0.0 0.0 0.0 + 0.0 0.0 1.0 0.0 0.0 0.0 0.0 0.0 + 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 + 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 + 0.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 + 0.0 0.0 0.0 0.0 0.0 0.0 1.0 0.0 ]; + +B = [ 1.0 + 0.0 + 0.0 + 0.0 + 0.0 + 0.0 + 0.0 + 0.0 ]; + +C = [ 0.0 0.0 6.4432e-3 2.3196e-3 7.1252e-2 1.0002 0.10455 0.99551 ]; + +G = ss (A, B, C); + +% LQG Design +H = [ 0.0 0.0 0.0 0.0 0.55 11.0 1.32 18.0 ]; + +q1 = 1e-6; +q2 = 100; % [100, 1000, 2000] + +Q = q1 * H.' * H; +R = 1; + +W = q2 * B * B.'; +V = 1; + +F = lqr (G, Q, R) +L = lqe (G, W, V) + +% Coprime Factorization using Balanced Truncation Approximation +figure (1) +for k = 8:-1:2 + Kr = cfconred (G, F, L, k); % 'method', 'bfsr-bta' + T = feedback (G*Kr); + step (T, 200) + hold on +endfor +hold off + +% Coprime Factorization using Singular Perturbation Approximation +figure (2) +for k = 8:-1:2 + Kr = cfconred (G, F, L, k, 'method', 'bfsr-spa'); + T = feedback (G*Kr); + step (T, 200) + hold on +endfor +hold off + +% Frequency-Weighted Coprime Factorization using BTA +figure (3) +for k = 8:-1:2 + Kr = fwcfconred (G, F, L, k); + T = feedback (G*Kr); + step (T, 300) + hold on +endfor +hold off diff --git a/octave_packages/control-2.3.52/BMWengine.m b/octave_packages/control-2.3.52/BMWengine.m new file mode 100644 index 0000000..0972283 --- /dev/null +++ b/octave_packages/control-2.3.52/BMWengine.m @@ -0,0 +1,122 @@ +## -*- texinfo -*- +## @deftypefn{Function File} {@var{sys} =} BMWengine () +## @deftypefnx{Function File} {@var{sys} =} BMWengine (@var{"scaled"}) +## @deftypefnx{Function File} {@var{sys} =} BMWengine (@var{"unscaled"}) +## Model of the BMW 4-cylinder engine at ETH Zurich's control laboratory. +## @example +## @group +## OPERATING POINT +## Drosselklappenstellung alpha_DK = 10.3 Grad +## Saugrohrdruck p_s = 0.48 bar +## Motordrehzahl n = 860 U/min +## Lambda-Messwert lambda = 1.000 +## Relativer Wandfilminhalt nu = 1 +## @end group +## @end example +## @example +## @group +## INPUTS +## U_1 Sollsignal Drosselklappenstellung [Grad] +## U_2 Relative Einspritzmenge [-] +## U_3 Zuendzeitpunkt [Grad KW] +## M_L Lastdrehmoment [Nm] +## @end group +## @end example +## @example +## @group +## STATES +## X_1 Drosselklappenstellung [Grad] +## X_2 Saugrohrdruck [bar] +## X_3 Motordrehzahl [U/min] +## X_4 Messwert Lamba-Sonde [-] +## X_5 Relativer Wandfilminhalt [-] +## @end group +## @end example +## @example +## @group +## OUTPUTS +## Y_1 Motordrehzahl [U/min] +## Y_2 Messwert Lambda-Sonde [-] +## @end group +## @end example +## @example +## @group +## SCALING +## U_1N, X_1N 1 Grad +## U_2N, X_4N, X_5N, Y_2N 0.05 +## U_3N 1.6 Grad KW +## X_2N 0.05 bar +## X_3N, Y_1N 200 U/min +## @end group +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: January 2010 +## Version: 0.1.1 + +## TODO: translate German terminology + +function sys = BMWengine (flg = "scaled") + + if (nargin > 1) + print_usage (); + endif + + switch (tolower (flg)) + case "unscaled" ## Linearisiertes Modell, nicht skaliert + + Apu = [ -40.0000 0 0 0 0 + 0.1683 -2.9471 -0.0016 0 0 + 26.6088 920.3932 -0.1756 0 259.1700 + -0.5852 14.1941 0.0061 -5.7000 -5.7000 + 0.6600 -1.1732 -0.0052 0 -15.0000 ]; + + Bpu = [ 40.0000 0 0 + 0 0 0 + 0 181.4190 1.5646 + 0 -3.9900 0 + 0 4.5000 0 ]; + + Bdpu = [ 0 + 0 + -15.9000 + 0 + 0 ]; + + Cpu = [ 0 0 1 0 0 + 0 0 0 1 0 ]; + + sys = ss (Apu, [Bpu, Bdpu], Cpu); + + case "scaled" ## Skaliertes Zustandsraummodell + + Ap = [ -40.0000 0 0 0 0 + 3.3659 -2.9471 -6.5157 0 0 + 0.1330 0.2301 -0.1756 0 0.0648 + -11.7043 14.1941 24.3930 -5.7000 -5.7000 + 13.2003 -1.1732 -20.9844 0 -15.0000 ]; + + Bp = [ 40.0000 0 0 + 0 0 0 + 0 0.0454 0.0125 + 0 -3.9900 0 + 0 4.5000 0 ]; + + Bdp = [ 0 + 0 + -1.5900 + 0 + 0 ]; + + Cp = [ 0 0 1 0 0 + 0 0 0 1 0 ]; + + sys = ss (Ap, [Bp, Bdp], Cp, [], "scaled", true); + + otherwise + print_usage (); + + endswitch + +endfunction diff --git a/octave_packages/control-2.3.52/Boeing707.m b/octave_packages/control-2.3.52/Boeing707.m new file mode 100644 index 0000000..ea5cda5 --- /dev/null +++ b/octave_packages/control-2.3.52/Boeing707.m @@ -0,0 +1,69 @@ +## Copyright (C) 1997, 2000, 2004, 2005, 2006, 2007 Kai P. Mueller +## +## +## This program is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} Boeing707 () +## Creates a linearized state-space model of a Boeing 707-321 aircraft +## at @var{v}=80 m/s +## @iftex +## @tex +## ($M = 0.26$, $G_{a0} = -3^{\\circ}$, ${\\alpha}_0 = 4^{\\circ}$, ${\\kappa}= 50^{\\circ}$). +## @end tex +## @end iftex +## @ifnottex +## (@var{M} = 0.26, @var{Ga0} = -3 deg, @var{alpha0} = 4 deg, @var{kappa} = 50 deg). +## @end ifnottex +## +## System inputs: (1) thrust and (2) elevator angle. +## +## System outputs: (1) airspeed and (2) pitch angle. +## +## @strong{Reference}: R. Brockhaus: @cite{Flugregelung} (Flight +## Control), Springer, 1994. +## @end deftypefn + +## Author: Kai P. Mueller +## Created: September 28, 1997 + +function outsys = Boeing707 () + + if (nargin != 0) + print_usage (); + endif + + a = [-0.46E-01, 0.10681415316, 0.0, -0.17121680433; + -0.1675901504661613, -0.515, 1.0, 0.6420630320636088E-02; + 0.1543104215347786, -0.547945, -0.906, -0.1521689385990753E-02; + 0.0, 0.0, 1.0, 0.0]; + + b = [0.1602300107479095, 0.2111848453E-02; + 0.8196877780963616E-02, -0.3025E-01; + 0.9173594317692437E-01, -0.75283075; + 0.0, 0.0]; + + c = [1.0, 0.0, 0.0, 0.0; + 0.0, 0.0, 0.0, 1.0]; + + d = zeros (2, 2); + + inam = {"thrust"; "rudder"}; + onam = {"speed"; "pitch"}; + ## snam = {"x1"; "x2"; "x3"; "x4"}; + + outsys = ss (a, b, c, d, "inname", inam, "outname", onam); + +endfunction diff --git a/octave_packages/control-2.3.52/MDSSystem.m b/octave_packages/control-2.3.52/MDSSystem.m new file mode 100644 index 0000000..92142be --- /dev/null +++ b/octave_packages/control-2.3.52/MDSSystem.m @@ -0,0 +1,162 @@ +%% -*- texinfo -*- +%% Robust control of a mass-damper-spring system. +%% Type @code{which MDSSystem} to locate, +%% @code{edit MDSSystem} to open and simply +%% @code{MDSSystem} to run the example file. + +% =============================================================================== +% Robust Control of a Mass-Damper-Spring System Lukas Reichlin August 2011 +% =============================================================================== +% Reference: Gu, D.W., Petkov, P.Hr. and Konstantinov, M.M. +% Robust Control Design with Matlab, Springer 2005 +% =============================================================================== + +% Tabula Rasa +clear all, close all, clc + +% =============================================================================== +% System Model +% =============================================================================== +% +---------------+ +% | d_m 0 0 | +% +-----| 0 d_c 0 |<----+ +% u_m | | 0 0 d_k | | y_m +% u_c | +---------------+ | y_c +% u_k | | y_k +% | +---------------+ | +% +---->| |-----+ +% | G_nom | +% u ----->| |-----> y +% +---------------+ + +% Nominal Values +m_nom = 3; % mass +c_nom = 1; % damping coefficient +k_nom = 2; % spring stiffness + +% Perturbations +p_m = 0.4; % 40% uncertainty in the mass +p_c = 0.2; % 20% uncertainty in the damping coefficient +p_k = 0.3; % 30% uncertainty in the spring stiffness + +% State-Space Representation +A = [ 0, 1 + -k_nom/m_nom, -c_nom/m_nom ]; + +B1 = [ 0, 0, 0 + -p_m, -p_c/m_nom, -p_k/m_nom ]; + +B2 = [ 0 + 1/m_nom ]; + +C1 = [ -k_nom/m_nom, -c_nom/m_nom + 0, c_nom + k_nom, 0 ]; + +C2 = [ 1, 0 ]; + +D11 = [ -p_m, -p_c/m_nom, -p_k/m_nom + 0, 0, 0 + 0, 0, 0 ]; + +D12 = [ 1/m_nom + 0 + 0 ]; + +D21 = [ 0, 0, 0 ]; + +D22 = [ 0 ]; + +inname = {'u_m', 'u_c', 'u_k', 'u'}; % input names +outname = {'y_m', 'y_c', 'y_k', 'y'}; % output names + +G_nom = ss (A, [B1, B2], [C1; C2], [D11, D12; D21, D22], ... + 'inputname', inname, 'outputname', outname); + +G = G_nom(4, 4); % extract output y and input u + + +% =============================================================================== +% Frequency Analysis of Uncertain System +% =============================================================================== + +% Uncertainties: -1 <= delta_m, delta_c, delta_k <= 1 +[delta_m, delta_c, delta_k] = ndgrid ([-1, 0, 1], [-1, 0, 1], [-1, 0, 1]); + +% Bode Plots of Perturbed Plants +w = logspace (-1, 1, 100); % frequency vector +figure (1) + +for k = 1 : numel (delta_m) + Delta = diag ([delta_m(k), delta_c(k), delta_k(k)]); + G_per = lft (Delta, G_nom); + bode (G_per, w) + subplot (2, 1, 1) + hold on + subplot (2, 1, 2) + hold on +endfor + + +% =============================================================================== +% Mixed Sensitivity H-infinity Controller Design (S over KS Method) +% =============================================================================== +% +-------+ +% +--------------------->| W_p |----------> e_p +% | +-------+ +% | +-------+ +% | +---->| W_u |----------> e_u +% | | +-------+ +% | | +---------+ +% | | ->| |-> +% r + e | +-------+ u | | G_nom | +% ----->(+)---+-->| K |----+--->| |----+----> y +% ^ - +-------+ +---------+ | +% | | +% +-----------------------------------------+ + +% Weighting Functions +s = tf ('s'); % transfer function variable +W_p = 0.95 * (s^2 + 1.8*s + 10) / (s^2 + 8.0*s + 0.01); % performance weighting +W_u = 10^-2; % control weighting + +% Synthesis +K_mix = mixsyn (G, W_p, W_u); % mixed-sensitivity H-infinity synthesis + +% Interconnections +L_mix = G * K_mix; % open loop +T_mix = feedback (L_mix); % closed loop + +% Plotting +figure (2) +bode (K_mix) % bode plot + +figure (3) +step (T_mix, 10) % step response for 10 seconds + + +% =============================================================================== +% H-infinity Loop-Shaping Design (Normalized Coprime Factor Perturbations) +% =============================================================================== + +% Settings +W1 = 8 * (2*s + 1) / (0.9*s); % precompensator +W2 = 1; % postcompensator +factor = 1.1; % suboptimal controller + +% Synthesis +K_ncf = ncfsyn (G, W1, W2, factor); % positive feedback controller + +% Interconnections +K_ncf = -K_ncf; % negative feedback controller +L_ncf = G * K_ncf; % open loop +T_ncf = feedback (L_ncf); % closed loop + +% Plotting +figure (4) +bode (K_ncf) % bode plot + +figure (5) +step (T_ncf, 10) % step response for 10 seconds + +% =============================================================================== diff --git a/octave_packages/control-2.3.52/Madievski.m b/octave_packages/control-2.3.52/Madievski.m new file mode 100644 index 0000000..2bf4fbe --- /dev/null +++ b/octave_packages/control-2.3.52/Madievski.m @@ -0,0 +1,126 @@ +%% -*- texinfo -*- +%% Frequency-weighted controller reduction. + +% =============================================================================== +% Frequency Weighted Controller Reduction Lukas Reichlin December 2011 +% =============================================================================== +% Reference: Madievski, A.G. and Anderson, B.D.O. +% Sampled-Data Controller Reduction Procedure +% IEEE Transactions of Automatic Control +% Vol. 40, No. 11, November 1995 +% =============================================================================== + +% Tabula Rasa +clear all, close all, clc + +% Plant +Ap1 = [ 0.0 1.0 + 0.0 0.0 ]; + +Ap2 = [ -0.015 0.765 + -0.765 -0.015 ]; + +Ap3 = [ -0.028 1.410 + -1.410 -0.028 ]; + +Ap4 = [ -0.04 1.85 + -1.85 -0.04 ]; + +Ap = blkdiag (Ap1, Ap2, Ap3, Ap4); + +Bp = [ 0.026 + -0.251 + 0.033 + -0.886 + -4.017 + 0.145 + 3.604 + 0.280 ]; + +Cp = [ -0.996 -0.105 0.261 0.009 -0.001 -0.043 0.002 -0.026 ]; + +Dp = [ 0.0 ]; + +P = ss (Ap, Bp, Cp, Dp); + +% Controller +Ac = [ -0.4077 0.9741 0.1073 0.0131 0.0023 -0.0186 -0.0003 -0.0098 + -0.0977 -0.1750 0.0215 -0.0896 -0.0260 0.0057 0.0109 -0.0105 + 0.0011 0.0218 -0.0148 0.7769 0.0034 -0.0013 -0.0014 0.0011 + -0.0361 -0.5853 -0.7701 -0.3341 -0.0915 0.0334 0.0378 -0.0290 + -0.1716 -2.6546 -0.0210 -1.4467 -0.4428 1.5611 0.1715 -0.1318 + -0.0020 0.0950 0.0029 0.0523 -1.3950 -0.0338 -0.0062 0.0045 + 0.1607 2.3824 0.0170 1.2979 0.3721 -0.1353 -0.1938 1.9685 + -0.0006 0.1837 0.0048 0.1010 0.0289 -0.0111 -1.8619 -0.0311 ]; + +Bc = [ -0.4105 + -0.0868 + -0.0004 + 0.0036 + 0.0081 + -0.0085 + -0.0004 + -0.0132 ]; + +Cc = [ -0.0447 -0.6611 -0.0047 -0.3601 -0.1033 0.0375 0.0427 -0.0329 ]; + +Dc = [ 0.0 ]; + +K = ss (Ac, Bc, Cc, Dc); + +% Controller Reduction +Kr4 = spaconred (P, K, 4, 'feedback', '-') +Kr2 = spaconred (P, K, 2, 'feedback', '-') + +% Open Loop +L = P * K; +Lr4 = P * Kr4; +Lr2 = P * Kr2; + +% Closed Loop +T = feedback (L); +Tr4 = feedback (Lr4); +Tr2 = feedback (Lr2); + +% Frequency Range +w = {1e-2, 1e1}; + +% Bode Plot of Controller +[mag, pha, w] = bode (K, w); +[magr4, phar4, wr4] = bode (Kr4, w); +[magr2, phar2, wr2] = bode (Kr2, w); + +mag = 20 * log10 (mag); +magr4 = 20 * log10 (magr4); +magr2 = 20 * log10 (magr2); + +figure (1) +subplot (2, 1, 1) +semilogx (w, mag, wr4, magr4, wr2, magr2) +axis ('tight') +ylim (__axis_margin__ (ylim)) +grid ('on') +title ('Bode Diagrams of K and Kr') +ylabel ('Magnitude [dB]') + +subplot (2, 1, 2) +semilogx (w, pha, wr4, phar4, wr2, phar2) +axis ('tight') +ylim (__axis_margin__ (ylim)) +grid ('on') +xlabel ('Frequency [rad/s]') +ylabel ('Phase [deg]') +legend ('K (8 states)', 'Kr (4 states)', 'Kr (2 states)', 'location', 'southwest') + +% Step Response of Closed Loop +[y, t] = step (T, 100); +[yr4, tr4] = step (Tr4, 100); +[yr2, tr2] = step (Tr2, 100); + +figure (2) +plot (t, y, tr4, yr4, tr2, yr2) +grid ('on') +title ('Step Response of Closed Loop') +xlabel ('Time [s]') +ylabel ('Output [-]') +legend ('K (8 states)', 'Kr (4 states)', 'Kr (2 states)', 'Location', 'SouthEast') diff --git a/octave_packages/control-2.3.52/WestlandLynx.m b/octave_packages/control-2.3.52/WestlandLynx.m new file mode 100644 index 0000000..d200301 --- /dev/null +++ b/octave_packages/control-2.3.52/WestlandLynx.m @@ -0,0 +1,103 @@ +## -*- texinfo -*- +## @deftypefn{Function File} {@var{sys} =} WestlandLynx () +## Model of the Westland Lynx Helicopter about hover. +## @example +## @group +## INPUTS +## main rotor collective +## longitudinal cyclic +## lateral cyclic +## tail rotor collective +## @end group +## @end example +## @example +## @group +## STATES +## pitch attitude theta [rad] +## roll attitude phi [rad] +## roll rate (body-axis) p [rad/s] +## pitch rate (body-axis) q [rad/s] +## yaw rate xi [rad/s] +## forward velocity v_x [ft/s] +## lateral velocity v_y [ft/s] +## vertical velocity v_z [ft/s] +## @end group +## @end example +## @example +## @group +## OUTPUTS +## heave velocity H_dot [ft/s] +## pitch attitude theta [rad] +## roll attitude phi [rad] +## heading rate psi_dot [rad/s] +## roll rate p [rad/s] +## pitch rate q [rad/s] +## @end group +## @end example +## @example +## @group +## Reference: +## Skogestad, S. and Postlethwaite I. +## Multivariable Feedback Control: Analysis and Design +## Second Edition +## Wiley 2005 +## http://www.nt.ntnu.no/users/skoge/book/2nd_edition/matlab_m/matfiles.html +## @end group +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: January 2010 +## Version: 0.1 + +function sys = WestlandLynx () + + if (nargin) + print_usage (); + endif + + a01 = [ 0 0 0 0.99857378005981; + 0 0 1.00000000000000 -0.00318221934140; + 0 0 -11.57049560546880 -2.54463768005371; + 0 0 0.43935656547546 -1.99818229675293; + 0 0 -2.04089546203613 -0.45899915695190; + -32.10360717773440 0 -0.50335502624512 2.29785919189453; + 0.10216116905212 32.05783081054690 -2.34721755981445 -0.50361156463623; + -1.91097259521484 1.71382904052734 -0.00400543212891 -0.05741119384766]; + + a02 = [ 0.05338427424431 0 0 0; + 0.05952465534210 0 0 0; + -0.06360262632370 0.10678052902222 -0.09491866827011 0.00710757449269; + 0 0.01665188372135 0.01846204698086 -0.00118747074157; + -0.73502779006958 0.01925575733185 -0.00459562242031 0.00212036073208; + 0 -0.02121581137180 -0.02116791903973 0.01581159234047; + 0.83494758605957 0.02122657001019 -0.03787973523140 0.00035400385968; + 0 0.01398963481188 -0.00090675335377 -0.29051351547241]; + + a0 = [a01 a02]; + + b0 = [ 0 0 0 0; + 0 0 0 0; + 0.12433505058289 0.08278584480286 -2.75247764587402 -0.01788876950741; + -0.03635892271996 0.47509527206421 0.01429074257612 0; + 0.30449151992798 0.01495801657438 -0.49651837348938 -0.20674192905426; + 0.28773546218872 -0.54450607299805 -0.01637935638428 0; + -0.01907348632812 0.01636743545532 -0.54453611373901 0.23484230041504; + -4.82063293457031 -0.00038146972656 0 0]; + + c0 = [ 0 0 0 0 0 0.0595 0.05329 -0.9968; + 1.0 0 0 0 0 0 0 0; + 0 1.0 0 0 0 0 0 0; + 0 0 0 -0.05348 1.0 0 0 0; + 0 0 1.0 0 0 0 0 0; + 0 0 0 1.0 0 0 0 0]; + + d0 = zeros (6, 4); + + inname = {"main_coll", "long_cyc", "lat_cyc", "tail_coll"}; + stname = {"theta", "phi", "p", "q", "xi", "v_x", "v_y", "v_z"}; + outname = {"H_dot", "theta", "phi", "psi_dot", "p", "q"}; + + sys = ss (a0, b0, c0, d0, "inname", inname, "stname", stname, "outname", outname); + +endfunction diff --git a/octave_packages/control-2.3.52/__adjust_frd_data__.m b/octave_packages/control-2.3.52/__adjust_frd_data__.m new file mode 100644 index 0000000..bc1b5e6 --- /dev/null +++ b/octave_packages/control-2.3.52/__adjust_frd_data__.m @@ -0,0 +1,51 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Common code for adjusting FRD model data. +## Used by @frd/frd.m and @frd/__set__.m + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function [H, w] = __adjust_frd_data__ (H, w); + + w = reshape (w, [], 1); + lw = length (w); + + if (ndims (H) != 3 && ! isempty (H)) + if (isscalar (H)) + H = reshape (H, 1, 1, []); + if (lw > 1) + H = repmat (H, [1, 1, lw]); # needed for "frd1 + scalar2" or "scalar1 * frd2) + endif + elseif (isvector (H) && length (H) == lw) # SISO system (H is a vector) + H = reshape (H, 1, 1, []); + elseif (ismatrix (H)) + H = reshape (H, rows (H), []); + if (lw > 1) + H = repmat (H, [1, 1, lw]); # needed for "frd1 + matrix2" or "matrix1 * frd2) + endif + else + error ("frd: first argument H invalid"); + endif + elseif (isempty (H)) + H = zeros (0, 0, 0); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/__adjust_labels__.m b/octave_packages/control-2.3.52/__adjust_labels__.m new file mode 100644 index 0000000..8367bcd --- /dev/null +++ b/octave_packages/control-2.3.52/__adjust_labels__.m @@ -0,0 +1,38 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Check whether a cell contains the required number of strings. +## Used by set and __set__. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function name = __adjust_labels__ (name, req_len) + + if (iscell (name)) + name = reshape (name, [], 1); + else # catch the siso case, + name = {name}; # e.g. sys = set (sys, "inname", "u_1") + endif + + if (! iscellstr (name) || numel (name) != req_len) + error ("lti: set: cell must contain %d strings", req_len); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/__adjust_ss_data__.m b/octave_packages/control-2.3.52/__adjust_ss_data__.m new file mode 100644 index 0000000..9beff0c --- /dev/null +++ b/octave_packages/control-2.3.52/__adjust_ss_data__.m @@ -0,0 +1,48 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Common code for adjusting SS model data. +## Used by @ss/ss.m, others possibly follow. + +## Author: Lukas Reichlin +## Created: October 2010 +## Version: 0.1 + +function [a, b, c, d, tsam] = __adjust_ss_data__ (a, b, c, d, tsam); + + if (isempty (a)) # static system + a = []; # avoid [](nx0) or [](0xn) + tsam = -2; + endif + + if (isempty (d)) + if (isempty (c)) # ss (a, b), ss (a, b, [], [], ...) + c = eye (size (a)); + d = zeros (rows (a), columns (b)); + else # ss (a, b, c), ss (a, b, c, [], ...) + d = zeros (rows (c), columns (b)); + endif + endif + + if (isempty (b) && isempty (c)) # sys = ss ([], [], [], d) + b = zeros (0, columns (d)); + c = zeros (rows(d), 0); + tsam = -2; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/__axis_limits__.m b/octave_packages/control-2.3.52/__axis_limits__.m new file mode 100644 index 0000000..cd3530e --- /dev/null +++ b/octave_packages/control-2.3.52/__axis_limits__.m @@ -0,0 +1,71 @@ +## Copyright (C) 1998, 2000, 2004, 2005, 2007 +## Auburn University. All rights reserved. +## +## +## This program is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __axis_limits__ (@var{axdata}) +## Determine axis limits for 2-D data (column vectors); leaves a 10% +## margin around the plots. +## Inserts margins of +/- 0.1 if data is one-dimensional +## (or a single point). +## +## @strong{Input} +## @table @var +## @item axdata +## @var{n} by 2 matrix of data [@var{x}, @var{y}]. +## @end table +## +## @strong{Output} +## @table @var +## @item axvec +## Vector of axis limits appropriate for call to @command{axis} function. +## @end table +## @end deftypefn + +function axvec = __axis_limits__ (axdata) + + if (nargin < 1 || isempty (axdata)) + axdata = 0; + endif + + ## compute axis limits + minv = min (axdata); + maxv = max (axdata); + delv = (maxv-minv)/2; # breadth of the plot + midv = (minv + maxv)/2; # midpoint of the plot + axmid = [midv(1), midv(1), midv(2), midv(2)]; + axdel = [-0.1, 0.1, -0.1, 0.1]; # default plot width (if less than 2-d data) + if (max (delv) == 0) + if (midv(1) != 0) + axdel(1:2) = [-0.1*midv(1), 0.1*midv(1)]; + endif + if (midv(2) != 0) + axdel(3:4) = [-0.1*midv(2), 0.1*midv(2)]; + endif + else + ## they're at least one-dimensional + tolv = max(1e-8, 1e-8*abs(midv)); + if (abs (delv(1)) >= tolv(1)) + axdel(1:2) = 1.1*[-delv(1),delv(1)]; + endif + if (abs (delv(2)) >= tolv(2)) + axdel(3:4) = 1.1*[-delv(2),delv(2)]; + endif + endif + axvec = axmid + axdel; + +endfunction diff --git a/octave_packages/control-2.3.52/__axis_margin__.m b/octave_packages/control-2.3.52/__axis_margin__.m new file mode 100644 index 0000000..a967782 --- /dev/null +++ b/octave_packages/control-2.3.52/__axis_margin__.m @@ -0,0 +1,63 @@ +## Copyright (C) 1998, 2000, 2004, 2005, 2007 +## Auburn University. All rights reserved. +## +## +## This program is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __axis_margin__ (@var{axdata}) +## Determine axis limits for 2-D data (column vectors); leaves a 10% +## margin around the plots. +## Inserts margins of +/- 0.1 if data is one-dimensional +## (or a single point). +## +## @strong{Input} +## @table @var +## @item axdata +## @var{n} by 2 matrix of data [@var{x}, @var{y}]. +## @end table +## +## @strong{Output} +## @table @var +## @item axvec +## Vector of axis limits appropriate for call to @command{axis} function. +## @end table +## @end deftypefn + +function axvec = __axis_margin__ (axdata) + + ## compute axis limits + minv = axdata(1); + maxv = axdata(2); + delv = (maxv-minv)/2; # breadth of the plot + midv = (minv + maxv)/2; # midpoint of the plot + axmid = [midv, midv]; + axdel = [-0.1, 0.1]; # default plot width (if less than 2-d data) + + if (delv == 0) + if (midv != 0) + axdel = [-0.1*midv, 0.1*midv]; + endif + else + ## they're at least one-dimensional + tolv = max(1e-8, 1e-8*abs(midv)); + if (abs (delv) >= tolv) + axdel = 1.1*[-delv,delv]; + endif + endif + + axvec = axmid + axdel; + +endfunction diff --git a/octave_packages/control-2.3.52/__conred_check_feedback_sign__.m b/octave_packages/control-2.3.52/__conred_check_feedback_sign__.m new file mode 100644 index 0000000..80f62bb --- /dev/null +++ b/octave_packages/control-2.3.52/__conred_check_feedback_sign__.m @@ -0,0 +1,40 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## check the feedback sign. + +## Author: Lukas Reichlin +## Created: December 2011 +## Version: 0.1 + +function negfb = __conred_check_feedback_sign__ (fbsign, key = "feedback") + + if (! ischar (fbsign)) + error ("conred: key '%s' requires string value", key); + endif + + switch (fbsign) + case "+" + negfb = false; + case "-" + negfb = true; + otherwise + error ("conred: key '%s' has an invalid value", key); + endswitch + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/__conred_sb16ad__.m b/octave_packages/control-2.3.52/__conred_sb16ad__.m new file mode 100644 index 0000000..529f525 --- /dev/null +++ b/octave_packages/control-2.3.52/__conred_sb16ad__.m @@ -0,0 +1,191 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{Kr}, @var{info}] =} __conred_sb16ad__ (@var{method}, @dots{}) +## Backend for btaconred and spaconred. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: December 2011 +## Version: 0.1 + +function [Kr, info] = __conred_sb16ad__ (method, varargin) + + if (nargin < 3) + print_usage (); + endif + + if (method != "bta" && method != "spa") + error ("modred: invalid method"); + endif + + G = varargin{1}; + K = varargin{2}; + varargin = varargin(3:end); + + if (! isa (G, "lti")) + error ("%sconred: first argument must be an LTI system", method); + endif + + if (! isa (K, "lti")) + error ("%sconred: second argument must be an LTI system", method); + endif + + if (nargin > 3) # *conred (G, K, ...) + if (is_real_scalar (varargin{1})) # *conred (G, K, nr) + varargin = horzcat (varargin(2:end), {"order"}, varargin(1)); + endif + if (isstruct (varargin{1})) # *conred (G, K, opt, ...), *conred (G, K, nr, opt, ...) + varargin = horzcat (__opt2cell__ (varargin{1}), varargin(2:end)); + endif + ## order placed at the end such that nr from *conred (G, K, nr, ...) + ## and *conred (G, K, nr, opt, ...) overrides possible nr's from + ## key/value-pairs and inside opt struct (later keys override former keys, + ## nr > key/value > opt) + endif + + nkv = numel (varargin); # number of keys and values + + if (rem (nkv, 2)) + error ("%sconred: keys and values must come in pairs", method); + endif + + [a, b, c, d, tsam, scaled] = ssdata (G); + [ac, bc, cc, dc, tsamc, scaledc] = ssdata (K); + [p, m] = size (G); + [pc, mc] = size (K); + dt = isdt (G); + + if (p != mc || m != pc) + error ("%sconred: dimensions of controller (%dx%d) and plant (%dx%d) don't match", \ + method, pc, mc, p, c); + endif + + + ## default arguments + alpha = __modred_default_alpha__ (dt); + tol1 = 0.0; + tol2 = 0.0; + jobc = jobo = 0; + bf = true; # balancing-free + weight = 3; + equil = scaled && scaledc; + ordsel = 1; + ncr = 0; + negfb = false; # positive feedback controller + + + ## handle keys and values + for k = 1 : 2 : nkv + key = lower (varargin{k}); + val = varargin{k+1}; + switch (key) + case "weight" + switch (lower (val(1))) + case "n" # none + weight = 0; + case {"l", "o"} # left, output + weight = 1; + case {"r", "i"} # right, input + weight = 2; + case {"b", "p"} # both, performance + weight = 3; + otherwise + error ("%sconred: '%s' is an invalid value for key weight", method, val); + endswitch + + case {"order", "ncr", "nr"} + [ncr, ordsel] = __modred_check_order__ (val, rows (ac)); + + case "tol1" + tol1 = __modred_check_tol__ (val, "tol1"); + + case "tol2" + tol2 = __modred_check_tol__ (val, "tol2"); + + case "alpha" + alpha = __modred_check_alpha__ (val, dt); + + case "method" + switch (tolower (val)) + case "sr" + bf = false; + case "bfsr" + bf = true; + otherwise + error ("modred: '%s' is an invalid approach", val); + endswitch + + case {"jobc", "gram-ctrb"} + jobc = __modred_check_gram__ (val, "gram-ctrb"); + + case {"jobo", "gram-obsv"} + jobo = __modred_check_gram__ (val, "gram-obsv"); + + case {"equil", "equilibrate", "equilibration", "scale", "scaling"} + scaled = __modred_check_equil__ (val); + + case "feedback" + negfb = __conred_check_feedback_sign__ (val); + + otherwise + warning ("%sconred: invalid property name '%s' ignored", method, key); + endswitch + endfor + + + ## handle model reduction approach + if (method == "bta" && ! bf) # 'B': use the square-root Balance & Truncate method + jobmr = 0; + elseif (method == "bta" && bf) # 'F': use the balancing-free square-root Balance & Truncate method + jobmr = 1; + elseif (method == "spa" && ! bf) # 'S': use the square-root Singular Perturbation Approximation method + jobmr = 2; + elseif (method == "spa" && bf) # 'P': use the balancing-free square-root Singular Perturbation Approximation method + jobmr = 3; + else + error ("%smodred: invalid jobmr option"); # this should never happen + endif + + ## handle negative feedback controllers + if (negfb) + [ac, bc, cc, dc] = ssdata (-K); + endif + + + ## perform model order reduction + [acr, bcr, ccr, dcr, ncr, hsvc, ncs] = slsb16ad (a, b, c, d, dt, equil, ncr, ordsel, alpha, jobmr, \ + ac, bc, cc, dc, \ + weight, jobc, jobo, tol1, tol2); + + ## assemble reduced order controller + Kr = ss (acr, bcr, ccr, dcr, tsamc); + + ## handle negative feedback controllers + if (negfb) + Kr = -Kr; + endif + + ## assemble info struct + info = struct ("ncr", ncr, "ncs", ncs, "hsvc", hsvc); + +endfunction + + + + diff --git a/octave_packages/control-2.3.52/__dss2ss__.m b/octave_packages/control-2.3.52/__dss2ss__.m new file mode 100644 index 0000000..8b33c08 --- /dev/null +++ b/octave_packages/control-2.3.52/__dss2ss__.m @@ -0,0 +1,36 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Convert descriptor state-space system into regular state-space form. + +## Author: Lukas Reichlin +## Created: September 2011 +## Version: 0.1 + +function [a, b, c, d, e] = __dss2ss__ (a, b, c, d, e) + + if (isempty (e)) + return; + elseif (rcond (e) < eps) # check for singularity + error ("ss: dss2ss: descriptor matrice 'e' singular"); + else + [a, b, c, d] = slsb10jd (a, b, c, d, e); + e = []; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/__dss_bilin__.m b/octave_packages/control-2.3.52/__dss_bilin__.m new file mode 100644 index 0000000..fed00db --- /dev/null +++ b/octave_packages/control-2.3.52/__dss_bilin__.m @@ -0,0 +1,91 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## 1. Discrete -> continuous +## _ +## E = alpha*E + A +## _ +## A = beta (A - alpha*E) +## _ +## B = sqrt(2*alpha*beta) * B +## _ -1 +## C = sqrt(2*alpha*beta) * C * (alpha*E + A) * E +## _ -1 +## D = D - C * (alpha*E + A) * B +## +## +## 2. Continuous -> discrete +## _ +## E = beta*E - A +## _ +## A = alpha (beta*E + A) +## _ +## B = sqrt(2*alpha*beta) * B +## _ -1 +## C = sqrt(2*alpha*beta) * C * (beta*E - A) * E +## _ -1 +## D = D + C * (beta*E - A) * B + +## Special thanks to Andras Varga for the formulae. +## Author: Lukas Reichlin +## Created: October 2011 +## Version: 0.1 + +function [Ar, Br, Cr, Dr, Er] = __dss_bilin__ (A, B, C, D, E, beta, discrete) + + if (discrete) + EpA = E + A; + s2b = sqrt (2*beta); + if (rcond (EpA) < eps) + error ("d2c: E+A singular"); + endif + CiEpA = C / EpA; + + Er = EpA; + Ar = beta * (A - E); + Br = s2b * B; + Cr = s2b * CiEpA * E; + Dr = D - CiEpA * B; + + ## Er = E + A; + ## Ar = beta * (A - E); + ## Br = sqrt (2*beta) * B; + ## Cr = sqrt (2*beta) * C / (E + A) * E; + ## Dr = D - C / (E + A) * B; + else + bEmA = beta*E - A; + s2b = sqrt (2*beta); + if (rcond (bEmA) < eps) + error ("c2d: beta*E-A singular"); + endif + CibEmA = C / bEmA; + + Er = bEmA; + Ar = beta*E + A; + Br = s2b * B; + Cr = s2b * CibEmA * E; + Dr = D + CibEmA * B; + + ## Er = beta*E - A; + ## Ar = beta*E + A; + ## Br = sqrt (2*beta) * B; + ## Cr = sqrt (2*beta) * C / (beta*E - A) * E; + ## Dr = D + C / (beta*E - A) * B; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/__frd_dim__.m b/octave_packages/control-2.3.52/__frd_dim__.m new file mode 100644 index 0000000..5ae6b6f --- /dev/null +++ b/octave_packages/control-2.3.52/__frd_dim__.m @@ -0,0 +1,47 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Number of outputs and inputs of transfer function numerator and +## denominator. For internal use only. + +## Author: Lukas Reichlin +## Created: February 2010 +## Version: 0.1 + +function [p, m, l] = __frd_dim__ (H, w) + + if (! isnumeric (H)) + error ("frd: H must be a 3-dimensional numeric array"); + endif + + lw = length (w); + + if (! isempty (w) && (! is_real_vector (w) || any (w < 0) \ + || ! issorted (w) || w(1) > w(end) \ + || length (unique (w)) != lw)) + error ("frd: w must be a vector of positive real numbers in ascending order"); + endif + + [p, m, l] = size (H); + + if (l != lw) + error ("frd: H (%dx%dx%d) and w (%d) must have equal length", + p, m, l, lw); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/__frequency_response__.m b/octave_packages/control-2.3.52/__frequency_response__.m new file mode 100644 index 0000000..351ffbb --- /dev/null +++ b/octave_packages/control-2.3.52/__frequency_response__.m @@ -0,0 +1,55 @@ +## Copyright (C) 2009, 2010, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Return frequency response H and frequency vector w. +## If w is empty, it will be calculated by __frequency_vector__. + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.4 + +function [H, w] = __frequency_response__ (sys, w = [], mimoflag = 0, resptype = 0, wbounds = "std", cellflag = false) + + ## check arguments + if(! isa (sys, "lti")) + error ("frequency_response: first argument sys must be an LTI system"); + endif + + if (! mimoflag && ! issiso (sys)) + error ("frequency_response: require SISO system"); + endif + + if (isa (sys, "frd")) + if (! isempty (w)) + warning ("frequency_response: second argument w is ignored"); + endif + w = get (sys, "w"); + H = __freqresp__ (sys, [], resptype, cellflag); + elseif (isempty (w)) # find interesting frequency range w if not specified + w = __frequency_vector__ (sys, wbounds); + H = __freqresp__ (sys, w, resptype, cellflag); + elseif (iscell (w) && numel (w) == 2 && issample (w{1}) && issample (w{2})) + w = __frequency_vector__ (sys, wbounds, w{1}, w{2}); + H = __freqresp__ (sys, w, resptype, cellflag); + elseif (! is_real_vector (w)) + error ("frequency_response: second argument w must be a vector of frequencies"); + else + H = __freqresp__ (sys, w, resptype, cellflag); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/__frequency_vector__.m b/octave_packages/control-2.3.52/__frequency_vector__.m new file mode 100644 index 0000000..bb5163c --- /dev/null +++ b/octave_packages/control-2.3.52/__frequency_vector__.m @@ -0,0 +1,135 @@ +## Copyright (C) 1996, 2000, 2004, 2005, 2006, 2007 +## Auburn University. All rights reserved. +## +## +## This program is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{w} =} __frequency_vector__ (@var{sys}) +## Get default range of frequencies based on cutoff frequencies of system +## poles and zeros. +## Frequency range is the interval +## @iftex +## @tex +## $ [ 10^{w_{min}}, 10^{w_{max}} ] $ +## @end tex +## @end iftex +## @ifnottex +## [10^@var{wmin}, 10^@var{wmax}] +## @end ifnottex +## +## Used by @command{__frequency_response__} +## @end deftypefn + +## Adapted-By: Lukas Reichlin +## Date: October 2009 +## Version: 0.3 + +function w = __frequency_vector__ (sys, wbounds = "std", wmin, wmax) + + zer = zero (sys); + pol = pole (sys); + tsam = abs (get (sys, "tsam")); # tsam could be -1 + discrete = ! isct (sys); # static gains (tsam = -2) are assumed continuous + + ## make sure zer, pol are row vectors + pol = reshape (pol, 1, []); + zer = reshape (zer, 1, []); + + ## check for natural frequencies away from omega = 0 + if (discrete) + ## The 2nd conditions prevents log(0) in the next log command + iiz = find (abs(zer-1) > norm(zer)*eps && abs(zer) > norm(zer)*eps); + iip = find (abs(pol-1) > norm(pol)*eps && abs(pol) > norm(pol)*eps); + + ## avoid dividing empty matrices, it would work but looks nasty + if (! isempty (iiz)) + czer = log (zer(iiz))/tsam; + else + czer = []; + endif + + if (! isempty (iip)) + cpol = log (pol(iip))/tsam; + else + cpol = []; + endif + else + ## continuous + iip = find (abs(pol) > norm(pol)*eps); + iiz = find (abs(zer) > norm(zer)*eps); + + if (! isempty (zer)) + czer = zer(iiz); + else + czer = []; + endif + if (! isempty (pol)) + cpol = pol(iip); + else + cpol = []; + endif + endif + + if (isempty (iip) && isempty (iiz)) + ## no poles/zeros away from omega = 0; pick defaults + dec_min = 0; # -1 + dec_max = 2; # 3 + else + dec_min = floor (log10 (min (abs ([cpol, czer])))); + dec_max = ceil (log10 (max (abs ([cpol, czer])))); + endif + + ## expand to show the entirety of the "interesting" portion of the plot + switch (wbounds) + case "std" # standard + if (dec_min == dec_max) + dec_min -= 2; + dec_max += 2; + else + dec_min--; + dec_max++; + endif + case "ext" # extended (for nyquist) + if (any (abs (pol) < sqrt (eps))) # look for integrators + ## dec_min -= 0.5; + dec_max += 2; + else + dec_min -= 2; + dec_max += 2; + endif + otherwise + error ("frequency_range: second argument invalid"); + endswitch + + ## run discrete frequency all the way to pi + if (discrete) + dec_max = log10 (pi/tsam); + endif + + if (nargin == 4) # w = {wmin, wmax} + dec_min = log10 (wmin); + dec_max = log10 (wmax); + endif + + ## create frequency vector + zp = [abs(zer), abs(pol)]; + idx = find (zp > 10^dec_min & zp < 10^dec_max); + zp = zp(idx); + + w = logspace (dec_min, dec_max, 500); + w = unique ([w, zp]); # unique also sorts frequency vector + +endfunction diff --git a/octave_packages/control-2.3.52/__is_stable__.m b/octave_packages/control-2.3.52/__is_stable__.m new file mode 100644 index 0000000..3849c76 --- /dev/null +++ b/octave_packages/control-2.3.52/__is_stable__.m @@ -0,0 +1,33 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Determine whether all poles in a vector are stable. + +## Author: Lukas Reichlin +## Created: December 2010 +## Version: 0.1 + +function bool = __is_stable__ (pol, ct = true, tol = 0) + + if (ct) # continuous-time + bool = all (real (pol) < -tol*(1 + abs (pol))); + else # discrete-time + bool = all (abs (pol) < 1 - tol); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/__labels__.m b/octave_packages/control-2.3.52/__labels__.m new file mode 100644 index 0000000..e2db67b --- /dev/null +++ b/octave_packages/control-2.3.52/__labels__.m @@ -0,0 +1,38 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Return default labels if cell "name" contains only empty strings. +## If not, check whether individual strings of the cell "name" are +## empty and mark them with "?". Used by display routines. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function [name, n] = __labels__ (name, variable = "x") + + n = numel (name); + + if (n == 0 || isequal ("", name{:})) + name = strseq (variable, 1:n); + else + idx = cellfun (@isempty, name); + name(idx) = "?"; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/__modred_ab09id__.m b/octave_packages/control-2.3.52/__modred_ab09id__.m new file mode 100644 index 0000000..8d06ffa --- /dev/null +++ b/octave_packages/control-2.3.52/__modred_ab09id__.m @@ -0,0 +1,178 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{Gr}, @var{info}] =} __modred_ab09id__ (@var{method}, @dots{}) +## Backend for btamodred and spamodred. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function [Gr, info] = __modred_ab09id__ (method, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (method != "bta" && method != "spa") + error ("modred: invalid method"); + endif + + G = varargin{1}; + varargin = varargin(2:end); + + if (! isa (G, "lti")) + error ("%smodred: first argument must be an LTI system", method); + endif + + if (nargin > 2) # *modred (G, ...) + if (is_real_scalar (varargin{1})) # *modred (G, nr) + varargin = horzcat (varargin(2:end), {"order"}, varargin(1)); + endif + if (isstruct (varargin{1})) # *modred (G, opt, ...), *modred (G, nr, opt, ...) + varargin = horzcat (__opt2cell__ (varargin{1}), varargin(2:end)); + endif + ## order placed at the end such that nr from *modred (G, nr, ...) + ## and *modred (G, nr, opt, ...) overrides possible nr's from + ## key/value-pairs and inside opt struct (later keys override former keys, + ## nr > key/value > opt) + endif + + nkv = numel (varargin); # number of keys and values + + if (rem (nkv, 2)) + error ("%smodred: keys and values must come in pairs", method); + endif + + [a, b, c, d, tsam, scaled] = ssdata (G); + [p, m] = size (G); + dt = isdt (G); + + ## default arguments + alpha = __modred_default_alpha__ (dt); + av = bv = cv = dv = []; + jobv = 0; + aw = bw = cw = dw = []; + jobw = 0; + alphac = alphao = 0.0; + tol1 = 0.0; + tol2 = 0.0; + jobc = jobo = 0; + bf = true; # balancing-free + weight = 1; + equil = 0; + ordsel = 1; + nr = 0; + + ## handle keys and values + for k = 1 : 2 : nkv + key = lower (varargin{k}); + val = varargin{k+1}; + switch (key) + case {"left", "output", "v"} + [av, bv, cv, dv, jobv] = __modred_check_weight__ (val, dt, p, []); + + case {"right", "input", "w"} + [aw, bw, cw, dw, jobw] = __modred_check_weight__ (val, dt, [], m); + + case {"order", "n", "nr"} + [nr, ordsel] = __modred_check_order__ (val, rows (a)); + + case "tol1" + tol1 = __modred_check_tol__ (val, "tol1"); + + case "tol2" + tol2 = __modred_check_tol__ (val, "tol2"); + + case "alpha" + alpha = __modred_check_alpha__ (val, dt); + + case "method" + switch (tolower (val)) + case "sr" + bf = false; + case "bfsr" + bf = true; + otherwise + error ("modred: '%s' is an invalid approach", val); + endswitch + + case {"jobc", "gram-ctrb"} + jobc = __modred_check_gram__ (val, "gram-ctrb"); + + case {"jobo", "gram-obsv"} + jobo = __modred_check_gram__ (val, "gram-obsv"); + + case {"alphac", "alpha-ctrb"} + alphac = __modred_check_alpha_gram__ (val, "alpha-ctrb"); + + case {"alphao", "alpha-obsv"} + alphao = __modred_check_alpha_gram__ (val, "alpha-obsv"); + + case {"equil", "equilibrate", "equilibration", "scale", "scaling"} + scaled = __modred_check_equil__ (val); + + otherwise + warning ("%smodred: invalid property name '%s' ignored", method, key); + endswitch + endfor + + ## handle type of frequency weighting + if (jobv && jobw) + weight = 3; # 'B': both left and right weightings V and W are used + elseif (jobv) + weight = 1; # 'L': only left weighting V is used (W = I) + elseif (jobw) + weight = 2; # 'R': only right weighting W is used (V = I) + else + weight = 0; # 'N': no weightings are used (V = I, W = I) + endif + + ## handle model reduction approach + if (method == "bta" && ! bf) # 'B': use the square-root Balance & Truncate method + job = 0; + elseif (method == "bta" && bf) # 'F': use the balancing-free square-root Balance & Truncate method + job = 1; + elseif (method == "spa" && ! bf) # 'S': use the square-root Singular Perturbation Approximation method + job = 2; + elseif (method == "spa" && bf) # 'P': use the balancing-free square-root Singular Perturbation Approximation method + job = 3; + else + error ("modred: invalid job option"); # this should never happen + endif + + + ## perform model order reduction + [ar, br, cr, dr, nr, hsv, ns] = slab09id (a, b, c, d, dt, equil, nr, ordsel, alpha, job, \ + av, bv, cv, dv, \ + aw, bw, cw, dw, \ + weight, jobc, jobo, alphac, alphao, \ + tol1, tol2); + + ## assemble reduced order model + Gr = ss (ar, br, cr, dr, tsam); + + ## assemble info struct + info = struct ("nr", nr, "ns", ns, "hsv", hsv); + +endfunction + + + + diff --git a/octave_packages/control-2.3.52/__modred_check_alpha__.m b/octave_packages/control-2.3.52/__modred_check_alpha__.m new file mode 100644 index 0000000..dbc5d46 --- /dev/null +++ b/octave_packages/control-2.3.52/__modred_check_alpha__.m @@ -0,0 +1,40 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## check alpha for model reduction commands + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function alpha = __modred_check_alpha__ (alpha, dt) + + if (! is_real_scalar (alpha)) + error ("modred: argument alpha must be a real scalar"); + endif + if (dt) # discrete-time + if (alpha < 0 || alpha > 1) + error ("modred: require 0 <= ALPHA <= 1"); + endif + else # continuous-time + if (alpha > 0) + error ("modred: require ALPHA <= 0"); + endif + endif + +endfunction diff --git a/octave_packages/control-2.3.52/__modred_check_alpha_gram__.m b/octave_packages/control-2.3.52/__modred_check_alpha_gram__.m new file mode 100644 index 0000000..f3851a2 --- /dev/null +++ b/octave_packages/control-2.3.52/__modred_check_alpha_gram__.m @@ -0,0 +1,35 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## check alpha for combination methods of grammians + +## Author: Lukas Reichlin +## Created: December 2011 +## Version: 0.1 + +function alpha = __modred_check_alpha_gram__ (alpha, key) + + if (! is_real_scalar (alpha)) + error ("modred: argument '%s' must be a real scalar", key); + endif + + if (abs (alpha) > 1) + error ("modred: require -1 <= %s <= 1", key); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/__modred_check_equil__.m b/octave_packages/control-2.3.52/__modred_check_equil__.m new file mode 100644 index 0000000..023b3fe --- /dev/null +++ b/octave_packages/control-2.3.52/__modred_check_equil__.m @@ -0,0 +1,33 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## check equilibration for model reduction commands + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function scaled = __modred_check_equil__ (equil) + + if (isscalar (equil)) + scaled = ! logical (equil); + else + error ("modred: property 'equil' must be a logical value"); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/__modred_check_gram__.m b/octave_packages/control-2.3.52/__modred_check_gram__.m new file mode 100644 index 0000000..e2c5334 --- /dev/null +++ b/octave_packages/control-2.3.52/__modred_check_gram__.m @@ -0,0 +1,40 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## check choice of frequency-weighted grammians. + +## Author: Lukas Reichlin +## Created: December 2011 +## Version: 0.1 + +function job = __modred_check_gram__ (choice, key) + + if (! ischar (choice)) + error ("modred: key '%s' requires string value", key); + endif + + switch (tolower (choice (1))) + case "s" # standard + job = 0; + case "e" # enhanced + job = 1; + otherwise + error ("modred: key '%s' has an invalid value", key); + endswitch + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/__modred_check_order__.m b/octave_packages/control-2.3.52/__modred_check_order__.m new file mode 100644 index 0000000..0e8b3b8 --- /dev/null +++ b/octave_packages/control-2.3.52/__modred_check_order__.m @@ -0,0 +1,38 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## check order for model reduction commands + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function [nr, ordsel] = __modred_check_order__ (nr, n) + + if (! issample (nr, 0) || nr != round (nr)) + error ("modred: order of reduced model must be an integer >= 0"); + endif + + if (nr > n) + error ("modred: order of reduced model (%d) can't be larger than the original one (%d)", \ + nr, n); + endif + + ordsel = 0; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/__modred_check_tol__.m b/octave_packages/control-2.3.52/__modred_check_tol__.m new file mode 100644 index 0000000..b4b1e2b --- /dev/null +++ b/octave_packages/control-2.3.52/__modred_check_tol__.m @@ -0,0 +1,31 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## check tolerance for model reduction commands + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function tol = __modred_check_tol__ (tol, str = "") + + if (! is_real_scalar (tol)) + error ("modred: argument %s must be a real scalar", str); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/__modred_check_weight__.m b/octave_packages/control-2.3.52/__modred_check_weight__.m new file mode 100644 index 0000000..1c9a34c --- /dev/null +++ b/octave_packages/control-2.3.52/__modred_check_weight__.m @@ -0,0 +1,49 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## check weightings for model reduction commands + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function [a, b, c, d, job] = __modred_check_weight__ (sys, dt, p = [], m = []) + + sys = ss (sys); # could be non-lti, therefore ssdata would fail + + if (dt != isdt (sys)) + error ("modred: ct/dt"); # TODO: error message + endif + + [pw, mw] = size (sys); + + if (! isempty (p) && mw != p) + error ("modred: left weight requires %d inputs", p); + endif + + if (! isempty (m) && pw != m) + error ("modred: right weight requires %d outputs", m); + endif + + [a, b, c, d] = ssdata (sys); + + job = 1; + + ## TODO: check system size + +endfunction diff --git a/octave_packages/control-2.3.52/__modred_default_alpha__.m b/octave_packages/control-2.3.52/__modred_default_alpha__.m new file mode 100644 index 0000000..39fde72 --- /dev/null +++ b/octave_packages/control-2.3.52/__modred_default_alpha__.m @@ -0,0 +1,33 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## default alpha for model reduction commands + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function alpha = __modred_default_alpha__ (dt) + + if (dt) # discrete-time + alpha = 1; # ALPHA <= 0 + else # continuous-time + alpha = 0; # 0 <= ALPHA <= 1 + endif + +endfunction diff --git a/octave_packages/control-2.3.52/__opt2cell__.m b/octave_packages/control-2.3.52/__opt2cell__.m new file mode 100644 index 0000000..f96940c --- /dev/null +++ b/octave_packages/control-2.3.52/__opt2cell__.m @@ -0,0 +1,37 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Convert option struct to a cell with field names as keys and +## field values as values. + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function c = __opt2cell__ (opt) + + if (! isstruct (opt)) + error ("opt2cell: argument must be a struct"); + endif + + key = fieldnames (opt); + val = struct2cell (opt); + + c = [key.'; val.'](:).'; # reshape to {key1, val1, key2, val2, ...} + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/__remove_trailing_zeros__.m b/octave_packages/control-2.3.52/__remove_trailing_zeros__.m new file mode 100644 index 0000000..fe70e36 --- /dev/null +++ b/octave_packages/control-2.3.52/__remove_trailing_zeros__.m @@ -0,0 +1,36 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Remove trailing zeros from a polynomial, except for polynomials +## which are of length 1. For internal use only. + +## Author: Lukas Reichlin +## Created: April 2012 +## Version: 0.1 + +function p = __remove_trailing_zeros__ (p) + + idx = find (p != 0); + + if (isempty (idx)) + p = 0; + else + p = p(1 : idx(end)); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/__ss_dim__.m b/octave_packages/control-2.3.52/__ss_dim__.m new file mode 100644 index 0000000..7a78027 --- /dev/null +++ b/octave_packages/control-2.3.52/__ss_dim__.m @@ -0,0 +1,72 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Number of outputs (p), inputs (m) and states (n) of state space matrices. +## For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.2 + +function [p, m, n] = __ss_dim__ (a, b, c, d, e = []) + + ## TODO: create oct-file? + + if (! is_real_matrix (a, b, c, d, e)) + error ("ss: system matrices must be real"); + endif + + [arows, acols] = size (a); + [brows, bcols] = size (b); + [crows, ccols] = size (c); + [drows, dcols] = size (d); + + m = bcols; # = dcols + n = arows; # = acols + p = crows; # = drows + + if (arows != acols) + error ("ss: system matrix a(%dx%d) is not square", arows, acols); + endif + + if (brows != arows) + error ("ss: system matrices a(%dx%d) and b(%dx%d) are incompatible", + arows, acols, brows, bcols); + endif + + if (ccols != acols) + error ("ss: system matrices a(%dx%d) and c(%dx%d) are incompatible", + arows, acols, crows, ccols); + endif + + if (bcols != dcols) + error ("ss: system matrices b(%dx%d) and d(%dx%d) are incompatible", + brows, bcols, drows, dcols); + endif + + if (crows != drows) + error ("ss: system matrices c(%dx%d) and d(%dx%d) are incompatible", + crows, ccols, drows, dcols); + endif + + if (! isempty (e) && ! size_equal (e, a)) + error ("ss: system matrices a(%dx%d) and e(%dx%d) are incompatible", + arows, acols, rows (e), columns (e)); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/__tf_dim__.m b/octave_packages/control-2.3.52/__tf_dim__.m new file mode 100644 index 0000000..2a2ea4b --- /dev/null +++ b/octave_packages/control-2.3.52/__tf_dim__.m @@ -0,0 +1,36 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Number of outputs and inputs of transfer function numerator and +## denominator. For internal use only. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function [nrows, ncols] = __tf_dim__ (num, den) + + [nrows, ncols] = size (num); + [drows, dcols] = size (den); + + if (nrows != drows || ncols != dcols) + error ("tf: num(%dx%d) and den(%dx%d) must have equal dimensions", + nrows, ncols, drows, dcols); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/__time_response__.m b/octave_packages/control-2.3.52/__time_response__.m new file mode 100644 index 0000000..81ca3d1 --- /dev/null +++ b/octave_packages/control-2.3.52/__time_response__.m @@ -0,0 +1,304 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Common code for the time response functions step, impulse and initial. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function [y, t, x_arr] = __time_response__ (sys, resptype, plotflag, tfinal, dt, x0, sysname) + + if (! isa (sys, "ss")) + sys = ss (sys); # sys must be proper + endif + + if (is_real_vector (tfinal) && length (tfinal) > 1) # time vector t passed + dt = tfinal(2) - tfinal(1); # assume that t is regularly spaced + tfinal = tfinal(end); + endif + + [A, B, C, D, tsam] = ssdata (sys); + + discrete = ! isct (sys); # static gains are treated as analog systems + tsam = abs (tsam); # use 1 second if tsam is unspecified (-1) + + if (discrete) + if (! isempty (dt)) + warning ("time_response: argument dt has no effect on sampling time of discrete system"); + endif + + dt = tsam; + endif + + [tfinal, dt] = __sim_horizon__ (A, discrete, tfinal, dt); + + if (! discrete) + sys = c2d (sys, dt, "zoh"); + endif + + [F, G] = ssdata (sys); # matrices C and D don't change + + n = rows (F); # number of states + m = columns (G); # number of inputs + p = rows (C); # number of outputs + + ## time vector + t = reshape (0 : dt : tfinal, [], 1); + l_t = length (t); + + switch (resptype) + case "initial" + str = ["Response of ", sysname, " to Initial Conditions"]; + yfinal = zeros (p, 1); + + ## preallocate memory + y = zeros (l_t, p); + x_arr = zeros (l_t, n); + + ## initial conditions + x = reshape (x0, [], 1); # make sure that x is a column vector + + if (n != length (x0) || ! is_real_vector (x0)) + error ("initial: x0 must be a real vector with %d elements", n); + endif + + ## simulation + for k = 1 : l_t + y(k, :) = C * x; + x_arr(k, :) = x; + x = F * x; + endfor + + case "step" + str = ["Step Response of ", sysname]; + yfinal = dcgain (sys); + + ## preallocate memory + y = zeros (l_t, p, m); + x_arr = zeros (l_t, n, m); + + for j = 1 : m # for every input channel + ## initial conditions + x = zeros (n, 1); + u = zeros (m, 1); + u(j) = 1; + + ## simulation + for k = 1 : l_t + y(k, :, j) = C * x + D * u; + x_arr(k, :, j) = x; + x = F * x + G * u; + endfor + endfor + + case "impulse" + str = ["Impulse Response of ", sysname]; + yfinal = zeros (p, m); + + ## preallocate memory + y = zeros (l_t, p, m); + x_arr = zeros (l_t, n, m); + + for j = 1 : m # for every input channel + ## initial conditions + u = zeros (m, 1); + u(j) = 1; + + if (discrete) + x = zeros (n, 1); # zero by definition + y(1, :, j) = D * u / dt; + x_arr(1, :, j) = x; + x = G * u / dt; + else + x = B * u; # B, not G! + y(1, :, j) = C * x; + x_arr(1, :, j) = x; + x = F * x; + endif + + ## simulation + for k = 2 : l_t + y (k, :, j) = C * x; + x_arr(k, :, j) = x; + x = F * x; + endfor + endfor + + if (discrete) + y *= dt; + x_arr *= dt; + endif + + otherwise + error ("time_response: invalid response type"); + + endswitch + + + if (plotflag) # display plot + + ## TODO: Set correct titles, especially for multi-input systems + + stable = isstable (sys); + outname = get (sys, "outname"); + outname = __labels__ (outname, "y_"); + + if (strcmp (resptype, "initial")) + cols = 1; + else + cols = m; + endif + + if (discrete) # discrete system + for k = 1 : p + for j = 1 : cols + + subplot (p, cols, (k-1)*cols+j); + + if (stable) + stairs (t, [y(:, k, j), yfinal(k, j) * ones(l_t, 1)]); + else + stairs (t, y(:, k, j)); + endif + + grid ("on"); + + if (k == 1 && j == 1) + title (str); + endif + + if (j == 1) + ylabel (sprintf ("Amplitude %s", outname{k})); + endif + + endfor + endfor + + xlabel ("Time [s]"); + + else # continuous system + for k = 1 : p + for j = 1 : cols + + subplot (p, cols, (k-1)*cols+j); + + if (stable) + plot (t, [y(:, k, j), yfinal(k, j) * ones(l_t, 1)]); + else + plot (t, y(:, k, j)); + endif + + grid ("on"); + + if (k == 1 && j == 1) + title (str); + endif + + if (j == 1) + ylabel (sprintf ("Amplitude %s", outname{k})); + endif + + endfor + endfor + + xlabel ("Time [s]"); + + endif + endif + +endfunction + + +function [tfinal, dt] = __sim_horizon__ (A, discrete, tfinal, Ts) + + ## code based on __stepimp__.m of Kai P. Mueller and A. Scottedward Hodel + + TOL = 1.0e-10; # values below TOL are assumed to be zero + N_MIN = 50; # min number of points + N_MAX = 2000; # max number of points + N_DEF = 1000; # default number of points + T_DEF = 10; # default simulation time + + n = rows (A); + eigw = eig (A); + + if (discrete) + ## perform bilinear transformation on poles in z + for k = 1 : n + pol = eigw(k); + if (abs (pol + 1) < TOL) + eigw(k) = 0; + else + eigw(k) = 2 / Ts * (pol - 1) / (pol + 1); + endif + endfor + endif + + ## remove poles near zero from eigenvalue array eigw + nk = n; + for k = 1 : n + if (abs (real (eigw(k))) < TOL) + eigw(k) = 0; + nk -= 1; + endif + endfor + + if (nk == 0) + if (isempty (tfinal)) + tfinal = T_DEF; + endif + + if (! discrete) + dt = tfinal / N_DEF; + endif + else + eigw = eigw(find (eigw)); + eigw_max = max (abs (eigw)); + + if (! discrete) + dt = 0.2 * pi / eigw_max; + endif + + if (isempty (tfinal)) + eigw_min = min (abs (real (eigw))); + tfinal = 5.0 / eigw_min; + + ## round up + yy = 10^(ceil (log10 (tfinal)) - 1); + tfinal = yy * ceil (tfinal / yy); + endif + + if (! discrete) + N = tfinal / dt; + + if (N < N_MIN) + dt = tfinal / N_MIN; + endif + + if (N > N_MAX) + dt = tfinal / N_MAX; + endif + endif + endif + + if (! isempty (Ts)) # catch case cont. system with dt specified + dt = Ts; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/__vec2tfpoly__.m b/octave_packages/control-2.3.52/__vec2tfpoly__.m new file mode 100644 index 0000000..095a2d1 --- /dev/null +++ b/octave_packages/control-2.3.52/__vec2tfpoly__.m @@ -0,0 +1,34 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Convert a (cell of) row vector(s) to a cell of tfpoly objects. +## Used by tf and __set__. + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function ndr = __vec2tfpoly__ (nd) + + if (! iscell (nd)) + nd = {nd}; + endif + + ndr = cellfun (@tfpoly, nd, "uniformoutput", false); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/augw.m b/octave_packages/control-2.3.52/augw.m new file mode 100644 index 0000000..80e22d3 --- /dev/null +++ b/octave_packages/control-2.3.52/augw.m @@ -0,0 +1,168 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{P} =} augw (@var{G}, @var{W1}, @var{W2}, @var{W3}) +## Extend plant for stacked S/KS/T problem. Subsequently, the robust control problem +## can be solved by h2syn or hinfsyn. +## +## @strong{Inputs} +## @table @var +## @item G +## LTI model of plant. +## @item W1 +## LTI model of performance weight. Bounds the largest singular values of sensitivity @var{S}. +## Model must be empty @code{[]}, SISO or of appropriate size. +## @item W2 +## LTI model to penalize large control inputs. Bounds the largest singular values of @var{KS}. +## Model must be empty @code{[]}, SISO or of appropriate size. +## @item W3 +## LTI model of robustness and noise sensitivity weight. Bounds the largest singular values of +## complementary sensitivity @var{T}. Model must be empty @code{[]}, SISO or of appropriate size. +## @end table +## +## All inputs must be proper/realizable. +## Scalars, vectors and matrices are possible instead of LTI models. +## +## @strong{Outputs} +## @table @var +## @item P +## State-space model of augmented plant. +## @end table +## +## @strong{Block Diagram} +## @example +## @group +## +## | W1 | -W1*G | z1 = W1 r - W1 G u +## | 0 | W2 | z2 = W2 u +## P = | 0 | W3*G | z3 = W3 G u +## |----+-------| +## | I | -G | e = r - G u +## @end group +## @end example +## @example +## @group +## +------+ z1 +## +---------------------------------------->| W1 |-----> +## | +------+ +## | +------+ z2 +## | +---------------------->| W2 |-----> +## | | +------+ +## r + e | +--------+ u | +--------+ y +------+ z3 +## ----->(+)---+-->| K(s) |----+-->| G(s) |----+---->| W3 |-----> +## ^ - +--------+ +--------+ | +------+ +## | | +## +----------------------------------------+ +## @end group +## @end example +## @example +## @group +## +--------+ +## | |-----> z1 (p1x1) z1 = W1 e +## r (px1) ----->| P(s) |-----> z2 (p2x1) z2 = W2 u +## | |-----> z3 (p3x1) z3 = W3 y +## u (mx1) ----->| |-----> e (px1) e = r - y +## +--------+ +## @end group +## @end example +## @example +## @group +## +--------+ +## r ----->| |-----> z +## | P(s) | +## u +---->| |-----+ e +## | +--------+ | +## | | +## | +--------+ | +## +-----| K(s) |<----+ +## +--------+ +## @end group +## @end example +## @example +## @group +## Reference: +## Skogestad, S. and Postlethwaite I. +## Multivariable Feedback Control: Analysis and Design +## Second Edition +## Wiley 2005 +## Chapter 3.8: General Control Problem Formulation +## @end group +## @end example +## @seealso{h2syn, hinfsyn, mixsyn} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: December 2009 +## Version: 0.2 + +function P = augw (G, W1 = [], W2 = [], W3 = []) + + if (nargin == 0 || nargin > 4) + print_usage (); + endif + + G = ss (G); + [p, m] = size (G); + + [W1, p1, m1] = __adjust_weighting__ (W1, p); + [W2, p2, m2] = __adjust_weighting__ (W2, m); + [W3, p3, m3] = __adjust_weighting__ (W3, p); + + ## Pr = [1; 0; 0; 1]; + ## Pu = [-1; 0; 1; -1]*G + [0; 1; 0; 0]; + + Pr = ss ([eye(m1,p) ; + zeros(m2,p); + zeros(m3,p); + eye(p,p) ]); + + Pu1 = ss ([-eye(m1,p) ; + zeros(m2,p); + eye(m3,p) ; + -eye(p,p) ]); + + Pu2 = ss ([zeros(m1,m); + eye(m2,m) ; + zeros(m3,m); + zeros(p,m) ]); + + Pu = Pu1 * G + Pu2; + + P = append (W1, W2, W3, eye (p, p)) * [Pr, Pu]; + +endfunction + + +function [W, p, m] = __adjust_weighting__ (W, s) + + W = ss (W); + [p, m] = size (W); + + if (m == 0 || m == s) # model is empty or has s inputs + return; + elseif (m == 1) # model is SISO or SIMO + tmp = W; + for k = 2 : s + W = append (W, tmp); # stack single-input model s times + endfor + [p, m] = size (W); # weighting function now of correct size + else # model is MIMO or MISO + error ("augw: %s must have 1 or %d inputs", inputname (1), s); + endif + +endfunction diff --git a/octave_packages/control-2.3.52/bode.m b/octave_packages/control-2.3.52/bode.m new file mode 100644 index 0000000..4262fab --- /dev/null +++ b/octave_packages/control-2.3.52/bode.m @@ -0,0 +1,97 @@ +## Copyright (C) 2009, 2010, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{mag}, @var{pha}, @var{w}] =} bode (@var{sys}) +## @deftypefnx {Function File} {[@var{mag}, @var{pha}, @var{w}] =} bode (@var{sys}, @var{w}) +## Bode diagram of frequency response. If no output arguments are given, +## the response is printed on the screen. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. Must be a single-input and single-output (SISO) system. +## @item w +## Optional vector of frequency values. If @var{w} is not specified, +## it is calculated by the zeros and poles of the system. +## Alternatively, the cell @code{@{wmin, wmax@}} specifies a frequency range, +## where @var{wmin} and @var{wmax} denote minimum and maximum frequencies +## in rad/s. +## @end table +## +## @strong{Outputs} +## @table @var +## @item mag +## Vector of magnitude. Has length of frequency vector @var{w}. +## @item pha +## Vector of phase. Has length of frequency vector @var{w}. +## @item w +## Vector of frequency values used. +## @end table +## +## @seealso{nichols, nyquist, sigma} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.4 + +function [mag_r, pha_r, w_r] = bode (sys, w = []) + + ## TODO: multiplot feature: bode (sys1, "b", sys2, "r", ...) + + if (nargin == 0 || nargin > 2) + print_usage (); + endif + + [H, w] = __frequency_response__ (sys, w, false, 0, "std"); + + H = reshape (H, [], 1); + mag = abs (H); + pha = unwrap (arg (H)) * 180 / pi; + + if (! nargout) + mag_db = 20 * log10 (mag); + + if (isct (sys)) + xl_str = "Frequency [rad/s]"; + else + xl_str = sprintf ("Frequency [rad/s] w_N = %g", pi / get (sys, "tsam")); + endif + + subplot (2, 1, 1) + semilogx (w, mag_db) + axis ("tight") + ylim (__axis_margin__ (ylim)) + grid ("on") + title (["Bode Diagram of ", inputname(1)]) + ylabel ("Magnitude [dB]") + + subplot (2, 1, 2) + semilogx (w, pha) + axis ("tight") + ylim (__axis_margin__ (ylim)) + grid ("on") + xlabel (xl_str) + ylabel ("Phase [deg]") + else + mag_r = mag; + pha_r = pha; + w_r = w; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/bodemag.m b/octave_packages/control-2.3.52/bodemag.m new file mode 100644 index 0000000..a8f4752 --- /dev/null +++ b/octave_packages/control-2.3.52/bodemag.m @@ -0,0 +1,85 @@ +## Copyright (C) 2009, 2010, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{mag}, @var{w}] =} bodemag (@var{sys}) +## @deftypefnx {Function File} {[@var{mag}, @var{w}] =} bodemag (@var{sys}, @var{w}) +## Bode magnitude diagram of frequency response. If no output arguments are given, +## the response is printed on the screen. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. Must be a single-input and single-output (SISO) system. +## @item w +## Optional vector of frequency values. If @var{w} is not specified, +## it is calculated by the zeros and poles of the system. +## Alternatively, the cell @code{@{wmin, wmax@}} specifies a frequency range, +## where @var{wmin} and @var{wmax} denote minimum and maximum frequencies +## in rad/s. +## @end table +## +## @strong{Outputs} +## @table @var +## @item mag +## Vector of magnitude. Has length of frequency vector @var{w}. +## @item w +## Vector of frequency values used. +## @end table +## +## @seealso{bode, nichols, nyquist, sigma} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.4 + +function [mag_r, w_r] = bodemag (sys, w = []) + + ## TODO: multiplot feature: bodemag (sys1, "b", sys2, "r", ...) + + if (nargin == 0 || nargin > 2) + print_usage (); + endif + + [H, w] = __frequency_response__ (sys, w, false, 0, "std"); + + H = reshape (H, [], 1); + mag = abs (H); + + if (! nargout) + mag_db = 20 * log10 (mag); + + if (isct (sys)) + xl_str = "Frequency [rad/s]"; + else + xl_str = sprintf ("Frequency [rad/s] w_N = %g", pi / get (sys, "tsam")); + endif + + semilogx (w, mag_db) + axis ("tight") + ylim (__axis_margin__ (ylim)) + grid ("on") + title (["Bode Magnitude Diagram of ", inputname(1)]) + xlabel (xl_str) + ylabel ("Magnitude [dB]") + else + mag_r = mag; + w_r = w; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/bstmodred.m b/octave_packages/control-2.3.52/bstmodred.m new file mode 100644 index 0000000..1bf1938 --- /dev/null +++ b/octave_packages/control-2.3.52/bstmodred.m @@ -0,0 +1,351 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{Gr}, @var{info}] =} bstmodred (@var{G}, @dots{}) +## @deftypefnx{Function File} {[@var{Gr}, @var{info}] =} bstmodred (@var{G}, @var{nr}, @dots{}) +## @deftypefnx{Function File} {[@var{Gr}, @var{info}] =} bstmodred (@var{G}, @var{opt}, @dots{}) +## @deftypefnx{Function File} {[@var{Gr}, @var{info}] =} bstmodred (@var{G}, @var{nr}, @var{opt}, @dots{}) +## +## Model order reduction by Balanced Stochastic Truncation (BST) method. +## The aim of model reduction is to find an LTI system @var{Gr} of order +## @var{nr} (nr < n) such that the input-output behaviour of @var{Gr} +## approximates the one from original system @var{G}. +## +## BST is a relative error method which tries to minimize +## @iftex +## @tex +## $$ || G^{-1} (G-G_r) ||_{\\infty} = min $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## -1 +## ||G (G-Gr)|| = min +## inf +## @end example +## @end ifnottex +## +## +## +## @strong{Inputs} +## @table @var +## @item G +## LTI model to be reduced. +## @item nr +## The desired order of the resulting reduced order system @var{Gr}. +## If not specified, @var{nr} is chosen automatically according +## to the description of key @var{'order'}. +## @item @dots{} +## Optional pairs of keys and values. @code{"key1", value1, "key2", value2}. +## @item opt +## Optional struct with keys as field names. +## Struct @var{opt} can be created directly or +## by command @command{options}. @code{opt.key1 = value1, opt.key2 = value2}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item Gr +## Reduced order state-space model. +## @item info +## Struct containing additional information. +## @table @var +## @item info.n +## The order of the original system @var{G}. +## @item info.ns +## The order of the @var{alpha}-stable subsystem of the original system @var{G}. +## @item info.hsv +## The Hankel singular values of the phase system corresponding +## to the @var{alpha}-stable part of the original system @var{G}. +## The @var{ns} Hankel singular values are ordered decreasingly. +## @item info.nu +## The order of the @var{alpha}-unstable subsystem of both the original +## system @var{G} and the reduced-order system @var{Gr}. +## @item info.nr +## The order of the obtained reduced order system @var{Gr}. +## @end table +## @end table +## +## @strong{Option Keys and Values} +## @table @var +## @item 'order', 'nr' +## The desired order of the resulting reduced order system @var{Gr}. +## If not specified, @var{nr} is the sum of NU and the number of +## Hankel singular values greater than @code{MAX(TOL1,NS*EPS)}; +## @var{nr} can be further reduced to ensure that +## @code{HSV(NR-NU) > HSV(NR+1-NU)}. +## +## @item 'method' +## Approximation method for the H-infinity norm. +## Valid values corresponding to this key are: +## @table @var +## @item 'sr-bta', 'b' +## Use the square-root Balance & Truncate method. +## @item 'bfsr-bta', 'f' +## Use the balancing-free square-root Balance & Truncate method. Default method. +## @item 'sr-spa', 's' +## Use the square-root Singular Perturbation Approximation method. +## @item 'bfsr-spa', 'p' +## Use the balancing-free square-root Singular Perturbation Approximation method. +## @end table +## +## @item 'alpha' +## Specifies the ALPHA-stability boundary for the eigenvalues +## of the state dynamics matrix @var{G.A}. For a continuous-time +## system, ALPHA <= 0 is the boundary value for +## the real parts of eigenvalues, while for a discrete-time +## system, 0 <= ALPHA <= 1 represents the +## boundary value for the moduli of eigenvalues. +## The ALPHA-stability domain does not include the boundary. +## Default value is 0 for continuous-time systems and +## 1 for discrete-time systems. +## +## @item 'beta' +## Use @code{[G, beta*I]} as new system @var{G} to combine +## absolute and relative error methods. +## BETA > 0 specifies the absolute/relative error weighting +## parameter. A large positive value of BETA favours the +## minimization of the absolute approximation error, while a +## small value of BETA is appropriate for the minimization +## of the relative error. +## BETA = 0 means a pure relative error method and can be +## used only if rank(G.D) = rows(G.D) which means that +## the feedthrough matrice must not be rank-deficient. +## Default value is 0. +## +## @item 'tol1' +## If @var{'order'} is not specified, @var{tol1} contains the tolerance for +## determining the order of reduced system. +## For model reduction, the recommended value of @var{tol1} lies +## in the interval [0.00001, 0.001]. @var{tol1} < 1. +## If @var{tol1} <= 0 on entry, the used default value is +## @var{tol1} = NS*EPS, where NS is the number of +## ALPHA-stable eigenvalues of A and EPS is the machine +## precision. +## If @var{'order'} is specified, the value of @var{tol1} is ignored. +## +## @item 'tol2' +## The tolerance for determining the order of a minimal +## realization of the phase system (see METHOD) corresponding +## to the ALPHA-stable part of the given system. +## The recommended value is TOL2 = NS*EPS. TOL2 <= TOL1 < 1. +## This value is used by default if @var{'tol2'} is not specified +## or if TOL2 <= 0 on entry. +## +## @item 'equil', 'scale' +## Boolean indicating whether equilibration (scaling) should be +## performed on system @var{G} prior to order reduction. +## Default value is true if @code{G.scaled == false} and +## false if @code{G.scaled == true}. +## Note that for @acronym{MIMO} models, proper scaling of both inputs and outputs +## is of utmost importance. The input and output scaling can @strong{not} +## be done by the equilibration option or the @command{prescale} command +## because these functions perform state transformations only. +## Furthermore, signals should not be scaled simply to a certain range. +## For all inputs (or outputs), a certain change should be of the same +## importance for the model. +## @end table +## +## +## BST is often suitable to perform model reduction in order to obtain +## low order design models for controller synthesis. +## +## Approximation Properties: +## @itemize @bullet +## @item +## Guaranteed stability of reduced models +## @item +## Approximates simultaneously gain and phase +## @item +## Preserves non-minimum phase zeros +## @item +## Guaranteed a priori error bound +## @iftex +## @tex +## $$ || G^{-1} (G-G_r) ||_{\\infty} \\leq 2 \\sum_{j=r+1}^{n} \\frac{1+\\sigma_j}{1-\\sigma_j} - 1 $$ +## @end tex +## @end iftex +## @end itemize +## +## @strong{Algorithm}@* +## Uses SLICOT AB09HD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2011 +## Version: 0.1 + +function [Gr, info] = bstmodred (G, varargin) + + if (nargin == 0) + print_usage (); + endif + + if (! isa (G, "lti")) + error ("bstmodred: first argument must be an LTI system"); + endif + + if (nargin > 1) # bstmodred (G, ...) + if (is_real_scalar (varargin{1})) # bstmodred (G, nr) + varargin = horzcat (varargin(2:end), {"order"}, varargin(1)); + endif + if (isstruct (varargin{1})) # bstmodred (G, opt, ...), bstmodred (G, nr, opt, ...) + varargin = horzcat (__opt2cell__ (varargin{1}), varargin(2:end)); + endif + ## order placed at the end such that nr from bstmodred (G, nr, ...) + ## and bstmodred (G, nr, opt, ...) overrides possible nr's from + ## key/value-pairs and inside opt struct (later keys override former keys, + ## nr > key/value > opt) + endif + + nkv = numel (varargin); # number of keys and values + + if (rem (nkv, 2)) + error ("bstmodred: keys and values must come in pairs"); + endif + + [a, b, c, d, tsam, scaled] = ssdata (G); + dt = isdt (G); + + ## default arguments + alpha = __modred_default_alpha__ (dt); + beta = 0; + tol1 = 0; + tol2 = 0; + ordsel = 1; + nr = 0; + job = 1; + + ## handle keys and values + for k = 1 : 2 : nkv + key = lower (varargin{k}); + val = varargin{k+1}; + switch (key) + case {"order", "nr"} + [nr, ordsel] = __modred_check_order__ (val, rows (a)); + + case "tol1" + tol1 = __modred_check_tol__ (val, "tol1"); + + case "tol2" + tol2 = __modred_check_tol__ (val, "tol2"); + + case "alpha" + alpha = __modred_check_alpha__ (val, dt); + + case "beta" + if (! issample (val, 0)) + error ("bstmodred: argument %s must be BETA >= 0", varargin{k}); + endif + beta = val; + + case "method" # approximation method + switch (tolower (val)) + case {"sr-bta", "b"} # 'B': use the square-root Balance & Truncate method + job = 0; + case {"bfsr-bta", "f"} # 'F': use the balancing-free square-root Balance & Truncate method + job = 1; + case {"sr-spa", "s"} # 'S': use the square-root Singular Perturbation Approximation method + job = 2; + case {"bfsr-spa", "p"} # 'P': use the balancing-free square-root Singular Perturbation Approximation method + job = 3; + otherwise + error ("bstmodred: '%s' is an invalid approximation method", val); + endswitch + + case {"equil", "equilibrate", "equilibration", "scale", "scaling"} + scaled = __modred_check_equil__ (val); + + otherwise + warning ("bstmodred: invalid property name '%s' ignored", key); + endswitch + endfor + + ## perform model order reduction + [ar, br, cr, dr, nr, hsv, ns] = slab09hd (a, b, c, d, dt, scaled, job, nr, ordsel, alpha, beta, \ + tol1, tol2); + + ## assemble reduced order model + Gr = ss (ar, br, cr, dr, tsam); + + ## assemble info struct + n = rows (a); + nu = n - ns; + info = struct ("n", n, "ns", ns, "hsv", hsv, "nu", nu, "nr", nr); + +endfunction + + +%!shared Mo, Me, Info, HSVe +%! A = [ -0.04165 0.0000 4.9200 -4.9200 0.0000 0.0000 0.0000 +%! -5.2100 -12.500 0.0000 0.0000 0.0000 0.0000 0.0000 +%! 0.0000 3.3300 -3.3300 0.0000 0.0000 0.0000 0.0000 +%! 0.5450 0.0000 0.0000 0.0000 -0.5450 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 4.9200 -0.04165 0.0000 4.9200 +%! 0.0000 0.0000 0.0000 0.0000 -5.2100 -12.500 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 3.3300 -3.3300 ]; +%! +%! B = [ 0.0000 0.0000 +%! 12.500 0.0000 +%! 0.0000 0.0000 +%! 0.0000 0.0000 +%! 0.0000 0.0000 +%! 0.0000 12.500 +%! 0.0000 0.0000 ]; +%! +%! C = [ 1.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 1.0000 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 1.0000 0.0000 0.0000 ]; +%! +%! D = [ 0.0000 0.0000 +%! 0.0000 0.0000 +%! 0.0000 0.0000 ]; +%! +%! G = ss (A, B, C, D, "scaled", true); +%! +%! [Gr, Info] = bstmodred (G, "beta", 1.0, "tol1", 0.1, "tol2", 0.0); +%! [Ao, Bo, Co, Do] = ssdata (Gr); +%! +%! Ae = [ 1.2729 0.0000 6.5947 0.0000 -3.4229 +%! 0.0000 0.8169 0.0000 2.4821 0.0000 +%! -2.9889 0.0000 -2.9028 0.0000 -0.3692 +%! 0.0000 -3.3921 0.0000 -3.1126 0.0000 +%! -1.4767 0.0000 -2.0339 0.0000 -0.6107 ]; +%! +%! Be = [ 0.1331 -0.1331 +%! -0.0862 -0.0862 +%! -2.6777 2.6777 +%! -3.5767 -3.5767 +%! -2.3033 2.3033 ]; +%! +%! Ce = [ -0.6907 -0.6882 0.0779 0.0958 -0.0038 +%! 0.0676 0.0000 0.6532 0.0000 -0.7522 +%! 0.6907 -0.6882 -0.0779 0.0958 0.0038 ]; +%! +%! De = [ 0.0000 0.0000 +%! 0.0000 0.0000 +%! 0.0000 0.0000 ]; +%! +%! HSVe = [ 0.8803 0.8506 0.8038 0.4494 0.3973 0.0214 0.0209 ].'; +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (Mo, Me, 1e-4); +%!assert (Info.hsv, HSVe, 1e-4); diff --git a/octave_packages/control-2.3.52/btaconred.m b/octave_packages/control-2.3.52/btaconred.m new file mode 100644 index 0000000..b5f4e38 --- /dev/null +++ b/octave_packages/control-2.3.52/btaconred.m @@ -0,0 +1,281 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{Kr}, @var{info}] =} btaconred (@var{G}, @var{K}, @dots{}) +## @deftypefnx{Function File} {[@var{Kr}, @var{info}] =} btaconred (@var{G}, @var{K}, @var{ncr}, @dots{}) +## @deftypefnx{Function File} {[@var{Kr}, @var{info}] =} btaconred (@var{G}, @var{K}, @var{opt}, @dots{}) +## @deftypefnx{Function File} {[@var{Kr}, @var{info}] =} btaconred (@var{G}, @var{K}, @var{ncr}, @var{opt}, @dots{}) +## +## Controller reduction by frequency-weighted Balanced Truncation Approximation (BTA). +## Given a plant @var{G} and a stabilizing controller @var{K}, determine a reduced +## order controller @var{Kr} such that the closed-loop system is stable and closed-loop +## performance is retained. +## +## The algorithm tries to minimize the frequency-weighted error +## @iftex +## @tex +## $$ || V \\ (K - K_r) \\ W ||_{\\infty} = min $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## ||V (K-Kr) W|| = min +## inf +## @end example +## @end ifnottex +## where @var{V} and @var{W} denote output and input weightings. +## +## +## @strong{Inputs} +## @table @var +## @item G +## LTI model of the plant. +## It has m inputs, p outputs and n states. +## @item K +## LTI model of the controller. +## It has p inputs, m outputs and nc states. +## @item ncr +## The desired order of the resulting reduced order controller @var{Kr}. +## If not specified, @var{ncr} is chosen automatically according +## to the description of key @var{'order'}. +## @item @dots{} +## Optional pairs of keys and values. @code{"key1", value1, "key2", value2}. +## @item opt +## Optional struct with keys as field names. +## Struct @var{opt} can be created directly or +## by command @command{options}. @code{opt.key1 = value1, opt.key2 = value2}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item Kr +## State-space model of reduced order controller. +## @item info +## Struct containing additional information. +## @table @var +## @item info.ncr +## The order of the obtained reduced order controller @var{Kr}. +## @item info.ncs +## The order of the alpha-stable part of original controller @var{K}. +## @item info.hsvc +## The Hankel singular values of the alpha-stable part of @var{K}. +## The @var{ncs} Hankel singular values are ordered decreasingly. +## @end table +## @end table +## +## @strong{Option Keys and Values} +## @table @var +## @item 'order', 'ncr' +## The desired order of the resulting reduced order controller @var{Kr}. +## If not specified, @var{ncr} is chosen automatically such that states with +## Hankel singular values @var{info.hsvc} > @var{tol1} are retained. +## +## @item 'method' +## Order reduction approach to be used as follows: +## @table @var +## @item 'sr', 'b' +## Use the square-root Balance & Truncate method. +## @item 'bfsr', 'f' +## Use the balancing-free square-root Balance & Truncate method. Default method. +## @end table +## +## @item 'weight' +## Specifies the type of frequency-weighting as follows: +## @table @var +## @item 'none' +## No weightings are used (V = I, W = I). +## +## @item 'left', 'output' +## Use stability enforcing left (output) weighting +## @iftex +## @tex +## $$ V = (I - G K)^{-1} G, \\qquad W = I $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## -1 +## V = (I-G*K) *G , W = I +## @end example +## @end ifnottex +## +## @item 'right', 'input' +## Use stability enforcing right (input) weighting +## @iftex +## @tex +## $$ V = I, \\qquad W = (I - G K)^{-1} G $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## -1 +## V = I , W = (I-G*K) *G +## @end example +## @end ifnottex +## +## @item 'both', 'performance' +## Use stability and performance enforcing weightings +## @iftex +## @tex +## $$ V = (I - G K)^{-1} G, \\qquad W = (I - G K)^{-1} $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## -1 -1 +## V = (I-G*K) *G , W = (I-G*K) +## @end example +## @end ifnottex +## Default value. +## @end table +## +## @item 'feedback' +## Specifies whether @var{K} is a positive or negative feedback controller: +## @table @var +## @item '+' +## Use positive feedback controller. Default value. +## @item '-' +## Use negative feedback controller. +## @end table +## +## @item 'alpha' +## Specifies the ALPHA-stability boundary for the eigenvalues +## of the state dynamics matrix @var{K.A}. For a continuous-time +## controller, ALPHA <= 0 is the boundary value for +## the real parts of eigenvalues, while for a discrete-time +## controller, 0 <= ALPHA <= 1 represents the +## boundary value for the moduli of eigenvalues. +## The ALPHA-stability domain does not include the boundary. +## Default value is 0 for continuous-time controllers and +## 1 for discrete-time controllers. +## +## @item 'tol1' +## If @var{'order'} is not specified, @var{tol1} contains the tolerance for +## determining the order of the reduced controller. +## For model reduction, the recommended value of @var{tol1} is +## c*info.hsvc(1), where c lies in the interval [0.00001, 0.001]. +## Default value is info.ncs*eps*info.hsvc(1). +## If @var{'order'} is specified, the value of @var{tol1} is ignored. +## +## @item 'tol2' +## The tolerance for determining the order of a minimal +## realization of the ALPHA-stable part of the given +## controller. TOL2 <= TOL1. +## If not specified, ncs*eps*info.hsvc(1) is chosen. +## +## @item 'gram-ctrb' +## Specifies the choice of frequency-weighted controllability +## Grammian as follows: +## @table @var +## @item 'standard' +## Choice corresponding to standard Enns' method [1]. Default method. +## @item 'enhanced' +## Choice corresponding to the stability enhanced +## modified Enns' method of [2]. +## @end table +## +## @item 'gram-obsv' +## Specifies the choice of frequency-weighted observability +## Grammian as follows: +## @table @var +## @item 'standard' +## Choice corresponding to standard Enns' method [1]. Default method. +## @item 'enhanced' +## Choice corresponding to the stability enhanced +## modified Enns' method of [2]. +## @end table +## +## @item 'equil', 'scale' +## Boolean indicating whether equilibration (scaling) should be +## performed on @var{G} and @var{K} prior to order reduction. +## Default value is false if both @code{G.scaled == true, K.scaled == true} +## and true otherwise. +## Note that for @acronym{MIMO} models, proper scaling of both inputs and outputs +## is of utmost importance. The input and output scaling can @strong{not} +## be done by the equilibration option or the @command{prescale} command +## because these functions perform state transformations only. +## Furthermore, signals should not be scaled simply to a certain range. +## For all inputs (or outputs), a certain change should be of the same +## importance for the model. +## @end table +## +## @strong{Algorithm}@* +## Uses SLICOT SB16AD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: December 2011 +## Version: 0.1 + +function [Kr, info] = btaconred (varargin) + + [Kr, info] = __conred_sb16ad__ ("bta", varargin{:}); + +endfunction + + +%!shared Mo, Me, Info, HSVCe +%! A = [ -1. 0. 4. +%! 0. 2. 0. +%! 0. 0. -3. ]; +%! +%! B = [ 1. +%! 1. +%! 1. ]; +%! +%! C = [ 1. 1. 1. ]; +%! +%! D = [ 0. ]; +%! +%! G = ss (A, B, C, D, "scaled", true); +%! +%! AC = [ -26.4000, 6.4023, 4.3868; +%! 32.0000, 0, 0; +%! 0, 8.0000, 0 ]; +%! +%! BC = [ -16 +%! 0 +%! 0 ]; +%! +%! CC = [ 9.2994 1.1624 0.1090 ]; +%! +%! DC = [ 0 ]; +%! +%! K = ss (AC, BC, CC, DC, "scaled", true); +%! +%! [Kr, Info] = btaconred (G, K, 2, "weight", "input", "feedback", "+"); +%! [Ao, Bo, Co, Do] = ssdata (Kr); +%! +%! Ae = [ 9.1900 0.0000 +%! 0.0000 -34.5297 ]; +%! +%! Be = [ -11.9593 +%! 86.3137 ]; +%! +%! Ce = [ 2.8955 -1.3566 ]; +%! +%! De = [ 0.0000 ]; +%! +%! HSVCe = [ 3.8253 0.2005 ].'; +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (Mo, Me, 1e-4); +%!assert (Info.hsvc, HSVCe, 1e-4); diff --git a/octave_packages/control-2.3.52/btamodred.m b/octave_packages/control-2.3.52/btamodred.m new file mode 100644 index 0000000..815da78 --- /dev/null +++ b/octave_packages/control-2.3.52/btamodred.m @@ -0,0 +1,304 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{Gr}, @var{info}] =} btamodred (@var{G}, @dots{}) +## @deftypefnx{Function File} {[@var{Gr}, @var{info}] =} btamodred (@var{G}, @var{nr}, @dots{}) +## @deftypefnx{Function File} {[@var{Gr}, @var{info}] =} btamodred (@var{G}, @var{opt}, @dots{}) +## @deftypefnx{Function File} {[@var{Gr}, @var{info}] =} btamodred (@var{G}, @var{nr}, @var{opt}, @dots{}) +## +## Model order reduction by frequency weighted Balanced Truncation Approximation (BTA) method. +## The aim of model reduction is to find an LTI system @var{Gr} of order +## @var{nr} (nr < n) such that the input-output behaviour of @var{Gr} +## approximates the one from original system @var{G}. +## +## BTA is an absolute error method which tries to minimize +## @iftex +## @tex +## $$ || G - G_r ||_{\\infty} = min $$ +## $$ || V \\ (G - G_r) \\ W ||_{\\infty} = min $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## ||G-Gr|| = min +## inf +## +## ||V (G-Gr) W|| = min +## inf +## @end example +## @end ifnottex +## where @var{V} and @var{W} denote output and input weightings. +## +## +## @strong{Inputs} +## @table @var +## @item G +## LTI model to be reduced. +## @item nr +## The desired order of the resulting reduced order system @var{Gr}. +## If not specified, @var{nr} is chosen automatically according +## to the description of key @var{'order'}. +## @item @dots{} +## Optional pairs of keys and values. @code{"key1", value1, "key2", value2}. +## @item opt +## Optional struct with keys as field names. +## Struct @var{opt} can be created directly or +## by command @command{options}. @code{opt.key1 = value1, opt.key2 = value2}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item Gr +## Reduced order state-space model. +## @item info +## Struct containing additional information. +## @table @var +## @item info.n +## The order of the original system @var{G}. +## @item info.ns +## The order of the @var{alpha}-stable subsystem of the original system @var{G}. +## @item info.hsv +## The Hankel singular values of the @var{alpha}-stable part of +## the original system @var{G}, ordered decreasingly. +## @item info.nu +## The order of the @var{alpha}-unstable subsystem of both the original +## system @var{G} and the reduced-order system @var{Gr}. +## @item info.nr +## The order of the obtained reduced order system @var{Gr}. +## @end table +## @end table +## +## +## @strong{Option Keys and Values} +## @table @var +## @item 'order', 'nr' +## The desired order of the resulting reduced order system @var{Gr}. +## If not specified, @var{nr} is chosen automatically such that states with +## Hankel singular values @var{info.hsv} > @var{tol1} are retained. +## +## @item 'left', 'output' +## LTI model of the left/output frequency weighting @var{V}. +## Default value is an identity matrix. +## +## @item 'right', 'input' +## LTI model of the right/input frequency weighting @var{W}. +## Default value is an identity matrix. +## +## @item 'method' +## Approximation method for the L-infinity norm to be used as follows: +## @table @var +## @item 'sr', 'b' +## Use the square-root Balance & Truncate method. +## @item 'bfsr', 'f' +## Use the balancing-free square-root Balance & Truncate method. Default method. +## @end table +## +## @item 'alpha' +## Specifies the ALPHA-stability boundary for the eigenvalues +## of the state dynamics matrix @var{G.A}. For a continuous-time +## system, ALPHA <= 0 is the boundary value for +## the real parts of eigenvalues, while for a discrete-time +## system, 0 <= ALPHA <= 1 represents the +## boundary value for the moduli of eigenvalues. +## The ALPHA-stability domain does not include the boundary. +## Default value is 0 for continuous-time systems and +## 1 for discrete-time systems. +## +## @item 'tol1' +## If @var{'order'} is not specified, @var{tol1} contains the tolerance for +## determining the order of the reduced model. +## For model reduction, the recommended value of @var{tol1} is +## c*info.hsv(1), where c lies in the interval [0.00001, 0.001]. +## Default value is info.ns*eps*info.hsv(1). +## If @var{'order'} is specified, the value of @var{tol1} is ignored. +## +## @item 'tol2' +## The tolerance for determining the order of a minimal +## realization of the ALPHA-stable part of the given +## model. TOL2 <= TOL1. +## If not specified, ns*eps*info.hsv(1) is chosen. +## +## @item 'gram-ctrb' +## Specifies the choice of frequency-weighted controllability +## Grammian as follows: +## @table @var +## @item 'standard' +## Choice corresponding to a combination method [4] +## of the approaches of Enns [1] and Lin-Chiu [2,3]. Default method. +## @item 'enhanced' +## Choice corresponding to the stability enhanced +## modified combination method of [4]. +## @end table +## +## @item 'gram-obsv' +## Specifies the choice of frequency-weighted observability +## Grammian as follows: +## @table @var +## @item 'standard' +## Choice corresponding to a combination method [4] +## of the approaches of Enns [1] and Lin-Chiu [2,3]. Default method. +## @item 'enhanced' +## Choice corresponding to the stability enhanced +## modified combination method of [4]. +## @end table +## +## @item 'alpha-ctrb' +## Combination method parameter for defining the +## frequency-weighted controllability Grammian. +## abs(alphac) <= 1. +## If alphac = 0, the choice of +## Grammian corresponds to the method of Enns [1], while if +## alphac = 1, the choice of Grammian corresponds +## to the method of Lin and Chiu [2,3]. +## Default value is 0. +## +## @item 'alpha-obsv' +## Combination method parameter for defining the +## frequency-weighted observability Grammian. +## abs(alphao) <= 1. +## If alphao = 0, the choice of +## Grammian corresponds to the method of Enns [1], while if +## alphao = 1, the choice of Grammian corresponds +## to the method of Lin and Chiu [2,3]. +## Default value is 0. +## +## @item 'equil', 'scale' +## Boolean indicating whether equilibration (scaling) should be +## performed on system @var{G} prior to order reduction. +## This is done by state transformations. +## Default value is true if @code{G.scaled == false} and +## false if @code{G.scaled == true}. +## Note that for @acronym{MIMO} models, proper scaling of both inputs and outputs +## is of utmost importance. The input and output scaling can @strong{not} +## be done by the equilibration option or the @command{prescale} command +## because these functions perform state transformations only. +## Furthermore, signals should not be scaled simply to a certain range. +## For all inputs (or outputs), a certain change should be of the same +## importance for the model. +## @end table +## +## +## Approximation Properties: +## @itemize @bullet +## @item +## Guaranteed stability of reduced models +## @item +## Lower guaranteed error bound +## @item +## Guaranteed a priori error bound +## @iftex +## @tex +## $$ \\sigma_{r+1} \\leq || (G-G_r) ||_{\\infty} \\leq 2 \\sum_{j=r+1}^{n} \\sigma_j $$ +## @end tex +## @end iftex +## @end itemize +## +## +## @strong{References}@* +## [1] Enns, D. +## Model reduction with balanced realizations: An error bound +## and a frequency weighted generalization. +## Proc. 23-th CDC, Las Vegas, pp. 127-132, 1984. +## +## [2] Lin, C.-A. and Chiu, T.-Y. +## Model reduction via frequency-weighted balanced realization. +## Control Theory and Advanced Technology, vol. 8, +## pp. 341-351, 1992. +## +## [3] Sreeram, V., Anderson, B.D.O and Madievski, A.G. +## New results on frequency weighted balanced reduction +## technique. +## Proc. ACC, Seattle, Washington, pp. 4004-4009, 1995. +## +## [4] Varga, A. and Anderson, B.D.O. +## Square-root balancing-free methods for the frequency-weighted +## balancing related model reduction. +## (report in preparation) +## +## +## @strong{Algorithm}@* +## Uses SLICOT AB09ID by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function [Gr, info] = btamodred (varargin) + + [Gr, info] = __modred_ab09id__ ("bta", varargin{:}); + +endfunction + + +%!shared Mo, Me, Info, HSVe +%! A = [ -26.4000, 6.4023, 4.3868; +%! 32.0000, 0, 0; +%! 0, 8.0000, 0 ]; +%! +%! B = [ 16 +%! 0 +%! 0 ]; +%! +%! C = [ 9.2994 1.1624 0.1090 ]; +%! +%! D = [ 0 ]; +%! +%! G = ss (A, B, C, D); % "scaled", false +%! +%! AV = [ -1.0000, 0, 4.0000, -9.2994, -1.1624, -0.1090; +%! 0, 2.0000, 0, -9.2994, -1.1624, -0.1090; +%! 0, 0, -3.0000, -9.2994, -1.1624, -0.1090; +%! 16.0000, 16.0000, 16.0000, -26.4000, 6.4023, 4.3868; +%! 0, 0, 0, 32.0000, 0, 0; +%! 0, 0, 0, 0, 8.0000, 0 ]; +%! +%! BV = [ 1 +%! 1 +%! 1 +%! 0 +%! 0 +%! 0 ]; +%! +%! CV = [ 1 1 1 0 0 0 ]; +%! +%! DV = [ 0 ]; +%! +%! V = ss (AV, BV, CV, DV); +%! +%! [Gr, Info] = btamodred (G, 2, "left", V); +%! [Ao, Bo, Co, Do] = ssdata (Gr); +%! +%! Ae = [ 9.1900 0.0000 +%! 0.0000 -34.5297 ]; +%! +%! Be = [ 11.9593 +%! 16.9329 ]; +%! +%! Ce = [ 2.8955 6.9152 ]; +%! +%! De = [ 0.0000 ]; +%! +%! HSVe = [ 3.8253 0.2005 ].'; +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (Mo, Me, 1e-4); +%!assert (Info.hsv, HSVe, 1e-4); diff --git a/octave_packages/control-2.3.52/care.m b/octave_packages/control-2.3.52/care.m new file mode 100644 index 0000000..c728790 --- /dev/null +++ b/octave_packages/control-2.3.52/care.m @@ -0,0 +1,258 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{l}, @var{g}] =} care (@var{a}, @var{b}, @var{q}, @var{r}) +## @deftypefnx {Function File} {[@var{x}, @var{l}, @var{g}] =} care (@var{a}, @var{b}, @var{q}, @var{r}, @var{s}) +## @deftypefnx {Function File} {[@var{x}, @var{l}, @var{g}] =} care (@var{a}, @var{b}, @var{q}, @var{r}, @var{[]}, @var{e}) +## @deftypefnx {Function File} {[@var{x}, @var{l}, @var{g}] =} care (@var{a}, @var{b}, @var{q}, @var{r}, @var{s}, @var{e}) +## Solve continuous-time algebraic Riccati equation (ARE). +## +## @strong{Inputs} +## @table @var +## @item a +## Real matrix (n-by-n). +## @item b +## Real matrix (n-by-m). +## @item q +## Real matrix (n-by-n). +## @item r +## Real matrix (m-by-m). +## @item s +## Optional real matrix (n-by-m). If @var{s} is not specified, a zero matrix is assumed. +## @item e +## Optional descriptor matrix (n-by-n). If @var{e} is not specified, an identity matrix is assumed. +## @end table +## +## @strong{Outputs} +## @table @var +## @item x +## Unique stabilizing solution of the continuous-time Riccati equation (n-by-n). +## @item l +## Closed-loop poles (n-by-1). +## @item g +## Corresponding gain matrix (m-by-n). +## @end table +## +## @strong{Equations} +## @example +## @group +## -1 +## A'X + XA - XB R B'X + Q = 0 +## +## -1 +## A'X + XA - (XB + S) R (B'X + S') + Q = 0 +## +## -1 +## G = R B'X +## +## -1 +## G = R (B'X + S') +## +## L = eig (A - B*G) +## @end group +## @end example +## @example +## @group +## -1 +## A'XE + E'XA - E'XB R B'XE + Q = 0 +## +## -1 +## A'XE + E'XA - (E'XB + S) R (B'XE + S') + Q = 0 +## +## -1 +## G = R B'XE +## +## -1 +## G = R (B'XE + S) +## +## L = eig (A - B*G, E) +## @end group +## @end example +## +## @strong{Algorithm}@* +## Uses SLICOT SB02OD and SG02AD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## +## @seealso{dare, lqr, dlqr, kalman} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.5.1 + +function [x, l, g] = care (a, b, q, r, s = [], e = []) + + ## TODO: extract feedback matrix g from SB02OD (and SG02AD) + + if (nargin < 4 || nargin > 6) + print_usage (); + endif + + if (! is_real_square_matrix (a, q, r)) + ## error ("care: a, q, r must be real and square"); + error ("care: %s, %s, %s must be real and square", \ + inputname (1), inputname (3), inputname (4)); + endif + + if (! is_real_matrix (b) || rows (a) != rows (b)) + ## error ("care: a and b must have the same number of rows"); + error ("care: %s and %s must have the same number of rows", \ + inputname (1), inputname (2)); + endif + + if (columns (r) != columns (b)) + ## error ("care: b and r must have the same number of columns"); + error ("care: %s and %s must have the same number of columns", \ + inputname (2), inputname (4)); + endif + + if (! is_real_matrix (s) && ! size_equal (s, b)) + ## error ("care: s(%dx%d) must be real and identically dimensioned with b(%dx%d)", + ## rows (s), columns (s), rows (b), columns (b)); + error ("care: %s(%dx%d) must be real and identically dimensioned with %s(%dx%d)", \ + inputname (5), rows (s), columns (s), inputname (2), rows (b), columns (b)); + endif + + if (! isempty (e) && (! is_real_square_matrix (e) || ! size_equal (e, a))) + ## error ("care: a and e must have the same number of rows"); + error ("care: %s and %s must have the same number of rows", \ + inputname (1), inputname (6)); + endif + + ## check stabilizability + if (! isstabilizable (a, b, e, [], 0)) + ## error ("care: (a, b) not stabilizable"); + error ("care: (%s, %s) not stabilizable", \ + inputname (1), inputname (2)); + endif + + ## check positive semi-definiteness + if (isempty (s)) + t = zeros (size (b)); + else + t = s; + endif + + m = [q, t; t.', r]; + + if (isdefinite (m) < 0) + ## error ("care: require [q, s; s.', r] >= 0"); + error ("care: require [%s, %s; %s.', %s] >= 0", \ + inputname (3), inputname (5), inputname (5), inputname (4)); + endif + + ## solve the riccati equation + if (isempty (e)) + if (isempty (s)) + [x, l] = slsb02od (a, b, q, r, b, false, false); + g = r \ (b.'*x); # gain matrix + else + [x, l] = slsb02od (a, b, q, r, s, false, true); + g = r \ (b.'*x + s.'); # gain matrix + endif + else + if (isempty (s)) + [x, l] = slsg02ad (a, e, b, q, r, b, false, false); + g = r \ (b.'*x*e); # gain matrix + else + [x, l] = slsg02ad (a, e, b, q, r, s, false, true); + g = r \ (b.'*x*e + s.'); # gain matrix + endif + endif + +endfunction + + +%!shared x, l, g, xe, le, ge +%! a = [-3 2 +%! 1 1]; +%! +%! b = [ 0 +%! 1]; +%! +%! c = [ 1 -1]; +%! +%! r = 3; +%! +%! [x, l, g] = care (a, b, c.'*c, r); +%! +%! xe = [ 0.5895 1.8216 +%! 1.8216 8.8188]; +%! +%! le = [-3.5026 +%! -1.4370]; +%! +%! ge = [ 0.6072 2.9396]; +%! +%!assert (x, xe, 1e-4); +%!assert (l, le, 1e-4); +%!assert (g, ge, 1e-4); + +%!shared x, l, g, xe, le, ge +%! a = [ 0.0 1.0 +%! 0.0 0.0]; +%! +%! b = [ 0.0 +%! 1.0]; +%! +%! c = [ 1.0 0.0 +%! 0.0 1.0 +%! 0.0 0.0]; +%! +%! d = [ 0.0 +%! 0.0 +%! 1.0]; +%! +%! [x, l, g] = care (a, b, c.'*c, d.'*d); +%! +%! xe = [ 1.7321 1.0000 +%! 1.0000 1.7321]; +%! +%! le = [-0.8660 + 0.5000i +%! -0.8660 - 0.5000i]; +%! +%! ge = [ 1.0000 1.7321]; +%! +%!assert (x, xe, 1e-4); +%!assert (l, le, 1e-4); +%!assert (g, ge, 1e-4); + +%!shared x, xe +%! a = [ 0.0 1.0 +%! 0.0 0.0 ]; +%! +%! e = [ 1.0 0.0 +%! 0.0 1.0 ]; +%! +%! b = [ 0.0 +%! 1.0 ]; +%! +%! c = [ 1.0 0.0 +%! 0.0 1.0 +%! 0.0 0.0 ]; +%! +%! d = [ 0.0 +%! 0.0 +%! 1.0 ]; +%! +%! x = care (a, b, c.'*c, d.'*d, [], e); +%! +%! xe = [ 1.7321 1.0000 +%! 1.0000 1.7321 ]; +%! +%!assert (x, xe, 1e-4); diff --git a/octave_packages/control-2.3.52/cfconred.m b/octave_packages/control-2.3.52/cfconred.m new file mode 100644 index 0000000..80e5af5 --- /dev/null +++ b/octave_packages/control-2.3.52/cfconred.m @@ -0,0 +1,334 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{Kr}, @var{info}] =} cfconred (@var{G}, @var{F}, @var{L}, @dots{}) +## @deftypefnx{Function File} {[@var{Kr}, @var{info}] =} cfconred (@var{G}, @var{F}, @var{L}, @var{ncr}, @dots{}) +## @deftypefnx{Function File} {[@var{Kr}, @var{info}] =} cfconred (@var{G}, @var{F}, @var{L}, @var{opt}, @dots{}) +## @deftypefnx{Function File} {[@var{Kr}, @var{info}] =} cfconred (@var{G}, @var{F}, @var{L}, @var{ncr}, @var{opt}, @dots{}) +## +## Reduction of state-feedback-observer based controller by coprime factorization (CF). +## Given a plant @var{G}, state feedback gain @var{F} and full observer gain @var{L}, +## determine a reduced order controller @var{Kr}. +## +## @strong{Inputs} +## @table @var +## @item G +## LTI model of the open-loop plant (A,B,C,D). +## It has m inputs, p outputs and n states. +## @item F +## Stabilizing state feedback matrix (m-by-n). +## @item L +## Stabilizing observer gain matrix (n-by-p). +## @item ncr +## The desired order of the resulting reduced order controller @var{Kr}. +## If not specified, @var{ncr} is chosen automatically according +## to the description of key @var{'order'}. +## @item @dots{} +## Optional pairs of keys and values. @code{"key1", value1, "key2", value2}. +## @item opt +## Optional struct with keys as field names. +## Struct @var{opt} can be created directly or +## by command @command{options}. @code{opt.key1 = value1, opt.key2 = value2}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item Kr +## State-space model of reduced order controller. +## @item info +## Struct containing additional information. +## @table @var +## @item info.hsv +## The Hankel singular values of the extended system?!?. +## The @var{n} Hankel singular values are ordered decreasingly. +## @item info.ncr +## The order of the obtained reduced order controller @var{Kr}. +## @end table +## @end table +## +## @strong{Option Keys and Values} +## @table @var +## @item 'order', 'ncr' +## The desired order of the resulting reduced order controller @var{Kr}. +## If not specified, @var{ncr} is chosen automatically such that states with +## Hankel singular values @var{info.hsv} > @var{tol1} are retained. +## +## @item 'method' +## Order reduction approach to be used as follows: +## @table @var +## @item 'sr-bta', 'b' +## Use the square-root Balance & Truncate method. +## @item 'bfsr-bta', 'f' +## Use the balancing-free square-root Balance & Truncate method. Default method. +## @item 'sr-spa', 's' +## Use the square-root Singular Perturbation Approximation method. +## @item 'bfsr-spa', 'p' +## Use the balancing-free square-root Singular Perturbation Approximation method. +## @end table +## +## @item 'cf' +## Specifies whether left or right coprime factorization is +## to be used as follows: +## @table @var +## @item 'left', 'l' +## Use left coprime factorization. Default method. +## @item 'right', 'r' +## Use right coprime factorization. +## @end table +## +## @item 'feedback' +## Specifies whether @var{F} and @var{L} are fed back positively or negatively: +## @table @var +## @item '+' +## A+BK and A+LC are both Hurwitz matrices. +## @item '-' +## A-BK and A-LC are both Hurwitz matrices. Default value. +## @end table +## +## @item 'tol1' +## If @var{'order'} is not specified, @var{tol1} contains the tolerance for +## determining the order of the reduced system. +## For model reduction, the recommended value of @var{tol1} is +## c*info.hsv(1), where c lies in the interval [0.00001, 0.001]. +## Default value is n*eps*info.hsv(1). +## If @var{'order'} is specified, the value of @var{tol1} is ignored. +## +## @item 'tol2' +## The tolerance for determining the order of a minimal +## realization of the coprime factorization controller. +## TOL2 <= TOL1. +## If not specified, n*eps*info.hsv(1) is chosen. +## +## @item 'equil', 'scale' +## Boolean indicating whether equilibration (scaling) should be +## performed on system @var{G} prior to order reduction. +## Default value is true if @code{G.scaled == false} and +## false if @code{G.scaled == true}. +## Note that for @acronym{MIMO} models, proper scaling of both inputs and outputs +## is of utmost importance. The input and output scaling can @strong{not} +## be done by the equilibration option or the @command{prescale} command +## because these functions perform state transformations only. +## Furthermore, signals should not be scaled simply to a certain range. +## For all inputs (or outputs), a certain change should be of the same +## importance for the model. +## @end table +## +## @strong{Algorithm}@* +## Uses SLICOT SB16BD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: December 2011 +## Version: 0.1 + +function [Kr, info] = cfconred (G, F, L, varargin) + + if (nargin < 3) + print_usage (); + endif + + if (! isa (G, "lti")) + error ("cfconred: first argument must be an LTI system"); + endif + + if (! is_real_matrix (F)) + error ("cfconred: second argument must be a real matrix"); + endif + + if (! is_real_matrix (L)) + error ("cfconred: third argument must be a real matrix"); + endif + + if (nargin > 3) # cfconred (G, F, L, ...) + if (is_real_scalar (varargin{1})) # cfconred (G, F, L, nr) + varargin = horzcat (varargin(2:end), {"order"}, varargin(1)); + endif + if (isstruct (varargin{1})) # cfconred (G, F, L, opt, ...), cfconred (G, F, L, nr, opt, ...) + varargin = horzcat (__opt2cell__ (varargin{1}), varargin(2:end)); + endif + ## order placed at the end such that nr from cfconred (G, F, L, nr, ...) + ## and cfconred (G, F, L, nr, opt, ...) overrides possible nr's from + ## key/value-pairs and inside opt struct (later keys override former keys, + ## nr > key/value > opt) + endif + + nkv = numel (varargin); # number of keys and values + + if (rem (nkv, 2)) + error ("cfconred: keys and values must come in pairs"); + endif + + [a, b, c, d, tsam, scaled] = ssdata (G); + [p, m] = size (G); + n = rows (a); + [mf, nf] = size (F); + [nl, pl] = size (L); + dt = isdt (G); + jobd = any (d(:)); + + if (mf != m || nf != n) + error ("cfconred: dimensions of state-feedback matrix (%dx%d) and plant (%dx%d, %d states) don't match", \ + mf, nf, p, m, n); + endif + + if (nl != n || pl != p) + error ("cfconred: dimensions of observer matrix (%dx%d) and plant (%dx%d, %d states) don't match", \ + nl, pl, p, m, n); + endif + + ## default arguments + tol1 = 0.0; + tol2 = 0.0; + jobcf = 0; + jobmr = 2; # balancing-free BTA + equil = scaled; # equil: 0 means "S", 1 means "N" + ordsel = 1; + ncr = 0; + negfb = true; # A-BK, A-LC Hurwitz + + + ## handle keys and values + for k = 1 : 2 : nkv + key = lower (varargin{k}); + val = varargin{k+1}; + switch (key) + case {"order", "ncr", "nr"} + [ncr, ordsel] = __modred_check_order__ (val, n); + + case "tol1" + tol1 = __modred_check_tol__ (val, "tol1"); + + case "tol2" + tol2 = __modred_check_tol__ (val, "tol2"); + + case "cf" + switch (lower (val(1))) + case "l" + jobcf = 0; + case "r" + jobcf = 1; + otherwise + error ("cfconred: '%s' is an invalid coprime factorization", val); + endswitch + + case "method" # approximation method + switch (tolower (val)) + case {"sr-bta", "b"} # 'B': use the square-root Balance & Truncate method + jobmr = 0; + case {"bfsr-bta", "f"} # 'F': use the balancing-free square-root Balance & Truncate method + jobmr = 1; + case {"sr-spa", "s"} # 'S': use the square-root Singular Perturbation Approximation method + jobmr = 2; + case {"bfsr-spa", "p"} # 'P': use the balancing-free square-root Singular Perturbation Approximation method + jobmr = 3; + otherwise + error ("cfconred: '%s' is an invalid approach", val); + endswitch + + case {"equil", "equilibrate", "equilibration", "scale", "scaling"} + equil = __modred_check_equil__ (val); + + case "feedback" + negfb = __conred_check_feedback_sign__ (val); + + otherwise + warning ("cfconred: invalid property name '%s' ignored", key); + endswitch + endfor + + + ## A - B*F --> A + B*F ; A - L*C --> A + L*C + if (negfb) + F = -F; + L = -L; + endif + + ## perform model order reduction + [acr, bcr, ccr, dcr, ncr, hsv] = slsb16bd (a, b, c, d, dt, equil, ncr, ordsel, jobd, jobmr, \ + F, L, jobcf, tol1, tol2); + + ## assemble reduced order controller + Kr = ss (acr, bcr, ccr, dcr, tsam); + + ## assemble info struct + info = struct ("ncr", ncr, "hsv", hsv); + +endfunction + + +%!shared Mo, Me, Info, HSVe +%! A = [ 0 1.0000 0 0 0 0 0 0 +%! 0 0 0 0 0 0 0 0 +%! 0 0 -0.0150 0.7650 0 0 0 0 +%! 0 0 -0.7650 -0.0150 0 0 0 0 +%! 0 0 0 0 -0.0280 1.4100 0 0 +%! 0 0 0 0 -1.4100 -0.0280 0 0 +%! 0 0 0 0 0 0 -0.0400 1.850 +%! 0 0 0 0 0 0 -1.8500 -0.040 ]; +%! +%! B = [ 0.0260 +%! -0.2510 +%! 0.0330 +%! -0.8860 +%! -4.0170 +%! 0.1450 +%! 3.6040 +%! 0.2800 ]; +%! +%! C = [ -.996 -.105 0.261 .009 -.001 -.043 0.002 -0.026 ]; +%! +%! D = [ 0.0 ]; +%! +%! G = ss (A, B, C, D); % "scaled", false +%! +%! F = [ 4.4721e-002 6.6105e-001 4.6986e-003 3.6014e-001 1.0325e-001 -3.7541e-002 -4.2685e-002 3.2873e-002 ]; +%! +%! L = [ 4.1089e-001 +%! 8.6846e-002 +%! 3.8523e-004 +%! -3.6194e-003 +%! -8.8037e-003 +%! 8.4205e-003 +%! 1.2349e-003 +%! 4.2632e-003 ]; +%! +%! [Kr, Info] = cfconred (G, F, L, 4, "method", "bfsr-bta", "cf", "left", "feedback", "+"); +%! [Ao, Bo, Co, Do] = ssdata (Kr); +%! +%! Ae = [ 0.5946 -0.7336 0.1914 -0.3368 +%! 0.5960 -0.0184 -0.1088 0.0207 +%! 1.2253 0.2043 0.1009 -1.4948 +%! -0.0330 -0.0243 1.3440 0.0035 ]; +%! +%! Be = [ 0.0015 +%! -0.0202 +%! 0.0159 +%! -0.0544 ]; +%! +%! Ce = [ 0.3534 0.0274 0.0337 -0.0320 ]; +%! +%! De = [ 0.0000 ]; +%! +%! HSVe = [ 4.9078 4.8745 3.8455 3.7811 1.2289 1.1785 0.5176 0.1148 ].'; +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (Mo, Me, 1e-4); +%!assert (Info.hsv, HSVe, 1e-4); diff --git a/octave_packages/control-2.3.52/covar.m b/octave_packages/control-2.3.52/covar.m new file mode 100644 index 0000000..d904c69 --- /dev/null +++ b/octave_packages/control-2.3.52/covar.m @@ -0,0 +1,91 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{p}, @var{q}] =} covar (@var{sys}, @var{w}) +## Return the steady-state covariance. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. +## @item w +## Intensity of Gaussian white noise inputs which drive @var{sys}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item p +## Output covariance. +## @item q +## State covariance. +## @end table +## +## @seealso{lyap, dlyap} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: January 2010 +## Version: 0.1 + +function [p, q] = covar (sys, w) + + if (nargin != 2) + print_usage (); + endif + + if (! isa (sys, "lti")) + error ("covar: first argument must be an LTI model"); + endif + + if (! isstable (sys)) + error ("covar: system must be stable"); + endif + + [a, b, c, d] = ssdata (sys); + + if (isct (sys)) + if (any (d(:))) + error ("covar: system is not strictly proper"); + endif + + q = lyap (a, b*w*b.'); + p = c*q*c.'; + else + q = dlyap (a, b*w*b.'); + p = c*q*c.' + d*w*d.'; + endif + +endfunction + +## continuous-time +%!shared p, q, p_exp, q_exp +%! sys = ss (-1, 1, 1, 0); +%! [p, q] = covar (sys, 5); +%! p_exp = 2.5000; +%! q_exp = 2.5000; +%!assert (p, p_exp, 1e-4); +%!assert (q, q_exp, 1e-4); + +## discrete-time +%!shared p, q, p_exp, q_exp +%! sys = ss ([-0.2, -0.5; 1, 0], [2; 0], [1, 0.5], [0], 0.1); +%! [p, q] = covar (sys, 5); +%! p_exp = 30.3167; +%! q_exp = [27.1493, -3.6199; -3.6199, 27.1493]; +%!assert (p, p_exp, 1e-4); +%!assert (q, q_exp, 1e-4); \ No newline at end of file diff --git a/octave_packages/control-2.3.52/ctrb.m b/octave_packages/control-2.3.52/ctrb.m new file mode 100644 index 0000000..e7f608c --- /dev/null +++ b/octave_packages/control-2.3.52/ctrb.m @@ -0,0 +1,83 @@ +## Copyright (C) 2009, 2010, 2012 Lukas F. Reichlin +## Copyright (C) 2009 Luca Favatella +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{co} =} ctrb (@var{sys}) +## @deftypefnx {Function File} {@var{co} =} ctrb (@var{a}, @var{b}) +## Return controllability matrix. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. +## @item a +## State transition matrix (n-by-n). +## @item b +## Input matrix (n-by-m). +## @end table +## +## @strong{Outputs} +## @table @var +## @item co +## Controllability matrix. +## @end table +## +## @strong{Equation} +## @iftex +## @tex +## $$ C_o = [ B \\ \\ AB \\ \\ A^2B \\ \\ldots \\ A^{n-1}B ] $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## 2 n-1 +## Co = [ B AB A B ... A B ] +## @end example +## @end ifnottex +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function co = ctrb (a, b) + + if (nargin == 1) # ctrb (sys) + if (! isa (a, "lti")) + error ("ctrb: argument must be an lti system"); + endif + [a, b] = ssdata (a); + elseif (nargin == 2) # ctrb (a, b) + if (! is_real_square_matrix (a) || ! is_real_matrix (b) || rows (a) != rows (b)) + error ("ctrb: invalid arguments (a, b)"); + endif + else + print_usage (); + endif + + n = rows (a); # number of states + k = 0:n-1; # exponents for a + + tmp = arrayfun (@(x) a^x*b, k, "uniformoutput", false); + + co = horzcat (tmp{:}); + +endfunction + + +%!assert (ctrb ([1, 0; 0, -0.5], [8; 8]), [8, 8; 8, -4]); diff --git a/octave_packages/control-2.3.52/ctrbf.m b/octave_packages/control-2.3.52/ctrbf.m new file mode 100644 index 0000000..b6c21ba --- /dev/null +++ b/octave_packages/control-2.3.52/ctrbf.m @@ -0,0 +1,122 @@ +## Copyright (C) 2010 Benjamin Fernandez +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{sysbar}, @var{T}, @var{K}] =} ctrbf (@var{sys}) +## @deftypefnx{Function File} {[@var{sysbar}, @var{T}, @var{K}] =} ctrbf (@var{sys}, @var{tol}) +## @deftypefnx{Function File} {[@var{Abar}, @var{Bbar}, @var{Cbar}, @var{T}, @var{K}] =} ctrbf (@var{A}, @var{B}, @var{C}) +## @deftypefnx{Function File} {[@var{Abar}, @var{Bbar}, @var{Cbar}, @var{T}, @var{K}] =} ctrbf (@var{A}, @var{B}, @var{C}, @var{TOL}) +## If Co=ctrb(A,B) has rank r <= n = SIZE(A,1), then there is a +## similarity transformation Tc such that Tc = [t1 t2] where t1 +## is the controllable subspace and t2 is orthogonal to t1 +## +## @example +## @group +## Abar = Tc \ A * Tc , Bbar = Tc \ B , Cbar = C * Tc +## @end group +## @end example +## +## and the transformed system has the form +## +## @example +## @group +## | Ac A12| | Bc | +## Abar = |----------|, Bbar = | ---|, Cbar = [Cc | Cnc]. +## | 0 Anc| | 0 | +## @end group +## @end example +## +## where (Ac,Bc) is controllable, and Cc(sI-Ac)^(-1)Bc = C(sI-A)^(-1)B. +## and the system is stabilizable if Anc has no eigenvalues in +## the right half plane. The last output K is a vector of length n +## containing the number of controllable states. +## @end deftypefn + +## Author: Benjamin Fernandez +## Created: 2010-04-30 +## Version: 0.1 + +function [ac, bc, cc, z, ncont] = ctrbf (a, b = [], c, tol = []) + + if (nargin < 1 || nargin > 4) + print_usage (); + endif + + islti = isa (a, "lti"); + + if (islti) + if (nargin > 2) + print_usage (); + endif + sys = a; + tol = b; + [a, b, c] = ssdata (sys); + else + if (nargin < 3) + print_usage (); + endif + sys = ss (a, b, c); + [a, b, c] = ssdata (sys); + endif + + if (isempty (tol)) + tol = 0; # default tolerance + elseif (! is_real_scalar (tol)) + error ("ctrbf: tol must be a real scalar"); + endif + + [ac, bc, cc, z, ncont] = sltb01ud (a, b, c, tol); + + if (islti) + ac = set (sys, "a", ac, "b", bc, "c", cc, "scaled", false); + bc = z; + cc = ncont; + endif + +endfunction + +%!shared Ao, Bo, Co, Zo, Ae, Be, Ce, Ze, NCONT +%! A = [ -1.0 0.0 0.0 +%! -2.0 -2.0 -2.0 +%! -1.0 0.0 -3.0 ]; +%! +%! B = [ 1.0 0.0 0.0 +%! 0.0 2.0 1.0 ].'; +%! +%! C = [ 0.0 2.0 1.0 +%! 1.0 0.0 0.0 ]; +%! +%! [Ao, Bo, Co, Zo, NCONT] = ctrbf (A, B, C); +%! +%! Ae = [ -3.0000 2.2361 +%! 0.0000 -1.0000 ]; +%! +%! Be = [ 0.0000 -2.2361 +%! 1.0000 0.0000 ]; +%! +%! Ce = [ -2.2361 0.0000 +%! 0.0000 1.0000 ]; +%! +%! Ze = [ 0.0000 1.0000 0.0000 +%! -0.8944 0.0000 -0.4472 +%! -0.4472 0.0000 0.8944 ]; +%! +%!assert (Ao(1:NCONT, 1:NCONT), Ae, 1e-4); +%!assert (Bo(1:NCONT, :), Be, 1e-4); +%!assert (Co(:, 1:NCONT), Ce, 1e-4); +%!assert (Zo, Ze, 1e-4); diff --git a/octave_packages/control-2.3.52/dare.m b/octave_packages/control-2.3.52/dare.m new file mode 100644 index 0000000..a25948e --- /dev/null +++ b/octave_packages/control-2.3.52/dare.m @@ -0,0 +1,206 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{l}, @var{g}] =} dare (@var{a}, @var{b}, @var{q}, @var{r}) +## @deftypefnx {Function File} {[@var{x}, @var{l}, @var{g}] =} dare (@var{a}, @var{b}, @var{q}, @var{r}, @var{s}) +## @deftypefnx {Function File} {[@var{x}, @var{l}, @var{g}] =} dare (@var{a}, @var{b}, @var{q}, @var{r}, @var{[]}, @var{e}) +## @deftypefnx {Function File} {[@var{x}, @var{l}, @var{g}] =} dare (@var{a}, @var{b}, @var{q}, @var{r}, @var{s}, @var{e}) +## Solve discrete-time algebraic Riccati equation (ARE). +## +## @strong{Inputs} +## @table @var +## @item a +## Real matrix (n-by-n). +## @item b +## Real matrix (n-by-m). +## @item q +## Real matrix (n-by-n). +## @item r +## Real matrix (m-by-m). +## @item s +## Optional real matrix (n-by-m). If @var{s} is not specified, a zero matrix is assumed. +## @item e +## Optional descriptor matrix (n-by-n). If @var{e} is not specified, an identity matrix is assumed. +## @end table +## +## @strong{Outputs} +## @table @var +## @item x +## Unique stabilizing solution of the discrete-time Riccati equation (n-by-n). +## @item l +## Closed-loop poles (n-by-1). +## @item g +## Corresponding gain matrix (m-by-n). +## @end table +## +## @strong{Equations} +## @example +## @group +## -1 +## A'XA - X - A'XB (B'XB + R) B'XA + Q = 0 +## +## -1 +## A'XA - X - (A'XB + S) (B'XB + R) (B'XA + S') + Q = 0 +## +## -1 +## G = (B'XB + R) B'XA +## +## -1 +## G = (B'XB + R) (B'XA + S') +## +## L = eig (A - B*G) +## @end group +## @end example +## @example +## @group +## -1 +## A'XA - E'XE - A'XB (B'XB + R) B'XA + Q = 0 +## +## -1 +## A'XA - E'XE - (A'XB + S) (B'XB + R) (B'XA + S') + Q = 0 +## +## -1 +## G = (B'XB + R) B'XA +## +## -1 +## G = (B'XB + R) (B'XA + S') +## +## L = eig (A - B*G, E) +## @end group +## @end example +## +## @strong{Algorithm}@* +## Uses SLICOT SB02OD and SG02AD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## +## @seealso{care, lqr, dlqr, kalman} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.5.1 + +function [x, l, g] = dare (a, b, q, r, s = [], e = []) + + ## TODO: extract feedback matrix g from SB02OD (and SG02AD) + + if (nargin < 4 || nargin > 6) + print_usage (); + endif + + if (! is_real_square_matrix (a, q, r)) + ## error ("dare: a, q, r must be real and square"); + error ("dare: %s, %s, %s must be real and square", \ + inputname (1), inputname (3), inputname (4)); + endif + + if (! is_real_matrix (b) || rows (a) != rows (b)) + ## error ("dare: a and b must have the same number of rows"); + error ("dare: %s and %s must have the same number of rows", \ + inputname (1), inputname (2)); + endif + + if (columns (r) != columns (b)) + ## error ("dare: b and r must have the same number of columns"); + error ("dare: %s and %s must have the same number of columns", \ + inputname (2), inputname (4)); + endif + + if (! is_real_matrix (s) && ! size_equal (s, b)) + ## error ("dare: s(%dx%d) must be real and identically dimensioned with b(%dx%d)", + ## rows (s), columns (s), rows (b), columns (b)); + error ("dare: %s(%dx%d) must be real and identically dimensioned with %s(%dx%d)", \ + inputname (5), rows (s), columns (s), inputname (2), rows (b), columns (b)); + endif + + if (! isempty (e) && (! is_real_square_matrix (e) || ! size_equal (e, a))) + ## error ("dare: a and e must have the same number of rows"); + error ("dare: %s and %s must have the same number of rows", \ + inputname (1), inputname (6)); + endif + + ## check stabilizability + if (! isstabilizable (a, b, e, [], 1)) + ## error ("dare: (a, b) not stabilizable"); + error ("dare: (%s, %s) not stabilizable", \ + inputname (1), inputname (2)); + endif + + ## check positive semi-definiteness + if (isempty (s)) + t = zeros (size (b)); + else + t = s; + endif + + m = [q, t; t.', r]; + + if (isdefinite (m) < 0) + ## error ("dare: require [q, s; s.', r] >= 0"); + error ("dare: require [%s, %s; %s.', %s] >= 0", \ + inputname (3), inputname (5), inputname (5), inputname (4)); + endif + + ## solve the riccati equation + if (isempty (e)) + if (isempty (s)) + [x, l] = slsb02od (a, b, q, r, b, true, false); + g = (r + b.'*x*b) \ (b.'*x*a); # gain matrix + else + [x, l] = slsb02od (a, b, q, r, s, true, true); + g = (r + b.'*x*b) \ (b.'*x*a + s.'); # gain matrix + endif + else + if (isempty (s)) + [x, l] = slsg02ad (a, e, b, q, r, b, true, false); + g = (r + b.'*x*b) \ (b.'*x*a); # gain matrix + else + [x, l] = slsg02ad (a, e, b, q, r, s, true, true); + g = (r + b.'*x*b) \ (b.'*x*a + s.'); # gain matrix + endif + endif + +endfunction + + +%!shared x, l, g, xe, le, ge +%! a = [ 0.4 1.7 +%! 0.9 3.8]; +%! +%! b = [ 0.8 +%! 2.1]; +%! +%! c = [ 1 -1]; +%! +%! r = 3; +%! +%! [x, l, g] = dare (a, b, c.'*c, r); +%! +%! xe = [ 1.5354 1.2623 +%! 1.2623 10.5596]; +%! +%! le = [-0.0022 +%! 0.2454]; +%! +%! ge = [ 0.4092 1.7283]; +%! +%!assert (x, xe, 1e-4); +%!assert (sort (l), sort (le), 1e-4); +%!assert (g, ge, 1e-4); + +## TODO: add more tests (nonempty s and/or e) diff --git a/octave_packages/control-2.3.52/dlqe.m b/octave_packages/control-2.3.52/dlqe.m new file mode 100644 index 0000000..36f3a08 --- /dev/null +++ b/octave_packages/control-2.3.52/dlqe.m @@ -0,0 +1,113 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## Copyright (C) 2012 Megan Zagrobelny +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{p}, @var{z}, @var{e}] =} dlqe (@var{a}, @var{g}, @var{c}, @var{q}, @var{r}) +## @deftypefnx {Function File} {[@var{m}, @var{p}, @var{z}, @var{e}] =} dlqe (@var{a}, @var{g}, @var{c}, @var{q}, @var{r}, @var{s}) +## @deftypefnx {Function File} {[@var{m}, @var{p}, @var{z}, @var{e}] =} dlqe (@var{a}, @var{[]}, @var{c}, @var{q}, @var{r}) +## @deftypefnx {Function File} {[@var{m}, @var{p}, @var{z}, @var{e}] =} dlqe (@var{a}, @var{[]}, @var{c}, @var{q}, @var{r}, @var{s}) +## Kalman filter for discrete-time systems. +## +## @example +## @group +## x[k] = Ax[k] + Bu[k] + Gw[k] (State equation) +## y[k] = Cx[k] + Du[k] + v[k] (Measurement Equation) +## E(w) = 0, E(v) = 0, cov(w) = Q, cov(v) = R, cov(w,v) = S +## @end group +## @end example +## +## @strong{Inputs} +## @table @var +## @item a +## State transition matrix of discrete-time system (n-by-n). +## @item g +## Process noise matrix of discrete-time system (n-by-g). +## If @var{g} is empty @code{[]}, an identity matrix is assumed. +## @item c +## Measurement matrix of discrete-time system (p-by-n). +## @item q +## Process noise covariance matrix (g-by-g). +## @item r +## Measurement noise covariance matrix (p-by-p). +## @item s +## Optional cross term covariance matrix (g-by-p), s = cov(w,v). +## If @var{s} is empty @code{[]} or not specified, a zero matrix is assumed. +## @end table +## +## @strong{Outputs} +## @table @var +## @item m +## Kalman filter gain matrix (n-by-p). +## @item p +## Unique stabilizing solution of the discrete-time Riccati equation (n-by-n). +## Symmetric matrix. +## @item z +## Error covariance (n-by-n), cov(x(k|k)-x) +## @item e +## Closed-loop poles (n-by-1). +## @end table +## +## @strong{Equations} +## @example +## @group +## x[k|k] = x[k|k-1] + M(y[k] - Cx[k|k-1] - Du[k]) +## +## x[k+1|k] = Ax[k|k] + Bu[k] for S=0 +## +## x[k+1|k] = Ax[k|k] + Bu[k] + G*S*(C*P*C' + R)^-1*(y[k] - C*x[k|k-1]) for non-zero S +## +## +## E = eig(A - A*M*C) for S=0 +## +## E = eig(A - A*M*C - G*S*(C*P*C' + Rv)^-1*C) for non-zero S +## +## @end group +## @end example +## @seealso{dare, care, dlqr, lqr, lqe} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: April 2012 +## Version: 0.1 + +function [m, p, z, e] = dlqe (a, g, c, q, r, s = []) + + if (nargin < 5 || nargin > 6) + print_usage (); + endif + + if (isempty (g)) + [p, e] = dare (a.', c.', q, r, s); # dlqe (a, [], c, q, r, s), g=I + elseif (columns (g) != rows (q) || ! issquare (q)) + error ("dlqe: matrices g(%dx%d) and q(%dx%d) have incompatible dimensions", \ + rows (g), columns (g), rows (q), columns (q)); + elseif (isempty (s)) + [p, e] = dare (a.', c.', g*q*g.', r); + elseif (columns (g) != rows (s)) + error ("dlqe: matrices g(%dx%d) and s(%dx%d) have incompatible dimensions", \ + rows (g), columns (g), rows (s), columns (s)); + else + [p, e] = dare (a.', c.', g*q*g.', r, g*s); + endif + + m = p*c.' / (c*p*c.' + r); + + z = p - m*c*p; + z = (z + z.') / 2; + +endfunction diff --git a/octave_packages/control-2.3.52/dlqr.m b/octave_packages/control-2.3.52/dlqr.m new file mode 100644 index 0000000..3ca03f4 --- /dev/null +++ b/octave_packages/control-2.3.52/dlqr.m @@ -0,0 +1,97 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{g}, @var{x}, @var{l}] =} dlqr (@var{sys}, @var{q}, @var{r}) +## @deftypefnx {Function File} {[@var{g}, @var{x}, @var{l}] =} dlqr (@var{sys}, @var{q}, @var{r}, @var{s}) +## @deftypefnx {Function File} {[@var{g}, @var{x}, @var{l}] =} dlqr (@var{a}, @var{b}, @var{q}, @var{r}) +## @deftypefnx {Function File} {[@var{g}, @var{x}, @var{l}] =} dlqr (@var{a}, @var{b}, @var{q}, @var{r}, @var{s}) +## @deftypefnx {Function File} {[@var{g}, @var{x}, @var{l}] =} dlqr (@var{a}, @var{b}, @var{q}, @var{r}, @var{[]}, @var{e}) +## @deftypefnx {Function File} {[@var{g}, @var{x}, @var{l}] =} dlqr (@var{a}, @var{b}, @var{q}, @var{r}, @var{s}, @var{e}) +## Linear-quadratic regulator for discrete-time systems. +## +## @strong{Inputs} +## @table @var +## @item sys +## Continuous or discrete-time LTI model (p-by-m, n states). +## @item a +## State transition matrix of discrete-time system (n-by-n). +## @item b +## Input matrix of discrete-time system (n-by-m). +## @item q +## State weighting matrix (n-by-n). +## @item r +## Input weighting matrix (m-by-m). +## @item s +## Optional cross term matrix (n-by-m). If @var{s} is not specified, a zero matrix is assumed. +## @item e +## Optional descriptor matrix (n-by-n). If @var{e} is not specified, an identity matrix is assumed. +## @end table +## +## @strong{Outputs} +## @table @var +## @item g +## State feedback matrix (m-by-n). +## @item x +## Unique stabilizing solution of the discrete-time Riccati equation (n-by-n). +## @item l +## Closed-loop poles (n-by-1). +## @end table +## +## @strong{Equations} +## @example +## @group +## x[k+1] = A x[k] + B u[k], x[0] = x0 +## +## inf +## J(x0) = SUM (x' Q x + u' R u + 2 x' S u) +## k=0 +## +## L = eig (A - B*G) +## @end group +## @end example +## @seealso{dare, care, lqr} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.2 + +function [g, x, l] = dlqr (a, b, q, r = [], s = [], e = []) + + if (nargin < 3 || nargin > 6) + print_usage (); + endif + + if (isa (a, "lti")) + s = r; + r = q; + q = b; + [a, b, c, d, e, tsam] = dssdata (a, []); + elseif (nargin < 4) + print_usage (); + else + tsam = 1; # any value > 0 could be used here + endif + + if (issample (tsam, -1)) + [x, l, g] = dare (a, b, q, r, s, e); + else + [x, l, g] = care (a, b, q, r, s, e); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/dlyap.m b/octave_packages/control-2.3.52/dlyap.m new file mode 100644 index 0000000..d6441a9 --- /dev/null +++ b/octave_packages/control-2.3.52/dlyap.m @@ -0,0 +1,166 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{x} =} dlyap (@var{a}, @var{b}) +## @deftypefnx{Function File} {@var{x} =} dlyap (@var{a}, @var{b}, @var{c}) +## @deftypefnx{Function File} {@var{x} =} dlyap (@var{a}, @var{b}, @var{[]}, @var{e}) +## Solve discrete-time Lyapunov or Sylvester equations. +## +## @strong{Equations} +## @example +## @group +## AXA' - X + B = 0 (Lyapunov Equation) +## +## AXB' - X + C = 0 (Sylvester Equation) +## +## AXA' - EXE' + B = 0 (Generalized Lyapunov Equation) +## @end group +## @end example +## +## @strong{Algorithm}@* +## Uses SLICOT SB03MD, SB04QD and SG03AD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## +## @seealso{dlyapchol, lyap, lyapchol} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: January 2010 +## Version: 0.2.1 + +function [x, scale] = dlyap (a, b, c, e) + + scale = 1; + + switch (nargin) + case 2 # Lyapunov equation + + if (! is_real_square_matrix (a, b)) + ## error ("dlyap: a, b must be real and square"); + error ("dlyap: %s, %s must be real and square", \ + inputname (1), inputname (2)); + endif + + if (rows (a) != rows (b)) + ## error ("dlyap: a, b must have the same number of rows"); + error ("dlyap: %s, %s must have the same number of rows", \ + inputname (1), inputname (2)); + endif + + [x, scale] = slsb03md (a, -b, true); # AXA' - X = -B + + ## x /= scale; # 0 < scale <= 1 + + case 3 # Sylvester equation + + if (! is_real_square_matrix (a, b)) + ## error ("dlyap: a, b must be real and square"); + error ("dlyap: %s, %s must be real and square", \ + inputname (1), inputname (2)); + endif + + if (! is_real_matrix (c) || rows (c) != rows (a) || columns (c) != columns (b)) + ## error ("dlyap: c must be a real (%dx%d) matrix", rows (a), columns (b)); + error ("dlyap: %s must be a real (%dx%d) matrix", \ + rows (a), columns (b), inputname (3)); + endif + + x = slsb04qd (-a, b, c); # AXB' - X = -C + + case 4 # generalized Lyapunov equation + + if (! isempty (c)) + print_usage (); + endif + + if (! is_real_square_matrix (a, b, e)) + ## error ("dlyap: a, b, e must be real and square"); + error ("dlyap: %s, %s, %s must be real and square", \ + inputname (1), inputname (2), inputname (4)); + endif + + if (rows (b) != rows (a) || rows (e) != rows (a)) + ## error ("dlyap: a, b, e must have the same number of rows"); + error ("dlyap: %s, %s, %s must have the same number of rows", \ + inputname (1), inputname (2), inputname (4)); + endif + + if (! issymmetric (b)) + ## error ("dlyap: b must be symmetric"); + error ("dlyap: %s must be symmetric", \ + inputname (2)); + endif + + [x, scale] = slsg03ad (a, e, -b, true); # AXA' - EXE' = -B + + ## x /= scale; # 0 < scale <= 1 + + otherwise + print_usage (); + + endswitch + + if (scale < 1) + warning ("dlyap: solution scaled by %g to prevent overflow", scale); + endif + +endfunction + + +## Lyapunov +%!shared X, X_exp +%! A = [3.0 1.0 1.0 +%! 1.0 3.0 0.0 +%! 0.0 0.0 3.0]; +%! +%! B = [25.0 24.0 15.0 +%! 24.0 32.0 8.0 +%! 15.0 8.0 40.0]; +%! +%! X = dlyap (A.', -B); +%! +%! X_exp = [2.0000 1.0000 1.0000 +%! 1.0000 3.0000 0.0000 +%! 1.0000 0.0000 4.0000]; +%! +%!assert (X, X_exp, 1e-4); + +## Sylvester +%!shared X, X_exp +%! A = [1.0 2.0 3.0 +%! 6.0 7.0 8.0 +%! 9.0 2.0 3.0]; +%! +%! B = [7.0 2.0 3.0 +%! 2.0 1.0 2.0 +%! 3.0 4.0 1.0]; +%! +%! C = [271.0 135.0 147.0 +%! 923.0 494.0 482.0 +%! 578.0 383.0 287.0]; +%! +%! X = dlyap (-A, B, C); +%! +%! X_exp = [2.0000 3.0000 6.0000 +%! 4.0000 7.0000 1.0000 +%! 5.0000 3.0000 2.0000]; +%! +%!assert (X, X_exp, 1e-4); + +## Generalized Lyapunov +## TODO: add a test \ No newline at end of file diff --git a/octave_packages/control-2.3.52/dlyapchol.m b/octave_packages/control-2.3.52/dlyapchol.m new file mode 100644 index 0000000..2475bb4 --- /dev/null +++ b/octave_packages/control-2.3.52/dlyapchol.m @@ -0,0 +1,106 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{u} =} dlyapchol (@var{a}, @var{b}) +## @deftypefnx{Function File} {@var{u} =} dlyapchol (@var{a}, @var{b}, @var{e}) +## Compute Cholesky factor of discrete-time Lyapunov equations. +## +## @strong{Equations} +## @example +## @group +## A U' U A' - U' U + B B' = 0 (Lyapunov Equation) +## +## A U' U A' - E U' U E' + B B' = 0 (Generalized Lyapunov Equation) +## @end group +## @end example +## +## @strong{Algorithm}@* +## Uses SLICOT SB03OD and SG03BD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## +## @seealso{dlyap, lyap, lyapchol} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: January 2010 +## Version: 0.2.1 + +function [u, scale] = dlyapchol (a, b, e) + + switch (nargin) + case 2 + + if (! is_real_square_matrix (a)) + ## error ("dlyapchol: a must be real and square"); + error ("dlyapchol: %s must be real and square", \ + inputname (1)); + endif + + if (! is_real_matrix (b)) + ## error ("dlyapchol: b must be real") + error ("dlyapchol: %s must be real", \ + inputname (2)) + endif + + if (rows (a) != rows (b)) + ## error ("dlyapchol: a and b must have the same number of rows"); + error ("dlyapchol: %s and %s must have the same number of rows", \ + inputname (1), inputname (2)); + endif + + [u, scale] = slsb03od (a.', b.', true); + + ## NOTE: TRANS = 'T' not suitable because we need U' U, not U U' + + case 3 + + if (! is_real_square_matrix (a, e)) + ## error ("dlyapchol: a, e must be real and square"); + error ("dlyapchol: %s, %s must be real and square", \ + inputname (1), inputname (3)); + endif + + if (! is_real_matrix (b)) + ## error ("dlyapchol: b must be real"); + error ("dlyapchol: %s must be real", \ + inputname (2)); + endif + + if (rows (b) != rows (a) || rows (e) != rows (a)) + ## error ("dlyapchol: a, b, e must have the same number of rows"); + error ("dlyapchol: %s, %s, %s must have the same number of rows", \ + inputname (1), inputname (2), inputname (3)); + endif + + [u, scale] = slsg03bd (a.', e.', b.', true); + + ## NOTE: TRANS = 'T' not suitable because we need U' U, not U U' + + otherwise + print_usage (); + + endswitch + + if (scale < 1) + warning ("dlyapchol: solution scaled by %g to prevent overflow", scale); + endif + +endfunction + + +## TODO: add tests diff --git a/octave_packages/control-2.3.52/doc-cache b/octave_packages/control-2.3.52/doc-cache new file mode 100644 index 0000000..8e86f9d --- /dev/null +++ b/octave_packages/control-2.3.52/doc-cache @@ -0,0 +1,5035 @@ +# Created by Octave 3.6.2, Mon Jun 25 21:47:37 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 71 +# name: +# type: sq_string +# elements: 1 +# length: 8 +Anderson + + +# name: +# type: sq_string +# elements: 1 +# length: 64 +Frequency-weighted coprime factorization controller reduction. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +Frequency-weighted coprime factorization controller reduction. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +BMWengine + + +# name: +# type: sq_string +# elements: 1 +# length: 1283 + -- Function File: SYS = BMWengine () + -- Function File: SYS = BMWengine ("SCALED") + -- Function File: SYS = BMWengine ("UNSCALED") + Model of the BMW 4-cylinder engine at ETH Zurich's control + laboratory. + OPERATING POINT + Drosselklappenstellung alpha_DK = 10.3 Grad + Saugrohrdruck p_s = 0.48 bar + Motordrehzahl n = 860 U/min + Lambda-Messwert lambda = 1.000 + Relativer Wandfilminhalt nu = 1 + + INPUTS + U_1 Sollsignal Drosselklappenstellung [Grad] + U_2 Relative Einspritzmenge [-] + U_3 Zuendzeitpunkt [Grad KW] + M_L Lastdrehmoment [Nm] + + STATES + X_1 Drosselklappenstellung [Grad] + X_2 Saugrohrdruck [bar] + X_3 Motordrehzahl [U/min] + X_4 Messwert Lamba-Sonde [-] + X_5 Relativer Wandfilminhalt [-] + + OUTPUTS + Y_1 Motordrehzahl [U/min] + Y_2 Messwert Lambda-Sonde [-] + + SCALING + U_1N, X_1N 1 Grad + U_2N, X_4N, X_5N, Y_2N 0.05 + U_3N 1.6 Grad KW + X_2N 0.05 bar + X_3N, Y_1N 200 U/min + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +Model of the BMW 4-cylinder engine at ETH Zurich's control laboratory. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +Boeing707 + + +# name: +# type: sq_string +# elements: 1 +# length: 392 + -- Function File: SYS = Boeing707 () + Creates a linearized state-space model of a Boeing 707-321 aircraft + at V=80 m/s (M = 0.26, GA0 = -3 deg, ALPHA0 = 4 deg, KAPPA = 50 + deg). + + System inputs: (1) thrust and (2) elevator angle. + + System outputs: (1) airspeed and (2) pitch angle. + + *Reference*: R. Brockhaus: `Flugregelung' (Flight Control), + Springer, 1994. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Creates a linearized state-space model of a Boeing 707-321 aircraft at +V=80 m/s + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +MDSSystem + + +# name: +# type: sq_string +# elements: 1 +# length: 156 +Robust control of a mass-damper-spring system. Type `which MDSSystem' +to locate, `edit MDSSystem' to open and simply `MDSSystem' to run the +example file. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Robust control of a mass-damper-spring system. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +Madievski + + +# name: +# type: sq_string +# elements: 1 +# length: 42 +Frequency-weighted controller reduction. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Frequency-weighted controller reduction. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +WestlandLynx + + +# name: +# type: sq_string +# elements: 1 +# length: 1288 + -- Function File: SYS = WestlandLynx () + Model of the Westland Lynx Helicopter about hover. + INPUTS + main rotor collective + longitudinal cyclic + lateral cyclic + tail rotor collective + + STATES + pitch attitude theta [rad] + roll attitude phi [rad] + roll rate (body-axis) p [rad/s] + pitch rate (body-axis) q [rad/s] + yaw rate xi [rad/s] + forward velocity v_x [ft/s] + lateral velocity v_y [ft/s] + vertical velocity v_z [ft/s] + + OUTPUTS + heave velocity H_dot [ft/s] + pitch attitude theta [rad] + roll attitude phi [rad] + heading rate psi_dot [rad/s] + roll rate p [rad/s] + pitch rate q [rad/s] + + Reference: + Skogestad, S. and Postlethwaite I. + Multivariable Feedback Control: Analysis and Design + Second Edition + Wiley 2005 + http://www.nt.ntnu.no/users/skoge/book/2nd_edition/matlab_m/matfiles.html + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Model of the Westland Lynx Helicopter about hover. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +augw + + +# name: +# type: sq_string +# elements: 1 +# length: 3059 + -- Function File: P = augw (G, W1, W2, W3) + Extend plant for stacked S/KS/T problem. Subsequently, the robust + control problem can be solved by h2syn or hinfsyn. + + *Inputs* + G + LTI model of plant. + + W1 + LTI model of performance weight. Bounds the largest singular + values of sensitivity S. Model must be empty `[]', SISO or + of appropriate size. + + W2 + LTI model to penalize large control inputs. Bounds the + largest singular values of KS. Model must be empty `[]', + SISO or of appropriate size. + + W3 + LTI model of robustness and noise sensitivity weight. Bounds + the largest singular values of complementary sensitivity T. + Model must be empty `[]', SISO or of appropriate size. + + All inputs must be proper/realizable. Scalars, vectors and + matrices are possible instead of LTI models. + + *Outputs* + P + State-space model of augmented plant. + + *Block Diagram* + + | W1 | -W1*G | z1 = W1 r - W1 G u + | 0 | W2 | z2 = W2 u + P = | 0 | W3*G | z3 = W3 G u + |----+-------| + | I | -G | e = r - G u + + +------+ z1 + +---------------------------------------->| W1 |-----> + | +------+ + | +------+ z2 + | +---------------------->| W2 |-----> + | | +------+ + r + e | +--------+ u | +--------+ y +------+ z3 + ----->(+)---+-->| K(s) |----+-->| G(s) |----+---->| W3 |-----> + ^ - +--------+ +--------+ | +------+ + | | + +----------------------------------------+ + + +--------+ + | |-----> z1 (p1x1) z1 = W1 e + r (px1) ----->| P(s) |-----> z2 (p2x1) z2 = W2 u + | |-----> z3 (p3x1) z3 = W3 y + u (mx1) ----->| |-----> e (px1) e = r - y + +--------+ + + +--------+ + r ----->| |-----> z + | P(s) | + u +---->| |-----+ e + | +--------+ | + | | + | +--------+ | + +-----| K(s) |<----+ + +--------+ + + Reference: + Skogestad, S. and Postlethwaite I. + Multivariable Feedback Control: Analysis and Design + Second Edition + Wiley 2005 + Chapter 3.8: General Control Problem Formulation + + See also: h2syn, hinfsyn, mixsyn + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Extend plant for stacked S/KS/T problem. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +bode + + +# name: +# type: sq_string +# elements: 1 +# length: 890 + -- Function File: [MAG, PHA, W] = bode (SYS) + -- Function File: [MAG, PHA, W] = bode (SYS, W) + Bode diagram of frequency response. If no output arguments are + given, the response is printed on the screen. + + *Inputs* + SYS + LTI system. Must be a single-input and single-output (SISO) + system. + + W + Optional vector of frequency values. If W is not specified, + it is calculated by the zeros and poles of the system. + Alternatively, the cell `{wmin, wmax}' specifies a frequency + range, where WMIN and WMAX denote minimum and maximum + frequencies in rad/s. + + *Outputs* + MAG + Vector of magnitude. Has length of frequency vector W. + + PHA + Vector of phase. Has length of frequency vector W. + + W + Vector of frequency values used. + + See also: nichols, nyquist, sigma + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Bode diagram of frequency response. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +bodemag + + +# name: +# type: sq_string +# elements: 1 +# length: 831 + -- Function File: [MAG, W] = bodemag (SYS) + -- Function File: [MAG, W] = bodemag (SYS, W) + Bode magnitude diagram of frequency response. If no output + arguments are given, the response is printed on the screen. + + *Inputs* + SYS + LTI system. Must be a single-input and single-output (SISO) + system. + + W + Optional vector of frequency values. If W is not specified, + it is calculated by the zeros and poles of the system. + Alternatively, the cell `{wmin, wmax}' specifies a frequency + range, where WMIN and WMAX denote minimum and maximum + frequencies in rad/s. + + *Outputs* + MAG + Vector of magnitude. Has length of frequency vector W. + + W + Vector of frequency values used. + + See also: bode, nichols, nyquist, sigma + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Bode magnitude diagram of frequency response. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +bstmodred + + +# name: +# type: sq_string +# elements: 1 +# length: 6097 + -- Function File: [GR, INFO] = bstmodred (G, ...) + -- Function File: [GR, INFO] = bstmodred (G, NR, ...) + -- Function File: [GR, INFO] = bstmodred (G, OPT, ...) + -- Function File: [GR, INFO] = bstmodred (G, NR, OPT, ...) + Model order reduction by Balanced Stochastic Truncation (BST) + method. The aim of model reduction is to find an LTI system GR of + order NR (nr < n) such that the input-output behaviour of GR + approximates the one from original system G. + + BST is a relative error method which tries to minimize + -1 + ||G (G-Gr)|| = min + inf + + *Inputs* + G + LTI model to be reduced. + + NR + The desired order of the resulting reduced order system GR. + If not specified, NR is chosen automatically according to the + description of key 'ORDER'. + + ... + Optional pairs of keys and values. `"key1", value1, "key2", + value2'. + + OPT + Optional struct with keys as field names. Struct OPT can be + created directly or by command `options'. `opt.key1 = + value1, opt.key2 = value2'. + + *Outputs* + GR + Reduced order state-space model. + + INFO + Struct containing additional information. + INFO.N + The order of the original system G. + + INFO.NS + The order of the ALPHA-stable subsystem of the original + system G. + + INFO.HSV + The Hankel singular values of the phase system + corresponding to the ALPHA-stable part of the original + system G. The NS Hankel singular values are ordered + decreasingly. + + INFO.NU + The order of the ALPHA-unstable subsystem of both the + original system G and the reduced-order system GR. + + INFO.NR + The order of the obtained reduced order system GR. + + *Option Keys and Values* + 'ORDER', 'NR' + The desired order of the resulting reduced order system GR. + If not specified, NR is the sum of NU and the number of + Hankel singular values greater than `MAX(TOL1,NS*EPS)'; NR + can be further reduced to ensure that `HSV(NR-NU) > + HSV(NR+1-NU)'. + + 'METHOD' + Approximation method for the H-infinity norm. Valid values + corresponding to this key are: + 'SR-BTA', 'B' + Use the square-root Balance & Truncate method. + + 'BFSR-BTA', 'F' + Use the balancing-free square-root Balance & Truncate + method. Default method. + + 'SR-SPA', 'S' + Use the square-root Singular Perturbation Approximation + method. + + 'BFSR-SPA', 'P' + Use the balancing-free square-root Singular Perturbation + Approximation method. + + 'ALPHA' + Specifies the ALPHA-stability boundary for the eigenvalues of + the state dynamics matrix G.A. For a continuous-time system, + ALPHA <= 0 is the boundary value for the real parts of + eigenvalues, while for a discrete-time system, 0 <= ALPHA <= + 1 represents the boundary value for the moduli of eigenvalues. + The ALPHA-stability domain does not include the boundary. + Default value is 0 for continuous-time systems and 1 for + discrete-time systems. + + 'BETA' + Use `[G, beta*I]' as new system G to combine absolute and + relative error methods. BETA > 0 specifies the + absolute/relative error weighting parameter. A large + positive value of BETA favours the minimization of the + absolute approximation error, while a small value of BETA is + appropriate for the minimization of the relative error. BETA + = 0 means a pure relative error method and can be used only + if rank(G.D) = rows(G.D) which means that the feedthrough + matrice must not be rank-deficient. Default value is 0. + + 'TOL1' + If 'ORDER' is not specified, TOL1 contains the tolerance for + determining the order of reduced system. For model + reduction, the recommended value of TOL1 lies in the interval + [0.00001, 0.001]. TOL1 < 1. If TOL1 <= 0 on entry, the used + default value is TOL1 = NS*EPS, where NS is the number of + ALPHA-stable eigenvalues of A and EPS is the machine + precision. If 'ORDER' is specified, the value of TOL1 is + ignored. + + 'TOL2' + The tolerance for determining the order of a minimal + realization of the phase system (see METHOD) corresponding to + the ALPHA-stable part of the given system. The recommended + value is TOL2 = NS*EPS. TOL2 <= TOL1 < 1. This value is + used by default if 'TOL2' is not specified or if TOL2 <= 0 on + entry. + + 'EQUIL', 'SCALE' + Boolean indicating whether equilibration (scaling) should be + performed on system G prior to order reduction. Default + value is true if `G.scaled == false' and false if `G.scaled + == true'. Note that for MIMO models, proper scaling of both + inputs and outputs is of utmost importance. The input and + output scaling can *not* be done by the equilibration option + or the `prescale' command because these functions perform + state transformations only. Furthermore, signals should not + be scaled simply to a certain range. For all inputs (or + outputs), a certain change should be of the same importance + for the model. + + BST is often suitable to perform model reduction in order to obtain + low order design models for controller synthesis. + + Approximation Properties: + * Guaranteed stability of reduced models + + * Approximates simultaneously gain and phase + + * Preserves non-minimum phase zeros + + * Guaranteed a priori error bound + + *Algorithm* + Uses SLICOT AB09HD by courtesy of NICONET e.V. + (http://www.slicot.org) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +Model order reduction by Balanced Stochastic Truncation (BST) method. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +btaconred + + +# name: +# type: sq_string +# elements: 1 +# length: 6173 + -- Function File: [KR, INFO] = btaconred (G, K, ...) + -- Function File: [KR, INFO] = btaconred (G, K, NCR, ...) + -- Function File: [KR, INFO] = btaconred (G, K, OPT, ...) + -- Function File: [KR, INFO] = btaconred (G, K, NCR, OPT, ...) + Controller reduction by frequency-weighted Balanced Truncation + Approximation (BTA). Given a plant G and a stabilizing controller + K, determine a reduced order controller KR such that the + closed-loop system is stable and closed-loop performance is + retained. + + The algorithm tries to minimize the frequency-weighted error + ||V (K-Kr) W|| = min + inf + where V and W denote output and input weightings. + + *Inputs* + G + LTI model of the plant. It has m inputs, p outputs and n + states. + + K + LTI model of the controller. It has p inputs, m outputs and + nc states. + + NCR + The desired order of the resulting reduced order controller + KR. If not specified, NCR is chosen automatically according + to the description of key 'ORDER'. + + ... + Optional pairs of keys and values. `"key1", value1, "key2", + value2'. + + OPT + Optional struct with keys as field names. Struct OPT can be + created directly or by command `options'. `opt.key1 = + value1, opt.key2 = value2'. + + *Outputs* + KR + State-space model of reduced order controller. + + INFO + Struct containing additional information. + INFO.NCR + The order of the obtained reduced order controller KR. + + INFO.NCS + The order of the alpha-stable part of original + controller K. + + INFO.HSVC + The Hankel singular values of the alpha-stable part of K. + The NCS Hankel singular values are ordered decreasingly. + + *Option Keys and Values* + 'ORDER', 'NCR' + The desired order of the resulting reduced order controller + KR. If not specified, NCR is chosen automatically such that + states with Hankel singular values INFO.HSVC > TOL1 are + retained. + + 'METHOD' + Order reduction approach to be used as follows: + 'SR', 'B' + Use the square-root Balance & Truncate method. + + 'BFSR', 'F' + Use the balancing-free square-root Balance & Truncate + method. Default method. + + 'WEIGHT' + Specifies the type of frequency-weighting as follows: + 'NONE' + No weightings are used (V = I, W = I). + + 'LEFT', 'OUTPUT' + Use stability enforcing left (output) weighting + -1 + V = (I-G*K) *G , W = I + + 'RIGHT', 'INPUT' + Use stability enforcing right (input) weighting + -1 + V = I , W = (I-G*K) *G + + 'BOTH', 'PERFORMANCE' + Use stability and performance enforcing weightings + -1 -1 + V = (I-G*K) *G , W = (I-G*K) + Default value. + + 'FEEDBACK' + Specifies whether K is a positive or negative feedback + controller: + '+' + Use positive feedback controller. Default value. + + '-' + Use negative feedback controller. + + 'ALPHA' + Specifies the ALPHA-stability boundary for the eigenvalues of + the state dynamics matrix K.A. For a continuous-time + controller, ALPHA <= 0 is the boundary value for the real + parts of eigenvalues, while for a discrete-time controller, 0 + <= ALPHA <= 1 represents the boundary value for the moduli of + eigenvalues. The ALPHA-stability domain does not include the + boundary. Default value is 0 for continuous-time controllers + and 1 for discrete-time controllers. + + 'TOL1' + If 'ORDER' is not specified, TOL1 contains the tolerance for + determining the order of the reduced controller. For model + reduction, the recommended value of TOL1 is c*info.hsvc(1), + where c lies in the interval [0.00001, 0.001]. Default value + is info.ncs*eps*info.hsvc(1). If 'ORDER' is specified, the + value of TOL1 is ignored. + + 'TOL2' + The tolerance for determining the order of a minimal + realization of the ALPHA-stable part of the given controller. + TOL2 <= TOL1. If not specified, ncs*eps*info.hsvc(1) is + chosen. + + 'GRAM-CTRB' + Specifies the choice of frequency-weighted controllability + Grammian as follows: + 'STANDARD' + Choice corresponding to standard Enns' method [1]. + Default method. + + 'ENHANCED' + Choice corresponding to the stability enhanced modified + Enns' method of [2]. + + 'GRAM-OBSV' + Specifies the choice of frequency-weighted observability + Grammian as follows: + 'STANDARD' + Choice corresponding to standard Enns' method [1]. + Default method. + + 'ENHANCED' + Choice corresponding to the stability enhanced modified + Enns' method of [2]. + + 'EQUIL', 'SCALE' + Boolean indicating whether equilibration (scaling) should be + performed on G and K prior to order reduction. Default value + is false if both `G.scaled == true, K.scaled == true' and + true otherwise. Note that for MIMO models, proper scaling of + both inputs and outputs is of utmost importance. The input + and output scaling can *not* be done by the equilibration + option or the `prescale' command because these functions + perform state transformations only. Furthermore, signals + should not be scaled simply to a certain range. For all + inputs (or outputs), a certain change should be of the same + importance for the model. + + *Algorithm* + Uses SLICOT SB16AD by courtesy of NICONET e.V. + (http://www.slicot.org) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Controller reduction by frequency-weighted Balanced Truncation +Approximation (BT + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +btamodred + + +# name: +# type: sq_string +# elements: 1 +# length: 7326 + -- Function File: [GR, INFO] = btamodred (G, ...) + -- Function File: [GR, INFO] = btamodred (G, NR, ...) + -- Function File: [GR, INFO] = btamodred (G, OPT, ...) + -- Function File: [GR, INFO] = btamodred (G, NR, OPT, ...) + Model order reduction by frequency weighted Balanced Truncation + Approximation (BTA) method. The aim of model reduction is to find + an LTI system GR of order NR (nr < n) such that the input-output + behaviour of GR approximates the one from original system G. + + BTA is an absolute error method which tries to minimize + ||G-Gr|| = min + inf + + ||V (G-Gr) W|| = min + inf + where V and W denote output and input weightings. + + *Inputs* + G + LTI model to be reduced. + + NR + The desired order of the resulting reduced order system GR. + If not specified, NR is chosen automatically according to the + description of key 'ORDER'. + + ... + Optional pairs of keys and values. `"key1", value1, "key2", + value2'. + + OPT + Optional struct with keys as field names. Struct OPT can be + created directly or by command `options'. `opt.key1 = + value1, opt.key2 = value2'. + + *Outputs* + GR + Reduced order state-space model. + + INFO + Struct containing additional information. + INFO.N + The order of the original system G. + + INFO.NS + The order of the ALPHA-stable subsystem of the original + system G. + + INFO.HSV + The Hankel singular values of the ALPHA-stable part of + the original system G, ordered decreasingly. + + INFO.NU + The order of the ALPHA-unstable subsystem of both the + original system G and the reduced-order system GR. + + INFO.NR + The order of the obtained reduced order system GR. + + *Option Keys and Values* + 'ORDER', 'NR' + The desired order of the resulting reduced order system GR. + If not specified, NR is chosen automatically such that states + with Hankel singular values INFO.HSV > TOL1 are retained. + + 'LEFT', 'OUTPUT' + LTI model of the left/output frequency weighting V. Default + value is an identity matrix. + + 'RIGHT', 'INPUT' + LTI model of the right/input frequency weighting W. Default + value is an identity matrix. + + 'METHOD' + Approximation method for the L-infinity norm to be used as + follows: + 'SR', 'B' + Use the square-root Balance & Truncate method. + + 'BFSR', 'F' + Use the balancing-free square-root Balance & Truncate + method. Default method. + + 'ALPHA' + Specifies the ALPHA-stability boundary for the eigenvalues of + the state dynamics matrix G.A. For a continuous-time system, + ALPHA <= 0 is the boundary value for the real parts of + eigenvalues, while for a discrete-time system, 0 <= ALPHA <= + 1 represents the boundary value for the moduli of eigenvalues. + The ALPHA-stability domain does not include the boundary. + Default value is 0 for continuous-time systems and 1 for + discrete-time systems. + + 'TOL1' + If 'ORDER' is not specified, TOL1 contains the tolerance for + determining the order of the reduced model. For model + reduction, the recommended value of TOL1 is c*info.hsv(1), + where c lies in the interval [0.00001, 0.001]. Default value + is info.ns*eps*info.hsv(1). If 'ORDER' is specified, the + value of TOL1 is ignored. + + 'TOL2' + The tolerance for determining the order of a minimal + realization of the ALPHA-stable part of the given model. + TOL2 <= TOL1. If not specified, ns*eps*info.hsv(1) is chosen. + + 'GRAM-CTRB' + Specifies the choice of frequency-weighted controllability + Grammian as follows: + 'STANDARD' + Choice corresponding to a combination method [4] of the + approaches of Enns [1] and Lin-Chiu [2,3]. Default + method. + + 'ENHANCED' + Choice corresponding to the stability enhanced modified + combination method of [4]. + + 'GRAM-OBSV' + Specifies the choice of frequency-weighted observability + Grammian as follows: + 'STANDARD' + Choice corresponding to a combination method [4] of the + approaches of Enns [1] and Lin-Chiu [2,3]. Default + method. + + 'ENHANCED' + Choice corresponding to the stability enhanced modified + combination method of [4]. + + 'ALPHA-CTRB' + Combination method parameter for defining the + frequency-weighted controllability Grammian. abs(alphac) <= + 1. If alphac = 0, the choice of Grammian corresponds to the + method of Enns [1], while if alphac = 1, the choice of + Grammian corresponds to the method of Lin and Chiu [2,3]. + Default value is 0. + + 'ALPHA-OBSV' + Combination method parameter for defining the + frequency-weighted observability Grammian. abs(alphao) <= 1. + If alphao = 0, the choice of Grammian corresponds to the + method of Enns [1], while if alphao = 1, the choice of + Grammian corresponds to the method of Lin and Chiu [2,3]. + Default value is 0. + + 'EQUIL', 'SCALE' + Boolean indicating whether equilibration (scaling) should be + performed on system G prior to order reduction. This is done + by state transformations. Default value is true if `G.scaled + == false' and false if `G.scaled == true'. Note that for + MIMO models, proper scaling of both inputs and outputs is of + utmost importance. The input and output scaling can *not* be + done by the equilibration option or the `prescale' command + because these functions perform state transformations only. + Furthermore, signals should not be scaled simply to a certain + range. For all inputs (or outputs), a certain change should + be of the same importance for the model. + + Approximation Properties: + * Guaranteed stability of reduced models + + * Lower guaranteed error bound + + * Guaranteed a priori error bound + + *References* + [1] Enns, D. Model reduction with balanced realizations: An error + bound and a frequency weighted generalization. Proc. 23-th CDC, + Las Vegas, pp. 127-132, 1984. + + [2] Lin, C.-A. and Chiu, T.-Y. Model reduction via + frequency-weighted balanced realization. Control Theory and + Advanced Technology, vol. 8, pp. 341-351, 1992. + + [3] Sreeram, V., Anderson, B.D.O and Madievski, A.G. New results + on frequency weighted balanced reduction technique. Proc. ACC, + Seattle, Washington, pp. 4004-4009, 1995. + + [4] Varga, A. and Anderson, B.D.O. Square-root balancing-free + methods for the frequency-weighted balancing related model + reduction. (report in preparation) + + *Algorithm* + Uses SLICOT AB09ID by courtesy of NICONET e.V. + (http://www.slicot.org) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Model order reduction by frequency weighted Balanced Truncation +Approximation (B + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +care + + +# name: +# type: sq_string +# elements: 1 +# length: 1627 + -- Function File: [X, L, G] = care (A, B, Q, R) + -- Function File: [X, L, G] = care (A, B, Q, R, S) + -- Function File: [X, L, G] = care (A, B, Q, R, [], E) + -- Function File: [X, L, G] = care (A, B, Q, R, S, E) + Solve continuous-time algebraic Riccati equation (ARE). + + *Inputs* + A + Real matrix (n-by-n). + + B + Real matrix (n-by-m). + + Q + Real matrix (n-by-n). + + R + Real matrix (m-by-m). + + S + Optional real matrix (n-by-m). If S is not specified, a zero + matrix is assumed. + + E + Optional descriptor matrix (n-by-n). If E is not specified, + an identity matrix is assumed. + + *Outputs* + X + Unique stabilizing solution of the continuous-time Riccati + equation (n-by-n). + + L + Closed-loop poles (n-by-1). + + G + Corresponding gain matrix (m-by-n). + + *Equations* + -1 + A'X + XA - XB R B'X + Q = 0 + + -1 + A'X + XA - (XB + S) R (B'X + S') + Q = 0 + + -1 + G = R B'X + + -1 + G = R (B'X + S') + + L = eig (A - B*G) + + -1 + A'XE + E'XA - E'XB R B'XE + Q = 0 + + -1 + A'XE + E'XA - (E'XB + S) R (B'XE + S') + Q = 0 + + -1 + G = R B'XE + + -1 + G = R (B'XE + S) + + L = eig (A - B*G, E) + + *Algorithm* + Uses SLICOT SB02OD and SG02AD by courtesy of NICONET e.V. + (http://www.slicot.org) + + See also: dare, lqr, dlqr, kalman + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Solve continuous-time algebraic Riccati equation (ARE). + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +cfconred + + +# name: +# type: sq_string +# elements: 1 +# length: 4348 + -- Function File: [KR, INFO] = cfconred (G, F, L, ...) + -- Function File: [KR, INFO] = cfconred (G, F, L, NCR, ...) + -- Function File: [KR, INFO] = cfconred (G, F, L, OPT, ...) + -- Function File: [KR, INFO] = cfconred (G, F, L, NCR, OPT, ...) + Reduction of state-feedback-observer based controller by coprime + factorization (CF). Given a plant G, state feedback gain F and + full observer gain L, determine a reduced order controller KR. + + *Inputs* + G + LTI model of the open-loop plant (A,B,C,D). It has m inputs, + p outputs and n states. + + F + Stabilizing state feedback matrix (m-by-n). + + L + Stabilizing observer gain matrix (n-by-p). + + NCR + The desired order of the resulting reduced order controller + KR. If not specified, NCR is chosen automatically according + to the description of key 'ORDER'. + + ... + Optional pairs of keys and values. `"key1", value1, "key2", + value2'. + + OPT + Optional struct with keys as field names. Struct OPT can be + created directly or by command `options'. `opt.key1 = + value1, opt.key2 = value2'. + + *Outputs* + KR + State-space model of reduced order controller. + + INFO + Struct containing additional information. + INFO.HSV + The Hankel singular values of the extended system?!?. + The N Hankel singular values are ordered decreasingly. + + INFO.NCR + The order of the obtained reduced order controller KR. + + *Option Keys and Values* + 'ORDER', 'NCR' + The desired order of the resulting reduced order controller + KR. If not specified, NCR is chosen automatically such that + states with Hankel singular values INFO.HSV > TOL1 are + retained. + + 'METHOD' + Order reduction approach to be used as follows: + 'SR-BTA', 'B' + Use the square-root Balance & Truncate method. + + 'BFSR-BTA', 'F' + Use the balancing-free square-root Balance & Truncate + method. Default method. + + 'SR-SPA', 'S' + Use the square-root Singular Perturbation Approximation + method. + + 'BFSR-SPA', 'P' + Use the balancing-free square-root Singular Perturbation + Approximation method. + + 'CF' + Specifies whether left or right coprime factorization is to + be used as follows: + 'LEFT', 'L' + Use left coprime factorization. Default method. + + 'RIGHT', 'R' + Use right coprime factorization. + + 'FEEDBACK' + Specifies whether F and L are fed back positively or + negatively: + '+' + A+BK and A+LC are both Hurwitz matrices. + + '-' + A-BK and A-LC are both Hurwitz matrices. Default value. + + 'TOL1' + If 'ORDER' is not specified, TOL1 contains the tolerance for + determining the order of the reduced system. For model + reduction, the recommended value of TOL1 is c*info.hsv(1), + where c lies in the interval [0.00001, 0.001]. Default value + is n*eps*info.hsv(1). If 'ORDER' is specified, the value of + TOL1 is ignored. + + 'TOL2' + The tolerance for determining the order of a minimal + realization of the coprime factorization controller. TOL2 <= + TOL1. If not specified, n*eps*info.hsv(1) is chosen. + + 'EQUIL', 'SCALE' + Boolean indicating whether equilibration (scaling) should be + performed on system G prior to order reduction. Default + value is true if `G.scaled == false' and false if `G.scaled + == true'. Note that for MIMO models, proper scaling of both + inputs and outputs is of utmost importance. The input and + output scaling can *not* be done by the equilibration option + or the `prescale' command because these functions perform + state transformations only. Furthermore, signals should not + be scaled simply to a certain range. For all inputs (or + outputs), a certain change should be of the same importance + for the model. + + *Algorithm* + Uses SLICOT SB16BD by courtesy of NICONET e.V. + (http://www.slicot.org) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Reduction of state-feedback-observer based controller by coprime +factorization ( + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +covar + + +# name: +# type: sq_string +# elements: 1 +# length: 319 + -- Function File: [P, Q] = covar (SYS, W) + Return the steady-state covariance. + + *Inputs* + SYS + LTI model. + + W + Intensity of Gaussian white noise inputs which drive SYS. + + *Outputs* + P + Output covariance. + + Q + State covariance. + + See also: lyap, dlyap + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Return the steady-state covariance. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +ctrb + + +# name: +# type: sq_string +# elements: 1 +# length: 390 + -- Function File: CO = ctrb (SYS) + -- Function File: CO = ctrb (A, B) + Return controllability matrix. + + *Inputs* + SYS + LTI model. + + A + State transition matrix (n-by-n). + + B + Input matrix (n-by-m). + + *Outputs* + CO + Controllability matrix. + + *Equation* + 2 n-1 + Co = [ B AB A B ... A B ] + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Return controllability matrix. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ctrbf + + +# name: +# type: sq_string +# elements: 1 +# length: 958 + -- Function File: [SYSBAR, T, K] = ctrbf (SYS) + -- Function File: [SYSBAR, T, K] = ctrbf (SYS, TOL) + -- Function File: [ABAR, BBAR, CBAR, T, K] = ctrbf (A, B, C) + -- Function File: [ABAR, BBAR, CBAR, T, K] = ctrbf (A, B, C, TOL) + If Co=ctrb(A,B) has rank r <= n = SIZE(A,1), then there is a + similarity transformation Tc such that Tc = [t1 t2] where t1 is + the controllable subspace and t2 is orthogonal to t1 + + Abar = Tc \ A * Tc , Bbar = Tc \ B , Cbar = C * Tc + + and the transformed system has the form + + | Ac A12| | Bc | + Abar = |----------|, Bbar = | ---|, Cbar = [Cc | Cnc]. + | 0 Anc| | 0 | + + where (Ac,Bc) is controllable, and Cc(sI-Ac)^(-1)Bc = + C(sI-A)^(-1)B. and the system is stabilizable if Anc has no + eigenvalues in the right half plane. The last output K is a vector + of length n containing the number of controllable states. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If Co=ctrb(A,B) has rank r <= n = SIZE(A,1), then there is a similarity +transfor + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +dare + + +# name: +# type: sq_string +# elements: 1 +# length: 1786 + -- Function File: [X, L, G] = dare (A, B, Q, R) + -- Function File: [X, L, G] = dare (A, B, Q, R, S) + -- Function File: [X, L, G] = dare (A, B, Q, R, [], E) + -- Function File: [X, L, G] = dare (A, B, Q, R, S, E) + Solve discrete-time algebraic Riccati equation (ARE). + + *Inputs* + A + Real matrix (n-by-n). + + B + Real matrix (n-by-m). + + Q + Real matrix (n-by-n). + + R + Real matrix (m-by-m). + + S + Optional real matrix (n-by-m). If S is not specified, a zero + matrix is assumed. + + E + Optional descriptor matrix (n-by-n). If E is not specified, + an identity matrix is assumed. + + *Outputs* + X + Unique stabilizing solution of the discrete-time Riccati + equation (n-by-n). + + L + Closed-loop poles (n-by-1). + + G + Corresponding gain matrix (m-by-n). + + *Equations* + -1 + A'XA - X - A'XB (B'XB + R) B'XA + Q = 0 + + -1 + A'XA - X - (A'XB + S) (B'XB + R) (B'XA + S') + Q = 0 + + -1 + G = (B'XB + R) B'XA + + -1 + G = (B'XB + R) (B'XA + S') + + L = eig (A - B*G) + + -1 + A'XA - E'XE - A'XB (B'XB + R) B'XA + Q = 0 + + -1 + A'XA - E'XE - (A'XB + S) (B'XB + R) (B'XA + S') + Q = 0 + + -1 + G = (B'XB + R) B'XA + + -1 + G = (B'XB + R) (B'XA + S') + + L = eig (A - B*G, E) + + *Algorithm* + Uses SLICOT SB02OD and SG02AD by courtesy of NICONET e.V. + (http://www.slicot.org) + + See also: care, lqr, dlqr, kalman + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Solve discrete-time algebraic Riccati equation (ARE). + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +dlqe + + +# name: +# type: sq_string +# elements: 1 +# length: 1695 + -- Function File: [M, P, Z, E] = dlqe (A, G, C, Q, R) + -- Function File: [M, P, Z, E] = dlqe (A, G, C, Q, R, S) + -- Function File: [M, P, Z, E] = dlqe (A, [], C, Q, R) + -- Function File: [M, P, Z, E] = dlqe (A, [], C, Q, R, S) + Kalman filter for discrete-time systems. + + x[k] = Ax[k] + Bu[k] + Gw[k] (State equation) + y[k] = Cx[k] + Du[k] + v[k] (Measurement Equation) + E(w) = 0, E(v) = 0, cov(w) = Q, cov(v) = R, cov(w,v) = S + + *Inputs* + A + State transition matrix of discrete-time system (n-by-n). + + G + Process noise matrix of discrete-time system (n-by-g). If G + is empty `[]', an identity matrix is assumed. + + C + Measurement matrix of discrete-time system (p-by-n). + + Q + Process noise covariance matrix (g-by-g). + + R + Measurement noise covariance matrix (p-by-p). + + S + Optional cross term covariance matrix (g-by-p), s = cov(w,v). + If S is empty `[]' or not specified, a zero matrix is assumed. + + *Outputs* + M + Kalman filter gain matrix (n-by-p). + + P + Unique stabilizing solution of the discrete-time Riccati + equation (n-by-n). Symmetric matrix. + + Z + Error covariance (n-by-n), cov(x(k|k)-x) + + E + Closed-loop poles (n-by-1). + + *Equations* + x[k|k] = x[k|k-1] + M(y[k] - Cx[k|k-1] - Du[k]) + + x[k+1|k] = Ax[k|k] + Bu[k] for S=0 + + x[k+1|k] = Ax[k|k] + Bu[k] + G*S*(C*P*C' + R)^-1*(y[k] - C*x[k|k-1]) for non-zero S + + + E = eig(A - A*M*C) for S=0 + + E = eig(A - A*M*C - G*S*(C*P*C' + Rv)^-1*C) for non-zero S + + See also: dare, care, dlqr, lqr, lqe + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Kalman filter for discrete-time systems. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +dlqr + + +# name: +# type: sq_string +# elements: 1 +# length: 1374 + -- Function File: [G, X, L] = dlqr (SYS, Q, R) + -- Function File: [G, X, L] = dlqr (SYS, Q, R, S) + -- Function File: [G, X, L] = dlqr (A, B, Q, R) + -- Function File: [G, X, L] = dlqr (A, B, Q, R, S) + -- Function File: [G, X, L] = dlqr (A, B, Q, R, [], E) + -- Function File: [G, X, L] = dlqr (A, B, Q, R, S, E) + Linear-quadratic regulator for discrete-time systems. + + *Inputs* + SYS + Continuous or discrete-time LTI model (p-by-m, n states). + + A + State transition matrix of discrete-time system (n-by-n). + + B + Input matrix of discrete-time system (n-by-m). + + Q + State weighting matrix (n-by-n). + + R + Input weighting matrix (m-by-m). + + S + Optional cross term matrix (n-by-m). If S is not specified, + a zero matrix is assumed. + + E + Optional descriptor matrix (n-by-n). If E is not specified, + an identity matrix is assumed. + + *Outputs* + G + State feedback matrix (m-by-n). + + X + Unique stabilizing solution of the discrete-time Riccati + equation (n-by-n). + + L + Closed-loop poles (n-by-1). + + *Equations* + x[k+1] = A x[k] + B u[k], x[0] = x0 + + inf + J(x0) = SUM (x' Q x + u' R u + 2 x' S u) + k=0 + + L = eig (A - B*G) + + See also: dare, care, lqr + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Linear-quadratic regulator for discrete-time systems. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +dlyap + + +# name: +# type: sq_string +# elements: 1 +# length: 527 + -- Function File: X = dlyap (A, B) + -- Function File: X = dlyap (A, B, C) + -- Function File: X = dlyap (A, B, [], E) + Solve discrete-time Lyapunov or Sylvester equations. + + *Equations* + AXA' - X + B = 0 (Lyapunov Equation) + + AXB' - X + C = 0 (Sylvester Equation) + + AXA' - EXE' + B = 0 (Generalized Lyapunov Equation) + + *Algorithm* + Uses SLICOT SB03MD, SB04QD and SG03AD by courtesy of NICONET e.V. + (http://www.slicot.org) + + See also: dlyapchol, lyap, lyapchol + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +Solve discrete-time Lyapunov or Sylvester equations. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +dlyapchol + + +# name: +# type: sq_string +# elements: 1 +# length: 478 + -- Function File: U = dlyapchol (A, B) + -- Function File: U = dlyapchol (A, B, E) + Compute Cholesky factor of discrete-time Lyapunov equations. + + *Equations* + A U' U A' - U' U + B B' = 0 (Lyapunov Equation) + + A U' U A' - E U' U E' + B B' = 0 (Generalized Lyapunov Equation) + + *Algorithm* + Uses SLICOT SB03OD and SG03BD by courtesy of NICONET e.V. + (http://www.slicot.org) + + See also: dlyap, lyap, lyapchol + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 +Compute Cholesky factor of discrete-time Lyapunov equations. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +dss + + +# name: +# type: sq_string +# elements: 1 +# length: 935 + -- Function File: SYS = dss (SYS) + -- Function File: SYS = dss (D) + -- Function File: SYS = dss (A, B, C, D, E, ...) + -- Function File: SYS = dss (A, B, C, D, E, TSAM, ...) + Create or convert to descriptor state-space model. + + *Inputs* + SYS + LTI model to be converted to state-space. + + A + State transition matrix (n-by-n). + + B + Input matrix (n-by-m). + + C + Measurement matrix (p-by-n). + + D + Feedthrough matrix (p-by-m). + + E + Descriptor matrix (n-by-n). + + TSAM + Sampling time in seconds. If TSAM is not specified, a + continuous-time model is assumed. + + ... + Optional pairs of properties and values. Type `set (dss)' + for more information. + + *Outputs* + SYS + Descriptor state-space model. + + *Equations* + . + E x = A x + B u + y = C x + D u + + See also: ss, tf + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Create or convert to descriptor state-space model. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +estim + + +# name: +# type: sq_string +# elements: 1 +# length: 654 + -- Function File: EST = estim (SYS, L) + -- Function File: EST = estim (SYS, L, SENSORS, KNOWN) + Return state estimator for a given estimator gain. + + *Inputs* + SYS + LTI model. + + L + State feedback matrix. + + SENSORS + Indices of measured output signals y from SYS. If omitted, + all outputs are measured. + + KNOWN + Indices of known input signals u (deterministic) to SYS. All + other inputs to SYS are assumed stochastic. If argument + KNOWN is omitted, no inputs u are known. + + *Outputs* + EST + State-space model of estimator. + + See also: kalman, place + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Return state estimator for a given estimator gain. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +filt + + +# name: +# type: sq_string +# elements: 1 +# length: 1602 + -- Function File: SYS = filt (NUM, DEN, ...) + -- Function File: SYS = filt (NUM, DEN, TSAM, ...) + Create discrete-time transfer function model from data in DSP + format. + + *Inputs* + NUM + Numerator or cell of numerators. Each numerator must be a + row vector containing the coefficients of the polynomial in + ascending powers of z^-1. num{i,j} contains the numerator + polynomial from input j to output i. In the SISO case, a + single vector is accepted as well. + + DEN + Denominator or cell of denominators. Each denominator must + be a row vector containing the coefficients of the polynomial + in ascending powers of z^-1. den{i,j} contains the + denominator polynomial from input j to output i. In the SISO + case, a single vector is accepted as well. + + TSAM + Sampling time in seconds. If TSAM is not specified, default + value -1 (unspecified) is taken. + + ... + Optional pairs of properties and values. Type `set (filt)' + for more information. + + *Outputs* + SYS + Discrete-time transfer function model. + + *Example* + 3 z^-1 + H(z^-1) = ------------------- + 1 + 4 z^-1 + 2 z^-2 + + octave:1> H = filt ([0, 3], [1, 4, 2]) + + Transfer function 'H' from input 'u1' to output ... + + 3 z^-1 + y1: ------------------- + 1 + 4 z^-1 + 2 z^-2 + + Sampling time: unspecified + Discrete-time model. + + See also: tf + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +Create discrete-time transfer function model from data in DSP format. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +fitfrd + + +# name: +# type: sq_string +# elements: 1 +# length: 1168 + -- Function File: [SYS, N] = fitfrd (DAT, N) + -- Function File: [SYS, N] = fitfrd (DAT, N, FLAG) + Fit frequency response data with a state-space system. If + requested, the returned system is stable and minimum-phase. + + *Inputs* + DAT + LTI model containing frequency response data of a SISO system. + + N + The desired order of the system to be fitted. `n <= + length(dat.w)'. + + FLAG + The flag controls whether the returned system is stable and + minimum-phase. + 0 + The system zeros and poles are not constrained. Default + value. + + 1 + The system zeros and poles will have negative real parts + in the continuous-time case, or moduli less than 1 in + the discrete-time case. + + *Outputs* + SYS + State-space model of order N, fitted to frequency response + data DAT. + + N + The order of the obtained system. The value of N could only + be modified if inputs `n > 0' and `flag = 1'. + + *Algorithm* + Uses SLICOT SB10YD by courtesy of NICONET e.V. + (http://www.slicot.org) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Fit frequency response data with a state-space system. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +fwcfconred + + +# name: +# type: sq_string +# elements: 1 +# length: 3221 + -- Function File: [KR, INFO] = fwcfconred (G, F, L, ...) + -- Function File: [KR, INFO] = fwcfconred (G, F, L, NCR, ...) + -- Function File: [KR, INFO] = fwcfconred (G, F, L, OPT, ...) + -- Function File: [KR, INFO] = fwcfconred (G, F, L, NCR, OPT, ...) + Reduction of state-feedback-observer based controller by + frequency-weighted coprime factorization (FW CF). Given a plant + G, state feedback gain F and full observer gain L, determine a + reduced order controller KR by using stability enforcing frequency + weights. + + *Inputs* + G + LTI model of the open-loop plant (A,B,C,D). It has m inputs, + p outputs and n states. + + F + Stabilizing state feedback matrix (m-by-n). + + L + Stabilizing observer gain matrix (n-by-p). + + NCR + The desired order of the resulting reduced order controller + KR. If not specified, NCR is chosen automatically according + to the description of key 'ORDER'. + + ... + Optional pairs of keys and values. `"key1", value1, "key2", + value2'. + + OPT + Optional struct with keys as field names. Struct OPT can be + created directly or by command `options'. `opt.key1 = + value1, opt.key2 = value2'. + + *Outputs* + KR + State-space model of reduced order controller. + + INFO + Struct containing additional information. + INFO.HSV + The Hankel singular values of the extended system?!?. + The N Hankel singular values are ordered decreasingly. + + INFO.NCR + The order of the obtained reduced order controller KR. + + *Option Keys and Values* + 'ORDER', 'NCR' + The desired order of the resulting reduced order controller + KR. If not specified, NCR is chosen automatically such that + states with Hankel singular values INFO.HSV > TOL1 are + retained. + + 'METHOD' + Order reduction approach to be used as follows: + 'SR', 'B' + Use the square-root Balance & Truncate method. + + 'BFSR', 'F' + Use the balancing-free square-root Balance & Truncate + method. Default method. + + 'CF' + Specifies whether left or right coprime factorization is to + be used as follows: + 'LEFT', 'L' + Use left coprime factorization. + + 'RIGHT', 'R' + Use right coprime factorization. Default method. + + 'FEEDBACK' + Specifies whether F and L are fed back positively or + negatively: + '+' + A+BK and A+LC are both Hurwitz matrices. + + '-' + A-BK and A-LC are both Hurwitz matrices. Default value. + + 'TOL1' + If 'ORDER' is not specified, TOL1 contains the tolerance for + determining the order of the reduced system. For model + reduction, the recommended value of TOL1 is c*info.hsv(1), + where c lies in the interval [0.00001, 0.001]. Default value + is n*eps*info.hsv(1). If 'ORDER' is specified, the value of + TOL1 is ignored. + + *Algorithm* + Uses SLICOT SB16CD by courtesy of NICONET e.V. + (http://www.slicot.org) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Reduction of state-feedback-observer based controller by +frequency-weighted copr + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +gensig + + +# name: +# type: sq_string +# elements: 1 +# length: 802 + -- Function File: [U, T] = gensig (SIGTYPE, TAU) + -- Function File: [U, T] = gensig (SIGTYPE, TAU, TFINAL) + -- Function File: [U, T] = gensig (SIGTYPE, TAU, TFINAL, TSAM) + Generate periodic signal. Useful in combination with lsim. + + *Inputs* + SIGTYPE = "SIN" + Sine wave. + + SIGTYPE = "COS" + Cosine wave. + + SIGTYPE = "SQUARE" + Square wave. + + SIGTYPE = "PULSE" + Periodic pulse. + + TAU + Duration of one period in seconds. + + TFINAL + Optional duration of the signal in seconds. Default duration + is 5 periods. + + TSAM + Optional sampling time in seconds. Default spacing is tau/64. + + *Outputs* + U + Vector of signal values. + + T + Time vector of the signal. + + See also: lsim + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 +Generate periodic signal. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +gram + + +# name: +# type: sq_string +# elements: 1 +# length: 462 + -- Function File: W = gram (SYS, MODE) + -- Function File: WC = gram (A, B) + `gram (SYS, "c")' returns the controllability gramian of the + (continuous- or discrete-time) system SYS. `gram (SYS, "o")' + returns the observability gramian of the (continuous- or + discrete-time) system SYS. `gram (A, B)' returns the + controllability gramian WC of the continuous-time system dx/dt = a + x + b u; i.e., WC satisfies a Wc + m Wc' + b b' = 0. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +`gram (SYS, "c")' returns the controllability gramian of the +(continuous- or dis + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +h2syn + + +# name: +# type: sq_string +# elements: 1 +# length: 1997 + -- Function File: [K, N, GAMMA, RCOND] = h2syn (P, NMEAS, NCON) + H-2 control synthesis for LTI plant. + + *Inputs* + P + Generalized plant. Must be a proper/realizable LTI model. + + NMEAS + Number of measured outputs v. The last NMEAS outputs of P + are connected to the inputs of controller K. The remaining + outputs z (indices 1 to p-nmeas) are used to calculate the + H-2 norm. + + NCON + Number of controlled inputs u. The last NCON inputs of P are + connected to the outputs of controller K. The remaining + inputs w (indices 1 to m-ncon) are excited by a harmonic test + signal. + + *Outputs* + K + State-space model of the H-2 optimal controller. + + N + State-space model of the lower LFT of P and K. + + GAMMA + H-2 norm of N. + + RCOND + Vector RCOND contains estimates of the reciprocal condition + numbers of the matrices which are to be inverted and + estimates of the reciprocal condition numbers of the Riccati + equations which have to be solved during the computation of + the controller K. For details, see the description of the + corresponding SLICOT algorithm. + + *Block Diagram* + + gamma = min||N(K)|| N = lft (P, K) + K 2 + + +--------+ + w ----->| |-----> z + | P(s) | + u +---->| |-----+ v + | +--------+ | + | | + | +--------+ | + +-----| K(s) |<----+ + +--------+ + + +--------+ + w ----->| N(s) |-----> z + +--------+ + + *Algorithm* + Uses SLICOT SB10HD and SB10ED by courtesy of NICONET e.V. + (http://www.slicot.org) + + See also: augw, lqr, dlqr, kalman + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +H-2 control synthesis for LTI plant. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +hinfsyn + + +# name: +# type: sq_string +# elements: 1 +# length: 2269 + -- Function File: [K, N, GAMMA, RCOND] = hinfsyn (P, NMEAS, NCON) + -- Function File: [K, N, GAMMA, RCOND] = hinfsyn (P, NMEAS, NCON, GMAX) + H-infinity control synthesis for LTI plant. + + *Inputs* + P + Generalized plant. Must be a proper/realizable LTI model. + + NMEAS + Number of measured outputs v. The last NMEAS outputs of P + are connected to the inputs of controller K. The remaining + outputs z (indices 1 to p-nmeas) are used to calculate the + H-infinity norm. + + NCON + Number of controlled inputs u. The last NCON inputs of P are + connected to the outputs of controller K. The remaining + inputs w (indices 1 to m-ncon) are excited by a harmonic test + signal. + + GMAX + The maximum value of the H-infinity norm of N. It is assumed + that GMAX is sufficiently large so that the controller is + admissible. + + *Outputs* + K + State-space model of the H-infinity (sub-)optimal controller. + + N + State-space model of the lower LFT of P and K. + + GAMMA + L-infinity norm of N. + + RCOND + Vector RCOND contains estimates of the reciprocal condition + numbers of the matrices which are to be inverted and + estimates of the reciprocal condition numbers of the Riccati + equations which have to be solved during the computation of + the controller K. For details, see the description of the + corresponding SLICOT algorithm. + + *Block Diagram* + + gamma = min||N(K)|| N = lft (P, K) + K inf + + +--------+ + w ----->| |-----> z + | P(s) | + u +---->| |-----+ v + | +--------+ | + | | + | +--------+ | + +-----| K(s) |<----+ + +--------+ + + +--------+ + w ----->| N(s) |-----> z + +--------+ + + *Algorithm* + Uses SLICOT SB10FD and SB10DD by courtesy of NICONET e.V. + (http://www.slicot.org) + + See also: augw, mixsyn + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +H-infinity control synthesis for LTI plant. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +hnamodred + + +# name: +# type: sq_string +# elements: 1 +# length: 6621 + -- Function File: [GR, INFO] = hnamodred (G, ...) + -- Function File: [GR, INFO] = hnamodred (G, NR, ...) + -- Function File: [GR, INFO] = hnamodred (G, OPT, ...) + -- Function File: [GR, INFO] = hnamodred (G, NR, OPT, ...) + Model order reduction by frequency weighted optimal Hankel-norm + (HNA) method. The aim of model reduction is to find an LTI system + GR of order NR (nr < n) such that the input-output behaviour of GR + approximates the one from original system G. + + HNA is an absolute error method which tries to minimize + ||G-Gr|| = min + H + + ||V (G-Gr) W|| = min + H + where V and W denote output and input weightings. + + *Inputs* + G + LTI model to be reduced. + + NR + The desired order of the resulting reduced order system GR. + If not specified, NR is chosen automatically according to the + description of key "ORDER". + + ... + Optional pairs of keys and values. `"key1", value1, "key2", + value2'. + + OPT + Optional struct with keys as field names. Struct OPT can be + created directly or by command `options'. `opt.key1 = + value1, opt.key2 = value2'. + + *Outputs* + GR + Reduced order state-space model. + + INFO + Struct containing additional information. + INFO.N + The order of the original system G. + + INFO.NS + The order of the ALPHA-stable subsystem of the original + system G. + + INFO.HSV + The Hankel singular values corresponding to the + projection `op(V)*G1*op(W)', where G1 denotes the + ALPHA-stable part of the original system G. The NS + Hankel singular values are ordered decreasingly. + + INFO.NU + The order of the ALPHA-unstable subsystem of both the + original system G and the reduced-order system GR. + + INFO.NR + The order of the obtained reduced order system GR. + + *Option Keys and Values* + 'ORDER', 'NR' + The desired order of the resulting reduced order system GR. + If not specified, NR is the sum of INFO.NU and the number of + Hankel singular values greater than `max(tol1, + ns*eps*info.hsv(1)'; + + 'METHOD' + Specifies the computational approach to be used. Valid + values corresponding to this key are: + 'DESCRIPTOR' + Use the inverse free descriptor system approach. + + 'STANDARD' + Use the inversion based standard approach. + + 'AUTO' + Switch automatically to the inverse free descriptor + approach in case of badly conditioned feedthrough + matrices in V or W. Default method. + + 'LEFT', 'V' + LTI model of the left/output frequency weighting. The + weighting must be antistable. + || V (G-Gr) . || = min + H + + 'RIGHT', 'W' + LTI model of the right/input frequency weighting. The + weighting must be antistable. + || . (G-Gr) W || = min + H + + 'LEFT-INV', 'INV-V' + LTI model of the left/output frequency weighting. The + weighting must have only antistable zeros. + || inv(V) (G-Gr) . || = min + H + + 'RIGHT-INV', 'INV-W' + LTI model of the right/input frequency weighting. The + weighting must have only antistable zeros. + || . (G-Gr) inv(W) || = min + H + + 'LEFT-CONJ', 'CONJ-V' + LTI model of the left/output frequency weighting. The + weighting must be stable. + || V (G-Gr) . || = min + H + + 'RIGHT-CONJ', 'CONJ-W' + LTI model of the right/input frequency weighting. The + weighting must be stable. + || . (G-Gr) W || = min + H + + 'LEFT-CONJ-INV', 'CONJ-INV-V' + LTI model of the left/output frequency weighting. The + weighting must be minimum-phase. + || V (G-Gr) . || = min + H + + 'RIGHT-CONJ-INV', 'CONJ-INV-W' + LTI model of the right/input frequency weighting. The + weighting must be minimum-phase. + || . (G-Gr) W || = min + H + + 'ALPHA' + Specifies the ALPHA-stability boundary for the eigenvalues of + the state dynamics matrix G.A. For a continuous-time system, + ALPHA <= 0 is the boundary value for the real parts of + eigenvalues, while for a discrete-time system, 0 <= ALPHA <= + 1 represents the boundary value for the moduli of eigenvalues. + The ALPHA-stability domain does not include the boundary. + Default value is 0 for continuous-time systems and 1 for + discrete-time systems. + + 'TOL1' + If 'ORDER' is not specified, TOL1 contains the tolerance for + determining the order of the reduced model. For model + reduction, the recommended value of TOL1 is c*info.hsv(1), + where c lies in the interval [0.00001, 0.001]. TOL1 < 1. If + 'ORDER' is specified, the value of TOL1 is ignored. + + 'TOL2' + The tolerance for determining the order of a minimal + realization of the ALPHA-stable part of the given model. + TOL2 <= TOL1 < 1. If not specified, ns*eps*info.hsv(1) is + chosen. + + 'EQUIL', 'SCALE' + Boolean indicating whether equilibration (scaling) should be + performed on system G prior to order reduction. Default + value is true if `G.scaled == false' and false if `G.scaled + == true'. Note that for MIMO models, proper scaling of both + inputs and outputs is of utmost importance. The input and + output scaling can *not* be done by the equilibration option + or the `prescale' command because these functions perform + state transformations only. Furthermore, signals should not + be scaled simply to a certain range. For all inputs (or + outputs), a certain change should be of the same importance + for the model. + + Approximation Properties: + * Guaranteed stability of reduced models + + * Lower guaranteed error bound + + * Guaranteed a priori error bound + + *Algorithm* + Uses SLICOT AB09JD by courtesy of NICONET e.V. + (http://www.slicot.org) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 77 +Model order reduction by frequency weighted optimal Hankel-norm (HNA) +method. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +hsvd + + +# name: +# type: sq_string +# elements: 1 +# length: 403 + -- Function File: HSV = hsvd (SYS) + -- Function File: HSV = hsvd (SYS, "OFFSET", OFFSET) + -- Function File: HSV = hsvd (SYS, "ALPHA", ALPHA) + Hankel singular values of the stable part of an LTI model. If no + output arguments are given, the Hankel singular values are + displayed in a plot. + + *Algorithm* + Uses SLICOT AB13AD by courtesy of NICONET e.V. + (http://www.slicot.org) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Hankel singular values of the stable part of an LTI model. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +impulse + + +# name: +# type: sq_string +# elements: 1 +# length: 1247 + -- Function File: [Y, T, X] = impulse (SYS) + -- Function File: [Y, T, X] = impulse (SYS, T) + -- Function File: [Y, T, X] = impulse (SYS, TFINAL) + -- Function File: [Y, T, X] = impulse (SYS, TFINAL, DT) + Impulse response of LTI system. If no output arguments are given, + the response is printed on the screen. + + *Inputs* + SYS + LTI model. + + T + Time vector. Should be evenly spaced. If not specified, it + is calculated by the poles of the system to reflect + adequately the response transients. + + TFINAL + Optional simulation horizon. If not specified, it is + calculated by the poles of the system to reflect adequately + the response transients. + + DT + Optional sampling time. Be sure to choose it small enough to + capture transient phenomena. If not specified, it is + calculated by the poles of the system. + + *Outputs* + Y + Output response array. Has as many rows as time samples + (length of t) and as many columns as outputs. + + T + Time row vector. + + X + State trajectories array. Has `length (t)' rows and as many + columns as states. + + See also: initial, lsim, step + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 +Impulse response of LTI system. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +initial + + +# name: +# type: sq_string +# elements: 1 +# length: 1546 + -- Function File: [Y, T, X] = initial (SYS, X0) + -- Function File: [Y, T, X] = initial (SYS, X0, T) + -- Function File: [Y, T, X] = initial (SYS, X0, TFINAL) + -- Function File: [Y, T, X] = initial (SYS, X0, TFINAL, DT) + Initial condition response of state-space model. If no output + arguments are given, the response is printed on the screen. + + *Inputs* + SYS + State-space model. + + X0 + Vector of initial conditions for each state. + + T + Optional time vector. Should be evenly spaced. If not + specified, it is calculated by the poles of the system to + reflect adequately the response transients. + + TFINAL + Optional simulation horizon. If not specified, it is + calculated by the poles of the system to reflect adequately + the response transients. + + DT + Optional sampling time. Be sure to choose it small enough to + capture transient phenomena. If not specified, it is + calculated by the poles of the system. + + *Outputs* + Y + Output response array. Has as many rows as time samples + (length of t) and as many columns as outputs. + + T + Time row vector. + + X + State trajectories array. Has `length (t)' rows and as many + columns as states. + + *Example* + . + Continuous Time: x = A x , y = C x , x(0) = x0 + + Discrete Time: x[k+1] = A x[k] , y[k] = C x[k] , x[0] = x0 + + See also: impulse, lsim, step + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Initial condition response of state-space model. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +isctrb + + +# name: +# type: sq_string +# elements: 1 +# length: 1096 + -- Function File: [BOOL, NCON] = isctrb (SYS) + -- Function File: [BOOL, NCON] = isctrb (SYS, TOL) + -- Function File: [BOOL, NCON] = isctrb (A, B) + -- Function File: [BOOL, NCON] = isctrb (A, B, E) + -- Function File: [BOOL, NCON] = isctrb (A, B, [], TOL) + -- Function File: [BOOL, NCON] = isctrb (A, B, E, TOL) + Logical check for system controllability. For numerical reasons, + `isctrb (sys)' should be used instead of `rank (ctrb (sys))'. + + *Inputs* + SYS + LTI model. Descriptor state-space models are possible. + + A + State transition matrix. + + B + Input matrix. + + E + Descriptor matrix. If E is empty `[]' or not specified, an + identity matrix is assumed. + + TOL + Optional roundoff parameter. Default value is 0. + + *Outputs* + BOOL = 0 + System is not controllable. + + BOOL = 1 + System is controllable. + + NCON + Number of controllable states. + + *Algorithm* + Uses SLICOT AB01OD and TG01HD by courtesy of NICONET e.V. + (http://www.slicot.org) + + See also: isobsv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +Logical check for system controllability. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +isdetectable + + +# name: +# type: sq_string +# elements: 1 +# length: 1509 + -- Function File: BOOL = isdetectable (SYS) + -- Function File: BOOL = isdetectable (SYS, TOL) + -- Function File: BOOL = isdetectable (A, C) + -- Function File: BOOL = isdetectable (A, C, E) + -- Function File: BOOL = isdetectable (A, C, [], TOL) + -- Function File: BOOL = isdetectable (A, C, E, TOL) + -- Function File: BOOL = isdetectable (A, C, [], [], DFLG) + -- Function File: BOOL = isdetectable (A, C, E, [], DFLG) + -- Function File: BOOL = isdetectable (A, C, [], TOL, DFLG) + -- Function File: BOOL = isdetectable (A, C, E, TOL, DFLG) + Logical test for system detectability. All unstable modes must be + observable or all unobservable states must be stable. + + *Inputs* + SYS + LTI system. + + A + State transition matrix. + + C + Measurement matrix. + + E + Descriptor matrix. If E is empty `[]' or not specified, an + identity matrix is assumed. + + TOL + Optional tolerance for stability. Default value is 0. + + DFLG = 0 + Matrices (A, C) are part of a continuous-time system. + Default Value. + + DFLG = 1 + Matrices (A, C) are part of a discrete-time system. + + *Outputs* + BOOL = 0 + System is not detectable. + + BOOL = 1 + System is detectable. + + *Algorithm* + Uses SLICOT AB01OD and TG01HD by courtesy of NICONET e.V. + (http://www.slicot.org) See `isstabilizable' for description of + computational method. + + See also: isstabilizable, isstable, isctrb, isobsv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Logical test for system detectability. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +isobsv + + +# name: +# type: sq_string +# elements: 1 +# length: 1094 + -- Function File: [BOOL, NOBS] = isobsv (SYS) + -- Function File: [BOOL, NOBS] = isobsv (SYS, TOL) + -- Function File: [BOOL, NOBS] = isobsv (A, C) + -- Function File: [BOOL, NOBS] = isobsv (A, C, E) + -- Function File: [BOOL, NOBS] = isobsv (A, C, [], TOL) + -- Function File: [BOOL, NOBS] = isobsv (A, C, E, TOL) + Logical check for system observability. For numerical reasons, + `isobsv (sys)' should be used instead of `rank (obsv (sys))'. + + *Inputs* + SYS + LTI model. Descriptor state-space models are possible. + + A + State transition matrix. + + C + Measurement matrix. + + E + Descriptor matrix. If E is empty `[]' or not specified, an + identity matrix is assumed. + + TOL + Optional roundoff parameter. Default value is 0. + + *Outputs* + BOOL = 0 + System is not observable. + + BOOL = 1 + System is observable. + + NOBS + Number of observable states. + + *Algorithm* + Uses SLICOT AB01OD and TG01HD by courtesy of NICONET e.V. + (http://www.slicot.org) + + See also: isctrb + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 +Logical check for system observability. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +issample + + +# name: +# type: sq_string +# elements: 1 +# length: 614 + -- Function File: BOOL = issample (TS) + -- Function File: BOOL = issample (TS, FLG) + Return true if TS is a valid sampling time. + + *Inputs* + TS + Alleged sampling time to be tested. + + FLG = 1 + Accept real scalars TS > 0. Default Value. + + FLG = 0 + Accept real scalars TS >= 0. + + FLG = -1 + Accept real scalars TS > 0 and TS == -1. + + FLG = -10 + Accept real scalars TS >= 0 and TS == -1. + + FLG = -2 + Accept real scalars TS >= 0, TS == -1 and TS == -2. + + *Outputs* + BOOL + True if conditions are met and false otherwise. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Return true if TS is a valid sampling time. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +isstabilizable + + +# name: +# type: sq_string +# elements: 1 +# length: 1786 + -- Function File: BOOL = isstabilizable (SYS) + -- Function File: BOOL = isstabilizable (SYS, TOL) + -- Function File: BOOL = isstabilizable (A, B) + -- Function File: BOOL = isstabilizable (A, B, E) + -- Function File: BOOL = isstabilizable (A, B, [], TOL) + -- Function File: BOOL = isstabilizable (A, B, E, TOL) + -- Function File: BOOL = isstabilizable (A, B, [], [], DFLG) + -- Function File: BOOL = isstabilizable (A, B, E, [], DFLG) + -- Function File: BOOL = isstabilizable (A, B, [], TOL, DFLG) + -- Function File: BOOL = isstabilizable (A, B, E, TOL, DFLG) + Logical check for system stabilizability. All unstable modes must + be controllable or all uncontrollable states must be stable. + + *Inputs* + SYS + LTI system. + + A + State transition matrix. + + B + Input matrix. + + E + Descriptor matrix. If E is empty `[]' or not specified, an + identity matrix is assumed. + + TOL + Optional tolerance for stability. Default value is 0. + + DFLG = 0 + Matrices (A, B) are part of a continuous-time system. + Default Value. + + DFLG = 1 + Matrices (A, B) are part of a discrete-time system. + + *Outputs* + BOOL = 0 + System is not stabilizable. + + BOOL = 1 + System is stabilizable. + + *Algorithm* + Uses SLICOT AB01OD and TG01HD by courtesy of NICONET e.V. + (http://www.slicot.org) + * Calculate staircase form (SLICOT AB01OD) + * Extract unobservable part of state transition matrix + * Calculate eigenvalues of unobservable part + * Check whether + real (ev) < -tol*(1 + abs (ev)) continuous-time + abs (ev) < 1 - tol discrete-time + + See also: isdetectable, isstable, isctrb, isobsv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +Logical check for system stabilizability. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +kalman + + +# name: +# type: sq_string +# elements: 1 +# length: 1539 + -- Function File: [EST, G, X] = kalman (SYS, Q, R) + -- Function File: [EST, G, X] = kalman (SYS, Q, R, S) + -- Function File: [EST, G, X] = kalman (SYS, Q, R, [], SENSORS, KNOWN) + -- Function File: [EST, G, X] = kalman (SYS, Q, R, S, SENSORS, KNOWN) + Design Kalman estimator for LTI systems. + + *Inputs* + SYS + Nominal plant model. + + Q + Covariance of white process noise. + + R + Covariance of white measurement noise. + + S + Optional cross term covariance. Default value is 0. + + SENSORS + Indices of measured output signals y from SYS. If omitted, + all outputs are measured. + + KNOWN + Indices of known input signals u (deterministic) to SYS. All + other inputs to SYS are assumed stochastic. If argument + KNOWN is omitted, no inputs u are known. + + *Outputs* + EST + State-space model of the Kalman estimator. + + G + Estimator gain. + + X + Solution of the Riccati equation. + + *Block Diagram* + u +-------+ ^ + +---------------------------->| |-------> y + | +-------+ + y | est | ^ + u ----+--->| |----->(+)------>| |-------> x + | sys | ^ + +-------+ + w -------->| | | + +-------+ | v + + Q = cov (w, w') R = cov (v, v') S = cov (w, v') + + See also: care, dare, estim, lqr + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Design Kalman estimator for LTI systems. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +lqe + + +# name: +# type: sq_string +# elements: 1 +# length: 1696 + -- Function File: [L, P, E] = lqe (SYS, Q, R) + -- Function File: [L, P, E] = lqe (SYS, Q, R, S) + -- Function File: [L, P, E] = lqe (A, G, C, Q, R) + -- Function File: [L, P, E] = lqe (A, G, C, Q, R, S) + -- Function File: [L, P, E] = lqe (A, [], C, Q, R) + -- Function File: [L, P, E] = lqe (A, [], C, Q, R, S) + Kalman filter for continuous-time systems. + + . + x = Ax + Bu + Gw (State equation) + y = Cx + Du + v (Measurement Equation) + E(w) = 0, E(v) = 0, cov(w) = Q, cov(v) = R, cov(w,v) = S + + *Inputs* + SYS + Continuous or discrete-time LTI model (p-by-m, n states). + + A + State transition matrix of continuous-time system (n-by-n). + + G + Process noise matrix of continuous-time system (n-by-g). If + G is empty `[]', an identity matrix is assumed. + + C + Measurement matrix of continuous-time system (p-by-n). + + Q + Process noise covariance matrix (g-by-g). + + R + Measurement noise covariance matrix (p-by-p). + + S + Optional cross term covariance matrix (g-by-p), s = cov(w,v). + If S is empty `[]' or not specified, a zero matrix is assumed. + + *Outputs* + L + Kalman filter gain matrix (n-by-p). + + P + Unique stabilizing solution of the continuous-time Riccati + equation (n-by-n). Symmetric matrix. If SYS is a + discrete-time model, the solution of the corresponding + discrete-time Riccati equation is returned. + + E + Closed-loop poles (n-by-1). + + *Equations* + . + x = Ax + Bu + L(y - Cx -Du) + + E = eig(A - L*C) + + See also: dare, care, dlqr, lqr, dlqe + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 +Kalman filter for continuous-time systems. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +lqr + + +# name: +# type: sq_string +# elements: 1 +# length: 1353 + -- Function File: [G, X, L] = lqr (SYS, Q, R) + -- Function File: [G, X, L] = lqr (SYS, Q, R, S) + -- Function File: [G, X, L] = lqr (A, B, Q, R) + -- Function File: [G, X, L] = lqr (A, B, Q, R, S) + -- Function File: [G, X, L] = lqr (A, B, Q, R, [], E) + -- Function File: [G, X, L] = lqr (A, B, Q, R, S, E) + Linear-quadratic regulator. + + *Inputs* + SYS + Continuous or discrete-time LTI model (p-by-m, n states). + + A + State transition matrix of continuous-time system (n-by-n). + + B + Input matrix of continuous-time system (n-by-m). + + Q + State weighting matrix (n-by-n). + + R + Input weighting matrix (m-by-m). + + S + Optional cross term matrix (n-by-m). If S is not specified, + a zero matrix is assumed. + + E + Optional descriptor matrix (n-by-n). If E is not specified, + an identity matrix is assumed. + + *Outputs* + G + State feedback matrix (m-by-n). + + X + Unique stabilizing solution of the continuous-time Riccati + equation (n-by-n). + + L + Closed-loop poles (n-by-1). + + *Equations* + . + x = A x + B u, x(0) = x0 + + inf + J(x0) = INT (x' Q x + u' R u + 2 x' S u) dt + 0 + + L = eig (A - B*G) + + See also: care, dare, dlqr + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 +Linear-quadratic regulator. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +lsim + + +# name: +# type: sq_string +# elements: 1 +# length: 1744 + -- Function File: [Y, T, X] = lsim (SYS, U) + -- Function File: [Y, T, X] = lsim (SYS, U, T) + -- Function File: [Y, T, X] = lsim (SYS, U, T, X0) + -- Function File: [Y, T, X] = lsim (SYS, U, T, [], METHOD) + -- Function File: [Y, T, X] = lsim (SYS, U, T, X0, METHOD) + Simulate LTI model response to arbitrary inputs. If no output + arguments are given, the system response is plotted on the screen. + + *Inputs* + SYS + LTI model. System must be proper, i.e. it must not have more + zeros than poles. + + U + Vector or array of input signal. Needs `length(t)' rows and + as many columns as there are inputs. If SYS is a + single-input system, row vectors U of length `length(t)' are + accepted as well. + + T + Time vector. Should be evenly spaced. If SYS is a + continuous-time system and T is a real scalar, SYS is + discretized with sampling time `tsam = t/(rows(u)-1)'. If + SYS is a discrete-time system and T is not specified, vector + T is assumed to be `0 : tsam : tsam*(rows(u)-1)'. + + X0 + Vector of initial conditions for each state. If not + specified, a zero vector is assumed. + + METHOD + Discretization method for continuous-time models. Default + value is zoh (zero-order hold). All methods from `c2d' are + supported. + + *Outputs* + Y + Output response array. Has as many rows as time samples + (length of t) and as many columns as outputs. + + T + Time row vector. It is always evenly spaced. + + X + State trajectories array. Has `length (t)' rows and as many + columns as states. + + See also: impulse, initial, step + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Simulate LTI model response to arbitrary inputs. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +ltimodels + + +# name: +# type: sq_string +# elements: 1 +# length: 144 + -- Function File: test ltimodels + -- Function File: ltimodels + -- Function File: ltimodels (SYSTYPE) + Test suite and help for LTI models. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Test suite and help for LTI models. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +lyap + + +# name: +# type: sq_string +# elements: 1 +# length: 527 + -- Function File: X = lyap (A, B) + -- Function File: X = lyap (A, B, C) + -- Function File: X = lyap (A, B, [], E) + Solve continuous-time Lyapunov or Sylvester equations. + + *Equations* + AX + XA' + B = 0 (Lyapunov Equation) + + AX + XB + C = 0 (Sylvester Equation) + + AXE' + EXA' + B = 0 (Generalized Lyapunov Equation) + + *Algorithm* + Uses SLICOT SB03MD, SB04MD and SG03AD by courtesy of NICONET e.V. + (http://www.slicot.org) + + See also: lyapchol, dlyap, dlyapchol + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Solve continuous-time Lyapunov or Sylvester equations. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +lyapchol + + +# name: +# type: sq_string +# elements: 1 +# length: 479 + -- Function File: U = lyapchol (A, B) + -- Function File: U = lyapchol (A, B, E) + Compute Cholesky factor of continuous-time Lyapunov equations. + + *Equations* + A U' U + U' U A' + B B' = 0 (Lyapunov Equation) + + A U' U E' + E U' U A' + B B' = 0 (Generalized Lyapunov Equation) + + *Algorithm* + Uses SLICOT SB03OD and SG03BD by courtesy of NICONET e.V. + (http://www.slicot.org) + + See also: lyap, dlyap, dlyapchol + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +Compute Cholesky factor of continuous-time Lyapunov equations. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +margin + + +# name: +# type: sq_string +# elements: 1 +# length: 2742 + -- Function File: [GAMMA, PHI, W_GAMMA, W_PHI] = margin (SYS) + -- Function File: [GAMMA, PHI, W_GAMMA, W_PHI] = margin (SYS, TOL) + Gain and phase margin of a system. If no output arguments are + given, both gain and phase margin are plotted on a bode diagram. + Otherwise, the margins and their corresponding frequencies are + computed and returned. + + *Inputs* + SYS + LTI model. Must be a single-input and single-output (SISO) + system. + + TOL + Imaginary parts below TOL are assumed to be zero. If not + specified, default value `sqrt (eps)' is taken. + + *Outputs* + GAMMA + Gain margin (as gain, not dBs). + + PHI + Phase margin (in degrees). + + W_GAMMA + Frequency for the gain margin (in rad/s). + + W_PHI + Frequency for the phase margin (in rad/s). + + *Equations* + CONTINUOUS SYSTEMS + Gain Margin + _ _ + L(jw) = L(jw) BTW: L(jw) = L(-jw) = conj (L(jw)) + + num(jw) num(-jw) + ------- = -------- + den(jw) den(-jw) + + num(jw) den(-jw) = num(-jw) den(jw) + + imag (num(jw) den(-jw)) = 0 + imag (num(-jw) den(jw)) = 0 + + Phase Margin + |num(jw)| + |L(jw)| = |-------| = 1 + |den(jw)| + _ 2 2 + z z = Re z + Im z + + num(jw) num(-jw) + ------- * -------- = 1 + den(jw) den(-jw) + + num(jw) num(-jw) - den(jw) den(-jw) = 0 + + real (num(jw) num(-jw) - den(jw) den(-jw)) = 0 + + DISCRETE SYSTEMS + Gain Margin + jwT log z + L(z) = L(1/z) BTW: z = e --> w = ----- + j T + num(z) num(1/z) + ------ = -------- + den(z) den(1/z) + + num(z) den(1/z) - num(1/z) den(z) = 0 + + Phase Margin + |num(z)| + |L(z)| = |------| = 1 + |den(z)| + + L(z) L(1/z) = 1 + + num(z) num(1/z) + ------ * -------- = 1 + den(z) den(1/z) + + num(z) num(1/z) - den(z) den(1/z) = 0 + + PS: How to get L(1/z) + 4 3 2 + p(z) = a z + b z + c z + d z + e + + -4 -3 -2 -1 + p(1/z) = a z + b z + c z + d z + e + + -4 2 3 4 + = z ( a + b z + c z + d z + e z ) + + 4 3 2 4 + = ( e z + d z + c z + b z + a ) / ( z ) + + See also: roots + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Gain and phase margin of a system. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +mixsyn + + +# name: +# type: sq_string +# elements: 1 +# length: 4424 + -- Function File: [K, N, GAMMA, RCOND] = mixsyn (G, W1, W2, W3, ...) + Solve stacked S/KS/T H-infinity problem. Bound the largest + singular values of S (for performance), K S (to penalize large + inputs) and T (for robustness and to avoid sensitivity to noise). + In other words, the inputs r are excited by a harmonic test signal. + Then the algorithm tries to find a controller K which minimizes + the H-infinity norm calculated from the outputs z. + + *Inputs* + G + LTI model of plant. + + W1 + LTI model of performance weight. Bounds the largest singular + values of sensitivity S. Model must be empty `[]', SISO or + of appropriate size. + + W2 + LTI model to penalize large control inputs. Bounds the + largest singular values of KS. Model must be empty `[]', + SISO or of appropriate size. + + W3 + LTI model of robustness and noise sensitivity weight. Bounds + the largest singular values of complementary sensitivity T. + Model must be empty `[]', SISO or of appropriate size. + + ... + Optional arguments of `hinfsyn'. Type `help hinfsyn' for + more information. + + All inputs must be proper/realizable. Scalars, vectors and + matrices are possible instead of LTI models. + + *Outputs* + K + State-space model of the H-infinity (sub-)optimal controller. + + N + State-space model of the lower LFT of P and K. + + GAMMA + L-infinity norm of N. + + RCOND + Vector RCOND contains estimates of the reciprocal condition + numbers of the matrices which are to be inverted and + estimates of the reciprocal condition numbers of the Riccati + equations which have to be solved during the computation of + the controller K. For details, see the description of the + corresponding SLICOT algorithm. + + *Block Diagram* + + | W1 S | + gamma = min||N(K)|| N = | W2 K S | = lft (P, K) + K inf | W3 T | + + +------+ z1 + +---------------------------------------->| W1 |-----> + | +------+ + | +------+ z2 + | +---------------------->| W2 |-----> + | | +------+ + r + e | +--------+ u | +--------+ y +------+ z3 + ----->(+)---+-->| K(s) |----+-->| G(s) |----+---->| W3 |-----> + ^ - +--------+ +--------+ | +------+ + | | + +----------------------------------------+ + + +--------+ + | |-----> z1 (p1x1) z1 = W1 e + r (px1) ----->| P(s) |-----> z2 (p2x1) z2 = W2 u + | |-----> z3 (p3x1) z3 = W3 y + u (mx1) ----->| |-----> e (px1) e = r - y + +--------+ + + +--------+ + r ----->| |-----> z + | P(s) | + u +---->| |-----+ e + | +--------+ | + | | + | +--------+ | + +-----| K(s) |<----+ + +--------+ + + +--------+ + r ----->| N(s) |-----> z + +--------+ + + Extended Plant: P = augw (G, W1, W2, W3) + Controller: K = mixsyn (G, W1, W2, W3) + Entire System: N = lft (P, K) + Open Loop: L = G * K + Closed Loop: T = feedback (L) + + Reference: + Skogestad, S. and Postlethwaite I. + Multivariable Feedback Control: Analysis and Design + Second Edition + Wiley 2005 + Chapter 3.8: General Control Problem Formulation + + *Algorithm* + Relies on commands `augw' and `hinfsyn', which use SLICOT SB10FD + and SB10DD by courtesy of NICONET e.V. (http://www.slicot.org) + + See also: hinfsyn, augw + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Solve stacked S/KS/T H-infinity problem. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ncfsyn + + +# name: +# type: sq_string +# elements: 1 +# length: 2310 + -- Function File: [K, N, GAMMA, INFO] = ncfsyn (G, W1, W2, FACTOR) + Loop shaping H-infinity synthesis. Compute positive feedback + controller using the McFarlane/Glover normalized coprime factor + (NCF) loop shaping design procedure. + + *Inputs* + G + LTI model of plant. + + W1 + LTI model of precompensator. Model must be SISO or of + appropriate size. An identity matrix is taken if W1 is not + specified or if an empty model `[]' is passed. + + W2 + LTI model of postcompensator. Model must be SISO or of + appropriate size. An identity matrix is taken if W2 is not + specified or if an empty model `[]' is passed. + + FACTOR + `factor = 1' implies that an optimal controller is required. + `factor > 1' implies that a suboptimal controller is required, + achieving a performance that is FACTOR times less than + optimal. Default value is 1. + + *Outputs* + K + State-space model of the H-infinity loop-shaping controller. + + N + State-space model of the closed loop depicted below. + + GAMMA + L-infinity norm of N. `gamma = norm (N, inf)'. + + INFO + Structure containing additional information. + + INFO.EMAX + Nugap robustness. `emax = inv (gamma)'. + + INFO.GS + Shaped plant. `Gs = W2 * G * W1'. + + INFO.KS + Controller for shaped plant. `Ks = ncfsyn (Gs)'. + + INFO.RCOND + Estimates of the reciprocal condition numbers of the Riccati + equations and a few other things. For details, see the + description of the corresponding SLICOT algorithm. + + *Block Diagram of N* + + ^ z1 ^ z2 + | | + w1 + | +--------+ | +--------+ + ----->(+)---+-->| Ks |----+--->(+)---->| Gs |----+ + ^ + +--------+ ^ +--------+ | + | w2 | | + | | + +-------------------------------------------------+ + + *Algorithm* + Uses SLICOT SB10ID, SB10KD and SB10ZD by courtesy of NICONET e.V. + (http://www.slicot.org) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Loop shaping H-infinity synthesis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +nichols + + +# name: +# type: sq_string +# elements: 1 +# length: 894 + -- Function File: [MAG, PHA, W] = nichols (SYS) + -- Function File: [MAG, PHA, W] = nichols (SYS, W) + Nichols chart of frequency response. If no output arguments are + given, the response is printed on the screen. + + *Inputs* + SYS + LTI system. Must be a single-input and single-output (SISO) + system. + + W + Optional vector of frequency values. If W is not specified, + it is calculated by the zeros and poles of the system. + Alternatively, the cell `{wmin, wmax}' specifies a frequency + range, where WMIN and WMAX denote minimum and maximum + frequencies in rad/s. + + *Outputs* + MAG + Vector of magnitude. Has length of frequency vector W. + + PHA + Vector of phase. Has length of frequency vector W. + + W + Vector of frequency values used. + + See also: bode, nyquist, sigma + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Nichols chart of frequency response. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +nyquist + + +# name: +# type: sq_string +# elements: 1 +# length: 901 + -- Function File: [RE, IM, W] = nyquist (SYS) + -- Function File: [RE, IM, W] = nyquist (SYS, W) + Nyquist diagram of frequency response. If no output arguments are + given, the response is printed on the screen. + + *Inputs* + SYS + LTI system. Must be a single-input and single-output (SISO) + system. + + W + Optional vector of frequency values. If W is not specified, + it is calculated by the zeros and poles of the system. + Alternatively, the cell `{wmin, wmax}' specifies a frequency + range, where WMIN and WMAX denote minimum and maximum + frequencies in rad/s. + + *Outputs* + RE + Vector of real parts. Has length of frequency vector W. + + IM + Vector of imaginary parts. Has length of frequency vector W. + + W + Vector of frequency values used. + + See also: bode, nichols, sigma + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Nyquist diagram of frequency response. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +obsv + + +# name: +# type: sq_string +# elements: 1 +# length: 459 + -- Function File: OB = obsv (SYS) + -- Function File: OB = obsv (A, C) + Return observability matrix. + + *Inputs* + SYS + LTI model. + + A + State transition matrix (n-by-n). + + C + Measurement matrix (p-by-n). + + *Outputs* + OB + Observability matrix. + + *Equation* + | C | + | CA | + Ob = | CA^2 | + | ... | + | CA^(n-1) | + + + + +# name: +# type: sq_string +# elements: 1 +# length: 28 +Return observability matrix. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +obsvf + + +# name: +# type: sq_string +# elements: 1 +# length: 925 + -- Function File: [SYSBAR, T, K] = obsvf (SYS) + -- Function File: [SYSBAR, T, K] = obsvf (SYS, TOL) + -- Function File: [ABAR, BBAR, CBAR, T, K] = obsvf (A, B, C) + -- Function File: [ABAR, BBAR, CBAR, T, K] = obsvf (A, B, C, TOL) + If Ob=obsv(A,C) has rank r <= n = SIZE(A,1), then there is a + similarity transformation Tc such that To = [t1;t2] where t1 is c + and t2 is orthogonal to t1 + + Abar = To \ A * To , Bbar = To \ B , Cbar = C * To + + and the transformed system has the form + + | Ao 0 | | Bo | + Abar = |----------|, Bbar = | --- |, Cbar = [Co | 0 ]. + | A21 Ano| | Bno | + + where (Ao,Bo) is observable, and Co(sI-Ao)^(-1)Bo = C(sI-A)^(-1)B. + And system is detectable if Ano has no eigenvalues in the right + half plane. The last output K is a vector of length n containing + the number of observable states. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If Ob=obsv(A,C) has rank r <= n = SIZE(A,1), then there is a similarity +transfor + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +optiPID + + +# name: +# type: sq_string +# elements: 1 +# length: 235 +Numerical optimization of a PID controller using an objective function. +The objective function is located in the file `optiPIDfun'. Type +`which optiPID' to locate, `edit optiPID' to open and simply `optiPID' +to run the example file. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +Numerical optimization of a PID controller using an objective function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +optiPIDctrl + + +# name: +# type: sq_string +# elements: 1 +# length: 397 + =============================================================================== + optiPIDctrl Lukas Reichlin February 2012 + =============================================================================== + Return PID controller with roll-off for given parameters Kp, Ti and Td. + =============================================================================== + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + =============================================================================== + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +optiPIDfun + + +# name: +# type: sq_string +# elements: 1 +# length: 464 + =============================================================================== + optiPIDfun Lukas Reichlin July 2009 + =============================================================================== + Objective Function + Reference: Guzzella, L. (2007) Analysis and Synthesis of SISO Control Systems. + vdf Hochschulverlag, Zurich + =============================================================================== + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + =============================================================================== + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +options + + +# name: +# type: sq_string +# elements: 1 +# length: 791 + -- Function File: OPT = options ("KEY1", VALUE1, "KEY2", VALUE2, ...) + Create options struct OPT from a number of key and value pairs. + For use with order reduction commands. + + *Inputs* + KEY, PROPERTY + The name of the property. + + VALUE + The value of the property. + + *Outputs* + OPT + Struct with fields for each key. + + *Example* + octave:1> opt = options ("method", "spa", "tol", 1e-6) + opt = + + scalar structure containing the fields: + + method = spa + tol = 1.0000e-06 + + octave:2> save filename opt + octave:3> # save the struct 'opt' to file 'filename' for later use + octave:4> load filename + octave:5> # load struct 'opt' from file 'filename' + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Create options struct OPT from a number of key and value pairs. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +place + + +# name: +# type: sq_string +# elements: 1 +# length: 1978 + -- Function File: F = place (SYS, P) + -- Function File: F = place (A, B, P) + -- Function File: [F, INFO] = place (SYS, P, ALPHA) + -- Function File: [F, INFO] = place (A, B, P, ALPHA) + Pole assignment for a given matrix pair (A,B) such that `p = eig + (A-B*F)'. If parameter ALPHA is specified, poles with real parts + (continuous-time) or moduli (discrete-time) below ALPHA are left + untouched. + + *Inputs* + SYS + LTI system. + + A + State transition matrix (n-by-n) of a continuous-time system. + + B + Input matrix (n-by-m) of a continuous-time system. + + P + Desired eigenvalues of the closed-loop system state-matrix + A-B*F. `length (p) <= rows (A)'. + + ALPHA + Specifies the maximum admissible value, either for real parts + or for moduli, of the eigenvalues of A which will not be + modified by the eigenvalue assignment algorithm. `alpha >= + 0' for discrete-time systems. + + *Outputs* + F + State feedback gain matrix. + + INFO + Structure containing additional information. + + INFO.NFP + The number of fixed poles, i.e. eigenvalues of A having real + parts less than ALPHA, or moduli less than ALPHA. These + eigenvalues are not modified by `place'. + + INFO.NAP + The number of assigned eigenvalues. `nap = n-nfp-nup'. + + INFO.NUP + The number of uncontrollable eigenvalues detected by the + eigenvalue assignment algorithm. + + INFO.Z + The orthogonal matrix Z reduces the closed-loop system state + matrix `A + B*F' to upper real Schur form. Note the positive + sign in `A + B*F'. + + *Note* + Place is also suitable to design estimator gains: + L = place (A.', C.', p).' + L = place (sys.', p).' # useful for discrete-time systems + + *Algorithm* + Uses SLICOT SB01BD by courtesy of NICONET e.V. + (http://www.slicot.org) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 74 +Pole assignment for a given matrix pair (A,B) such that `p = eig +(A-B*F)'. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +pzmap + + +# name: +# type: sq_string +# elements: 1 +# length: 415 + -- Function File: pzmap (SYS) + -- Function File: [P, Z] = pzmap (SYS) + Plot the poles and zeros of an LTI system in the complex plane. + If no output arguments are given, the result is plotted on the + screen. Otherwise, the poles and zeros are computed and returned. + + *Inputs* + SYS + LTI model. + + *Outputs* + P + Poles of SYS. + + Z + Transmission zeros of SYS. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Plot the poles and zeros of an LTI system in the complex plane. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +rlocus + + +# name: +# type: sq_string +# elements: 1 +# length: 910 + -- Function File: rlocus (SYS) + -- Function File: [RLDATA, K] = rlocus (SYS, INCREMENT, MIN_K, MAX_K) + Display root locus plot of the specified SISO system. + + *Inputs* + SYS + LTI model. Must be a single-input and single-output (SISO) + system. + + MIN_K + Minimum value of K. + + MAX_K + Maximum value of K. + + INCREMENT + The increment used in computing gain values. + + *Outputs* + RLDATA + Data points plotted: in column 1 real values, in column 2 the + imaginary values. + + K + Gains for real axis break points. + + *Block Diagram* + u + +---+ +------+ y + ------>(+)----->| k |----->| SISO |-------+-------> + ^ - +---+ +------+ | + | | + +---------------------------------+ + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Display root locus plot of the specified SISO system. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +sigma + + +# name: +# type: sq_string +# elements: 1 +# length: 1643 + -- Function File: [SV, W] = sigma (SYS) + -- Function File: [SV, W] = sigma (SYS, W) + -- Function File: [SV, W] = sigma (SYS, [], PTYPE) + -- Function File: [SV, W] = sigma (SYS, W, PTYPE) + Singular values of frequency response. If no output arguments are + given, the singular value plot is printed on the screen; + + *Inputs* + SYS + LTI system. Multiple inputs and/or outputs (MIMO systems) + make practical sense. + + W + Optional vector of frequency values. If W is not specified, + it is calculated by the zeros and poles of the system. + Alternatively, the cell `{wmin, wmax}' specifies a frequency + range, where WMIN and WMAX denote minimum and maximum + frequencies in rad/s. + + PTYPE = 0 + Singular values of the frequency response H of system SYS. + Default Value. + + PTYPE = 1 + Singular values of the frequency response `inv(H)'; i.e. + inversed system. + + PTYPE = 2 + Singular values of the frequency response `I + H'; i.e. + inversed sensitivity (or return difference) if `H = P * C'. + + PTYPE = 3 + Singular values of the frequency response `I + inv(H)'; i.e. + inversed complementary sensitivity if `H = P * C'. + + *Outputs* + SV + Array of singular values. For a system with m inputs and p + outputs, the array sv has `min (m, p)' rows and as many + columns as frequency points `length (w)'. The singular + values at the frequency `w(k)' are given by `sv(:,k)'. + + W + Vector of frequency values used. + + See also: bodemag, svd + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Singular values of frequency response. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +spaconred + + +# name: +# type: sq_string +# elements: 1 +# length: 6224 + -- Function File: [KR, INFO] = spaconred (G, K, ...) + -- Function File: [KR, INFO] = spaconred (G, K, NCR, ...) + -- Function File: [KR, INFO] = spaconred (G, K, OPT, ...) + -- Function File: [KR, INFO] = spaconred (G, K, NCR, OPT, ...) + Controller reduction by frequency-weighted Singular Perturbation + Approximation (SPA). Given a plant G and a stabilizing controller + K, determine a reduced order controller KR such that the + closed-loop system is stable and closed-loop performance is + retained. + + The algorithm tries to minimize the frequency-weighted error + ||V (K-Kr) W|| = min + inf + where V and W denote output and input weightings. + + *Inputs* + G + LTI model of the plant. It has m inputs, p outputs and n + states. + + K + LTI model of the controller. It has p inputs, m outputs and + nc states. + + NCR + The desired order of the resulting reduced order controller + KR. If not specified, NCR is chosen automatically according + to the description of key 'ORDER'. + + ... + Optional pairs of keys and values. `"key1", value1, "key2", + value2'. + + OPT + Optional struct with keys as field names. Struct OPT can be + created directly or by command `options'. `opt.key1 = + value1, opt.key2 = value2'. + + *Outputs* + KR + State-space model of reduced order controller. + + INFO + Struct containing additional information. + INFO.NCR + The order of the obtained reduced order controller KR. + + INFO.NCS + The order of the alpha-stable part of original + controller K. + + INFO.HSVC + The Hankel singular values of the alpha-stable part of K. + The NCS Hankel singular values are ordered decreasingly. + + *Option Keys and Values* + 'ORDER', 'NCR' + The desired order of the resulting reduced order controller + KR. If not specified, NCR is chosen automatically such that + states with Hankel singular values INFO.HSVC > TOL1 are + retained. + + 'METHOD' + Order reduction approach to be used as follows: + 'SR', 'S' + Use the square-root Singular Perturbation Approximation + method. + + 'BFSR', 'P' + Use the balancing-free square-root Singular Perturbation + Approximation method. Default method. + + 'WEIGHT' + Specifies the type of frequency-weighting as follows: + 'NONE' + No weightings are used (V = I, W = I). + + 'LEFT', 'OUTPUT' + Use stability enforcing left (output) weighting + -1 + V = (I-G*K) *G , W = I + + 'RIGHT', 'INPUT' + Use stability enforcing right (input) weighting + -1 + V = I , W = (I-G*K) *G + + 'BOTH', 'PERFORMANCE' + Use stability and performance enforcing weightings + -1 -1 + V = (I-G*K) *G , W = (I-G*K) + Default value. + + 'FEEDBACK' + Specifies whether K is a positive or negative feedback + controller: + '+' + Use positive feedback controller. Default value. + + '-' + Use negative feedback controller. + + 'ALPHA' + Specifies the ALPHA-stability boundary for the eigenvalues of + the state dynamics matrix K.A. For a continuous-time + controller, ALPHA <= 0 is the boundary value for the real + parts of eigenvalues, while for a discrete-time controller, 0 + <= ALPHA <= 1 represents the boundary value for the moduli of + eigenvalues. The ALPHA-stability domain does not include the + boundary. Default value is 0 for continuous-time controllers + and 1 for discrete-time controllers. + + 'TOL1' + If 'ORDER' is not specified, TOL1 contains the tolerance for + determining the order of the reduced controller. For model + reduction, the recommended value of TOL1 is c*info.hsvc(1), + where c lies in the interval [0.00001, 0.001]. Default value + is info.ncs*eps*info.hsvc(1). If 'ORDER' is specified, the + value of TOL1 is ignored. + + 'TOL2' + The tolerance for determining the order of a minimal + realization of the ALPHA-stable part of the given controller. + TOL2 <= TOL1. If not specified, ncs*eps*info.hsvc(1) is + chosen. + + 'GRAM-CTRB' + Specifies the choice of frequency-weighted controllability + Grammian as follows: + 'STANDARD' + Choice corresponding to standard Enns' method [1]. + Default method. + + 'ENHANCED' + Choice corresponding to the stability enhanced modified + Enns' method of [2]. + + 'GRAM-OBSV' + Specifies the choice of frequency-weighted observability + Grammian as follows: + 'STANDARD' + Choice corresponding to standard Enns' method [1]. + Default method. + + 'ENHANCED' + Choice corresponding to the stability enhanced modified + Enns' method of [2]. + + 'EQUIL', 'SCALE' + Boolean indicating whether equilibration (scaling) should be + performed on G and K prior to order reduction. Default value + is false if both `G.scaled == true, K.scaled == true' and + true otherwise. Note that for MIMO models, proper scaling of + both inputs and outputs is of utmost importance. The input + and output scaling can *not* be done by the equilibration + option or the `prescale' command because these functions + perform state transformations only. Furthermore, signals + should not be scaled simply to a certain range. For all + inputs (or outputs), a certain change should be of the same + importance for the model. + + *Algorithm* + Uses SLICOT SB16AD by courtesy of NICONET e.V. + (http://www.slicot.org) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Controller reduction by frequency-weighted Singular Perturbation +Approximation ( + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +spamodred + + +# name: +# type: sq_string +# elements: 1 +# length: 7167 + -- Function File: [GR, INFO] = spamodred (G, ...) + -- Function File: [GR, INFO] = spamodred (G, NR, ...) + -- Function File: [GR, INFO] = spamodred (G, OPT, ...) + -- Function File: [GR, INFO] = spamodred (G, NR, OPT, ...) + Model order reduction by frequency weighted Singular Perturbation + Approximation (SPA). The aim of model reduction is to find an LTI + system GR of order NR (nr < n) such that the input-output + behaviour of GR approximates the one from original system G. + + SPA is an absolute error method which tries to minimize + ||G-Gr|| = min + inf + + ||V (G-Gr) W|| = min + inf + where V and W denote output and input weightings. + + *Inputs* + G + LTI model to be reduced. + + NR + The desired order of the resulting reduced order system GR. + If not specified, NR is chosen automatically according to the + description of key 'ORDER'. + + ... + Optional pairs of keys and values. `"key1", value1, "key2", + value2'. + + OPT + Optional struct with keys as field names. Struct OPT can be + created directly or by command `options'. `opt.key1 = + value1, opt.key2 = value2'. + + *Outputs* + GR + Reduced order state-space model. + + INFO + Struct containing additional information. + INFO.N + The order of the original system G. + + INFO.NS + The order of the ALPHA-stable subsystem of the original + system G. + + INFO.HSV + The Hankel singular values of the ALPHA-stable part of + the original system G, ordered decreasingly. + + INFO.NU + The order of the ALPHA-unstable subsystem of both the + original system G and the reduced-order system GR. + + INFO.NR + The order of the obtained reduced order system GR. + + *Option Keys and Values* + 'ORDER', 'NR' + The desired order of the resulting reduced order system GR. + If not specified, NR is chosen automatically such that states + with Hankel singular values INFO.HSV > TOL1 are retained. + + 'LEFT', 'OUTPUT' + LTI model of the left/output frequency weighting V. Default + value is an identity matrix. + + 'RIGHT', 'INPUT' + LTI model of the right/input frequency weighting W. Default + value is an identity matrix. + + 'METHOD' + Approximation method for the L-infinity norm to be used as + follows: + 'SR', 'S' + Use the square-root Singular Perturbation Approximation + method. + + 'BFSR', 'P' + Use the balancing-free square-root Singular Perturbation + Approximation method. Default method. + + 'ALPHA' + Specifies the ALPHA-stability boundary for the eigenvalues of + the state dynamics matrix G.A. For a continuous-time system, + ALPHA <= 0 is the boundary value for the real parts of + eigenvalues, while for a discrete-time system, 0 <= ALPHA <= + 1 represents the boundary value for the moduli of eigenvalues. + The ALPHA-stability domain does not include the boundary. + Default value is 0 for continuous-time systems and 1 for + discrete-time systems. + + 'TOL1' + If 'ORDER' is not specified, TOL1 contains the tolerance for + determining the order of the reduced model. For model + reduction, the recommended value of TOL1 is c*info.hsv(1), + where c lies in the interval [0.00001, 0.001]. Default value + is info.ns*eps*info.hsv(1). If 'ORDER' is specified, the + value of TOL1 is ignored. + + 'TOL2' + The tolerance for determining the order of a minimal + realization of the ALPHA-stable part of the given model. + TOL2 <= TOL1. If not specified, ns*eps*info.hsv(1) is chosen. + + 'GRAM-CTRB' + Specifies the choice of frequency-weighted controllability + Grammian as follows: + 'STANDARD' + Choice corresponding to a combination method [4] of the + approaches of Enns [1] and Lin-Chiu [2,3]. Default + method. + + 'ENHANCED' + Choice corresponding to the stability enhanced modified + combination method of [4]. + + 'GRAM-OBSV' + Specifies the choice of frequency-weighted observability + Grammian as follows: + 'STANDARD' + Choice corresponding to a combination method [4] of the + approaches of Enns [1] and Lin-Chiu [2,3]. Default + method. + + 'ENHANCED' + Choice corresponding to the stability enhanced modified + combination method of [4]. + + 'ALPHA-CTRB' + Combination method parameter for defining the + frequency-weighted controllability Grammian. abs(alphac) <= + 1. If alphac = 0, the choice of Grammian corresponds to the + method of Enns [1], while if alphac = 1, the choice of + Grammian corresponds to the method of Lin and Chiu [2,3]. + Default value is 0. + + 'ALPHA-OBSV' + Combination method parameter for defining the + frequency-weighted observability Grammian. abs(alphao) <= 1. + If alphao = 0, the choice of Grammian corresponds to the + method of Enns [1], while if alphao = 1, the choice of + Grammian corresponds to the method of Lin and Chiu [2,3]. + Default value is 0. + + 'EQUIL', 'SCALE' + Boolean indicating whether equilibration (scaling) should be + performed on system G prior to order reduction. Default + value is true if `G.scaled == false' and false if `G.scaled + == true'. Note that for MIMO models, proper scaling of both + inputs and outputs is of utmost importance. The input and + output scaling can *not* be done by the equilibration option + or the `prescale' command because these functions perform + state transformations only. Furthermore, signals should not + be scaled simply to a certain range. For all inputs (or + outputs), a certain change should be of the same importance + for the model. + + *References* + [1] Enns, D. Model reduction with balanced realizations: An error + bound and a frequency weighted generalization. Proc. 23-th CDC, + Las Vegas, pp. 127-132, 1984. + + [2] Lin, C.-A. and Chiu, T.-Y. Model reduction via + frequency-weighted balanced realization. Control Theory and + Advanced Technology, vol. 8, pp. 341-351, 1992. + + [3] Sreeram, V., Anderson, B.D.O and Madievski, A.G. New results + on frequency weighted balanced reduction technique. Proc. ACC, + Seattle, Washington, pp. 4004-4009, 1995. + + [4] Varga, A. and Anderson, B.D.O. Square-root balancing-free + methods for the frequency-weighted balancing related model + reduction. (report in preparation) + + *Algorithm* + Uses SLICOT AB09ID by courtesy of NICONET e.V. + (http://www.slicot.org) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Model order reduction by frequency weighted Singular Perturbation +Approximation + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +step + + +# name: +# type: sq_string +# elements: 1 +# length: 1235 + -- Function File: [Y, T, X] = step (SYS) + -- Function File: [Y, T, X] = step (SYS, T) + -- Function File: [Y, T, X] = step (SYS, TFINAL) + -- Function File: [Y, T, X] = step (SYS, TFINAL, DT) + Step response of LTI system. If no output arguments are given, + the response is printed on the screen. + + *Inputs* + SYS + LTI model. + + T + Time vector. Should be evenly spaced. If not specified, it + is calculated by the poles of the system to reflect + adequately the response transients. + + TFINAL + Optional simulation horizon. If not specified, it is + calculated by the poles of the system to reflect adequately + the response transients. + + DT + Optional sampling time. Be sure to choose it small enough to + capture transient phenomena. If not specified, it is + calculated by the poles of the system. + + *Outputs* + Y + Output response array. Has as many rows as time samples + (length of t) and as many columns as outputs. + + T + Time row vector. + + X + State trajectories array. Has `length (t)' rows and as many + columns as states. + + See also: impulse, initial, lsim + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 28 +Step response of LTI system. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +strseq + + +# name: +# type: sq_string +# elements: 1 +# length: 250 + -- Function File: STRVEC = strseq (STR, IDX) + Return a cell vector of indexed strings by appending the indices + IDX to the string STR. + + strseq ("x", 1:3) = {"x1"; "x2"; "x3"} + strseq ("u", [1, 2, 5]) = {"u1"; "u2"; "u5"} + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return a cell vector of indexed strings by appending the indices IDX to +the stri + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +test_control + + +# name: +# type: sq_string +# elements: 1 +# length: 1089 + -- Script File: test_control + Execute all available tests at once. The Octave control package + is based on the SLICOT (http://www.slicot.org) library. SLICOT + needs a LAPACK library which is also a prerequisite for Octave + itself. In case of failing test, it is highly recommended to use + Netlib's reference LAPACK (http://www.netlib.org/lapack/) for + building Octave. Using ATLAS may lead to sign changes in some + entries in the state-space matrices. In general, these sign + changes are not 'wrong' and can be regarded as the result of state + transformations. Such state transformations (but not input/output + transformations) have no influence on the input-output behaviour + of the system. For better numerics, the control package uses such + transformations by default when calculating the frequency + responses and a few other things. However, arguments like the + Hankel singular Values (HSV) must not change. Differing HSVs and + failing algorithms are known for using Framework Accelerate from + Mac OS X 10.7. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Execute all available tests at once. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +tfpoly2str + + +# name: +# type: sq_string +# elements: 1 +# length: 158 + -- Function File: STR = tfpoly2str (P) + -- Function File: STR = tfpoly2str (P, TFVAR) + Return the string of a polynomial with string TFVAR as variable. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 +Return the string of a polynomial with string TFVAR as variable. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +tfpolyones + + +# name: +# type: sq_string +# elements: 1 +# length: 59 +Return (pxm) cell of tfpoly([1]). For internal use only. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Return (pxm) cell of tfpoly([1]). + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +tfpolyzeros + + +# name: +# type: sq_string +# elements: 1 +# length: 59 +Return (pxm) cell of tfpoly([0]). For internal use only. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Return (pxm) cell of tfpoly([0]). + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +zpk + + +# name: +# type: sq_string +# elements: 1 +# length: 1373 + -- Function File: S = zpk ("S") + -- Function File: Z = zpk ("Z", TSAM) + -- Function File: SYS = zpk (SYS) + -- Function File: SYS = zpk (K) + -- Function File: SYS = zpk (Z, P, K, ...) + -- Function File: SYS = zpk (Z, P, K, TSAM, ...) + -- Function File: SYS = zpk (Z, P, K, TSAM, ...) + Create transfer function model from zero-pole-gain data. This is + just a stop-gap compatibility wrapper since zpk models are not yet + implemented. + + *Inputs* + SYS + LTI model to be converted to transfer function. + + Z + Cell of vectors containing the zeros for each channel. + z{i,j} contains the zeros from input j to output i. In the + SISO case, a single vector is accepted as well. + + P + Cell of vectors containing the poles for each channel. + p{i,j} contains the poles from input j to output i. In the + SISO case, a single vector is accepted as well. + + K + Matrix containing the gains for each channel. k(i,j) + contains the gain from input j to output i. + + TSAM + Sampling time in seconds. If TSAM is not specified, a + continuous-time model is assumed. + + ... + Optional pairs of properties and values. Type `set (tf)' for + more information. + + *Outputs* + SYS + Transfer function model. + + See also: tf, ss, dss, frd + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 +Create transfer function model from zero-pole-gain data. + + + + + diff --git a/octave_packages/control-2.3.52/dss.m b/octave_packages/control-2.3.52/dss.m new file mode 100644 index 0000000..0a5fdda --- /dev/null +++ b/octave_packages/control-2.3.52/dss.m @@ -0,0 +1,90 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} dss (@var{sys}) +## @deftypefnx {Function File} {@var{sys} =} dss (@var{d}) +## @deftypefnx {Function File} {@var{sys} =} dss (@var{a}, @var{b}, @var{c}, @var{d}, @var{e}, @dots{}) +## @deftypefnx {Function File} {@var{sys} =} dss (@var{a}, @var{b}, @var{c}, @var{d}, @var{e}, @var{tsam}, @dots{}) +## Create or convert to descriptor state-space model. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model to be converted to state-space. +## @item a +## State transition matrix (n-by-n). +## @item b +## Input matrix (n-by-m). +## @item c +## Measurement matrix (p-by-n). +## @item d +## Feedthrough matrix (p-by-m). +## @item e +## Descriptor matrix (n-by-n). +## @item tsam +## Sampling time in seconds. If @var{tsam} is not specified, +## a continuous-time model is assumed. +## @item @dots{} +## Optional pairs of properties and values. +## Type @command{set (dss)} for more information. +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## Descriptor state-space model. +## @end table +## +## @strong{Equations} +## @example +## @group +## . +## E x = A x + B u +## y = C x + D u +## @end group +## @end example +## +## @seealso{ss, tf} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2010 +## Version: 0.1 + +function sys = dss (varargin) + + switch (nargin) + case {0, 1} # static gain (dss (5)) or empty (useful for "set (dss)") + sys = ss (varargin{:}); + + case {2, 3, 4} + print_usage (); + + otherwise # general case + sys = ss (varargin{[1:4, 6:end]}, "e", varargin{5}); + endswitch + +endfunction + +## NOTE: The author prefers "dss (e, a, b, c, d)" since we write +## . +## E x = A x + B u, y = C x + D u +## +## but this would break compatibility to a widespread +## commercial implementation of the octave language. +## There's no way to tell e and d apart if n = m = p. diff --git a/octave_packages/control-2.3.52/estim.m b/octave_packages/control-2.3.52/estim.m new file mode 100644 index 0000000..1c40ad0 --- /dev/null +++ b/octave_packages/control-2.3.52/estim.m @@ -0,0 +1,99 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{est} =} estim (@var{sys}, @var{l}) +## @deftypefnx {Function File} {@var{est} =} estim (@var{sys}, @var{l}, @var{sensors}, @var{known}) +## Return state estimator for a given estimator gain. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. +## @item l +## State feedback matrix. +## @item sensors +## Indices of measured output signals y from @var{sys}. If omitted, all outputs are measured. +## @item known +## Indices of known input signals u (deterministic) to @var{sys}. All other inputs to @var{sys} +## are assumed stochastic. If argument @var{known} is omitted, no inputs u are known. +## @end table +## +## @strong{Outputs} +## @table @var +## @item est +## State-space model of estimator. +## @end table +## @seealso{kalman, place} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.2 + +function est = estim (sys, l, sensors = [], known = []) + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + if (! isa (sys, "lti")) + error ("estim: first argument must be an LTI system"); + endif + + [a, b, c, d, e, tsam] = dssdata (sys, []); + + if (isempty (sensors)) + sensors = 1 : rows (c); + endif + + m = length (known); + n = rows (a); + p = length (sensors); + + b = b(:, known); + c = c(sensors, :); + d = d(sensors, known); + + f = a - l*c; + g = [b - l*d, l]; + h = [c; eye(n)]; + j = [d, zeros(p, p); zeros(n, m), zeros(n, p)]; + ## k = e; + + est = dss (f, g, h, j, e, tsam); + + ## TODO: inname, stname, outname + +endfunction + + +%!shared m, m_exp +%! sys = ss (-2, 1, 1, 3); +%! est = estim (sys, 5); +%! [a, b, c, d] = ssdata (est); +%! m = [a, b; c, d]; +%! m_exp = [-7, 5; 1, 0; 1, 0]; +%!assert (m, m_exp, 1e-4); + +%!shared m, m_exp +%! sys = ss (-1, 2, 3, 4); +%! est = estim (sys, 5); +%! [a, b, c, d] = ssdata (est); +%! m = [a, b; c, d]; +%! m_exp = [-16, 5; 3, 0; 1, 0]; +%!assert (m, m_exp, 1e-4); \ No newline at end of file diff --git a/octave_packages/control-2.3.52/filt.m b/octave_packages/control-2.3.52/filt.m new file mode 100644 index 0000000..c7e8372 --- /dev/null +++ b/octave_packages/control-2.3.52/filt.m @@ -0,0 +1,139 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{sys} =} filt (@var{num}, @var{den}, @dots{}) +## @deftypefnx {Function File} {@var{sys} =} filt (@var{num}, @var{den}, @var{tsam}, @dots{}) +## Create discrete-time transfer function model from data in DSP format. +## +## @strong{Inputs} +## @table @var +## @item num +## Numerator or cell of numerators. Each numerator must be a row vector +## containing the coefficients of the polynomial in ascending powers of z^-1. +## num@{i,j@} contains the numerator polynomial from input j to output i. +## In the SISO case, a single vector is accepted as well. +## @item den +## Denominator or cell of denominators. Each denominator must be a row vector +## containing the coefficients of the polynomial in ascending powers of z^-1. +## den@{i,j@} contains the denominator polynomial from input j to output i. +## In the SISO case, a single vector is accepted as well. +## @item tsam +## Sampling time in seconds. If @var{tsam} is not specified, +## default value -1 (unspecified) is taken. +## @item @dots{} +## Optional pairs of properties and values. +## Type @command{set (filt)} for more information. +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## Discrete-time transfer function model. +## @end table +## +## @strong{Example} +## @example +## @group +## 3 z^-1 +## H(z^-1) = ------------------- +## 1 + 4 z^-1 + 2 z^-2 +## +## octave:1> H = filt ([0, 3], [1, 4, 2]) +## +## Transfer function 'H' from input 'u1' to output ... +## +## 3 z^-1 +## y1: ------------------- +## 1 + 4 z^-1 + 2 z^-2 +## +## Sampling time: unspecified +## Discrete-time model. +## @end group +## @end example +## +## @seealso{tf} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: April 2012 +## Version: 0.1 + +function sys = filt (num = {}, den = {}, tsam = -1, varargin) + + switch (nargin) + case 0 # filt () + sys = tf (); + ## sys.inv = true; + return; + + case 1 # filt (sys), filt (matrix) + if (isa (num, "lti") || is_real_matrix (num)) + sys = tf (num); + ## sys.inv = true; # would be a problem for continuous-time LTI models + return; + else + print_usage (); + endif + + otherwise # filt (num, den, ...) + if (! iscell (num)) + num = {num}; + endif + if (! iscell (den)) + den = {den}; + endif + + ## convert from z^-1 to z + ## expand each channel by z^x, where x is the largest exponent of z^-1 (z^-x) + + ## remove trailing zeros + ## such that polynomials are as short as possible + num = cellfun (@__remove_trailing_zeros__, num, "uniformoutput", false); + den = cellfun (@__remove_trailing_zeros__, den, "uniformoutput", false); + + ## make numerator and denominator polynomials equally long + ## by adding trailing zeros + lnum = cellfun (@length, num, "uniformoutput", false); + lden = cellfun (@length, den, "uniformoutput", false); + + lmax = cellfun (@max, lnum, lden, "uniformoutput", false); + + num = cellfun (@postpad, num, lmax, "uniformoutput", false); + den = cellfun (@postpad, den, lmax, "uniformoutput", false); + + ## use standard tf constructor + ## sys is stored in standard z form, not z^-1 + ## so we can mix it with regular transfer function models + ## property "inv", true displays sys in z^-1 form + sys = tf (num, den, tsam, "inv", true, varargin{:}); + endswitch + +endfunction + +%!shared num, den, n1, d1, n2, d2, n2e, d2e +%! num = [0, 3]; +%! den = [1, 4, 2]; +%! sys = filt (num, den); +%! [n1, d1] = filtdata (sys, "vector"); +%! [n2, d2] = tfdata (sys, "vector"); +%! n2e = [3, 0]; +%! d2e = [1, 4, 2]; +%!assert (n1, num, 1e-4); +%!assert (d1, den, 1e-4); +%!assert (n2, n2e, 1e-4); +%!assert (d2, d2e, 1e-4); diff --git a/octave_packages/control-2.3.52/fitfrd.m b/octave_packages/control-2.3.52/fitfrd.m new file mode 100644 index 0000000..70dbc5c --- /dev/null +++ b/octave_packages/control-2.3.52/fitfrd.m @@ -0,0 +1,100 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{sys}, @var{n}] =} fitfrd (@var{dat}, @var{n}) +## @deftypefnx{Function File} {[@var{sys}, @var{n}] =} fitfrd (@var{dat}, @var{n}, @var{flag}) +## Fit frequency response data with a state-space system. +## If requested, the returned system is stable and minimum-phase. +## +## @strong{Inputs} +## @table @var +## @item dat +## LTI model containing frequency response data of a SISO system. +## @item n +## The desired order of the system to be fitted. @code{n <= length(dat.w)}. +## @item flag +## The flag controls whether the returned system is stable and minimum-phase. +## @table @var +## @item 0 +## The system zeros and poles are not constrained. Default value. +## @item 1 +## The system zeros and poles will have negative real parts in the +## continuous-time case, or moduli less than 1 in the discrete-time case. +## @end table +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## State-space model of order @var{n}, fitted to frequency response data @var{dat}. +## @item n +## The order of the obtained system. The value of @var{n} +## could only be modified if inputs @code{n > 0} and @code{flag = 1}. +## @end table +## +## @strong{Algorithm}@* +## Uses SLICOT SB10YD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2011 +## Version: 0.1 + +function [sys, n] = fitfrd (dat, n, flag = 0) + + if (nargin == 0 || nargin > 3) + print_usage (); + endif + + if (! isa (dat, "frd")) + dat = frd (dat); + endif + + if (! issiso (dat)) + error ("fitfrd: require SISO system"); + endif + + if (! issample (n, 0) || n != round (n)) + error ("fitfrd: second argument must be an integer >= 0"); + endif + + [H, w, tsam] = frdata (dat, "vector"); + dt = isdt (dat); + + if (n > length (w)) + error ("fitfrd: require n <= length (dat.w)"); + endif + + [a, b, c, d, n] = slsb10yd (real (H), imag (H), w, n, dt, logical (flag)); + + sys = ss (a, b, c, d, tsam); + +endfunction + + +%!shared Yo, Ye +%! SYS = ss (-1, 1, 1, 0); +%! T = 0:0.1:50; +%! Ye = step (SYS, T); +%! W = logspace (-2, 2, 100); +%! FR = frd (SYS, W); +%! N = 1; +%! SYSID = fitfrd (FR, N, 1); +%! Yo = step (SYSID, T); +%!assert (Yo, Ye, 1e-2); \ No newline at end of file diff --git a/octave_packages/control-2.3.52/fwcfconred.m b/octave_packages/control-2.3.52/fwcfconred.m new file mode 100644 index 0000000..2962a80 --- /dev/null +++ b/octave_packages/control-2.3.52/fwcfconred.m @@ -0,0 +1,295 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{Kr}, @var{info}] =} fwcfconred (@var{G}, @var{F}, @var{L}, @dots{}) +## @deftypefnx{Function File} {[@var{Kr}, @var{info}] =} fwcfconred (@var{G}, @var{F}, @var{L}, @var{ncr}, @dots{}) +## @deftypefnx{Function File} {[@var{Kr}, @var{info}] =} fwcfconred (@var{G}, @var{F}, @var{L}, @var{opt}, @dots{}) +## @deftypefnx{Function File} {[@var{Kr}, @var{info}] =} fwcfconred (@var{G}, @var{F}, @var{L}, @var{ncr}, @var{opt}, @dots{}) +## +## Reduction of state-feedback-observer based controller by frequency-weighted coprime factorization (FW CF). +## Given a plant @var{G}, state feedback gain @var{F} and full observer gain @var{L}, +## determine a reduced order controller @var{Kr} by using stability enforcing frequency weights. +## +## @strong{Inputs} +## @table @var +## @item G +## LTI model of the open-loop plant (A,B,C,D). +## It has m inputs, p outputs and n states. +## @item F +## Stabilizing state feedback matrix (m-by-n). +## @item L +## Stabilizing observer gain matrix (n-by-p). +## @item ncr +## The desired order of the resulting reduced order controller @var{Kr}. +## If not specified, @var{ncr} is chosen automatically according +## to the description of key @var{'order'}. +## @item @dots{} +## Optional pairs of keys and values. @code{"key1", value1, "key2", value2}. +## @item opt +## Optional struct with keys as field names. +## Struct @var{opt} can be created directly or +## by command @command{options}. @code{opt.key1 = value1, opt.key2 = value2}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item Kr +## State-space model of reduced order controller. +## @item info +## Struct containing additional information. +## @table @var +## @item info.hsv +## The Hankel singular values of the extended system?!?. +## The @var{n} Hankel singular values are ordered decreasingly. +## @item info.ncr +## The order of the obtained reduced order controller @var{Kr}. +## @end table +## @end table +## +## @strong{Option Keys and Values} +## @table @var +## @item 'order', 'ncr' +## The desired order of the resulting reduced order controller @var{Kr}. +## If not specified, @var{ncr} is chosen automatically such that states with +## Hankel singular values @var{info.hsv} > @var{tol1} are retained. +## +## @item 'method' +## Order reduction approach to be used as follows: +## @table @var +## @item 'sr', 'b' +## Use the square-root Balance & Truncate method. +## @item 'bfsr', 'f' +## Use the balancing-free square-root Balance & Truncate method. Default method. +## @end table +## +## @item 'cf' +## Specifies whether left or right coprime factorization is +## to be used as follows: +## @table @var +## @item 'left', 'l' +## Use left coprime factorization. +## @item 'right', 'r' +## Use right coprime factorization. Default method. +## @end table +## +## @item 'feedback' +## Specifies whether @var{F} and @var{L} are fed back positively or negatively: +## @table @var +## @item '+' +## A+BK and A+LC are both Hurwitz matrices. +## @item '-' +## A-BK and A-LC are both Hurwitz matrices. Default value. +## @end table +## +## @item 'tol1' +## If @var{'order'} is not specified, @var{tol1} contains the tolerance for +## determining the order of the reduced system. +## For model reduction, the recommended value of @var{tol1} is +## c*info.hsv(1), where c lies in the interval [0.00001, 0.001]. +## Default value is n*eps*info.hsv(1). +## If @var{'order'} is specified, the value of @var{tol1} is ignored. +## @end table +## +## @strong{Algorithm}@* +## Uses SLICOT SB16CD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: December 2011 +## Version: 0.1 + +function [Kr, info] = fwcfconred (G, F, L, varargin) + + if (nargin < 3) + print_usage (); + endif + + if (! isa (G, "lti")) + error ("fwcfconred: first argument must be an LTI system"); + endif + + if (! is_real_matrix (F)) + error ("fwcfconred: second argument must be a real matrix"); + endif + + if (! is_real_matrix (L)) + error ("fwcfconred: third argument must be a real matrix"); + endif + + if (nargin > 3) # fwcfconred (G, F, L, ...) + if (is_real_scalar (varargin{1})) # fwcfconred (G, F, L, nr) + varargin = horzcat (varargin(2:end), {"order"}, varargin(1)); + endif + if (isstruct (varargin{1})) # fwcfconred (G, F, L, opt, ...), fwcfconred (G, F, L, nr, opt, ...) + varargin = horzcat (__opt2cell__ (varargin{1}), varargin(2:end)); + endif + ## order placed at the end such that nr from fwcfconred (G, F, L, nr, ...) + ## and fwcfconred (G, F, L, nr, opt, ...) overrides possible nr's from + ## key/value-pairs and inside opt struct (later keys override former keys, + ## nr > key/value > opt) + endif + + nkv = numel (varargin); # number of keys and values + + if (rem (nkv, 2)) + error ("fwcfconred: keys and values must come in pairs"); + endif + + [a, b, c, d, tsam] = ssdata (G); + [p, m] = size (G); + n = rows (a); + [mf, nf] = size (F); + [nl, pl] = size (L); + dt = isdt (G); + jobd = any (d(:)); + + if (mf != m || nf != n) + error ("fwcfconred: dimensions of state-feedback matrix (%dx%d) and plant (%dx%d, %d states) don't match", \ + mf, nf, p, m, n); + endif + + if (nl != n || pl != p) + error ("fwcfconred: dimensions of observer matrix (%dx%d) and plant (%dx%d, %d states) don't match", \ + nl, pl, p, m, n); + endif + + ## default arguments + tol1 = 0.0; + jobcf = 1; + jobmr = 1; # balancing-free BTA + ordsel = 1; + ncr = 0; + negfb = true; # A-BK, A-LC Hurwitz + + + ## handle keys and values + for k = 1 : 2 : nkv + key = lower (varargin{k}); + val = varargin{k+1}; + switch (key) + case {"order", "ncr", "nr"} + [ncr, ordsel] = __modred_check_order__ (val, n); + + case {"tol1", "tol"} + tol1 = __modred_check_tol__ (val, "tol1"); + + case "cf" + switch (lower (val(1))) + case "l" + jobcf = 0; + case "r" + jobcf = 1; + otherwise + error ("cfconred: '%s' is an invalid coprime factorization", val); + endswitch + + case "method" # approximation method + switch (tolower (val)) + case {"sr-bta", "b", "sr"} # 'B': use the square-root Balance & Truncate method + jobmr = 0; + case {"bfsr-bta", "f", "bfsr"} # 'F': use the balancing-free square-root Balance & Truncate method + jobmr = 1; + otherwise + error ("cfconred: '%s' is an invalid approach", val); + endswitch + + case "feedback" + negfb = __conred_check_feedback_sign__ (val); + + otherwise + warning ("fwcfconred: invalid property name '%s' ignored", key); + endswitch + endfor + + + ## A - B*F --> A + B*F ; A - L*C --> A + L*C + if (negfb) + F = -F; + L = -L; + endif + + ## perform model order reduction + [acr, bcr, ccr, ncr, hsv] = slsb16cd (a, b, c, d, dt, ncr, ordsel, jobd, jobmr, \ + F, L, jobcf, tol1); + + ## assemble reduced order controller + Kr = ss (acr, bcr, ccr, [], tsam); + + ## assemble info struct + info = struct ("ncr", ncr, "hsv", hsv); + +endfunction + + +%!shared Mo, Me, Info, HSVe +%! A = [ 0 1.0000 0 0 0 0 0 0 +%! 0 0 0 0 0 0 0 0 +%! 0 0 -0.0150 0.7650 0 0 0 0 +%! 0 0 -0.7650 -0.0150 0 0 0 0 +%! 0 0 0 0 -0.0280 1.4100 0 0 +%! 0 0 0 0 -1.4100 -0.0280 0 0 +%! 0 0 0 0 0 0 -0.0400 1.850 +%! 0 0 0 0 0 0 -1.8500 -0.040 ]; +%! +%! B = [ 0.0260 +%! -0.2510 +%! 0.0330 +%! -0.8860 +%! -4.0170 +%! 0.1450 +%! 3.6040 +%! 0.2800 ]; +%! +%! C = [ -.996 -.105 0.261 .009 -.001 -.043 0.002 -0.026 ]; +%! +%! D = [ 0.0 ]; +%! +%! G = ss (A, B, C, D); % "scaled", false +%! +%! F = [ 4.472135954999638e-002 6.610515358414598e-001 4.698598960657579e-003 3.601363251422058e-001 1.032530880771415e-001 -3.754055214487997e-002 -4.268536964759344e-002 3.287284547842979e-002 ]; +%! +%! L = [ 4.108939884667451e-001 +%! 8.684600000000012e-002 +%! 3.852317308197148e-004 +%! -3.619366874815911e-003 +%! -8.803722876359955e-003 +%! 8.420521094001852e-003 +%! 1.234944428038507e-003 +%! 4.263205617645322e-003 ]; +%! +%! [Kr, Info] = fwcfconred (G, F, L, 2, "method", "bfsr", "cf", "right", "feedback", "+"); +%! [Ao, Bo, Co, Do] = ssdata (Kr); +%! +%! Ae = [ -0.4334 0.4884 +%! -0.1950 -0.1093 ]; +%! +%! Be = [ -0.4231 +%! -0.1785 ]; +%! +%! Ce = [ -0.0326 -0.2307 ]; +%! +%! De = [ 0.0000 ]; +%! +%! HSVe = [ 3.3073 0.7274 0.1124 0.0784 0.0242 0.0182 0.0101 0.0094 ].'; +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (Mo, Me, 1e-4); +%!assert (Info.hsv, HSVe, 1e-4); diff --git a/octave_packages/control-2.3.52/gensig.m b/octave_packages/control-2.3.52/gensig.m new file mode 100644 index 0000000..5fd1009 --- /dev/null +++ b/octave_packages/control-2.3.52/gensig.m @@ -0,0 +1,99 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{u}, @var{t}] =} gensig (@var{sigtype}, @var{tau}) +## @deftypefnx{Function File} {[@var{u}, @var{t}] =} gensig (@var{sigtype}, @var{tau}, @var{tfinal}) +## @deftypefnx{Function File} {[@var{u}, @var{t}] =} gensig (@var{sigtype}, @var{tau}, @var{tfinal}, @var{tsam}) +## Generate periodic signal. Useful in combination with lsim. +## +## @strong{Inputs} +## @table @var +## @item sigtype = "sin" +## Sine wave. +## @item sigtype = "cos" +## Cosine wave. +## @item sigtype = "square" +## Square wave. +## @item sigtype = "pulse" +## Periodic pulse. +## @item tau +## Duration of one period in seconds. +## @item tfinal +## Optional duration of the signal in seconds. Default duration is 5 periods. +## @item tsam +## Optional sampling time in seconds. Default spacing is tau/64. +## @end table +## +## @strong{Outputs} +## @table @var +## @item u +## Vector of signal values. +## @item t +## Time vector of the signal. +## @end table +## +## @seealso{lsim} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: August 2009 +## Version: 0.4 + +function [u, t] = gensig (sigtype, tau, tfinal, tsam) + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + if (! ischar (sigtype)) + error ("gensig: first argument must be a string"); + endif + + if (! issample (tau)) + error ("gensig: second argument is not a valid period"); + endif + + if (nargin < 3) + tfinal = 5 * tau; + elseif (! issample (tfinal)) + error ("gensig: third argument is not a valid final time"); + endif + + if (nargin < 4) + tsam = tau / 64; + elseif (! issample (tsam)) + error ("gensig: fourth argument is not a valid sampling time"); + endif + + t = reshape (0 : tsam : tfinal, [], 1); + + switch (lower (sigtype(1:2))) + case "si" + u = sin (2*pi/tau * t); + case "co" + u = cos (2*pi/tau * t); + case "sq" + u = double (rem (t, tau) >= tau/2); + case "pu" + u = double (rem (t, tau) < (1 - 1000*eps) * tsam); + otherwise + error ("gensig: '%s' is an invalid signal type", sigtype); + endswitch + +endfunction + diff --git a/octave_packages/control-2.3.52/gram.m b/octave_packages/control-2.3.52/gram.m new file mode 100644 index 0000000..45f59bd --- /dev/null +++ b/octave_packages/control-2.3.52/gram.m @@ -0,0 +1,117 @@ +## Copyright (C) 1996, 2000, 2003, 2004, 2005, 2007 +## Auburn University. All rights reserved. +## +## +## This program is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{W} =} gram (@var{sys}, @var{mode}) +## @deftypefnx {Function File} {@var{Wc} =} gram (@var{a}, @var{b}) +## @code{gram (@var{sys}, "c")} returns the controllability gramian of +## the (continuous- or discrete-time) system @var{sys}. +## @code{gram (@var{sys}, "o")} returns the observability gramian of the +## (continuous- or discrete-time) system @var{sys}. +## @code{gram (@var{a}, @var{b})} returns the controllability gramian +## @var{Wc} of the continuous-time system @math{dx/dt = a x + b u}; +## i.e., @var{Wc} satisfies @math{a Wc + m Wc' + b b' = 0}. +## +## @end deftypefn + +## Author: A. S. Hodel + +## Adapted-By: Lukas Reichlin +## Date: October 2009 +## Version: 0.2 + +function W = gram (argin1, argin2) + + if (nargin != 2) + print_usage (); + endif + + if (ischar (argin2)) # the function was called as "gram (sys, mode)" + sys = argin1; + + if (! isa (sys, "lti")) + error ("gram: first argument must be an LTI model"); + endif + + [a, b, c] = ssdata (sys); + + if (strncmpi (argin2, "o", 1)) + a = a.'; + b = c.'; + elseif (! strncmpi (argin2, "c", 1)) + print_usage (); + endif + else # the function was called as "gram (a, b)" + a = argin1; + b = argin2; + + ## assume that a and b are matrices of continuous-time system + ## values of b, c and d are irrelevant for system stability + sys = ss (a, b, zeros (1, columns (a)), zeros (1, columns (b))); + endif + + if (! isstable (sys)) + error ("gram: system matrix a must be stable"); + endif + + if (isct (sys)) + W = lyap (a, b*b.'); # let lyap do the error checking about dimensions + else # discrete-time system + W = dlyap (a, b*b.'); # let dlyap do the error checking about dimensions + endif + +endfunction + + +%!test +%! a = [-1 0 0; 1/2 -1 0; 1/2 0 -1]; +%! b = [1 0; 0 -1; 0 1]; +%! c = [0 0 1; 1 1 0]; ## it doesn't matter what the value of c is +%! Wc = gram (ss (a, b, c), "c"); +%! assert (a * Wc + Wc * a.' + b * b.', zeros (size (a))) + +%!test +%! a = [-1 0 0; 1/2 -1 0; 1/2 0 -1]; +%! b = [1 0; 0 -1; 0 1]; ## it doesn't matter what the value of b is +%! c = [0 0 1; 1 1 0]; +%! Wo = gram (ss (a, b, c), "o"); +%! assert (a.' * Wo + Wo * a + c.' * c, zeros (size (a))) + +%!test +%! a = [-1 0 0; 1/2 -1 0; 1/2 0 -1]; +%! b = [1 0; 0 -1; 0 1]; +%! Wc = gram (a, b); +%! assert (a * Wc + Wc * a.' + b * b.', zeros (size (a))) + +%!test +%! a = [-1 0 0; 1/2 1 0; 1/2 0 -1] / 2; +%! b = [1 0; 0 -1; 0 1]; +%! c = [0 0 1; 1 1 0]; ## it doesn't matter what the value of c is +%! d = zeros (rows (c), columns (b)); ## it doesn't matter what the value of d is +%! Ts = 0.1; ## Ts != 0 +%! Wc = gram (ss (a, b, c, d, Ts), "c"); +%! assert (a * Wc * a.' - Wc + b * b.', zeros (size (a)), 1e-12) + +%!test +%! a = [-1 0 0; 1/2 1 0; 1/2 0 -1] / 2; +%! b = [1 0; 0 -1; 0 1]; ## it doesn't matter what the value of b is +%! c = [0 0 1; 1 1 0]; +%! d = zeros (rows (c), columns (b)); ## it doesn't matter what the value of d is +%! Ts = 0.1; ## Ts != 0 +%! Wo = gram (ss (a, b, c, d, Ts), "o"); +%! assert (a.' * Wo * a - Wo + c.' * c, zeros (size (a)), 1e-12) \ No newline at end of file diff --git a/octave_packages/control-2.3.52/h2syn.m b/octave_packages/control-2.3.52/h2syn.m new file mode 100644 index 0000000..9850f48 --- /dev/null +++ b/octave_packages/control-2.3.52/h2syn.m @@ -0,0 +1,265 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{K}, @var{N}, @var{gamma}, @var{rcond}] =} h2syn (@var{P}, @var{nmeas}, @var{ncon}) +## H-2 control synthesis for LTI plant. +## +## @strong{Inputs} +## @table @var +## @item P +## Generalized plant. Must be a proper/realizable LTI model. +## @item nmeas +## Number of measured outputs v. The last @var{nmeas} outputs of @var{P} are connected to the +## inputs of controller @var{K}. The remaining outputs z (indices 1 to p-nmeas) are used +## to calculate the H-2 norm. +## @item ncon +## Number of controlled inputs u. The last @var{ncon} inputs of @var{P} are connected to the +## outputs of controller @var{K}. The remaining inputs w (indices 1 to m-ncon) are excited +## by a harmonic test signal. +## @end table +## +## @strong{Outputs} +## @table @var +## @item K +## State-space model of the H-2 optimal controller. +## @item N +## State-space model of the lower LFT of @var{P} and @var{K}. +## @item gamma +## H-2 norm of @var{N}. +## @item rcond +## Vector @var{rcond} contains estimates of the reciprocal condition +## numbers of the matrices which are to be inverted and +## estimates of the reciprocal condition numbers of the +## Riccati equations which have to be solved during the +## computation of the controller @var{K}. For details, +## see the description of the corresponding SLICOT algorithm. +## @end table +## +## @strong{Block Diagram} +## @example +## @group +## +## gamma = min||N(K)|| N = lft (P, K) +## K 2 +## +## +--------+ +## w ----->| |-----> z +## | P(s) | +## u +---->| |-----+ v +## | +--------+ | +## | | +## | +--------+ | +## +-----| K(s) |<----+ +## +--------+ +## +## +--------+ +## w ----->| N(s) |-----> z +## +--------+ +## @end group +## @end example +## +## @strong{Algorithm}@* +## Uses SLICOT SB10HD and SB10ED by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## +## @seealso{augw, lqr, dlqr, kalman} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: December 2009 +## Version: 0.1 + +function [K, varargout] = h2syn (P, nmeas, ncon) + + ## check input arguments + if (nargin != 3) + print_usage (); + endif + + if (! isa (P, "lti")) + error ("h2syn: first argument must be an LTI system"); + endif + + if (! is_real_scalar (nmeas)) + error ("h2syn: second argument invalid"); + endif + + if (! is_real_scalar (ncon)) + error ("h2syn: third argument invalid"); + endif + + [a, b, c, d, tsam] = ssdata (P); + + ## check assumptions A1 - A3 + m = columns (b); + p = rows (c); + + m1 = m - ncon; + p1 = p - nmeas; + + d11 = d(1:p1, 1:m1); + + if (isct (P) && any (d11(:))) + warning ("h2syn: setting matrice D11 to zero"); + d(1:p1, 1:m1) = 0; + endif + + if (! isstabilizable (P(:, m1+1:m))) + error ("h2syn: (A, B2) must be stabilizable"); + endif + + if (! isdetectable (P(p1+1:p, :))) + error ("h2syn: (C2, A) must be detectable"); + endif + + ## H-2 synthesis + if (isct (P)) # continuous plant + [ak, bk, ck, dk, rcond] = slsb10hd (a, b, c, d, ncon, nmeas); + else # discrete plant + [ak, bk, ck, dk, rcond] = slsb10ed (a, b, c, d, ncon, nmeas); + endif + + ## controller + K = ss (ak, bk, ck, dk, tsam); + + if (nargout > 1) + N = lft (P, K); + varargout{1} = N; + if (nargout > 2) + varargout{2} = norm (N, 2); + if (nargout > 3) + varargout{3} = rcond; + endif + endif + endif + +endfunction + + +## continuous-time case +%!shared M, M_exp +%! A = [-1.0 0.0 4.0 5.0 -3.0 -2.0 +%! -2.0 4.0 -7.0 -2.0 0.0 3.0 +%! -6.0 9.0 -5.0 0.0 2.0 -1.0 +%! -8.0 4.0 7.0 -1.0 -3.0 0.0 +%! 2.0 5.0 8.0 -9.0 1.0 -4.0 +%! 3.0 -5.0 8.0 0.0 2.0 -6.0]; +%! +%! B = [-3.0 -4.0 -2.0 1.0 0.0 +%! 2.0 0.0 1.0 -5.0 2.0 +%! -5.0 -7.0 0.0 7.0 -2.0 +%! 4.0 -6.0 1.0 1.0 -2.0 +%! -3.0 9.0 -8.0 0.0 5.0 +%! 1.0 -2.0 3.0 -6.0 -2.0]; +%! +%! C = [ 1.0 -1.0 2.0 -4.0 0.0 -3.0 +%! -3.0 0.0 5.0 -1.0 1.0 1.0 +%! -7.0 5.0 0.0 -8.0 2.0 -2.0 +%! 9.0 -3.0 4.0 0.0 3.0 7.0 +%! 0.0 1.0 -2.0 1.0 -6.0 -2.0]; +%! +%! D = [ 0.0 0.0 0.0 -4.0 -1.0 +%! 0.0 0.0 0.0 1.0 0.0 +%! 0.0 0.0 0.0 0.0 1.0 +%! 3.0 1.0 0.0 1.0 -3.0 +%! -2.0 0.0 1.0 7.0 1.0]; +%! +%! P = ss (A, B, C, D); +%! K = h2syn (P, 2, 2); +%! M = [K.A, K.B; K.C, K.D]; +%! +%! KA = [ 88.0015 -145.7298 -46.2424 82.2168 -45.2996 -31.1407 +%! 25.7489 -31.4642 -12.4198 9.4625 -3.5182 2.7056 +%! 54.3008 -102.4013 -41.4968 50.8412 -20.1286 -26.7191 +%! 108.1006 -198.0785 -45.4333 70.3962 -25.8591 -37.2741 +%! -115.8900 226.1843 47.2549 -47.8435 -12.5004 34.7474 +%! 59.0362 -101.8471 -20.1052 36.7834 -16.1063 -26.4309]; +%! +%! KB = [ 3.7345 3.4758 +%! -0.3020 0.6530 +%! 3.4735 4.0499 +%! 4.3198 7.2755 +%! -3.9424 -10.5942 +%! 2.1784 2.5048]; +%! +%! KC = [ -2.3346 3.2556 0.7150 -0.9724 0.6962 0.4074 +%! 7.6899 -8.4558 -2.9642 7.0365 -4.2844 0.1390]; +%! +%! KD = [ 0.0000 0.0000 +%! 0.0000 0.0000]; +%! +%! M_exp = [KA, KB; KC, KD]; +%! +%!assert (M, M_exp, 1e-4); + + +## discrete-time case +%!shared M, M_exp +%! A = [-0.7 0.0 0.3 0.0 -0.5 -0.1 +%! -0.6 0.2 -0.4 -0.3 0.0 0.0 +%! -0.5 0.7 -0.1 0.0 0.0 -0.8 +%! -0.7 0.0 0.0 -0.5 -1.0 0.0 +%! 0.0 0.3 0.6 -0.9 0.1 -0.4 +%! 0.5 -0.8 0.0 0.0 0.2 -0.9]; +%! +%! B = [-1.0 -2.0 -2.0 1.0 0.0 +%! 1.0 0.0 1.0 -2.0 1.0 +%! -3.0 -4.0 0.0 2.0 -2.0 +%! 1.0 -2.0 1.0 0.0 -1.0 +%! 0.0 1.0 -2.0 0.0 3.0 +%! 1.0 0.0 3.0 -1.0 -2.0]; +%! +%! C = [ 1.0 -1.0 2.0 -2.0 0.0 -3.0 +%! -3.0 0.0 1.0 -1.0 1.0 0.0 +%! 0.0 2.0 0.0 -4.0 0.0 -2.0 +%! 1.0 -3.0 0.0 0.0 3.0 1.0 +%! 0.0 1.0 -2.0 1.0 0.0 -2.0]; +%! +%! D = [ 1.0 -1.0 -2.0 0.0 0.0 +%! 0.0 1.0 0.0 1.0 0.0 +%! 2.0 -1.0 -3.0 0.0 1.0 +%! 0.0 1.0 0.0 1.0 -1.0 +%! 0.0 0.0 1.0 2.0 1.0]; +%! +%! P = ss (A, B, C, D, 1); # value of sampling time doesn't matter +%! K = h2syn (P, 2, 2); +%! M = [K.A, K.B; K.C, K.D]; +%! +%! KA = [-0.0551 -2.1891 -0.6607 -0.2532 0.6674 -1.0044 +%! -1.0379 2.3804 0.5031 0.3960 -0.6605 1.2673 +%! -0.0876 -2.1320 -0.4701 -1.1461 1.2927 -1.5116 +%! -0.1358 -2.1237 -0.9560 -0.7144 0.6673 -0.7957 +%! 0.4900 0.0895 0.2634 -0.2354 0.1623 -0.2663 +%! 0.1672 -0.4163 0.2871 -0.1983 0.4944 -0.6967]; +%! +%! KB = [-0.5985 -0.5464 +%! 0.5285 0.6087 +%! -0.7600 -0.4472 +%! -0.7288 -0.6090 +%! 0.0532 0.0658 +%! -0.0663 0.0059]; +%! +%! KC = [ 0.2500 -1.0200 -0.3371 -0.2733 0.2747 -0.4444 +%! 0.0654 0.2095 0.0632 0.2089 -0.1895 0.1834]; +%! +%! KD = [-0.2181 -0.2070 +%! 0.1094 0.1159]; +%! +%! M_exp = [KA, KB; KC, KD]; +%! +%!assert (M, M_exp, 1e-4); \ No newline at end of file diff --git a/octave_packages/control-2.3.52/hinfsyn.m b/octave_packages/control-2.3.52/hinfsyn.m new file mode 100644 index 0000000..aefcf8e --- /dev/null +++ b/octave_packages/control-2.3.52/hinfsyn.m @@ -0,0 +1,268 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{K}, @var{N}, @var{gamma}, @var{rcond}] =} hinfsyn (@var{P}, @var{nmeas}, @var{ncon}) +## @deftypefnx{Function File} {[@var{K}, @var{N}, @var{gamma}, @var{rcond}] =} hinfsyn (@var{P}, @var{nmeas}, @var{ncon}, @var{gmax}) +## H-infinity control synthesis for LTI plant. +## +## @strong{Inputs} +## @table @var +## @item P +## Generalized plant. Must be a proper/realizable LTI model. +## @item nmeas +## Number of measured outputs v. The last @var{nmeas} outputs of @var{P} are connected to the +## inputs of controller @var{K}. The remaining outputs z (indices 1 to p-nmeas) are used +## to calculate the H-infinity norm. +## @item ncon +## Number of controlled inputs u. The last @var{ncon} inputs of @var{P} are connected to the +## outputs of controller @var{K}. The remaining inputs w (indices 1 to m-ncon) are excited +## by a harmonic test signal. +## @item gmax +## The maximum value of the H-infinity norm of @var{N}. It is assumed that @var{gmax} is +## sufficiently large so that the controller is admissible. +## @end table +## +## @strong{Outputs} +## @table @var +## @item K +## State-space model of the H-infinity (sub-)optimal controller. +## @item N +## State-space model of the lower LFT of @var{P} and @var{K}. +## @item gamma +## L-infinity norm of @var{N}. +## @item rcond +## Vector @var{rcond} contains estimates of the reciprocal condition +## numbers of the matrices which are to be inverted and +## estimates of the reciprocal condition numbers of the +## Riccati equations which have to be solved during the +## computation of the controller @var{K}. For details, +## see the description of the corresponding SLICOT algorithm. +## @end table +## +## @strong{Block Diagram} +## @example +## @group +## +## gamma = min||N(K)|| N = lft (P, K) +## K inf +## +## +--------+ +## w ----->| |-----> z +## | P(s) | +## u +---->| |-----+ v +## | +--------+ | +## | | +## | +--------+ | +## +-----| K(s) |<----+ +## +--------+ +## +## +--------+ +## w ----->| N(s) |-----> z +## +--------+ +## @end group +## @end example +## +## @strong{Algorithm}@* +## Uses SLICOT SB10FD and SB10DD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## +## @seealso{augw, mixsyn} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: December 2009 +## Version: 0.1 + +## TODO: improve compatibility for nargin >= 4 + +function [K, varargout] = hinfsyn (P, nmeas, ncon, gmax = 1e15) + + ## check input arguments + if (nargin < 3 || nargin > 4) + print_usage (); + endif + + if (! isa (P, "lti")) + error ("hinfsyn: first argument must be an LTI system"); + endif + + if (! is_real_scalar (nmeas)) + error ("hinfsyn: second argument invalid"); + endif + + if (! is_real_scalar (ncon)) + error ("hinfsyn: third argument invalid"); + endif + + if (! is_real_scalar (gmax) || gmax < 0) + error ("hinfsyn: fourth argument invalid"); + endif + + [a, b, c, d, tsam] = ssdata (P); + + ## check assumption A1 + m = columns (b); + p = rows (c); + + m1 = m - ncon; + p1 = p - nmeas; + + if (! isstabilizable (P(:, m1+1:m))) + error ("hinfsyn: (A, B2) must be stabilizable"); + endif + + if (! isdetectable (P(p1+1:p, :))) + error ("hinfsyn: (C2, A) must be detectable"); + endif + + ## H-infinity synthesis + if (isct (P)) # continuous plant + [ak, bk, ck, dk, rcond] = slsb10fd (a, b, c, d, ncon, nmeas, gmax); + else # discrete plant + [ak, bk, ck, dk, rcond] = slsb10dd (a, b, c, d, ncon, nmeas, gmax); + endif + + ## controller + K = ss (ak, bk, ck, dk, tsam); + + if (nargout > 1) + N = lft (P, K); + varargout{1} = N; + if (nargout > 2) + varargout{2} = norm (N, inf); + if (nargout > 3) + varargout{3} = rcond; + endif + endif + endif + +endfunction + + +## continuous-time case +%!shared M, M_exp +%! A = [-1.0 0.0 4.0 5.0 -3.0 -2.0 +%! -2.0 4.0 -7.0 -2.0 0.0 3.0 +%! -6.0 9.0 -5.0 0.0 2.0 -1.0 +%! -8.0 4.0 7.0 -1.0 -3.0 0.0 +%! 2.0 5.0 8.0 -9.0 1.0 -4.0 +%! 3.0 -5.0 8.0 0.0 2.0 -6.0]; +%! +%! B = [-3.0 -4.0 -2.0 1.0 0.0 +%! 2.0 0.0 1.0 -5.0 2.0 +%! -5.0 -7.0 0.0 7.0 -2.0 +%! 4.0 -6.0 1.0 1.0 -2.0 +%! -3.0 9.0 -8.0 0.0 5.0 +%! 1.0 -2.0 3.0 -6.0 -2.0]; +%! +%! C = [ 1.0 -1.0 2.0 -4.0 0.0 -3.0 +%! -3.0 0.0 5.0 -1.0 1.0 1.0 +%! -7.0 5.0 0.0 -8.0 2.0 -2.0 +%! 9.0 -3.0 4.0 0.0 3.0 7.0 +%! 0.0 1.0 -2.0 1.0 -6.0 -2.0]; +%! +%! D = [ 1.0 -2.0 -3.0 0.0 0.0 +%! 0.0 4.0 0.0 1.0 0.0 +%! 5.0 -3.0 -4.0 0.0 1.0 +%! 0.0 1.0 0.0 1.0 -3.0 +%! 0.0 0.0 1.0 7.0 1.0]; +%! +%! P = ss (A, B, C, D); +%! K = hinfsyn (P, 2, 2, 15); +%! M = [K.A, K.B; K.C, K.D]; +%! +%! KA = [ -2.8043 14.7367 4.6658 8.1596 0.0848 2.5290 +%! 4.6609 3.2756 -3.5754 -2.8941 0.2393 8.2920 +%! -15.3127 23.5592 -7.1229 2.7599 5.9775 -2.0285 +%! -22.0691 16.4758 12.5523 -16.3602 4.4300 -3.3168 +%! 30.6789 -3.9026 -1.3868 26.2357 -8.8267 10.4860 +%! -5.7429 0.0577 10.8216 -11.2275 1.5074 -10.7244]; +%! +%! KB = [ -0.1581 -0.0793 +%! -0.9237 -0.5718 +%! 0.7984 0.6627 +%! 0.1145 0.1496 +%! -0.6743 -0.2376 +%! 0.0196 -0.7598]; +%! +%! KC = [ -0.2480 -0.1713 -0.0880 0.1534 0.5016 -0.0730 +%! 2.8810 -0.3658 1.3007 0.3945 1.2244 2.5690]; +%! +%! KD = [ 0.0554 0.1334 +%! -0.3195 0.0333]; +%! +%! M_exp = [KA, KB; KC, KD]; +%! +%!assert (M, M_exp, 1e-4); + + +## discrete-time case +%!shared M, M_exp +%! A = [-0.7 0.0 0.3 0.0 -0.5 -0.1 +%! -0.6 0.2 -0.4 -0.3 0.0 0.0 +%! -0.5 0.7 -0.1 0.0 0.0 -0.8 +%! -0.7 0.0 0.0 -0.5 -1.0 0.0 +%! 0.0 0.3 0.6 -0.9 0.1 -0.4 +%! 0.5 -0.8 0.0 0.0 0.2 -0.9]; +%! +%! B = [-1.0 -2.0 -2.0 1.0 0.0 +%! 1.0 0.0 1.0 -2.0 1.0 +%! -3.0 -4.0 0.0 2.0 -2.0 +%! 1.0 -2.0 1.0 0.0 -1.0 +%! 0.0 1.0 -2.0 0.0 3.0 +%! 1.0 0.0 3.0 -1.0 -2.0]; +%! +%! C = [ 1.0 -1.0 2.0 -2.0 0.0 -3.0 +%! -3.0 0.0 1.0 -1.0 1.0 0.0 +%! 0.0 2.0 0.0 -4.0 0.0 -2.0 +%! 1.0 -3.0 0.0 0.0 3.0 1.0 +%! 0.0 1.0 -2.0 1.0 0.0 -2.0]; +%! +%! D = [ 1.0 -1.0 -2.0 0.0 0.0 +%! 0.0 1.0 0.0 1.0 0.0 +%! 2.0 -1.0 -3.0 0.0 1.0 +%! 0.0 1.0 0.0 1.0 -1.0 +%! 0.0 0.0 1.0 2.0 1.0]; +%! +%! P = ss (A, B, C, D, 1); # value of sampling time doesn't matter +%! K = hinfsyn (P, 2, 2, 111.294); +%! M = [K.A, K.B; K.C, K.D]; +%! +%! KA = [-18.0030 52.0376 26.0831 -0.4271 -40.9022 18.0857 +%! 18.8203 -57.6244 -29.0938 0.5870 45.3309 -19.8644 +%! -26.5994 77.9693 39.0368 -1.4020 -60.1129 26.6910 +%! -21.4163 62.1719 30.7507 -0.9201 -48.6221 21.8351 +%! -0.8911 4.2787 2.3286 -0.2424 -3.0376 1.2169 +%! -5.3286 16.1955 8.4824 -0.2489 -12.2348 5.1590]; +%! +%! KB = [ 16.9788 14.1648 +%! -18.9215 -15.6726 +%! 25.2046 21.2848 +%! 20.1122 16.8322 +%! 1.4104 1.2040 +%! 5.3181 4.5149]; +%! +%! KC = [ -9.1941 27.5165 13.7364 -0.3639 -21.5983 9.6025 +%! 3.6490 -10.6194 -5.2772 0.2432 8.1108 -3.6293]; +%! +%! KD = [ 9.0317 7.5348 +%! -3.4006 -2.8219]; +%! +%! M_exp = [KA, KB; KC, KD]; +%! +%!assert (M, M_exp, 1e-4); \ No newline at end of file diff --git a/octave_packages/control-2.3.52/hnamodred.m b/octave_packages/control-2.3.52/hnamodred.m new file mode 100644 index 0000000..a3e4107 --- /dev/null +++ b/octave_packages/control-2.3.52/hnamodred.m @@ -0,0 +1,469 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{Gr}, @var{info}] =} hnamodred (@var{G}, @dots{}) +## @deftypefnx{Function File} {[@var{Gr}, @var{info}] =} hnamodred (@var{G}, @var{nr}, @dots{}) +## @deftypefnx{Function File} {[@var{Gr}, @var{info}] =} hnamodred (@var{G}, @var{opt}, @dots{}) +## @deftypefnx{Function File} {[@var{Gr}, @var{info}] =} hnamodred (@var{G}, @var{nr}, @var{opt}, @dots{}) +## +## Model order reduction by frequency weighted optimal Hankel-norm (HNA) method. +## The aim of model reduction is to find an LTI system @var{Gr} of order +## @var{nr} (nr < n) such that the input-output behaviour of @var{Gr} +## approximates the one from original system @var{G}. +## +## HNA is an absolute error method which tries to minimize +## @iftex +## @tex +## $$ || G - G_r ||_H = min $$ +## $$ || V \\ (G - G_r) \\ W ||_H = min $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## ||G-Gr|| = min +## H +## +## ||V (G-Gr) W|| = min +## H +## @end example +## @end ifnottex +## where @var{V} and @var{W} denote output and input weightings. +## +## +## @strong{Inputs} +## @table @var +## @item G +## LTI model to be reduced. +## @item nr +## The desired order of the resulting reduced order system @var{Gr}. +## If not specified, @var{nr} is chosen automatically according +## to the description of key @var{"order"}. +## @item @dots{} +## Optional pairs of keys and values. @code{"key1", value1, "key2", value2}. +## @item opt +## Optional struct with keys as field names. +## Struct @var{opt} can be created directly or +## by command @command{options}. @code{opt.key1 = value1, opt.key2 = value2}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item Gr +## Reduced order state-space model. +## @item info +## Struct containing additional information. +## @table @var +## @item info.n +## The order of the original system @var{G}. +## @item info.ns +## The order of the @var{alpha}-stable subsystem of the original system @var{G}. +## @item info.hsv +## The Hankel singular values corresponding to the projection @code{op(V)*G1*op(W)}, +## where G1 denotes the @var{alpha}-stable part of the original system @var{G}. +## The @var{ns} Hankel singular values are ordered decreasingly. +## @item info.nu +## The order of the @var{alpha}-unstable subsystem of both the original +## system @var{G} and the reduced-order system @var{Gr}. +## @item info.nr +## The order of the obtained reduced order system @var{Gr}. +## @end table +## @end table +## +## +## @strong{Option Keys and Values} +## @table @var +## @item 'order', 'nr' +## The desired order of the resulting reduced order system @var{Gr}. +## If not specified, @var{nr} is the sum of @var{info.nu} and the number of +## Hankel singular values greater than @code{max(tol1, ns*eps*info.hsv(1)}; +## +## @item 'method' +## Specifies the computational approach to be used. +## Valid values corresponding to this key are: +## @table @var +## @item 'descriptor' +## Use the inverse free descriptor system approach. +## @item 'standard' +## Use the inversion based standard approach. +## @item 'auto' +## Switch automatically to the inverse free +## descriptor approach in case of badly conditioned +## feedthrough matrices in V or W. Default method. +## @end table +## +## +## @item 'left', 'v' +## LTI model of the left/output frequency weighting. +## The weighting must be antistable. +## @iftex +## @math{|| V \\ (G-G_r) \\dots ||_H = min} +## @end iftex +## @ifnottex +## @example +## || V (G-Gr) . || = min +## H +## @end example +## @end ifnottex +## +## @item 'right', 'w' +## LTI model of the right/input frequency weighting. +## The weighting must be antistable. +## @iftex +## @math{|| \\dots (G-G_r) \\ W ||_H = min} +## @end iftex +## @ifnottex +## @example +## || . (G-Gr) W || = min +## H +## @end example +## @end ifnottex +## +## +## @item 'left-inv', 'inv-v' +## LTI model of the left/output frequency weighting. +## The weighting must have only antistable zeros. +## @iftex +## @math{|| inv(V) \\ (G-G_r) \\dots ||_H = min} +## @end iftex +## @ifnottex +## @example +## || inv(V) (G-Gr) . || = min +## H +## @end example +## @end ifnottex +## +## @item 'right-inv', 'inv-w' +## LTI model of the right/input frequency weighting. +## The weighting must have only antistable zeros. +## @iftex +## @math{|| \\dots (G-G_r) \\ inv(W) ||_H = min} +## @end iftex +## @ifnottex +## @example +## || . (G-Gr) inv(W) || = min +## H +## @end example +## @end ifnottex +## +## +## @item 'left-conj', 'conj-v' +## LTI model of the left/output frequency weighting. +## The weighting must be stable. +## @iftex +## @math{|| conj(V) \\ (G-G_r) \\dots ||_H = min} +## @end iftex +## @ifnottex +## @example +## || V (G-Gr) . || = min +## H +## @end example +## @end ifnottex +## +## @item 'right-conj', 'conj-w' +## LTI model of the right/input frequency weighting. +## The weighting must be stable. +## @iftex +## @math{|| \\dots (G-G_r) \\ conj(W) ||_H = min} +## @end iftex +## @ifnottex +## @example +## || . (G-Gr) W || = min +## H +## @end example +## @end ifnottex +## +## +## @item 'left-conj-inv', 'conj-inv-v' +## LTI model of the left/output frequency weighting. +## The weighting must be minimum-phase. +## @iftex +## @math{|| conj(inv(V)) \\ (G-G_r) \\dots ||_H = min} +## @end iftex +## @ifnottex +## @example +## || V (G-Gr) . || = min +## H +## @end example +## @end ifnottex +## +## @item 'right-conj-inv', 'conj-inv-w' +## LTI model of the right/input frequency weighting. +## The weighting must be minimum-phase. +## @iftex +## @math{|| \\dots (G-G_r) \\ conj(inv(W)) ||_H = min} +## @end iftex +## @ifnottex +## @example +## || . (G-Gr) W || = min +## H +## @end example +## @end ifnottex +## +## +## @item 'alpha' +## Specifies the ALPHA-stability boundary for the eigenvalues +## of the state dynamics matrix @var{G.A}. For a continuous-time +## system, ALPHA <= 0 is the boundary value for +## the real parts of eigenvalues, while for a discrete-time +## system, 0 <= ALPHA <= 1 represents the +## boundary value for the moduli of eigenvalues. +## The ALPHA-stability domain does not include the boundary. +## Default value is 0 for continuous-time systems and +## 1 for discrete-time systems. +## +## @item 'tol1' +## If @var{'order'} is not specified, @var{tol1} contains the tolerance for +## determining the order of the reduced model. +## For model reduction, the recommended value of @var{tol1} is +## c*info.hsv(1), where c lies in the interval [0.00001, 0.001]. +## @var{tol1} < 1. +## If @var{'order'} is specified, the value of @var{tol1} is ignored. +## +## @item 'tol2' +## The tolerance for determining the order of a minimal +## realization of the ALPHA-stable part of the given +## model. @var{tol2} <= @var{tol1} < 1. +## If not specified, ns*eps*info.hsv(1) is chosen. +## +## @item 'equil', 'scale' +## Boolean indicating whether equilibration (scaling) should be +## performed on system @var{G} prior to order reduction. +## Default value is true if @code{G.scaled == false} and +## false if @code{G.scaled == true}. +## Note that for @acronym{MIMO} models, proper scaling of both inputs and outputs +## is of utmost importance. The input and output scaling can @strong{not} +## be done by the equilibration option or the @command{prescale} command +## because these functions perform state transformations only. +## Furthermore, signals should not be scaled simply to a certain range. +## For all inputs (or outputs), a certain change should be of the same +## importance for the model. +## @end table +## +## +## Approximation Properties: +## @itemize @bullet +## @item +## Guaranteed stability of reduced models +## @item +## Lower guaranteed error bound +## @item +## Guaranteed a priori error bound +## @iftex +## @tex +## $$ \\sigma_{r+1} \\leq || (G-G_r) ||_{\\infty} \\leq 2 \\sum_{j=r+1}^{n} \\sigma_j $$ +## @end tex +## @end iftex +## @end itemize +## +## @strong{Algorithm}@* +## Uses SLICOT AB09JD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2011 +## Version: 0.1 + +function [Gr, info] = hnamodred (G, varargin) + + if (nargin == 0) + print_usage (); + endif + + if (! isa (G, "lti")) + error ("hnamodred: first argument must be an LTI system"); + endif + + if (nargin > 1) # hnamodred (G, ...) + if (is_real_scalar (varargin{1})) # hnamodred (G, nr) + varargin = horzcat (varargin(2:end), {"order"}, varargin(1)); + endif + if (isstruct (varargin{1})) # hnamodred (G, opt, ...), hnamodred (G, nr, opt, ...) + varargin = horzcat (__opt2cell__ (varargin{1}), varargin(2:end)); + endif + ## order placed at the end such that nr from hnamodred (G, nr, ...) + ## and hnamodred (G, nr, opt, ...) overrides possible nr's from + ## key/value-pairs and inside opt struct (later keys override former keys, + ## nr > key/value > opt) + endif + + nkv = numel (varargin); # number of keys and values + + if (rem (nkv, 2)) + error ("hnamodred: keys and values must come in pairs"); + endif + + [a, b, c, d, tsam, scaled] = ssdata (G); + [p, m] = size (G); + dt = isdt (G); + + ## default arguments + alpha = __modred_default_alpha__ (dt); + av = bv = cv = dv = []; + jobv = 0; + aw = bw = cw = dw = []; + jobw = 0; + jobinv = 2; + tol1 = 0; + tol2 = 0; + ordsel = 1; + nr = 0; + + ## handle keys and values + for k = 1 : 2 : nkv + key = lower (varargin{k}); + val = varargin{k+1}; + switch (key) + case {"left", "v", "wo"} + [av, bv, cv, dv, jobv] = __modred_check_weight__ (val, dt, p, p); + ## TODO: correct error messages for non-square weights + + case {"right", "w", "wi"} + [aw, bw, cw, dw, jobw] = __modred_check_weight__ (val, dt, m, m); + + case {"left-inv", "inv-v"} + [av, bv, cv, dv] = __modred_check_weight__ (val, dt, p, p); + jobv = 2; + + case {"right-inv", "inv-w"} + [aw, bw, cw, dw] = __modred_check_weight__ (val, dt, m, m); + jobv = 2 + + case {"left-conj", "conj-v"} + [av, bv, cv, dv] = __modred_check_weight__ (val, dt, p, p); + jobv = 3; + + case {"right-conj", "conj-w"} + [aw, bw, cw, dw] = __modred_check_weight__ (val, dt, m, m); + jobv = 3 + + case {"left-conj-inv", "conj-inv-v"} + [av, bv, cv, dv] = __modred_check_weight__ (val, dt, p, p); + jobv = 4; + + case {"right-conj-inv", "conj-inv-w"} + [aw, bw, cw, dw] = __modred_check_weight__ (val, dt, m, m); + jobv = 4 + + case {"order", "nr"} + [nr, ordsel] = __modred_check_order__ (val, rows (a)); + + case "tol1" + tol1 = __modred_check_tol__ (val, "tol1"); + + case "tol2" + tol2 = __modred_check_tol__ (val, "tol2"); + + case "alpha" + alpha = __modred_check_alpha__ (val, dt); + + case "method" + switch (tolower (val(1))) + case {"d", "n"} # "descriptor" + jobinv = 0; + case {"s", "i"} # "standard" + jobinv = 1; + case "a" # {"auto", "automatic"} + jobinv = 2; + otherwise + error ("hnamodred: invalid computational approach"); + endswitch + + case {"equil", "equilibrate", "equilibration", "scale", "scaling"} + scaled = __modred_check_equil__ (val); + + otherwise + warning ("hnamodred: invalid property name '%s' ignored", key); + endswitch + endfor + + + ## perform model order reduction + [ar, br, cr, dr, nr, hsv, ns] = slab09jd (a, b, c, d, dt, scaled, nr, ordsel, alpha, \ + jobv, av, bv, cv, dv, \ + jobw, aw, bw, cw, dw, \ + jobinv, tol1, tol2); + + ## assemble reduced order model + Gr = ss (ar, br, cr, dr, tsam); + + ## assemble info struct + n = rows (a); + nu = n - ns; + info = struct ("n", n, "ns", ns, "hsv", hsv, "nu", nu, "nr", nr); + +endfunction + + +%!shared Mo, Me, Info, HSVe +%! A = [ -3.8637 -7.4641 -9.1416 -7.4641 -3.8637 -1.0000 +%! 1.0000, 0 0 0 0 0 +%! 0 1.0000 0 0 0 0 +%! 0 0 1.0000 0 0 0 +%! 0 0 0 1.0000 0 0 +%! 0 0 0 0 1.0000 0 ]; +%! +%! B = [ 1 +%! 0 +%! 0 +%! 0 +%! 0 +%! 0 ]; +%! +%! C = [ 0 0 0 0 0 1 ]; +%! +%! D = [ 0 ]; +%! +%! G = ss (A, B, C, D); # "scaled", false +%! +%! AV = [ 0.2000 -1.0000 +%! 1.0000 0 ]; +%! +%! BV = [ 1 +%! 0 ]; +%! +%! CV = [ -1.8000 0 ]; +%! +%! DV = [ 1 ]; +%! +%! V = ss (AV, BV, CV, DV); +%! +%! [Gr, Info] = hnamodred (G, "left", V, "tol1", 1e-1, "tol2", 1e-14); +%! [Ao, Bo, Co, Do] = ssdata (Gr); +%! +%! Ae = [ -0.2391 0.3072 1.1630 1.1967 +%! -2.9709 -0.2391 2.6270 3.1027 +%! 0.0000 0.0000 -0.5137 -1.2842 +%! 0.0000 0.0000 0.1519 -0.5137 ]; +%! +%! Be = [ -1.0497 +%! -3.7052 +%! 0.8223 +%! 0.7435 ]; +%! +%! Ce = [ -0.4466 0.0143 -0.4780 -0.2013 ]; +%! +%! De = [ 0.0219 ]; +%! +%! HSVe = [ 2.6790 2.1589 0.8424 0.1929 0.0219 0.0011 ].'; +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (Mo, Me, 1e-4); +%!assert (Info.hsv, HSVe, 1e-4); diff --git a/octave_packages/control-2.3.52/hsvd.m b/octave_packages/control-2.3.52/hsvd.m new file mode 100644 index 0000000..2b9748c --- /dev/null +++ b/octave_packages/control-2.3.52/hsvd.m @@ -0,0 +1,106 @@ +## Copyright (C) 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{hsv} =} hsvd (@var{sys}) +## @deftypefnx{Function File} {@var{hsv} =} hsvd (@var{sys}, @var{"offset"}, @var{offset}) +## @deftypefnx{Function File} {@var{hsv} =} hsvd (@var{sys}, @var{"alpha"}, @var{alpha}) +## Hankel singular values of the stable part of an LTI model. If no output arguments are +## given, the Hankel singular values are displayed in a plot. +## +## @strong{Algorithm}@* +## Uses SLICOT AB13AD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: January 2010 +## Version: 0.4 + +function hsv_r = hsvd (sys, prop = "offset", val = 1e-8) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (! isa (sys, "lti")) + error ("hsvd: first argument must be an LTI system"); + endif + + if (! is_real_scalar (val)) + error ("hsvd: third argument must be a real scalar"); + endif + + [a, b, c, ~, ~, scaled] = ssdata (sys); + + discrete = ! isct (sys); + + switch (tolower (prop(1))) + case "o" # offset + if (discrete) + alpha = 1 - val; + else + alpha = - val; + endif + case "a" # alpha + alpha = val; + otherwise + error ("hsvd: second argument invalid"); + endswitch + + [hsv, ns] = slab13ad (a, b, c, discrete, alpha, scaled); + + if (nargout) + hsv_r = hsv; + else + bar ((1:ns) + (rows (a) - ns), hsv); + title (["Hankel Singular Values of Stable Part of ", inputname(1)]); + xlabel ("State"); + ylabel ("State Energy"); + grid ("on"); + endif + +endfunction + + +%!shared hsv, hsv_exp +%! a = [ -0.04165 0.0000 4.9200 -4.9200 0.0000 0.0000 0.0000 +%! -5.2100 -12.500 0.0000 0.0000 0.0000 0.0000 0.0000 +%! 0.0000 3.3300 -3.3300 0.0000 0.0000 0.0000 0.0000 +%! 0.5450 0.0000 0.0000 0.0000 -0.5450 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 4.9200 -0.04165 0.0000 4.9200 +%! 0.0000 0.0000 0.0000 0.0000 -5.2100 -12.500 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 3.3300 -3.3300]; +%! +%! b = [ 0.0000 0.0000 +%! 12.5000 0.0000 +%! 0.0000 0.0000 +%! 0.0000 0.0000 +%! 0.0000 0.0000 +%! 0.0000 12.500 +%! 0.0000 0.0000]; +%! +%! c = [ 1.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 1.0000 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 1.0000 0.0000 0.0000]; +%! +%! sys = ss (a, b, c, [], "scaled", true); +%! hsv = hsvd (sys, "alpha", 0.0); +%! +%! hsv_exp = [2.5139; 2.0846; 1.9178; 0.7666; 0.5473; 0.0253; 0.0246]; +%! +%!assert (hsv, hsv_exp, 1e-4); diff --git a/octave_packages/control-2.3.52/impulse.m b/octave_packages/control-2.3.52/impulse.m new file mode 100644 index 0000000..0e79080 --- /dev/null +++ b/octave_packages/control-2.3.52/impulse.m @@ -0,0 +1,75 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{y}, @var{t}, @var{x}] =} impulse (@var{sys}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} impulse (@var{sys}, @var{t}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} impulse (@var{sys}, @var{tfinal}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} impulse (@var{sys}, @var{tfinal}, @var{dt}) +## Impulse response of LTI system. +## If no output arguments are given, the response is printed on the screen. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. +## @item t +## Time vector. Should be evenly spaced. If not specified, it is calculated by +## the poles of the system to reflect adequately the response transients. +## @item tfinal +## Optional simulation horizon. If not specified, it is calculated by +## the poles of the system to reflect adequately the response transients. +## @item dt +## Optional sampling time. Be sure to choose it small enough to capture transient +## phenomena. If not specified, it is calculated by the poles of the system. +## @end table +## +## @strong{Outputs} +## @table @var +## @item y +## Output response array. Has as many rows as time samples (length of t) +## and as many columns as outputs. +## @item t +## Time row vector. +## @item x +## State trajectories array. Has @code{length (t)} rows and as many columns as states. +## @end table +## +## @seealso{initial, lsim, step} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function [y_r, t_r, x_r] = impulse (sys, tfinal = [], dt = []) + + ## TODO: multiplot feature: impulse (sys1, "b", sys2, "r", ...) + + if (nargin == 0 || nargin > 3) + print_usage (); + endif + + [y, t, x] = __time_response__ (sys, "impulse", ! nargout, tfinal, dt, [], inputname (1)); + + if (nargout) + y_r = y; + t_r = t; + x_r = x; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/initial.m b/octave_packages/control-2.3.52/initial.m new file mode 100644 index 0000000..b744813 --- /dev/null +++ b/octave_packages/control-2.3.52/initial.m @@ -0,0 +1,151 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{y}, @var{t}, @var{x}] =} initial (@var{sys}, @var{x0}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} initial (@var{sys}, @var{x0}, @var{t}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} initial (@var{sys}, @var{x0}, @var{tfinal}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} initial (@var{sys}, @var{x0}, @var{tfinal}, @var{dt}) +## Initial condition response of state-space model. +## If no output arguments are given, the response is printed on the screen. +## +## @strong{Inputs} +## @table @var +## @item sys +## State-space model. +## @item x0 +## Vector of initial conditions for each state. +## @item t +## Optional time vector. Should be evenly spaced. If not specified, it is calculated +## by the poles of the system to reflect adequately the response transients. +## @item tfinal +## Optional simulation horizon. If not specified, it is calculated by +## the poles of the system to reflect adequately the response transients. +## @item dt +## Optional sampling time. Be sure to choose it small enough to capture transient +## phenomena. If not specified, it is calculated by the poles of the system. +## @end table +## +## @strong{Outputs} +## @table @var +## @item y +## Output response array. Has as many rows as time samples (length of t) +## and as many columns as outputs. +## @item t +## Time row vector. +## @item x +## State trajectories array. Has @code{length (t)} rows and as many columns as states. +## @end table +## +## @strong{Example} +## @example +## @group +## . +## Continuous Time: x = A x , y = C x , x(0) = x0 +## +## Discrete Time: x[k+1] = A x[k] , y[k] = C x[k] , x[0] = x0 +## @end group +## @end example +## +## @seealso{impulse, lsim, step} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function [y_r, t_r, x_r] = initial (sys, x0, tfinal = [], dt = []) + + ## TODO: multiplot feature: initial (sys1, "b", sys2, "r", ..., x0, ...) + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + [y, t, x] = __time_response__ (sys, "initial", ! nargout, tfinal, dt, x0, inputname (1)); + + if (nargout) + y_r = y; + t_r = t; + x_r = x; + endif + +endfunction + + +%!shared initial_c, initial_c_exp, initial_d, initial_d_exp +%! +%! A = [ -2.8 2.0 -1.8 +%! -2.4 -2.0 0.8 +%! 1.1 1.7 -1.0 ]; +%! +%! B = [ -0.8 0.5 0 +%! 0 0.7 2.3 +%! -0.3 -0.1 0.5 ]; +%! +%! C = [ -0.1 0 -0.3 +%! 0.9 0.5 1.2 +%! 0.1 -0.1 1.9 ]; +%! +%! D = [ -0.5 0 0 +%! 0.1 0 0.3 +%! -0.8 0 0 ]; +%! +%! x_0 = [1, 2, 3]; +%! +%! sysc = ss (A, B, C, D); +%! +%! [yc, tc, xc] = initial (sysc, x_0, 0.2, 0.1); +%! initial_c = [yc, tc, xc]; +%! +%! sysd = c2d (sysc, 2); +%! +%! [yd, td, xd] = initial (sysd, x_0, 4); +%! initial_d = [yd, td, xd]; +%! +%! ## expected values computed by the "dark side" +%! +%! yc_exp = [ -1.0000 5.5000 5.6000 +%! -0.9872 5.0898 5.7671 +%! -0.9536 4.6931 5.7598 ]; +%! +%! tc_exp = [ 0.0000 +%! 0.1000 +%! 0.2000 ]; +%! +%! xc_exp = [ 1.0000 2.0000 3.0000 +%! 0.5937 1.6879 3.0929 +%! 0.2390 1.5187 3.0988 ]; +%! +%! initial_c_exp = [yc_exp, tc_exp, xc_exp]; +%! +%! yd_exp = [ -1.0000 5.5000 5.6000 +%! -0.6550 3.1673 4.2228 +%! -0.5421 2.6186 3.4968 ]; +%! +%! td_exp = [ 0 +%! 2 +%! 4 ]; +%! +%! xd_exp = [ 1.0000 2.0000 3.0000 +%! -0.4247 1.5194 2.3249 +%! -0.3538 1.2540 1.9250 ]; +%! +%! initial_d_exp = [yd_exp, td_exp, xd_exp]; +%! +%!assert (initial_c, initial_c_exp, 1e-4) +%!assert (initial_d, initial_d_exp, 1e-4) diff --git a/octave_packages/control-2.3.52/isctrb.m b/octave_packages/control-2.3.52/isctrb.m new file mode 100644 index 0000000..c2641bf --- /dev/null +++ b/octave_packages/control-2.3.52/isctrb.m @@ -0,0 +1,99 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{bool}, @var{ncon}] =} isctrb (@var{sys}) +## @deftypefnx {Function File} {[@var{bool}, @var{ncon}] =} isctrb (@var{sys}, @var{tol}) +## @deftypefnx {Function File} {[@var{bool}, @var{ncon}] =} isctrb (@var{a}, @var{b}) +## @deftypefnx {Function File} {[@var{bool}, @var{ncon}] =} isctrb (@var{a}, @var{b}, @var{e}) +## @deftypefnx {Function File} {[@var{bool}, @var{ncon}] =} isctrb (@var{a}, @var{b}, @var{[]}, @var{tol}) +## @deftypefnx {Function File} {[@var{bool}, @var{ncon}] =} isctrb (@var{a}, @var{b}, @var{e}, @var{tol}) +## Logical check for system controllability. +## For numerical reasons, @code{isctrb (sys)} +## should be used instead of @code{rank (ctrb (sys))}. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. Descriptor state-space models are possible. +## @item a +## State transition matrix. +## @item b +## Input matrix. +## @item e +## Descriptor matrix. +## If @var{e} is empty @code{[]} or not specified, an identity matrix is assumed. +## @item tol +## Optional roundoff parameter. Default value is 0. +## @end table +## +## @strong{Outputs} +## @table @var +## @item bool = 0 +## System is not controllable. +## @item bool = 1 +## System is controllable. +## @item ncon +## Number of controllable states. +## @end table +## +## @strong{Algorithm}@* +## Uses SLICOT AB01OD and TG01HD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## +## @seealso{isobsv} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.4 + +function [bool, ncont] = isctrb (a, b = [], e = [], tol = []) + + if (nargin < 1 || nargin > 4) + print_usage (); + elseif (isa (a, "lti")) # isctrb (sys), isctrb (sys, tol) + if (nargin > 2) + print_usage (); + endif + tol = b; + [a, b, c, d, e] = dssdata (a, []); + elseif (nargin < 2) # isctrb (a, b), isctrb (a, b, tol) + print_usage (); + elseif (! is_real_square_matrix (a) || ! is_real_matrix (b) || rows (a) != rows (b)) + error ("isctrb: a(%dx%d), b(%dx%d) not conformal", + rows (a), columns (a), rows (b), columns (b)); + elseif (! isempty (e) && (! is_real_square_matrix (e) || ! size_equal (e, a))) + error ("isctrb: a(%dx%d), e(%dx%d) not conformal", + rows (a), columns (a), rows (e), columns (e)); + endif + + if (isempty (tol)) + tol = 0; # default tolerance + elseif (! is_real_scalar (tol)) + error ("isctrb: tol must be a real scalar"); + endif + + if (isempty (e)) + [~, ~, ~, ncont] = slab01od (a, b, tol); + else + [~, ~, ~, ~, ~, ~, ncont] = sltg01hd (a, e, b, zeros (1, columns (a)), tol); + endif + + bool = (ncont == rows (a)); + +endfunction diff --git a/octave_packages/control-2.3.52/isdetectable.m b/octave_packages/control-2.3.52/isdetectable.m new file mode 100644 index 0000000..727b8ec --- /dev/null +++ b/octave_packages/control-2.3.52/isdetectable.m @@ -0,0 +1,87 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{bool} =} isdetectable (@var{sys}) +## @deftypefnx {Function File} {@var{bool} =} isdetectable (@var{sys}, @var{tol}) +## @deftypefnx {Function File} {@var{bool} =} isdetectable (@var{a}, @var{c}) +## @deftypefnx {Function File} {@var{bool} =} isdetectable (@var{a}, @var{c}, @var{e}) +## @deftypefnx {Function File} {@var{bool} =} isdetectable (@var{a}, @var{c}, @var{[]}, @var{tol}) +## @deftypefnx {Function File} {@var{bool} =} isdetectable (@var{a}, @var{c}, @var{e}, @var{tol}) +## @deftypefnx {Function File} {@var{bool} =} isdetectable (@var{a}, @var{c}, @var{[]}, @var{[]}, @var{dflg}) +## @deftypefnx {Function File} {@var{bool} =} isdetectable (@var{a}, @var{c}, @var{e}, @var{[]}, @var{dflg}) +## @deftypefnx {Function File} {@var{bool} =} isdetectable (@var{a}, @var{c}, @var{[]}, @var{tol}, @var{dflg}) +## @deftypefnx {Function File} {@var{bool} =} isdetectable (@var{a}, @var{c}, @var{e}, @var{tol}, @var{dflg}) +## Logical test for system detectability. +## All unstable modes must be observable or all unobservable states must be stable. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. +## @item a +## State transition matrix. +## @item c +## Measurement matrix. +## @item e +## Descriptor matrix. +## If @var{e} is empty @code{[]} or not specified, an identity matrix is assumed. +## @item tol +## Optional tolerance for stability. Default value is 0. +## @item dflg = 0 +## Matrices (@var{a}, @var{c}) are part of a continuous-time system. Default Value. +## @item dflg = 1 +## Matrices (@var{a}, @var{c}) are part of a discrete-time system. +## @end table +## +## @strong{Outputs} +## @table @var +## @item bool = 0 +## System is not detectable. +## @item bool = 1 +## System is detectable. +## @end table +## +## +## @strong{Algorithm}@* +## Uses SLICOT AB01OD and TG01HD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## See @command{isstabilizable} for description of computational method. +## @seealso{isstabilizable, isstable, isctrb, isobsv} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function bool = isdetectable (a, c = [], e = [], tol = [], dflg = 0) + + if (nargin == 0) + print_usage (); + elseif (isa (a, "lti")) # isdetectable (sys), isdetectable (sys, tol) + if (nargin > 2) + print_usage (); + endif + bool = isstabilizable (a.', c); # transpose is overloaded + elseif (nargin < 2 || nargin > 5) + print_usage (); + else # isdetectable (a, c, ...) + bool = isstabilizable (a.', c.', e.', tol, dflg); # arguments checked inside + endif + +endfunction + diff --git a/octave_packages/control-2.3.52/isobsv.m b/octave_packages/control-2.3.52/isobsv.m new file mode 100644 index 0000000..79fea47 --- /dev/null +++ b/octave_packages/control-2.3.52/isobsv.m @@ -0,0 +1,81 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{bool}, @var{nobs}] =} isobsv (@var{sys}) +## @deftypefnx {Function File} {[@var{bool}, @var{nobs}] =} isobsv (@var{sys}, @var{tol}) +## @deftypefnx {Function File} {[@var{bool}, @var{nobs}] =} isobsv (@var{a}, @var{c}) +## @deftypefnx {Function File} {[@var{bool}, @var{nobs}] =} isobsv (@var{a}, @var{c}, @var{e}) +## @deftypefnx {Function File} {[@var{bool}, @var{nobs}] =} isobsv (@var{a}, @var{c}, @var{[]}, @var{tol}) +## @deftypefnx {Function File} {[@var{bool}, @var{nobs}] =} isobsv (@var{a}, @var{c}, @var{e}, @var{tol}) +## Logical check for system observability. +## For numerical reasons, @code{isobsv (sys)} +## should be used instead of @code{rank (obsv (sys))}. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. Descriptor state-space models are possible. +## @item a +## State transition matrix. +## @item c +## Measurement matrix. +## @item e +## Descriptor matrix. +## If @var{e} is empty @code{[]} or not specified, an identity matrix is assumed. +## @item tol +## Optional roundoff parameter. Default value is 0. +## @end table +## +## @strong{Outputs} +## @table @var +## @item bool = 0 +## System is not observable. +## @item bool = 1 +## System is observable. +## @item nobs +## Number of observable states. +## @end table +## +## @strong{Algorithm}@* +## Uses SLICOT AB01OD and TG01HD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## +## @seealso{isctrb} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.4 + +function [bool, nobs] = isobsv (a, c = [], e = [], tol = []) + + if (nargin == 0) + print_usage (); + elseif (isa (a, "lti")) # isobsv (sys), isobsv (sys, tol) + if (nargin > 2) + print_usage (); + endif + [bool, nobs] = isctrb (a.', c); # transpose is overloaded + elseif (nargin < 2 || nargin > 4) + print_usage (); + else # isobsv (a, c), isobsv (a, c, e), ... + [bool, nobs] = isctrb (a.', c.', e.', tol); + endif + +endfunction + diff --git a/octave_packages/control-2.3.52/issample.m b/octave_packages/control-2.3.52/issample.m new file mode 100644 index 0000000..547213e --- /dev/null +++ b/octave_packages/control-2.3.52/issample.m @@ -0,0 +1,113 @@ +## Copyright (C) 1996, 2000, 2002, 2003, 2004, 2005, 2007 +## Auburn University. All rights reserved. +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{bool} =} issample (@var{ts}) +## @deftypefnx {Function File} {@var{bool} =} issample (@var{ts}, @var{flg}) +## Return true if @var{ts} is a valid sampling time. +## +## @strong{Inputs} +## @table @var +## @item ts +## Alleged sampling time to be tested. +## @item flg = 1 +## Accept real scalars @var{ts} > 0. Default Value. +## @item flg = 0 +## Accept real scalars @var{ts} >= 0. +## @item flg = -1 +## Accept real scalars @var{ts} > 0 and @var{ts} == -1. +## @item flg = -10 +## Accept real scalars @var{ts} >= 0 and @var{ts} == -1. +## @item flg = -2 +## Accept real scalars @var{ts} >= 0, @var{ts} == -1 and @var{ts} == -2. +## @end table +## +## @strong{Outputs} +## @table @var +## @item bool +## True if conditions are met and false otherwise. +## @end table +## +## @end deftypefn + +## Author: A. S. Hodel +## Created: July 1995 + +## Adapted-By: Lukas Reichlin +## Date: September 2009 +## Version: 0.3 + +function bool = issample (tsam, flg = 1) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + switch (flg) + case 1 # discrete + bool = is_real_scalar (tsam) && (tsam > 0); + case 0 # continuous or discrete + bool = is_real_scalar (tsam) && (tsam >= 0); + case -1 # discrete, tsam unspecified + bool = is_real_scalar (tsam) && (tsam > 0 || tsam == -1); + case -10 # continuous or discrete, tsam unspecified + bool = is_real_scalar (tsam) && (tsam >= 0 || tsam == -1); + case -2 # accept static gains + bool = is_real_scalar (tsam) && (tsam >= 0 || tsam == -1 || tsam == -2); + otherwise + print_usage (); + endswitch + +endfunction + + +## flg == 1 +%!assert (issample (1)) +%!assert (issample (pi)) +%!assert (issample (0), false) +%!assert (issample (-1), false) +%!assert (issample (-1, 1), false) +%!assert (issample ("a"), false) +%!assert (issample (eye (2)), false) +%!assert (issample (2+2i), false) + +## flg == 0 +%!assert (issample (1, 0)) +%!assert (issample (0, 0)) +%!assert (issample (-1, 0), false) +%!assert (issample (pi, 0)) +%!assert (issample ("b", 0), false) +%!assert (issample (rand (3,2), 0), false) +%!assert (issample (2+2i, 0), false) +%!assert (issample (0+2i, 0), false) + +## flg == -1 +%!assert (issample (-1, -1)) +%!assert (issample (0, -1), false) +%!assert (issample (1, -1)) +%!assert (issample (pi, -1)) +%!assert (issample (-pi, -1), false) +%!assert (issample ("b", -1), false) +%!assert (issample (rand (3,2), -1), false) +%!assert (issample (-2+2i, -1), false) + +## errors +%!error (issample (-1, "ab")) +%!error (issample ()) +%!error (issample (-1, -1, -1)) +%!error (issample (1, pi)) +%!error (issample (5, rand (2,3))) +%!error (issample (0, 1+2i)) diff --git a/octave_packages/control-2.3.52/isstabilizable.m b/octave_packages/control-2.3.52/isstabilizable.m new file mode 100644 index 0000000..8e2377c --- /dev/null +++ b/octave_packages/control-2.3.52/isstabilizable.m @@ -0,0 +1,135 @@ +## Copyright (C) 2009, 2010, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{bool} =} isstabilizable (@var{sys}) +## @deftypefnx {Function File} {@var{bool} =} isstabilizable (@var{sys}, @var{tol}) +## @deftypefnx {Function File} {@var{bool} =} isstabilizable (@var{a}, @var{b}) +## @deftypefnx {Function File} {@var{bool} =} isstabilizable (@var{a}, @var{b}, @var{e}) +## @deftypefnx {Function File} {@var{bool} =} isstabilizable (@var{a}, @var{b}, @var{[]}, @var{tol}) +## @deftypefnx {Function File} {@var{bool} =} isstabilizable (@var{a}, @var{b}, @var{e}, @var{tol}) +## @deftypefnx {Function File} {@var{bool} =} isstabilizable (@var{a}, @var{b}, @var{[]}, @var{[]}, @var{dflg}) +## @deftypefnx {Function File} {@var{bool} =} isstabilizable (@var{a}, @var{b}, @var{e}, @var{[]}, @var{dflg}) +## @deftypefnx {Function File} {@var{bool} =} isstabilizable (@var{a}, @var{b}, @var{[]}, @var{tol}, @var{dflg}) +## @deftypefnx {Function File} {@var{bool} =} isstabilizable (@var{a}, @var{b}, @var{e}, @var{tol}, @var{dflg}) +## Logical check for system stabilizability. +## All unstable modes must be controllable or all uncontrollable states must be stable. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. +## @item a +## State transition matrix. +## @item b +## Input matrix. +## @item e +## Descriptor matrix. +## If @var{e} is empty @code{[]} or not specified, an identity matrix is assumed. +## @item tol +## Optional tolerance for stability. Default value is 0. +## @item dflg = 0 +## Matrices (@var{a}, @var{b}) are part of a continuous-time system. Default Value. +## @item dflg = 1 +## Matrices (@var{a}, @var{b}) are part of a discrete-time system. +## @end table +## +## @strong{Outputs} +## @table @var +## @item bool = 0 +## System is not stabilizable. +## @item bool = 1 +## System is stabilizable. +## @end table +## +## @strong{Algorithm}@* +## Uses SLICOT AB01OD and TG01HD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @example +## @group +## * Calculate staircase form (SLICOT AB01OD) +## * Extract unobservable part of state transition matrix +## * Calculate eigenvalues of unobservable part +## * Check whether +## real (ev) < -tol*(1 + abs (ev)) continuous-time +## abs (ev) < 1 - tol discrete-time +## @end group +## @end example +## @seealso{isdetectable, isstable, isctrb, isobsv} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.4 + +function bool = isstabilizable (a, b = [], e = [], tol = [], dflg = 0) + + if (nargin < 1 || nargin > 5) + print_usage (); + elseif (isa (a, "lti")) # isstabilizable (sys), isstabilizable (sys, tol) + if (nargin > 2) + print_usage (); + endif + tol = b; + dflg = ! isct (a); + [a, b, c, d, e] = dssdata (a, []); + elseif (nargin == 1) # isstabilizable (a, b, ...) + print_usage (); + elseif (! is_real_square_matrix (a) || rows (a) != rows (b)) + error ("isstabilizable: a must be square and conformal to b"); + elseif (! isempty (e) && (! is_real_square_matrix (e) || ! size_equal (a, e))) + error ("isstabilizable: e must be square and conformal to a"); + endif + + if (isempty (tol)) + tol = 0; # default tolerance + elseif (! is_real_scalar (tol)) + error ("isstabilizable: tol must be a real scalar"); + endif + + if (isempty (e)) + ## controllability staircase form + [ac, ~, ~, ncont] = slab01od (a, b, tol); + + ## extract uncontrollable part of staircase form + uncont_idx = ncont+1 : rows (a); + auncont = ac(uncont_idx, uncont_idx); + + ## calculate poles of uncontrollable part + pol = eig (auncont); + else + ## controllability staircase form - output matrix c has no influence + [ac, ec, ~, ~, ~, ~, ncont] = sltg01hd (a, e, b, zeros (1, columns (a)), tol); + + ## extract uncontrollable part of staircase form + uncont_idx = ncont+1 : rows (a); + auncont = ac(uncont_idx, uncont_idx); + euncont = ec(uncont_idx, uncont_idx); + + ## calculate poles of uncontrollable part + pol = eig (auncont, euncont); + + ## remove infinite poles + tolinf = norm ([auncont, euncont], 2); + idx = find (abs (pol) < tolinf/eps); + pol = pol(idx); + endif + + ## check whether uncontrollable poles are stable + bool = __is_stable__ (pol, ! dflg, tol); + +endfunction diff --git a/octave_packages/control-2.3.52/kalman.m b/octave_packages/control-2.3.52/kalman.m new file mode 100644 index 0000000..309e53e --- /dev/null +++ b/octave_packages/control-2.3.52/kalman.m @@ -0,0 +1,125 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{est}, @var{g}, @var{x}] =} kalman (@var{sys}, @var{q}, @var{r}) +## @deftypefnx {Function File} {[@var{est}, @var{g}, @var{x}] =} kalman (@var{sys}, @var{q}, @var{r}, @var{s}) +## @deftypefnx {Function File} {[@var{est}, @var{g}, @var{x}] =} kalman (@var{sys}, @var{q}, @var{r}, @var{[]}, @var{sensors}, @var{known}) +## @deftypefnx {Function File} {[@var{est}, @var{g}, @var{x}] =} kalman (@var{sys}, @var{q}, @var{r}, @var{s}, @var{sensors}, @var{known}) +## Design Kalman estimator for LTI systems. +## +## @strong{Inputs} +## @table @var +## @item sys +## Nominal plant model. +## @item q +## Covariance of white process noise. +## @item r +## Covariance of white measurement noise. +## @item s +## Optional cross term covariance. Default value is 0. +## @item sensors +## Indices of measured output signals y from @var{sys}. If omitted, all outputs are measured. +## @item known +## Indices of known input signals u (deterministic) to @var{sys}. All other inputs to @var{sys} +## are assumed stochastic. If argument @var{known} is omitted, no inputs u are known. +## @end table +## +## @strong{Outputs} +## @table @var +## @item est +## State-space model of the Kalman estimator. +## @item g +## Estimator gain. +## @item x +## Solution of the Riccati equation. +## @end table +## +## @strong{Block Diagram} +## @example +## @group +## u +-------+ ^ +## +---------------------------->| |-------> y +## | +-------+ + y | est | ^ +## u ----+--->| |----->(+)------>| |-------> x +## | sys | ^ + +-------+ +## w -------->| | | +## +-------+ | v +## +## Q = cov (w, w') R = cov (v, v') S = cov (w, v') +## @end group +## @end example +## +## @seealso{care, dare, estim, lqr} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.3 + +function [est, k, x] = kalman (sys, q, r, s = [], sensors = [], deterministic = []) + + ## TODO: type "current" for discrete-time systems + + if (nargin < 3 || nargin > 6 || ! isa (sys, "lti")) + print_usage (); + endif + + [a, b, c, d, e] = dssdata (sys, []); + + if (isempty (sensors)) + sensors = 1 : rows (c); + endif + + stochastic = setdiff (1 : columns (b), deterministic); + + c = c(sensors, :); + g = b(:, stochastic); + h = d(sensors, stochastic); + + if (isempty (s)) + rbar = r + h*q*h.'; + sbar = g * q*h.'; + else + rbar = r + h*q*h.'+ h*s + s.'*h.'; + sbar = g * (q*h.' + s); + endif + + if (isct (sys)) + [x, l, k] = care (a.', c.', g*q*g.', rbar, sbar, e.'); + else + [x, l, k] = dare (a.', c.', g*q*g.', rbar, sbar, e.'); + endif + + k = k.'; + + est = estim (sys, k, sensors, deterministic); + +endfunction + + +%!shared m, m_exp, g, g_exp, x, x_exp +%! sys = ss (-2, 1, 1, 3); +%! [est, g, x] = kalman (sys, 1, 1, 1); +%! [a, b, c, d] = ssdata (est); +%! m = [a, b; c, d]; +%! m_exp = [-2.25, 0.25; 1, 0; 1, 0]; +%! g_exp = 0.25; +%! x_exp = 0; +%!assert (m, m_exp, 1e-2); +%!assert (g, g_exp, 1e-2); +%!assert (x, x_exp, 1e-2); \ No newline at end of file diff --git a/octave_packages/control-2.3.52/lqe.m b/octave_packages/control-2.3.52/lqe.m new file mode 100644 index 0000000..77669dd --- /dev/null +++ b/octave_packages/control-2.3.52/lqe.m @@ -0,0 +1,113 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## Copyright (C) 2012 Megan Zagrobelny +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{l}, @var{p}, @var{e}] =} lqe (@var{sys}, @var{q}, @var{r}) +## @deftypefnx {Function File} {[@var{l}, @var{p}, @var{e}] =} lqe (@var{sys}, @var{q}, @var{r}, @var{s}) +## @deftypefnx {Function File} {[@var{l}, @var{p}, @var{e}] =} lqe (@var{a}, @var{g}, @var{c}, @var{q}, @var{r}) +## @deftypefnx {Function File} {[@var{l}, @var{p}, @var{e}] =} lqe (@var{a}, @var{g}, @var{c}, @var{q}, @var{r}, @var{s}) +## @deftypefnx {Function File} {[@var{l}, @var{p}, @var{e}] =} lqe (@var{a}, @var{[]}, @var{c}, @var{q}, @var{r}) +## @deftypefnx {Function File} {[@var{l}, @var{p}, @var{e}] =} lqe (@var{a}, @var{[]}, @var{c}, @var{q}, @var{r}, @var{s}) +## Kalman filter for continuous-time systems. +## +## @example +## @group +## . +## x = Ax + Bu + Gw (State equation) +## y = Cx + Du + v (Measurement Equation) +## E(w) = 0, E(v) = 0, cov(w) = Q, cov(v) = R, cov(w,v) = S +## @end group +## @end example +## +## @strong{Inputs} +## @table @var +## @item sys +## Continuous or discrete-time LTI model (p-by-m, n states). +## @item a +## State transition matrix of continuous-time system (n-by-n). +## @item g +## Process noise matrix of continuous-time system (n-by-g). +## If @var{g} is empty @code{[]}, an identity matrix is assumed. +## @item c +## Measurement matrix of continuous-time system (p-by-n). +## @item q +## Process noise covariance matrix (g-by-g). +## @item r +## Measurement noise covariance matrix (p-by-p). +## @item s +## Optional cross term covariance matrix (g-by-p), s = cov(w,v). +## If @var{s} is empty @code{[]} or not specified, a zero matrix is assumed. +## @end table +## +## @strong{Outputs} +## @table @var +## @item l +## Kalman filter gain matrix (n-by-p). +## @item p +## Unique stabilizing solution of the continuous-time Riccati equation (n-by-n). +## Symmetric matrix. If @var{sys} is a discrete-time model, the solution of the +## corresponding discrete-time Riccati equation is returned. +## @item e +## Closed-loop poles (n-by-1). +## @end table +## +## @strong{Equations} +## @example +## @group +## . +## x = Ax + Bu + L(y - Cx -Du) +## +## E = eig(A - L*C) +## +## @end group +## @end example +## @seealso{dare, care, dlqr, lqr, dlqe} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: April 2012 +## Version: 0.1 + +function [l, p, e] = lqe (a, g, c, q = [], r = [], s = []) + + if (nargin < 3 || nargin > 6) + print_usage (); + endif + + if (isa (a, "lti")) + [l, p, e] = lqr (a.', g, c, q); # lqe (sys, q, r, s), g=I, works like lqr (sys.', q, r, s).' + elseif (isempty (g)) + [l, p, e] = lqr (a.', c.', q, r, s); # lqe (a, [], c, q, r, s), g=I, works like lqr (a.', c.', q, r, s).' + elseif (columns (g) != rows (q) || ! issquare (q)) + error ("lqe: matrices g(%dx%d) and q(%dx%d) have incompatible dimensions", \ + rows (g), columns (g), rows (q), columns (q)); + elseif (isempty (s)) + [l, p, e] = lqr (a.', c.', g*q*g.', r); + elseif (columns (g) != rows (s)) + error ("lqe: matrices g(%dx%d) and s(%dx%d) have incompatible dimensions", \ + rows (g), columns (g), rows (s), columns (s)); + else + [l, p, e] = lqr (a.', c.', g*q*g.', r, g*s); + endif + + l = l.'; + + ## NOTE: for discrete-time sys, the solution L' from DARE + ## is different to L from DLQE (a, s) + +endfunction diff --git a/octave_packages/control-2.3.52/lqr.m b/octave_packages/control-2.3.52/lqr.m new file mode 100644 index 0000000..b692747 --- /dev/null +++ b/octave_packages/control-2.3.52/lqr.m @@ -0,0 +1,98 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{g}, @var{x}, @var{l}] =} lqr (@var{sys}, @var{q}, @var{r}) +## @deftypefnx {Function File} {[@var{g}, @var{x}, @var{l}] =} lqr (@var{sys}, @var{q}, @var{r}, @var{s}) +## @deftypefnx {Function File} {[@var{g}, @var{x}, @var{l}] =} lqr (@var{a}, @var{b}, @var{q}, @var{r}) +## @deftypefnx {Function File} {[@var{g}, @var{x}, @var{l}] =} lqr (@var{a}, @var{b}, @var{q}, @var{r}, @var{s}) +## @deftypefnx {Function File} {[@var{g}, @var{x}, @var{l}] =} lqr (@var{a}, @var{b}, @var{q}, @var{r}, @var{[]}, @var{e}) +## @deftypefnx {Function File} {[@var{g}, @var{x}, @var{l}] =} lqr (@var{a}, @var{b}, @var{q}, @var{r}, @var{s}, @var{e}) +## Linear-quadratic regulator. +## +## @strong{Inputs} +## @table @var +## @item sys +## Continuous or discrete-time LTI model (p-by-m, n states). +## @item a +## State transition matrix of continuous-time system (n-by-n). +## @item b +## Input matrix of continuous-time system (n-by-m). +## @item q +## State weighting matrix (n-by-n). +## @item r +## Input weighting matrix (m-by-m). +## @item s +## Optional cross term matrix (n-by-m). If @var{s} is not specified, a zero matrix is assumed. +## @item e +## Optional descriptor matrix (n-by-n). If @var{e} is not specified, an identity matrix is assumed. +## @end table +## +## @strong{Outputs} +## @table @var +## @item g +## State feedback matrix (m-by-n). +## @item x +## Unique stabilizing solution of the continuous-time Riccati equation (n-by-n). +## @item l +## Closed-loop poles (n-by-1). +## @end table +## +## @strong{Equations} +## @example +## @group +## . +## x = A x + B u, x(0) = x0 +## +## inf +## J(x0) = INT (x' Q x + u' R u + 2 x' S u) dt +## 0 +## +## L = eig (A - B*G) +## @end group +## @end example +## @seealso{care, dare, dlqr} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.2 + +function [g, x, l] = lqr (a, b, q, r = [], s = [], e = []) + + if (nargin < 3 || nargin > 6) + print_usage (); + endif + + if (isa (a, "lti")) + s = r; + r = q; + q = b; + [a, b, c, d, e, tsam] = dssdata (a, []); + elseif (nargin < 4) + print_usage (); + else + tsam = 0; + endif + + if (issample (tsam, -1)) + [x, l, g] = dare (a, b, q, r, s, e); + else + [x, l, g] = care (a, b, q, r, s, e); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/lsim.m b/octave_packages/control-2.3.52/lsim.m new file mode 100644 index 0000000..352a298 --- /dev/null +++ b/octave_packages/control-2.3.52/lsim.m @@ -0,0 +1,195 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{y}, @var{t}, @var{x}] =} lsim (@var{sys}, @var{u}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} lsim (@var{sys}, @var{u}, @var{t}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} lsim (@var{sys}, @var{u}, @var{t}, @var{x0}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} lsim (@var{sys}, @var{u}, @var{t}, @var{[]}, @var{method}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} lsim (@var{sys}, @var{u}, @var{t}, @var{x0}, @var{method}) +## Simulate LTI model response to arbitrary inputs. If no output arguments are given, +## the system response is plotted on the screen. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. System must be proper, i.e. it must not have more zeros than poles. +## @item u +## Vector or array of input signal. Needs @code{length(t)} rows and as many columns +## as there are inputs. If @var{sys} is a single-input system, row vectors @var{u} +## of length @code{length(t)} are accepted as well. +## @item t +## Time vector. Should be evenly spaced. If @var{sys} is a continuous-time system +## and @var{t} is a real scalar, @var{sys} is discretized with sampling time +## @code{tsam = t/(rows(u)-1)}. If @var{sys} is a discrete-time system and @var{t} +## is not specified, vector @var{t} is assumed to be @code{0 : tsam : tsam*(rows(u)-1)}. +## @item x0 +## Vector of initial conditions for each state. If not specified, a zero vector is assumed. +## @item method +## Discretization method for continuous-time models. Default value is zoh +## (zero-order hold). All methods from @code{c2d} are supported. +## @end table +## +## @strong{Outputs} +## @table @var +## @item y +## Output response array. Has as many rows as time samples (length of t) +## and as many columns as outputs. +## @item t +## Time row vector. It is always evenly spaced. +## @item x +## State trajectories array. Has @code{length (t)} rows and as many columns as states. +## @end table +## +## @seealso{impulse, initial, step} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.3 + +function [y_r, t_r, x_r] = lsim (sys, u, t = [], x0 = [], method = "zoh") + + ## TODO: multiplot feature: lsim (sys1, "b", sys2, "r", ..., u, t) + + if (nargin < 2 || nargin > 5) + print_usage (); + endif + + if (! isa (sys, "ss")) + sys = ss (sys); # sys must be proper + endif + + if (is_real_vector (u)) + u = reshape (u, [], 1); # allow row vectors for single-input systems + elseif (! is_real_matrix (u)) + error ("lsim: input signal u must be an array of real numbers"); + endif + + if (! is_real_vector (t) && ! isempty (t)) + error ("lsim: time vector t must be real or empty"); + endif + + discrete = ! isct (sys); # static gains are treated as continuous-time systems + tsam = abs (get (sys, "tsam")); # use 1 second as default if tsam is unspecified (-1) + urows = rows (u); + ucols = columns (u); + + if (discrete) # discrete system + if (isempty (t)) # lsim (sys, u) + dt = tsam; + tinitial = 0; + tfinal = tsam * (urows - 1); + elseif (length (t) == 1) # lsim (sys, u, tfinal) + dt = tsam; + tinitial = 0; + tfinal = t; + else # lsim (sys, u, t, ...) + warning ("lsim: spacing of time vector has no effect on sampling time of discrete system"); + dt = tsam; + tinitial = t(1); + tfinal = t(end); + endif + else # continuous system + if (isempty (t)) # lsim (sys, u, [], ...) + error ("lsim: invalid time vector"); + elseif (length (t) == 1) # lsim (sys, u, tfinal, ...) + dt = t / (urows - 1); + tinitial = 0; + tfinal = t; + else # lsim (sys, u, t, ...) + dt = t(2) - t(1); # assume that t is regularly spaced + tinitial = t(1); + tfinal = t(end); + endif + sys = c2d (sys, dt, method); # convert to discrete-time model + endif + + [A, B, C, D] = ssdata (sys); + + n = rows (A); # number of states + m = columns (B); # number of inputs + p = rows (C); # number of outputs + + t = reshape (tinitial : dt : tfinal, [], 1); # time vector + trows = length (t); + + if (urows != trows) + error ("lsim: input vector u must have %d rows", trows); + endif + + if (ucols != m) + error ("lsim: input vector u must have %d columns", m); + endif + + ## preallocate memory + y = zeros (trows, p); + x_arr = zeros (trows, n); + + ## initial conditions + if (isempty (x0)) + x0 = zeros (n, 1); + elseif (n != length (x0) || ! is_real_vector (x0)) + error ("initial: x0 must be a vector with %d elements", n); + endif + + x = reshape (x0, [], 1); # make sure that x is a column vector + + ## simulation + for k = 1 : trows + y(k, :) = C * x + D * u(k, :).'; + x_arr(k, :) = x; + x = A * x + B * u(k, :).'; + endfor + + if (nargout == 0) # plot information + str = ["Linear Simulation Results of ", inputname(1)]; + outname = get (sys, "outname"); + outname = __labels__ (outname, "y_"); + if (discrete) # discrete system + for k = 1 : p + subplot (p, 1, k); + stairs (t, y(:, k)); + grid ("on"); + if (k == 1) + title (str); + endif + ylabel (sprintf ("Amplitude %s", outname{k})); + endfor + xlabel ("Time [s]"); + else # continuous system + for k = 1 : p + subplot (p, 1, k); + plot (t, y(:, k)); + grid ("on"); + if (k == 1) + title (str); + endif + ylabel (sprintf ("Amplitude %s", outname{k})); + endfor + xlabel ("Time [s]"); + endif + else # return values + y_r = y; + t_r = t; + x_r = x_arr; + endif + +endfunction + + +## TODO: add test cases \ No newline at end of file diff --git a/octave_packages/control-2.3.52/ltimodels.m b/octave_packages/control-2.3.52/ltimodels.m new file mode 100644 index 0000000..369193f --- /dev/null +++ b/octave_packages/control-2.3.52/ltimodels.m @@ -0,0 +1,413 @@ +## Copyright (C) 2009 Luca Favatella +## Copyright (C) 2009, 2010, 2011 Lukas Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} test ltimodels +## @deftypefnx {Function File} ltimodels +## @deftypefnx {Function File} ltimodels (@var{systype}) +## Test suite and help for LTI models. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.2 + +function ltimodels (systype = "general") + + %if (nargin > 1) + print_usage (); + %endif + + ## TODO: write documentation + + if (! ischar (systype)) + error ("ltimodels: argument must be a string"); + endif + + systype = lower (systype); + + switch (systype) + case "ss" + str = {"State Space (SS) Models"\ + "-----------------------"\ + ""}; + + case "tf" + str = {"Transfer Function (TF) Models"\ + "-----------------------------"\ + ""}; + + otherwise # general + str = {"Linear Time Invariant (LTI) Models"\ + "----------------------------------"\ + ""}; + + endswitch + + disp (""); + disp (char (str)); + +endfunction + + + +## ============================================================================== +## LTI Tests +## ============================================================================== + +## isct, isdt +%!shared ltisys +%! ltisys = tf (12); +%!assert (ltisys.ts, -2); +%!assert (isct (ltisys)); +%!assert (isdt (ltisys)); + +%!shared ltisys +%! ltisys = ss (17); +%!assert (ltisys.ts, -2); +%!assert (isct (ltisys)); +%!assert (isdt (ltisys)); + +%!shared ltisys +%! ltisys = tf (1, [1 1]); +%!assert (ltisys.ts, 0); +%!assert (isct (ltisys)); +%!assert (! isdt (ltisys)); + +%!shared ltisys, ts +%! ts = 0.1; +%! ltisys = ss (-1, 1, 1, 0, ts); +%!assert (ltisys.ts, ts); +%!assert (! isct (ltisys)); +%!assert (isdt (ltisys)); + + + +## ============================================================================== +## TF Tests +## ============================================================================== + + + +## ============================================================================== +## SS Tests +## ============================================================================== + + +## staircase (SLICOT AB01OD) +%!shared Ac, Bc, Ace, Bce +%! A = [ 17.0 24.0 1.0 8.0 15.0 +%! 23.0 5.0 7.0 14.0 16.0 +%! 4.0 6.0 13.0 20.0 22.0 +%! 10.0 12.0 19.0 21.0 3.0 +%! 11.0 18.0 25.0 2.0 9.0 ]; +%! +%! B = [ -1.0 -4.0 +%! 4.0 9.0 +%! -9.0 -16.0 +%! 16.0 25.0 +%! -25.0 -36.0 ]; +%! +%! tol = 0; +%! +%! A = A.'; # There's a little mistake in the example +%! # program of routine AB01OD in SLICOT 5.0 +%! +%! [Ac, Bc, U, ncont] = slab01od (A, B, tol); +%! +%! Ace = [ 12.8848 3.2345 11.8211 3.3758 -0.8982 +%! 4.4741 -12.5544 5.3509 5.9403 1.4360 +%! 14.4576 7.6855 23.1452 26.3872 -29.9557 +%! 0.0000 1.4805 27.4668 22.6564 -0.0072 +%! 0.0000 0.0000 -30.4822 0.6745 18.8680 ]; +%! +%! Bce = [ 31.1199 47.6865 +%! 3.2480 0.0000 +%! 0.0000 0.0000 +%! 0.0000 0.0000 +%! 0.0000 0.0000 ]; +%! +%!assert (Ac, Ace, 1e-4); +%!assert (Bc, Bce, 1e-4); + + +## controllability staircase form of descriptor state-space models (SLICOT TG01HD) +%!shared ac, ec, bc, cc, q, z, ncont, ac_e, ec_e, bc_e, cc_e, q_e, z_e, ncont_e +%! +%! a = [ 2 0 2 0 -1 3 1 +%! 0 1 0 0 1 0 0 +%! 0 0 0 1 0 0 1 +%! 0 0 2 0 -1 3 1 +%! 0 0 0 1 0 0 1 +%! 0 1 0 0 1 0 0 +%! 0 0 0 1 0 0 1 ]; +%! +%! e = [ 0 0 1 0 0 0 0 +%! 0 0 0 0 0 1 0 +%! 0 0 0 0 0 0 1 +%! 0 0 0 0 0 0 1 +%! 0 0 0 1 0 0 0 +%! 0 0 1 0 -1 0 0 +%! 1 3 0 2 0 0 0 ]; +%! +%! b = [ 2 1 0 +%! 0 0 0 +%! 0 0 0 +%! 0 0 0 +%! 0 0 0 +%! 0 0 0 +%! 1 2 3 ]; +%! +%! c = [ 1 0 0 1 0 0 1 +%! 0 -1 1 0 -1 1 0 ]; +%! +%! tol = 0; +%! +%! [ac, ec, bc, cc, q, z, ncont] = sltg01hd (a, e, b, c, tol); +%! +%! ncont_e = 3; +%! +%! ac_e = [ 0.0000 0.0000 0.0000 0.0000 -1.2627 0.4334 0.4666 +%! 0.0000 2.0000 0.0000 -3.7417 -0.8520 0.2924 -0.4342 +%! 0.0000 0.0000 1.7862 0.3780 -0.2651 -0.7723 0.0000 +%! 0.0000 0.0000 0.0000 3.7417 0.8520 -0.2924 0.4342 +%! 0.0000 0.0000 0.0000 0.0000 -1.5540 0.5334 0.5742 +%! 0.0000 0.0000 0.0000 0.0000 -0.6533 0.2242 0.2414 +%! 0.0000 0.0000 0.0000 0.0000 -0.5892 0.2022 0.2177 ]; +%! +%! ec_e = [ -1.8325 1.0000 2.3752 0.0000 -0.8214 0.2819 1.8016 +%! 0.4887 0.0000 0.3770 -0.5345 0.1874 0.5461 0.0000 +%! -0.1728 0.0000 -0.1333 -1.1339 0.1325 0.3861 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.8520 -0.2924 0.4342 +%! 0.0000 0.0000 0.0000 0.0000 -1.0260 -0.1496 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 1.1937 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 1.0000 ]; +%! +%! bc_e = [ 1.0000 2.0000 3.0000 +%! 2.0000 1.0000 0.0000 +%! 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 ]; +%! +%! cc_e = [ 0.0000 1.0000 0.0000 0.0000 -1.2627 0.4334 0.4666 +%! 0.3665 0.0000 -0.9803 -1.6036 0.1874 0.5461 0.0000 ]; +%! +%! q_e = [ 0.0000 1.0000 0.0000 0.0000 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.7071 0.0000 0.2740 -0.6519 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.8304 0.3491 -0.4342 +%! 0.0000 0.0000 0.0000 -1.0000 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.4003 0.1683 0.9008 +%! 0.0000 0.0000 0.7071 0.0000 -0.2740 0.6519 0.0000 +%! 1.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 ]; +%! +%! z_e = [ 0.0000 1.0000 0.0000 0.0000 0.0000 0.0000 0.0000 +%! -0.6108 0.0000 0.7917 0.0000 0.0000 0.0000 0.0000 +%! 0.4887 0.0000 0.3770 -0.5345 0.1874 0.5461 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 -0.4107 0.1410 0.9008 +%! 0.6108 0.0000 0.4713 0.2673 -0.1874 -0.5461 0.0000 +%! -0.1222 0.0000 -0.0943 -0.8018 -0.1874 -0.5461 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 -0.8520 0.2924 -0.4342 ]; +%! +%!assert (ac, ac_e, 1e-4); +%!assert (ec, ec_e, 1e-4); +%!assert (bc, bc_e, 1e-4); +%!assert (cc, cc_e, 1e-4); +%!assert (q, q_e, 1e-4); +%!assert (z, z_e, 1e-4); +%!assert (ncont, ncont_e); + + +## observability staircase form of descriptor state-space models (SLICOT TG01ID) +%!shared ao, eo, bo, co, q, z, nobsv, ao_e, eo_e, bo_e, co_e, q_e, z_e, nobsv_e +%! +%! a = [ 2 0 0 0 0 0 0 +%! 0 1 0 0 0 1 0 +%! 2 0 0 2 0 0 0 +%! 0 0 1 0 1 0 1 +%! -1 1 0 -1 0 1 0 +%! 3 0 0 3 0 0 0 +%! 1 0 1 1 1 0 1 ]; +%! +%! e = [ 0 0 0 0 0 0 1 +%! 0 0 0 0 0 0 3 +%! 1 0 0 0 0 1 0 +%! 0 0 0 0 1 0 2 +%! 0 0 0 0 0 -1 0 +%! 0 1 0 0 0 0 0 +%! 0 0 1 1 0 0 0 ]; +%! +%! b = [ 1 0 +%! 0 -1 +%! 0 1 +%! 1 0 +%! 0 -1 +%! 0 1 +%! 1 0 ]; +%! +%! c = [ 2 0 0 0 0 0 1 +%! 1 0 0 0 0 0 2 +%! 0 0 0 0 0 0 3 ]; +%! +%! tol = 0; +%! +%! [ao, eo, bo, co, q, z, nobsv] = sltg01id (a, e, b, c, tol); +%! +%! nobsv_e = 3; +%! +%! ao_e = [ 0.2177 0.2414 0.5742 0.4342 0.0000 -0.4342 0.4666 +%! 0.2022 0.2242 0.5334 -0.2924 -0.7723 0.2924 0.4334 +%! -0.5892 -0.6533 -1.5540 0.8520 -0.2651 -0.8520 -1.2627 +%! 0.0000 0.0000 0.0000 3.7417 0.3780 -3.7417 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 1.7862 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 2.0000 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 ]; +%! +%! eo_e = [ 1.0000 0.0000 0.0000 0.4342 0.0000 0.0000 1.8016 +%! 0.0000 1.1937 -0.1496 -0.2924 0.3861 0.5461 0.2819 +%! 0.0000 0.0000 -1.0260 0.8520 0.1325 0.1874 -0.8214 +%! 0.0000 0.0000 0.0000 0.0000 -1.1339 -0.5345 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 -0.1333 0.3770 2.3752 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 1.0000 +%! 0.0000 0.0000 0.0000 0.0000 -0.1728 0.4887 -1.8325 ]; +%! +%! bo_e = [ 0.4666 0.0000 +%! 0.4334 0.5461 +%! -1.2627 0.1874 +%! 0.0000 -1.6036 +%! 0.0000 -0.9803 +%! 1.0000 0.0000 +%! 0.0000 0.3665 ]; +%! +%! co_e = [ 0.0000 0.0000 0.0000 0.0000 0.0000 2.0000 1.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 1.0000 2.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 3.0000 ]; +%! +%! q_e = [ 0.0000 0.0000 0.0000 0.0000 0.0000 1.0000 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.7917 0.0000 -0.6108 +%! 0.0000 0.5461 0.1874 -0.5345 0.3770 0.0000 0.4887 +%! 0.9008 0.1410 -0.4107 0.0000 0.0000 0.0000 0.0000 +%! 0.0000 -0.5461 -0.1874 0.2673 0.4713 0.0000 0.6108 +%! 0.0000 -0.5461 -0.1874 -0.8018 -0.0943 0.0000 -0.1222 +%! -0.4342 0.2924 -0.8520 0.0000 0.0000 0.0000 0.0000 ]; +%! +%! z_e = [ 0.0000 0.0000 0.0000 0.0000 0.0000 1.0000 0.0000 +%! 0.0000 -0.6519 0.2740 0.0000 0.7071 0.0000 0.0000 +%! -0.4342 0.3491 0.8304 0.0000 0.0000 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 -1.0000 0.0000 0.0000 0.0000 +%! 0.9008 0.1683 0.4003 0.0000 0.0000 0.0000 0.0000 +%! 0.0000 0.6519 -0.2740 0.0000 0.7071 0.0000 0.0000 +%! 0.0000 0.0000 0.0000 0.0000 0.0000 0.0000 1.0000 ]; +%! +%!assert (ao, ao_e, 1e-4); +%!assert (eo, eo_e, 1e-4); +%!assert (bo, bo_e, 1e-4); +%!assert (co, co_e, 1e-4); +%!assert (q, q_e, 1e-4); +%!assert (z, z_e, 1e-4); +%!assert (nobsv, nobsv_e); + + +## ss2tf conversion by Slicot TB04BD +## Test provided by Slicot +%!shared NUM, DEN, NUMe, DENe +%! A = [ -1.0 0.0 0.0 +%! 0.0 -2.0 0.0 +%! 0.0 0.0 -3.0 ]; +%! +%! B = [ 0.0 1.0 -1.0 +%! 1.0 1.0 0.0 ].'; +%! +%! C = [ 0.0 1.0 1.0 +%! 1.0 1.0 1.0 ]; +%! +%! D = [ 1.0 0.0 +%! 0.0 1.0 ]; +%! +%! [NUM, DEN] = tfdata (ss (A, B, C, D)); +%! +%! NUMe = {[1, 5, 7], [1]; [1], [1, 5, 5]}; +%! +%! DENe = {[1, 5, 6], [1, 2]; [1, 5, 6], [1, 3, 2]}; +%! +%!assert (NUM, NUMe, 1e-4); +%!assert (DEN, DENe, 1e-4); + + +## ss2tf conversion by Slicot TB04BD +## Trivial test +%!shared NUM, DEN, NUMe, DENe +%! A = [ 0 ]; +%! +%! B = [ 1 ]; +%! +%! C = [ 1 ]; +%! +%! D = [ 0 ]; +%! +%! [NUM, DEN] = tfdata (ss (A, B, C, D)); +%! +%! NUMe = {[1]}; +%! +%! DENe = {[1, 0]}; +%! +%!assert (NUM, NUMe, 1e-4); +%!assert (DEN, DENe, 1e-4); + + +## transfer function to state-space conversion +## test from SLICOT TD04AD +%!shared Mo, Me +%! INDEX = [ 3 3 ]; +%! +%! DCOEFF = [ 1.0 6.0 11.0 6.0 +%! 1.0 6.0 11.0 6.0 ]; +%! +%! UCOEFF = zeros (2, 2, 4); +%! +%! u11 = [ 1.0 6.0 12.0 7.0 ]; +%! u12 = [ 0.0 1.0 4.0 3.0 ]; +%! u21 = [ 0.0 0.0 1.0 1.0 ]; +%! u22 = [ 1.0 8.0 20.0 15.0 ]; +%! +%! UCOEFF(1,1,:) = u11; +%! UCOEFF(1,2,:) = u12; +%! UCOEFF(2,1,:) = u21; +%! UCOEFF(2,2,:) = u22; +%! +%! [Ao, Bo, Co, Do] = sltd04ad (UCOEFF, DCOEFF, INDEX, 0); +%! +%! Ae = [ 0.5000 -0.8028 0.9387 +%! 4.4047 -2.3380 2.5076 +%! -5.5541 1.6872 -4.1620 ]; +%! +%! Be = [ -0.2000 -1.2500 +%! 0.0000 -0.6097 +%! 0.0000 2.2217 ]; +%! +%! Ce = [ 0.0000 -0.8679 0.2119 +%! 0.0000 0.0000 0.9002 ]; +%! +%! De = [ 1.0000 0.0000 +%! 0.0000 1.0000 ]; +%! +%! Mo = [Ao, Bo; Co, Do]; +%! Me = [Ae, Be; Ce, De]; +%! +%!assert (Mo, Me, 1e-4); diff --git a/octave_packages/control-2.3.52/lyap.m b/octave_packages/control-2.3.52/lyap.m new file mode 100644 index 0000000..9052a5b --- /dev/null +++ b/octave_packages/control-2.3.52/lyap.m @@ -0,0 +1,177 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{x} =} lyap (@var{a}, @var{b}) +## @deftypefnx{Function File} {@var{x} =} lyap (@var{a}, @var{b}, @var{c}) +## @deftypefnx{Function File} {@var{x} =} lyap (@var{a}, @var{b}, @var{[]}, @var{e}) +## Solve continuous-time Lyapunov or Sylvester equations. +## +## @strong{Equations} +## @example +## @group +## AX + XA' + B = 0 (Lyapunov Equation) +## +## AX + XB + C = 0 (Sylvester Equation) +## +## AXE' + EXA' + B = 0 (Generalized Lyapunov Equation) +## @end group +## @end example +## +## @strong{Algorithm}@* +## Uses SLICOT SB03MD, SB04MD and SG03AD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## +## @seealso{lyapchol, dlyap, dlyapchol} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: January 2010 +## Version: 0.2.1 + +function [x, scale] = lyap (a, b, c, e) + + scale = 1; + + switch (nargin) + case 2 # Lyapunov equation + + if (! is_real_square_matrix (a, b)) + ## error ("lyap: a, b must be real and square"); + error ("lyap: %s, %s must be real and square", \ + inputname (1), inputname (2)); + endif + + if (rows (a) != rows (b)) + ## error ("lyap: a, b must have the same number of rows"); + error ("lyap: %s, %s must have the same number of rows", \ + inputname (1), inputname (2)); + + endif + + [x, scale] = slsb03md (a, -b, false); # AX + XA' = -B + + ## x /= scale; # 0 < scale <= 1 + + case 3 # Sylvester equation + + if (! is_real_square_matrix (a, b)) + ## error ("lyap: a, b must be real and square"); + error ("lyap: %s, %s must be real and square", \ + inputname (1), inputname (2)); + endif + + if (! is_real_matrix (c) || rows (c) != rows (a) || columns (c) != columns (b)) + ## error ("lyap: c must be a real (%dx%d) matrix", rows (a), columns (b)); + error ("lyap: %s must be a real (%dx%d) matrix", \ + rows (a), columns (b), inputname (3)); + endif + + x = slsb04md (a, b, -c); # AX + XB = -C + + case 4 # generalized Lyapunov equation + + if (! isempty (c)) + print_usage (); + endif + + if (! is_real_square_matrix (a, b, e)) + ## error ("lyap: a, b, e must be real and square"); + error ("lyap: %s, %s, %s must be real and square", \ + inputname (1), inputname (2), inputname (4)); + endif + + if (rows (b) != rows (a) || rows (e) != rows (a)) + ## error ("lyap: a, b, e must have the same number of rows"); + error ("lyap: %s, %s, %s must have the same number of rows", \ + inputname (1), inputname (2), inputname (4)); + endif + + if (! issymmetric (b)) + ## error ("lyap: b must be symmetric"); + error ("lyap: %s must be symmetric", \ + inputname (2)); + endif + + [x, scale] = slsg03ad (a, e, -b, false); # AXE' + EXA' = -B + + ## x /= scale; # 0 < scale <= 1 + + otherwise + print_usage (); + + endswitch + + if (scale < 1) + warning ("lyap: solution scaled by %g to prevent overflow", scale); + endif + +endfunction + + +## Lyapunov +%!shared X, X_exp +%! A = [1, 2; -3, -4]; +%! Q = [3, 1; 1, 1]; +%! X = lyap (A, Q); +%! X_exp = [ 6.1667, -3.8333; +%! -3.8333, 3.0000]; +%!assert (X, X_exp, 1e-4); + +## Sylvester +%!shared X, X_exp +%! A = [2.0 1.0 3.0 +%! 0.0 2.0 1.0 +%! 6.0 1.0 2.0]; +%! +%! B = [2.0 1.0 +%! 1.0 6.0]; +%! +%! C = [2.0 1.0 +%! 1.0 4.0 +%! 0.0 5.0]; +%! +%! X = lyap (A, B, -C); +%! +%! X_exp = [-2.7685 0.5498 +%! -1.0531 0.6865 +%! 4.5257 -0.4389]; +%! +%!assert (X, X_exp, 1e-4); + +## Generalized Lyapunov +%!shared X, X_exp +%! A = [ 3.0 1.0 1.0 +%! 1.0 3.0 0.0 +%! 1.0 0.0 2.0]; +%! +%! E = [ 1.0 3.0 0.0 +%! 3.0 2.0 1.0 +%! 1.0 0.0 1.0]; +%! +%! B = [-64.0 -73.0 -28.0 +%! -73.0 -70.0 -25.0 +%! -28.0 -25.0 -18.0]; +%! +%! X = lyap (A.', -B, [], E.'); +%! +%! X_exp = [-2.0000 -1.0000 0.0000 +%! -1.0000 -3.0000 -1.0000 +%! 0.0000 -1.0000 -3.0000]; +%! +%!assert (X, X_exp, 1e-4); + diff --git a/octave_packages/control-2.3.52/lyapchol.m b/octave_packages/control-2.3.52/lyapchol.m new file mode 100644 index 0000000..4161108 --- /dev/null +++ b/octave_packages/control-2.3.52/lyapchol.m @@ -0,0 +1,154 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{u} =} lyapchol (@var{a}, @var{b}) +## @deftypefnx{Function File} {@var{u} =} lyapchol (@var{a}, @var{b}, @var{e}) +## Compute Cholesky factor of continuous-time Lyapunov equations. +## +## @strong{Equations} +## @example +## @group +## A U' U + U' U A' + B B' = 0 (Lyapunov Equation) +## +## A U' U E' + E U' U A' + B B' = 0 (Generalized Lyapunov Equation) +## @end group +## @end example +## +## @strong{Algorithm}@* +## Uses SLICOT SB03OD and SG03BD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## +## @seealso{lyap, dlyap, dlyapchol} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: January 2010 +## Version: 0.2.1 + +function [u, scale] = lyapchol (a, b, e) + + switch (nargin) + case 2 + + if (! is_real_square_matrix (a)) + ## error ("lyapchol: a must be real and square"); + error ("lyapchol: %s must be real and square", \ + inputname (1)); + endif + + if (! is_real_matrix (b)) + ## error ("lyapchol: b must be real") + error ("lyapchol: %s must be real", \ + inputname (2)) + endif + + if (rows (a) != rows (b)) + ## error ("lyapchol: a and b must have the same number of rows"); + error ("lyapchol: %s and %s must have the same number of rows", \ + inputname (1), inputname (2)); + endif + + [u, scale] = slsb03od (a.', b.', false); + + ## NOTE: TRANS = 'T' not suitable because we need U' U, not U U' + + case 3 + + if (! is_real_square_matrix (a, e)) + ## error ("lyapchol: a, e must be real and square"); + error ("lyapchol: %s, %s must be real and square", \ + inputname (1), inputname (3)); + endif + + if (! is_real_matrix (b)) + ## error ("lyapchol: b must be real"); + error ("lyapchol: %s must be real", \ + inputname (2)); + endif + + if (rows (b) != rows (a) || rows (e) != rows (a)) + ## error ("lyapchol: a, b, e must have the same number of rows"); + error ("lyapchol: %s, %s, %s must have the same number of rows", \ + inputname (1), inputname (2), inputname (3)); + endif + + [u, scale] = slsg03bd (a.', e.', b.', false); + + ## NOTE: TRANS = 'T' not suitable because we need U' U, not U U' + + otherwise + print_usage (); + + endswitch + + if (scale < 1) + warning ("lyapchol: solution scaled by %g to prevent overflow", scale); + endif + +endfunction + + +%!shared U, U_exp, X, X_exp +%! +%! A = [ -1.0 37.0 -12.0 -12.0 +%! -1.0 -10.0 0.0 4.0 +%! 2.0 -4.0 7.0 -6.0 +%! 2.0 2.0 7.0 -9.0 ].'; +%! +%! B = [ 1.0 2.5 1.0 3.5 +%! 0.0 1.0 0.0 1.0 +%! -1.0 -2.5 -1.0 -1.5 +%! 1.0 2.5 4.0 -5.5 +%! -1.0 -2.5 -4.0 3.5 ].'; +%! +%! U = lyapchol (A, B); +%! +%! X = U.' * U; # use lyap at home! +%! +%! U_exp = [ 1.0000 0.0000 0.0000 0.0000 +%! 3.0000 1.0000 0.0000 0.0000 +%! 2.0000 -1.0000 1.0000 0.0000 +%! -1.0000 1.0000 -2.0000 1.0000 ].'; +%! +%! X_exp = [ 1.0000 3.0000 2.0000 -1.0000 +%! 3.0000 10.0000 5.0000 -2.0000 +%! 2.0000 5.0000 6.0000 -5.0000 +%! -1.0000 -2.0000 -5.0000 7.0000 ]; +%! +%!assert (U, U_exp, 1e-4); +%!assert (X, X_exp, 1e-4); + +%!shared U, U_exp, X, X_exp +%! +%! A = [ -1.0 3.0 -4.0 +%! 0.0 5.0 -2.0 +%! -4.0 4.0 1.0 ].'; +%! +%! E = [ 2.0 1.0 3.0 +%! 2.0 0.0 1.0 +%! 4.0 5.0 1.0 ].'; +%! +%! B = [ 2.0 -1.0 7.0 ].'; +%! +%! U = lyapchol (A, B, E); +%! +%! U_exp = [ 1.6003 -0.4418 -0.1523 +%! 0.0000 0.6795 -0.2499 +%! 0.0000 0.0000 0.2041 ]; +%! +%!assert (U, U_exp, 1e-4); diff --git a/octave_packages/control-2.3.52/margin.m b/octave_packages/control-2.3.52/margin.m new file mode 100644 index 0000000..b1c0a4e --- /dev/null +++ b/octave_packages/control-2.3.52/margin.m @@ -0,0 +1,437 @@ +## Copyright (C) 2009, 2010, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{gamma}, @var{phi}, @var{w_gamma}, @var{w_phi}] =} margin (@var{sys}) +## @deftypefnx{Function File} {[@var{gamma}, @var{phi}, @var{w_gamma}, @var{w_phi}] =} margin (@var{sys}, @var{tol}) +## Gain and phase margin of a system. If no output arguments are given, both gain and phase margin +## are plotted on a bode diagram. Otherwise, the margins and their corresponding frequencies are +## computed and returned. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. Must be a single-input and single-output (SISO) system. +## @item tol +## Imaginary parts below @var{tol} are assumed to be zero. +## If not specified, default value @code{sqrt (eps)} is taken. +## @end table +## +## @strong{Outputs} +## @table @var +## @item gamma +## Gain margin (as gain, not dBs). +## @item phi +## Phase margin (in degrees). +## @item w_gamma +## Frequency for the gain margin (in rad/s). +## @item w_phi +## Frequency for the phase margin (in rad/s). +## @end table +## +## @strong{Equations} +## @example +## @group +## CONTINUOUS SYSTEMS +## Gain Margin +## _ _ +## L(jw) = L(jw) BTW: L(jw) = L(-jw) = conj (L(jw)) +## +## num(jw) num(-jw) +## ------- = -------- +## den(jw) den(-jw) +## +## num(jw) den(-jw) = num(-jw) den(jw) +## +## imag (num(jw) den(-jw)) = 0 +## imag (num(-jw) den(jw)) = 0 +## @end group +## @end example +## @example +## @group +## Phase Margin +## |num(jw)| +## |L(jw)| = |-------| = 1 +## |den(jw)| +## _ 2 2 +## z z = Re z + Im z +## +## num(jw) num(-jw) +## ------- * -------- = 1 +## den(jw) den(-jw) +## +## num(jw) num(-jw) - den(jw) den(-jw) = 0 +## +## real (num(jw) num(-jw) - den(jw) den(-jw)) = 0 +## @end group +## @end example +## @example +## @group +## DISCRETE SYSTEMS +## Gain Margin +## jwT log z +## L(z) = L(1/z) BTW: z = e --> w = ----- +## j T +## num(z) num(1/z) +## ------ = -------- +## den(z) den(1/z) +## +## num(z) den(1/z) - num(1/z) den(z) = 0 +## @end group +## @end example +## @example +## @group +## Phase Margin +## |num(z)| +## |L(z)| = |------| = 1 +## |den(z)| +## +## L(z) L(1/z) = 1 +## +## num(z) num(1/z) +## ------ * -------- = 1 +## den(z) den(1/z) +## +## num(z) num(1/z) - den(z) den(1/z) = 0 +## @end group +## @end example +## @example +## @group +## PS: How to get L(1/z) +## 4 3 2 +## p(z) = a z + b z + c z + d z + e +## +## -4 -3 -2 -1 +## p(1/z) = a z + b z + c z + d z + e +## +## -4 2 3 4 +## = z ( a + b z + c z + d z + e z ) +## +## 4 3 2 4 +## = ( e z + d z + c z + b z + a ) / ( z ) +## @end group +## @end example +## +## @seealso{roots} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: July 2009 +## Version: 0.9.1 + +function [gamma_r, phi_r, w_gamma_r, w_phi_r] = margin (sys, tol = sqrt (eps)) + + ## TODO: multiplot feature: margin (sys1, "b", sys2, "r", ...) + + ## check whether arguments are OK + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (! isa (sys, "lti")) + error ("margin: argument sys must be an LTI system"); + endif + + if (! issiso (sys)) + error ("margin: argument sys must be a SISO system"); + endif + + ## get transfer function + [num, den, tsam] = tfdata (sys, "vector"); + continuous = isct (sys); + tsam = abs (tsam); # use 1 second as default if tsam == -1 + + + if (continuous) # CONTINUOUS SYSTEM + + ## create polynomials s -> jw + l_num = length (num); + l_den = length (den); + + num_jw = num .* i.^(l_num-1 : -1 : 0); + den_jw = den .* i.^(l_den-1 : -1 : 0); + + ## GAIN MARGIN + ## create gm polynomial + gm_poly = imag (conv (num_jw, conj (den_jw))); + + ## find frequencies w + w = roots (gm_poly); + + ## filter results + [gamma, w_gamma] = gm_filter (w, num, den, tsam, tol, continuous); + + ## PHASE MARGIN + ## create pm polynomials + poly_1 = conv (num_jw, conj (num_jw)); + poly_2 = conv (den_jw, conj (den_jw)); + + ## make polynomials equally long for subtraction + [poly_1, poly_2] = poly_equalizer (poly_1, poly_2); + + ## subtract polynomials + pm_poly = real (poly_1 - poly_2); + + ## find frequencies w + w = roots (pm_poly); + + ## filter results + [phi, w_phi] = pm_filter (w, num, den, tsam, tol, continuous); + + + else # DISCRETE SYSTEM + + ## create polynomials z -> 1/z + l_num = length (num); + l_den = length (den); + + num_rev = fliplr (num); + den_rev = fliplr (den); + + num_div = zeros (1, l_num); + den_div = zeros (1, l_den); + num_div(1) = 1; + den_div(1) = 1; + + num_inv = conv (num_rev, den_div); + den_inv = conv (den_rev, num_div); + + ## GAIN MARGIN + ## create gm polynomial + poly_1 = conv (num, den_inv); + poly_2 = conv (num_inv, den); + + ## make polynomials equally long for subtraction + [poly_1, poly_2] = poly_equalizer (poly_1, poly_2); + + ## subtract polynomials + gm_poly = poly_1 - poly_2; + + ## find frequencies z + z = roots (gm_poly); + + ## filter results + idx = find (abs (abs (z) - 1) < tol); # find z with magnitude 1 + + if (length (idx) > 0) # if z with magnitude 1 exist + z_gm = z(idx); + w = log (z_gm) / (i*tsam); # get frequencies w from z + [gamma, w_gamma] = gm_filter (w, num, den, tsam, tol, continuous); + else # there are no z with magnitude 1 + gamma = Inf; + w_gamma = NaN; + endif + + ## PHASE MARGIN + ## create pm polynomials + poly_1 = conv (num, num_inv); + poly_2 = conv (den, den_inv); + + ## make polynomials equally long for subtraction + [poly_1, poly_2] = poly_equalizer (poly_1, poly_2); + + ## subtract polynomials + pm_poly = poly_1 - poly_2; + + ## find frequencies z + z = roots (pm_poly); + + ## filter results + idx = find (abs (abs (z) - 1) < tol); # find z with magnitude 1 + + if (length (idx) > 0) # if z with magnitude 1 exist + z_gm = z(idx); + w = log (z_gm) / (i*tsam); # get frequencies w from z + [phi, w_phi] = pm_filter (w, num, den, tsam, tol, continuous); + else # there are no z with magnitude 1 + phi = 180; + w_phi = NaN; + endif + + endif + + + if (nargout == 0) # show bode diagram + + [H, w] = __frequency_response__ (sys, [], false, 0, "std"); + + H = reshape (H, [], 1); + mag_db = 20 * log10 (abs (H)); + pha = unwrap (arg (H)) * 180 / pi; + gamma_db = 20 * log10 (gamma); + + wv = [min(w), max(w)]; + ax_vec_mag = __axis_limits__ ([w(:), mag_db(:)]); + ax_vec_mag(1:2) = wv; + ax_vec_pha = __axis_limits__ ([w(:), pha(:)]); + ax_vec_pha(1:2) = wv; + + wgm = [w_gamma, w_gamma]; + mgmh = [-gamma_db, ax_vec_mag(3)]; + mgm = [0, -gamma_db]; + pgm = [ax_vec_pha(4), -180]; + + wpm = [w_phi, w_phi]; + mpm = [0, ax_vec_mag(3)]; + ppmh = [ax_vec_pha(4), phi - 180]; + ppm = [phi - 180, -180]; + + title_str = sprintf ("GM = %g dB (at %g rad/s), PM = %g deg (at %g rad/s)", + gamma_db, w_gamma, phi, w_phi); + if (continuous) + xl_str = "Frequency [rad/s]"; + else + xl_str = sprintf ("Frequency [rad/s] w_N = %g", pi/tsam); + endif + + subplot (2, 1, 1) + semilogx (w, mag_db, "b", wv, [0, 0], ":k", wgm, mgmh, ":k", wgm, mgm, "r", wpm, mpm, ":k") + axis (ax_vec_mag) + grid ("on") + title (title_str) + ylabel ("Magnitude [dB]") + + subplot (2, 1, 2) + semilogx (w, pha, "b", wv, [-180, -180], ":k", wgm, pgm, ":k", wpm, ppmh, ":k", wpm, ppm, "r") + axis (ax_vec_pha) + grid ("on") + xlabel (xl_str) + ylabel ("Phase [deg]") + + else # return values + gamma_r = gamma; + phi_r = phi; + w_gamma_r = w_gamma; + w_phi_r = w_phi; + endif + +endfunction + + +function [poly_eq_1, poly_eq_2] = poly_equalizer (poly_1, poly_2) + + l_p1 = length (poly_1); + l_p2 = length (poly_2); + l_max = max (l_p1, l_p2); + + lead_zer_1 = zeros (1, l_max - l_p1); + lead_zer_2 = zeros (1, l_max - l_p2); + + poly_eq_1 = horzcat (lead_zer_1, poly_1); + poly_eq_2 = horzcat (lead_zer_2, poly_2); + +endfunction + + +function [gamma, w_gamma] = gm_filter (w, num, den, tsam, tol, continuous) + + idx = find ((abs (imag (w)) < tol) & (real (w) > 0)); # find frequencies in R+ + + if (length (idx) > 0) # if frequencies in R+ exist + w_gm = real (w(idx)); + + if (continuous) + s = i * w_gm; + else + s = exp (i * w_gm * tsam); + endif + + f_resp = polyval (num, s) ./ polyval (den, s); + gm = (abs (f_resp)).^-1; + + ## find crossings between 0 and -1 + idx = find ((real (f_resp) < 0) & (real (f_resp) >= -1)); + + if (length (idx) > 0) # if crossings between 0 and -1 exist + gm = gm(idx); + w_gm = w_gm(idx); + [gamma, idx] = min (gm); + w_gamma = w_gm(idx); + else # there are no crossings between 0 and -1 + idx = find (real (f_resp) < -1); # find crossings between -1 and -Inf + + if (length (idx) > 0) # if crossings between -1 and -Inf exist + gm = gm(idx); + w_gm = w_gm(idx); + [gamma, idx] = max (gm); + w_gamma = w_gm(idx); + else + gamma = Inf; + w_gamma = NaN; + endif + endif + else # there are no frequencies in R+ + gamma = Inf; + w_gamma = NaN; + endif + +endfunction + + +function [phi, w_phi] = pm_filter (w, num, den, tsam, tol, continuous) + + idx = find ((abs (imag (w)) < tol) & (real (w) > 0)); # find frequencies in R+ + + if (length (idx) > 0) # if frequencies in R+ exist + w_pm = real (w(idx)); + + if (continuous) + s = i * w_pm; + else + s = exp (i * w_pm * tsam); + endif + + f_resp = polyval (num, s) ./ polyval (den, s); + pm = 180 + arg (f_resp) ./ pi .* 180; + + [phi, idx] = min (pm); + w_phi = w_pm(idx); + else # there are no frequencies in R+ + phi = 180; + w_phi = NaN; + endif + +endfunction + + +%!shared margin_c, margin_c_exp, margin_d, margin_d_exp +%! sysc = tf ([24], [1, 6, 11, 6]); +%! [gamma_c, phi_c, w_gamma_c, w_phi_c] = margin (sysc); +%! sysd = c2d (sysc, 0.3); +%! [gamma_d, phi_d, w_gamma_d, w_phi_d] = margin (sysd); +%! +%! margin_c = [gamma_c, phi_c, w_gamma_c, w_phi_c]; +%! margin_d = [gamma_d, phi_d, w_gamma_d, w_phi_d]; +%! +%! ## results from this implementation and the "dark side" diverge +%! ## from the third digit after the decimal point on +%! +%! gamma_c_exp = 2.50; +%! phi_c_exp = 35.43; +%! w_gamma_c_exp = 3.32; +%! w_phi_c_exp = 2.06; +%! +%! gamma_d_exp = 1.41; +%! phi_d_exp = 18.60; +%! w_gamma_d_exp = 2.48; +%! w_phi_d_exp = 2.04; +%! +%! margin_c_exp = [gamma_c_exp, phi_c_exp, w_gamma_c_exp, w_phi_c_exp]; +%! margin_d_exp = [gamma_d_exp, phi_d_exp, w_gamma_d_exp, w_phi_d_exp]; +%! +%!assert (margin_c, margin_c_exp, 1e-2); +%!assert (margin_d, margin_d_exp, 1e-2); diff --git a/octave_packages/control-2.3.52/mixsyn.m b/octave_packages/control-2.3.52/mixsyn.m new file mode 100644 index 0000000..10b7458 --- /dev/null +++ b/octave_packages/control-2.3.52/mixsyn.m @@ -0,0 +1,162 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{K}, @var{N}, @var{gamma}, @var{rcond}] =} mixsyn (@var{G}, @var{W1}, @var{W2}, @var{W3}, @dots{}) +## Solve stacked S/KS/T H-infinity problem. Bound the largest singular values +## of @var{S} (for performance), @var{K S} (to penalize large inputs) and +## @var{T} (for robustness and to avoid sensitivity to noise). +## In other words, the inputs r are excited by a harmonic test signal. +## Then the algorithm tries to find a controller @var{K} which minimizes +## the H-infinity norm calculated from the outputs z. +## +## @strong{Inputs} +## @table @var +## @item G +## LTI model of plant. +## @item W1 +## LTI model of performance weight. Bounds the largest singular values of sensitivity @var{S}. +## Model must be empty @code{[]}, SISO or of appropriate size. +## @item W2 +## LTI model to penalize large control inputs. Bounds the largest singular values of @var{KS}. +## Model must be empty @code{[]}, SISO or of appropriate size. +## @item W3 +## LTI model of robustness and noise sensitivity weight. Bounds the largest singular values of +## complementary sensitivity @var{T}. Model must be empty @code{[]}, SISO or of appropriate size. +## @item @dots{} +## Optional arguments of @command{hinfsyn}. Type @command{help hinfsyn} for more information. +## @end table +## +## All inputs must be proper/realizable. +## Scalars, vectors and matrices are possible instead of LTI models. +## +## @strong{Outputs} +## @table @var +## @item K +## State-space model of the H-infinity (sub-)optimal controller. +## @item N +## State-space model of the lower LFT of @var{P} and @var{K}. +## @item gamma +## L-infinity norm of @var{N}. +## @item rcond +## Vector @var{rcond} contains estimates of the reciprocal condition +## numbers of the matrices which are to be inverted and +## estimates of the reciprocal condition numbers of the +## Riccati equations which have to be solved during the +## computation of the controller @var{K}. For details, +## see the description of the corresponding SLICOT algorithm. +## @end table +## +## @strong{Block Diagram} +## @example +## @group +## +## | W1 S | +## gamma = min||N(K)|| N = | W2 K S | = lft (P, K) +## K inf | W3 T | +## @end group +## @end example +## @example +## @group +## +------+ z1 +## +---------------------------------------->| W1 |-----> +## | +------+ +## | +------+ z2 +## | +---------------------->| W2 |-----> +## | | +------+ +## r + e | +--------+ u | +--------+ y +------+ z3 +## ----->(+)---+-->| K(s) |----+-->| G(s) |----+---->| W3 |-----> +## ^ - +--------+ +--------+ | +------+ +## | | +## +----------------------------------------+ +## @end group +## @end example +## @example +## @group +## +--------+ +## | |-----> z1 (p1x1) z1 = W1 e +## r (px1) ----->| P(s) |-----> z2 (p2x1) z2 = W2 u +## | |-----> z3 (p3x1) z3 = W3 y +## u (mx1) ----->| |-----> e (px1) e = r - y +## +--------+ +## @end group +## @end example +## @example +## @group +## +--------+ +## r ----->| |-----> z +## | P(s) | +## u +---->| |-----+ e +## | +--------+ | +## | | +## | +--------+ | +## +-----| K(s) |<----+ +## +--------+ +## @end group +## @end example +## @example +## @group +## +--------+ +## r ----->| N(s) |-----> z +## +--------+ +## @end group +## @end example +## @example +## @group +## Extended Plant: P = augw (G, W1, W2, W3) +## Controller: K = mixsyn (G, W1, W2, W3) +## Entire System: N = lft (P, K) +## Open Loop: L = G * K +## Closed Loop: T = feedback (L) +## @end group +## @end example +## @example +## @group +## Reference: +## Skogestad, S. and Postlethwaite I. +## Multivariable Feedback Control: Analysis and Design +## Second Edition +## Wiley 2005 +## Chapter 3.8: General Control Problem Formulation +## @end group +## @end example +## +## @strong{Algorithm}@* +## Relies on commands @command{augw} and @command{hinfsyn}, +## which use SLICOT SB10FD and SB10DD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## +## @seealso{hinfsyn, augw} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: December 2009 +## Version: 0.1 + +function [K, N, gamma, rcond] = mixsyn (G, W1 = [], W2 = [], W3 = [], varargin) + + if (nargin == 0) + print_usage (); + endif + + [p, m] = size (G); + + P = augw (G, W1, W2, W3); + + [K, N, gamma, rcond] = hinfsyn (P, p, m, varargin{:}); + +endfunction diff --git a/octave_packages/control-2.3.52/ncfsyn.m b/octave_packages/control-2.3.52/ncfsyn.m new file mode 100644 index 0000000..05a10b0 --- /dev/null +++ b/octave_packages/control-2.3.52/ncfsyn.m @@ -0,0 +1,503 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{K}, @var{N}, @var{gamma}, @var{info}] =} ncfsyn (@var{G}, @var{W1}, @var{W2}, @var{factor}) +## Loop shaping H-infinity synthesis. Compute positive feedback controller using +## the McFarlane/Glover normalized coprime factor (NCF) loop shaping design procedure. +## +## @strong{Inputs} +## @table @var +## @item G +## LTI model of plant. +## @item W1 +## LTI model of precompensator. Model must be SISO or of appropriate size. +## An identity matrix is taken if @var{W1} is not specified or if an empty model +## @code{[]} is passed. +## @item W2 +## LTI model of postcompensator. Model must be SISO or of appropriate size. +## An identity matrix is taken if @var{W2} is not specified or if an empty model +## @code{[]} is passed. +## @item factor +## @code{factor = 1} implies that an optimal controller is required. +## @code{factor > 1} implies that a suboptimal controller is required, +## achieving a performance that is @var{factor} times less than optimal. +## Default value is 1. +## @end table +## +## @strong{Outputs} +## @table @var +## @item K +## State-space model of the H-infinity loop-shaping controller. +## @item N +## State-space model of the closed loop depicted below. +## @item gamma +## L-infinity norm of @var{N}. @code{gamma = norm (N, inf)}. +## @item info +## Structure containing additional information. +## @item info.emax +## Nugap robustness. @code{emax = inv (gamma)}. +## @item info.Gs +## Shaped plant. @code{Gs = W2 * G * W1}. +## @item info.Ks +## Controller for shaped plant. @code{Ks = ncfsyn (Gs)}. +## @item info.rcond +## Estimates of the reciprocal condition numbers of the Riccati equations +## and a few other things. For details, see the description of the +## corresponding SLICOT algorithm. +## @end table +## +## @strong{Block Diagram of N} +## @example +## @group +## +## ^ z1 ^ z2 +## | | +## w1 + | +--------+ | +--------+ +## ----->(+)---+-->| Ks |----+--->(+)---->| Gs |----+ +## ^ + +--------+ ^ +--------+ | +## | w2 | | +## | | +## +-------------------------------------------------+ +## @end group +## @end example +## +## @strong{Algorithm}@* +## Uses SLICOT SB10ID, SB10KD and SB10ZD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: July 2011 +## Version: 0.1 + +function [K, varargout] = ncfsyn (G, W1 = [], W2 = [], factor = 1.0) + + if (nargin == 0 || nargin > 4) + print_usage (); + endif + + if (! isa (G, "lti")) + error ("ncfsyn: first argument must be an LTI system"); + endif + + if (! is_real_scalar (factor) || factor < 1.0) + error ("ncfsyn: fourth argument invalid"); + endif + + [p, m] = size (G); + + W1 = __adjust_weighting__ (W1, m); + W2 = __adjust_weighting__ (W2, p); + + Gs = W2 * G * W1; # shaped plant + + [a, b, c, d, tsam] = ssdata (Gs); + + ## synthesis + if (isct (Gs)) # continuous-time + [ak, bk, ck, dk, rcond] = slsb10id (a, b, c, d, factor); + elseif (any (d(:))) # discrete-time, d != 0 + [ak, bk, ck, dk, rcond] = slsb10zd (a, b, c, d, factor, 0.0); + else # discrete-time, d == 0 + [ak, bk, ck, dk, rcond] = slsb10kd (a, b, c, factor); + endif + + ## controller + Ks = ss (ak, bk, ck, dk, tsam); + + K = W1 * Ks * W2; + + if (nargout > 1) + ## FIXME: is this really the same thing as the dark side does? + N = append (eye (p), Ks, Gs); + M = [zeros(p,p), zeros(p,m), eye(p); + eye(p), zeros(p,m), zeros(p,p); + zeros(m,p), eye(m), zeros(m,p)]; + in_idx = [1:p, 2*p+(1:m)]; + out_idx = 1:p+m; + N = mconnect (N, M, in_idx, out_idx); + varargout{1} = N; + if (nargout > 2) + gamma = norm (N, inf); + varargout{2} = gamma; + if (nargout > 3) + varargout{3} = struct ("emax", inv (gamma), "Gs", Gs, "Ks", Ks, "rcond", rcond); + endif + endif + endif + +endfunction + + +function W = __adjust_weighting__ (W, s) + + if (isempty (W)) + W = ss (eye (s)); + else + W = ss (W); + ## if (! isstable (W)) + ## error ("ncfsyn: %s must be stable", inputname (1)); + ## endif + ## if (! isminimumphase (W)) + ## error ("ncfsyn: %s must be minimum-phase", inputname (1)); + ## endif + [p, m] = size (W); + if (m == s && p == s) # model is of correct size + return; + elseif (m == 1 && p == 1) # model is SISO + tmp = W; + for k = 2 : s + W = append (W, tmp); # stack SISO model s times + endfor + else # model is invalid + error ("ncfsyn: %s must have 1 or %d inputs and outputs", inputname (1), s); + endif + endif + +endfunction + + +## continuous-time case, direct access to sb10id +%!shared AK, BK, CK, DK, RCOND, AKe, BKe, CKe, DKe, RCONDe +%! A = [ -1.0 0.0 4.0 5.0 -3.0 -2.0 +%! -2.0 4.0 -7.0 -2.0 0.0 3.0 +%! -6.0 9.0 -5.0 0.0 2.0 -1.0 +%! -8.0 4.0 7.0 -1.0 -3.0 0.0 +%! 2.0 5.0 8.0 -9.0 1.0 -4.0 +%! 3.0 -5.0 8.0 0.0 2.0 -6.0 ]; +%! +%! B = [ -3.0 -4.0 +%! 2.0 0.0 +%! -5.0 -7.0 +%! 4.0 -6.0 +%! -3.0 9.0 +%! 1.0 -2.0 ]; +%! +%! C = [ 1.0 -1.0 2.0 -4.0 0.0 -3.0 +%! -3.0 0.0 5.0 -1.0 1.0 1.0 +%! -7.0 5.0 0.0 -8.0 2.0 -2.0 ]; +%! +%! D = [ 1.0 -2.0 +%! 0.0 4.0 +%! 5.0 -3.0 ]; +%! +%! FACTOR = 1.0; +%! +%! [AK, BK, CK, DK, RCOND] = slsb10id (A, B, C, D, FACTOR); +%! +%! AKe = [ -39.0671 9.9293 22.2322 -27.4113 43.8655 +%! -6.6117 3.0006 11.0878 -11.4130 15.4269 +%! 33.6805 -6.6934 -23.9953 14.1438 -33.4358 +%! -32.3191 9.7316 25.4033 -24.0473 42.0517 +%! -44.1655 18.7767 34.8873 -42.4369 50.8437 ]; +%! +%! BKe = [ -10.2905 -16.5382 -10.9782 +%! -4.3598 -8.7525 -5.1447 +%! 6.5962 1.8975 6.2316 +%! -9.8770 -14.7041 -11.8778 +%! -9.6726 -22.7309 -18.2692 ]; +%! +%! CKe = [ -0.6647 -0.0599 -1.0376 0.5619 1.7297 +%! -8.4202 3.9573 7.3094 -7.6283 10.6768 ]; +%! +%! DKe = [ 0.8466 0.4979 -0.6993 +%! -1.2226 -4.8689 -4.5056 ]; +%! +%! RCONDe = [ 0.13861D-01 0.90541D-02 ].'; +%! +%!assert (AK, AKe, 1e-4); +%!assert (BK, BKe, 1e-4); +%!assert (CK, CKe, 1e-4); +%!assert (DK, DKe, 1e-4); +%!assert (RCOND, RCONDe, 1e-4); + + +## continuous-time case +%!shared AK, BK, CK, DK, RCOND, AKe, BKe, CKe, DKe, RCONDe +%! A = [ -1.0 0.0 4.0 5.0 -3.0 -2.0 +%! -2.0 4.0 -7.0 -2.0 0.0 3.0 +%! -6.0 9.0 -5.0 0.0 2.0 -1.0 +%! -8.0 4.0 7.0 -1.0 -3.0 0.0 +%! 2.0 5.0 8.0 -9.0 1.0 -4.0 +%! 3.0 -5.0 8.0 0.0 2.0 -6.0 ]; +%! +%! B = [ -3.0 -4.0 +%! 2.0 0.0 +%! -5.0 -7.0 +%! 4.0 -6.0 +%! -3.0 9.0 +%! 1.0 -2.0 ]; +%! +%! C = [ 1.0 -1.0 2.0 -4.0 0.0 -3.0 +%! -3.0 0.0 5.0 -1.0 1.0 1.0 +%! -7.0 5.0 0.0 -8.0 2.0 -2.0 ]; +%! +%! D = [ 1.0 -2.0 +%! 0.0 4.0 +%! 5.0 -3.0 ]; +%! +%! FACTOR = 1.0; +%! +%! G = ss (A, B, C, D); +%! K = ncfsyn (G, [], [], FACTOR); +%! [AK, BK, CK, DK] = ssdata (K); +%! +%! AKe = [ -39.0671 9.9293 22.2322 -27.4113 43.8655 +%! -6.6117 3.0006 11.0878 -11.4130 15.4269 +%! 33.6805 -6.6934 -23.9953 14.1438 -33.4358 +%! -32.3191 9.7316 25.4033 -24.0473 42.0517 +%! -44.1655 18.7767 34.8873 -42.4369 50.8437 ]; +%! +%! BKe = [ -10.2905 -16.5382 -10.9782 +%! -4.3598 -8.7525 -5.1447 +%! 6.5962 1.8975 6.2316 +%! -9.8770 -14.7041 -11.8778 +%! -9.6726 -22.7309 -18.2692 ]; +%! +%! CKe = [ -0.6647 -0.0599 -1.0376 0.5619 1.7297 +%! -8.4202 3.9573 7.3094 -7.6283 10.6768 ]; +%! +%! DKe = [ 0.8466 0.4979 -0.6993 +%! -1.2226 -4.8689 -4.5056 ]; +%! +%! RCONDe = [ 0.13861D-01 0.90541D-02 ]; +%! +%!assert (AK, AKe, 1e-4); +%!assert (BK, BKe, 1e-4); +%!assert (CK, CKe, 1e-4); +%!assert (DK, DKe, 1e-4); + + +## discrete-time case D==0, direct access to sb10kd +%!shared AK, BK, CK, DK, RCOND, AKe, BKe, CKe, DKe, RCONDe +%! A = [ 0.2 0.0 0.3 0.0 -0.3 -0.1 +%! -0.3 0.2 -0.4 -0.3 0.0 0.0 +%! -0.1 0.1 -0.1 0.0 0.0 -0.3 +%! 0.1 0.0 0.0 -0.1 -0.1 0.0 +%! 0.0 0.3 0.6 0.2 0.1 -0.4 +%! 0.2 -0.4 0.0 0.0 0.2 -0.2 ]; +%! +%! B = [ -1.0 -2.0 +%! 1.0 3.0 +%! -3.0 -4.0 +%! 1.0 -2.0 +%! 0.0 1.0 +%! 1.0 5.0 ]; +%! +%! C = [ 1.0 -1.0 2.0 -2.0 0.0 -3.0 +%! -3.0 0.0 1.0 -1.0 1.0 -1.0 ]; +%! +%! FACTOR = 1.1; +%! +%! [AK, BK, CK, DK, RCOND] = slsb10kd (A, B, C, FACTOR); +%! +%! AKe = [ 0.0337 0.0222 0.0858 0.1264 -0.1872 0.1547 +%! 0.4457 0.0668 -0.2255 -0.3204 -0.4548 -0.0691 +%! -0.2419 -0.2506 -0.0982 -0.1321 -0.0130 -0.0838 +%! -0.4402 0.3654 -0.0335 -0.2444 0.6366 -0.6469 +%! -0.3623 0.3854 0.4162 0.4502 0.0065 0.1261 +%! -0.0121 -0.4377 0.0604 0.2265 -0.3389 0.4542 ]; +%! +%! BKe = [ 0.0931 -0.0269 +%! -0.0872 0.1599 +%! 0.0956 -0.1469 +%! -0.1728 0.0129 +%! 0.2022 -0.1154 +%! 0.2419 -0.1737 ]; +%! +%! CKe = [ -0.3677 0.2188 0.0403 -0.0854 0.3564 -0.3535 +%! 0.1624 -0.0708 0.0058 0.0606 -0.2163 0.1802 ]; +%! +%! DKe = [ -0.0857 -0.0246 +%! 0.0460 0.0074 ]; +%! +%! RCONDe = [ 0.11269D-01 0.17596D-01 0.18225D+00 0.75968D-03 ].'; +%! +%!assert (AK, AKe, 1e-4); +%!assert (BK, BKe, 1e-4); +%!assert (CK, CKe, 1e-4); +%!assert (DK, DKe, 1e-4); +%!assert (RCOND, RCONDe, 1e-4); + + +## discrete-time case D==0 +%!shared AK, BK, CK, DK, RCOND, AKe, BKe, CKe, DKe, RCONDe +%! A = [ 0.2 0.0 0.3 0.0 -0.3 -0.1 +%! -0.3 0.2 -0.4 -0.3 0.0 0.0 +%! -0.1 0.1 -0.1 0.0 0.0 -0.3 +%! 0.1 0.0 0.0 -0.1 -0.1 0.0 +%! 0.0 0.3 0.6 0.2 0.1 -0.4 +%! 0.2 -0.4 0.0 0.0 0.2 -0.2 ]; +%! +%! B = [ -1.0 -2.0 +%! 1.0 3.0 +%! -3.0 -4.0 +%! 1.0 -2.0 +%! 0.0 1.0 +%! 1.0 5.0 ]; +%! +%! C = [ 1.0 -1.0 2.0 -2.0 0.0 -3.0 +%! -3.0 0.0 1.0 -1.0 1.0 -1.0 ]; +%! +%! FACTOR = 1.1; +%! +%! G = ss (A, B, C, [], 1); # value of sampling time doesn't matter +%! K = ncfsyn (G, [], [], FACTOR); +%! [AK, BK, CK, DK] = ssdata (K); +%! +%! AKe = [ 0.0337 0.0222 0.0858 0.1264 -0.1872 0.1547 +%! 0.4457 0.0668 -0.2255 -0.3204 -0.4548 -0.0691 +%! -0.2419 -0.2506 -0.0982 -0.1321 -0.0130 -0.0838 +%! -0.4402 0.3654 -0.0335 -0.2444 0.6366 -0.6469 +%! -0.3623 0.3854 0.4162 0.4502 0.0065 0.1261 +%! -0.0121 -0.4377 0.0604 0.2265 -0.3389 0.4542 ]; +%! +%! BKe = [ 0.0931 -0.0269 +%! -0.0872 0.1599 +%! 0.0956 -0.1469 +%! -0.1728 0.0129 +%! 0.2022 -0.1154 +%! 0.2419 -0.1737 ]; +%! +%! CKe = [ -0.3677 0.2188 0.0403 -0.0854 0.3564 -0.3535 +%! 0.1624 -0.0708 0.0058 0.0606 -0.2163 0.1802 ]; +%! +%! DKe = [ -0.0857 -0.0246 +%! 0.0460 0.0074 ]; +%! +%! RCONDe = [ 0.11269D-01 0.17596D-01 0.18225D+00 0.75968D-03 ].'; +%! +%!assert (AK, AKe, 1e-4); +%!assert (BK, BKe, 1e-4); +%!assert (CK, CKe, 1e-4); +%!assert (DK, DKe, 1e-4); + + +## discrete-time case D!=0, direct access to sb10zd +%!shared AK, BK, CK, DK, RCOND, AKe, BKe, CKe, DKe, RCONDe +%! A = [ 0.2 0.0 3.0 0.0 -0.3 -0.1 +%! -3.0 0.2 -0.4 -0.3 0.0 0.0 +%! -0.1 0.1 -1.0 0.0 0.0 -3.0 +%! 1.0 0.0 0.0 -1.0 -1.0 0.0 +%! 0.0 0.3 0.6 2.0 0.1 -0.4 +%! 0.2 -4.0 0.0 0.0 0.2 -2.0 ]; +%! +%! B = [ -1.0 -2.0 +%! 1.0 3.0 +%! -3.0 -4.0 +%! 1.0 -2.0 +%! 0.0 1.0 +%! 1.0 5.0 ]; +%! +%! C = [ 1.0 -1.0 2.0 -2.0 0.0 -3.0 +%! -3.0 0.0 1.0 -1.0 1.0 -1.0 +%! 2.0 4.0 -3.0 0.0 5.0 1.0 ]; +%! +%! D = [ 10.0 -6.0 +%! -7.0 8.0 +%! 2.0 -4.0 ]; +%! +%! FACTOR = 1.1; +%! +%! [AK, BK, CK, DK, RCOND] = slsb10zd (A, B, C, D, FACTOR, 0.0); +%! +%! AKe = [ 1.0128 0.5101 -0.1546 1.1300 3.3759 0.4911 +%! -2.1257 -1.4517 -0.4486 0.3493 -1.5506 -1.4296 +%! -1.0930 -0.6026 -0.1344 0.2253 -1.5625 -0.6762 +%! 0.3207 0.1698 0.2376 -1.1781 -0.8705 0.2896 +%! 0.5017 0.9006 0.0668 2.3613 0.2049 0.3703 +%! 1.0787 0.6703 0.2783 -0.7213 0.4918 0.7435 ]; +%! +%! BKe = [ 0.4132 0.3112 -0.8077 +%! 0.2140 0.4253 0.1811 +%! -0.0710 0.0807 0.3558 +%! -0.0121 -0.2019 0.0249 +%! 0.1047 0.1399 -0.0457 +%! -0.2542 -0.3472 0.0523 ]; +%! +%! CKe = [ -0.0372 -0.0456 -0.0040 0.0962 -0.2059 -0.0571 +%! 0.1999 0.2994 0.1335 -0.0251 -0.3108 0.2048 ]; +%! +%! DKe = [ 0.0629 -0.0022 0.0363 +%! -0.0228 0.0195 0.0600 ]; +%! +%! RCONDe = [ 0.27949D-03 0.66679D-03 0.45677D-01 0.23433D-07 0.68495D-01 0.76854D-01 ].'; +%! +%!assert (AK, AKe, 1e-4); +%!assert (BK, BKe, 1e-4); +%!assert (CK, CKe, 1e-4); +%!assert (DK, DKe, 1e-4); +%!assert (RCOND, RCONDe, 1e-4); + + +## discrete-time case D!=0 +%!shared AK, BK, CK, DK, RCOND, AKe, BKe, CKe, DKe, RCONDe +%! A = [ 0.2 0.0 3.0 0.0 -0.3 -0.1 +%! -3.0 0.2 -0.4 -0.3 0.0 0.0 +%! -0.1 0.1 -1.0 0.0 0.0 -3.0 +%! 1.0 0.0 0.0 -1.0 -1.0 0.0 +%! 0.0 0.3 0.6 2.0 0.1 -0.4 +%! 0.2 -4.0 0.0 0.0 0.2 -2.0 ]; +%! +%! B = [ -1.0 -2.0 +%! 1.0 3.0 +%! -3.0 -4.0 +%! 1.0 -2.0 +%! 0.0 1.0 +%! 1.0 5.0 ]; +%! +%! C = [ 1.0 -1.0 2.0 -2.0 0.0 -3.0 +%! -3.0 0.0 1.0 -1.0 1.0 -1.0 +%! 2.0 4.0 -3.0 0.0 5.0 1.0 ]; +%! +%! D = [ 10.0 -6.0 +%! -7.0 8.0 +%! 2.0 -4.0 ]; +%! +%! FACTOR = 1.1; +%! +%! G = ss (A, B, C, D, 1); # value of sampling time doesn't matter +%! K = ncfsyn (G, [], [], FACTOR); +%! [AK, BK, CK, DK] = ssdata (K); +%! +%! AKe = [ 1.0128 0.5101 -0.1546 1.1300 3.3759 0.4911 +%! -2.1257 -1.4517 -0.4486 0.3493 -1.5506 -1.4296 +%! -1.0930 -0.6026 -0.1344 0.2253 -1.5625 -0.6762 +%! 0.3207 0.1698 0.2376 -1.1781 -0.8705 0.2896 +%! 0.5017 0.9006 0.0668 2.3613 0.2049 0.3703 +%! 1.0787 0.6703 0.2783 -0.7213 0.4918 0.7435 ]; +%! +%! BKe = [ 0.4132 0.3112 -0.8077 +%! 0.2140 0.4253 0.1811 +%! -0.0710 0.0807 0.3558 +%! -0.0121 -0.2019 0.0249 +%! 0.1047 0.1399 -0.0457 +%! -0.2542 -0.3472 0.0523 ]; +%! +%! CKe = [ -0.0372 -0.0456 -0.0040 0.0962 -0.2059 -0.0571 +%! 0.1999 0.2994 0.1335 -0.0251 -0.3108 0.2048 ]; +%! +%! DKe = [ 0.0629 -0.0022 0.0363 +%! -0.0228 0.0195 0.0600 ]; +%! +%! RCONDe = [ 0.27949D-03 0.66679D-03 0.45677D-01 0.23433D-07 0.68495D-01 0.76854D-01 ].'; +%! +%!assert (AK, AKe, 1e-4); +%!assert (BK, BKe, 1e-4); +%!assert (CK, CKe, 1e-4); +%!assert (DK, DKe, 1e-4); diff --git a/octave_packages/control-2.3.52/nichols.m b/octave_packages/control-2.3.52/nichols.m new file mode 100644 index 0000000..315c1d3 --- /dev/null +++ b/octave_packages/control-2.3.52/nichols.m @@ -0,0 +1,84 @@ +## Copyright (C) 2009, 2010, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{mag}, @var{pha}, @var{w}] =} nichols (@var{sys}) +## @deftypefnx {Function File} {[@var{mag}, @var{pha}, @var{w}] =} nichols (@var{sys}, @var{w}) +## Nichols chart of frequency response. If no output arguments are given, +## the response is printed on the screen. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. Must be a single-input and single-output (SISO) system. +## @item w +## Optional vector of frequency values. If @var{w} is not specified, +## it is calculated by the zeros and poles of the system. +## Alternatively, the cell @code{@{wmin, wmax@}} specifies a frequency range, +## where @var{wmin} and @var{wmax} denote minimum and maximum frequencies +## in rad/s. +## @end table +## +## @strong{Outputs} +## @table @var +## @item mag +## Vector of magnitude. Has length of frequency vector @var{w}. +## @item pha +## Vector of phase. Has length of frequency vector @var{w}. +## @item w +## Vector of frequency values used. +## @end table +## +## @seealso{bode, nyquist, sigma} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.4 + +function [mag_r, pha_r, w_r] = nichols (sys, w = []) + + ## TODO: multiplot feature: nichols (sys1, "b", sys2, "r", ...) + + if (nargin == 0 || nargin > 2) + print_usage (); + endif + + [H, w] = __frequency_response__ (sys, w, false, 0, "ext"); + + H = reshape (H, [], 1); + mag = abs (H); + pha = unwrap (arg (H)) * 180 / pi; + + if (! nargout) + mag_db = 20 * log10 (mag); + + plot (pha, mag_db) + axis ("tight") + xlim (__axis_margin__ (xlim)) + ylim (__axis_margin__ (ylim)) + grid ("on") + title (["Nichols Chart of ", inputname(1)]) + xlabel ("Phase [deg]") + ylabel ("Magnitude [dB]") + else + mag_r = mag; + pha_r = pha; + w_r = w; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/nyquist.m b/octave_packages/control-2.3.52/nyquist.m new file mode 100644 index 0000000..af84e46 --- /dev/null +++ b/octave_packages/control-2.3.52/nyquist.m @@ -0,0 +1,82 @@ +## Copyright (C) 2009, 2010, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{re}, @var{im}, @var{w}] =} nyquist (@var{sys}) +## @deftypefnx {Function File} {[@var{re}, @var{im}, @var{w}] =} nyquist (@var{sys}, @var{w}) +## Nyquist diagram of frequency response. If no output arguments are given, +## the response is printed on the screen. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. Must be a single-input and single-output (SISO) system. +## @item w +## Optional vector of frequency values. If @var{w} is not specified, +## it is calculated by the zeros and poles of the system. +## Alternatively, the cell @code{@{wmin, wmax@}} specifies a frequency range, +## where @var{wmin} and @var{wmax} denote minimum and maximum frequencies +## in rad/s. +## @end table +## +## @strong{Outputs} +## @table @var +## @item re +## Vector of real parts. Has length of frequency vector @var{w}. +## @item im +## Vector of imaginary parts. Has length of frequency vector @var{w}. +## @item w +## Vector of frequency values used. +## @end table +## +## @seealso{bode, nichols, sigma} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.3 + +function [re_r, im_r, w_r] = nyquist (sys, w = []) + + ## TODO: multiplot feature: nyquist (sys1, "b", sys2, "r", ...) + + if (nargin == 0 || nargin > 2) + print_usage (); + endif + + [H, w] = __frequency_response__ (sys, w, false, 0, "ext"); + + H = reshape (H, [], 1); + re = real (H); + im = imag (H); + + if (! nargout) + plot (re, im, "b", re, -im, "r") + axis ("tight") + xlim (__axis_margin__ (xlim)) + ylim (__axis_margin__ (ylim)) + grid ("on") + title (["Nyquist Diagram of ", inputname(1)]) + xlabel ("Real Axis") + ylabel ("Imaginary Axis") + else + re_r = re; + im_r = im; + w_r = w; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/obsv.m b/octave_packages/control-2.3.52/obsv.m new file mode 100644 index 0000000..08a3798 --- /dev/null +++ b/octave_packages/control-2.3.52/obsv.m @@ -0,0 +1,80 @@ +## Copyright (C) 2009, 2010 Lukas F. Reichlin +## Copyright (C) 2009 Luca Favatella +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{ob} =} obsv (@var{sys}) +## @deftypefnx {Function File} {@var{ob} =} obsv (@var{a}, @var{c}) +## Return observability matrix. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. +## @item a +## State transition matrix (n-by-n). +## @item c +## Measurement matrix (p-by-n). +## @end table +## +## @strong{Outputs} +## @table @var +## @item ob +## Observability matrix. +## @end table +## +## @strong{Equation} +## @iftex +## @tex +## $$ O_b = \\left[ \\matrix{ C \\cr +## CA \\cr +## CA^2 \\cr +## \\vdots \\cr +## CA^{n-1} } \\right ] $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## @group +## | C | +## | CA | +## Ob = | CA^2 | +## | ... | +## | CA^(n-1) | +## @end group +## @end example +## @end ifnottex +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.2 + +function ob = obsv (a, c) + + if (nargin == 1) # obsv (sys) + ob = ctrb (a.').'; # transpose is overloaded for lti models + elseif (nargin == 2) # obsv (a, c) + ob = ctrb (a.', c.').'; # size checked inside + else + print_usage (); + endif + +endfunction + + +%!assert (obsv ([1, 0; 0, -0.5], [8, 8]), [8, 8; 8, -4]); diff --git a/octave_packages/control-2.3.52/obsvf.m b/octave_packages/control-2.3.52/obsvf.m new file mode 100644 index 0000000..fdcec71 --- /dev/null +++ b/octave_packages/control-2.3.52/obsvf.m @@ -0,0 +1,77 @@ +## Copyright (C) 2010 Benjamin Fernandez +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{sysbar}, @var{T}, @var{K}] =} obsvf (@var{sys}) +## @deftypefnx{Function File} {[@var{sysbar}, @var{T}, @var{K}] =} obsvf (@var{sys}, @var{tol}) +## @deftypefnx{Function File} {[@var{Abar}, @var{Bbar}, @var{Cbar}, @var{T}, @var{K}] =} obsvf (@var{A}, @var{B}, @var{C}) +## @deftypefnx{Function File} {[@var{Abar}, @var{Bbar}, @var{Cbar}, @var{T}, @var{K}] =} obsvf (@var{A}, @var{B}, @var{C}, @var{TOL}) +## If Ob=obsv(A,C) has rank r <= n = SIZE(A,1), then there is a +## similarity transformation Tc such that To = [t1;t2] where t1 is c +## and t2 is orthogonal to t1 +## +## @example +## @group +## Abar = To \ A * To , Bbar = To \ B , Cbar = C * To +## @end group +## @end example +## +## and the transformed system has the form +## +## @example +## @group +## | Ao 0 | | Bo | +## Abar = |----------|, Bbar = | --- |, Cbar = [Co | 0 ]. +## | A21 Ano| | Bno | +## @end group +## @end example +## +## where (Ao,Bo) is observable, and Co(sI-Ao)^(-1)Bo = C(sI-A)^(-1)B. And +## system is detectable if Ano has no eigenvalues in the right +## half plane. The last output K is a vector of length n containing the +## number of observable states. +## @end deftypefn + +## Author: Benjamin Fernandez +## Created: 2010-05-02 +## Version: 0.1 + +function [ac, bc, cc, z, ncont] = obsvf (a, b = [], c, tol = []) + + if (nargin < 1 || nargin > 4) + print_usage (); + endif + + if (isa (a, "lti")) + if (nargin > 2) + print_usage (); + endif + [ac, bc, cc] = ctrbf (a.', b); # [sysbar, z, ncont] = ctrbf (sys.', tol); + ac = ac.'; + z = ncont = []; + else + if (nargin < 3) + print_usage (); + endif + [ac, tmp, cc, z, ncont] = ctrbf (a.', c.', b.', tol); + ac = ac.'; + bc = cc.'; + cc = tmp.'; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/optiPID.m b/octave_packages/control-2.3.52/optiPID.m new file mode 100644 index 0000000..77733d5 --- /dev/null +++ b/octave_packages/control-2.3.52/optiPID.m @@ -0,0 +1,102 @@ +%% -*- texinfo -*- +%% Numerical optimization of a PID controller using an objective function. +%% The objective function is located in the file @command{optiPIDfun}. +%% Type @code{which optiPID} to locate, @code{edit optiPID} to open +%% and simply @code{optiPID} to run the example file. + +% =============================================================================== +% optiPID Lukas Reichlin July 2009 +% =============================================================================== +% Numerical Optimization of an A/H PID Controller +% Reference: Guzzella, L. (2007) Analysis and Synthesis of SISO Control Systems. +% vdf Hochschulverlag, Zurich +% Required OCTAVE Packages: control, optim (and its dependencies) +% Required MATLAB Toolboxes: Control, Optimization +% =============================================================================== + +% Tabula Rasa +clear all, close all, clc; + +% Global Variables +global P t dt mu_1 mu_2 mu_3 + +% Plant +numP = [1]; +denP = conv ([1, 1, 1], [1, 4, 6, 4, 1]); +P = tf (numP, denP); + +% Relative Weighting Factors: PLAY AROUND WITH THESE! +mu_1 = 1; % Minimize ITAE Criterion +mu_2 = 10; % Minimize Max Overshoot +mu_3 = 20; % Minimize Sensitivity Ms + +% Simulation Settings: PLANT-DEPENDENT! +t_sim = 30; % Simulation Time [s] +dt = 0.05; % Sampling Time [s] +t = 0 : dt : t_sim; % Time Vector [s] + +% A/H PID Controller: Ms = 2.0 +[gamma, phi, w_gamma, w_phi] = margin (P); + +ku = gamma; +Tu = 2*pi / w_gamma; +kappa = inv (dcgain (P)); + +disp ('optiPID: Astrom/Hagglund PID controller parameters:'); +kp_AH = ku * 0.72 * exp ( -1.60 * kappa + 1.20 * kappa^2 ) +Ti_AH = Tu * 0.59 * exp ( -1.30 * kappa + 0.38 * kappa^2 ) +Td_AH = Tu * 0.15 * exp ( -1.40 * kappa + 0.56 * kappa^2 ) + +C_AH = optiPIDctrl (kp_AH, Ti_AH, Td_AH); + +% Initial Values +C_par_0 = [kp_AH; Ti_AH; Td_AH]; + +% Optimization +if (exist ('fminsearch')) + warning ('optiPID: optimization starts, please be patient ...'); +else + error ('optiPID: please load/install optim package to proceed'); +end + +C_par_opt = fminsearch (@optiPIDfun, C_par_0); + +% Optimized Controller +disp ('optiPID: optimized PID controller parameters:'); +kp_opt = C_par_opt(1) +Ti_opt = C_par_opt(2) +Td_opt = C_par_opt(3) + +C_opt = optiPIDctrl (kp_opt, Ti_opt, Td_opt); + +% Open Loop +L_AH = P * C_AH; +L_opt = P * C_opt; + +% Closed Loop +T_AH = feedback (L_AH, 1); +T_opt = feedback (L_opt, 1); + +% A Posteriori Stability Check +disp ('optiPID: closed-loop stability check:'); +st_AH = isstable (T_AH) +st_opt = isstable (T_opt) + +% Stability Margins +disp ('optiPID: gain margin gamma [-] and phase margin phi [deg]:'); +[gamma_AH, phi_AH] = margin (L_AH) +[gamma_opt, phi_opt] = margin (L_opt) + +% Plot Step Response +[y_AH, t_AH] = step (T_AH, t); +[y_opt, t_opt] = step (T_opt, t); + +figure (1) +plot (t_AH, y_AH, 'b', t_opt, y_opt, 'r') +grid ('on') +title ('Step Response') +xlabel ('Time [s]') +ylabel ('Output [-]') +legend ('A/H', 'Optimized', 'Location', 'SouthEast') + +% =============================================================================== diff --git a/octave_packages/control-2.3.52/optiPIDctrl.m b/octave_packages/control-2.3.52/optiPIDctrl.m new file mode 100644 index 0000000..65f2d4c --- /dev/null +++ b/octave_packages/control-2.3.52/optiPIDctrl.m @@ -0,0 +1,18 @@ +% =============================================================================== +% optiPIDctrl Lukas Reichlin February 2012 +% =============================================================================== +% Return PID controller with roll-off for given parameters Kp, Ti and Td. +% =============================================================================== + +function C = optiPIDctrl (Kp, Ti, Td) + + tau = Td / 10; % roll-off + + num = Kp * [Ti*Td, Ti, 1]; + den = conv ([Ti, 0], [tau^2, 2*tau, 1]); + + C = tf (num, den); + +end + +% =============================================================================== diff --git a/octave_packages/control-2.3.52/optiPIDfun.m b/octave_packages/control-2.3.52/optiPIDfun.m new file mode 100644 index 0000000..7e7e845 --- /dev/null +++ b/octave_packages/control-2.3.52/optiPIDfun.m @@ -0,0 +1,56 @@ +% =============================================================================== +% optiPIDfun Lukas Reichlin July 2009 +% =============================================================================== +% Objective Function +% Reference: Guzzella, L. (2007) Analysis and Synthesis of SISO Control Systems. +% vdf Hochschulverlag, Zurich +% =============================================================================== + +function J = optiPIDfun (C_par) + + % Global Variables + global P t dt mu_1 mu_2 mu_3 + + % Function Argument -> Controller Parameters + kp = C_par(1); + Ti = C_par(2); + Td = C_par(3); + + % PID Controller with Roll-Off + C = optiPIDctrl (kp, Ti, Td); + + % Open Loop + L = P * C; + + % Sum Block: e = r - y + SUM = ss ([1, -1]); % Matlab converts to SS (and back) for MIMO TF connections + + % Group Sum Block and Open Loop + SUML = append (SUM, L); + + % Build System Interconnections + CM = [3, 1; % Controller Input with Sum Block Output + 2, 2]; % Sum Block Negative Input with Plant Output + + inputs = [1]; % Input 1: reference r(t) + outputs = [1, 2]; % Output 1: error e(t), Output 2: output y(t) + + SUML = connect (SUML, CM, inputs, outputs); + + % Simulation + [y, t_y] = step (SUML, t); + + % ITAE Criterion + itae = dt * (t_y.' * abs (y(:, 1))); + + % Sensitivity + S = inv (1 + L); + Ms = norm (S, inf); + + % Objective Function + J = mu_1 * itae + mu_2 * (max (y(:, 2)) - 1) + mu_3 * Ms; + +end % function + +% =============================================================================== + diff --git a/octave_packages/control-2.3.52/options.m b/octave_packages/control-2.3.52/options.m new file mode 100644 index 0000000..7021559 --- /dev/null +++ b/octave_packages/control-2.3.52/options.m @@ -0,0 +1,83 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{opt} =} options (@var{"key1"}, @var{value1}, @var{"key2"}, @var{value2}, @dots{}) +## Create options struct @var{opt} from a number of key and value pairs. +## For use with order reduction commands. +## +## @strong{Inputs} +## @table @var +## @item key, property +## The name of the property. +## @item value +## The value of the property. +## @end table +## +## @strong{Outputs} +## @table @var +## @item opt +## Struct with fields for each key. +## @end table +## +## @strong{Example} +## @example +## @group +## octave:1> opt = options ("method", "spa", "tol", 1e-6) +## opt = +## +## scalar structure containing the fields: +## +## method = spa +## tol = 1.0000e-06 +## +## @end group +## @end example +## @example +## @group +## octave:2> save filename opt +## octave:3> # save the struct 'opt' to file 'filename' for later use +## octave:4> load filename +## octave:5> # load struct 'opt' from file 'filename' +## @end group +## @end example +## +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function opt = options (varargin) + + if (nargin == 0) + print_usage (); + endif + + if (rem (nargin, 2)) + error ("options: properties and values must come in pairs"); + endif + + ## alternative: opt = struct (varargin{:}); + + key = reshape (varargin(1:2:end-1), [], 1); + val = reshape (varargin(2:2:end), [], 1); + + opt = cell2struct (val, key, 1); + opt = orderfields (opt); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/packinfo/.autoload b/octave_packages/control-2.3.52/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/control-2.3.52/packinfo/DESCRIPTION b/octave_packages/control-2.3.52/packinfo/DESCRIPTION new file mode 100644 index 0000000..628f03d --- /dev/null +++ b/octave_packages/control-2.3.52/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: Control +Version: 2.3.52 +Date: 2012-06-25 +Author: Lukas Reichlin +Maintainer: Lukas Reichlin +Title: Control Systems +Description: Octave control systems package based on the proven SLICOT library +Depends: octave (>= 3.6.0) +Autoload: yes +License: GPLv3+ +Url: http://octave.sf.net, http://www.slicot.org diff --git a/octave_packages/control-2.3.52/packinfo/INDEX b/octave_packages/control-2.3.52/packinfo/INDEX new file mode 100644 index 0000000..fe8c18a --- /dev/null +++ b/octave_packages/control-2.3.52/packinfo/INDEX @@ -0,0 +1,133 @@ +control >> Control Theory +Examples + MDSSystem + optiPID + Anderson + Madievski +Linear Time Invariant Models + dss + filt + frd + ss + tf + zpk +Model Data Access + @lti/dssdata + @lti/filtdata + @lti/frdata + @lti/get + @lti/set + @lti/ssdata + @lti/tfdata + @lti/zpkdata +Model Conversions + @lti/c2d + @lti/d2c + @lti/prescale + @lti/xperm +Model Interconnections + @lti/append + @lti/blkdiag + @lti/connect + @lti/feedback + @lti/lft + @lti/mconnect + @lti/parallel + @lti/series +Model Characteristics + ctrb + ctrbf + @lti/dcgain + gram + hsvd + @lti/isct + isctrb + isdetectable + @lti/isdt + @lti/isminimumphase + isobsv + @lti/issiso + isstabilizable + @lti/isstable + @lti/norm + obsv + obsvf + @lti/pole + pzmap + @lti/size + @lti/zero +Model Simplification + @lti/minreal + @lti/sminreal +Time Domain Analysis + covar + gensig + impulse + initial + lsim + step +Frequency Domain Analysis + bode + bodemag + @lti/freqresp + margin + nichols + nyquist + sigma +Pole Placement + place + rlocus +Linear-Quadratic Control + dlqe + dlqr + estim + kalman + lqe + lqr +Robust Control + augw + fitfrd + h2syn + hinfsyn + mixsyn + ncfsyn +Matrix Equation Solvers + care + dare + dlyap + dlyapchol + lyap + lyapchol +Model Reduction + bstmodred + btamodred + hnamodred + spamodred +Controller Reduction + btaconred + cfconred + fwcfconred + spaconred +Overloaded Operators + @lti/ctranspose + @lti/horzcat + @lti/inv + @lti/minus + @lti/mldivide + @lti/mpower + @lti/mrdivide + @lti/mtimes + @lti/plus + @lti/subsasgn + @lti/subsref + @lti/transpose + @lti/uminus + @lti/uplus + @lti/vertcat +Miscellaneous + options + strseq + test_control + BMWengine + Boeing707 + WestlandLynx diff --git a/octave_packages/control-2.3.52/packinfo/NEWS b/octave_packages/control-2.3.52/packinfo/NEWS new file mode 100644 index 0000000..a75d874 --- /dev/null +++ b/octave_packages/control-2.3.52/packinfo/NEWS @@ -0,0 +1,387 @@ +Summary of important user-visible changes for releases of the control package + +=============================================================================== +control-2.3.52 Release Date: 2012-06-25 Release Manager: Lukas Reichlin +=============================================================================== + +** Fixed a silly mistake in MIMO transfer function to state-space conversion. + The bug has been introduced with control-2.3.51. + (Thanks to Jim Rawlings for providing the test case) + +** dlqe, lqe + Added new functions for linear quadratic estimators. + (Thanks to Megan Zagrobelny) + +** Upon request of the Debian maintainers, the tex-files control.tex and + functions.texi for generating control.pdf are included in the doc folder, + next to control.pdf. Note that functions.texi is generated automatically + by the scripts in the control/devel folder and the package generate_html. + They are not included in the control package and can be found on the + OctaveForge SVN server. + +** Minor improvements in various help texts. + + +=============================================================================== +control-2.3.51 Release Date: 2012-06-03 Release Manager: Lukas Reichlin +=============================================================================== + +** filt, filtdata, tf + -- Added function "filt" to specify disrete-time transfer functions in DSP + format, i.e. z^-1. + -- Added function "filtdata" to return any type of discrete-time LTI model + in DSP format. + -- tf models have a new property "inv". To display a discrete-time TF sys + in z^-1, set sys.inv=true. In order to switch to z, set sys.inv=false. + "filt" sets property "inv" to true (z^-1) by default, while "tf" uses + false (z) as default value. + +** ctranspose + Conjugate transpose or pertransposition of LTI objects. + Used by Octave for "sys'". For a transfer-function matrix G, G' denotes the + conjugate of G given by G.'(-s) for a continuous-time system or G.'(1/z) for + a discrete-time system. The frequency response of the pertransposition of G + is the Hermitian (conjugate) transpose of G(jw), + i.e. freqresp (G', w) = freqresp (G, w)'. + WARNING: Do NOT use this for dual problems, use the transpose "sys.'" + (note the dot) instead. + +** test_control + Add a few remarks to the help text regarding the severity of failing tests. + +** Makefile fixed to work with non-standard linker options e.g on + Apple. + +** The conversion to state-space of multi-input transfer functions with common + row denominators is now handled more efficiently. + + +=============================================================================== +control-2.3.50 Release Date: 2012-03-06 Release Manager: Lukas Reichlin +=============================================================================== + +** Added new functions for frequency-weighted model and controller order + reduction: + + bstmodred btaconred + btamodred cfconred + hnamodred fwcfconred + spamodred spaconred + +** Anderson, Madievski + -- Added two examples for controller reduction. The m-files are named after + the authors of the corresponding papers. + +** fitfrd + -- Added function to fit frequency response data with a state-space model. + +** set + -- The set command doesn't need a return argument anymore in order to save + the modified values. set (sys, "key", value) is now equivalent to + sys = set (sys, "key", value). + +** Require Octave version 3.6.0 or better. (The frequency response plotting + commands have been simplified. They now use the fixed "axis tight" command. + This is a first step towards multiple systems in one plot, + e.g. bode (sys1, sys2, sys3). Furthermore, the code takes advantage of the + new "arrayfun" function which became a faster oct-file instead of an m-file) + +** Revised package installation and cleanup efforts under the hood. + The new solution compiles the SLICOT library in a less barbaric way and + creates only a single oct-file containing all the SLICOT routines. + This also brings along faster compile times. + (Special thanks to Hans Buchmann, Carlo De Falco and Michael Goffioul for + their advice) + +** doc/control.pdf + -- Extended PDF manual. + + +=============================================================================== +control-2.2.5 Release Date: 2012-02-09 Release Manager: Lukas Reichlin +=============================================================================== + +** Improved Matlab compatibility for frequency response commands. It is now + possible to specify a frequency range. Example: bode (sys, {wmin, wmax}) + where wmin and wmax denote frequencies in rad/s. + +** margin + -- Fixed a variable name such that discrete-time models are plotted + without an error. (Thanks to Renato Caldas) + + +=============================================================================== +control-2.2.4 Release Date: 2012-01-07 Release Manager: Lukas Reichlin +=============================================================================== + +** Compatibility with Octave 3.6.0. (The makefile must specify the libraries + that mkoctfile needs to link. Thanks to Marco Atzeri and Carlo De Falco) + +** ctrbf, obsvf + -- Added new functions to compute controllable and observable block + Hessenberg realizations based on SLICOT TB01UD. + (Thanks to Benjamin Fernandez and Alexandre Felipe) + + +=============================================================================== +control-2.2.3 Release Date: 2011-12-07 Release Manager: Lukas Reichlin +=============================================================================== + +** Improved performance when computing the frequency response of transfer + function models by orders of magnitude. (I realized that "polyval" can + evaluate a polynomial at several values at once in a vectorized manner.) + +** bode, bodemag, nichols, sigma + -- Fixed a hang when plotting pairs of purely imaginary poles or zeros. + The hang was caused by nonsensical (Inf, NaN) axis values. + (Reported by Laurent Tissier) + +** Use single instead of double quotes when displaying names of TF and FRD + models. + + +=============================================================================== +control-2.2.2 Release Date: 2011-12-04 Release Manager: Lukas Reichlin +=============================================================================== + +** Improved error messages for place, ARE solvers and robust control commands. + +** minreal, ss + -- Fixed a crash for descriptor models. minreal for dss models as well as + conversion from non-proper transfer functions to descriptor state-space + models should work now as expected. + +** ss + -- Revised default tolerance for transfer function to state-space conversion + by SLICOT TD04AD. + +** Better performance when computing the frequency response of SISO transfer + function models. + +** Reorganized tests. Most tests have been moved from "ltimodels" to the files + of the LTI methods being tested. All available tests can be executed by + "test_control". + +** The NEWS file is handled correctly when using Octave version 3.6. + Type "news("control")" or "news control" to display the news (3.6 only). + + +=============================================================================== +control-2.2.1 Release Date: 2011-10-24 Release Manager: Lukas Reichlin +=============================================================================== + +** tf + -- Fixed a nasty bug that prevented shortening of numerator and denominator + polynomials consisting solely of zeros. + -- MIMO support for descriptor state-space to transfer function conversion. + Usage: tf_sys = tf (dss_sys) + -- MIMO support for interconnections of non-proper transfer functions via + internal conversion to state-space. + +** ss + -- Support conversion from non-proper transfer function to descriptor state- + space. Usage: dss_sys = ss (tf_sys) + +** c2d, d2c + -- Support bilinear transformation of descriptor state-space models. + +** inv + -- Support the inversion of MIMO transfer functions. Inverses of 2x2 TFs are + computed directly, larger models are computed internally in state-space. + +** place + -- Return the number of fixed, assigned and uncontrollable poles in a single + "info" struct instead of three individual output arguments. + +** rlocus + -- Clarify usage statement in help string. + -- Check whether system is SISO. + +** MDSSystem + -- Display bode plots of controllers instead of singular value plots of the + closed loops. + +** hsvd + -- Added option "alpha" to specify the alpha-stability boundary for the + eigenvalues of the state dynamics matrix A. + +** isctrb, isobsv + -- Return number of controllable/observable states as a second output + argument. + +** doc/control.pdf + -- Added preface to PDF manual. + + +=============================================================================== +control-2.2.0 Release Date: 2011-09-26 Release Manager: Lukas Reichlin +=============================================================================== + +** ss + -- Transfer function to state-space conversion uses now SLICOT TD04AD. + Conversion of MIMO models is now supported. Usage: ss_sys = ss (tf_sys) + +** tf + -- Support for interconnections of MIMO transfer functions. This is done by + an internal conversion to a minimal state-space representation. With the + current tf2ss and ss2tf conversions, only proper transfer function are + supported. This limitation does not exist for SISO transfer functions. + -- Fixed a cellfun statement that caused problems on MinGW32 builds and + possibly some others. (Reported by Bernhard Weller) + +** pole, zero + -- Computation of poles and zeros of MIMO transfer functions is now possible + via conversion to state-space. Please note that the state-space + realization of SLICOT TD04AD is a minimal one. Therefore certain poles + and zeros might be missing. + +** zpk, zpkdata + -- Included wrappers that create transfer function models from zero-pole-gain + data (zpk) and zero-pole-gain data from lti models (zpkdata). They are + stop-gap measures for compatibility until ZPK models are implemented. + +** tfdata + -- "vector" option added. For SISO models, it returns numerator and + denominator directly as column vectors instead of cells containing a + single column vector. + +** doc/control.pdf + -- Revised PDF manual. + + +=============================================================================== +control-2.1.55 Release Date: 2011-09-07 Release Manager: Lukas Reichlin +=============================================================================== + +** c2d + -- Support for "tustin" and "prewarp" method added. + -- Transfer functions are now supported via the state-space methods. + -- Improved Texinfo string. + +** d2c + -- Discrete to continuous-time conversion added. However, support is + limited to the zero-order hold, tustin and pre-warping methods. + +** Conversion from descriptor to regular state-space is now performed by SLICOT + routine SB10JD. Better numerical results are to be expected over the + previous naive inversion formula. This conversion is used internally for + ssdata and some other functions. + + +=============================================================================== +control-2.1.54 Release Date: 2011-08-22 Release Manager: Lukas Reichlin +=============================================================================== + +** tf + -- State-space to transfer function conversion uses now SLICOT TB04BD. + Conversion of MIMO models is now supported. Usage: tf_sys = tf (ss_sys) + -- Display an empty line between title and numerator for better readability. + -- Display whether model is static, continuous- or discrete-time. + +** A PDF manual is included for the first time. It is located inside the "doc" + folder. It has been generated automatically from the Texinfo help strings + and is not yet completely sorted out. + + +=============================================================================== +control-2.1.53 Release Date: 2011-08-08 Release Manager: Lukas Reichlin +=============================================================================== + +** ncfsyn + -- Added support for McFarlane/Glover loop shaping design procedure. + "ncfsyn" stands for Normalized Coprime Factor Synthesis. + +** MDSSystem + -- Added example script which demonstrates the usage of the robust control + commands "mixsyn" and "ncfsyn". + +** Texinfo help strings of several functions have been extended, although + documentation still leaves a lot to be desired. + + +=============================================================================== +control-2.1.52 Release Date: 2011-07-27 Release Manager: Lukas Reichlin +=============================================================================== + +** hsvd + -- Use scaling unless state-space model property "scaled" is set to true. + +** norm + -- Use scaling for computation of L-infinity norm unless state-space model + property "scaled" is set to true. + +** minreal + -- Use scaling for state-space and descriptor state-space models unless + property "scaled" is set to true. + -- More accurate results are to be expected for descriptor state-space + models by performing only those reduction phases where effective order + reduction occurs. This is achieved by saving the system matrices before + each phase and restoring them if no order reduction took place. + +** zero + -- Use scaling for state-space and descriptor state-space models unless + property "scaled" is set to true. + +** frdata + -- The frequency response is now returned correctly as an array and not as a + vector, unless the "vector" option is set and the system is single-input + single-output. + -- Added help text. + + +=============================================================================== +control-2.1.51 Release Date: 2011-07-21 Release Manager: Lukas Reichlin +=============================================================================== + +** frd + -- Support for Frequency Response Data (frd) measurement "models". + + +=============================================================================== +control-2.1.50 Release Date: 2011-07-06 Release Manager: Lukas Reichlin +=============================================================================== + +** ss + -- Support for property "scaled". By default, it is set to "false". + +** prescale + -- Scaling for state-space models (SLICOT TB01ID) and descriptor models + (SLICOT TG01AD). + +** freqresp + -- Scale state-space models using @lti/prescale.m if property "scaled" is + set to "false". Frequency response commands now perform automatic + scaling unless model property "scaled" is set to "true". + + +=============================================================================== +control-2.0.2 Release Date: 2011-03-18 Release Manager: Lukas Reichlin +=============================================================================== + +** lsim + -- Fixed a logical error that refused valid initial state vectors. It was + due to a thinko introduced with the changes in control-2.0.1. + (Thanks to Rob Frohne) + + +=============================================================================== +control-2.0.1 Release Date: 2011-03-06 Release Manager: Lukas Reichlin +=============================================================================== + +** lsim + -- Support time vectors not starting at zero. (Thanks to Rob Frohne) + -- Improved help text. + +** zero + -- The gain of descriptor state-space models is now computed correctly. + (fingers crossed) + + +=============================================================================== +control-2.0.0 Release Date: 2011-02-08 Release Manager: Lukas Reichlin +=============================================================================== + +** First official release. + + +=============================================================================== diff --git a/octave_packages/control-2.3.52/place.m b/octave_packages/control-2.3.52/place.m new file mode 100644 index 0000000..2514444 --- /dev/null +++ b/octave_packages/control-2.3.52/place.m @@ -0,0 +1,186 @@ +## Copyright (C) 2009, 2010, 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{f} =} place (@var{sys}, @var{p}) +## @deftypefnx {Function File} {@var{f} =} place (@var{a}, @var{b}, @var{p}) +## @deftypefnx {Function File} {[@var{f}, @var{info}] =} place (@var{sys}, @var{p}, @var{alpha}) +## @deftypefnx {Function File} {[@var{f}, @var{info}] =} place (@var{a}, @var{b}, @var{p}, @var{alpha}) +## Pole assignment for a given matrix pair (@var{A},@var{B}) such that @code{p = eig (A-B*F)}. +## If parameter @var{alpha} is specified, poles with real parts (continuous-time) +## or moduli (discrete-time) below @var{alpha} are left untouched. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. +## @item a +## State transition matrix (n-by-n) of a continuous-time system. +## @item b +## Input matrix (n-by-m) of a continuous-time system. +## @item p +## Desired eigenvalues of the closed-loop system state-matrix @var{A-B*F}. +## @code{length (p) <= rows (A)}. +## @item alpha +## Specifies the maximum admissible value, either for real +## parts or for moduli, of the eigenvalues of @var{A} which will +## not be modified by the eigenvalue assignment algorithm. +## @code{alpha >= 0} for discrete-time systems. +## @end table +## +## @strong{Outputs} +## @table @var +## @item f +## State feedback gain matrix. +## @item info +## Structure containing additional information. +## @item info.nfp +## The number of fixed poles, i.e. eigenvalues of @var{A} having +## real parts less than @var{alpha}, or moduli less than @var{alpha}. +## These eigenvalues are not modified by @command{place}. +## @item info.nap +## The number of assigned eigenvalues. @code{nap = n-nfp-nup}. +## @item info.nup +## The number of uncontrollable eigenvalues detected by the +## eigenvalue assignment algorithm. +## @item info.z +## The orthogonal matrix @var{z} reduces the closed-loop +## system state matrix @code{A + B*F} to upper real Schur form. +## Note the positive sign in @code{A + B*F}. +## @end table +## +## @strong{Note} +## @example +## Place is also suitable to design estimator gains: +## @group +## L = place (A.', C.', p).' +## L = place (sys.', p).' # useful for discrete-time systems +## @end group +## @end example +## +## @strong{Algorithm}@* +## Uses SLICOT SB01BD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Special thanks to Peter Benner from TU Chemnitz for his advice. +## Author: Lukas Reichlin +## Created: December 2009 +## Version: 0.5 + +function [f, info] = place (a, b, p = [], alpha = [], tol = []) + + if (nargin < 2 || nargin > 5) + print_usage (); + endif + + if (isa (a, "lti")) # place (sys, p), place (sys, p, alpha), place (sys, p, alpha, tol) + if (nargin > 4) # nargin < 2 already tested + print_usage (); + endif + tol = alpha; + alpha = p; + p = b; + sys = a; + [a, b] = ssdata (sys); # descriptor matrice e should be regular + discrete = ! isct (sys); # treat tsam = -2 as continuous system + else # place (a, b, p), place (a, b, p, alpha), place (a, b, p, alpha, tol) + if (nargin < 3) # nargin > 5 already tested + print_usage (); + endif + if (! is_real_square_matrix (a) || ! is_real_matrix (b) || rows (a) != rows (b)) + error ("place: matrices a and b not conformal"); + endif + discrete = 0; # assume continuous system + endif + + if (! isnumeric (p) || ! isvector (p) || isempty (p)) # p could be complex + error ("place: p must be a vector"); + endif + + p = sort (reshape (p, [], 1)); # complex conjugate pairs must appear together + wr = real (p); + wi = imag (p); + + n = rows (a); # number of states + np = length (p); # number of given eigenvalues + + if (np > n) + error ("place: at most %d eigenvalues can be assigned for the given matrix a (%dx%d)", + n, n, n); + endif + + if (isempty (alpha)) + if (discrete) + alpha = 0; + else + alpha = - norm (a, inf); + endif + endif + + if (isempty (tol)) + tol = 0; + endif + + [f, nfp, nap, nup, z] = slsb01bd (a, b, wr, wi, discrete, alpha, tol); + f = -f; # A + B*F --> A - B*F + + info = struct ("nfp", nfp, "nap", nap, "nup", nup, "z", z); + +endfunction + + +## Test from "legacy" control package 1.0.* +%!shared A, B, C, P, Kexpected +%! A = [0, 1; 3, 2]; +%! B = [0; 1]; +%! C = [2, 1]; # C is needed for ss; it doesn't matter what the value of C is +%! P = [-1, -0.5]; +%! Kexpected = [3.5, 3.5]; +%!assert (place (ss (A, B, C), P), Kexpected, 2*eps); +%!assert (place (A, B, P), Kexpected, 2*eps); + +## FIXME: Test from SLICOT example SB01BD fails with 4 eigenvalues in P +%!shared F, F_exp, ev_ol, ev_cl +%! A = [-6.8000 0.0000 -207.0000 0.0000 +%! 1.0000 0.0000 0.0000 0.0000 +%! 43.2000 0.0000 0.0000 -4.2000 +%! 0.0000 0.0000 1.0000 0.0000]; +%! +%! B = [ 5.6400 0.0000 +%! 0.0000 0.0000 +%! 0.0000 1.1800 +%! 0.0000 0.0000]; +%! +%! P = [-0.5000 + 0.1500i +%! -0.5000 - 0.1500i]; +#%! -2.0000 + 0.0000i +#%! -0.4000 + 0.0000i]; +%! +%! ALPHA = -0.4; +%! TOL = 1e-8; +%! +%! F = place (A, B, P, ALPHA, TOL); +%! +%! F_exp = - [-0.0876 -4.2138 0.0837 -18.1412 +%! -0.0233 18.2483 -0.4259 -4.8120]; +%! +%! ev_ol = sort (eig (A)); +%! ev_cl = sort (eig (A - B*F)); +%! +%!assert (F, F_exp, 1e-4); +%!assert (ev_ol(3:4), ev_cl(3:4), 1e-4); diff --git a/octave_packages/control-2.3.52/pzmap.m b/octave_packages/control-2.3.52/pzmap.m new file mode 100644 index 0000000..769b091 --- /dev/null +++ b/octave_packages/control-2.3.52/pzmap.m @@ -0,0 +1,75 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} pzmap (@var{sys}) +## @deftypefnx {Function File} {[@var{p}, @var{z}] =} pzmap (@var{sys}) +## Plot the poles and zeros of an LTI system in the complex plane. +## If no output arguments are given, the result is plotted on the screen. +## Otherwise, the poles and zeros are computed and returned. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. +## @end table +## +## @strong{Outputs} +## @table @var +## @item p +## Poles of @var{sys}. +## @item z +## Transmission zeros of @var{sys}. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2009 +## Version: 0.1 + +function [pol_r, zer_r] = pzmap (sys) + + ## TODO: multiplot feature: pzmap (sys1, "b", sys2, "r", ...) + + if (nargin != 1) + print_usage (); + endif + + if (! isa (sys, "lti")) + error ("pzmap: argument must be an LTI system"); + endif + + pol = pole (sys); + zer = zero (sys); + + if (! nargout) + pol_re = real (pol); + pol_im = imag (pol); + zer_re = real (zer); + zer_im = imag (zer); + + plot (pol_re, pol_im, "xb", zer_re, zer_im, "or") + grid ("on") + title (["Pole-Zero Map of ", inputname(1)]) + xlabel ("Real Axis") + ylabel ("Imaginary Axis") + else + pol_r = pol; + zer_r = zer; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/rlocus.m b/octave_packages/control-2.3.52/rlocus.m new file mode 100644 index 0000000..2724fd3 --- /dev/null +++ b/octave_packages/control-2.3.52/rlocus.m @@ -0,0 +1,352 @@ +## Copyright (C) 1996, 2000, 2004, 2005, 2006, 2007 +## Auburn University. All rights reserved. +## +## +## This program is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} rlocus (@var{sys}) +## @deftypefnx {Function File} {[@var{rldata}, @var{k}] =} rlocus (@var{sys}, @var{increment}, @var{min_k}, @var{max_k}) +## Display root locus plot of the specified @acronym{SISO} system. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. Must be a single-input and single-output (SISO) system. +## @item min_k +## Minimum value of @var{k}. +## @item max_k +## Maximum value of @var{k}. +## @item increment +## The increment used in computing gain values. +## @end table +## +## @strong{Outputs} +## @table @var +## @item rldata +## Data points plotted: in column 1 real values, in column 2 the imaginary values. +## @item k +## Gains for real axis break points. +## @end table +## +## @strong{Block Diagram} +## @example +## @group +## u + +---+ +------+ y +## ------>(+)----->| k |----->| SISO |-------+-------> +## ^ - +---+ +------+ | +## | | +## +---------------------------------+ +## @end group +## @end example +## @end deftypefn + +## Author: David Clem +## Author: R. Bruce Tenison +## Updated by Kristi McGowan July 1996 for intelligent gain selection +## Updated by John Ingram July 1996 for systems + +## Adapted-By: Lukas Reichlin +## Date: December 2009 +## Version: 0.4 + +## TODO: Improve compatibility + +function [rldata_r, k_break, rlpol, gvec, real_ax_pts] = rlocus (sys, increment, min_k, max_k) + + ## TODO: multiplot feature: rlocus (sys1, "b", sys2, "r", ...) + + if (nargin < 1 || nargin > 4) + print_usage (); + endif + + if (! isa (sys, "lti") || ! issiso (sys)) + error ("rlocus: first argument must be a SISO LTI model"); + endif + + ## Convert the input to a transfer function if necessary + [num, den] = tfdata (sys, "vector"); # extract numerator/denominator polynomials + lnum = length (num); + lden = length (den); + ## equalize length of num, den polynomials + ## TODO: handle case lnum > lden (non-proper models) + if (lden < 2) + error ("rlocus: system has no poles"); + elseif (lnum < lden) + num = [zeros(1,lden-lnum), num]; # so that derivative is shortened by one + endif + + olpol = roots (den); + olzer = roots (num); + nas = lden - lnum; # number of asymptotes + maxk = 0; + if (nas > 0) + cas = (sum (olpol) - sum (olzer)) / nas; + angles = (2*[1:nas]-1)*pi/nas; + ## printf("rlocus: there are %d asymptotes centered at %f\n", nas, cas); + else + cas = angles = []; + maxk = 100*den(1)/num(1); + endif + + + ## compute real axis break points and corresponding gains + dnum = polyder (num); + dden = polyder (den); + brkp = conv (den, dnum) - conv (num, dden); + real_ax_pts = roots (brkp); + real_ax_pts = real_ax_pts(find (imag (real_ax_pts) == 0)); + k_break = -polyval (den, real_ax_pts) ./ polyval (num, real_ax_pts); + idx = find (k_break >= 0); + k_break = k_break(idx); + real_ax_pts = real_ax_pts(idx); + if (! isempty (k_break)) + maxk = max (max (k_break), maxk); + endif + + if (nas == 0) + maxk = max (1, 2*maxk); # get at least some root locus + else + ## get distance from breakpoints, poles, and zeros to center of asymptotes + dmax = 3*max (abs ([vec(olzer); vec(olpol); vec(real_ax_pts)] - cas)); + if (dmax == 0) + dmax = 1; + endif + + ## get gain for dmax along each asymptote, adjust maxk if necessary + svals = cas + dmax * exp (j*angles); + kvals = -polyval (den, svals) ./ polyval (num, svals); + maxk = max (maxk, max (real (kvals))); + endif + + ## check for input arguments: + if (nargin > 2) + mink = min_k; + else + mink = 0; + endif + if (nargin > 3) + maxk = max_k; + endif + if (nargin > 1) + if (increment <= 0) + error ("rlocus: increment must be positive"); + else + ngain = (maxk-mink)/increment; + endif + else + ngain = 30; + endif + + ## vector of gains + ngain = max (30, ngain); + gvec = linspace (mink, maxk, ngain); + if (length (k_break)) + gvec = sort ([gvec, reshape(k_break, 1, [])]); + endif + + ## Find the open loop zeros and the initial poles + rlzer = roots (num); + + ## update num to be the same length as den + lnum = length (num); + if (lnum < lden) + num = [zeros(1,lden - lnum),num]; + endif + + ## compute preliminary pole sets + nroots = lden - 1; + for ii = 1:ngain + gain = gvec(ii); + rlpol(1:nroots,ii) = vec(sort (roots (den + gain*num))); + endfor + + ## set smoothing tolerance + smtolx = 0.01*(max (max (real (rlpol))) - min (min (real (rlpol)))); + smtoly = 0.01*(max (max (imag (rlpol))) - min (min (imag (rlpol)))); + smtol = max (smtolx, smtoly); + ## sort according to nearest-neighbor + rlpol = sort_roots (rlpol, smtolx, smtoly); + + done = (nargin == 4); # perform a smoothness check + while (! done && ngain < 1000) + done = 1 ; # assume done + dp = abs (diff (rlpol.')).'; + maxdp = max (dp); + + ## search for poles whose neighbors are distant + if (lden == 2) + idx = find (dp > smtol); + else + idx = find (maxdp > smtol); + endif + + for ii = 1:length(idx) + i1 = idx(ii); + g1 = gvec(i1); + p1 = rlpol(:,i1); + + i2 = idx(ii)+1; + g2 = gvec(i2); + p2 = rlpol(:,i2); + + ## isolate poles in p1, p2 + if (max (abs (p2-p1)) > smtol) + newg = linspace (g1, g2, 5); + newg = newg(2:4); + gvec = [gvec,newg]; + done = 0; # need to process new gains + endif + endfor + + ## process new gain values + ngain1 = length (gvec); + for ii = (ngain+1):ngain1 + gain = gvec(ii); + rlpol(1:nroots,ii) = vec(sort (roots (den + gain*num))); + endfor + + [gvec, idx] = sort (gvec); + rlpol = rlpol(:,idx); + ngain = length (gvec); + ## sort according to nearest-neighbor + rlpol = sort_roots (rlpol, smtolx, smtoly); + endwhile + rldata = rlpol; + + ## Plot the data + if (nargout == 0) + rlpolv = vec(rlpol); + axdata = [real(rlpolv), imag(rlpolv); real(olzer), imag(olzer)]; + axlim = __axis_limits__ (axdata); + rldata = [real(rlpolv), imag(rlpolv) ]; + + %inname = get (sys, "inname"); + %outname = get (sys, "outname"); + + ## build plot command args pole by pole + + n_rlpol = rows (rlpol); + nelts = n_rlpol+1; + if (! isempty (rlzer)) + nelts++; + endif + ## add asymptotes + n_A = length (olpol) - length (olzer); + if (n_A > 0) + nelts += n_A; + endif + args = cell (3, nelts); + kk = 0; + ## asymptotes first + if (n_A > 0) + len_A = 2*max (abs (axlim)); + sigma_A = (sum(olpol) - sum(olzer))/n_A; + for i_A=0:n_A-1 + phi_A = pi*(2*i_A + 1)/n_A; + args{1,++kk} = [sigma_A sigma_A+len_A*cos(phi_A)]; + args{2,kk} = [0 len_A*sin(phi_A)]; + if (i_A == 1) + args{3,kk} = "k--;asymptotes;"; + else + args{3,kk} = "k--"; + endif + endfor + endif + ## locus next + for ii = 1:rows(rlpol) + args{1,++kk} = real (rlpol (ii,:)); + args{2,kk} = imag (rlpol (ii,:)); + if (ii == 1) + args{3,kk} = "b-;locus;"; + else + args{3,kk} = "b-"; + endif + endfor + ## poles and zeros last + args{1,++kk} = real (olpol); + args{2,kk} = imag (olpol); + args{3,kk} = "rx;open loop poles;"; + if (! isempty (rlzer)) + args{1,++kk} = real (rlzer); + args{2,kk} = imag (rlzer); + args{3,kk} = "go;zeros;"; + endif + + set (gcf,"visible","off"); + hplt = plot (args{:}); + set (hplt(kk--), "markersize", 2); + if (! isempty (rlzer)) + set (hplt(kk--), "markersize", 2); + endif + for ii = 1:rows(rlpol) + set (hplt(kk--), "linewidth", 2); + endfor + legend ("boxon", 2); + grid ("on"); + axis (axlim); + title (["Root Locus of ", inputname(1)]); + xlabel (sprintf ("Real Axis gain = [%g, %g]", gvec(1), gvec(ngain))); + ylabel ("Imaginary Axis"); + set (gcf (), "visible", "on"); + else + rldata_r = rldata; + endif +endfunction + + +function rlpol = sort_roots (rlpol, tolx, toly) + ## no point sorting of you've only got one pole! + if (rows (rlpol) == 1) + return; + endif + + ## reorder entries in each column of rlpol to be by their nearest-neighbors rlpol + dp = diff (rlpol.').'; + drp = max (real (dp)); + dip = max (imag (dp)); + idx = find (drp > tolx | dip > toly); + if (isempty (idx)) + return; + endif + + [np, ng] = size (rlpol); # num poles, num gains + for jj = idx + vals = rlpol(:,[jj,jj+1]); + jdx = (jj+1):ng; + for ii = 1:rows(rlpol-1) + rdx = ii:np; + dval = abs (rlpol(rdx,jj+1)-rlpol(ii,jj)); + mindist = min (dval); + sidx = min (find (dval == mindist)) + ii - 1; + if (sidx != ii) + c1 = norm (diff(vals.')); + [vals(ii,2), vals(sidx,2)] = swap (vals(ii,2), vals(sidx,2)); + c2 = norm (diff (vals.')); + if (c1 > c2) + ## perform the swap + [rlpol(ii,jdx), rlpol(sidx,jdx)] = swap (rlpol(ii,jdx), rlpol(sidx,jdx)); + vals = rlpol(:,[jj,jj+1]); + endif + endif + endfor + endfor + +endfunction + + +function [b, a] = swap (a, b) + +endfunction diff --git a/octave_packages/control-2.3.52/sigma.m b/octave_packages/control-2.3.52/sigma.m new file mode 100644 index 0000000..13e238d --- /dev/null +++ b/octave_packages/control-2.3.52/sigma.m @@ -0,0 +1,117 @@ +## Copyright (C) 2009, 2010, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{sv}, @var{w}] =} sigma (@var{sys}) +## @deftypefnx{Function File} {[@var{sv}, @var{w}] =} sigma (@var{sys}, @var{w}) +## @deftypefnx{Function File} {[@var{sv}, @var{w}] =} sigma (@var{sys}, @var{[]}, @var{ptype}) +## @deftypefnx{Function File} {[@var{sv}, @var{w}] =} sigma (@var{sys}, @var{w}, @var{ptype}) +## Singular values of frequency response. If no output arguments are given, +## the singular value plot is printed on the screen; +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI system. Multiple inputs and/or outputs (MIMO systems) make practical sense. +## @item w +## Optional vector of frequency values. If @var{w} is not specified, +## it is calculated by the zeros and poles of the system. +## Alternatively, the cell @code{@{wmin, wmax@}} specifies a frequency range, +## where @var{wmin} and @var{wmax} denote minimum and maximum frequencies +## in rad/s. +## @item ptype = 0 +## Singular values of the frequency response @var{H} of system @var{sys}. Default Value. +## @item ptype = 1 +## Singular values of the frequency response @code{inv(H)}; i.e. inversed system. +## @item ptype = 2 +## Singular values of the frequency response @code{I + H}; i.e. inversed sensitivity +## (or return difference) if @code{H = P * C}. +## @item ptype = 3 +## Singular values of the frequency response @code{I + inv(H)}; i.e. inversed complementary +## sensitivity if @code{H = P * C}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item sv +## Array of singular values. For a system with m inputs and p outputs, the array sv +## has @code{min (m, p)} rows and as many columns as frequency points @code{length (w)}. +## The singular values at the frequency @code{w(k)} are given by @code{sv(:,k)}. +## @item w +## Vector of frequency values used. +## @end table +## +## @seealso{bodemag, svd} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2009 +## Version: 0.6 + +function [sv_r, w_r] = sigma (sys, w = [], resptype = 0) + + ## TODO: multiplot feature: sigma (sys1, "b", sys2, "r", ...) + + if (nargin == 0 || nargin > 3) + print_usage (); + endif + + [H, w] = __frequency_response__ (sys, w, true, resptype, "std", true); + + sv = cellfun (@svd, H, "uniformoutput", false); + sv = horzcat (sv{:}); + + if (! nargout) # plot the information + + ## convert to dB for plotting + sv_db = 20 * log10 (sv); + + ## determine xlabel + if (isct (sys)) + xl_str = "Frequency [rad/s]"; + else + xl_str = sprintf ("Frequency [rad/s] w_N = %g", pi / get (sys, "tsam")); + endif + + ## plot results + semilogx (w, sv_db, "b") + axis ("tight") + ylim (__axis_margin__ (ylim)) + grid ("on") + title (["Singular Values of ", inputname(1)]) + xlabel (xl_str) + ylabel ("Singular Values [dB]") + else # return values + sv_r = sv; + w_r = reshape (w, [], 1); + endif + +endfunction + + +%!shared sv_exp, w_exp, sv_obs, w_obs +%! A = [1, 2; 3, 4]; +%! B = [5, 6; 7, 8]; +%! C = [4, 3; 2, 1]; +%! D = [8, 7; 6, 5]; +%! w = [2, 3, 4]; +%! sv_exp = [7.9176, 8.6275, 9.4393; +%! 0.6985, 0.6086, 0.5195]; +%! w_exp = [2; 3; 4]; +%! [sv_obs, w_obs] = sigma (ss (A, B, C, D), w); +%!assert (sv_obs, sv_exp, 1e-4); +%!assert (w_obs, w_exp, 1e-4); diff --git a/octave_packages/control-2.3.52/spaconred.m b/octave_packages/control-2.3.52/spaconred.m new file mode 100644 index 0000000..5061533 --- /dev/null +++ b/octave_packages/control-2.3.52/spaconred.m @@ -0,0 +1,232 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{Kr}, @var{info}] =} spaconred (@var{G}, @var{K}, @dots{}) +## @deftypefnx{Function File} {[@var{Kr}, @var{info}] =} spaconred (@var{G}, @var{K}, @var{ncr}, @dots{}) +## @deftypefnx{Function File} {[@var{Kr}, @var{info}] =} spaconred (@var{G}, @var{K}, @var{opt}, @dots{}) +## @deftypefnx{Function File} {[@var{Kr}, @var{info}] =} spaconred (@var{G}, @var{K}, @var{ncr}, @var{opt}, @dots{}) +## +## Controller reduction by frequency-weighted Singular Perturbation Approximation (SPA). +## Given a plant @var{G} and a stabilizing controller @var{K}, determine a reduced +## order controller @var{Kr} such that the closed-loop system is stable and closed-loop +## performance is retained. +## +## The algorithm tries to minimize the frequency-weighted error +## @iftex +## @tex +## $$ || V \\ (K - K_r) \\ W ||_{\\infty} = min $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## ||V (K-Kr) W|| = min +## inf +## @end example +## @end ifnottex +## where @var{V} and @var{W} denote output and input weightings. +## +## +## @strong{Inputs} +## @table @var +## @item G +## LTI model of the plant. +## It has m inputs, p outputs and n states. +## @item K +## LTI model of the controller. +## It has p inputs, m outputs and nc states. +## @item ncr +## The desired order of the resulting reduced order controller @var{Kr}. +## If not specified, @var{ncr} is chosen automatically according +## to the description of key @var{'order'}. +## @item @dots{} +## Optional pairs of keys and values. @code{"key1", value1, "key2", value2}. +## @item opt +## Optional struct with keys as field names. +## Struct @var{opt} can be created directly or +## by command @command{options}. @code{opt.key1 = value1, opt.key2 = value2}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item Kr +## State-space model of reduced order controller. +## @item info +## Struct containing additional information. +## @table @var +## @item info.ncr +## The order of the obtained reduced order controller @var{Kr}. +## @item info.ncs +## The order of the alpha-stable part of original controller @var{K}. +## @item info.hsvc +## The Hankel singular values of the alpha-stable part of @var{K}. +## The @var{ncs} Hankel singular values are ordered decreasingly. +## @end table +## @end table +## +## @strong{Option Keys and Values} +## @table @var +## @item 'order', 'ncr' +## The desired order of the resulting reduced order controller @var{Kr}. +## If not specified, @var{ncr} is chosen automatically such that states with +## Hankel singular values @var{info.hsvc} > @var{tol1} are retained. +## +## @item 'method' +## Order reduction approach to be used as follows: +## @table @var +## @item 'sr', 's' +## Use the square-root Singular Perturbation Approximation method. +## @item 'bfsr', 'p' +## Use the balancing-free square-root Singular Perturbation Approximation method. Default method. +## @end table +## +## @item 'weight' +## Specifies the type of frequency-weighting as follows: +## @table @var +## @item 'none' +## No weightings are used (V = I, W = I). +## +## @item 'left', 'output' +## Use stability enforcing left (output) weighting +## @iftex +## @tex +## $$ V = (I - G K)^{-1} G, \\qquad W = I $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## -1 +## V = (I-G*K) *G , W = I +## @end example +## @end ifnottex +## +## @item 'right', 'input' +## Use stability enforcing right (input) weighting +## @iftex +## @tex +## $$ V = I, \\qquad W = (I - G K)^{-1} G $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## -1 +## V = I , W = (I-G*K) *G +## @end example +## @end ifnottex +## +## @item 'both', 'performance' +## Use stability and performance enforcing weightings +## @iftex +## @tex +## $$ V = (I - G K)^{-1} G, \\qquad W = (I - G K)^{-1} $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## -1 -1 +## V = (I-G*K) *G , W = (I-G*K) +## @end example +## @end ifnottex +## Default value. +## @end table +## +## @item 'feedback' +## Specifies whether @var{K} is a positive or negative feedback controller: +## @table @var +## @item '+' +## Use positive feedback controller. Default value. +## @item '-' +## Use negative feedback controller. +## @end table +## +## @item 'alpha' +## Specifies the ALPHA-stability boundary for the eigenvalues +## of the state dynamics matrix @var{K.A}. For a continuous-time +## controller, ALPHA <= 0 is the boundary value for +## the real parts of eigenvalues, while for a discrete-time +## controller, 0 <= ALPHA <= 1 represents the +## boundary value for the moduli of eigenvalues. +## The ALPHA-stability domain does not include the boundary. +## Default value is 0 for continuous-time controllers and +## 1 for discrete-time controllers. +## +## @item 'tol1' +## If @var{'order'} is not specified, @var{tol1} contains the tolerance for +## determining the order of the reduced controller. +## For model reduction, the recommended value of @var{tol1} is +## c*info.hsvc(1), where c lies in the interval [0.00001, 0.001]. +## Default value is info.ncs*eps*info.hsvc(1). +## If @var{'order'} is specified, the value of @var{tol1} is ignored. +## +## @item 'tol2' +## The tolerance for determining the order of a minimal +## realization of the ALPHA-stable part of the given +## controller. TOL2 <= TOL1. +## If not specified, ncs*eps*info.hsvc(1) is chosen. +## +## @item 'gram-ctrb' +## Specifies the choice of frequency-weighted controllability +## Grammian as follows: +## @table @var +## @item 'standard' +## Choice corresponding to standard Enns' method [1]. Default method. +## @item 'enhanced' +## Choice corresponding to the stability enhanced +## modified Enns' method of [2]. +## @end table +## +## @item 'gram-obsv' +## Specifies the choice of frequency-weighted observability +## Grammian as follows: +## @table @var +## @item 'standard' +## Choice corresponding to standard Enns' method [1]. Default method. +## @item 'enhanced' +## Choice corresponding to the stability enhanced +## modified Enns' method of [2]. +## @end table +## +## @item 'equil', 'scale' +## Boolean indicating whether equilibration (scaling) should be +## performed on @var{G} and @var{K} prior to order reduction. +## Default value is false if both @code{G.scaled == true, K.scaled == true} +## and true otherwise. +## Note that for @acronym{MIMO} models, proper scaling of both inputs and outputs +## is of utmost importance. The input and output scaling can @strong{not} +## be done by the equilibration option or the @command{prescale} command +## because these functions perform state transformations only. +## Furthermore, signals should not be scaled simply to a certain range. +## For all inputs (or outputs), a certain change should be of the same +## importance for the model. +## @end table +## +## @strong{Algorithm}@* +## Uses SLICOT SB16AD by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: December 2011 +## Version: 0.1 + +function [Kr, info] = spaconred (varargin) + + [Kr, info] = __conred_sb16ad__ ("spa", varargin{:}); + +endfunction + +## TODO: add a test \ No newline at end of file diff --git a/octave_packages/control-2.3.52/spamodred.m b/octave_packages/control-2.3.52/spamodred.m new file mode 100644 index 0000000..63ad5e5 --- /dev/null +++ b/octave_packages/control-2.3.52/spamodred.m @@ -0,0 +1,232 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{Gr}, @var{info}] =} spamodred (@var{G}, @dots{}) +## @deftypefnx{Function File} {[@var{Gr}, @var{info}] =} spamodred (@var{G}, @var{nr}, @dots{}) +## @deftypefnx{Function File} {[@var{Gr}, @var{info}] =} spamodred (@var{G}, @var{opt}, @dots{}) +## @deftypefnx{Function File} {[@var{Gr}, @var{info}] =} spamodred (@var{G}, @var{nr}, @var{opt}, @dots{}) +## +## Model order reduction by frequency weighted Singular Perturbation Approximation (SPA). +## The aim of model reduction is to find an LTI system @var{Gr} of order +## @var{nr} (nr < n) such that the input-output behaviour of @var{Gr} +## approximates the one from original system @var{G}. +## +## SPA is an absolute error method which tries to minimize +## @iftex +## @tex +## $$ || G - G_r ||_{\\infty} = min $$ +## $$ || V \\ (G - G_r) \\ W ||_{\\infty} = min $$ +## @end tex +## @end iftex +## @ifnottex +## @example +## ||G-Gr|| = min +## inf +## +## ||V (G-Gr) W|| = min +## inf +## @end example +## @end ifnottex +## where @var{V} and @var{W} denote output and input weightings. +## +## +## @strong{Inputs} +## @table @var +## @item G +## LTI model to be reduced. +## @item nr +## The desired order of the resulting reduced order system @var{Gr}. +## If not specified, @var{nr} is chosen automatically according +## to the description of key @var{'order'}. +## @item @dots{} +## Optional pairs of keys and values. @code{"key1", value1, "key2", value2}. +## @item opt +## Optional struct with keys as field names. +## Struct @var{opt} can be created directly or +## by command @command{options}. @code{opt.key1 = value1, opt.key2 = value2}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item Gr +## Reduced order state-space model. +## @item info +## Struct containing additional information. +## @table @var +## @item info.n +## The order of the original system @var{G}. +## @item info.ns +## The order of the @var{alpha}-stable subsystem of the original system @var{G}. +## @item info.hsv +## The Hankel singular values of the @var{alpha}-stable part of +## the original system @var{G}, ordered decreasingly. +## @item info.nu +## The order of the @var{alpha}-unstable subsystem of both the original +## system @var{G} and the reduced-order system @var{Gr}. +## @item info.nr +## The order of the obtained reduced order system @var{Gr}. +## @end table +## @end table +## +## +## @strong{Option Keys and Values} +## @table @var +## @item 'order', 'nr' +## The desired order of the resulting reduced order system @var{Gr}. +## If not specified, @var{nr} is chosen automatically such that states with +## Hankel singular values @var{info.hsv} > @var{tol1} are retained. +## +## @item 'left', 'output' +## LTI model of the left/output frequency weighting @var{V}. +## Default value is an identity matrix. +## +## @item 'right', 'input' +## LTI model of the right/input frequency weighting @var{W}. +## Default value is an identity matrix. +## +## @item 'method' +## Approximation method for the L-infinity norm to be used as follows: +## @table @var +## @item 'sr', 's' +## Use the square-root Singular Perturbation Approximation method. +## @item 'bfsr', 'p' +## Use the balancing-free square-root Singular Perturbation Approximation method. Default method. +## @end table +## +## @item 'alpha' +## Specifies the ALPHA-stability boundary for the eigenvalues +## of the state dynamics matrix @var{G.A}. For a continuous-time +## system, ALPHA <= 0 is the boundary value for +## the real parts of eigenvalues, while for a discrete-time +## system, 0 <= ALPHA <= 1 represents the +## boundary value for the moduli of eigenvalues. +## The ALPHA-stability domain does not include the boundary. +## Default value is 0 for continuous-time systems and +## 1 for discrete-time systems. +## +## @item 'tol1' +## If @var{'order'} is not specified, @var{tol1} contains the tolerance for +## determining the order of the reduced model. +## For model reduction, the recommended value of @var{tol1} is +## c*info.hsv(1), where c lies in the interval [0.00001, 0.001]. +## Default value is info.ns*eps*info.hsv(1). +## If @var{'order'} is specified, the value of @var{tol1} is ignored. +## +## @item 'tol2' +## The tolerance for determining the order of a minimal +## realization of the ALPHA-stable part of the given +## model. TOL2 <= TOL1. +## If not specified, ns*eps*info.hsv(1) is chosen. +## +## @item 'gram-ctrb' +## Specifies the choice of frequency-weighted controllability +## Grammian as follows: +## @table @var +## @item 'standard' +## Choice corresponding to a combination method [4] +## of the approaches of Enns [1] and Lin-Chiu [2,3]. Default method. +## @item 'enhanced' +## Choice corresponding to the stability enhanced +## modified combination method of [4]. +## @end table +## +## @item 'gram-obsv' +## Specifies the choice of frequency-weighted observability +## Grammian as follows: +## @table @var +## @item 'standard' +## Choice corresponding to a combination method [4] +## of the approaches of Enns [1] and Lin-Chiu [2,3]. Default method. +## @item 'enhanced' +## Choice corresponding to the stability enhanced +## modified combination method of [4]. +## @end table +## +## @item 'alpha-ctrb' +## Combination method parameter for defining the +## frequency-weighted controllability Grammian. +## abs(alphac) <= 1. +## If alphac = 0, the choice of +## Grammian corresponds to the method of Enns [1], while if +## alphac = 1, the choice of Grammian corresponds +## to the method of Lin and Chiu [2,3]. +## Default value is 0. +## +## @item 'alpha-obsv' +## Combination method parameter for defining the +## frequency-weighted observability Grammian. +## abs(alphao) <= 1. +## If alphao = 0, the choice of +## Grammian corresponds to the method of Enns [1], while if +## alphao = 1, the choice of Grammian corresponds +## to the method of Lin and Chiu [2,3]. +## Default value is 0. +## +## @item 'equil', 'scale' +## Boolean indicating whether equilibration (scaling) should be +## performed on system @var{G} prior to order reduction. +## Default value is true if @code{G.scaled == false} and +## false if @code{G.scaled == true}. +## Note that for @acronym{MIMO} models, proper scaling of both inputs and outputs +## is of utmost importance. The input and output scaling can @strong{not} +## be done by the equilibration option or the @command{prescale} command +## because these functions perform state transformations only. +## Furthermore, signals should not be scaled simply to a certain range. +## For all inputs (or outputs), a certain change should be of the same +## importance for the model. +## @end table +## +## +## @strong{References}@* +## [1] Enns, D. +## Model reduction with balanced realizations: An error bound +## and a frequency weighted generalization. +## Proc. 23-th CDC, Las Vegas, pp. 127-132, 1984. +## +## [2] Lin, C.-A. and Chiu, T.-Y. +## Model reduction via frequency-weighted balanced realization. +## Control Theory and Advanced Technology, vol. 8, +## pp. 341-351, 1992. +## +## [3] Sreeram, V., Anderson, B.D.O and Madievski, A.G. +## New results on frequency weighted balanced reduction +## technique. +## Proc. ACC, Seattle, Washington, pp. 4004-4009, 1995. +## +## [4] Varga, A. and Anderson, B.D.O. +## Square-root balancing-free methods for the frequency-weighted +## balancing related model reduction. +## (report in preparation) +## +## +## @strong{Algorithm}@* +## Uses SLICOT AB09ID by courtesy of +## @uref{http://www.slicot.org, NICONET e.V.} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function [Gr, info] = spamodred (varargin) + + [Gr, info] = __modred_ab09id__ ("spa", varargin{:}); + +endfunction + +## TODO: add a test \ No newline at end of file diff --git a/octave_packages/control-2.3.52/step.m b/octave_packages/control-2.3.52/step.m new file mode 100644 index 0000000..0160c65 --- /dev/null +++ b/octave_packages/control-2.3.52/step.m @@ -0,0 +1,75 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{y}, @var{t}, @var{x}] =} step (@var{sys}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} step (@var{sys}, @var{t}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} step (@var{sys}, @var{tfinal}) +## @deftypefnx{Function File} {[@var{y}, @var{t}, @var{x}] =} step (@var{sys}, @var{tfinal}, @var{dt}) +## Step response of LTI system. +## If no output arguments are given, the response is printed on the screen. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model. +## @item t +## Time vector. Should be evenly spaced. If not specified, it is calculated by +## the poles of the system to reflect adequately the response transients. +## @item tfinal +## Optional simulation horizon. If not specified, it is calculated by +## the poles of the system to reflect adequately the response transients. +## @item dt +## Optional sampling time. Be sure to choose it small enough to capture transient +## phenomena. If not specified, it is calculated by the poles of the system. +## @end table +## +## @strong{Outputs} +## @table @var +## @item y +## Output response array. Has as many rows as time samples (length of t) +## and as many columns as outputs. +## @item t +## Time row vector. +## @item x +## State trajectories array. Has @code{length (t)} rows and as many columns as states. +## @end table +## +## @seealso{impulse, initial, lsim} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: October 2009 +## Version: 0.1 + +function [y_r, t_r, x_r] = step (sys, tfinal = [], dt = []) + + ## TODO: multiplot feature: step (sys1, "b", sys2, "r", ...) + + if (nargin == 0 || nargin > 3) + print_usage (); + endif + + [y, t, x] = __time_response__ (sys, "step", ! nargout, tfinal, dt, [], inputname (1)); + + if (nargout) + y_r = y; + t_r = t; + x_r = x; + endif + +endfunction diff --git a/octave_packages/control-2.3.52/strseq.m b/octave_packages/control-2.3.52/strseq.m new file mode 100644 index 0000000..5a0a8a8 --- /dev/null +++ b/octave_packages/control-2.3.52/strseq.m @@ -0,0 +1,41 @@ +## Copyright (C) 2009, 2010, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{strvec} =} strseq (@var{str}, @var{idx}) +## Return a cell vector of indexed strings by appending the indices @var{idx} +## to the string @var{str}. +## +## @example +## strseq ("x", 1:3) = @{"x1"; "x2"; "x3"@} +## strseq ("u", [1, 2, 5]) = @{"u1"; "u2"; "u5"@} +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.3 + +function strvec = strseq (str, idx) + + if (nargin != 2 || ! ischar (str) || ! isnumeric (idx)) + print_usage (); + endif + + strvec = arrayfun (@(x) sprintf ("%s%d", str, x), idx(:), "uniformoutput", false); + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/test_control.m b/octave_packages/control-2.3.52/test_control.m new file mode 100644 index 0000000..450b38e --- /dev/null +++ b/octave_packages/control-2.3.52/test_control.m @@ -0,0 +1,105 @@ +## Copyright (C) 2010, 2011, 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Script File} {} test_control +## Execute all available tests at once. +## The Octave control package is based on the @uref{http://www.slicot.org, SLICOT} library. +## SLICOT needs a LAPACK library which is also a prerequisite for Octave itself. +## In case of failing test, it is highly recommended to use +## @uref{http://www.netlib.org/lapack/, Netlib's reference LAPACK} +## for building Octave. Using ATLAS may lead to sign changes +## in some entries in the state-space matrices. +## In general, these sign changes are not 'wrong' and can be regarded as +## the result of state transformations. Such state transformations +## (but not input/output transformations) have no influence on the +## input-output behaviour of the system. For better numerics, +## the control package uses such transformations by default when +## calculating the frequency responses and a few other things. +## However, arguments like the Hankel singular Values (HSV) must not change. +## Differing HSVs and failing algorithms are known for using Framework Accelerate +## from Mac OS X 10.7. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.4 + +## test collection +test ltimodels + +## LTI methods +test @lti/c2d +test @lti/d2c +test @lti/feedback +test @lti/horzcat +test @lti/inv +test @lti/minreal +test @lti/mtimes +test @lti/norm +test @lti/plus +test @lti/prescale +test @lti/sminreal +test @lti/subsref +test @lti/zero + +## robust control +test h2syn +test hinfsyn +test ncfsyn + +## ARE solvers +test care +test dare +test kalman + +## Lyapunov +test covar +test dlyap +## test dlyapchol # TODO: add tests +test gram +test lyap +test lyapchol + +## model order reduction +test bstmodred +test btamodred +test hnamodred +## test spamodred # TODO: create test case + +## controller order reduction +test btaconred +test cfconred +test fwcfconred +## test spaconred # TODO: create test case + +## identification +test fitfrd + +## various oct-files +test ctrbf +test hsvd +test place + +## various m-files +test ctrb +test filt +test initial +test issample +test margin +test obsv +test sigma diff --git a/octave_packages/control-2.3.52/tfpoly2str.m b/octave_packages/control-2.3.52/tfpoly2str.m new file mode 100644 index 0000000..90c243d --- /dev/null +++ b/octave_packages/control-2.3.52/tfpoly2str.m @@ -0,0 +1,104 @@ +## Copyright (C) 2012 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{str} =} tfpoly2str (@var{p}) +## @deftypefnx {Function File} {@var{str} =} tfpoly2str (@var{p}, @var{tfvar}) +## Return the string of a polynomial with string @var{tfvar} as variable. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2012 +## Version: 0.1 + +function str = tfpoly2str (p, tfvar = "x") + + ## TODO: simplify this ugly code + + str = ""; + + lp = numel (p); + + if (lp > 0) # first element (lowest order) + idx = find (p); # first non-zero element + if (isempty (idx)) + str = "0"; + return; + else + idx = idx(1); + endif + a = p(idx); + + if (a < 0) + cs = "-"; + else + cs = ""; + endif + + if (idx == 1) + str = [cs, num2str(abs (a), 4)]; + else + if (abs (a) == 1) + str = [cs, __variable__(tfvar, idx-1)]; + else + str = [cs, __coefficient__(a), " ", __variable__(tfvar, idx-1)]; + endif + endif + + if (lp > idx) # remaining elements of higher order + for k = idx+1 : lp + a = p(k); + + if (a != 0) + if (a < 0) + cs = " - "; + else + cs = " + "; + endif + + if (abs (a) == 1) + str = [str, cs, __variable__(tfvar, k-1)]; + else + str = [str, cs, __coefficient__(a), " ", __variable__(tfvar, k-1)]; + endif + endif + endfor + + endif + endif + +endfunction + + +function str = __coefficient__ (a) + + b = abs (a); + + if (b == 1) + str = ""; + else + str = num2str (b, 4); + endif + +endfunction + + +function str = __variable__ (tfvar, n) + + str = [tfvar, "^-", num2str(n)]; + +endfunction diff --git a/octave_packages/control-2.3.52/tfpolyones.m b/octave_packages/control-2.3.52/tfpolyones.m new file mode 100644 index 0000000..e3d569a --- /dev/null +++ b/octave_packages/control-2.3.52/tfpolyones.m @@ -0,0 +1,33 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Return (pxm) cell of tfpoly([1]). For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function ret = tfpolyones (p, m) + + ret = cell (p, m); + + one = tfpoly ([1]); + + ret(:) = {one}; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/tfpolyzeros.m b/octave_packages/control-2.3.52/tfpolyzeros.m new file mode 100644 index 0000000..8882b50 --- /dev/null +++ b/octave_packages/control-2.3.52/tfpolyzeros.m @@ -0,0 +1,33 @@ +## Copyright (C) 2009 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## Return (pxm) cell of tfpoly([0]). For internal use only. + +## Author: Lukas Reichlin +## Created: September 2009 +## Version: 0.1 + +function ret = tfpolyzeros (p, m) + + ret = cell (p, m); + + zero = tfpoly ([0]); + + ret(:) = {zero}; + +endfunction \ No newline at end of file diff --git a/octave_packages/control-2.3.52/zpk.m b/octave_packages/control-2.3.52/zpk.m new file mode 100644 index 0000000..e7dbb99 --- /dev/null +++ b/octave_packages/control-2.3.52/zpk.m @@ -0,0 +1,105 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This file is part of LTI Syncope. +## +## LTI Syncope is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## LTI Syncope is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with LTI Syncope. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{s} =} zpk (@var{"s"}) +## @deftypefnx {Function File} {@var{z} =} zpk (@var{"z"}, @var{tsam}) +## @deftypefnx {Function File} {@var{sys} =} zpk (@var{sys}) +## @deftypefnx {Function File} {@var{sys} =} zpk (@var{k}) +## @deftypefnx {Function File} {@var{sys} =} zpk (@var{z}, @var{p}, @var{k}, @dots{}) +## @deftypefnx {Function File} {@var{sys} =} zpk (@var{z}, @var{p}, @var{k}, @var{tsam}, @dots{}) +## @deftypefnx {Function File} {@var{sys} =} zpk (@var{z}, @var{p}, @var{k}, @var{tsam}, @dots{}) +## Create transfer function model from zero-pole-gain data. +## This is just a stop-gap compatibility wrapper since zpk +## models are not yet implemented. +## +## @strong{Inputs} +## @table @var +## @item sys +## LTI model to be converted to transfer function. +## @item z +## Cell of vectors containing the zeros for each channel. +## z@{i,j@} contains the zeros from input j to output i. +## In the SISO case, a single vector is accepted as well. +## @item p +## Cell of vectors containing the poles for each channel. +## p@{i,j@} contains the poles from input j to output i. +## In the SISO case, a single vector is accepted as well. +## @item k +## Matrix containing the gains for each channel. +## k(i,j) contains the gain from input j to output i. +## @item tsam +## Sampling time in seconds. If @var{tsam} is not specified, +## a continuous-time model is assumed. +## @item @dots{} +## Optional pairs of properties and values. +## Type @command{set (tf)} for more information. +## @end table +## +## @strong{Outputs} +## @table @var +## @item sys +## Transfer function model. +## @end table +## +## @seealso{tf, ss, dss, frd} +## @end deftypefn + +## Author: Lukas Reichlin +## Created: September 2011 +## Version: 0.1 + +function sys = zpk (z = {}, p = {}, k = [], varargin) + + switch (nargin) + case 0 # sys = zpk () + sys = tf (); + return; + + case 1 # sys = zpk (sys), sys = zpk (k), s = zpk ("s") + if (isa (z, "lti") || is_real_matrix (z) || ischar (z)) + sys = tf (z); + return; + else + print_usage (); + endif + + case 2 # z = zpk ("z", tsam) + if (ischar (z) && issample (p, -1)) + sys = tf (z, p); + return; + else + print_usage (); + endif + + otherwise # sys = zpk (z, p, k, ...) + if (! iscell (z)) + z = {z}; + endif + if (! iscell (p)) + p = {p}; + endif + if (! size_equal (z, p, k)) + error ("zpk: arguments z, p and k must have equal dimensions"); + endif + num = cellfun (@(zer, gain) real (gain * poly (zer)), z, num2cell (k), "uniformoutput", false); + den = cellfun (@(pol) real (poly (pol)), p, "uniformoutput", false); + sys = tf (num, den, varargin{:}); + endswitch + +endfunction + diff --git a/octave_packages/data-smoothing-1.3.0/ddmat.m b/octave_packages/data-smoothing-1.3.0/ddmat.m new file mode 100644 index 0000000..1b1289d --- /dev/null +++ b/octave_packages/data-smoothing-1.3.0/ddmat.m @@ -0,0 +1,53 @@ +## Copyright (C) 2003 Paul H. C. Eilers +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{D} =} ddmat (@var{x}, @var{o}) +## Compute divided differencing matrix of order @var{o} +## +## @itemize @w +## @item Input +## @itemize @w +## @item @var{x}: vector of sampling positions +## @item @var{o}: order of diffferences +## @end itemize +## @item Output +## @itemize @w +## @item @var{D}: the matrix; @var{D} * Y gives divided differences of order @var{o} +## @end itemize +## @end itemize +## +## References: Anal. Chem. (2003) 75, 3631. +## +## @end deftypefn + +## corrected the recursion multiplier; JJS 2/25/08 +## added error check that x is a column vector; JJS 4/13/09 + +function D = ddmat(x, d) + if (nargin != 2) + print_usage; + elseif ( !iscolumn (x) ) + error("x should be a column vector") + endif + m = length(x); + if d == 0 + D = speye(m); + else + dx = x((d + 1):m) - x(1:(m - d)); + V = sparse(diag(1 ./ dx)); + D = d * V * diff(ddmat(x, d - 1)); + endif +endfunction diff --git a/octave_packages/data-smoothing-1.3.0/doc-cache b/octave_packages/data-smoothing-1.3.0/doc-cache new file mode 100644 index 0000000..e5f54f9 --- /dev/null +++ b/octave_packages/data-smoothing-1.3.0/doc-cache @@ -0,0 +1,211 @@ +# Created by Octave 3.6.1, Thu Mar 22 19:35:12 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 4 +# name: +# type: sq_string +# elements: 1 +# length: 5 +ddmat + + +# name: +# type: sq_string +# elements: 1 +# length: 352 + -- Function File: D = ddmat (X, O) + Compute divided differencing matrix of order O + + Input + X: vector of sampling positions + + O: order of diffferences + + Output + D: the matrix; D * Y gives divided differences of order + O + + References: Anal. Chem. (2003) 75, 3631. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Compute divided differencing matrix of order O + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +regdatasmooth + + +# name: +# type: sq_string +# elements: 1 +# length: 1939 + -- Function File: [YHAT, LAMBDA] = regdatasmooth (X, Y, [OPTIONS]) + Smooths the Y vs. X values of 1D data by Tikhonov regularization. + The smooth y-values are returned as YHAT. The regularization + parameter LAMBDA that was used for the smoothing may also be + returned. + + Note: the options have changed! Currently supported input + options are (multiple options are allowed): + + `"d", VALUE' + the smoothing derivative to use (default = 2) + + `"lambda", VALUE' + the regularization paramater to use + + `"stdev", VALUE' + the standard deviation of the measurement of Y; an optimal + value for lambda will be determined by matching the provided + VALUE with the standard devation of YHAT-Y; if the option + "relative" is also used, then a relative standard deviation + is inferred + + `"gcv"' + use generalized cross-validation to determine the optimal + value for lambda; if neither "lambda" nor "stdev" options are + given, this option is implied + + `"lguess", VALUE' + the initial value for lambda to use in the iterative + minimization algorithm to find the optimal value (default = 1) + + `"xhat", VECTOR' + A vector of x-values to use for the smooth curve; must be + monotonically increasing and must at least span the data + + `"weights", VECTOR' + A vector of weighting values for fitting each point in the + data. + + `"relative"' + use relative differences for the goodnes of fit term. + Conflicts with the "weights" option. + + `"midpointrule"' + use the midpoint rule for the integration terms rather than a + direct sum; this option conflicts with the option "xhat" + + Please run the demos for example usage. + + References: Anal. Chem. (2003) 75, 3631; AIChE J. (2006) 52, 325 + + See also: rgdtsmcorewrap, rgdtsmcore + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +Smooths the Y vs. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +rgdtsmcore + + +# name: +# type: sq_string +# elements: 1 +# length: 1279 + -- Function File: [YHAT, V] = rgdtsmcore (X, Y, D, LAMBDA, [OPTIONS]) + Smooths Y vs. X values by Tikhonov regularization. Although this + function can be used directly, the more feature rich function + "regdatasmooth" should be used instead. In addition to X and Y, + required input includes the smoothing derivative D and the + regularization parameter LAMBDA. The smooth y-values are returned + as YHAT. The generalized cross validation variance V may also be + returned. + + Note: the options have changed! Currently supported input + options are (multiple options are allowed): + + `"xhat", VECTOR' + A vector of x-values to use for the smooth curve; must be + monotonically increasing and must at least span the data + + `"weights", VECTOR' + A vector of weighting values for fitting each point in the + data. + + `"relative"' + use relative differences for the goodnes of fit term. + Conflicts with the "weights" option. + + `"midpointrule"' + use the midpoint rule for the integration terms rather than a + direct sum; this option conflicts with the option "xhat" + + References: Anal. Chem. (2003) 75, 3631; AIChE J. (2006) 52, 325 + + See also: regdatasmooth + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +Smooths Y vs. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +rgdtsmcorewrap + + +# name: +# type: sq_string +# elements: 1 +# length: 485 + -- Function File: CVE = rgdtsmcorewrap (LOG10LAMBDA, X, Y, D, MINCELL, + OPTIONS) + -- Function File: STDEVDIF = rgdtsmcorewrap (LOG10LAMBDA, X, Y, D, + MINCELL, OPTIONS) + Wrapper function for rgdtsmcore in order to minimize over LAMBDA + w.r.t. cross-validation error OR the squared difference between + the standard deviation of (Y-YHAT) and the given standard + deviation. This function is called from regdatasmooth. + + See also: regdatasmooth + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 68 +Wrapper function for rgdtsmcore in order to minimize over LAMBDA +w. + + + + + diff --git a/octave_packages/data-smoothing-1.3.0/packinfo/.autoload b/octave_packages/data-smoothing-1.3.0/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/data-smoothing-1.3.0/packinfo/DESCRIPTION b/octave_packages/data-smoothing-1.3.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..c3c0cf2 --- /dev/null +++ b/octave_packages/data-smoothing-1.3.0/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: data-smoothing +Version: 1.3.0 +Date: 2012-03-01 +Author: Jonathan Stickel +Maintainer: Jonathan Stickel +Title: Data smoothing +Description: Algorithms for smoothing noisy data +Categories: Data-smoothing +Depends: octave (>= 3.6.0), optim (>= 1.0.3) +Autoload: yes +License: GPL version 3 or later +Url: http://octave.sf.net diff --git a/octave_packages/data-smoothing-1.3.0/packinfo/INDEX b/octave_packages/data-smoothing-1.3.0/packinfo/INDEX new file mode 100644 index 0000000..bade778 --- /dev/null +++ b/octave_packages/data-smoothing-1.3.0/packinfo/INDEX @@ -0,0 +1,6 @@ +data-smoothing >> Data smoothing +Data-smoothing + ddmat + regdatasmooth + rgdtsmcore + rgdtsmcorewrap diff --git a/octave_packages/data-smoothing-1.3.0/packinfo/NEWS b/octave_packages/data-smoothing-1.3.0/packinfo/NEWS new file mode 100644 index 0000000..f0ac5d2 --- /dev/null +++ b/octave_packages/data-smoothing-1.3.0/packinfo/NEWS @@ -0,0 +1,9 @@ +Summary of important user-visible changes for data-smoothing 1.3.0: +------------------------------------------------------------------- + + ** Package is no longer automatically loaded + + ** Code has been cleaned to remove warnings about `possible Matlab-style + short-circuit operator' + + ** Minimal input check for all functions has been implemented diff --git a/octave_packages/data-smoothing-1.3.0/regdatasmooth.m b/octave_packages/data-smoothing-1.3.0/regdatasmooth.m new file mode 100644 index 0000000..f6998fc --- /dev/null +++ b/octave_packages/data-smoothing-1.3.0/regdatasmooth.m @@ -0,0 +1,189 @@ +## Copyright (C) 2008 Jonathan Stickel +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +##@deftypefn {Function File} {[@var{yhat}, @var{lambda}] =} regdatasmooth (@var{x}, @var{y}, [@var{options}]) +## +## Smooths the @var{y} vs. @var{x} values of 1D data by Tikhonov +## regularization. The smooth y-values are returned as @var{yhat}. The +## regularization parameter @var{lambda} that was used for the smoothing +## may also be returned. +## +## Note: the options have changed! +## Currently supported input options are (multiple options are allowed): +## +##@table @code +##@item "d", @var{value} +## the smoothing derivative to use (default = 2) +##@item "lambda", @var{value} +## the regularization paramater to use +##@item "stdev", @var{value} +## the standard deviation of the measurement of @var{y}; an optimal +## value for lambda will be determined by matching the provided +## @var{value} with the standard devation of @var{yhat}-@var{y}; +## if the option "relative" is also used, then a relative standard +## deviation is inferred +##@item "gcv" +## use generalized cross-validation to determine the optimal value for +## lambda; if neither "lambda" nor "stdev" options are given, this +## option is implied +##@item "lguess", @var{value} +## the initial value for lambda to use in the iterative minimization +## algorithm to find the optimal value (default = 1) +## @item "xhat", @var{vector} +## A vector of x-values to use for the smooth curve; must be +## monotonically increasing and must at least span the data +## @item "weights", @var{vector} +## A vector of weighting values for fitting each point in the data. +## @item "relative" +## use relative differences for the goodnes of fit term. Conflicts +## with the "weights" option. +##@item "midpointrule" +## use the midpoint rule for the integration terms rather than a direct +## sum; this option conflicts with the option "xhat" +##@end table +## +## Please run the demos for example usage. +## +## References: Anal. Chem. (2003) 75, 3631; AIChE J. (2006) 52, 325 +## @seealso{rgdtsmcorewrap, rgdtsmcore} +## @end deftypefn + +function [yhat, lambda] = regdatasmooth (x, y, varargin) + + if (nargin < 2) + print_usage; + elseif ( length(x) != length(y) ) + error("x and y must be equal length vectors") + endif + if ( isrow(x) ) x = x'; endif + if ( isrow(y) ) y = y'; endif + + ## defaults + d = 2; + lambda = 0; + stdev = 0; + guess = 0; + + ## parse options for d, lambda, stdev, gcv, lguess; + ## remaining options (gridx, Nhat, range, relative, midpointrule) + ## will be sent directly to the core function + idx = []; + if ( nargin > 2) + for i = 1:nargin-2 + arg = varargin{i}; + if ischar(arg) + switch arg + case "d" + d = varargin{i+1}; + idx = [idx,i,i+1]; + case "lambda" + lambda = varargin{i+1}; + idx = [idx,i,i+1]; + case "stdev" + stdev = varargin{i+1}; + idx = [idx,i,i+1]; + case "gcv" + idx = [idx,i]; + case "lguess" + guess = log10(varargin{i+1}); + idx = [idx,i,i+1]; + endswitch + endif + endfor + endif + varargin(idx) = []; + options = varargin; + ## add warning if more than one gcv, lambda, or stdev options provided? + + maxiter = 50; + if (lambda) + ## do nothing and use the provided lambda + else + ## find the "optimal" lambda + if ( stdev ) + ## match standard deviation + fhandle = @(log10lambda) rgdtsmcorewrap (log10lambda, x, y, d, {"stdev", stdev}, options{:}); + else + ## perform cross-validation + fhandle = @(log10lambda) rgdtsmcorewrap (log10lambda, x, y, d, {"cve"}, options{:}); + endif + ## "fminunc" works OK, but a derivative-free method (below) is better for this problem + ##opt = optimset("TolFun",1e-6,"MaxFunEvals",maxiter); + ##[log10lambda,fout,exitflag] = fminunc (fhandle, guess, opt); + ##[log10lambda,fout,exitflag] = fminunc_compat (fhandle, guess, opt); + ## derivative-free optimization; should use "fminsearch" for Matlab + ## compatibility, but fminsearch needs updates to be more compatible itself + [log10lambda, fout, niter] = nelder_mead_min (fhandle, guess, "ftol", 1e-6, "maxev", maxiter); + if (niter > maxiter) + exitflag = 0; + else + exitflag = 1; + endif + if (!exitflag) + warning("Iteration limit of %i exceeded\n",maxiter) + endif + lambda = 10^log10lambda; + endif + + yhat = rgdtsmcore (x, y, d, lambda, options{:}); + +endfunction + +%!demo +%! npts = 100; +%! x = linspace(0,2*pi,npts)'; +%! x = x + 2*pi/npts*(rand(npts,1)-0.5); +%! y = sin(x); +%! y = y + 1e-1*randn(npts,1); +%! yp = ddmat(x,1)*y; +%! y2p = ddmat(x,2)*y; +%! [yh, lambda] = regdatasmooth (x, y, "d",4,"stdev",1e-1,"midpointrule"); +%! lambda +%! yhp = ddmat(x,1)*yh; +%! yh2p = ddmat(x,2)*yh; +%! clf +%! subplot(221) +%! plot(x,y,'o','markersize',5,x,yh,x,sin(x)) +%! title("y(x)") +%! legend("noisy","smoothed","sin(x)","location","northeast"); +%! subplot(222) +%! plot(x(1:end-1),[yp,yhp,cos(x(1:end-1))]) +%! axis([min(x),max(x),min(yhp)-abs(min(yhp)),max(yhp)*2]) +%! title("y'(x)") +%! legend("noisy","smoothed","cos(x)","location","southeast"); +%! subplot(223) +%! plot(x(2:end-1),[y2p,yh2p,-sin(x(2:end-1))]) +%! axis([min(x),max(x),min(yh2p)-abs(min(yh2p)),max(yh2p)*2]) +%! title("y''(x)") +%! legend("noisy","smoothed","-sin(x)","location","southeast"); +%! %-------------------------------------------------------- +%! % smoothing of monotonic data, using "stdev" to determine the optimal lambda + +%!demo +%! npts = 20; +%! x = rand(npts,1)*2*pi; +%! y = sin(x); +%! y = y + 1e-1*randn(npts,1); +%! xh = linspace(0,2*pi,200)'; +%! [yh, lambda] = regdatasmooth (x, y, "d", 3, "xhat", xh); +%! lambda +%! clf +%! figure(1); +%! plot(x,y,'o','markersize',10,xh,yh,xh,sin(xh)) +%! title("y(x)") +%! legend("noisy","smoothed","sin(x)","location","northeast"); +%! %-------------------------------------------------------- +%! % smoothing of scattered data, using "gcv" to determine the optimal lambda diff --git a/octave_packages/data-smoothing-1.3.0/rgdtsmcore.m b/octave_packages/data-smoothing-1.3.0/rgdtsmcore.m new file mode 100644 index 0000000..bb63511 --- /dev/null +++ b/octave_packages/data-smoothing-1.3.0/rgdtsmcore.m @@ -0,0 +1,166 @@ +## Copyright (C) 2008 Jonathan Stickel +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +##@deftypefn {Function File} {[@var{yhat}, @var{v}] =} rgdtsmcore (@var{x}, @var{y}, @var{d}, @var{lambda}, [@var{options}]) +## +## Smooths @var{y} vs. @var{x} values by Tikhonov regularization. +## Although this function can be used directly, the more feature rich +## function "regdatasmooth" should be used instead. In addition to +## @var{x} and @var{y}, required input includes the smoothing derivative +## @var{d} and the regularization parameter @var{lambda}. The smooth +## y-values are returned as @var{yhat}. The generalized cross +## validation variance @var{v} may also be returned. +## +## Note: the options have changed! +## Currently supported input options are (multiple options are allowed): +## +## @table @code +## @item "xhat", @var{vector} +## A vector of x-values to use for the smooth curve; must be +## monotonically increasing and must at least span the data +## @item "weights", @var{vector} +## A vector of weighting values for fitting each point in the data. +## @item "relative" +## use relative differences for the goodnes of fit term. Conflicts +## with the "weights" option. +## @item "midpointrule" +## use the midpoint rule for the integration terms rather than a direct +## sum; this option conflicts with the option "xhat" +## @end table +## +## References: Anal. Chem. (2003) 75, 3631; AIChE J. (2006) 52, 325 +## @seealso{regdatasmooth} +## @end deftypefn + + +function [yhat, v] = rgdtsmcore (x, y, d, lambda, varargin) + + if (nargin < 4) + print_usage; + endif + + ## Defaults if not provided + xhatprov = 0; + xhat = x; + weights = 0; + relative = 0; + midpr = 0; + + ## parse the provided options + if ( length(varargin) ) + for i = 1:length(varargin) + arg = varargin{i}; + if ischar(arg) + switch arg + case "xhat" + xhatprov = 1; + xhat = varargin{i+1}; + case "weights" + weights = 1; + weightv = varargin{i+1}; + case "relative" + relative = 1; + case "midpointrule" + midpr = 1; + otherwise + printf("Option '%s' is not implemented;\n", arg) + endswitch + endif + endfor + endif + if (xhatprov && midpr) + warning("midpointrule is currently not used if xhat is provided (since x,y may be scattered)") + midpr = 0; + endif + if (weights && relative) + warning("relative differences is not used if a weighting vector is provided") + endif + + N = length(x); + Nhat = length(xhat); + + ## test that xhat is increasing + if !all(diff(xhat)>0) + if xhatprov + error("xhat must be monotonically increasing") + else + error("x must be monotonically increasing if xhat is not provided") + endif + endif + ## test that xhat spans x + if ( min(x) < min(xhat) || max(xhat) < max(x) ) + error("xhat must at least span the data") + endif + + ## construct M, D + M = speye(Nhat); + idx = interp1(xhat,1:Nhat,x,"nearest"); # works for unequally spaced xhat + M = M(idx,:); + D = ddmat(xhat,d); + + ## construct "weighting" matrices W and U + if (weights) + ## use arbitrary weighting as provided + W = diag(weightv); + elseif (relative) + ## use relative differences + Yinv = sparse(diag(1./y)); + W = Yinv^2; + else + W = speye(N); + endif + ## use midpoint rule integration (rather than simple sums) + if (midpr) + Bhat = sparse(diag(-ones(N-1,1),-1)) + sparse(diag(ones(N-1,1),1)); + Bhat(1,1) = -1; + Bhat(N,N) = 1; + B = 1/2*sparse(diag(Bhat*x)); + if ( floor(d/2) == d/2 ) # test if d is even + dh = d/2; + Btilda = B(dh+1:N-dh,dh+1:N-dh); + else # d is odd + dh = ceil(d/2); + Btilda = B(dh:N-dh,dh:N-dh); + endif + W = W*B; + U = Btilda; + else + ## W = W*speye(Nhat); + U = speye(Nhat-d); + endif + + ## Smoothing + delta = trace(D'*D)/Nhat^(2+d); # using "relative" or other weighting affects this! + yhat = (M'*W*M + lambda*delta^(-1)*D'*U*D) \ M'*W*y; + #[R,P,S] = splchol(M'*W*M + lambda*delta^(-1)*D'*U*D); + #yhat = S*(R'\(R\(S'*M'*W*y))); + + ## Computation of hat diagonal and cross-validation + if (nargout > 1) + ## from AIChE J. (2006) 52, 325 + ## note: chol factorization does not help speed up the computation of H; + ## should implement Eiler's partial H computation if many point smoothing by GCV is needed + ##H = M*(S*(R'\(R\(S'*M'*W)))); + H = M*((M'*W*M + lambda*delta^(-1)*D'*U*D)\M'*W); + ## note: this is variance, squared of the standard error that Eilers uses + v = (M*yhat - y)'*(M*yhat - y)/N / (1 - trace(H)/N)^2; + endif + + ## test mapping + ##figure(5) + ##plot(x,y,'o',x,M*yhat,'x') + +endfunction diff --git a/octave_packages/data-smoothing-1.3.0/rgdtsmcorewrap.m b/octave_packages/data-smoothing-1.3.0/rgdtsmcorewrap.m new file mode 100644 index 0000000..3a79c66 --- /dev/null +++ b/octave_packages/data-smoothing-1.3.0/rgdtsmcorewrap.m @@ -0,0 +1,71 @@ +## Copyright (C) 2008 Jonathan Stickel +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{cve} =} rgdtsmcorewrap (@var{log10lambda}, @var{x}, @var{y}, @var{d}, @var{mincell}, @var{options}) +## @deftypefnx {Function File} {@var{stdevdif} =} rgdtsmcorewrap (@var{log10lambda}, @var{x}, @var{y}, @var{d}, @var{mincell}, @var{options}) +## +## Wrapper function for rgdtsmcore in order to minimize over +## @var{lambda} w.r.t. cross-validation error OR the squared difference +## between the standard deviation of (@var{y}-@var{yhat}) and the given +## standard deviation. This function is called from regdatasmooth. +## @seealso{regdatasmooth} +## @end deftypefn + +function out = rgdtsmcorewrap (log10lambda, x, y, d, mincell, varargin) + + if (nargin < 5) + print_usage; + endif + + lambda = 10^(log10lambda); + + if ( length(mincell) == 2 ) # using stdev to find optimal lambda + stdev = mincell{2}; + yhat = rgdtsmcore (x, y, d, lambda, varargin{:}); + + xhatprov = 0; + relative = 0; + for i = 1:length(varargin) + if strcmp(varargin{i},"relative") + relative = 1; + elseif strcmp(varargin{i},"xhat") + xhatprov = 1; + xhat = varargin{i+1}; + endif + endfor + + if (xhatprov) + idx = interp1(xhat,1:length(xhat),x,"nearest"); + if relative + stdevd = std((y-yhat(idx))./y); + else + stdevd = std(y-yhat(idx)); + endif + else + if (relative) + stdevd = std((y-yhat)./y); + else + stdevd = std(y-yhat); + endif + endif + + out = (stdevd - stdev)^2; + + else # use gcv to find optimal lambda + [yhat, out] = rgdtsmcore (x, y, d, lambda, varargin{:}); + endif + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/abs.m b/octave_packages/dataframe-0.9.1/@dataframe/abs.m new file mode 100644 index 0000000..9027c56 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/abs.m @@ -0,0 +1,29 @@ +function resu = abs(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: abs.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@abs, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/acos.m b/octave_packages/dataframe-0.9.1/@dataframe/acos.m new file mode 100644 index 0000000..88a9239 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/acos.m @@ -0,0 +1,29 @@ +function resu = acos(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: acos.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@acos, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/acosh.m b/octave_packages/dataframe-0.9.1/@dataframe/acosh.m new file mode 100644 index 0000000..c941a10 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/acosh.m @@ -0,0 +1,29 @@ +function resu = acosh(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: acosh.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@acosh, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/and.m b/octave_packages/dataframe-0.9.1/@dataframe/and.m new file mode 100644 index 0000000..0a602aa --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/and.m @@ -0,0 +1,32 @@ +function resu = and(A, B); + + %# function resu = and(A, B) + %# Implements the '&' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: and.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_func(@and, A, B); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/angle.m b/octave_packages/dataframe-0.9.1/@dataframe/angle.m new file mode 100644 index 0000000..73f9fdb --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/angle.m @@ -0,0 +1,29 @@ +function resu = angle(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: angle.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@angle, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/arg.m b/octave_packages/dataframe-0.9.1/@dataframe/arg.m new file mode 100644 index 0000000..c9f0a3f --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/arg.m @@ -0,0 +1,29 @@ +function resu = arg(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: arg.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@arg, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/asin.m b/octave_packages/dataframe-0.9.1/@dataframe/asin.m new file mode 100644 index 0000000..7a387cf --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/asin.m @@ -0,0 +1,29 @@ +function resu = asin(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: asin.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@asin, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/asinh.m b/octave_packages/dataframe-0.9.1/@dataframe/asinh.m new file mode 100644 index 0000000..147abc8 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/asinh.m @@ -0,0 +1,29 @@ +function resu = asinh(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: asinh.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@asinh, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/atan.m b/octave_packages/dataframe-0.9.1/@dataframe/atan.m new file mode 100644 index 0000000..37a73e2 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/atan.m @@ -0,0 +1,29 @@ +function resu = atan(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: atan.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@atan, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/atanh.m b/octave_packages/dataframe-0.9.1/@dataframe/atanh.m new file mode 100644 index 0000000..402e47a --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/atanh.m @@ -0,0 +1,29 @@ +function resu = atanh(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: atanh.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@atanh, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/bsxfun.m b/octave_packages/dataframe-0.9.1/@dataframe/bsxfun.m new file mode 100644 index 0000000..740018b --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/bsxfun.m @@ -0,0 +1,51 @@ +function resu = bsxfun(func, A, B) + + %# function resu = bsxfun(func, A, B) + %# Implements a wrapper around internal bsxfun + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: bsxfun.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + + try + + [A, B, resu] = df_basecomp(A, B, true, @bsxfun); + + for indi = 1:max(A._cnt(2), B._cnt(2)), + indA = min(indi, A._cnt(2)); + indB = min(indi, B._cnt(2)); + Au = A._data{indA}(:, A._rep{indA}); + Bu = B._data{indB}(:, B._rep{indB}); + resu._data{indi} = bsxfun(func, Au, Bu); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + + resu = df_thirddim(resu); + + catch + disp(lasterr()); + error('bsxfun: non-compatible dimensions') + end_try_catch + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/cat.m b/octave_packages/dataframe-0.9.1/@dataframe/cat.m new file mode 100644 index 0000000..2a5e47e --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/cat.m @@ -0,0 +1,201 @@ +function resu = cat(dim, A, varargin) + %# function resu = cat(dim, A, varargin) + %# This is the concatenation operator for a dataframe object. "Dim" + %# has the same meaning as ordinary cat. Next arguments may be + %# dataframe, vector/matrix, or two elements cells. First one is taken + %# as row/column name, second as data. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: cat.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if (!isa(A, 'dataframe')), + A = dataframe(A); + endif + + switch dim + case 1 + resu = A; + + for indi = 1:length(varargin), + B = varargin{indi}; + if !isa(B, 'dataframe'), + if iscell(B) && 2 == length(B), + B = dataframe(B{2}, 'rownames', B{1}); + else + B = dataframe(B, 'colnames', inputname(2+indi)); + endif + endif + if resu._cnt(2) != B._cnt(2), + error('Different number of columns in dataframes'); + endif + %# do not duplicate empty names + if !isempty(resu._name{1}) || !isempty(B._name{1}), + if length(resu._name{1}) < resu._cnt(1), + resu._name{1}(end+1:resu._cnt(1), 1) = {''}; + endif + if length(B._name{1}) < B._cnt(1), + B._name{1}(end+1:B._cnt(1), 1) = {''}; + endif + resu._name{1} = vertcat(resu._name{1}(:), B._name{1}(:)); + resu._over{1} = [resu._over{1} B._over{1}]; + endif + resu._cnt(1) = resu._cnt(1) + B._cnt(1); + if size(resu._ridx, 2) < size(B._ridx, 2), + resu._ridx(:, end+1:size(B._ridx, 2)) = NA; + elseif size(resu._ridx, 2) > size(B._ridx, 2), + B._ridx(:, end+1:size(resu._ridx, 2)) = NA; + endif + resu._ridx = [resu._ridx; B._ridx]; + %# find data with same column names + dummy = A._over{2} & B._over{2}; + indA = true(1, resu._cnt(2)); + indB = true(1, resu._cnt(2)); + for indj = 1:resu._cnt(2), + if (dummy(indj)), + indk = strmatch(resu._name{2}(indj), B._name{2}, 'exact'); + if (~isempty(indk)), + indk = indk(1); + if ~strcmp(resu._type{indj}, B._type{indk}), + error("Trying to mix columns of different types"); + endif + endif + else + indk = indj; + endif + resu._data{indj} = [resu._data{indj}; B._data{indk}]; + indA(indj) = false; indB(indk) = false; + endfor + if any(indA) || any(indB) + error('Different number/names of columns in dataframe'); + endif + + endfor + + case 2 + resu = A; + + for indi = 1:length(varargin), + B = varargin{indi}; + if !isa(B, 'dataframe'), + if iscell(B) && 2 == length(B), + B = dataframe(B{2}, 'colnames', B{1}); + else + B = dataframe(B, 'colnames', inputname(2+indi)); + endif + B._ridx = resu._ridx; %# make them compatibles + endif + if resu._cnt(1) != B._cnt(1), + error('Different number of rows in dataframes'); + endif + if any(resu._ridx(:) - B._ridx(:)) + error('dataframes row indexes not matched'); + endif + resu._name{2} = vertcat(resu._name{2}, B._name{2}); + resu._over{2} = [resu._over{2} B._over{2}]; + resu._data(resu._cnt(2)+(1:B._cnt(2))) = B._data; + resu._type(resu._cnt(2)+(1:B._cnt(2))) = B._type; + resu._cnt(2) = resu._cnt(2) + B._cnt(2); + endfor + + case 3 + resu = A; + + for indi = 1:length(varargin), + B = varargin{indi}; + if (!isa(B, 'dataframe')), + if (iscell(B) && 2 == length(B)), + B = dataframe(B{2}, 'rownames', B{1}); + else + B = dataframe(B, 'colnames', inputname(indi+2)); + endif + endif + if (resu._cnt(1) != B._cnt(1)), + error('Different number of rows in dataframes'); + endif + if (resu._cnt(2) != B._cnt(2)), + error('Different number of columns in dataframes'); + endif + %# to be merged against 3rd dim, rownames must be equals, if + %# non-empty. Columns are merged based upon their name; columns + %# with identic content are kept. + + if size(resu._ridx, 2) < size(B._ridx, 2), + resu._ridx(:, end+1:size(B._ridx, 2)) = NA; + elseif size(resu._ridx, 2) > size(B._ridx, 2), + B._ridx(:, end+1:size(resu._ridx, 2)) = NA; + endif + resu._ridx = cat(3, resu._ridx, B._ridx); + %# find data with same column names + indA = true(1, resu._cnt(2)); + indB = true(1, resu._cnt(2)); + dummy = A._over{2} & B._over{2}; + for indj = 1:resu._cnt(2), + if (dummy(indj)), + indk = strmatch(resu._name{2}(indj), B._name{2}, 'exact'); + if (~isempty(indk)), + indk = indk(1); + if (~strcmp(resu._type{indj}, B._type{indk})), + error("Trying to mix columns of different types"); + endif + endif + else + indk = indj; + endif + if (all([isnumeric(resu._data{indj}) isnumeric(B._data{indk})])), + %# iterate over the columns of resu and B + op1 = resu._data{indj}; op2 = B._data{indk}; + for ind2=1:columns(op2), + indr = false; + for ind1=1:columns(op1), + if (all(abs(op1(:, ind1) - op2(:, ind2)) <= eps)), + resu._rep{indj} = [resu._rep{indj} ind1]; + indr = true; + break; + endif + endfor + if (!indr), + %# pad in the second dim + resu._data{indj} = [resu._data{indj}, B._data{indk}]; + resu._rep{indj} = [resu._rep{indj} 1+length(resu._rep{indj})]; + endif + endfor + else + resu._data{indj} = [resu._data{indj} B._data{indk}]; + resu._rep{indj} = [resu._rep{indj} 1+length(resu._rep({indj}))]; + endif + indA(indj) = false; indB(indk) = false; + endfor + if (any(indA) || any(indB)), + error('Different number/names of columns in dataframe'); + endif + endfor + + resu = df_thirddim(resu); + + otherwise + error('Incorrect call to cat'); + endswitch + + %# disp('End of cat'); keyboard +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/ceil.m b/octave_packages/dataframe-0.9.1/@dataframe/ceil.m new file mode 100644 index 0000000..019c5bd --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/ceil.m @@ -0,0 +1,29 @@ +function resu = ceil(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: ceil.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@ceil, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/columns.m b/octave_packages/dataframe-0.9.1/@dataframe/columns.m new file mode 100644 index 0000000..d66d22b --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/columns.m @@ -0,0 +1,31 @@ +function resu = columns(df) + %# function resu = columns(df) + %# returns the number of columns of a dataframe + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: columns.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df._cnt(end); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/conj.m b/octave_packages/dataframe-0.9.1/@dataframe/conj.m new file mode 100644 index 0000000..266daf7 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/conj.m @@ -0,0 +1,29 @@ +function resu = conj(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: conj.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@conj, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/cos.m b/octave_packages/dataframe-0.9.1/@dataframe/cos.m new file mode 100644 index 0000000..535f039 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/cos.m @@ -0,0 +1,29 @@ +function resu = cos(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: cos.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@cos, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/cosh.m b/octave_packages/dataframe-0.9.1/@dataframe/cosh.m new file mode 100644 index 0000000..3daf2e0 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/cosh.m @@ -0,0 +1,29 @@ +function resu = cosh(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: cosh.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@cosh, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/cumprod.m b/octave_packages/dataframe-0.9.1/@dataframe/cumprod.m new file mode 100644 index 0000000..875d445 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/cumprod.m @@ -0,0 +1,29 @@ +function resu = cumprod(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: cumprod.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@cumprod, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/cumsum.m b/octave_packages/dataframe-0.9.1/@dataframe/cumsum.m new file mode 100644 index 0000000..1ff0c67 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/cumsum.m @@ -0,0 +1,29 @@ +function resu = cumsum(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: cumsum.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@cumsum, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/dataframe.m b/octave_packages/dataframe-0.9.1/@dataframe/dataframe.m new file mode 100644 index 0000000..9c2722e --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/dataframe.m @@ -0,0 +1,434 @@ +function df = dataframe(x = [], varargin) + + %# -*- texinfo -*- + %# @deftypefn {Function File} @var{df} = dataframe(@var{x = []}, ...) + %# This is the default constructor for a dataframe object, which is + %# similar to R 'data.frame'. It's a way to group tabular data, then + %# accessing them either as matrix or by column name. + %# Input argument x may be: @itemize + %# @item a dataframe => use @var{varargin} to pad it with suplemental + %# columns + %# @item a matrix => create column names from input name; each column + %# is used as an entry + %# @item a cell matrix => try to infer column names from the first row, + %# and row indexes and names from the two first columns; + %# @item a file name => import data into a dataframe; + %# @item a matrix of char => initialise colnames from them. + %# @item a two-element cell: use the first as column as column to + %# append to, and the second as initialiser for the column(s) + %# @end itemize + %# If called with an empty value, or with the default argument, it + %# returns an empty dataframe which can be further populated by + %# assignement, cat, ... If called without any argument, it should + %# return a dataframe from the whole workspace. + %# @*Variable input arguments are first parsed as pairs (options, values). + %# Recognised options are: @itemize + %# @item rownames : take the values as initialiser for row names + %# @item colnames : take the values as initialiser for column names + %# @item seeked : a (kept) field value which triggers start of processing. + %# @item trigger : a (unkept) field value which triggers start of processing. + %# Each preceeding line is silently skipped. Default: none + %# @item unquot: a logical switch telling wheter or not strings should + %# be unquoted before storage, default = true; + %# @item sep: the elements separator, default '\t,' + %# @end itemize + %# The remaining data are concatenated (right-appended) to the existing ones. + %# @end deftypefn + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: dataframe.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + +if (0 == nargin) + disp ('FIXME -- should create a dataframe from the whole workspace') + df = dataframe ([]); + return +endif + +if (isempty (x) && 1 == nargin) + %# default constructor: initialise the fields in the right order + df._cnt = [0 0]; + df._name = {cell(0, 1), cell(1, 0)}; %# rows - cols + df._over = cell (1, 2); + df._ridx = []; + df._data = cell (0, 0); + df._rep = cell (0, 0); %# a repetition index + df._type = cell (0, 0); %# the type of each column + df._src = cell (0, 0); + df._cmt = cell (0, 0); %# to put comments + df = class (df, 'dataframe'); + return +endif + +if (isa (x, 'dataframe')) + df = x; +elseif (isa (x, 'struct')) + df = class (x, 'dataframe'); return +else + df = dataframe ([]); %# get the right fields +endif + +%# default values +seeked = []; trigger =[]; unquot = true; sep = "\t,"; cmt_lines = []; +locales = "C"; + +if (length(varargin) > 0) + indi = 1; + %# loop over possible arguments + while (indi <= size (varargin, 2)) + if (isa (varargin{indi}, 'char')) + switch(varargin{indi}) + case 'rownames' + switch class (varargin{indi+1}) + case {'cell'} + df._name{1} = varargin{indi+1}; + case {'char'} + df._name{1} = cellstr (varargin{indi+1}); + otherwise + df._name{1} = cellstr (num2str (varargin{indi+1})); + endswitch + df._name{1} = genvarname (df._name{1}); + df._over{1}(1, 1:length (df._name{1})) = false; + df._cnt(1) = size (df._name{1}, 1); + df._ridx = (1:df._cnt(1))'; + varargin(indi:indi+1) = []; + case 'colnames' + switch class(varargin{indi+1}) + case {'cell'} + df._name{2} = varargin{indi+1}; + case {'char'} + df._name{2} = cellstr (varargin{indi+1}); + otherwise + df._name{2} = cellstr (num2str (varargin{indi+1})); + endswitch + %# detect assignment - functions calls - ranges + dummy = cellfun ('size', cellfun (@(x) strsplit (x, ":=("), df._name{2}, \ + "UniformOutput", false), 2); + if (any(dummy > 1)) + warning('dataframe colnames taken literally and not interpreted'); + endif + df._name{2} = genvarname (df._name{2}); + df._over{2}(1, 1:length (df._name{2})) = false; + varargin(indi:indi+1) = []; + case 'seeked', + seeked = varargin{indi + 1}; + varargin(indi:indi+1) = []; + case 'trigger', + trigger = varargin{indi + 1}; + varargin(indi:indi+1) = []; + case 'unquot', + unquot = varargin{indi + 1}; + varargin(indi:indi+1) = []; + case 'sep', + sep = varargin{indi + 1}; + varargin(indi:indi+1) = []; + case 'locales' + locales = varargin{indi + 1}; + varargin(indi:indi+1) = []; + otherwise %# FIXME: just skip it for now + disp (sprintf ("Ignoring unkown argument %s", varargin{indi})); + indi = indi + 1; + endswitch + else + indi = indi + 1; %# skip it + endif + endwhile +endif + +if (!isempty (seeked) && !isempty (trigger)) + error ('seeked and trigger are mutuallly incompatible arguments'); +endif + +indi = 0; +while (indi <= size(varargin, 2)) + indi = indi + 1; + if (~isa (x, 'dataframe')) + if (isa(x, 'char') && size(x, 1) < 2) + %# read the data frame from a file + try + dummy = tilde_expand (x); + x = load (dummy); + df._src{end+1, 1} = dummy; + catch + %# try our own method + UTF8_BOM = char([0xEF 0xBB 0xBF]); + unwind_protect + dummy = tilde_expand (x); + fid = fopen (dummy); + if (fid != -1) + df._src{end+1, 1} = dummy; + dummy = fgetl (fid); + if (!strcmp (dummy, UTF8_BOM)) + frewind (fid); + endif + %# slurp everything and convert doubles to char, avoiding + %# problems with char > 127 + in = char (fread (fid).'); + else + in = []; + endif + unwind_protect_cleanup + if (fid != -1) fclose (fid); endif + end_unwind_protect + + if (!isempty (in)) + %# explicit list taken from 'man pcrepattern' -- we enclose all + %# vertical separators in case the underlying regexp engine + %# doesn't have them all. + eol = '(\r\n|\n|\v|\f|\r|\x85)'; + %# cut into lines -- include the EOL to have a one-to-one + %# matching between line numbers. Use a non-greedy match. + lines = regexp (in, ['.*?' eol], 'match'); + dummy = cellfun (@(x) regexp (x, eol), lines); + %# remove the EOL character(s) + lines(1 == dummy) = {""}; + %# use a positive lookahead -- eol is not part of the match + lines(dummy > 1) = cellfun (@(x) regexp (x, ['.*?(?=' eol ')'], \ + 'match'), lines(dummy > 1)); + %# a field either starts at a word boundary, either by + - . for + %# a numeric data, either by ' for a string. + + %# content = cellfun(@(x) regexp(x, '(\b|[-+\.''])[^,]*(''|\b)', 'match'),\ + %# lines, 'UniformOutput', false); %# extract fields + content = cellfun (@(x) strsplit (x, sep), lines, \ + 'UniformOutput', false); %# extract fields + indl = 1; indj = 1; %# disp('line 151 '); keyboard + if (~isempty (seeked)) + while (indl <= length (lines)) + dummy = content{indl}; + if (all (cellfun ('size', dummy, 2) == 0)) + indl = indl + 1; + continue; + endif + dummy = content{indl}; + if (strcmp (dummy{1}, seeked)) + break; + endif + indl = indl + 1; + endwhile + elseif (~isempty (trigger)) + while (indl <= length (lines)) + dummy = content{indl}; + indl = indl + 1; + if (all (cellfun ('size', dummy, 2) == 0)) + continue; + endif + if (strcmp (dummy{1}, trigger)) + break; + endif + endwhile + endif + x = cell (1+length (lines)-indl, size(dummy, 2)); + empty_lines = []; cmt_lines = []; + while (indl <= length(lines)) + dummy = content{indl}; + if (all (cellfun ('size', dummy, 2) == 0)) + empty_lines = [empty_lines indj]; + indl = indl + 1; indj = indj + 1; + continue; + endif + %# does it looks like a comment line ? + if (regexp (dummy{1}, ['^\s*' char(35)])) + empty_lines = [empty_lines indj]; + cmt_lines = strvcat (cmt_lines, horzcat (dummy{:})); + indl = indl + 1; indj = indj + 1; + continue; + endif + %# try to convert to float + the_line = cellfun (@(x) sscanf (x, "%f", locales), dummy, \ + 'UniformOutput', false); + for indk = (1:size (the_line, 2)) + if (isempty (the_line{indk}) || any (size (the_line{indk}) > 1)) + %#if indi > 1 && indk > 1, disp('line 117 '); keyboard; %#endif + if (unquot) + try + %# remove quotes and leading space(s) + x(indj, indk) = regexp (dummy{indk}, '[^'' ].*[^'']', 'match'){1}; + catch + %# if the previous test fails, try a simpler one + in = regexp (dummy{indk}, '[^'' ]+', 'match'); + if (!isempty(in)) + x(indj, indk) = in{1}; + %# else + %# x(indj, indk) = []; + endif + end_try_catch + else + %# no conversion possible, store and remove leading space(s) + x(indj, indk) = regexp (dummy{indk}, '[^ ].*', 'match'); + endif + else + if (!isempty (regexp (dummy{indk}, '[/:]'))) + %# try to convert to a date + [timeval, nfields] = strptime( dummy{indk}, + [char(37) 'd/' char(37) 'm/' char(37) 'Y ' char(37) 'T']); + if (nfields > 0) %# at least a few fields are OK + timestr = strftime ([char(37) 'H:' char(37) 'M:' char(37) 'S'], + timeval); + %# try to extract the usec field, if any + idx = regexp (dummy{indk}, timestr, 'end'); + if (!isempty (idx)) + idx = idx + 1; + if (ispunct (dummy{indk}(idx))) + idx = idx + 1; + endif + timeval.usec = str2num(dummy{indk}(idx:end)); + endif + x(indj, indk) = str2num (strftime ([char(37) 's'], timeval)) + ... + timeval.usec * 1e-6; + endif + else + x(indj, indk) = the_line{indk}; + endif + endif + endfor + indl = indl + 1; indj = indj + 1; + endwhile + if (!isempty(empty_lines)) + x(empty_lines, :) = []; + endif + %# detect empty columns + empty_lines = find (0 == sum (cellfun ('size', x, 2))); + if (!isempty(empty_lines)) + x(:, empty_lines) = []; + endif + clear UTF8_BOM fid in lines indl the_line content empty_lines + clear timeval timestr nfields idx + endif + end_try_catch + endif + + %# fallback, avoiding a recursive call + idx.type = '()'; + if (!isa (x, 'char')) + indj = df._cnt(2)+(1:size (x, 2)); + else + %# at this point, reading some filename failed + error("dataframe: can't open '%s' for reading data", x); + endif; + + if (iscell(x)) + if (2 == length (x)) + %# use the intermediate value as destination column + [indc, ncol] = df_name2idx (df._name{2}, x{1}, df._cnt(2), "column"); + if (ncol != 1) + error (["With two-elements cell, the first should resolve " ... + "to a single column"]); + endif + try + dummy = cellfun ('class', x{2}(2, :), 'UniformOutput', false); + catch + dummy = cellfun ('class', x{2}(1, :), 'UniformOutput', false); + end_try_catch + df = df_pad (df, 2, [length(dummy) indc], dummy); + x = x{2}; + indj = indc + (1:size(x, 2)); %# redefine target range + else + if (isa (x{1}, 'cell')) + x = x{1}; %# remove one cell level + endif + endif + if (length (df._name{2}) < indj(1) || isempty (df._name{2}(indj))) + [df._name{2}(indj, 1), df._over{2}(1, indj)] ... + = df_colnames (inputname(indi), indj); + df._name{2} = genvarname (df._name{2}); + endif + %# allow overwriting of column names + df._over{2}(1, indj) = true; + else + if (!isempty(indj)) + if (1 == length (df._name{2}) && length (df._name{2}) < \ + length (indj)) + [df._name{2}(indj, 1), df._over{2}(1, indj)] ... + = df_colnames (char(df._name{2}), indj); + elseif (length (df._name{2}) < indj(1) || isempty (df._name{2}(indj))) + [df._name{2}(indj, 1), df._over{2}(1, indj)] ... + = df_colnames (inputname(indi), indj); + endif + df._name{2} = genvarname (df._name{2}); + endif + endif + if (!isempty (indj)) + %# the exact row size will be determined latter + idx.subs = {'', indj}; + %# use direct assignement + if (ndims (x) > 2), idx.subs{3} = 1:size (x, 3); endif + %# df = subsasgn(df, idx, x); <= call directly lower level + df = df_matassign (df, idx, indj, length(indj), x); + if (!isempty (cmt_lines)) + df._cmt = vertcat(df._cmt, cellstr(cmt_lines)); + cmt_lines = []; + endif + else + df._cnt(2) = length (df._name{2}); + endif + elseif (indi > 1) + error ('Concatenating dataframes: use cat instead'); + endif + + try + %# loop over next variable argument + x = varargin{1, indi}; + catch + %# disp('line 197 ???'); + end_try_catch + +endwhile + +endfunction + +function [x, y] = df_colnames(base, num) + %# small auxiliary function to generate column names. This is required + %# here, as only the constructor can use inputname() + if (any ([index(base, "=")])) + %# takes the left part as base + x = strsplit (base, "="); + x = deblank (x{1}); + if (isvarname (x)) + y = false; + else + x = 'X'; y = true; + endif + else + %# is base most probably a filename ? + x = regexp (base, '''[^''].*[^'']''', 'match'); + if (isempty (x)) + if (isvarname (base)) + x = base; y = false; + else + x = 'X'; y = true; %# this is a default value, may be changed + endif + else + x = x{1}; y = true; + endif + endif + + if (numel (num) > 1) + x = repmat (x, numel (num), 1); + x = cstrcat (x, strjust (num2str (num(:)), 'left')); + y = repmat (y, 1, numel (num)); + endif + + x = cellstr (x); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/display.m b/octave_packages/dataframe-0.9.1/@dataframe/display.m new file mode 100644 index 0000000..c2e98e3 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/display.m @@ -0,0 +1,203 @@ +function resu = display(df) + + %# function resu = display(df) + %# Tries to produce a nicely formatted output of a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: display.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + %# generate header name + dummy = inputname (1); + if (isempty(dummy)) + dummy = "ans"; + endif + + if (2 == length (df._cnt)) + head = sprintf ("%s = dataframe with %d rows and %d columns", \ + dummy, df._cnt); + else + head = sprintf ("%s = dataframe with %d rows and %d columns on %d pages", \ + dummy, df._cnt); + endif + + if (!isempty (df._src)) + for indi = (1:size (df._src, 1)) + head = strvcat\ + (head, [repmat("Src: ", size (df._src{indi, 1}, 1), 1)\ + df._src{indi, 1}]); + endfor + endif + + if (!isempty (df._cmt)) + for indi = (1:size(df._cmt, 1)) + head = strvcat\ + (head, [repmat("Comment: ", size (df._cmt{indi, 1}, 1), 1)\ + df._cmt{indi, 1}]); + endfor + endif + + if (all (df._cnt > 0)) %# stop for empty df + dummy=[]; vspace = repmat (' ', df._cnt(1), 1); + indi = 1; %# the real, unfolded index + %# loop over columns where the corresponding _data really exists + for indc = (1:min (df._cnt(2), size (df._data, 2))) + %# emit column names and type + if (1 == length (df._rep{indc})) + dummy{1, 2+indi} = deblank (disp (df._name{2}{indc})); + dummy{2, 2+indi} = deblank (df._type{indc}); + else + %# append a dot and the third-dimension index to column name + tmp_str = [deblank(disp (df._name{2}{indc})) "."]; + tmp_str = arrayfun (@(x) horzcat (tmp_str, num2str(x)), ... + (1:length (df._rep{indc})), 'UniformOutput', false); + dummy{1, 2+indi} = tmp_str{1}; + dummy{2, 2+indi} = deblank (df._type{indc}); + for indk = (2:length (tmp_str)) + dummy{1, 1+indi+indk} = tmp_str{indk}; + dummy{2, 1+indi+indk} = dummy{2, 2+indi}; + endfor + endif + %# "print" each column + switch df._type{indc} + case {'char'} + indk = 1; while (indk <= size (df._data{indc}, 2)) + tmp_str = df._data{indc}(:, indk); %#get the whole column + indj = cellfun ('isprint', tmp_str, 'UniformOutput', false); + indj = ~cellfun ('all', indj); + for indr = (1:length(indj)) + if (indj(indr)), + if (isna (tmp_str{indr})), + tmp_str{indr} = "NA"; + else + if (~ischar (tmp_str{indr})) + tmp_str{indr} = char (tmp_str{indr}); + endif + tmp_str{indr} = undo_string_escapes (tmp_str{indr}); + endif + endif + endfor + %# keep the whole thing, and add a vertical space + dummy{3, 2+indi} = disp (char (tmp_str)); + dummy{3, 2+indi} = horzcat... + (vspace, char (regexp (dummy{3, 2+indi}, '.*', ... + 'match', 'dotexceptnewline'))); + indi = indi + 1; indk = indk + 1; + endwhile + otherwise + %# keep only one horizontal space per line + unfolded = df._data{indc}(:, df._rep{indc}); + indk = 1; while (indk <= size (unfolded, 2)) + dummy{3, 2+indi} = disp (unfolded(:, indk)); + tmp_str = char (regexp (dummy{3, 2+indi}, \ + '[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?(\s??[-+]\s??[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?i)?', \ + 'match', 'dotexceptnewline')); + tmp_str = horzcat... + (vspace, char (regexp (dummy{3, 2+indi}, '\S.*', ... + 'match', 'dotexceptnewline'))); + dummy{3, 2+indi} = tmp_str; + indi = indi + 1; indk = indk + 1; + endwhile + endswitch + endfor + + %# put everything together + vspace = [' '; ' '; vspace]; + %# second line content + resu = []; + if (!isempty (df._ridx)) + for (ind1 = 1:size (df._ridx, 2)) + if ((1 == size(df._ridx, 3)) && \ + (any (!isna (df._ridx(1:df._cnt(1), ind1))))) + dummy{2, 1} = [sprintf("_%d", ind1) ; "Nr"]; + dummy{3, 1} = disp (df._ridx(1:df._cnt(1), ind1)); + indi = regexp (dummy{3, 1}, '\b.*\b', 'match', 'dotexceptnewline'); + if (isempty (resu)) + resu = strjust (char (dummy{2, 1}, indi), 'right'); + else + resu = horzcat(resu, vspace, strjust (char (dummy{2, 1}, indi), \ + 'right'), vspace); + endif + else + for ind2 = (1:size (df._ridx, 3)) + if (any (!isna (df._ridx(1:df._cnt(1), ind1, ind2)))), + dummy{2, 1} = [sprintf("_%d.%d", ind1, ind2) ; "Nr"]; + dummy{3, 1} = disp (df._ridx(1:df._cnt(1), ind1, ind2)); + indi = regexp (dummy{3, 1}, '\b.*\b', 'match', 'dotexceptnewline'); + if (isempty (resu)) + resu = strjust (char (dummy{2, 1}, indi), 'right'); + else + resu = horzcat (resu, vspace, strjust (char(dummy{2, 1}, indi), \ + 'right'), vspace); + endif + endif + endfor + endif + endfor + endif + + %# emit row names + if (isempty (df._name{1})), + dummy{2, 2} = []; dummy{3, 2} = []; + else + dummy{2, 2} = [" ";" "]; + dummy{3, 2} = df._name{1}; + endif + + %# insert a vertical space + if (!isempty(dummy{3, 2})) + indi = ~cellfun ('isempty', dummy{3, 2}); + if (any (indi)) + try + resu = horzcat (resu, vspace, strjust (char(dummy{2, 2}, dummy{3, 2}),\ + 'right')); + catch + disp ('line 172 '); keyboard + end_try_catch + endif + endif + + %# emit each colum + for indi = (1:size (dummy, 2) - 2) + %# was max(df._cnt(2:end)), + try + %# avoid this column touching the previous one + if (any (cellfun ('size', dummy(1:2, 2+indi), 2) >= \ + size (dummy{3, 2+indi}, 2))) + resu = horzcat (resu, vspace); + endif + resu = horzcat (resu, strjust (char (dummy{:, 2+indi}), 'right')); + catch + tmp_str = sprintf ("Emitting %d lines, expecting %d", ... + size (dummy{3, 2+indi}, 1), df._cnt(1)); + keyboard + error (tmp_str); + end_try_catch + endfor + else + resu = ''; + endif + + resu = char (head, resu); disp (resu) + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/end.m b/octave_packages/dataframe-0.9.1/@dataframe/end.m new file mode 100644 index 0000000..611001d --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/end.m @@ -0,0 +1,40 @@ +function resu = end(df, k, n) + %# function resu = end(df, k, n) + %# This is the end operator for a dataframe object, returning the + %# maximum number of rows or columns + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: end.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + try + if k < 3, + resu = df._cnt(k); + else + resu = max(cellfun(@length, df._rep)); + endif + catch + error("incorrect call to end, index greater than number of dimensions"); + end_try_catch + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/eq.m b/octave_packages/dataframe-0.9.1/@dataframe/eq.m new file mode 100644 index 0000000..f5fffb5 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/eq.m @@ -0,0 +1,32 @@ +function resu = eq(A, B); + + %# function resu = eq(A, B) + %# Implements the '==' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: eq.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_func(@eq, A, B); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/erf.m b/octave_packages/dataframe-0.9.1/@dataframe/erf.m new file mode 100644 index 0000000..cdcf129 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/erf.m @@ -0,0 +1,29 @@ +function resu = erf(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: erf.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@erf, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/erfc.m b/octave_packages/dataframe-0.9.1/@dataframe/erfc.m new file mode 100644 index 0000000..253a90b --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/erfc.m @@ -0,0 +1,29 @@ +function resu = erfc(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: erfc.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@erfc, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/erfcx.m b/octave_packages/dataframe-0.9.1/@dataframe/erfcx.m new file mode 100644 index 0000000..ca62783 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/erfcx.m @@ -0,0 +1,29 @@ +function resu = erfcx(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: erfcx.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@erfcx, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/erfinv.m b/octave_packages/dataframe-0.9.1/@dataframe/erfinv.m new file mode 100644 index 0000000..7231182 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/erfinv.m @@ -0,0 +1,29 @@ +function resu = erfinv(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: erfinv.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@erfinv, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/exp.m b/octave_packages/dataframe-0.9.1/@dataframe/exp.m new file mode 100644 index 0000000..d2b4dba --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/exp.m @@ -0,0 +1,29 @@ +function resu = exp(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: exp.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@exp, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/expm1.m b/octave_packages/dataframe-0.9.1/@dataframe/expm1.m new file mode 100644 index 0000000..d1ed377 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/expm1.m @@ -0,0 +1,29 @@ +function resu = expm1(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: expm1.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@expm1, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/find.m b/octave_packages/dataframe-0.9.1/@dataframe/find.m new file mode 100644 index 0000000..46ba45e --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/find.m @@ -0,0 +1,60 @@ +function varargout = find(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: find.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + switch nargout + case {0, 1} + resu = []; mz = max(cellfun(@length, df._rep)); + for indc = 1:df._cnt(2), + [indr, inds] = feval(@find, df._data{indc}(:, df._rep{indc})); + %# create a vector the same size as indr + dummy = indr; dummy(:) = indc; + resu = [resu; sub2ind([df._cnt(1:2) mz], indr, dummy, inds)]; + endfor + varargout{1} = sort(resu); + case 2 + nz = 0; idx_i = []; idx_j = []; + for indc = 1:df._cnt(2), + [dum1, dum2] = feval(@find, df._data{indc}(:, df._rep{indc})); + idx_i = [idx_i; dum1]; + idx_j = [idx_j; nz + dum2]; + nz = nz + df._cnt(1)*length(df._rep{indc}); + endfor + varargout{1} = idx_i; varargout{2} = idx_j; + case 3 + nz = 0; idx_i = []; idx_j = []; val = []; + for indc = 1:df._cnt(2), + [dum1, dum2, dum3] = feval(@find, df._data{indc}(:, df._rep{indc})); + idx_i = [idx_i; dum1]; + idx_j = [idx_j; nz + dum2]; + val = [val; dum3]; + nz = nz + df._cnt(1)*length(df._rep{indc}); + endfor + varargout{1} = idx_i; varargout{2} = idx_j; varargout{3} = val; + otherwise + print_usage('find'); + endswitch + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/finite.m b/octave_packages/dataframe-0.9.1/@dataframe/finite.m new file mode 100644 index 0000000..4b6d1a2 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/finite.m @@ -0,0 +1,29 @@ +function resu = finite(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: finite.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@finite, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/fix.m b/octave_packages/dataframe-0.9.1/@dataframe/fix.m new file mode 100644 index 0000000..ec86306 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/fix.m @@ -0,0 +1,29 @@ +function resu = fix(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: fix.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@fix, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/floor.m b/octave_packages/dataframe-0.9.1/@dataframe/floor.m new file mode 100644 index 0000000..dc9b60e --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/floor.m @@ -0,0 +1,29 @@ +function resu = floor(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: floor.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@floor, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/fold.m b/octave_packages/dataframe-0.9.1/@dataframe/fold.m new file mode 100644 index 0000000..ed485c9 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/fold.m @@ -0,0 +1,96 @@ +function resu = fold(df, dim, indr, indc) + + %# function resu = subasgn(df, S, RHS) + %# The purpose is to fold a dataframe. Part from (1:indr-1) doesn't + %# move, then content starting at indr is moved into the second, + %# third, ... sheet. To be moved, there must be equality of rownames, + %# if any, and of fields contained in indc. + + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: fold.m 9585 2012-02-05 15:32:46Z cdemills $ + %# +switch dim + case 1 + [indr, nrow] = df_name2idx(df._name{1}, indr, df._cnt(1), 'row'); + [indc, ncol] = df_name2idx(df._name{2}, indc, df._cnt(2), 'column'); + + if (indr(1) > 1), + slice_size = indr(1) - 1; + %# we can't use directly resu = df(1:slice_size, :, :) + S.type = '()'; + S.subs = { 1:slice_size, ':', ':', 'dataframe'}; + resu = subsref(df, S); + + %# how many columns for each slice + targets = cellfun(@length, df._rep); + %# a test function to determine if the location is free + for indj = 1:df._cnt(2), + if (any(indj == indc)), + continue; + endif + switch df._type{indj} + case { 'char' } + testfunc{indj} = @(x, indr, indc) ... + !isna(x{indr, indc}); + otherwise + testfunc{indj} = @(x, indr, indc) ... + !isna(x(indr, indc)); + endswitch + endfor + + for indi = indr, + %# where does this line go ? + where = find(df._data{indc}(1:slice_size, 1) ... + == df._data{indc}(indi, 1)); + if (!isempty(where)), + %# transfering one line -- loop over columns + for indj = 1:df._cnt(2), + if any(indj == indc), + continue; + endif + + if (testfunc{indj}(resu._data{indj}, where, targets(indj))), + %# add one more sheet + resu = df_pad(resu, 3, 1, indj); + targets(indj) = targets(indj) + 1; + endif + %# transfer field + stop + resu._data{indj}(where, targets(indj)) = ... + df._data{indj}(indi, 1); + endfor + %# update row index + resu._ridx(where, max(targets)) = df._ridx(indi); + else + disp('line 65: FIXME'); keyboard; + endif + endfor + + else + + disp('line 70: FIXME '); keyboard + endif + + +endswitch diff --git a/octave_packages/dataframe-0.9.1/@dataframe/gamma.m b/octave_packages/dataframe-0.9.1/@dataframe/gamma.m new file mode 100644 index 0000000..b07edc8 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/gamma.m @@ -0,0 +1,29 @@ +function resu = gamma(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: gamma.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@gamma, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/ge.m b/octave_packages/dataframe-0.9.1/@dataframe/ge.m new file mode 100644 index 0000000..ca4334c --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/ge.m @@ -0,0 +1,32 @@ +function resu = ge(A, B); + + %# function resu = ge(A, B) + %# Implements the '>=' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: ge.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_func(@ge, A, B); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/gt.m b/octave_packages/dataframe-0.9.1/@dataframe/gt.m new file mode 100644 index 0000000..861de37 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/gt.m @@ -0,0 +1,32 @@ +function resu = gt(A, B); + + %# function resu = gt(A, B) + %# Implements the '>' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: gt.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_func(@gt, A, B); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/horzcat.m b/octave_packages/dataframe-0.9.1/@dataframe/horzcat.m new file mode 100644 index 0000000..462388d --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/horzcat.m @@ -0,0 +1,33 @@ +function resu = horzcat(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: horzcat.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + for indi = 1:length(varargin), + varargin{indi} = dataframe(varargin{indi}, 'colnames', inputname(1+indi));, + endfor + + resu = cat(2, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/imag.m b/octave_packages/dataframe-0.9.1/@dataframe/imag.m new file mode 100644 index 0000000..34c515b --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/imag.m @@ -0,0 +1,29 @@ +function resu = imag(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: imag.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@imag, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/inv.m b/octave_packages/dataframe-0.9.1/@dataframe/inv.m new file mode 100644 index 0000000..7f135cc --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/inv.m @@ -0,0 +1,52 @@ +function [resu, rcond] = inv(df); + + %# function [x, rcond] = inv(df) + %# Overloaded function computing the inverse of a dataframe. To + %# succeed, the dataframe must be convertible to an square array. Row + %# and column meta-information are exchanged. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: inv.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if (length(df._cnt) > 2 || (df._cnt(1) != df._cnt(2))), + error("Dataframe is not square"); + endif + + %# quick and dirty conversion + [dummy, rcond] = inv(horzcat(df._data{:})); + + resu = df_allmeta(df); + + [resu._name{2}, resu._name{1}] = deal(resu._name{1}, resu._name{2}); + [resu._over{2}, resu._over{1}] = deal(resu._over{1}, resu._over{2}); + if (isempty(resu._name{2})), + resu._name{2} = cellstr(repmat('_', resu._cnt(2), 1)); + resu._over{2} = ones(1, resu._cnt(2)); + endif + for indi = resu._cnt(1):-1:1, + resu._data{indi} = dummy(:, indi); + endfor + resu._type(:) = class(dummy); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/ipermute.m b/octave_packages/dataframe-0.9.1/@dataframe/ipermute.m new file mode 100644 index 0000000..0726d6a --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/ipermute.m @@ -0,0 +1,29 @@ +function resu = ipermute(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: ipermute.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper2(@ipermute, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/isempty.m b/octave_packages/dataframe-0.9.1/@dataframe/isempty.m new file mode 100644 index 0000000..b9c63e0 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/isempty.m @@ -0,0 +1,10 @@ +function resu = isempty(df) + %# -*- texinfo -*- + %# @deftypefn {Function File} isempty(@var{df}) + %# Return 1 if df is an empty dataframe (either the number of rows, or + %# the number of columns, or both are zero). Otherwise, return 0. + %# @end deftypefn + + resu = any(0 == size(df)); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/isfield.m b/octave_packages/dataframe-0.9.1/@dataframe/isfield.m new file mode 100644 index 0000000..6e772f2 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/isfield.m @@ -0,0 +1,92 @@ +function [resu, idx] = isfield(df, name, strict) + + %# -*- texinfo -*- + %# @deftypefn {Function File} [@var{resu}, @var{idx}] = isfield + %# (@var{df}, @var{name}, @var{strict}) + %# Return true if the expression @var{df} is a dataframe and it + %# includes an element matching @var{name}. If @var{name} is a cell + %# array, a logical array of equal dimension is returned. @var{idx} + %# contains the column indexes of number of fields matching + %# @var{name}. To enforce strict matching instead of regexp matching, + %# set the third argument to 'true'. + %# @end deftypefn + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: isfield.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if !isa(df, 'dataframe'), + resu = false; return; + endif + + if nargin <2 || nargin > 3, + print_usage(); + resu = false; return; + endif + + if 2 == nargin, strict = false; endif + + if isa(name, 'char'), + if strict, %# use strmatch to get indexes + for indi = size(name, 1):-1:1, + dummy = strmatch(name(indi, :), df._name{2}, "exact"); + resu(indi, 1) = !isempty(dummy); + for indj = 1:length(dummy), + idx(indi, indj) = dummy(indj); + endfor + endfor + else + for indi = size(name, 1):-1:1, + try + dummy = df_name2idx(df._name{2}, name(indi, :), \ + df._cnt(2), 'column'); + resu(indi, 1) = !isempty(dummy); + for indj = 1:length(dummy), + idx(indi, indj) = dummy(indj); + endfor + catch + resu(indi, 1) = false; idx(indi, 1) = 0; + end_try_catch + endfor + endif + elseif isa(name, 'cell'), + if strict, %# use strmatch to get indexes + for indi = size(name, 1):-1:1, + dummy = strmatch(name{indi}, df._name{2}, "exact"); + resu{indi, 1} = !isempty(dummy); + idx{indi, 1} = dummy; + endfor + else + for indi = length(name):-1:1, + try + dummy = df_name2idx(df._name{2}, name{indi}, \ + df._cnt(2), 'column'); + keyboard + resu{indi, 1} = !isempty(dummy); idx{indi, 1} = dummy; + catch + resu{indi, 1} = false; cnt{indi, 1} = 0; + end_try_catch + endfor + endif + endif +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/isinf.m b/octave_packages/dataframe-0.9.1/@dataframe/isinf.m new file mode 100644 index 0000000..a4f89a8 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/isinf.m @@ -0,0 +1,29 @@ +function resu = isinf(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: isinf.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@isinf, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/ismatrix.m b/octave_packages/dataframe-0.9.1/@dataframe/ismatrix.m new file mode 100644 index 0000000..2a029c0 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/ismatrix.m @@ -0,0 +1,38 @@ +function resu = ismatrix(df) + %# function resu = ismatrix(df) + %# returns true if the dataframe can be converted to a matrix + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: ismatrix.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + df_is_num = isnumeric(df._data{1}); + df_is_char = ischar(df._data{1}); + for indi = df._cnt(2):-1:2, + df_is_num = df_is_num & isnumeric(df._data{indi}); + df_is_char = df_is_char & ischar(df._data{indi}); + endfor + + resu = df_is_num | df_is_char; + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/isna.m b/octave_packages/dataframe-0.9.1/@dataframe/isna.m new file mode 100644 index 0000000..2af17a9 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/isna.m @@ -0,0 +1,29 @@ +function resu = isna(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: isna.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@isna, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/isnan.m b/octave_packages/dataframe-0.9.1/@dataframe/isnan.m new file mode 100644 index 0000000..4d8e364 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/isnan.m @@ -0,0 +1,29 @@ +function resu = isnan(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: isnan.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@isnan, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/isnumeric.m b/octave_packages/dataframe-0.9.1/@dataframe/isnumeric.m new file mode 100644 index 0000000..85d3582 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/isnumeric.m @@ -0,0 +1,39 @@ +function resu = ismatrix(df) + %# function resu = isnumeric(df) + %# returns true if the dataframe contains only numeric columns + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: isnumeric.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + df_is_num = isnumeric(df._data{1}); + df_is_char = ischar(df._data{1}); + for indi = df._cnt(2):-1:2, + df_is_num = df_is_num & isnumeric(df._data{indi}); + df_is_char = df_is_char & ischar(df._data{indi}); + endfor + + resu = isnumeric(zeros(0, class(sum(cellfun(@(x) zeros(1, class(x(1))),\ + df._data))))); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/isscalar.m b/octave_packages/dataframe-0.9.1/@dataframe/isscalar.m new file mode 100644 index 0000000..1cde8cd --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/isscalar.m @@ -0,0 +1,31 @@ +function resu = isscalar(df) + %# function resu = isscalar(df) + %# returns true if the dataframe can be converted to a vector + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: isscalar.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = ismatrix(df) & (length(find(df._cnt > 1)) < 1); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/isvector.m b/octave_packages/dataframe-0.9.1/@dataframe/isvector.m new file mode 100644 index 0000000..a11348e --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/isvector.m @@ -0,0 +1,31 @@ +function resu = isvector(df) + %# function resu = isvector(df) + %# returns true if the dataframe can be converted to a vector + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: isvector.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = ismatrix(df) & (length(find(df._cnt > 1)) <= 1); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/kron.m b/octave_packages/dataframe-0.9.1/@dataframe/kron.m new file mode 100644 index 0000000..918d13b --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/kron.m @@ -0,0 +1,36 @@ +function resu = kron(A, B) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: kron.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if (isa(A, 'dataframe')), + A = df_whole(A); + endif + if (isa(B, 'dataframe')), + B = df_whole(B); + endif + + resu = kron(A, B); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/ldivide.m b/octave_packages/dataframe-0.9.1/@dataframe/ldivide.m new file mode 100644 index 0000000..9881f05 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/ldivide.m @@ -0,0 +1,37 @@ +function resu = ldivide(A, B); + + %# function resu = ldivide(A, B) + %# Implements the dotted '\' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: ldivide.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + try + resu = df_func(@ldivide, A, B); + catch + disp(lasterr()); + error("Operator .\\ problem for %s vs. %s", class(A), class(B)); + end_try_catch + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/le.m b/octave_packages/dataframe-0.9.1/@dataframe/le.m new file mode 100644 index 0000000..179147f --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/le.m @@ -0,0 +1,32 @@ +function resu = le(A, B); + + %# function resu = le(A, B) + %# Implements the '<=' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: le.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_func(@le, A, B); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/lgamma.m b/octave_packages/dataframe-0.9.1/@dataframe/lgamma.m new file mode 100644 index 0000000..59a5553 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/lgamma.m @@ -0,0 +1,29 @@ +function resu = lgamma(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: lgamma.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@lgamma, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/log.m b/octave_packages/dataframe-0.9.1/@dataframe/log.m new file mode 100644 index 0000000..1b3cd7e --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/log.m @@ -0,0 +1,29 @@ +function resu = log(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: log.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@log, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/log10.m b/octave_packages/dataframe-0.9.1/@dataframe/log10.m new file mode 100644 index 0000000..de44843 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/log10.m @@ -0,0 +1,29 @@ +function resu = log10(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: log10.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@log10, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/log1p.m b/octave_packages/dataframe-0.9.1/@dataframe/log1p.m new file mode 100644 index 0000000..91b253b --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/log1p.m @@ -0,0 +1,29 @@ +function resu = log1p(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: log1p.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@log1p, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/log2.m b/octave_packages/dataframe-0.9.1/@dataframe/log2.m new file mode 100644 index 0000000..897a624 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/log2.m @@ -0,0 +1,29 @@ +function resu = log2(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: log2.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@log2, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/lt.m b/octave_packages/dataframe-0.9.1/@dataframe/lt.m new file mode 100644 index 0000000..69132e1 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/lt.m @@ -0,0 +1,32 @@ +function resu = lt(A, B); + + %# function resu = minus(A, B) + %# Implements the '<' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: lt.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_func(@lt, A, B); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/max.m b/octave_packages/dataframe-0.9.1/@dataframe/max.m new file mode 100644 index 0000000..437b82b --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/max.m @@ -0,0 +1,29 @@ +function resu = max(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: max.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper2(@max, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/min.m b/octave_packages/dataframe-0.9.1/@dataframe/min.m new file mode 100644 index 0000000..2d93425 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/min.m @@ -0,0 +1,29 @@ +function resu = min(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: min.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper2(@min, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/minus.m b/octave_packages/dataframe-0.9.1/@dataframe/minus.m new file mode 100644 index 0000000..e10ba3b --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/minus.m @@ -0,0 +1,37 @@ +function resu = minus(A, B); + + %# function resu = minus(A, B) + %# Implements the '-' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: minus.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + try + resu = df_func(@minus, A, B); + catch + disp(lasterr()); + error("Operator - problem for %s vs. %s", class(A), class(B)); + end_try_catch + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/mldivide.m b/octave_packages/dataframe-0.9.1/@dataframe/mldivide.m new file mode 100644 index 0000000..a309971 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/mldivide.m @@ -0,0 +1,37 @@ +function resu = mldivide(A, B); + + %# function resu = mldivide(A, B) + %# Implements the '\' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: mldivide.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + try + resu = df_func(@mldivide, A, B, false, [true false]); + catch + disp(lasterr()); + error("Operator \\ problem for %s vs. %s", class(A), class(B)); + end_try_catch + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/mrdivide.m b/octave_packages/dataframe-0.9.1/@dataframe/mrdivide.m new file mode 100644 index 0000000..7781f95 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/mrdivide.m @@ -0,0 +1,37 @@ +function resu = mrdivide(A, B); + + %# function resu = mrdivide(A, B) + %# Implements the '/' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: mrdivide.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + try + resu = df_func(@mrdivide, A, B, [false true], [false true]); + catch + disp(lasterr()); + error("Operator / problem for %s vs. %s", class(A), class(B)); + end_try_catch + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/mtimes.m b/octave_packages/dataframe-0.9.1/@dataframe/mtimes.m new file mode 100644 index 0000000..066f25b --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/mtimes.m @@ -0,0 +1,37 @@ +function resu = mtimes(A, B); + + %# function resu = mtimes(A, B) + %# Implements the '*' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: mtimes.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + try + resu = df_func(@mtimes, A, B, false, [true false]); + catch + disp(lasterr()); + error("Operator * problem for %s vs. %s", class(A), class(B)); + end_try_catch + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/ndims.m b/octave_packages/dataframe-0.9.1/@dataframe/ndims.m new file mode 100644 index 0000000..f380e46 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/ndims.m @@ -0,0 +1,12 @@ +function resu = ndims(df) + %# -*- texinfo -*- + %# @deftypefn {Function File} ndims(@var{df}) + %# overloaded function implementing ndims for a dataframe + %# @end deftypefn + + resu = 2; + nseq = max(cellfun(@length, df._rep)); + + if nseq > 1, resu = 3; endif + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/ne.m b/octave_packages/dataframe-0.9.1/@dataframe/ne.m new file mode 100644 index 0000000..b5f8707 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/ne.m @@ -0,0 +1,32 @@ +function resu = ne(A, B); + + %# function resu = ne(A, B) + %# Implements the '!=' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: ne.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_func(@ne, A, B); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/not.m b/octave_packages/dataframe-0.9.1/@dataframe/not.m new file mode 100644 index 0000000..858ee90 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/not.m @@ -0,0 +1,29 @@ +function resu = not(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: not.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@not, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/or.m b/octave_packages/dataframe-0.9.1/@dataframe/or.m new file mode 100644 index 0000000..8710d50 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/or.m @@ -0,0 +1,32 @@ +function resu = or(A, B); + + %# function resu = or(A, B) + %# Implements the '|' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: or.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_func(@or, A, B); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/permute.m b/octave_packages/dataframe-0.9.1/@dataframe/permute.m new file mode 100644 index 0000000..be72d28 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/permute.m @@ -0,0 +1,114 @@ +function resu = permute(df, perm) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: permute.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = dataframe([]); + + if (length(df._cnt) >= length(perm)), + resu._cnt = df._cnt(perm); + else + resu._cnt = [df._cnt 1](perm); + endif + + if (ndims(df._ridx) < 3), + resu._ridx = permute(df._ridx, [min(perm(1), 2) min(perm(2:end))]); + else + resu._ridx = permute(df._ridx, perm); + endif + + if (size(resu._ridx, 1) < resu._cnt(1)), + %# adjust index size, if required + resu._ridx(end+1:resu._cnt(1), :, :) = NA; + endif + + if (2 == perm(1)), + resu._name{1} = df._name{2}; + resu._over{1} = df._over{2}; + indc = length(resu._name{1}); + indi = resu._cnt(1) - indc; + if (indi > 0), + %# generate a name for the new row(s) + dummy = cstrcat(repmat('_', indi, 1), ... + strjust(num2str(indc + (1:indi).'), 'left')); + resu._name{1}(indc + (1:indi)) = cellstr(dummy); + resu._over{1}(1, indc + (1:indi)) = true; + endif + else + resu._name{1} = df._name{1}; + resu._over{1} = df._over{1}; + endif + + + if (2 == perm(2)), + resu._name{2} = df._name{2}; + resu._over{2} = df._over{2}; + else + resu._name{2} = df._name{1}; + resu._over{2} = df._over{1}; + endif + + if (isempty(resu._name{2})), + indc = 0; + else + indc = length(resu._name{2}); + endif + indi = resu._cnt(2) - indc; + if (indi > 0), + %# generate a name for the new column(s) + dummy = cstrcat(repmat('_', indi, 1), ... + strjust(num2str(indc + (1:indi).'), 'left')); + resu._name{2}(indc + (1:indi)) = cellstr(dummy); + resu._over{2}(1, indc + (1:indi)) = true; + endif + + if (2 != perm(2)), + %# recompute the new type + dummy = zeros(0, class(sum(cellfun(@(x) zeros(1, class(x(1))),\ + df._data)))); + resu._type(1:resu._cnt(2)) = class(dummy); + dummy = permute(df_whole(df), perm); + for indi = 1:resu._cnt(2), + resu._data{indi} = squeeze(dummy(:, indi, :)); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + else %# 2 == perm(2) + if (1 == perm(1)), %# blank operation + resu._type = df._type; + resu._data = df._data; + resu._rep = df._rep; + else + for indi = 1:resu._cnt(2), + unfolded = df._data{indi}(:, df._rep{indi}); + resu._data{indi} = permute(unfolded, [2 1]); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + resu._type{indi} = df._type{indi}; + endfor + endif + endif + + resu._src = df._src; + resu._cmt = df._cmt; + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/plus.m b/octave_packages/dataframe-0.9.1/@dataframe/plus.m new file mode 100644 index 0000000..dedd0f2 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/plus.m @@ -0,0 +1,37 @@ +function resu = plus(A, B); + + %# function resu = plus(A, B) + %# Implements the '+' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: plus.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + try + resu = df_func(@plus, A, B); + catch + disp(lasterr()); + error("Operator + problem for %s vs. %s", class(A), class(B)); + end_try_catch + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/power.m b/octave_packages/dataframe-0.9.1/@dataframe/power.m new file mode 100644 index 0000000..3775b08 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/power.m @@ -0,0 +1,29 @@ +function resu = power(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: power.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@power, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_allmeta.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_allmeta.m new file mode 100644 index 0000000..72999e7 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_allmeta.m @@ -0,0 +1,62 @@ +function resu = df_allmeta(df, dim = []) + + %# function resu = df_allmeta(df) + %# Returns a new dataframe, initalised with the all the + %# meta-information but with empty data + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_allmeta.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = dataframe([]); + + if (isempty(dim)), + dim = df._cnt(1:2); + else + dim = dim(1:2); %# ignore third dim, if any + endif + + resu._cnt(1:2) = min(dim, df._cnt(1:2)); + if (!isempty(df._name{1})), + resu._name{1} = df._name{1}(1:resu._cnt(1)); + resu._over{1} = df._over{1}(1:resu._cnt(1)); + endif + if (!isempty(df._name{2})), + resu._name{2} = df._name{2}(1:resu._cnt(2)); + resu._over{2} = df._over{2}(1:resu._cnt(2)); + endif + if (!isempty(df._ridx)), + if (size(df._ridx, 2) >= resu._cnt(2)), + resu._ridx = df._ridx(1:resu._cnt(1), :, :); + else + resu._ridx = df._ridx(1:resu._cnt(1), 1, :); + endif + endif + %# init it with the right orientation + resu._data = cell(size(df._data)); + resu._rep = cell(size(df._rep)); + resu._type = df._type(1:resu._cnt(2)); + resu._src = df._src; + resu._cmt = df._cmt; + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_basecomp.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_basecomp.m new file mode 100644 index 0000000..17b8ad7 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_basecomp.m @@ -0,0 +1,193 @@ +function [A, B, C] = df_basecomp(A, B, itercol=true, func=@plus); + + %# function [A, B, C] = df_basecomp(A, B, itercol) + %# Basic size and metadata compatibility verifications for + %# two-arguments operations on dataframe. Returns a scalar, a matrix, + %# or a dataframe. Cell arrays are converted to df. Third output + %# contains a merge of the metadata. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_basecomp.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if 1 == length(itercol), + strict = false; + else + strict = itercol(2); itercol = itercol(1); + endif + + if (iscell(A)), A = dataframe(A); endif + if (iscell(B)), B = dataframe(B); endif + + switch (func2str(func)), + case 'bsxfun' + %# bsxfun compatibility rule: if there is at least one singleton + %# dim, the smallest is repeated to reach the size of the + %# greatest. Otherwise, all dims must be equal. + if (any(size(A)(1:2) != size(B)(1:2))) + if (!any (1 == [size(A) size(B)])) + error('bsxfun: both arguments must have the same dim, of one of them must have at least one singleton dim'); + else + Csize = max([size(A)(1:2); size(B)(1:2)]); + endif + else + Csize = size(A)(1:2); + endif + case 'mldivide' + if (isscalar(A)), + Csize = size(B)(1:2); + else + if (size(A, 1) != size(B, 1)), + error("Non compatible row sizes (op1 is %dx%d, op2 is %dx%d)",\ + size(A), size(B)(1:2)); + endif + Csize = [size(A, 2) size(B, 2)]; + endif + otherwise + %# if strict is set, B may not be non-scalar vs scalar + if ((!(isscalar(A) || isscalar(B)))||(strict && isscalar(A))), + if (itercol), %# requires full compatibility + Csize = size(A)(1:2); + if (any(Csize - size(B)(1:2))), + %# disp([size(A) size(B)]) + error("Non compatible row and columns sizes (op1 is %dx%d, op2 is %dx%d)",\ + Csize, size(B)); + endif + else %# compatibility with matrix product + if (size(A, 2) - size(B, 1)), + error("Non compatible columns vs. rows size (op1 is %dx%d, op2 is %dx%d)",\ + size(A)(1:2), size(B)(1:2)); + endif + Csize = [size(A, 1) size(B, 2)]; + endif + endif + endswitch + + if !(isscalar(A) || isscalar(B)) + C = []; + if (isa(A, 'dataframe')) + if (nargout > 2 && all(Csize == size(A)(1:2))), + C = df_allmeta(A, Csize); + endif + if (isa(B, 'dataframe')) + if (nargout > 2 && isempty(C) && all(Csize == size(B)(1:2))), + C = df_allmeta(B, Csize); + endif + if (strict), + %# compare indexes if both exist + if (!isempty(A._ridx)) + if (!isempty(B._ridx) && itercol), + if (any(A._ridx-B._ridx)), + error("Non compatible indexes"); + endif + endif + else + if (nargout > 2 && itercol), C._ridx = B._ridx; endif + endif + + if (itercol), + idxB = 1; %# row-row comparison + else + idxB = 2; %# row-col comparsion + endif + + if (!isempty(A._name{1})) + if (!isempty(B._name{idxB})) + dummy = !(strcmp(cellstr(A._name{1}), cellstr(B._name{idxB}))\ + | (A._over{1}(:)) | (B._over{idxB}(:))); + if (any(dummy)), + if (itercol), + error("Incompatible row names"); + else + error("Incompatible row vs. column names"); + endif + endif + dummy = A._over{1} > B._over{idxB}; + if (any(dummy)), + C._name{1}(dummy) = B._name{idxB}(dummy); + C._over{1}(dummy) = B._over{idxB}(dummy); + endif + endif + else + if (nargout > 2), + C._name{1} = B._name{idxB}; C._over{1} = B._over{idxB}; + endif + endif + + idxB = 3-idxB; + + if (!isempty(A._name{2})) + if (!isempty(B._name{idxB})) + dummy = !(strcmp(cellstr(A._name{2}), cellstr(B._name{2}))\ + | (A._over{2}(:)) | (B._over{2}(:))); + if (any(dummy)), + if (itercol), + error("Incompatible column vs row names"); + else + error("Incompatible column names"); + endif + endif + dummy = A._over{2} > B._over{idxB}; + if (any(dummy)), + C._name{2}(dummy) = B._name{idxB}(dummy); + C._over{2}(dummy) = B._over{idxB}(dummy); + endif + endif + else + if (nargout > 2 && !isempty(B._name{idxB})), + C._name{2} = B._name{idxB}; C._over{2} = B._over{idxB}; + endif + endif + endif + + if (isempty(A._src) && nargout > 2 && !isempty(B._src)), + C._src = B._src; + endif + if (isempty(A._cmt) && nargout > 2 && !isempty(B._cmt)), + C._cmt = B._cmt; + endif + else %# B is not a df + if (nargout > 2 && isempty(C)), + C = df_allmeta(A); + endif + endif + else %# A is not a df + if (nargout > 2), + if (all(Csize==size(B)(1:2))), + C = df_allmeta(B, Csize); + else + C = df_allmeta(B); + endif + endif + endif + else %# both arg are scalar + if (nargout > 2), + if (isa(A, 'dataframe')) + C = df_allmeta(A); + else + C = df_allmeta(B); + endif + endif + endif + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_check_char_array.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_check_char_array.m new file mode 100644 index 0000000..7ab164b --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_check_char_array.m @@ -0,0 +1,52 @@ +function resu = df_check_char_array(x, nelem, required) + + %# auxiliary function: pad a char array to some width + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_check_char_array.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if 2 == nargin, required = [nelem 1]; endif + + if nelem < required(1), + error("Too many elements to assign"); + endif + + %# a zero-length element is still considered as a space by char + if isempty(x), x = ' '; endif + + if size(x, 1) < max(required(1), nelem) + %# pad vertically + dummy = repmat(' ', nelem-size(x, 1), 1); + resu = char(x, dummy); + else + resu = x; + endif + + if size(resu, 2) < required(2), + %# pad horizontally + dummy = repmat(' ', nelem, required(2)-size(resu, 2)); + resu = horzcat(resu, dummy); + endif + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_colmeta.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_colmeta.m new file mode 100644 index 0000000..682cf66 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_colmeta.m @@ -0,0 +1,43 @@ +function resu = df_colmeta(df) + + %# function resu = df_colmeta(df) + %# Returns a new dataframe, initalised with the meta-information + %# about columns from the source, but with empty data + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_func.m 7943 2010-11-24 15:33:54Z cdemills $ + %# + + resu = dataframe([]); + + resu._cnt(2) = df._cnt(2); + resu._name{2} = df._name{2}; + resu._over{2} = df._over{2}; + resu._type = df._type; + %# init it with the right orientation + resu._data = cell(size(df._data)); + resu._rep = cell(size(df._rep)); + resu._src = df._src; + resu._cmt = df._cmt; + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_cow.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_cow.m new file mode 100644 index 0000000..433c00e --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_cow.m @@ -0,0 +1,78 @@ +function [df, S] = df_cow(df, S, col) + + %# function [resu, S] = df_cow(df, S, col) + %# Implements Copy-On-Write on dataframe. If one or more columns + %# specified in inds is aliased to another one, duplicate it and + %# adjust the repetition index to remove the aliasing + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_cow.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if length(col) > 1, + error("df_cow must work on a column-by-column basis"); + endif + + if (1 == length(S.subs)), + inds = 1; + else + inds = S.subs{2}; + endif + + if (!isnumeric(inds)), + if !strcmp(inds, ':'), + error("Unknown sheet selector %s", inds); + endif + inds = 1:length(df._rep(col)); + endif + + for indi = inds(:).', + dummy = df._rep{col}; dummy(indi) = 0; + [t1, t2] = ismember(df._rep{col}(indi)(:), dummy); + for indj = t2(find(t2)), %# Copy-On-Write + %# determines the index for the next column + t1 = 1+max(df._rep{col}); + %# duplicate the touched column + df._data{col} = horzcat(df._data{col}, \ + df._data{col}(:, df._rep{col}(indj))); + if (indi > 1), + %# a new column has been created + df._rep{col}(indi) = t1; + else + %# update repetition index aliasing this one + df._rep{col}(find(dummy == indi)) = t1; + endif + endfor + endfor + + %# reorder S + if (length(S.subs) > 1), + if (S.subs{2} != 1 || length(S.subs{2}) > 1), + %# adapt sheet index according to df_rep + S.subs{2} = df._rep{col}(S.subs{2}); + endif + endif + + df = df_thirddim(df); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_func.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_func.m new file mode 100644 index 0000000..3bc91e7 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_func.m @@ -0,0 +1,235 @@ +function resu = df_func(func, A, B, itercol=true, whole=logical([0 0])); + + %# function resu = df_func(func, A, B, whole) + %# Implements an iterator to apply some func when at + %# least one argument is a dataframe. The output is a dataframe with + %# the same metadata, types may be altered, like f.i. double=>logical. + %# When itercol is 'true', the default, LHS is iterated by columns, + %# otherwise by rows. 'Whole' is a two-elements logical vector with + %# the meaning that LHS and or RHS must be iterated at once or not + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_func.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + [A, B, resu] = df_basecomp(A, B, itercol, func); + itercol = itercol(1); %# drop second value + + if (isa(B, 'dataframe')) + if (!isa(A, 'dataframe')), + if (isscalar(A)), + for indi = resu._cnt(2):-1:1, + switch resu._type{indi} + case "char" + resu._data{indi} = feval(func, A, char(B._data{indi})); + otherwise + resu._data{indi} = feval(func, A, B._data{indi}); + endswitch + endfor + resu._rep = B._rep; + else + if (whole(1) && !whole(2)), + for indi = resu._cnt(2):-1:1, + switch resu._type{indi} + case "char" + resu._data{indi} = feval(func, A, \ + char(B._data{indi}(:, B._rep{indi}))); + otherwise + resu._data{indi} = feval(func, A, \ + B._data{indi}(:, B._rep{indi})); + endswitch + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + elseif (itercol && !whole(2)), + for indi = resu._cnt(2):-1:1, + switch resu._type{indi} + case "char" + resu._data{indi} = feval(func, squeeze(A(:, indi, :)), \ + char(B._data{indi}(:, B._rep{indi}))); + otherwise + resu._data{indi} = feval(func, squeeze(A(:, indi, :)), \ + B._data{indi}(:, B._rep{indi})); + endswitch + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + elseif (!whole(2)), + warning("no 3D yet"); + for indi = resu._cnt(2):-1:1, + switch resu._type{indi} + case "char" + resu._data{indi} = feval(func, A(indi, :), char(B._data{indi})); + otherwise + resu._data{indi} = feval(func, A(indi, :), B._data{indi}); + endswitch + endfor + else + dummy = feval(func, A, df_whole(B)); + for indi = resu._cnt(2):-1:1, %# store column-wise + resu._data{indi} = squeeze(dummy(:, indi, :)); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + resu._type{indi} = class(dummy); + endfor + endif + endif + else + if (itercol), + for indi = resu._cnt(2):-1:1, + switch resu._type{indi} + case "char" + resu._data{indi} = feval\ + (func, char(A._data{indi}(:, A._rep{indi})), \ + char(B._data{indi}(B._rep{indi}))); + otherwise + resu._data{indi} = feval\ + (func, A._data{indi}(:, A._rep{indi}), \ + B._data{indi}(:, B._rep{indi})); + endswitch + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + else %# itercol is false + dummy = df_whole(A); + if whole(1), + for indi = resu._cnt(2):-1:1, + switch resu._type{indi} + case "char" + resu._data{indi} = feval(func, dummy, \ + char(B._data{indi}(:, B._rep{indi}))); + otherwise + resu._data{indi} = feval(func, dummy, \ + B._data{indi}(:, B._rep{indi})); + endswitch + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + elseif (!whole(2)), + for indi = resu._cnt(2):-1:1, + switch resu._type{indi} + case "char" + resu._data{indi} = squeeze\ + (feval(func, dummy(indi, :, :),\ + char(B._data{indi}(:, B._rep{indi})))); + otherwise + resu._data{indi} = squeeze\ + (feval(func, dummy(indi, :, :), \ + B._data{indi}(:, B._rep{indi}))); + endswitch + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + else + dummy = feval(func, dummy, df_whole(B)); + for indi = resu._cnt(2):-1:1, %# store column-wise + resu._data{indi} = squeeze(dummy(:, indi, :)); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + resu._type{indi} = class(dummy); + endfor + endif + endif + endif + else %# B is not a dataframe + if (isscalar(B)), + for indi = resu._cnt(2):-1:1, + switch resu._type{indi} + case "char" + resu._data{indi} = feval(func, char(A._data{indi}), B); + otherwise + resu._data{indi} = feval(func, A._data{indi}, B); + endswitch + endfor + resu._rep = A._rep; + else + if (itercol), + if (whole(2)), + for indi = resu._cnt(2):-1:1, + switch resu._type{indi} + case "char" + unfolded = char(A._data{indi}(:, A._rep{indi})); + otherwise + unfolded = A._data{indi}(:, A._rep{indi}); + endswitch + resu._data{indi} = squeeze(feval(func, unfolded, B)); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + else + for indi = resu._cnt(2):-1:1, + switch resu._type{indi} + case "char" + unfolded = char(A._data{indi}(:, A._rep{indi})); + otherwise + unfolded = A._data{indi}(:, A._rep{indi}); + endswitch + resu._data{indi} = feval(func, unfolded, \ + squeeze(B(:, indi, :))); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + endif + else + dummy = df_whole(A); + if whole(1), + for indi = columns(B):-1:1, + resu._data{indi} = squeeze(feval(func, dummy, B(:, indi, :))); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + else + if !whole(2), + for indi = resu._cnt(1):-1:1, + resu._data{indi} = squeeze(feval(func, dummy(indi, :, :), \ + B(:, indi, :))); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + else + for indi = resu._cnt(1):-1:1, %# in place computation + dummy(indi, :, :) = feval(func, dummy(indi, :, :), B); + endfor + for indi = resu._cnt(2):-1:1, %# store column-wise + resu._data{indi} = squeeze(dummy(:, indi, :)); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + endif + endif + %# verify that sizes match, this is required for "\" + resu._cnt(2) = length(resu._data); + resu._cnt(1) = max(cellfun('size', resu._data, 1)); + if (length(resu._ridx) < resu._cnt(1)), + if (1 == length(resu._ridx)), + resu._ridx(end+1:resu._cnt(1), 1) = resu._ridx(1); + else + resu._ridx(end+1:resu._cnt(1), 1) = NA; + endif + endif + if (length(resu._name{2}) < resu._cnt(2)), + if (1 == length(resu._name{2})), + resu._name{2}(end+1:resu._cnt(2), 1) = resu._name{2}; + resu._over{2}(end+1:resu._cnt(2), 1) = resu._over{2}; + else + resu._name{2}(end+1:resu._cnt(2), 1) = '_'; + resu._over{2}(end+1:resu._cnt(2), 1) = true; + endif + endif + endif + endif + endif + + resu._type = cellfun(@class, resu._data, "UniformOutput", false); + + resu = df_thirddim(resu); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_mapper.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_mapper.m new file mode 100644 index 0000000..7beb1ba --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_mapper.m @@ -0,0 +1,37 @@ +function resu = df_mapper(func, df, varargin) + %# resu = df_mapper(func, df) + %# small interface to iterate some func over the elements of a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_mapper.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_allmeta(df); + resu._data = cellfun(@(x) feval(func, x, varargin{:}), df._data, \ + "UniformOutput", false); + resu._rep = df._rep; %# things didn't change + resu._type = cellfun(@(x) class(x(1)), resu._data, "UniformOutput", false); + + resu = df_thirddim(resu); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_mapper2.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_mapper2.m new file mode 100644 index 0000000..d6cc37c --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_mapper2.m @@ -0,0 +1,77 @@ +function resu = df_mapper2(func, df, varargin) + %# resu = df_mapper2(func, df) + %# small interface to iterate some vector func over the elements of a + %# dataframe. This one is specifically adapted to all functions where + %# the first argument, if numeric, is 'dim'. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_mapper2.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + dim = 1; resu = []; vout = varargin; + + %# take care of constructs as min(x, [], dim) + if (!isempty(varargin)), + indk = 1; while indk <= length(varargin), + if (isnumeric(varargin{indk})), + if (isempty(varargin{indk})), + indk = indk + 1; continue; + endif + dim = varargin{indk}; + %# the "third" dim is the second on stored data + if 3 == dim, vout(indk) = 2; endif + endif + break; + endwhile + endif + + switch(dim) + case {1}, + resu = df_colmeta(df); + for indi = 1:df._cnt(2), + resu._data{indi} = feval(func, df._data{indi}(:, df._rep{indi}), \ + vout{:}); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + resu._cnt(1) = max(cellfun('size', resu._data, 1)); + if (resu._cnt(1) == df._cnt(1)), + %# the func was not contracting + resu._ridx = df._ridx; + resu._name{1} = resu._name{1}; resu._over{1} = resu._over{1}; + endif + case {2}, + error('Operation not implemented'); + case {3}, + resu = df_allmeta(df); + for indi = 1:df._cnt(2), + resu._data{indi} = feval(func, df._data{indi}(:, df._rep{indi}), \ + vout{:}); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + otherwise + error("Invalid dimension %d", dim); + endswitch + + resu = df_thirddim(resu); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_matassign.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_matassign.m new file mode 100644 index 0000000..ae639d7 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_matassign.m @@ -0,0 +1,502 @@ +function df = df_matassign(df, S, indc, ncol, RHS) + %# auxiliary function: assign the dataframe as if it was a matrix + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_matassign.m 9615 2012-02-10 15:22:57Z cdemills $ + %# + + if (isnull (RHS)) + if (1 == ncol) + if (sum (~strcmp (S.subs, ':')) > 2) + error("A null assignment can only have one non-colon index."); + endif + elseif (sum (~strcmp (S.subs, ':')) > 1) + error("A null assignment can only have one non-colon index."); + endif + + if (strcmp (S.subs(1), ':')) %# removing column/matrix + RHS = S; RHS.subs(2) = []; + for indi = (indc) + unfolded = df._data{indi}(:, df._rep{indi}); + unfolded = feval (@subsasgn, unfolded, RHS, []); + df._data{indi} = unfolded; + if (~isempty (unfolded)) + df._rep(indi) = 1:size (unfolded, 2); + endif + endfor + %# remove empty elements + indi = cellfun ('isempty', df._data); + if (any (indi)) %# nothing left, remove this column + df._cnt(2) = df._cnt(2) - sum (indi); + indi = ~indi; %# vector of kept data + df._name{2} = df._name{2}(indi); + df._over{2} = df._over{2}(indi); + df._type = df._type(indi); + df._data = df._data(indi); + df._rep = df._rep(indi); + endif + if (size (df._ridx, 3) > 1) + df._ridx(:, indc, :) = []; + endif + elseif (strcmp (S.subs(2), ':')) %# removing rows + indr = S.subs{1}; + if (~isempty (df._name{1})) + df._name{1}(indr, :) = []; + df._over{1}(indr) = []; + endif + df._ridx(indr, :, :) = []; + %# to remove a line, iterate on each column + df._data = cellfun (@(x) feval(@subsasgn, x, S, []), \ + df._data, "UniformOutPut", false); + if (isa (indr, 'char')) + df._cnt(1) = 0; + else + df._cnt(1) = df._cnt(1) - length (indr); + endif + endif + df = df_thirddim (df); + return; + endif + + indc_was_set = ~isempty (indc); + if (~indc_was_set) %# initial dataframe was empty + ncol = size (RHS, 2); indc = 1:ncol; + endif + + indr = S.subs{1, 1}; + indr_was_set = ~isempty (indr); + %# initial dataframe was empty ? + if (~indr_was_set || strcmp (indr, ':')) + if (iscell (RHS)) + nrow = max (sum (cellfun ('size', RHS, 1))); + else + if (isvector (RHS)) + if (0 == df._cnt(1)) + nrow = size (RHS, 1); + else + nrow = df._cnt(1); %# limit to df numbner of rows + endif + else + %# deduce limit from RHS + nrow = size (RHS, 1); + endif + endif + indr = 1:nrow; + elseif (~isempty (indr)) + if (~isnumeric (indr)) + %# translate row names to row index + [indr, nrow] = df_name2idx (df._name{1}, indr, df._cnt(1), 'row'); + S.subs{1, 1} = indr; + else + nrow = length (indr); + endif + endif + if (length (S.subs) > 2) + inds = S.subs{1, 3}; + else + inds = []; + endif + + rname = cell(0, 0); rname_width = max (1, size (df._name{2}, 2)); + ridx = []; cname = rname; ctype = rname; + + if (iscell (RHS)) + if ((length (indc) == df._cnt(2) && size (RHS, 2) >= df._cnt(2)) \ + || 0 == df._cnt(2) || isempty (S.subs{1}) || isempty (S.subs{2})) + %# providing too much information -- remove extra content + if (size (RHS, 1) > 1) + %# at this stage, verify that the first line doesn't contain + %# chars only; use them for column names + dummy = cellfun ('class', \ + RHS(1, ~cellfun ('isempty', RHS(1, :))), \ + 'UniformOutput', false); + dummy = strcmp (dummy, 'char'); + if (all (dummy)) + if (length (df._over{2}) >= max (indc) \ + && ~all (df._over{2}(indc)) && ~isempty (S.subs{2})) + warning("Trying to overwrite colum names"); + endif + + cname = RHS(1, :).'; RHS = RHS(2:end, :); + if (~indr_was_set) + nrow = nrow - 1; indr = 1:nrow; + else + %# we know indr, there is no reason that RHS(:, 1) contains + %# row names. + if (isempty (S.subs{2})) + %# extract columns position from columns names + [indc, ncol, S.subs{2}, dummy] = ... + df_name2idx (df._name{2}, cname, df._cnt(2), 'column'); + if (length (dummy) ~= sum (dummy)) + warning ("Not all RHS column names used"); + cname = cname(dummy); RHS = RHS(:, dummy); + endif + endif + endif + endif + %# at this stage, verify that the first line doesn't contain + %# chars only; use them for column types + dummy = cellfun ('class', \ + RHS(1, ~cellfun ('isempty', RHS(1, :))), \ + 'UniformOutput', false); + dummy = strcmp (dummy, 'char'); + if (all (dummy)) + if (length (df._over{2}) >= max (indc) \ + && ~all (df._over{2}(indc))) + warning ("Trying to overwrite colum names"); + endif + + ctype = RHS(1, :); RHS = RHS(2:end, :); + if (~indr_was_set) + nrow = nrow - 1; indr = 1:nrow; + endif + endif + endif + + %# more elements than df width -- try to use the first two as + %# row index and/or row name + if (size (RHS, 1) > 1) + dummy = all (cellfun ('isnumeric', \ + RHS(~cellfun ('isempty', RHS(:, 1)), 1))); + else + dummy = isnumeric(RHS{1, 1}); + endif + dummy = dummy && (~isempty (cname) && size (cname{1}, 2) < 1); + if (dummy) + ridx = cell2mat (RHS(:, 1)); + %# can it be converted to a list of unique numbers ? + if (length (unique (ridx)) == length (ridx)) + ridx = RHS(:, 1); RHS = RHS(:, 2:end); + if (length (df._name{2}) == df._cnt(2) + ncol) + %# columns name were pre-filled with too much values + df._name{2}(end) = []; + df._over{2}(end) = []; + if (size (RHS, 2) < ncol) + ncol = size (RHS, 2); indc = 1:ncol; + endif + elseif (~indc_was_set) + ncol = ncol - 1; indc = 1:ncol; + endif + if (~isempty (cname)) cname = cname(2:end); endif + if (~isempty (ctype)) ctype = ctype(2:end); endif + else + ridx = []; + endif + endif + + if (size (RHS, 2) > df._cnt(2)) + %# verify the the first row doesn't contain chars only, use them + %# for row names + dummy = cellfun ('class', \ + RHS(~cellfun ('isempty', RHS(:, 1)), 1), \ + 'UniformOutput', false); + dummy = strcmp (dummy, 'char') \ + && (~isempty (cname) && size (cname{1}, 2) < 1); + if (all (dummy)) + if (length (df._over{1}) >= max (indr) \ + && ~all (df._over{1}(indr))) + warning("Trying to overwrite row names"); + else + rname = RHS(:, 1); + endif + rname_width = max ([1; cellfun('size', rname, 2)]); + RHS = RHS(:, 2:end); + if (length (df._name{2}) == df._cnt(2) + ncol) + %# columns name were pre-filled with too much values + df._name{2}(end) = []; + df._over{2}(end) = []; + if (size (RHS, 2) < ncol) + ncol = size (RHS, 2); indc = 1:ncol; + endif + elseif (~indc_was_set) + ncol = ncol - 1; indc = 1:ncol; + endif + if (~isempty (cname)) cname = cname(2:end); endif + if (~isempty (ctype)) ctype = ctype(2:end); endif + endif + endif + endif + endif + + %# perform row resizing if columns are already filled + if (~isempty (indr) && isnumeric(indr)) + if (max (indr) > df._cnt(1) && size (df._data, 2) == df._cnt(2)) + df = df_pad (df, 1, max (indr)-df._cnt(1), rname_width); + endif + endif + + if (iscell(RHS)) %# we must pad on a column-by-column basis + %# verify that each cell contains a non-empty vector, and that sizes + %# are compatible + %# dummy = cellfun ('size', RHS(:), 2); + %# if any (dummy < 1), + %# error("cells content may not be empty"); + %# endif + + %# dummy = cellfun ('size', RHS, 1); + %# if any (dummy < 1), + %# error("cells content may not be empty"); + %# endif + %# if any (diff(dummy) > 0), + %# error("cells content with unequal length"); + %# endif + %# if 1 < size (RHS, 1) && any (dummy > 1), + %# error("cells may only contain scalar"); + %# endif + + if (size(RHS, 2) > indc) + keyboard + endif + + %# the real assignement + if (1 == size (RHS, 1)) %# each cell contains one vector + fillfunc = @(x) RHS{x}; + idxOK = logical(indr); + else %# use cell2mat to pad on a column-by-column basis + fillfunc = @(x) cell2mat (RHS(:, x)); + endif + + indj = 1; + for indi = (1:ncol) + if (indc(indi) > df._cnt(2)) + %# perform dynamic resizing one-by-one, to get type right + if (isempty (ctype) || length (ctype) < indc(indi)) + df = df_pad(df, 2, indc(indi)-df._cnt(2), class(RHS{1, indj})); + else + df = df_pad(df, 2, indc(indi)-df._cnt(2), ctype{indj}); + endif + endif + if (nrow == df._cnt(1)) + %# whole assignement + try + if (size (RHS, 1) <= 1) + switch df._type{indc(indi)} + case {'char' } %# use a cell array to hold strings + dummy = RHS(:, indj); + case {'double' } + dummy = fillfunc (indj); + otherwise + dummy = cast(fillfunc (indj), df._type{indc(indi)}); + endswitch + else + %# keeps indexes in sync as cell elements may be empty + idxOK = ~cellfun ('isempty', RHS(:, indj)); + %# intialise dummy so that it can receive "anything" + dummy = []; + switch (df._type{indc(indi)}) + case {'char' } %# use a cell array to hold strings + dummy = RHS(:, indj); + case {'double' } + dummy(idxOK, :) = fillfunc (indj); dummy(~idxOK, :) = NA; + otherwise + dummy(idxOK, :) = fillfunc (indj); dummy(~idxOK, :) = NA; + dummy = cast(dummy, df._type{indc(indi)}); + endswitch + endif + catch + dummy = \ + sprintf ("Assignement failed for colum %d, of type %s and length %d,\nwith new content\n%s", \ + indj, df._type{indc(indi)}, length (indr), disp (RHS(:, indj))); + error (dummy); + end_try_catch + if (size (dummy, 1) < df._cnt(1)) + dummy(end+1:df._cnt(1), :) = NA; + endif + else + %# partial assignement -- extract actual data and update + dummy = df._data{indc(indi)}; + try + switch (df._type{indc(indi)}) + case {'char' } %# use a cell array to hold strings + dummy(indr, 1) = RHS(:, indj); + case {'double' } + dummy(indr, :) = fillfunc (indj); + otherwise + dummy(indr, :) = cast(fillfunc (indj), df._type{indc(indi)}); + endswitch + catch + dummy = \ + sprintf ("Assignement failed for colum %d, of type %s and length %d,\nwith new content\n%s", \ + indj, df._type{indc(indi)}, length (indr), disp(RHS(:, indj))); + error (dummy); + end_try_catch + endif + df._data{indc(indi)} = dummy; df._rep{indc(indi)} = 1:size (dummy, 2); + indj = indj + 1; + endfor + + else + %# RHS is either a numeric, either a df + if (any (indc > min (size (df._data, 2), df._cnt(2)))) + df = df_pad(df, 2, max (indc-min (size (df._data, 2), df._cnt(2))),\ + class(RHS)); + endif + if (~isempty (inds) && isnumeric(inds) && any (inds > 1)) + for indi = (1:length (indc)) + if (max (inds) > length (df._rep{indc(indi)})) + df = df_pad(df, 3, max (inds)-length (df._rep{indc(indi)}), \ + indc(indi)); + endif + endfor + endif + + if (isa (RHS, 'dataframe')) + %# block-copy index + S.subs(2) = 1; + if (any (~isna(RHS._ridx))) + df._ridx = feval(@subsasgn, df._ridx, S, RHS._ridx); + endif + %# skip second dim and copy data + S.subs(2) = []; Sorig = S; + for indi = (1:length (indc)) + [df, S] = df_cow(df, S, indc(indi)); + if (strcmp (df._type(indc(indi)), RHS._type(indi))) + try + df._data{indc(indi)} = feval(@subsasgn, df._data{indc(indi)}, S, \ + RHS._data{indi}(:, RHS._rep{indi})); + catch + disp(lasterr()); disp('line 516 ???'); keyboard + end_try_catch + else + df._data{indc(indi)} = feval(@subsasgn, df._data{indc(indi)}, S, \ + cast(RHS._data{indi}(:, RHS._rep{indi}),\ + df._type(indc(indi)))); + endif + S = Sorig; + endfor + if (~isempty (RHS._name{1})) + df._name{1}(indr) = genvarname(RHS._name{1}(indr)); + df._over{1}(indr) = RHS._over{1}(indr); + endif + if (~isempty (RHS._src)) + if (~any (strcmp (cellstr(df._src), cellstr(RHS._src)))) + df._src = vertcat(df._src, RHS._src); + endif + endif + if (~isempty (RHS._cmt)) + if (~any (strcmp (cellstr(df._cmt), cellstr(RHS._cmt)))) + df._cmt = vertcat(df._cmt, RHS._cmt); + endif + endif + + else + %# RHS is homogenous, pad at once + if (isvector (RHS)) %# scalar - vector + if (isempty (S.subs)) + fillfunc = @(x, y) RHS; + else + %# ignore 'column' dimension -- force colum vectors -- use a + %# third dim just in case + if (isempty (S.subs{1})) S.subs{1} = ':'; endif + S.subs(2) = []; + if (length (S.subs) < 2) + S.subs{2} = 1; + endif + if (length (indc) > 1 && length (RHS) > 1) + %# set a row from a vector + fillfunc = @(x, S, y) feval (@subsasgn, x, S, RHS(y)); + else + fillfunc = @(x, S, y) feval (@subsasgn, x, S, RHS); + endif + endif + Sorig = S; + for indi = (1:length (indc)) + try + [df, S] = df_cow(df, S, indc(indi)); + df._data{indc(indi)} = fillfunc (df._data{indc(indi)}, S, indi); + S = Sorig; + catch + disp(lasterr) + disp('line 470 '); keyboard + end_try_catch + # catch + # if ndims(df._data{indc(indi)}) > 2, + # %# upstream forgot to give the third dim + # dummy = S; dummy.subs(3) = 1; + # df._data{indc(indi)} = fillfunc(df._data{indc(indi)}, \ + # dummy, indi); + # else + # rethrow(lasterr()); + # endif + # end_try_catch + endfor + else %# 2D - 3D matrix + S.subs(2) = []; %# ignore 'column' dimension + if (isempty (S.subs{1})) + S.subs{1} = indr; + endif + %# rotate slices in dim 1-3 to slices in dim 1-2 + fillfunc = @(x, S, y) feval(@subsasgn, x, S, squeeze(RHS(:, y, :))); + Sorig = S; + for indi = (1:length (indc)) + [df, S] = df_cow(df, S, indc(indi)); + df._data{indc(indi)} = fillfunc (df._data{indc(indi)}, S, indi); + S = Sorig; + endfor + endif + if (indi < size (RHS, 2) && ~isa (RHS, 'char')) + warning (' not all columns of RHS used'); + endif + endif + endif + + %# delayed row padding -- column padding occured before + if (~isempty (indr) && isnumeric (indr)) + if (max (indr) > df._cnt(1) && size (df._data, 2) < df._cnt(2)) + df = df_pad(df, 1, max (indr)-df._cnt(1), rname_width); + endif + endif + + %# adjust ridx and rnames, if required + if (~isempty (ridx)) + dummy = df._ridx; + if (1 == size (RHS, 1)) + dummy(indr) = ridx{1}; + else + dummy(indr) = vertcat(ridx{indr}); + endif + if (length (unique (dummy)) ~= length (dummy)) %# || \ + %# any (diff(dummy) <= 0), + error("row indexes are not unique or not ordered"); + endif + df._ridx = dummy; + endif + + if (~isempty (rname) && (length (df._over{1}) < max (indr) || \ + all (df._over{1}(indr)))) + df._name{1}(indr, 1) = genvarname(rname); + df._over{1}(1, indr) = false; + endif + if (~isempty (cname) && (length (df._over{2}) < max (indc) || \ + all (df._over{2}(indc)))) + try + df._name{2}(indc, 1) = genvarname (cname); + catch + disp('line 472 '); keyboard + end_try_catch + df._over{2}(1, indc) = false; + endif + + df = df_thirddim (df); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_name2idx.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_name2idx.m new file mode 100644 index 0000000..c67af96 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_name2idx.m @@ -0,0 +1,130 @@ +function [idx, nelem, subs, mask] = df_name2idx(names, subs, count, dimname, missingOK=false); + + %# This is a helper routine to translate rownames or columnames into + %# real index. Input: names, a char array, and subs, a cell array as + %# produced by subsref and similar. This routine can also detect + %# ranges, two values separated by ':'. On output, subs is + %# 'sanitised' from names, and is either a vector, either a single ':' + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_name2idx.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if (isempty (subs)) + %# not caring about rownames ? Avoid generating an error. + idx = []; nelem = 0; return + endif + + if (isa (subs, 'char')), + orig_name = subs; + if (1 == size (subs, 1)) + if (strcmp(subs, ':')) %# range operator + idx = 1:count; nelem = count; + return + endif + endif + subs = cellstr (subs); + else + if (~isvector(subs)) + %# yes/no ? + %# error("Trying to access column as a matrix"); + endif + switch (class (subs)) + case {"cell"} + orig_name = char (subs); + case {"dataframe"} + orig_name = "elements indexed by a dataframe"; + otherwise + orig_name = num2str (subs); + endswitch + endif + + if (isa (subs, 'cell')) + subs = subs(:); idx = []; mask = logical (zeros (size (subs, 1), 1)); + %# translate list of variables to list of indices + for indi = (1:size(subs, 1)) + %# regexp doesn't like empty patterns + if (isempty (subs{indi})) continue; endif + %# convert from standard pattern to regexp pattern + subs{indi} = regexprep (subs{indi}, '([^\.\\])(\*|\?)', "$1.$2"); + %# quote repetition ops at begining of line, otherwise the regexp + %# will stall forever/fail + subs{indi} = regexprep (subs{indi}, \ + '^([\*\+\?\{\}\|])', "\\$1"); + %# detect | followed by EOL + subs{indi} = regexprep (subs{indi}, '([^\\])\|$', "$1\\|"); + if (0 == index (subs{indi}, ':')) + for indj = (1:min (length (names), count)) %# sanity check + if (~isempty (regexp (names{indj}, subs{indi}))) + idx = [idx indj]; mask(indi) = true; + endif + endfor + else + dummy = strsplit (subs{indi}, ':'); + ind_start = 1; + if (!isempty (dummy{1})) + ind_start = sscanf (dummy{1}, "%d"); + if (isempty (ind_start)) + ind_start = 1; + for indj = (1:min(length (names), count)) %# sanity check + if (~isempty (regexp (names{indj}, subs{indi}))), + ind_start = indj; break; %# stop at the first match + endif + endfor + endif + endif + + if (isempty (dummy{2}) || strcmp (dummy{2}, 'end')) + ind_stop = count; + else + ind_stop = sscanf(dummy{2}, "%d"); + if (isempty (ind_stop)) + ind_stop = 1; + for indj = (min (length (names), count):-1:1) %# sanity check + if (~isempty (regexp (names{indj}, subs{indi}))) + ind_stop = indj; break; %# stop at the last match + endif + endfor + endif + endif + idx = [idx ind_start:ind_stop]; + endif + endfor + if (isempty (idx) && ~missingOK) + dummy = sprintf ("Unknown %s name while searching for %s", ... + dimname, orig_name); + error (dummy); + endif + elseif (isa (subs, 'logical')) + idx = 1:length (subs(:)); idx = reshape (idx, size (subs)); + idx(~subs) = []; mask = subs; + elseif (isa (subs, 'dataframe')) + idx = subsindex (subs, 1); + else + idx = subs; + endif + + subs = idx; + nelem = length (idx); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_pad.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_pad.m new file mode 100644 index 0000000..d18892b --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_pad.m @@ -0,0 +1,166 @@ +function df = df_pad(df, dim, n, coltype=[]) + %# function resu = df_pad(df, dim, n, coltype = []) + %# given a dataframe, insert n rows or columns, and adjust everything + %# accordingly. Coltype is a supplemental argument: + %# dim = 1 => not used + %# dim = 2 => type of the added column(s) + %# dim = 3 => index of columns receiving a new sheet (default: all) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_pad.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + switch dim + case 1 + if (!isempty(df._name{1})), + if (length(df._name{1}) < df._cnt(1)+n), + %# generate a name for the new row(s) + df._name{1}(df._cnt(1)+(1:n), 1) = {'_'}; + df._over{1}(1, df._cnt(1)+(1:n), 1) = true; + endif + endif + %# complete row indexes: by default, row number. + if (isempty(df._ridx)), + dummy = (1:n)(:); + else + dummy = vertcat(df._ridx, repmat(size(df._ridx, 1)+(1:n)(:), ... + 1, size(df._ridx, 2))); + endif + df._ridx = dummy; + %# pad every line + for indi = 1:min(size(df._data, 2), df._cnt(2)), + neff = n + df._cnt(1) - size(df._data{indi}, 1); + if (neff > 0), + m = size(df._data{indi}, 2); + switch df._type{indi} + case {'char'} + dummy = {}; dummy(1:neff, 1:m) = NA; + dummy = vertcat(df._data{indi}, dummy); + case { 'double' } + dummy = vertcat(df._data{indi}, repmat(NA, neff, m)); + otherwise + dummy = cast(vertcat(df._data{indi}, repmat(NA, neff, m)), ... + df._type{indi}); + endswitch + df._data{indi} = dummy; + endif + endfor + df._cnt(1) = df._cnt(1) + n; + + case 2 + %# create new columns + if (isempty(coltype)) + error("df_pad: dim equals 2, and coltype undefined"); + endif + if (length(n) > 1), %#second value is an offset + indc = n(2); n = n(1); + if (indc < df._cnt(2)), + %# shift to the right + df._name{2}(n + (indc+1:end)) = df._name{2}(indc+1:end); + df._over{2}(n + (indc+1:end)) = df._over{2}(indc+1:end); + dummy = cstrcat(repmat('_', n, 1), ... + strjust(num2str(indc + (1:n).'), 'left')); + df._name{2}(indc + (1:n)) = cellstr(dummy); + df._over{2}(indc + (1:n)) = true; + df._type(n+(indc+1:end)) = df._type(indc+1:end); + df._type(indc + (1:n)) = NA; + df._data(n + (indc+1:end)) = df._data(indc+1:end); + df._rep(n + (indc+1:end)) = df._rep(indc+1:end); + df._data(indc + (1:n)) = NA; + df._rep(indc + (1:n)) = 1; + endif + else + %# add new values after the last column + indc = min(size(df._data, 2), df._cnt(2)); + endif + if (!isa(coltype, 'cell')), coltype = {coltype}; endif + if (isscalar(coltype) && n > 1), + coltype = repmat(coltype, 1, n); + endif + for indi = (1:n), + switch coltype{indi} + case {'char'} + dummy = {repmat(NA, df._cnt(1), 1) }; + dummy(:, 1) = '_'; + case { 'double'} + dummy = repmat(NA, df._cnt(1), 1); + case {'logical'} %# there is no NA in logical type + dummy = repmat(false, df._cnt(1), 1); + otherwise + dummy = cast(repmat(NA, df._cnt(1), 1), coltype{indi}); + endswitch + df._data{indc+indi} = dummy; + df._rep{indc+indi} = 1; + df._type{indc+indi} = coltype{indi}; + endfor + + if (size(df._data, 2) > df._cnt(2)), + df._cnt(2) = size(df._data, 2); + endif + if (length(df._name{2}) < df._cnt(2)), + %# generate a name for the new column(s) + dummy = cstrcat(repmat('_', n, 1), ... + strjust(num2str(indc + (1:n).'), 'left')); + df._name{2}(indc + (1:n)) = cellstr(dummy); + df._over{2}(1, indc + (1:n)) = true; + endif + + case 3 + if (n <= 0), return; endif + if (isempty(coltype)), + coltype = 1:df._cnt(2); + endif + dummy = max(n+cellfun(@length, df._rep(coltype))); + if (size(df._ridx, 2) < dummy), + df._ridx(:, end+1:dummy) = NA; + endif + for indi = coltype, + switch df._type{indi} + case {'char'} + if (isa(df._data{indi}, 'char')), + dummy = horzcat(df._data{indi}(:, df._rep{indi}), \ + {repmat(NA, df._cnt(1), 1)}); + else + dummy = df._data{indi}; + endif + case { 'double' } + dummy = horzcat(df._data{indi}(:, df._rep{indi}), \ + repmat(NA, df._cnt(1), 1)); + case { 'logical' } + %# there is no logical 'NA' -- fill empty elems with false + dummy = horzcat(df._data{indi}(:, df._rep{indi}), \ + repmat(false, df._cnt(1), 1)); + otherwise + dummy = cast(horzcat(df._data{indi}(:, df._rep{indi}), \ + repmat(NA, df._cnt(1), 1)), \ + df._type{indi}); + endswitch + df._data{indi} = dummy; + df._rep{indi} = [df._rep{indi} length(df._rep{indi})+ones(1, n)]; + endfor + df = df_thirddim(df); + otherwise + error('Invalid dimension in df_pad'); + endswitch + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_strjust.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_strjust.m new file mode 100644 index 0000000..b093bfb --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_strjust.m @@ -0,0 +1,36 @@ +function [a, b] = df_strjust(a, b) + + %# small auxiliary function: make two char arrays the same width + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_strjust.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + indi = size(a, 2) - size(b, 2); + if indi < 0 + a = horzcat(repmat(' ', size(a, 1), -indi), a); + elseif indi > 0, + b = horzcat(repmat(' ', size(b, 1), indi), b); + endif + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_strset.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_strset.m new file mode 100644 index 0000000..641397e --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_strset.m @@ -0,0 +1,80 @@ +function [x, over] = df_strset(x, over, S, RHS, pad = ' ') + %# x = df_strset(x, over, S, RHS, pad = " ") + %# replaces the strings in cellstr x at indr by strings at y. Adapt + %# the width of x if required. Use x 'over' attribute to display a + %# message in case strings are overwritten. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_strset.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + %# adjust x size, if required + if isnull(RHS), + %# clearing + if isempty(S), + x = cell(0, 1); over = zeros(1, 0); + return + endif + dummy = S; dummy(1).subs(2:end) = []; + over = builtin('subsasgn', over, dummy, true); + else + if isempty(S), %# complete overwrite + if ischar(RHS), RHS = cellstr(RHS); endif + nrow = length(RHS); + if any(~over(nrow)), + warning('going to overwrite names'); + endif + x(1:nrow) = RHS; + over(1:nrow) = false; + if nrow < length(x), + x(nrow+1:end) = {pad}; + endif + return + else + dummy = S(1); dummy.subs(2:end) = []; % keep first dim only + if any(~(builtin('subsref', over, dummy))); + warning('going to overwrite names'); + endif + over = builtin('subsasgn', over, dummy, false); + endif + endif + + %# common part + if ischar(RHS) && length(S(1).subs) > 1, + %# partial accesses to a char array + dummy = char(x); + dummy = builtin('subsasgn', dummy, S, RHS); + if isempty(dummy), + x = cell(0, 1); over = zeros(1, 0); + return + endif + if size(dummy, 1) == length(x), + x = cellstr(dummy); + return + endif + %# partial clearing gone wrong ? retry + RHS = { RHS }; + endif + x = builtin('subsasgn', x, S, RHS); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_thirddim.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_thirddim.m new file mode 100644 index 0000000..6d8b252 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_thirddim.m @@ -0,0 +1,39 @@ +function [df] = df_thirddim(df) + + %# function [resu] = df_thirddim(df) + %# This is a small helper function which recomputes the third dim each + %# time a change may have occured. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_thirddim.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + %# sanity check + dummy = max(cellfun(@length, df._rep)); + if (dummy != 1), + df._cnt(3) = dummy; + elseif (length(df._cnt) > 2), + df._cnt = df._cnt(1:2); + endif + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/private/df_whole.m b/octave_packages/dataframe-0.9.1/@dataframe/private/df_whole.m new file mode 100644 index 0000000..507536e --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/private/df_whole.m @@ -0,0 +1,54 @@ +function resu = df_whole(df); + + %# function resu = df_whole(df) + %# Generate a full matrix from a column-compressed version of a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: df_whole.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + inds = max(cellfun(@length, df._rep)); + + resu = df._data{1}(:, df._rep{1}); + if (inds > 1), + resu = reshape(resu, df._cnt(1), 1, []); + if (1 == size(resu, 3)), + resu = repmat(resu, [1 1 inds]); + endif + endif + + if df._cnt(2) > 1, + resu = repmat(resu, [1 df._cnt(2)]); + for indi = 2:df._cnt(2), + dummy = df._data{indi}(:, df._rep{indi}); + if (inds > 1), + dummy = reshape(dummy, df._cnt(1), 1, []); + if (1 == size(dummy, 3)), + dummy = repmat(dummy, [1 1 inds]); + endif + endif + resu(:, indi, :) = dummy; + endfor + endif + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/prod.m b/octave_packages/dataframe-0.9.1/@dataframe/prod.m new file mode 100644 index 0000000..039019d --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/prod.m @@ -0,0 +1,33 @@ +function resu = prod(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: prod.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if !isa(df, 'dataframe'), + resu = []; return; + endif + + resu = df_mapper2(@prod, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/rationale.txt b/octave_packages/dataframe-0.9.1/@dataframe/rationale.txt new file mode 100644 index 0000000..9274e6b --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/rationale.txt @@ -0,0 +1,113 @@ +1) Context + +I was recently performing I-V measurements of a MOS +(Metal-Oxide-Semiconductor) structure. A full set of measurements +contained a DC biaising voltage, a AC frequency, a small signal +capacitance and conductance. I had to change a few times the +measurement device configuration, so sometimes the sweeping occured +first on frequency, then on voltage, sometimes in the reverse +order. To make it short, I had to deal with many input files with +inconsistent columns order. The code to identify this order quickly +became clumsy. + +The idea of a dataframe is to implement a mix between matrix and +cells. Its' like a matrix, where each column contains elements of the +same type. Unlike a matrix, columns type may be dissimilar. Also, +each colum MUST have a name, and rows MAY have a name. Moreover, to +make it easy to interface with databases, each row must have an unique +identifier. The goal is to make possible to use constructs like +y(:, ["Fr*"; "VB*"; "C";"G"]) +where y is the dataframe, and column selection is based on +regexp. This way, the translation between names and indexes uses all +the power of regexpes. + +2) Implementation +a dataframe is a class containing the following members: +_cnt = [0 0] : row count, column count, ... nth dimension count +_name = cell(1, 2) : row names, column names, ... +_ridx = [] : a unique Id for each row +_data = cell(0, 0) : a container for each column +_type = cell(0, 0) : the type of each column + +The constructor can be used as +- no argument: convert the whole workspace to a dataframe (TBD) +- one null argument: return an empty dataframe +- one numeric or cell argument: transform it to a dataframe; tries to +infer column names from the name of the input argument. +- one char array with more than one line: uses it as rownames +- one single line char array: take it as the name of a file to read +data from. Expected format is csv, try to be carefull with +quoted/unquoted strings, also tries to remove trailing and leading +spaces from string entries. Do not try to cope with things such as +separator INSIDE quoted strings. + +-supplemental arguments may occur either as pairs (string, value), + either as vectors. In the first case, the string contains an optional + parameter whose value is contained in the next argument. In the + second case, the argument is right-appended to the dataframe. Valid + optional parameters are + - rownames: a character array with the row names + - unquot: a logical to indicate if strings must be unquoted, default=true + - seeked: a string which must occur in the first row to start + considering values. Previous lines are skipped. + +3) Access (reading) +- like a single matrix: df(:, 3); df(3, :). If all the results are of +the same type, returns a matrix, otherwise a dataframe. This behavior +can be inhibited by having the last argument set to 'dataframe': + df(3, 3, 'dataframe') will return a one-by-one dataframe +- by columnames: + df(:, ["Fr*"; "VB*"; "C";]) + will try to match a columname beginning by "F" followed by an + optional 'r', thus 'F', 'Fréquence' and 'Freqs'; then a columname + starting by "V" with an optional "B", like f.i. "VBias", then a + columname with is the exact string 'C'. +- by rownames: same principle +- either member selector may also be logical: + df(df.OK=='A', ['C';'G']) +- as a struct: either use one of the column name (df.C), either use + one of the allowed accessor for internal fields: "rownames", + "colnames", "rowcnt", "colcnt", "rowidx", "types". Direct access to + the members like y._type is allowed, but should be restricted to + class members and friends. "types" accept both numeric and strings + arguments, the latter being converter to column order based upon + columns name. +- as a cell: TODO: define how to fill the cell array with all the + fields. + +4) Modifying +- as a matrix, using '()': use the same syntax as reading: + df(3, 'Fr*') = 200 + df(df.OK=='?', ['C'; 'G']) = NaN; + Note that removing elements may only occur on a full row of colum + basis. Removing a single element is not allowed. +- as a struct: either access a columname, as + df.C = []; + either accessing the internal fields through entry points 'rownames' + and 'colnames', where care is taken to adapt the strings width in + order to make them compatibles. The entry point "types", with + arguments numeric or strings, has the effect to cast whole column(s) + to a new type: + df.types{[3 5]} = 'uint16' + df.type{"Freq"} = "uint32" +- as a cell: TBD + +5) other overloaded functions: display, size, numel, cat. The latter +has to be thoroughfully tested. In particular, I've put the +restriction that horizontal cat requires that the row indexes are the +same for both elems. For vertical cat, how should we proceed ? Require +uniqueness of row indexes, and sorting ? Other ? + +6) to be done: +- the 'load' function is in fact contained inside the constructor; +maybe we should have a specific load function ? +- be able to load a dataframe from a URI specification +- write a simple 'save' function +- adding data to a dataframe: R doesn't seems to allow adding rows +to a data.frame, should we follow it ? +- add test cases +- implement a 'factor' class for categorised data +- make all functions below statistics/ dataframe compatible + +Pascal Dupuis +Louvain-la-Neuve, July First, 2010. diff --git a/octave_packages/dataframe-0.9.1/@dataframe/rdivide.m b/octave_packages/dataframe-0.9.1/@dataframe/rdivide.m new file mode 100644 index 0000000..b544452 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/rdivide.m @@ -0,0 +1,37 @@ +function resu = rdivide(A, B); + + %# function resu = rdivide(A, B) + %# Implements the dotted '\' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: rdivide.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + try + resu = df_func(@rdivide, A, B); + catch + disp(lasterr()); + error("Operator ./ problem for %s vs. %s", class(A), class(B)); + end_try_catch + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/real.m b/octave_packages/dataframe-0.9.1/@dataframe/real.m new file mode 100644 index 0000000..70d66c4 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/real.m @@ -0,0 +1,29 @@ +function resu = real(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: real.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@real, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/repmat.m b/octave_packages/dataframe-0.9.1/@dataframe/repmat.m new file mode 100644 index 0000000..6a48799 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/repmat.m @@ -0,0 +1,65 @@ +function resu = repmat(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: repmat.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df; idx = horzcat(varargin{:}); + %# for the second dim, use either 1 either the 3rd one + dummy = idx; + if (length(dummy) > 2), + dummy(2) = []; + else + dummy(2) = 1; + endif + %# operate on first dim + if (idx(1) > 1), + resu = df_mapper(@repmat, df, [idx(1) 1]); + if (!isempty(df._name{1})), + resu._name{1} = feval(@repmat, df._name{1}, [idx(1) 1]); + resu._over{1} = feval(@repmat, df._over{1}, [idx(1) 1]); + endif + resu._cnt(1) = resu._cnt(1) * idx(1); + endif + + if (dummy(2) > 1), + for indi = 1:resu._cnt(2), + resu._rep{indi} = feval(@repmat, resu._rep{indi}, [1 dummy(2)]); + endfor + endif + + %# operate on ridx + resu._ridx = feval(@repmat, resu._ridx, idx); + + %# operate on second dim + if (length(idx) > 1 && idx(2) > 1), + resu._data = feval(@repmat, resu._data, [1 idx(2)]); + resu._name{2} = feval(@repmat, df._name{2}, [idx(2) 1]); + resu._over{2} = feval(@repmat, df._over{2}, [1 idx(2)]); + resu._type = feval(@repmat, df._type, [1 idx(2)]); + resu._cnt(2) = resu._cnt(2) * idx(2); + endif + + resu = df_thirddim(resu); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/reshape.m b/octave_packages/dataframe-0.9.1/@dataframe/reshape.m new file mode 100644 index 0000000..49b5aeb --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/reshape.m @@ -0,0 +1,35 @@ +function resu = reshape(df, varargin) + %# function resu = reshape(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: reshape.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + dummy = horzcat(varargin{:}); + if (any(dummy != df._cnt)), + error('Function not yet implemented on dataframe'); + else + resu = df; %# blank operation + endif + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/round.m b/octave_packages/dataframe-0.9.1/@dataframe/round.m new file mode 100644 index 0000000..04804e9 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/round.m @@ -0,0 +1,29 @@ +function resu = round(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: round.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@round, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/roundb.m b/octave_packages/dataframe-0.9.1/@dataframe/roundb.m new file mode 100644 index 0000000..2a7ca32 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/roundb.m @@ -0,0 +1,29 @@ +function resu = roundb(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: roundb.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@roundb, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/rows.m b/octave_packages/dataframe-0.9.1/@dataframe/rows.m new file mode 100644 index 0000000..433b234 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/rows.m @@ -0,0 +1,31 @@ +function resu = rows(df) + %# function resu = rows(df) + %# returns the number of rows of a dataframe + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: rows.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df._cnt(1); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/signum.m b/octave_packages/dataframe-0.9.1/@dataframe/signum.m new file mode 100644 index 0000000..0bbe531 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/signum.m @@ -0,0 +1,29 @@ +function resu = signum(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: signum.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@signum, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/sin.m b/octave_packages/dataframe-0.9.1/@dataframe/sin.m new file mode 100644 index 0000000..4ab86b7 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/sin.m @@ -0,0 +1,29 @@ +function resu = sin(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: sin.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@sin, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/sinh.m b/octave_packages/dataframe-0.9.1/@dataframe/sinh.m new file mode 100644 index 0000000..e9f1312 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/sinh.m @@ -0,0 +1,29 @@ +function resu = sinh(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: sinh.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@sinh, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/size.m b/octave_packages/dataframe-0.9.1/@dataframe/size.m new file mode 100644 index 0000000..2a0fdbe --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/size.m @@ -0,0 +1,88 @@ +function varargout = size(df, varargin) + %# function resu = size(df, varargin) + %# This is size operator for a dataframe object. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: size.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + switch nargin + case 1 + switch nargout + case {0, 1} + varargout{1} = df._cnt; + case {2} + varargout{1} = df._cnt(1); + if (1 == df._cnt(2) && length(df._cnt) > 2), + varargout{2} = df._cnt(3); + else + varargout{2} = df._cnt(2); + endif + case {3} + varargout{1:2} = df._cnt(1:2); + if 2==length(df._cnt), + varargout{3} = 1; + else + varargout{3} = df._cnt(3); + endif + otherwise + error(print_usage()); + endswitch + case 2 + switch nargout + case {0 1} + varargout{1} = df._cnt; + try + varargout{1} = varargout{1}(varargin{1}); + catch + error(print_usage()); + end_try_catch + otherwise + error(print_usage()); + endswitch + case 3 + switch nargout + case {0 1} + if (length(df._cnt) < 3), + varargout{1} = 1; + else + varargout{1} = df._cnt; + endif + try + varargout{1} = varargout{1}(varargin{1}); + catch + error(print_usage()); + end_try_catch + otherwise + error(print_usage()); + endswitch + otherwise + error(print_usage()); + endswitch + +endfunction + +function usage = print_usage() + usage = strcat('Invalid call to size. Correct usage is: ', ' ', ... + '-- Overloaded Function: size (A, N)'); +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/sort.m b/octave_packages/dataframe-0.9.1/@dataframe/sort.m new file mode 100644 index 0000000..870c229 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/sort.m @@ -0,0 +1,151 @@ +function [resu, idx] = sort(df, varargin) + + %# -*- texinfo -*- + %# @deftypefn {Loadable Function} {[@var{s}, @var{i}] =} sort (@var{x}) + %# @deftypefnx {Loadable Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim}) + %# @deftypefnx {Loadable Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{mode}) + %# @deftypefnx {Loadable Function} {[@var{s}, @var{i}] =} sort (@var{x}, @var{dim}, @var{mode}) + %# Return a copy of @var{x} with the elements arranged in increasing + %# order. For matrices, @code{sort} orders the elements in each column. + %# + %# For example: + %# + %# @example + %# @group + %# sort ([1, 2; 2, 3; 3, 1]) + %# @result{} 1 1 + %# 2 2 + %# 3 3 + %# + %# @end group + %# @end example + %# + %# The @code{sort} function may also be used to produce a matrix + %# containing the original row indices of the elements in the sorted + %# matrix. For example: + %# + %# @example + %# @group + %# [s, i] = sort ([1, 2; 2, 3; 3, 1]) + %# @result{} s = 1 1 + %# 2 2 + %# 3 3 + %# @result{} i = 1 3 + %# 2 1 + %# 3 2 + %# @end group + %# @end example + %# + %# If the optional argument @var{dim} is given, then the matrix is sorted + %# along the dimension defined by @var{dim}. The optional argument @code{mode} + %# defines the order in which the values will be sorted. Valid values of + %# @code{mode} are `ascend' or `descend'. + %# + %# For equal elements, the indices are such that the equal elements are listed + %# in the order that appeared in the original list. + %# + %# The @code{sort} function may also be used to sort strings and cell arrays + %# of strings, in which case the dictionary order of the strings is used. + %# + %# The algorithm used in @code{sort} is optimized for the sorting of partially + %# ordered lists. + %# @end deftypefn + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: sort.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if !isa(df, 'dataframe'), + resu = []; return; + endif + + dim = []; mode = []; + vout= varargin; + + indi = 1; while indi <= length(varargin) + if isnumeric(varargin{indi}), + if !isempty(dim), + print_usage('@dataframe/sort'); + resu = []; + return + else + dim = varargin{indi}; + if 3 == dim, vout(indi) = 2; endif + endif + else + if !isempty(mode), + print_usage('@dataframe/sort'); + resu = []; + return + else + sort = varargin{indi}; + endif + endif + indi = indi + 1; + endwhile; + + if isempty(dim), dim = 1; endif; + + %# pre-assignation + resu = struct(df); + + switch(dim) + case {1}, + for indi = 1:resu._cnt(2), + [resu._data{indi}, idx(:, indi, :)] = sort\ + (resu._data{indi}(:, resu._rep{indi}), varargin{:}); + resu._data{indi} = squeeze(resu._data{indi}); + resu._rep{indi} = 1:size(resu._data{indi}, 2); + endfor + if (all([1 == size(idx, 2) 1 == size(idx, 3)])), + if (size(resu._ridx, 1) == resu._cnt(1)), + resu._ridx = resu._ridx(idx, :); + endif + if (!isempty(resu._name{1, 1})), + resu._name{1, 1} = resu._name{1, 1}(idx); + resu._over{1, 1} = resu._over{1, 1}(idx); + endif + else + %# data where mixed + resu._ridx = idx; + resu._name{1, 1} = []; resu._over{1, 1} = []; + endif + + case {2}, + error('Operation not implemented'); + case {3}, + for indi = 1:resu._cnt(2), + [resu._data{1, indi}, idx(:, indi)] = sort(resu._data{1, indi}, vout(:)); + endfor + otherwise + error("Invalid dimension %d", dim); + endswitch + + dummy = dbstack(); + if (any(strmatch('quantile', {dummy.name}))), + resu = df_whole(resu); + else + resu = dataframe(resu); + endif + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/sqrt.m b/octave_packages/dataframe-0.9.1/@dataframe/sqrt.m new file mode 100644 index 0000000..d5e4832 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/sqrt.m @@ -0,0 +1,29 @@ +function resu = sqrt(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: sqrt.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@sqrt, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/subsasgn.m b/octave_packages/dataframe-0.9.1/@dataframe/subsasgn.m new file mode 100644 index 0000000..1ea28cb --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/subsasgn.m @@ -0,0 +1,190 @@ +function df = subasgn(df, S, RHS) + %# function df = subasgn(df, S, RHS) + %# This is the assignement operator for a dataframe object, taking + %# care of all the housekeeping of meta-info. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: subsasgn.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if (isnull (df)) + error ('dataframe subsasgn: first argument may not be empty'); + endif + + switch (S(1).type) + case '{}' + error ('Invalid dataframe as cell assignement'); + case '.' + %# translate the external to internal name + switch (S(1).subs) + case "rownames" + if (~isnull (RHS) && isempty (df._name{1})) + df._name{1}(1:df._cnt(1), 1) = {''}; + df._over{1}(1, 1:df._cnt(1)) = true; + endif + [df._name{1}, df._over{1}] = df_strset \ + (df._name{1}, df._over{1}, S(2:end), RHS); + return + + case "rowidx" + if (1 == length(S)) + df._ridx = RHS; + else + df._ridx = feval (@subsasgn, df._ridx, S(2:end), RHS); + endif + return + + case "colnames" + if (isnull(RHS)) error ("Colnames can't be nulled"); endif + [df._name{2}, df._over{2}] = df_strset \ + (df._name{2}, df._over{2}, S(2:end), RHS, '_'); + df._name{2} = genvarname (df._name{2}); + return + + case "types" + if (isnull(RHS)) error("Types can't be nulled"); endif + if (1 == length (S)) + %# perform explicit cast on each column + df._data = cellfun (@(x) cast (x, RHS), df._data, + "UniformOutput", false); + df._type(1:end) = RHS; + else + if (~strcmp (S(2).type, '()')) + error ("Invalid internal type sub-access, use () instead"); + endif + if (length (S) > 2 || length (S(2).subs) > 1) + error("Types can only be changed as a whole"); + endif + if (~isnumeric(S(2).subs{1})) + [indj, ncol, S(2).subs{1}] = df_name2idx\ + (df._name{2}, S(2).subs{1}, df._cnt(2), 'column'); + else + indj = S(2).subs{1}; ncol = length (indj); + endif + df._data(indj) = cellfun (@(x) cast (x, RHS), df._data(indj), + "UniformOutput", false); + df._type(indj) = {RHS}; + endif + return + + case "source" + if (length(S) > 1) + df._src = feval (@subsasgn, df._src, S(2:end), RHS); + else + df._src = RHS; + endif + return + + case "comment" + if (length(S) > 1) + df._cmt = feval (@subsasgn, df._cmt, S(2:end), RHS); + else + df._cmt = RHS; + endif + return + + otherwise + if (~ischar (S(1).subs)) + error ("Congratulations. I didn't see how to produce this error"); + endif + %# translate the name to column + [indc, ncol] = df_name2idx (df._name{2}, S(1).subs, \ + df._cnt(2), 'column', true); + if (isempty(indc)) + %# dynamic allocation + df = df_pad (df, 2, 1, class (RHS)); + indc = df._cnt(2); ncol = 1; + df._name{2}(end) = S(1).subs; + df._name{2} = genvarname(df._name{2}); + df._over{2}(end) = false; + endif + + if (length(S) > 1) + if (1 == length (S(2).subs)), %# add column reference + S(2).subs{2} = indc; + else + S(2).subs(2:3) = {indc, S(2).subs{2}}; + endif + else + %# full assignement + S(2).type = '()'; S(2).subs = { '', indc, ':' }; + if (ndims (RHS) < 3) + if (isnull (RHS)) + S(2).subs = {':', indc}; + elseif (1 == size (RHS, 2)) + S(2).subs = { '', indc }; + elseif (1 == ncol && 1 == size (df._data{indc}, 2)) + %# force the padding of the vector to a matrix + S(2).subs = {'', indc, [1:size(RHS, 2)]}; + endif + endif + endif + %# do we need to "rotate" RHS ? + if (1 == ncol && ndims (RHS) < 3 \ + && size (RHS, 2) > 1) + RHS = reshape (RHS, [size(RHS, 1), 1, size(RHS, 2)]); + endif + df = df_matassign (df, S(2), indc, ncol, RHS); + endswitch + + case '()' + [indr, nrow, S(1).subs{1}] = df_name2idx (df._name{1}, S(1).subs{1}, \ + df._cnt(1), 'row'); + if (isempty (indr) && df._cnt(1) > 0) + %# this is not an initial assignment + df = df; return; + endif + + if (length (S(1).subs) > 1) + if (~isempty (S(1).subs{2})) + [indc, ncol, S(1).subs{2}] = \ + df_name2idx (df._name{2}, S(1).subs{2}, df._cnt(2), 'column'); + %# if (isempty (indc) && df._cnt(2) > 0) + %# this is not an initial assignment + %# df = df; return; + else + [indc, ncol] = deal ([]); + endif + else + mz = max (cellfun (@length, df._rep)); + [fullindr, fullindc, fullinds] = ind2sub ([df._cnt(1:2) mz], indr); + indr = unique( fullindr); indc = unique (fullindc); + inds = unique (fullinds); + ncol = length (indc); + if (any (inds > 1)) + S(1).subs{3} = inds; + endif + endif + + %# avoid passing ':' as selector on the two first dims + if (~isnull (RHS)) + S(1).subs{1} = indr; S(1).subs{2} = indc; + endif + + df = df_matassign (df, S, indc, ncol, RHS); + + endswitch + + %# disp("end of subasgn"); keyboard + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/subsindex.m b/octave_packages/dataframe-0.9.1/@dataframe/subsindex.m new file mode 100644 index 0000000..5f18b41 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/subsindex.m @@ -0,0 +1,45 @@ +function resu = subsindex(df, base) + %# function resu = subsindex(df) + %# This function convert a dataframe to an index. Do not expect a + %# meaningfull result when mixing numeric and logical columns. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: subsindex.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if nargin < 2, + base = 1.0; + else + base = base - 1.0; + endif + + %# extract all values at once + dummy = df_whole(df); + if isa(dummy, 'logical'), + resu = sort(find(dummy)-base); + %# resu = dummy - base; + else + resu = dummy - base; + endif + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/subsref.m b/octave_packages/dataframe-0.9.1/@dataframe/subsref.m new file mode 100644 index 0000000..5bf04c7 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/subsref.m @@ -0,0 +1,678 @@ +function resu = subsref(df, S) + %# function resu = subsref(df, S) + %# This function returns a subpart of a dataframe. It is invoked when + %# calling df.field, df(value), or df{value}. In case of fields, + %# returns either the content of the container with the same name, + %# either the column with the same name, priority being given to the + %# container. In case of range, selection may occur on name or order + %# (not rowidx for rows). If the result is homogenous, it is + %# downclassed. In case an extra field is given, is it used to + %# determine the class of the return value. F.i., + %# df(1, 2, 'dataframe') + %# does not return a scalar but a dataframe, keeping all the meta-information + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: subsref.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + %# what kind of object should we return ? + asked_output_type = ''; asked_output_format = []; + + if (strcmp (S(1).type, '.')) %# struct access + indi = strmatch (S(1).subs, 'as'); + if (~isempty (indi)) + if (length (S) < 2 || ~strcmp (S(2).type, '.')) + error ("The output format qualifier 'as' must be followed by a type"); + endif + asked_output_type = "array"; + asked_output_format = S(2).subs; S = S(3:end); + else + indi = strmatch(S(1).subs, 'array'); + if (~isempty (indi)) + asked_output_type = "array"; + S = S(2:end); + else + indi = strmatch (S(1).subs, char ('df', class (df))); + if (~isempty (indi)) + %# requiring a dataframe + if (1 == indi) %# 'df' = short for 'dataframe' + asked_output_type = 'dataframe'; + else + asked_output_type = S(1).subs; + endif + S = S(2:end); + if (isempty (S) && strcmp (asked_output_type, class (df))) + resu = df; return; + endif + else + indi = strmatch(S(1).subs, 'cell'); + if (~isempty (indi)) + asked_output_type = S(1).subs; + S = S(2:end); + else + %# access as a pseudo-struct + resu = struct(df); %# avoid recursive calls + if (1 == strfind(S(1).subs, '_')) %# its an internal field name + %# FIXME: this should only be called from class members and friends + %# FIXME -- in case many columns are asked, horzcat them + resu = horzcat (feval (@subsref, resu, S)); + else + %# direct access through the exact column name + indi = strmatch(S(1).subs, resu._name{2}, "exact"); + if (~isempty (indi)) + resu = df._data{indi}; %# extract colum; + if (strcmp (df._type{indi}, 'char') \ + && 1 == size (df._data{indi}, 2)) + resu = char (resu) + endif + if (length (S) > 1) + dummy = S(2:end); S = S(1); + switch dummy(1).type + case '()' + if (isa(dummy(1).subs{1}, "char")) + [indr, nrow, dummy(1).subs{1}] = \ + df_name2idx(df._name{1}, dummy(1).subs{1}, df._cnt(1), 'row'); + endif + resu = feval(@subsref, resu, dummy); + otherwise + error ("Invalid column access"); + endswitch + endif + else %# access of an attribute + dummy = S(2:end); S = S(1); + postop = ''; further_deref = false; + %# translate the external to internal name + switch S(1).subs + case "rownames" + S(1).subs = "_name"; + S(2).type = "{}"; S(2).subs{1}= 1; + postop = @(x) char (x); + case "colnames" + S(1).subs = "_name"; + S(2).type = "{}"; S(2).subs{1}= 2; + postop = @(x) char (x); further_deref = true; + case "rowcnt" + S(1).subs = "_cnt"; + S(2).type = "()"; S(2).subs{1}= 1; + case "colcnt" + S(1).subs = "_cnt"; + S(2).type = "()"; S(2).subs{1}= 2; + case "rowidx" + S(1).subs = "_ridx"; further_deref = true; + case "types" %# this one should be accessed as a matrix + S(1).subs = "_type"; further_deref = true; + case "source" + S(1).subs = "_src"; + further_deref = true; + case "comment" + S(1).subs = "_cmt"; + further_deref = true; + case "new" + if (isempty (dummy)) + resu = dataframe([]); + else + if (!strcmp (dummy(1).type, "()")) + error ("Bogus constructor call"); + endif + resu = dataframe(dummy(1).subs{:}); + endif + if (length (dummy) > 1) + resu = subsref(resu, dummy(2:end)); + endif + return; + otherwise + error ("Unknown column name: %s", S(1).subs); + endswitch + if (!isempty (dummy)) + if ~further_deref, + error ("Invalid sub-dereferencing"); + endif + if (isa(dummy(1).subs{1}, "char")) + [indc, ncol, dummy(1).subs{1}] = \ + df_name2idx(df._name{2}, dummy(1).subs{1}, \ + df._cnt(2), 'column'); + if (isempty (indc)) + %# should be already catched inside df_name2idx + error ("Unknown column name: %s", dummy(1).subs{1}); + endif + endif + if (!strcmp (dummy(1).type, '()')) + error ("Invalid internal field name sub-access, use () instead"); + endif + endif + %# workaround around bug 30921, fixed in hg changeset 10937 + %# if !isempty (dummy) + S = [S dummy]; + %# endif + resu = feval(@subsref, resu, S); + if (!isempty (postop)) + resu = postop(resu); + endif + endif + endif + return + endif + endif + endif + endif + endif + + %# disp('line 103 '); keyboard + + IsFirst = true; + while 1, %# avoid recursive calls on dataframe sub-accesses + + %# a priori, performs whole accesses + nrow = df._cnt(1); indr = 1:nrow; + ncol = df._cnt(2); indc = 1:ncol; + %# linear indexes + [fullindr, fullindc, fullinds, onedimidx] = deal([]); + + %# iterate over S, sort out strange constructs as x()()(1:10, 1:4) + while length (S) > 0, + if (strcmp (S(1).type, '{}')) + if (!IsFirst || !isempty (asked_output_format)) + error ("Illegal dataframe dereferencing"); + endif + [asked_output_type, asked_output_format] = deal('cell'); + elseif (!strcmp (S(1).type, '()')) + %# disp(S); keyboard + error ("Illegal dataframe dereferencing"); + endif + if (isempty (S(1).subs)) %# process calls like x() + if (isempty (asked_output_type)) + asked_output_type = class (df); + endif + if (length (S) <= 1) + if (strcmp (asked_output_type, class (df))) + %# whole access without conversion + resu = df; return; + endif + break; %# no dimension specified -- select all, the + %# asked_output_type was set in a previous iteration + else + %# avoid recursive calls + S = S(2:end); + IsFirst = false; continue; + endif + endif + %# generic access + if (isempty (S(1).subs{1})) + error ('subsref: first dimension empty ???'); + endif + if (length (S(1).subs) > 1) + if (isempty (S(1).subs{2})) + error ('subsref: second dimension empty ???'); + endif + [indr, nrow, S(1).subs{1}] = \ + df_name2idx(df._name{1}, S(1).subs{1}, df._cnt(1), 'row'); + if (!isa(indr, 'char') && max (indr) > df._cnt(1)) + error ("Accessing dataframe past end of lines"); + endif + [indc, ncol, S(1).subs{2}] = \ + df_name2idx(df._name{2}, S(1).subs{2}, df._cnt(2), 'column'); + if (max (indc) > df._cnt(2)) + %# is it a two index access of a 3D structure ? + if (length (df._cnt) > 2) + [fullindc, fullinds] = ind2sub (df._cnt(2:3), indc); + if (fullindc <= df._cnt(2)) + indc = fullindc; inds = fullinds; + endif + endif + %# retest + if (max (indc) > df._cnt(2)) + error ("Accessing dataframe past end of columns"); + endif + endif + else + %# one single dim -- probably something like df(:), df(A), ... + fullindr = 1; onedimidx = S(1).subs{1}; + switch class (S(1).subs{1}) + case {'char'} %# one dimensional access, disallow it if not ':' + if (strcmp (S(1).subs{1}, ':')) + fullindr = []; fullindc = []; asked_output_type = "array"; + else + error (["Accessing through single dimension and name " \ + S(1).subs{1} " not allowed\n-- use variable(:, 'name') instead"]); + endif + case {'logical'} + S(1).subs{1} = find(S(1).subs{1}); + case {'dataframe'} + S(1).subs{1} = subsindex(S(1).subs{1}, 1); + endswitch + + if (isempty (S(1).subs{1})) + resu = df_colmeta(df); + return; + endif + + if (!isempty (fullindr)) + %# convert linear index to subscripts + if (length (df._cnt) <= 2) + [fullindr, fullindc] = ind2sub (df._cnt, S(1).subs{1}); + fullinds = ones (size (fullindr)); + else + dummy = max (cellfun(@length, df._rep)); + [fullindr, fullindc, fullinds] = ind2sub\ + ([df._cnt dummy], S(1).subs{1}); + endif + + indr = unique (fullindr); nrow = length (indr); + %# determine on which columns we'll iterate + indc = unique (fullindc)(:).'; ncol = length (indc); + if (!isempty (asked_output_type) && ncol > 1) + %# verify that the extracted values form a square matrix + dummy = zeros(indr(end), indc(end)); + for indi = (1:ncol) + indj = find (fullindc == indc(indi)); + dummy(fullindr(indj), indc(indi)) = 1; + endfor + dummy = dummy(indr(1):indr(end), indc(1):indc(end)); + if (any (any (dummy!= 1))) + error ("Vector-like selection is not rectangular for the asked output type"); + else + fullindr = []; fullindc = []; + endif + endif + endif + endif + %# at this point, S is either empty, either contains further dereferencing + break; + endwhile + + %# we're ready to extract data + %# disp('line 211 '); keyboard + + if (isempty (asked_output_type)) + output_type = class (df); %# force df output + else + if (!strcmp (asked_output_type, "array") \ + || !isempty (asked_output_format)) + %# override the class of the return value + output_type = asked_output_type; + else + %# can the data be merged ? + output_type = df._data{indc(1)}(1); + dummy = isnumeric(df._data{indc(1)}); + for indi = (2:ncol) + dummy = dummy & isnumeric (df._data{indc(indi)}); + if (~strcmp (class (output_type), df._type{indc(indi)})) + if (dummy) + %# let downclassing occur + output_type = horzcat (output_type, df._data{indc(indi)}(1)); + continue; + endif + %# unmixable args -- falls back to type of parent container + error ("Selected columns %s not compatible with cat() -- use 'cell' as output format", mat2str (indc)); + %# dead code -- suppress previous line for switching automagically the output format to df + output_type = class (df); + break; + endif + endfor + asked_output_format = class (output_type); + output_type = "array"; + endif + endif + + if (any(strcmp ({output_type, asked_output_type}, class (df)))) + if (!isempty (S) && (1 == length (S(1).subs))) + %# is the selection index vector-like ? + if ((isnumeric(S(1).subs{1}) && isvector(S(1).subs{1}) && + df._cnt(1) > 1) && isempty (asked_output_type)) + %# in the case of vector input, favor array output + [asked_output_type, output_type] = deal("array"); + endif + endif + endif + + indt = {}; %# in case we have to mix matrix of different width + if (!isempty (fullinds)) + inds = unique (fullinds); nseq = length (inds); + indt(1, 1:df._cnt(2)) = inds; + else + inds = 1; indt(1, 1:df._cnt(2)) = inds; nseq = 1; + if (isempty (S) || all(cellfun('isclass', S(1).subs, 'char'))) + inds = ':'; indt(1, 1:df._cnt(2)) = inds; + nseq = max (cellfun(@length, df._rep(indc))); + else + if (length (S(1).subs) > 1) %# access-as-matrix + if (length (S(1).subs) > 2) + inds = S(1).subs{3}; + if (isa(inds, 'char')) + nseq = max (cellfun(@length, df._rep(indc))); + indt(1, 1:df._cnt(2)) = inds; + else + %# generate a specific index for each column + nseq = length (inds); + dummy = cellfun(@length, df._rep(indc)); + indt(1, 1:df._cnt(2)) = inds; + indt(1==dummy) = 1; + endif + endif + endif + endif + endif + + if (strcmp (output_type, class (df))) + %# disp('line 295 '); keyboard + %# export the result as a dataframe + resu = dataframe ([]); + resu._cnt(1) = nrow; resu._cnt(2) = ncol; + if (isempty (fullindr)) + for indi = (1:ncol) + resu._data{indi} = df._data{indc(indi)}\ + (indr, df._rep{indc(indi)}(indt{indc(indi)})); + resu._rep{indi} = 1:size (resu._data{indi}, 2); + resu._name{2}(indi, 1) = df._name{2}(indc(indi)); + resu._over{2}(1, indi) = df._over{2}(indc(indi)); + resu._type{indi} = df._type{indc(indi)}; + endfor + if (!isempty (df._ridx) && size (df._ridx, 2) >= inds) + resu._ridx = df._ridx(indr, inds); + endif + if (length (df._name{1}) >= max (indr)) + resu._name{1}(1:nrow, 1) = df._name{1}(indr); + resu._over{1}(1, 1:nrow) = df._over{1}(indr); + endif + else + dummy = df_whole(df); + dummy = dummy(onedimidx); + for indi = (1:resu._cnt(2)) + indc = unique (fullindc(:, indi)); + if (1 == length (indc)) + resu._name{2}(indi)= df._name{2}(indc); + resu._over{2}(indi)= df._over{2}(indc); + unfolded = df._data{indc}(:, df._rep{indc}); + indj = sub2ind (size (unfolded), fullindr(:, indi), \ + fullinds(:, indi)); + resu._data{indi} = unfolded(indj); + resu._type{indi} = df._type{indc}; + resu._rep{indi} = 1:size (resu._data{indi}, 2); + else + resu._name{2}(indi)= ["X" num2str(indi)]; + resu._over{2}(indi)= true; + resu._data{indi} = squeeze(dummy(:, indi, :)); + resu._type{indi} = class (dummy(1, indi, 1)); + resu._rep{indi} = 1:size (resu._data{indi}, 2); + endif + endfor + if (1 == size (df._ridx, 2)) + resu._ridx = repmat (df._ridx, [1 ncol 1]); + else + resu._ridx = df._ridx; + endif + if (!isempty (resu._ridx)) + if (size (resu._ridx, 2) > 1) + resu._ridx = resu._ridx(indr, indc); + else + resu._ridx = resu._ridx(indr); + endif + endif + endif + %# to be verified : keyboard + resu._src = df._src; + resu._cmt = df._cmt; + resu = df_thirddim(resu); + if (length (S) > 1) %# perform further access, if required + df = resu; + S = S(2:end); %# avoid recursive calls + continue; %# restart the loop around line 150 + endif + return; + + elseif (strcmp (output_type, 'cell')) + %# export the result as a cell array + if (isempty (asked_output_format)) + resu = cell (2+nrow, 2+ncol); resu(1:end, 1:2) = {''}; + resu(2, 3:end) = df._type(indc); %column type + row_offs = 2; col_offs = 2; + for indi = (1:ncol) + resu{1, 2+indi} = df._name{2}{indc(indi)}; % column name + endfor + resu(3:end, 1) = mat2cell (df._ridx(indr), ones (nrow, 1), 1); + if (length (df._name{1}) >= max (indr)) + resu(3:end, 2) = df._name{1}{indr}; + endif + else + resu = cell (nrow, ncol); + row_offs = 0; col_offs = 0; + endif + for indi = (1:ncol) + switch df._type{indc(indi)} % cell content + case {'char' } + %# dummy = cellstr(df._data{indc(indi)}(indr, :)); + dummy = df._data{indc(indi)}(indr, :); + resu(1+row_offs:end, indi+col_offs) = dummy; + otherwise + dummy = df._data{indc(indi)}(indr, :); + resu(1+row_offs:end, indi+col_offs) = \ + mat2cell (dummy, ones (nrow, 1), size (dummy, 2)); + endswitch + endfor + + %# did we arrive here by x.cell ? + if (0 == length (S)) return; endif + + %# perform the selection on the content, keeping the header + if (length (S) > 1) %# perform further access, if required + if (~strcmp (S(2).type, '()')) + error ("Illegal dataframe-as-cell sub-dereferencing"); + endif + if (!isempty (asked_output_format)) + resu = feval(@subsref, resu, S(2:end)); + else + if (length (S(2).subs) != 1) + %# normal, two-dimensionnal access apply the selection on the + %# zone containing the data + dummy = S; + if (!isempty (dummy(2).subs)) + dummy(2).subs{2} = ':'; + endif + resuf = cat (2, \ + %# reselect indexes + feval (@subsref, resu(3:end, 1), + dummy(2:end)), \ + %# reselect rownames + feval (@subsref, resu(3:end, 2), + dummy(2:end)), \ + %# extract - reorder - whatever + feval (@subsref, resu(3:end, 3:end), S(2:end)) + \ + ); + dummy = S; + if (!isempty (dummy(2).subs)) + dummy(2).subs{1} = [1 2]; + endif + resuf = cat(1, \ + %# reselect column names and types + [cell(2, 2) feval(@subsref, resu(1:2, + 3:end), \ + dummy(2:end))], \ + resuf \ + ); + resuf(1:2, 1:2) = {''}; resu = resuf; + else + %# one dimensionnal access of the whole 2D cell array -- you + %# asked it, you got it + resu = feval(@subsref, resu(:), S(2:end)); + if (!isa(S(2).subs{1}, 'char') \ + && size (S(2).subs{1}, 2) > 1) + resu = resu.'; + endif + endif + endif + elseif (1 == length (S(1).subs)) + resu = resu(:); + if (!isa(S(1).subs{1}, 'char') \ + && size (S(1).subs{1}, 2) > 1) + resu = resu.'; + endif + endif + return; %# no more iteration required + + else + %# export the result as a vector/matrix. Rules: + %# * x(:, :, :) returns a 3D matrix + %# * x(:, n:m, :) returns a 3D matrix + %# * x(:, :) returns a horzcat of the third dimension + %# * x(:, n:m) select only the first sequence + %# * x(:) returns a vertcat of the columns of x(:, :) + %# disp('line 403 '); keyboard + if (isempty (S) || isempty (S(1).subs) || \ + length (S(1).subs) > 1 || \ + (isnumeric(S(1).subs{1}) && !isvector(S(1).subs{1}))) + %# access-as-matrix + df = struct(df); %# remove the magic, avoid recursive calls + if (isempty (fullindr)) %# two index access + if (~isempty (asked_output_format)) %# force a conversion + if (strmatch(asked_output_format, 'cell')) + extractfunc = @(x) mat2cell\ + (df._data{indc(x)}(indr, df._rep{indc(x)}(inds)), \ + ones (nrow, 1)); + else + extractfunc = @(x) cast ( df._data{indc(x)}\ + (indr, df._rep{indc(x)}(inds)),\ + asked_output_format); + endif + else %# let the usual downclassing occur + extractfunc = @(x) df._data{indc(x)}(indr, df._rep{indc(x)}(inds)); + endif + try + if (nseq > 1) + dummy = reshape (extractfunc (1), nrow, 1, []); + if (size (dummy, 3) < nseq) + dummy = repmat (dummy, [1 1 nseq]); + endif + else + dummy = extractfunc (1); + endif + catch + error ("Column %d format (%s) can't be converted to %s", \ + indc(1), df._type{indc(1)}, asked_output_format); + end_try_catch + if (ncol > 1) + %# dynamic allocation with the final type + resu = repmat (dummy, [1 ncol]); + for indi = (2:ncol) + try + if (nseq > 1) + dummy = reshape (extractfunc (indi), nrow, 1, []); + if (size (dummy, 3) < nseq) + dummy = repmat (dummy, [1 1 nseq]); + endif + else + dummy = extractfunc (indi); + endif + catch + error ("Column %d format (%s) can't be converted to %s", \ + indc(indi), df._type{indc(indi)}, asked_output_format); + end_try_catch + resu(:, indi, :) = dummy; + endfor + else + if (strcmp (df._type{indc(1)}, 'char')) + resu = char (dummy); + else + resu = dummy; + endif + endif + if (!isempty (S) && 2 == length (S(1).subs) \ + && all(cellfun('isclass', S(1).subs, 'char'))) + resu = reshape (resu, nrow, ncol*nseq); + endif + else %# one index access + %# disp('line 557'); keyboard + if (~isempty (asked_output_format)) %# force a conversion + if (strmatch (asked_output_format, 'cell')) + extractfunc = @(x, y) mat2cell (df._data{x}(:, df._rep{x}(y)), \ + ones (length (y), 1)); + else + extractfunc = @(x, y) cast (df._data{x}(:, df._rep{x})(y), \ + asked_output_format); + endif + else %# let the usual downclassing occur + extractfunc = @(x, y) df._data{x}(:, df._rep{x})(y); + endif + try + resu = zeros(0, class (sum (cellfun (@(x) zeros (1, class (x(1))),\ + df._data(indc))))); + for indi = (indc) + dummy = find (indi == fullindc); %# linear global index + %# linear index for this matrix + idx = sub2ind (size (df._data{indi}), fullindr(dummy), \ + fullinds(dummy)); + resu(dummy) = extractfunc (indi, idx); + endfor + catch + disp (lasterr); + error ("Column %d format (%s) can't be converted to %s", \ + indi, df._type{indi}, asked_output_format); + end_try_catch + resu = reshape (resu, size (onedimidx)); + endif + else %# access-as-vector + %# disp('line 548 '); keyboard + if (!isempty (fullindr)) + switch df._type{indc(1)} + case {'char'} + resu = df._data{indc(1)}(fullindr(1), \ + df._rep{indc(1)}(fullinds(1))); + for indi = (2:length (fullindr)) + resu = char (resu, df._data{indc(indi)}\ + (fullindr(indi), df._rep{indc(indi)}(fullinds(indi)))); + endfor + otherwise + if (isempty (asked_output_format)) + resu = df._data{fullindc(1)}\ + (fullindr(1), df._rep{fullindc(1)}(fullinds(1))); + else %# this type will propagate with subsequent cat + resu = cast (df._data{fullindc(1)}\ + (fullindr(1), df._rep{fullindc(1)}(fullinds(1))),\ + asked_output_format); + endif + for indi = (2:length (fullindr)) + resu = cat(1, resu, df._data{fullindc(indi)}\ + (fullindr(indi), \ + df._rep{fullindc(indi)}(fullinds(indi)))); + endfor + endswitch + else %# using the (:) operator + resu = df_whole(df)(:); + endif + if (!isa(S(1).subs{1}, 'char') \ + && size (S(1).subs{1}, 2) > 1) + resu = resu.'; + endif + endif + if (length (S) > 1) %# perform further access, if required + %# disp('line 442 '); keyboard + resu = feval(@subsref, resu, S(2:end)); + endif + endif + return; %# no more iteration required + endwhile + + %# disp("line 343 !?!"); %# keyboard + return + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/sum.m b/octave_packages/dataframe-0.9.1/@dataframe/sum.m new file mode 100644 index 0000000..114926a --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/sum.m @@ -0,0 +1,33 @@ +function resu = sum(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: sum.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if !isa(df, 'dataframe'), + resu = []; return; + endif + + resu = df_mapper2(@sum, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/summary.m b/octave_packages/dataframe-0.9.1/@dataframe/summary.m new file mode 100644 index 0000000..1a82492 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/summary.m @@ -0,0 +1,86 @@ +function resu = summary(df) + %# function resu = summary(df) + %# This function prints a nice summary of a dataframe, on a + %# colum-by-column basis. For continuous varaibles, returns basic + %# statistics; for discrete one (char, factors, ...), returns the + %# occurence count for each element. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: summary.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + dummy = df._type; resu = []; + + for indi = 1:length(dummy), + switch dummy{indi} + case {'char' 'factor'} + [sval, sidxi, sidxj] = unique(df._data{:, indi}); + %# compute their occurences + sidxj = hist(sidxj, min(sidxj):max(sidxj)); + %# generate a column with unique values + resuR = strjust(char(regexp(disp(sval), '\S.*', 'match', ... + 'dotexceptnewline')), 'right'); + resuR = horzcat(resuR, repmat(':', size(resuR, 1), 1), + strjust(char(regexp(disp(sidxj.'), '\b.*', 'match', ... + 'dotexceptnewline')), ... + 'right')); + %# now put the name above all + resuR = strjust([deblank(df._name{1, 2}(indi, :)); resuR], 'right'); + resuR = horzcat(resuR, repmat(' ', size(resuR, 1), 1)); + resu = horzcat_pad(resu, resuR); + + otherwise + s = statistics(df._data{:, indi}); + s = s([1:3 6 4:5]); + %# generate a column with name and fields name + resuR = strjust([deblank(df._name{1, 2}{indi, :}); + "Min. :"; "1st Qu.:"; + "Median :"; "Mean :"; + "3rd Qu.:"; "Max. :"], 'right'); + %# generate a column with a blank line and the values + resuR = horzcat(resuR, repmat(' ', size(resuR, 1), 1), + strjust(char(' ', regexp(disp(s), '\S.*', 'match', ... + 'dotexceptnewline')), 'right'),... + repmat(' ', size(resuR, 1), 1)); + resu = horzcat_pad(resu, resuR); + + endswitch + endfor + +endfunction + + +function resu = horzcat_pad(A, B) + %# small auxiliary function to cat horizontally tables of different height + dx = size(A, 1) - size(B, 1); + + if dx < 0, + %# pad A + A = strvcat(A, repmat(' ', -dx, size(A, 2))); + elseif dx > 0 + B = strvcat(B, repmat(' ', dx, size(B, 2))); + endif + + resu = horzcat(A, B); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/sumsq.m b/octave_packages/dataframe-0.9.1/@dataframe/sumsq.m new file mode 100644 index 0000000..2e12fe7 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/sumsq.m @@ -0,0 +1,33 @@ +function resu = sumsq(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: sumsq.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + if !isa(df, 'dataframe'), + resu = []; return; + endif + + resu = df_mapper2(@sumsq, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/tan.m b/octave_packages/dataframe-0.9.1/@dataframe/tan.m new file mode 100644 index 0000000..a531905 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/tan.m @@ -0,0 +1,29 @@ +function resu = tan(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: tan.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@tan, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/tanh.m b/octave_packages/dataframe-0.9.1/@dataframe/tanh.m new file mode 100644 index 0000000..e1ffd4d --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/tanh.m @@ -0,0 +1,29 @@ +function resu = tanh(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: tanh.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@tanh, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/times.m b/octave_packages/dataframe-0.9.1/@dataframe/times.m new file mode 100644 index 0000000..9018c7c --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/times.m @@ -0,0 +1,37 @@ +function resu = times(A, B); + + %# function resu = times(A, B) + %# Implements the dotted '*' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: times.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + try + resu = df_func(@times, A, B); + catch + disp(lasterr()); + error("Operator .* problem for %s vs. %s", class(A), class(B)); + end_try_catch + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/uminus.m b/octave_packages/dataframe-0.9.1/@dataframe/uminus.m new file mode 100644 index 0000000..4f6562f --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/uminus.m @@ -0,0 +1,32 @@ +function resu = uminus(df); + + %# function resu = uminus(df) + %# Implements the unitary '-' operator for a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: uminus.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@uminus, df); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/uplus.m b/octave_packages/dataframe-0.9.1/@dataframe/uplus.m new file mode 100644 index 0000000..a4d02e0 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/uplus.m @@ -0,0 +1,32 @@ +function resu = uplus(df); + + %# function resu = uplus(df) + %# Implements the unitary '+' operator for a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: uplus.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_mapper(@uplus, df); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/vertcat.m b/octave_packages/dataframe-0.9.1/@dataframe/vertcat.m new file mode 100644 index 0000000..178a22c --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/vertcat.m @@ -0,0 +1,34 @@ +function resu = vertcat(df, varargin) + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: vertcat.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + %# do the conversion now, in order not to loose inputnames + for indi = 1:length(varargin), + varargin{indi} = dataframe(varargin{indi}, 'colnames', inputname(1+indi));, + endfor + + resu = cat(1, df, varargin{:}); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/@dataframe/xor.m b/octave_packages/dataframe-0.9.1/@dataframe/xor.m new file mode 100644 index 0000000..3822e94 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/@dataframe/xor.m @@ -0,0 +1,32 @@ +function resu = xor(A, B); + + %# function resu = xor(A, B) + %# Implements the '??' operator when at least one argument is a dataframe. + + %% Copyright (C) 2009-2012 Pascal Dupuis + %% + %% This file is part of Octave. + %% + %% Octave is free software; you can 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, or (at your option) any later version. + %% + %% Octave is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied + %% warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR + %% PURPOSE. See the GNU General Public License for more + %% details. + %% + %% You should have received a copy of the GNU General Public + %% License along with Octave; see the file COPYING. If not, + %% write to the Free Software Foundation, 51 Franklin Street - + %% Fifth Floor, Boston, MA 02110-1301, USA. + + %# + %# $Id: xor.m 9585 2012-02-05 15:32:46Z cdemills $ + %# + + resu = df_func(@xor, A, B); + +endfunction diff --git a/octave_packages/dataframe-0.9.1/data_test.csv b/octave_packages/dataframe-0.9.1/data_test.csv new file mode 100644 index 0000000..50d3c9e --- /dev/null +++ b/octave_packages/dataframe-0.9.1/data_test.csv @@ -0,0 +1,14 @@ +#notice there is a extra separator +DataName, VBIAS, Freq, |IBIAS|, C, GOUT, OK?, +DataValue, -6, 300000, 1.6272E-11, 7.02154E-13, 1.60436E-07, 'A', +DataValue, -5.8, 300000, 1.599E-11, 6.96065E-13, 1.5728E-07, 'E', +# a comment line, and an empty one + +DataValue, -5.6, 300000, 1.379E-11, 6.90475E-13, 1.54887E-07, '!', +DataValue, -5.4, 300000, 1.442E-11, 6.85165E-13, 1.54777E-07, '?', +# the next lines use \r\n, \r and \f as linefeed +DataValue, -5.2, 300000, 1.293E-11, 6.79655E-13, 1.51887E-07, 'C', +DataValue, -5, 300000, 1.261E-11, 6.74438E-13, 1.49309E-07, 'B', DataValue, -4.8, 300000, 1.439E-11, 6.70105E-13, 1.48758E-07, 'A', DataValue, -4.6, 300000, 1.089E-11, 6.64158E-13, 1.489E-07, '3', +# one empty input field +DataValue, -4.4, 300000, , 6.5859E-13, 1.45578E-07, 'C', +DataValue, -4.2, 300000, 1.061E-11, 6.53547E-13, 1.44306E-07, 'B', diff --git a/octave_packages/dataframe-0.9.1/dataframe b/octave_packages/dataframe-0.9.1/dataframe new file mode 100644 index 0000000..f3732b7 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/dataframe @@ -0,0 +1,229 @@ +%# -*- mode: Octave -*- +%!shared a, b, x, xl, y, yl, Y, z +%! x=dataframe(randn(3, 3), 'rownames', (7:-1:5).'); +%! x(1:3, 1) = 3; +%! x(1:3, 1) = (4:6).'; +%!assert(x.array(2, 1), 5); +%! x(1, 1:3) = 3; +%! x(1, 1:3) = (4:6).'; +%!assert(x.array(1, 2), 5); +%!assert(isempty(x.rowidx), false); +%! x.types(2) ='single'; +%!assert(class(x.array(1, 2)), 'single') +%! x=dataframe('data_test.csv'); +%!assert(isna(x.array(9, 4))) +%! # remove rownames +%! x.rownames = []; +%!assert(size(x.rownames), [0 0]) +%! # remove a column through '.' access +%! y = x; y.DataName = []; +%!assert(size(y(:, '_IBIAS_')), [10 1]) +%!assert(size(y), [10 6]); +%! y = x{}; +%!assert(size(y), [10 7]); +%! y = x{[2 5], [2 7]}; +%!assert(y, {-5.8, "E"; -5.2, "C"}); +%! y = x{}([2 5], [2 7]); +%!assert(y, {-5.8, "E"; -5.2, "C"}); +%! y = x{1:2, 1:2}(4); +%!assert(y, {-5.8}); +%! # remove a column through (:, name) access +%! y = x; y(:, "DataName") = []; +%!assert(size(y), [10 6]); +%! # create an empty dataframe +%! y = dataframe([]); +%!assert(isempty(y), true); +%! y = x.df(:, 2:6); +%! Y = 2*pi*double(y.Freq).*y.C+y.GOUT; +%! z = dataframe(y,{{'Y'; Y}}); +%!assert(size(z), [10 6]); +%!assert(abs(z(1, "Y") - Y(1)).array, 0); +%! # direct matrix setting through struct access +%! y.Freq=[(1:10).' (10:-1:1).']; +%! # verify the "end" operator on the third dim +%!assert(y.array(2, 2, end), 9); +%! # direct setting through 3D matrix +%! y(:, ["C"; "G"], 1:2) = repmat(y(:, ["C"; "G"]), [1 1 2]); +%! y(4:5, 4:5) = NaN; +%!test +%! if any(size(x) != [10 7]), +%! error('x: wrong input size') +%! endif +%! if any(size(y) != [10 5 2]), +%! error('y: wrong input size') +%! endif +%!#assert(numel(x), 1); +%! # test simple slices +%!assert(x.VBIAS(1:6), (-6:.2:-5).'); +%!assert(x.array(6:10, 2), (-5:.2:-4.2).'); +%!assert(x.array(6, "OK_"), 'B'); +%!assert(x.array(2, logical([0 0 1 1])), x.array(2, 3:4)) +%!assert(size(y.array(:, :, :)), [10 5 2]); +%!assert(size(y.array(:, :)), [10 10]); +%!assert(size(y.array(:, 2, 2)), [10 1]); +%!assert(size(y.array(:, 2)), [10 1]); +%!assert(y.C(4:5), [NaN NaN]); +%!error error("Accessing past limits") +%! x(1, 8) +%! x(11, 1) +%! x(1, logical(ones(1, 7))) +%! x.types{"FReq*"} +%! x(1, :) +%!test +%! #!! removed -- output format may only be specified before selection +%! #select one column +%! #assert(x(1:3, 1).cell(:), x.cell(1:3)(:)) +%! #assert(x(33:35).cell.', x(33:35).cell(:)) +%! #select two columns +%!assert(x.cell(1:10, 2:3)(:), x.cell(11:30)(:)) +%!error error("Complex accesses"); +%! x(:); +%! x.dataframe(:); +%! x.dataframe.cell +%!test +%! # test modifying column type +%! x.types("Freq") = 'uint32'; x.types(2) = 'single'; +%! # downclassing must occur ! +%!assert(class(x.array(1, ["Freq"; "C"])), 'uint32') +%! # upclassing must occur ! +%!assert(class(x.as.double(1, ["Freq"; "C"])), 'double') +%!error error("Incorrect internal field sub-referencing") +%! x.types{"Freq"} +%!error error("mixing different types") +%! x([12:18 22:28 32:38]); +%!error error("non-square access") +%! x([22:28 32:37]).dataframe; +%! x.cell([1:19]); +%!error error("Single-dimension name access") +%! x("Freq"); +%!test +%! # complex access +%! x(x(:, "OK_") == '?', ["C"; "G"]) = NaN; +%!assert(x.array(4, 5:6), [NaN NaN]) +%! # extract values +%! y = x.dataframe(x(:, "OK_") =='A', {"Freq", "VB*", "C", "G"}); +%! #comparison using cell output class, because assert use (:) +%!assert(y.cell(:, 2:3), x.cell([1 7], ["VB*"; "C"])) +%!assert(x.array((33:35).'), x.array(3:5, 4)) +%! #test further dereferencing +%!assert(x.array(:, "C")(2:4), x.array(2:4, "C")) +%! # complex modifications through cell access +%! z = dataframe(x, {"VB*", {"Polarity" ,"Sense"; ones(12,2), zeros(10,2)}}); +%!assert(size(z), [12 9 2]); +%!assert(z.Sense(11:12, :), NA*ones(2, 2)); +%!assert(size(z._over{2}, 2) - size(x._over{2}, 2), 2); +%! x = dataframe(randn(3, 3)); y = x.array; +%! xl = x > 0; yl = y > 0; +%! a = zeros(size(yl)); b = a; +%! a(xl) = 1; b(yl) = 1; +%!assert(a, b); +%! [a, b] = sort(y(:)); y = reshape(b, 3, 3); x = dataframe(y); +%! a = zeros(size(yl)); b = a; +%! a(x) = 10:-1:2; b(y) = 10:-1:2; +%!assert(a, b); +%! x = dataframe(randn(3, 3)); y = randn(3, 3); z = dataframe(y); +%!assert((x+y(1)).array, x.array+y(1)) +%!assert((y(1)+x).array, y(1)+x.array) +%!assert((x+y).array, x.array+y) +%!assert((y+x).array, y+x.array) +%!assert((x+z).array, x.array+z.array) +%!assert((bsxfun(@plus, x, z(1,:))).array, bsxfun(@plus, x.array, z.array(1,:))) +%!assert((bsxfun(@plus, x, z(:,1))).array, bsxfun(@plus, x.array, z.array(:,1))) +%!assert((bsxfun(@minus,z(1,:),x)).array, bsxfun(@minus,z.array(1,:),x.array)) +%!assert((bsxfun(@minus,z(:,1),x)).array, bsxfun(@minus,z.array(:,1),x.array)) +%!assert((x > 0).array, x.array > 0) +%!assert((0 > x).array, 0 > x.array) +%!assert((x > y).array, x.array > y); +%!assert((y > x).array, y > x.array); +%!assert((x > z).array, x.array > z.array) +%!assert((x*y(1)).array, x.array*y(1)) +%!assert((y(1)*x).array, y(1)*x.array) +%!assert((x.*y).array, x.array.*y) +%!assert((y.*x).array, y.*x.array) +%!assert((z.*x).array, z.array.*x.array) +%!assert((x*y).array, x.array*y) +%!assert((y*x).array, y*x.array) +%!assert((x*z).array, x.array*z.array) +%!assert((x/y(1)).array, x.array/y(1)) +%!assert((x./y).array, x.array./y) +%!assert((y./x).array, y./x.array) +%!assert((z./x).array, z.array./x.array) +%!assert((x/y).array, x.array/y) +%!assert((y/x).array, y/x.array) +%!assert((x/z).array, x.array/z.array) +% # left division is a bit more complicated +%!assert((x(1, 1)\y).array, x.array(1, 1)\y) +%!assert((x(:, 1)\y).array, x.array(:, 1)\y, sqrt(eps)) +%!assert((x\y).array, x.array\y) +%!assert((y\x).array, y\x.array) +%!assert((x\z).array, x.array\z.array) +% x=dataframe(randn(4, 3, 2)); y=randn(4, 3, 2); z=dataframe(y); +%!assert((abs(sum(center(x)) < sqrt(eps)).array)) +%!assert((x+y).array, x.array+y) +%!assert((y+x).array, y+x.array) +%!assert((x+z).array, x.array+z.array); +%!assert((bsxfun(@plus,x,z(1,:,:))).array, bsxfun(@plus,x.array,z.array(1,:,:))); +%!assert((bsxfun(@plus,x,z(:,1,:))).array, bsxfun(@plus,x.array,z.array(:,1,:))); +%!assert((bsxfun(@plus,z(1,:,:),x)).array, bsxfun(@plus,z.array(1,:,:),x.array)); +%!assert((bsxfun(@plus,z(:,1,:),x)).array, bsxfun(@plus,z.array(:,1,:),x.array)); + +%! [a, b] = sort(x(:)); x=dataframe(reshape((1:9)(b), [3 3])); +%! y = reshape((1:9)(b), [3 3]); z = dataframe(y); +%!assert(x(x(:)), y(x(:))); +%!assert(x(y(:)), y(y(:))); +%! z= x(x); +%!assert(z.array, y(x)); +%! z = x(y); +%!assert(z.array, y(y)); + +%!demo +%! x=dataframe('octave_frame/data_test.csv') +%! disp("Access as a struct: x.VBIAS(1:6)") +%! x.VBIAS(1:6) +%! pause; disp("Access as a matrix: x(6, 'OK')") +%! x(6, "OK?") +%! pause; disp("Removing the row names: x.rownames = []"); +%! x.rownames = [] +%! pause; disp("Modifying column type: x.types['Freq']='uint32'"); +%! x.types("Freq")='uint32' +%! pause; disp("Partial extract"); +%! disp("y = x(x(:, 'OK.') == 'A'|x(:, ""OK?"") == 'B', {'Freq', 'VB*', 'C', 'G'}") +%! y = x(x(:, 'OK.') == 'A'|x(:, "OK?") == 'B', {'Freq', 'VB*', 'C', 'G'}) +%! disp("y.rownames = char({'low', 'med', 'med', 'high'})"); +%! y.rownames = char({'low', 'med', 'med', 'high'}) +%! pause; disp("Partial modification of one column") +%! disp("y.Freq('med')=[290e3; 310e3]") +%! y.Freq('med') = [290e3; 310e3] +%! pause; disp('Complex access'); +%! disp("y.C('med')([2 1])"); +%! y.C('med')([2 1]) +%! pause; disp('Print stats about a dataframe: summary(y)'); +%! summary(y) + +%!demo +%! disp('Modifying a dataframe from a cell array') +%! RHS={ 'don''t care', 'idx', 'Vb', 'freq', 'Ib', 'C', 'status', 'comment' +%! 'yes', uint16(5), single(3.2), 10000, 1e-11, 6e-13, 'bla', '@' +%! 'no', uint16(16), 4, 12000, 2e-11, 4e-13, 7, 'X'}; +%! disp("Resetting a dataframe: x=dataframe([])"); +%! x = dataframe([]); +%! x(:, :) = RHS +%! disp("Overwriting the second line") +%! RHS{1, 2} = "idg"; RHS{3, 1}= "No!"; +%! disp("'x(2, :) = RHS(1:2, :)' will produce two warnings") +%! disp("Notice that only the second line content will change"); +%! disp("x(2, :) = RHS(1:2, :)") +%! x(2, :) = RHS(1:2, :) +%! pause; disp('same effect, but skipping first column'); +%! disp("x(1, :) = RHS([1 3], 2:end)"); +%! x(1, []) = RHS([1 3], 2:end) +%!demo +%! disp("same game, but using row indexes.") +%! disp("Notice the first field name is empty") +%! RHS= { '', 'idx', 'Vb', 'freq', 'Ib', 'C', 'status', 'comment' +%! 5, uint32(16), 5.3, 11000, 3e-12, 5e-12, "may", "8th"}; +%! disp("x= dataframe(RHS)") +%! x = dataframe(RHS) +%! pause; disp("The same effect is achieved by assigning to an empty dataframe") +%! x = dataframe([]); +%! x(:, :) = RHS diff --git a/octave_packages/dataframe-0.9.1/packinfo/DESCRIPTION b/octave_packages/dataframe-0.9.1/packinfo/DESCRIPTION new file mode 100644 index 0000000..53a8de2 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: dataframe +Version: 0.9.1 +Date: 2012-02-10 +Author: Pascal Dupuis +Maintainer: The Octave Community +Title: Data Frame +Description: Data manipulation toolbox similar to R data.frame +Categories: data manipulation, statistics +Depends: octave (>= 3.2.0) +License: GPL version 3 or later +Url: http://octave.sf.net +SVNRelease: $Revision: 9615 $ diff --git a/octave_packages/dataframe-0.9.1/packinfo/INDEX b/octave_packages/dataframe-0.9.1/packinfo/INDEX new file mode 100644 index 0000000..7ea0b9a --- /dev/null +++ b/octave_packages/dataframe-0.9.1/packinfo/INDEX @@ -0,0 +1,23 @@ +dataframe >> Data manipulation toolbox similar to R data.frame +Dataframe + @dataframe/cat + @dataframe/dataframe + @dataframe/display + @dataframe/end + @dataframe/fold + @dataframe/isempty + @dataframe/ldivide + @dataframe/minus + @dataframe/mldivide + @dataframe/mrdivide + @dataframe/mtimes + @dataframe/numel + @dataframe/plus + @dataframe/rdivide + @dataframe/size + @dataframe/subsasgn + @dataframe/subsref + @dataframe/summary + @dataframe/times + @dataframe/uminus + @dataframe/uplus diff --git a/octave_packages/dataframe-0.9.1/packinfo/NEWS b/octave_packages/dataframe-0.9.1/packinfo/NEWS new file mode 100644 index 0000000..0ce0c82 --- /dev/null +++ b/octave_packages/dataframe-0.9.1/packinfo/NEWS @@ -0,0 +1,4 @@ +Summary of important user-visible changes for dataframe 0.9.1: +------------------------------------------------------------------- + + ** dataframe 0.9.1 is a bug fixing release. diff --git a/octave_packages/econometrics-1.0.8/__kernel_epanechnikov.m b/octave_packages/econometrics-1.0.8/__kernel_epanechnikov.m new file mode 100644 index 0000000..a81e150 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/__kernel_epanechnikov.m @@ -0,0 +1,36 @@ +# Copyright (C) 2006 Michael Creel +# +# 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 . + +# __kernel_epanechnikov: this function is for internal use by kernel_density +# and kernel_regression +# +# multivariate spherical Epanechnikov kernel +# input: PxK matrix - P data points, each of which is in R^K +# output: Px1 vector, input matrix passed though the kernel +# other multivariate kernel functions should follow this convention + +function z = __kernel_epanechnikov(z) + + K = columns(z); + + # Volume of d-dimensional unit sphere + c = pi ^ (K/2) / gamma(K/2 + 1); + + # compute kernel + z = sumsq(z, 2); + z = ((1/2) / c * (K + 2) * (1 - z)) .* (z < 1); + + +endfunction diff --git a/octave_packages/econometrics-1.0.8/__kernel_normal.m b/octave_packages/econometrics-1.0.8/__kernel_normal.m new file mode 100644 index 0000000..238776f --- /dev/null +++ b/octave_packages/econometrics-1.0.8/__kernel_normal.m @@ -0,0 +1,29 @@ +# Copyright (C) 2006 Michael Creel +# +# 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 . + +# __kernel_normal: this function is for internal use by kernel_density +# and kernel_regression +# +# product normal kernel +# input: PxK matrix - P data points, each of which is in R^K +# output: Px1 vector, input matrix passed though the kernel +# other multivariate kernel functions should follow this convention + +function z = __kernel_normal(z) + + z = normpdf(z); + z = prod(z,2); + +endfunction diff --git a/octave_packages/econometrics-1.0.8/__kernel_weights.m b/octave_packages/econometrics-1.0.8/__kernel_weights.m new file mode 100644 index 0000000..95c42ed --- /dev/null +++ b/octave_packages/econometrics-1.0.8/__kernel_weights.m @@ -0,0 +1,32 @@ +# Copyright (C) 2006, 2007 Michael Creel +# under the terms of the GNU General Public License. +# +# 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 . + +# __kernel_weights: for internal use by kernel_regression and kernel_density. There +# is also a faster .oct file version that should be be found automatically. + + +function W = __kernel_weights(data, evalpoints, kernel) + + # calculate distances + nn = rows(evalpoints); + n = rows(data); + W = zeros(nn,n); + for i = 1:nn + zz = data - repmat(evalpoints(i,:), n, 1); + zz = feval(kernel, zz); + W(i,:) = zz'; + endfor +endfunction diff --git a/octave_packages/econometrics-1.0.8/average_moments.m b/octave_packages/econometrics-1.0.8/average_moments.m new file mode 100644 index 0000000..1508c4c --- /dev/null +++ b/octave_packages/econometrics-1.0.8/average_moments.m @@ -0,0 +1,54 @@ +# Copyright (C) 2003,2004,2005 Michael Creel +# +# 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 . + +# for internal use by gmm_estimate + + +# average moments (separate function so it can be differentiated) +function m = average_moments(theta, data, moments, momentargs) + + global NSLAVES PARALLEL NEWORLD NSLAVES TAG; + + n = rows(data); + + if PARALLEL + nn = floor(n/(NSLAVES + 1)); # save some work for master + + # The command that the slave nodes will execute + cmd=['contrib = sum_moments_nodes(theta, data, moments, momentargs, nn); ',... + 'MPI_Send(contrib,0,TAG,NEWORLD);']; + + # send items to slaves + NumCmds_Send({"theta", "nn", "cmd"},{theta, nn, cmd}); + + # evaluate last block on master while slaves are busy + m = feval("sum_moments_nodes", theta, data, moments, momentargs, nn); + + # collect slaves' results + contrib = zeros(1,columns(m)); + for i = 1:NSLAVES + MPI_Recv(contrib,i,TAG,NEWORLD); + m = m + contrib; + endfor + + m = m'; # we want a column vector, please + m = m/n; # average please, not sum + + else # serial version + m = feval(moments, theta, data, momentargs); + m = mean(m)'; # returns Gx1 moment vector + endif + +endfunction diff --git a/octave_packages/econometrics-1.0.8/delta_method.m b/octave_packages/econometrics-1.0.8/delta_method.m new file mode 100644 index 0000000..e88ff0f --- /dev/null +++ b/octave_packages/econometrics-1.0.8/delta_method.m @@ -0,0 +1,23 @@ +# Copyright (C) 2003,2004 Michael Creel +# +# 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 . + +# Computes Delta method mean and covariance of a nonlinear +# transformation defined by "func" +function [theta_transf, var_transf] = delta_method(func, theta, otherargs, vartheta) + theta_transf = feval(func, theta, otherargs); + D = numgradient(func, {theta, otherargs}); + var_transf = D * vartheta * D'; + +endfunction diff --git a/octave_packages/econometrics-1.0.8/doc-cache b/octave_packages/econometrics-1.0.8/doc-cache new file mode 100644 index 0000000..4bc25f5 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/doc-cache @@ -0,0 +1,990 @@ +# Created by Octave 3.6.1, Wed Mar 28 20:33:11 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 33 +# name: +# type: sq_string +# elements: 1 +# length: 15 +average_moments + + +# name: +# type: sq_string +# elements: 1 +# length: 35 + for internal use by gmm_estimate + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 + for internal use by gmm_estimate + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +delta_method + + +# name: +# type: sq_string +# elements: 1 +# length: 92 + Computes Delta method mean and covariance of a nonlinear + transformation defined by "func" + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Computes Delta method mean and covariance of a nonlinear + transformation define + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +gmm_estimate + + +# name: +# type: sq_string +# elements: 1 +# length: 927 + usage: [theta, obj_value, convergence, iters] = + gmm_estimate(theta, data, weight, moments, momentargs, control, nslaves) + + inputs: + theta: column vector initial parameters + data: data matrix + weight: the GMM weight matrix + moments: name of function computes the moments + (should return nXg matrix of contributions) + momentargs: (cell) additional inputs needed to compute moments. + May be empty ("") + control: (optional) BFGS or SA controls (see bfgsmin and samin). + May be empty (""). + nslaves: (optional) number of slaves if executed in parallel + (requires MPITB) + + outputs: + theta: GMM estimate of parameters + obj_value: the value of the gmm obj. function + convergence: return code from bfgsmin + (1 means success, see bfgsmin for details) + iters: number of BFGS iteration used + + please type "gmm_example" while in octave to see an example + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: [theta, obj_value, convergence, iters] = + gmm_estimate(theta, + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +gmm_example + + +# name: +# type: sq_string +# elements: 1 +# length: 126 + GMM example file, shows initial consistent estimator, + estimation of efficient weight, and second round + efficient estimator + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + GMM example file, shows initial consistent estimator, + estimation of efficient + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +gmm_obj + + +# name: +# type: sq_string +# elements: 1 +# length: 206 + The GMM objective function, for internal use by gmm_estimate + This is scaled so that it converges to a finite number. + To get the chi-square specification + test you need to multiply by n (the sample size) + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + The GMM objective function, for internal use by gmm_estimate + This is scaled so + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +gmm_results + + +# name: +# type: sq_string +# elements: 1 +# length: 1145 + usage: [theta, V, obj_value] = + gmm_results(theta, data, weight, moments, momentargs, names, title, unscale, control, nslaves) + + inputs: + theta: column vector initial parameters + data: data matrix + weight: the GMM weight matrix + moments: name of function computes the moments + (should return nXg matrix of contributions) + momentargs: (cell) additional inputs needed to compute moments. + May be empty ("") + names: vector of parameter names + e.g., names = char("param1", "param2"); + title: string, describes model estimated + unscale: (optional) cell that holds means and std. dev. of data + (see scale_data) + control: (optional) BFGS or SA controls (see bfgsmin and samin). May be empty (""). + nslaves: (optional) number of slaves if executed in parallel + (requires MPITB) + + outputs: + theta: GMM estimated parameters + V: estimate of covariance of parameters. Assumes the weight matrix + is optimal (inverse of covariance of moments) + obj_value: the value of the GMM objective function + + please type "gmm_example" while in octave to see an example + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: [theta, V, obj_value] = + gmm_results(theta, data, weight, moments, mome + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +gmm_variance + + +# name: +# type: sq_string +# elements: 1 +# length: 49 + GMM variance, which assumes weights are optimal + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 + GMM variance, which assumes weights are optimal + + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +gmm_variance_inefficient + + +# name: +# type: sq_string +# elements: 1 +# length: 53 + GMM variance, which assumes weights are not optimal + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 + GMM variance, which assumes weights are not optimal + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +kernel_density + + +# name: +# type: sq_string +# elements: 1 +# length: 1178 + kernel_density: multivariate kernel density estimator + + usage: + dens = kernel_density(eval_points, data, bandwidth) + + inputs: + eval_points: PxK matrix of points at which to calculate the density + data: NxK matrix of data points + bandwidth: positive scalar, the smoothing parameter. The fit + is more smooth as the bandwidth increases. + kernel (optional): string. Name of the kernel function. Default is + Gaussian kernel. + prewhiten bool (optional): default false. If true, rotate data + using Choleski decomposition of inverse of covariance, + to approximate independence after the transformation, which + makes a product kernel a reasonable choice. + do_cv: bool (optional). default false. If true, calculate leave-1-out + density for cross validation + computenodes: int (optional, default 0). + Number of compute nodes for parallel evaluation + debug: bool (optional, default false). show results on compute nodes if doing + a parallel run + outputs: + dens: Px1 vector: the fitted density value at each of the P evaluation points. + + References: + Wand, M.P. and Jones, M.C. (1995), 'Kernel smoothing'. + http://www.xplore-stat.de/ebooks/scripts/spm/html/spmhtmlframe73.html + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 + kernel_density: multivariate kernel density estimator + + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +kernel_density_cvscore + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + some kernels can assign zero density + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + some kernels can assign zero density + + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +kernel_density_nodes + + +# name: +# type: sq_string +# elements: 1 +# length: 87 + kernel_density_nodes: for internal use by kernel_density - does calculations on nodes + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + kernel_density_nodes: for internal use by kernel_density - does calculations on + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +kernel_example + + +# name: +# type: sq_string +# elements: 1 +# length: 161 + kernel_example: examples of how to use kernel density and regression functions + requires the optim and plot packages from Octave Forge + + usage: kernel_example; + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + kernel_example: examples of how to use kernel density and regression functions + + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +kernel_optimal_bandwidth + + +# name: +# type: sq_string +# elements: 1 +# length: 309 + kernel_optimal_bandwidth: find optimal bandwith doing leave-one-out cross validation + inputs: + * data: data matrix + * depvar: column vector or empty (""). + If empty, do kernel density, orherwise, kernel regression + * kernel (optional, string) the kernel function to use + output: + * h: the optimal bandwidth + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + kernel_optimal_bandwidth: find optimal bandwith doing leave-one-out cross valid + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +kernel_regression + + +# name: +# type: sq_string +# elements: 1 +# length: 1100 + kernel_regression: kernel regression estimator + + usage: + fit = kernel_regression(eval_points, depvar, condvars, bandwidth) + + inputs: + eval_points: PxK matrix of points at which to calculate the density + depvar: Nx1 vector of observations of the dependent variable + condvars: NxK matrix of data points + bandwidth (optional): positive scalar, the smoothing parameter. + Default is N ^ (-1/(4+K)) + kernel (optional): string. Name of the kernel function. Default is + Gaussian kernel. + prewhiten bool (optional): default true. If true, rotate data + using Choleski decomposition of inverse of covariance, + to approximate independence after the transformation, which + makes a product kernel a reasonable choice. + do_cv: bool (optional). default false. If true, calculate leave-1-out + fit to calculate the cross validation score + computenodes: int (optional, default 0). + Number of compute nodes for parallel evaluation + debug: bool (optional, default false). show results on compute nodes if doing + a parallel run + outputs: + fit: Px1 vector: the fitted value at each of the P evaluation points. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + kernel_regression: kernel regression estimator + + + + +# name: +# type: sq_string +# elements: 1 +# length: 23 +kernel_regression_nodes + + +# name: +# type: sq_string +# elements: 1 +# length: 93 + kernel_regression_nodes: for internal use by kernel_regression - does calculations on nodes + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + kernel_regression_nodes: for internal use by kernel_regression - does calculati + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +mle_estimate + + +# name: +# type: sq_string +# elements: 1 +# length: 758 + usage: + [theta, obj_value, conv, iters] = mle_estimate(theta, data, model, modelargs, control, nslaves) + + inputs: + theta: column vector of model parameters + data: data matrix + model: name of function that computes log-likelihood + modelargs: (cell) additional inputs needed by model. May be empty ("") + control: (optional) BFGS or SA controls (see bfgsmin and samin). May be empty (""). + nslaves: (optional) number of slaves if executed in parallel (requires MPITB) + + outputs: + theta: ML estimated value of parameters + obj_value: the value of the log likelihood function at ML estimate + conv: return code from bfgsmin (1 means success, see bfgsmin for details) + iters: number of BFGS iteration used + + please see mle_example.m for examples of how to use this + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: + [theta, obj_value, conv, iters] = mle_estimate(theta, data, model, mode + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +mle_example + + +# name: +# type: sq_string +# elements: 1 +# length: 42 + Example to show how to use MLE functions + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 + Example to show how to use MLE functions + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +mle_obj + + +# name: +# type: sq_string +# elements: 1 +# length: 178 + usage: [obj_value, score] = mle_obj(theta, data, model, modelargs, nslaves) + + Returns the average log-likelihood for a specified model + This is for internal use by mle_estimate + + + +# name: +# type: sq_string +# elements: 1 +# length: 77 + usage: [obj_value, score] = mle_obj(theta, data, model, modelargs, nslaves) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +mle_obj_nodes + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + Who am I? + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + Who am I? + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +mle_results + + +# name: +# type: sq_string +# elements: 1 +# length: 918 + usage: [theta, V, obj_value, infocrit] = + mle_results(theta, data, model, modelargs, names, title, unscale, control) + + inputs: + theta: column vector of model parameters + data: data matrix + model: name of function that computes log-likelihood + modelargs: (cell) additional inputs needed by model. May be empty ("") + names: vector of parameter names, e.g., use names = char("param1", "param2"); + title: string, describes model estimated + unscale: (optional) cell that holds means and std. dev. of data (see scale_data) + control: (optional) BFGS or SA controls (see bfgsmin and samin). May be empty (""). + nslaves: (optional) number of slaves if executed in parallel (requires MPITB) + + outputs: + theta: ML estimated value of parameters + obj_value: the value of the log likelihood function at ML estimate + conv: return code from bfgsmin (1 means success, see bfgsmin for details) + iters: number of BFGS iteration used + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: [theta, V, obj_value, infocrit] = + mle_results(theta, data, model, mo + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +mle_variance + + +# name: +# type: sq_string +# elements: 1 +# length: 122 + usage: [V,scorecontribs,J_inv] = + mle_variance(theta, data, model, modelargs) + + This is for internal use by mle_results + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: [V,scorecontribs,J_inv] = + mle_variance(theta, data, model, modelargs) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +nls_estimate + + +# name: +# type: sq_string +# elements: 1 +# length: 780 + usage: + [theta, obj_value, conv, iters] = nls_estimate(theta, data, model, modelargs, control, nslaves) + + inputs: + theta: column vector of model parameters + data: data matrix + model: name of function that computes the vector of sums of squared errors + modelargs: (cell) additional inputs needed by model. May be empty ("") + control: (optional) BFGS or SA controls (see bfgsmin and samin). May be empty (""). + nslaves: (optional) number of slaves if executed in parallel (requires MPITB) + + outputs: + theta: NLS estimated value of parameters + obj_value: the value of the sum of squared errors at NLS estimate + conv: return code from bfgsmin (1 means success, see bfgsmin for details) + iters: number of BFGS iteration used + + please see nls_example.m for examples of how to use this + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: + [theta, obj_value, conv, iters] = nls_estimate(theta, data, model, mode + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +nls_example + + +# name: +# type: sq_string +# elements: 1 +# length: 56 + + define arguments for nls_estimate # + + starting values + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + + define arguments for nls_estimate # + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +nls_obj + + +# name: +# type: sq_string +# elements: 1 +# length: 185 + usage: [obj_value, score] = nls_obj(theta, data, model, modelargs, nslaves) + + Returns the average sum of squared errors for a specified model + This is for internal use by nls_estimate + + + +# name: +# type: sq_string +# elements: 1 +# length: 77 + usage: [obj_value, score] = nls_obj(theta, data, model, modelargs, nslaves) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +nls_obj_nodes + + +# name: +# type: sq_string +# elements: 1 +# length: 42 + This is for internal use by nls_estimate + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 + This is for internal use by nls_estimate + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +parameterize + + +# name: +# type: sq_string +# elements: 1 +# length: 316 + usage: theta = parameterize(theta, otherargs) + + This is an empty function, provided so that + delta_method will work as is. Replace it with + the parameter transformations your models use. + Note: you can let "otherargs" contain the model + name so that this function can do parameterizations + for a variety of models + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: theta = parameterize(theta, otherargs) + + This is an empty function, pro + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +poisson + + +# name: +# type: sq_string +# elements: 1 +# length: 65 + Example likelihood function (Poisson for count data) with score + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 + Example likelihood function (Poisson for count data) with score + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +poisson_moments + + +# name: +# type: sq_string +# elements: 1 +# length: 53 + the form a user-written moment function should take + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 + the form a user-written moment function should take + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +prettyprint + + +# name: +# type: sq_string +# elements: 1 +# length: 49 + this prints matrices with row and column labels + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 + this prints matrices with row and column labels + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +prettyprint_c + + +# name: +# type: sq_string +# elements: 1 +# length: 59 + this prints matrices with column labels but no row labels + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 + this prints matrices with column labels but no row labels + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +scale_data + + +# name: +# type: sq_string +# elements: 1 +# length: 69 + Standardizes and normalizes data matrix, + primarily for use by BFGS + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 + Standardizes and normalizes data matrix, + primarily for use by BFGS + + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +sum_moments_nodes + + +# name: +# type: sq_string +# elements: 1 +# length: 34 + for internal use by gmm_estimate + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 + for internal use by gmm_estimate + + + + +# name: +# type: sq_string +# elements: 1 +# length: 18 +unscale_parameters + + +# name: +# type: sq_string +# elements: 1 +# length: 86 + Unscales parameters that were estimated using scaled data + primarily for use by BFGS + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Unscales parameters that were estimated using scaled data + primarily for use by + + + + + diff --git a/octave_packages/econometrics-1.0.8/gmm_estimate.m b/octave_packages/econometrics-1.0.8/gmm_estimate.m new file mode 100644 index 0000000..7be8714 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/gmm_estimate.m @@ -0,0 +1,74 @@ +# Copyright (C) 2003,2004,2005 Michael Creel +# +# 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 . + +# usage: [theta, obj_value, convergence, iters] = +# gmm_estimate(theta, data, weight, moments, momentargs, control, nslaves) +# +# inputs: +# theta: column vector initial parameters +# data: data matrix +# weight: the GMM weight matrix +# moments: name of function computes the moments +# (should return nXg matrix of contributions) +# momentargs: (cell) additional inputs needed to compute moments. +# May be empty ("") +# control: (optional) BFGS or SA controls (see bfgsmin and samin). +# May be empty (""). +# nslaves: (optional) number of slaves if executed in parallel +# (requires MPITB) +# +# outputs: +# theta: GMM estimate of parameters +# obj_value: the value of the gmm obj. function +# convergence: return code from bfgsmin +# (1 means success, see bfgsmin for details) +# iters: number of BFGS iteration used +# +# please type "gmm_example" while in octave to see an example + +# call the minimizing routine +function [theta, obj_value, convergence, iters] = gmm_estimate(theta, data, weight, moments, momentargs, control, nslaves) + + if nargin < 5 error("gmm_estimate: 5 arguments required"); endif + if nargin < 6 control = {-1}; endif # default controls + if !iscell(control) control = {-1}; endif # default controls if receive placeholder + if nargin < 7 nslaves = 0; endif + + if nslaves > 0 + global NSLAVES PARALLEL NEWORLD NSLAVES TAG; + LAM_Init(nslaves); + # Send the data to all nodes + NumCmds_Send({"data", "weight", "moments", "momentargs"}, {data, weight, moments, momentargs}); + endif + + # bfgs or sa? + if (size(control,1)*size(control,2) == 0) # use default bfgs if no control + control = {Inf,0,1,1}; + method = "bfgs"; + elseif (size(control,1)*size(control,2) < 11) + method = "bfgs"; + else method = "sa"; + endif + + + if strcmp(method, "bfgs") + [theta, obj_value, convergence, iters] = bfgsmin("gmm_obj", {theta, data, weight, moments, momentargs}, control); + elseif strcmp(method, "sa") + [theta, obj_value, convergence] = samin("gmm_obj", {theta, data, weight, moments, momentargs}, control); + endif + + if nslaves > 0 LAM_Finalize; endif # clean up + +endfunction diff --git a/octave_packages/econometrics-1.0.8/gmm_example.m b/octave_packages/econometrics-1.0.8/gmm_example.m new file mode 100644 index 0000000..5825ae8 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/gmm_example.m @@ -0,0 +1,64 @@ +# Copyright (C) 2003,2004, 2005 Michael Creel +# +# 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 . + +# GMM example file, shows initial consistent estimator, +# estimation of efficient weight, and second round +# efficient estimator + + +n = 1000; +k = 5; + +x = [ones(n,1) randn(n,k-1)]; +w = [x, rand(n,1)]; +theta_true = ones(k,1); +lambda = exp(x*theta_true); +y = poissrnd(lambda); +[xs, scalecoef] = scale_data(x); + +# The arguments for gmm_estimate +theta = zeros(k,1); +data = [y xs w]; +weight = eye(columns(w)); +moments = "poisson_moments"; +momentargs = {k}; # needed to know where x ends and w starts + +# additional args for gmm_results +names = char("theta1", "theta2", "theta3", "theta4", "theta5"); +gmmtitle = "Poisson GMM trial"; +control = {100,0,1,1}; + + +# initial consistent estimate: only used to get efficient weight matrix, no screen output +[theta, obj_value, convergence] = gmm_estimate(theta, data, weight, moments, momentargs, control); + +# efficient weight matrix +# this method is valid when moments are not autocorrelated +# the user is reponsible to properly estimate the efficient weight +m = feval(moments, theta, data, momentargs); +weight = inverse(cov(m)); + +# second round efficient estimator +gmm_results(theta, data, weight, moments, momentargs, names, gmmtitle, scalecoef, control); +printf("\nThe true parameter values used to generate the data:\n"); +prettyprint(theta_true, names, "value"); + +# Example doing estimation in parallel on a cluster (requires MPITB) +# uncomment the following if you have MPITB installed +# nslaves = 1; +# theta = zeros(k,1); +# nslaves = 1; +# title = "GMM estimation done in parallel"; +# gmm_results(theta, data, weight, moments, momentargs, names, gmmtitle, scalecoef, control, nslaves); diff --git a/octave_packages/econometrics-1.0.8/gmm_obj.m b/octave_packages/econometrics-1.0.8/gmm_obj.m new file mode 100644 index 0000000..0cbaa19 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/gmm_obj.m @@ -0,0 +1,31 @@ +# Copyright (C) 2003,2004,2005 Michael Creel +# +# 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 . + + +# The GMM objective function, for internal use by gmm_estimate +# This is scaled so that it converges to a finite number. +# To get the chi-square specification +# test you need to multiply by n (the sample size) +function obj_value = gmm_obj(theta, data, weight, moments, momentargs) + + m = average_moments(theta, data, moments, momentargs); + + obj_value = m' * weight *m; + + if (((abs(obj_value) == Inf)) || (isnan(obj_value))) + obj_value = realmax; + endif + +endfunction diff --git a/octave_packages/econometrics-1.0.8/gmm_results.m b/octave_packages/econometrics-1.0.8/gmm_results.m new file mode 100644 index 0000000..c5d0a1b --- /dev/null +++ b/octave_packages/econometrics-1.0.8/gmm_results.m @@ -0,0 +1,105 @@ +# Copyright (C) 2003,2004,2005 Michael Creel +# +# 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 . + +# usage: [theta, V, obj_value] = +# gmm_results(theta, data, weight, moments, momentargs, names, title, unscale, control, nslaves) +# +# inputs: +# theta: column vector initial parameters +# data: data matrix +# weight: the GMM weight matrix +# moments: name of function computes the moments +# (should return nXg matrix of contributions) +# momentargs: (cell) additional inputs needed to compute moments. +# May be empty ("") +# names: vector of parameter names +# e.g., names = char("param1", "param2"); +# title: string, describes model estimated +# unscale: (optional) cell that holds means and std. dev. of data +# (see scale_data) +# control: (optional) BFGS or SA controls (see bfgsmin and samin). May be empty (""). +# nslaves: (optional) number of slaves if executed in parallel +# (requires MPITB) +# +# outputs: +# theta: GMM estimated parameters +# V: estimate of covariance of parameters. Assumes the weight matrix +# is optimal (inverse of covariance of moments) +# obj_value: the value of the GMM objective function +# +# please type "gmm_example" while in octave to see an example + + +function [theta, V, obj_value] = gmm_results(theta, data, weight, moments, momentargs, names, title, unscale, control, nslaves) + + if nargin < 10 nslaves = 0; endif # serial by default + + if nargin < 9 + [theta, obj_value, convergence] = gmm_estimate(theta, data, weight, moments, momentargs, "", nslaves); + else + [theta, obj_value, convergence] = gmm_estimate(theta, data, weight, moments, momentargs, control, nslaves); + endif + + + m = feval(moments, theta, data, momentargs); # find out how many obsns. we have + n = rows(m); + + if convergence == 1 + convergence="Normal convergence"; + else + convergence="No convergence"; + endif + + V = gmm_variance(theta, data, weight, moments, momentargs); + + # unscale results if argument has been passed + # this puts coefficients into scale corresponding to the original data + if nargin > 7 + if iscell(unscale) + [theta, V] = unscale_parameters(theta, V, unscale); + endif + endif + + [theta, V] = delta_method("parameterize", theta, {data, moments, momentargs}, V); + + k = rows(theta); + se = sqrt(diag(V)); + + printf("\n\n******************************************************\n"); + disp(title); + printf("\nGMM Estimation Results\n"); + printf("BFGS convergence: %s\n", convergence); + printf("\nObjective function value: %f\n", obj_value); + printf("Observations: %d\n", n); + + junk = "X^2 test"; + df = n - k; + if df > 0 + clabels = char("Value","df","p-value"); + a = [n*obj_value, df, 1 - chi2cdf(n*obj_value, df)]; + printf("\n"); + prettyprint(a, junk, clabels); + else + disp("\nExactly identified, no spec. test"); + end; + + # results for parameters + a =[theta, se, theta./se, 2 - 2*normcdf(abs(theta ./ se))]; + clabels = char("estimate", "st. err", "t-stat", "p-value"); + printf("\n"); + prettyprint(a, names, clabels); + + printf("******************************************************\n"); +endfunction diff --git a/octave_packages/econometrics-1.0.8/gmm_variance.m b/octave_packages/econometrics-1.0.8/gmm_variance.m new file mode 100644 index 0000000..c06ec4a --- /dev/null +++ b/octave_packages/econometrics-1.0.8/gmm_variance.m @@ -0,0 +1,24 @@ +# Copyright (C) 2003,2004 Michael Creel +# +# 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 . + + +# GMM variance, which assumes weights are optimal +function V = gmm_variance(theta, data, weight, moments, momentargs) + D = numgradient("average_moments", {theta, data, moments, momentargs}); + D = D'; + m = feval(moments, theta, data, momentargs); # find out how many obsns. we have + n = rows(m); + V = (1/n)*inv(D*weight*D'); +endfunction diff --git a/octave_packages/econometrics-1.0.8/gmm_variance_inefficient.m b/octave_packages/econometrics-1.0.8/gmm_variance_inefficient.m new file mode 100644 index 0000000..8548441 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/gmm_variance_inefficient.m @@ -0,0 +1,27 @@ +# Copyright (C) 2003,2004 Michael Creel +# +# 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 . + +# GMM variance, which assumes weights are not optimal +function V = gmm_variance_inefficient(theta, data, weight, omega, moments, momentargs) + D = numgradient("average_moments", {theta, data, moments, momentargs}); + D = D'; + + n = rows(data); + + J = D*weight*D'; + J = inv(J); + I = D*weight*omega*weight*D'; + V = (1/n)*J*I*J; +endfunction diff --git a/octave_packages/econometrics-1.0.8/kernel_density.m b/octave_packages/econometrics-1.0.8/kernel_density.m new file mode 100644 index 0000000..5a43d57 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/kernel_density.m @@ -0,0 +1,119 @@ +# Copyright (C) 2006 Michael Creel +# +# 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 . + +# kernel_density: multivariate kernel density estimator +# +# usage: +# dens = kernel_density(eval_points, data, bandwidth) +# +# inputs: +# eval_points: PxK matrix of points at which to calculate the density +# data: NxK matrix of data points +# bandwidth: positive scalar, the smoothing parameter. The fit +# is more smooth as the bandwidth increases. +# kernel (optional): string. Name of the kernel function. Default is +# Gaussian kernel. +# prewhiten bool (optional): default false. If true, rotate data +# using Choleski decomposition of inverse of covariance, +# to approximate independence after the transformation, which +# makes a product kernel a reasonable choice. +# do_cv: bool (optional). default false. If true, calculate leave-1-out +# density for cross validation +# computenodes: int (optional, default 0). +# Number of compute nodes for parallel evaluation +# debug: bool (optional, default false). show results on compute nodes if doing +# a parallel run +# outputs: +# dens: Px1 vector: the fitted density value at each of the P evaluation points. +# +# References: +# Wand, M.P. and Jones, M.C. (1995), 'Kernel smoothing'. +# http://www.xplore-stat.de/ebooks/scripts/spm/html/spmhtmlframe73.html + +function z = kernel_density(eval_points, data, bandwidth, kernel, prewhiten, do_cv, computenodes, debug) + + if nargin < 2; error("kernel_density: at least 2 arguments are required"); endif + + n = rows(data); + k = columns(data); + + + # set defaults for optional args + if (nargin < 3) bandwidth = (n ^ (-1/(4+k))); endif # bandwidth - see Li and Racine pg. 26 + if (nargin < 4) kernel = "__kernel_normal"; endif # what kernel? + if (nargin < 5) prewhiten = false; endif # automatic prewhitening? + if (nargin < 6) do_cv = false; endif # ordinary or leave-1-out + if (nargin < 7) computenodes = 0; endif # parallel? + if (nargin < 8) debug = false; endif; # debug? + + nn = rows(eval_points); + n = rows(data); + if prewhiten + H = bandwidth*chol(cov(data)); + else + H = bandwidth; + endif + + # Inverse bandwidth matrix H_inv + H_inv = inv(H); + + # weight by inverse bandwidth matrix + eval_points = eval_points*H_inv; + data = data*H_inv; + + # check if doing this parallel or serial + global PARALLEL NSLAVES NEWORLD NSLAVES TAG + PARALLEL = 0; + + if computenodes > 0 + PARALLEL = 1; + NSLAVES = computenodes; + LAM_Init(computenodes, debug); + endif + + if !PARALLEL # ordinary serial version + points_per_node = nn; # do the all on this node + z = kernel_density_nodes(eval_points, data, do_cv, kernel, points_per_node, computenodes, debug); + else # parallel version + z = zeros(nn,1); + points_per_node = floor(nn/(NSLAVES + 1)); # number of obsns per slave + # The command that the slave nodes will execute + cmd=['z_on_node = kernel_density_nodes(eval_points, data, do_cv, kernel, points_per_node, computenodes, debug); ',... + 'MPI_Send(z_on_node, 0, TAG, NEWORLD);']; + + # send items to slaves + + NumCmds_Send({"eval_points", "data", "do_cv", "kernel", "points_per_node", "computenodes", "debug","cmd"}, {eval_points, data, do_cv, kernel, points_per_node, computenodes, debug, cmd}); + + # evaluate last block on master while slaves are busy + z_on_node = kernel_density_nodes(eval_points, data, do_cv, kernel, points_per_node, computenodes, debug); + startblock = NSLAVES*points_per_node + 1; + endblock = nn; + z(startblock:endblock,:) = z(startblock:endblock,:) + z_on_node; + + # collect slaves' results + z_on_node = zeros(points_per_node,1); # size may differ between master and compute nodes - reset here + for i = 1:NSLAVES + MPI_Recv(z_on_node,i,TAG,NEWORLD); + startblock = i*points_per_node - points_per_node + 1; + endblock = i*points_per_node; + z(startblock:endblock,:) = z(startblock:endblock,:) + z_on_node; + endfor + + # clean up after parallel + LAM_Finalize; + endif + z = z*det(H_inv); +endfunction diff --git a/octave_packages/econometrics-1.0.8/kernel_density_cvscore.m b/octave_packages/econometrics-1.0.8/kernel_density_cvscore.m new file mode 100644 index 0000000..c95cf3e --- /dev/null +++ b/octave_packages/econometrics-1.0.8/kernel_density_cvscore.m @@ -0,0 +1,6 @@ +function cvscore = kernel_density_cvscore(bandwidth, data, kernel) + dens = kernel_density(data, data, exp(bandwidth), true, 0, 0, chol(cov(data)), kernel); + dens = dens + eps; # some kernels can assign zero density + cvscore = -mean(log(dens)); +endfunction + diff --git a/octave_packages/econometrics-1.0.8/kernel_density_nodes.m b/octave_packages/econometrics-1.0.8/kernel_density_nodes.m new file mode 100644 index 0000000..9fcc73e --- /dev/null +++ b/octave_packages/econometrics-1.0.8/kernel_density_nodes.m @@ -0,0 +1,54 @@ +# Copyright (C) 2006, 2007 Michael Creel +# under the terms of the GNU General Public License. +# +# 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 . + +# kernel_density_nodes: for internal use by kernel_density - does calculations on nodes + +function z = kernel_density_nodes(eval_points, data, do_cv, kernel, points_per_node, nslaves, debug) + + if (nslaves > 0) + global NEWORLD + [info, myrank] = MPI_Comm_rank(NEWORLD); + else myrank = 0; # if not parallel then do all on master node + endif + + if myrank == 0 # Do this if I'm master + startblock = nslaves*points_per_node + 1; + endblock = rows(eval_points); + else # this is for the slaves + startblock = myrank*points_per_node - points_per_node + 1; + endblock = myrank*points_per_node; + endif + + # the block of eval_points this node does + myeval = eval_points(startblock:endblock,:); + nn = rows(myeval); + n = rows(data); + + W = __kernel_weights(data, myeval, kernel); + if (do_cv) + W = W - diag(diag(W)); + z = sum(W,2) / (n-1); + else + z = sum(W,2) / n; + endif + + if debug + printf("z on node %d: \n", myrank); + z' + endif +endfunction + + diff --git a/octave_packages/econometrics-1.0.8/kernel_example.m b/octave_packages/econometrics-1.0.8/kernel_example.m new file mode 100644 index 0000000..20bf399 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/kernel_example.m @@ -0,0 +1,140 @@ +# Copyright (C) 2007 Michael Creel +# +# 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 . + +# kernel_example: examples of how to use kernel density and regression functions +# requires the optim and plot packages from Octave Forge +# +# usage: kernel_example; + +# sample size (default n = 500) - should get better fit (on average) +# as this increases, supposing that you allow the optimal window width +# to be found, by uncommenting the relevant lines +n = 500; + +# set this to greater than 0 to try parallel computations (requires MPITB) +compute_nodes = 0; +nodes = compute_nodes + 1; # count master node + +close all; +hold off; + +############################################################ +# kernel regression example +# uniformly spaced data points on [0,2] +x = 1:n; +x = x'; +x = 2*x/n; +# generate dependent variable +trueline = x + (x.^2)/2 - 3.1*(x.^3)/3 + 1.2*(x.^4)/4; +sig = 0.5; +y = trueline + sig*randn(n,1); +tic; +fit = kernel_regression(x, y, x); # use the default bandwidth +t1 = toc; +printf("\n"); +printf("########################################################################\n"); +printf("time for kernel regression example using %d data points and %d compute nodes: %f\n", n, nodes, t1); +plot(x, fit, ";fit;", x, trueline,";true;"); +grid("on"); +title("Example 1: Kernel regression fit"); + +############################################################ +# kernel density example: univariate - fit to Chi^2(3) data +data = sumsq(randn(n,3),2); +# evaluation point are on a grid for plotting +stepsize = 0.2; +grid_x = (-1:stepsize:11)'; +bandwidth = 0.55; +# get optimal bandwidth (time consuming, uncomment if you want to try it) +# bandwidth = kernel_optimal_bandwidth(data); +# get the fitted density and do a plot +tic; +dens = kernel_density(grid_x, data, bandwidth, "__kernel_normal", false, false, compute_nodes); +t1 = toc; +printf("\n"); +printf("########################################################################\n"); +printf("time for univariate kernel density example using %d data points and %d compute nodes: %f\n", n, nodes, t1); +printf("A rough integration under the fitted univariate density is %f\n", sum(dens)*stepsize); +figure(); +plot(grid_x, dens, ";fitted density;", grid_x, chi2pdf(grid_x,3), ";true density;"); +title("Example 2: Kernel density fit: Univariate Chi^2(3) data"); + +############################################################ +# kernel density example: bivariate +# X ~ N(0,1) +# Y ~ Chi squared(3) +# X, Y are dependent +d = randn(n,3); +data = [d(:,1) sumsq(d,2)]; +# evaluation points are on a grid for plotting +stepsize = 0.2; +a = (-5:stepsize:5)'; # for the N(0,1) +b = (-1:stepsize:9)'; # for the Chi squared(3) +gridsize = rows(a); +[grid_x, grid_y] = meshgrid(a, b); +eval_points = [vec(grid_x) vec(grid_y)]; +bandwidth = 0.85; +# get optimal bandwidth (time consuming, uncomment if you want to try it) +# bandwidth = kernel_optimal_bandwidth(data); +# get the fitted density and do a plot +tic; +dens = kernel_density(eval_points, data, bandwidth, "__kernel_normal", false, false, compute_nodes); +t1 = toc; +printf("\n"); +printf("########################################################################\n"); +printf("time for multivariate kernel density example using %d data points and %d compute nodes: %f\n", n, nodes, t1); +dens = reshape(dens, gridsize, gridsize); +printf("A rough integration under the fitted bivariate density is %f\n", sum(sum(dens))*stepsize^2); +figure(); +surf(grid_x, grid_y, dens); +title("Example 3: Kernel density fit: dependent bivariate data"); +xlabel("true marginal density is N(0,1)"); +ylabel("true marginal density is Chi^2(3)"); +# more extensive test of parallel +if compute_nodes > 0 # only try this if parallel is available + ns =[4000; 8000; 10000; 12000; 16000; 20000]; + printf("\n"); + printf("########################################################################\n"); + printf("kernel regression example with several sample sizes serial/parallel timings\n"); + figure(); + clg; + title("Compute time versus nodes, kernel regression with different sample sizes"); + xlabel("nodes"); + ylabel("time (sec)"); + hold on; + ts = zeros(rows(ns),4); + for i = 1:rows(ns) + for compute_nodes = 0:3 + nodes = compute_nodes + 1; + n = ns(i,:); + x = 1:n; + x = x'; + x = 2*x/n; + # generate dependent variable + trueline = x + (x.^2)/2 - 3.1*(x.^3)/3 + 1.2*(x.^4)/4; + sig = 0.5; + y = trueline + sig*randn(n,1); + bandwidth = 0.45; + tic; + fit = kernel_regression(x, y, x, bandwidth, "__kernel_normal", false, false, compute_nodes); + t1 = toc; + ts(i, nodes) = t1; + plot(nodes, t1, "*"); + printf(" %d data points and %d compute nodes: %f\n", n, nodes, t1); + endfor + plot(ts(i,:)'); + endfor + hold off; +endif diff --git a/octave_packages/econometrics-1.0.8/kernel_optimal_bandwidth.m b/octave_packages/econometrics-1.0.8/kernel_optimal_bandwidth.m new file mode 100644 index 0000000..29d2da9 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/kernel_optimal_bandwidth.m @@ -0,0 +1,58 @@ +# Copyright (C) 2007 Michael Creel +# +# 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 . + +# kernel_optimal_bandwidth: find optimal bandwith doing leave-one-out cross validation +# inputs: +# * data: data matrix +# * depvar: column vector or empty (""). +# If empty, do kernel density, orherwise, kernel regression +# * kernel (optional, string) the kernel function to use +# output: +# * h: the optimal bandwidth + +function bandwidth = kernel_optimal_bandwidth(data, depvar, kernel) + + if (nargin < 2) error("kernel_optimal_bandwidth: 3 arguments required"); endif + if (nargin < 3) kernel = "__kernel_epanechnikov"; endif + + do_density = false; + if isempty(depvar) do_density = true; endif; + + # SA controls + ub = 3; + lb = -5; + nt = 1; + ns = 1; + rt = 0.05; + maxevals = 50; + neps = 5; + functol = 1e-2; + paramtol = 1e-3; + verbosity = 0; + minarg = 1; + sa_control = { lb, ub, nt, ns, rt, maxevals, neps, functol, paramtol, verbosity, 1}; + + # bfgs controls + bfgs_control = {10}; + + if do_density + bandwidth = samin("kernel_density_cvscore", {1, data, kernel}, sa_control); + bandwidth = bfgsmin("kernel_density_cvscore", {bandwidth, data, kernel}, bfgs_control); + else + bandwidth = samin("kernel_regression_cvscore", {1, data, depvar, kernel}, sa_control); + bandwidth = bfgsmin("kernel_regression_cvscore", {bandwidth, data, depvar, kernel}, bfgs_control); + endif + bandwidth = exp(bandwidth); +endfunction diff --git a/octave_packages/econometrics-1.0.8/kernel_regression.m b/octave_packages/econometrics-1.0.8/kernel_regression.m new file mode 100644 index 0000000..ec0859b --- /dev/null +++ b/octave_packages/econometrics-1.0.8/kernel_regression.m @@ -0,0 +1,117 @@ +# Copyright (C) 2006 Michael Creel +# +# 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 . + +# kernel_regression: kernel regression estimator +# +# usage: +# fit = kernel_regression(eval_points, depvar, condvars, bandwidth) +# +# inputs: +# eval_points: PxK matrix of points at which to calculate the density +# depvar: Nx1 vector of observations of the dependent variable +# condvars: NxK matrix of data points +# bandwidth (optional): positive scalar, the smoothing parameter. +# Default is N ^ (-1/(4+K)) +# kernel (optional): string. Name of the kernel function. Default is +# Gaussian kernel. +# prewhiten bool (optional): default true. If true, rotate data +# using Choleski decomposition of inverse of covariance, +# to approximate independence after the transformation, which +# makes a product kernel a reasonable choice. +# do_cv: bool (optional). default false. If true, calculate leave-1-out +# fit to calculate the cross validation score +# computenodes: int (optional, default 0). +# Number of compute nodes for parallel evaluation +# debug: bool (optional, default false). show results on compute nodes if doing +# a parallel run +# outputs: +# fit: Px1 vector: the fitted value at each of the P evaluation points. +# + +function z = kernel_regression(eval_points, depvar, condvars, bandwidth, kernel, prewhiten, do_cv, computenodes, debug) + + if nargin < 3; error("kernel_regression: at least 3 arguments are required"); endif + + n = rows(condvars); + k = columns(condvars); + + # set defaults for optional args + if (nargin < 4) bandwidth = (n ^ (-1/(4+k))); endif # bandwidth - see Li and Racine pg. 66 + if (nargin < 5) kernel = "__kernel_normal"; endif # what kernel? + if (nargin < 6) prewhiten = true; endif # automatic prewhitening? + if (nargin < 7) do_cv = false; endif # ordinary or leave-1-out + if (nargin < 8) computenodes = 0; endif # parallel? + if (nargin < 9) debug = false; endif; # debug? + + + nn = rows(eval_points); + n = rows(depvar); + + if prewhiten + H = bandwidth*chol(cov(condvars)); + else + H = bandwidth; + endif + H_inv = inv(H); + + # weight by inverse bandwidth matrix + eval_points = eval_points*H_inv; + condvars = condvars*H_inv; + + data = [depvar condvars]; # put it all together for sending to nodes + + # check if doing this parallel or serial + global PARALLEL NSLAVES NEWORLD NSLAVES TAG + PARALLEL = 0; + + if computenodes > 0 + PARALLEL = 1; + NSLAVES = computenodes; + LAM_Init(computenodes, debug); + endif + + if !PARALLEL # ordinary serial version + points_per_node = nn; # do the all on this node + z = kernel_regression_nodes(eval_points, data, do_cv, kernel, points_per_node, computenodes, debug); + else # parallel version + z = zeros(nn,1); + points_per_node = floor(nn/(NSLAVES + 1)); # number of obsns per slave + # The command that the slave nodes will execute + cmd=['z_on_node = kernel_regression_nodes(eval_points, data, do_cv, kernel, points_per_node, computenodes, debug); ',... + 'MPI_Send(z_on_node, 0, TAG, NEWORLD);']; + + # send items to slaves + + NumCmds_Send({"eval_points", "data", "do_cv", "kernel", "points_per_node", "computenodes", "debug","cmd"}, {eval_points, data, do_cv, kernel, points_per_node, computenodes, debug, cmd}); + + # evaluate last block on master while slaves are busy + z_on_node = kernel_regression_nodes(eval_points, data, do_cv, kernel, points_per_node, computenodes, debug); + startblock = NSLAVES*points_per_node + 1; + endblock = nn; + z(startblock:endblock,:) = z(startblock:endblock,:) + z_on_node; + + # collect slaves' results + z_on_node = zeros(points_per_node,1); # size may differ between master and compute nodes - reset here + for i = 1:NSLAVES + MPI_Recv(z_on_node,i,TAG,NEWORLD); + startblock = i*points_per_node - points_per_node + 1; + endblock = i*points_per_node; + z(startblock:endblock,:) = z(startblock:endblock,:) + z_on_node; + endfor + + # clean up after parallel + LAM_Finalize; + endif +endfunction diff --git a/octave_packages/econometrics-1.0.8/kernel_regression_cvscore.m b/octave_packages/econometrics-1.0.8/kernel_regression_cvscore.m new file mode 100644 index 0000000..34424e3 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/kernel_regression_cvscore.m @@ -0,0 +1,5 @@ +function cvscore = kernel_regression_cvscore(bandwidth, data, depvar) + fit = kernel_regression(data, depvar, data, exp(bandwidth), true); + cvscore = norm(depvar - fit); +endfunction + diff --git a/octave_packages/econometrics-1.0.8/kernel_regression_nodes.m b/octave_packages/econometrics-1.0.8/kernel_regression_nodes.m new file mode 100644 index 0000000..35bf3a5 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/kernel_regression_nodes.m @@ -0,0 +1,62 @@ +# Copyright (C) 2006, 2007 Michael Creel +# under the terms of the GNU General Public License. +# +# 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 . + +# kernel_regression_nodes: for internal use by kernel_regression - does calculations on nodes + +function z = kernel_regression_nodes(eval_points, data, do_cv, kernel, points_per_node, nslaves, debug) + + if (nslaves > 0) + global NEWORLD + [info, myrank] = MPI_Comm_rank(NEWORLD); + else myrank = 0; # if not parallel then do all on master node + endif + + if myrank == 0 # Do this if I'm master + startblock = nslaves*points_per_node + 1; + endblock = rows(eval_points); + else # this is for the slaves + startblock = myrank*points_per_node - points_per_node + 1; + endblock = myrank*points_per_node; + endif + + # the block of eval_points this node does + myeval = eval_points(startblock:endblock,:); + nn = rows(myeval); + n = rows(data); + + y = data(:,1); + data = data(:,2:columns(data)); + W = __kernel_weights(data, myeval, kernel); + + # drop own weight for CV + if (do_cv) W = W - diag(diag(W)); endif + + den = sum(W,2); + if !all(den) + warning("kernel_regression: some evaluation points have no neighbors - increase the bandwidth"); + den = den + eps; # avoid divide by zero + endif + + W = W ./ (repmat(den,1,n)); + z = W*y; + + if debug + printf("z on node %d: \n", myrank); + z' + endif +endfunction + + diff --git a/octave_packages/econometrics-1.0.8/mle_estimate.m b/octave_packages/econometrics-1.0.8/mle_estimate.m new file mode 100644 index 0000000..4dec10a --- /dev/null +++ b/octave_packages/econometrics-1.0.8/mle_estimate.m @@ -0,0 +1,73 @@ +## Copyright (C) 2003,2004,2005 Michael Creel +## +## 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 . + +# usage: +# [theta, obj_value, conv, iters] = mle_estimate(theta, data, model, modelargs, control, nslaves) +# +# inputs: +# theta: column vector of model parameters +# data: data matrix +# model: name of function that computes log-likelihood +# modelargs: (cell) additional inputs needed by model. May be empty ("") +# control: (optional) BFGS or SA controls (see bfgsmin and samin). May be empty (""). +# nslaves: (optional) number of slaves if executed in parallel (requires MPITB) +# +# outputs: +# theta: ML estimated value of parameters +# obj_value: the value of the log likelihood function at ML estimate +# conv: return code from bfgsmin (1 means success, see bfgsmin for details) +# iters: number of BFGS iteration used +# +# please see mle_example.m for examples of how to use this +function [theta, obj_value, convergence, iters] = mle_estimate(theta, data, model, modelargs, control, nslaves) + + + if nargin < 3 + error("mle_estimate: 3 arguments required"); + endif + + if nargin < 4 modelargs = {}; endif # create placeholder if not used + if !iscell(modelargs) modelargs = {}; endif # default controls if receive placeholder + if nargin < 5 control = {-1,0,1,1}; endif # default controls and method + if !iscell(control) control = {-1,0,1,1}; endif # default controls if receive placeholder + if nargin < 6 nslaves = 0; endif + if nslaves > 0 + global NSLAVES PARALLEL NEWORLD TAG; + LAM_Init(nslaves); + # Send the data to all nodes + NumCmds_Send({"data", "model", "modelargs"}, {data, model, modelargs}); + endif + + # bfgs or sa? + if (size(control,1)*size(control,2) == 0) # use default bfgs if no control + control = {Inf,0,1,1}; + method = "bfgs"; + elseif (size(control,1)*size(control,2) < 11) + method = "bfgs"; + else method = "sa"; + endif + + # do estimation using either bfgsmin or samin + if strcmp(method, "bfgs") + [theta, obj_value, convergence, iters] = bfgsmin("mle_obj", {theta, data, model, modelargs, nslaves}, control); + elseif strcmp(method, "sa") + [theta, obj_value, convergence] = samin("mle_obj", {theta, data, model, modelargs, nslaves}, control); + endif + + if nslaves > 0 + LAM_Finalize; + endif # cleanup + obj_value = - obj_value; # recover from minimization rather than maximization +endfunction diff --git a/octave_packages/econometrics-1.0.8/mle_example.m b/octave_packages/econometrics-1.0.8/mle_example.m new file mode 100644 index 0000000..660b881 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/mle_example.m @@ -0,0 +1,79 @@ +## Copyright (C) 2003,2004 Michael Creel +## +## 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 . + +## Example to show how to use MLE functions + + + +# Generate data +n = 1000; # how many observations? + +# the explanatory variables: note that they have unequal scales +x = [ones(n,1) -rand(n,1) randn(n,1)]; +theta = 1:3; # true coefficients are 1,2,3 +theta = theta'; + +lambda = exp(x*theta); +y = poissrnd(lambda); # generate the dependent variable + +#################################### +# define arguments for mle_results # +#################################### + +# starting values +theta = zeros(3,1); +# data +data = [y, x]; +# name of model to estimate +model = "poisson"; +modelargs = {0}; # if this is zero the function gives analytic score, otherwise not +# parameter names +names = char("beta1", "beta2", "beta3"); +mletitle = "Poisson MLE trial"; # title for the run + +# controls for bfgsmin: 30 iterations is not always enough for convergence +control = {50,0}; + +# This displays the results +printf("\n\nanalytic score, unscaled data\n"); +[theta, V, obj_value, infocrit] = mle_results(theta, data, model, modelargs, names, mletitle, 0, control); + +# This just calculates the results, no screen display +printf("\n\nanalytic score, unscaled data, no screen display\n"); +theta = zeros(3,1); +[theta, obj_value, convergence] = mle_estimate(theta, data, model, modelargs, control); +printf("obj_value = %f, to confirm it worked\n", obj_value); + +# This show how to scale data during estimation, but get results +# for data in original units (recommended to avoid conditioning problems) +# This usually converges faster, depending upon the data +printf("\n\nanalytic score, scaled data\n"); +[scaled_x, unscale] = scale_data(x); +data = [y, scaled_x]; +theta = zeros(3,1); +[theta, V, obj_value, infocrit] = mle_results(theta, data, model, modelargs, names, mletitle, unscale, control); + +# Example using numeric score +printf("\n\nnumeric score, scaled data\n"); +theta = zeros(3,1); +modelargs = {1}; # set the switch for no score +[theta, V, obj_value, infocrit] = mle_results(theta, data, model, modelargs, names, mletitle, unscale, control); + +# Example doing estimation in parallel on a cluster (requires MPITB) +# uncomment the following if you have MPITB installed +# theta = zeros(3,1); +# nslaves = 1; +# title = "MLE estimation done in parallel"; +# [theta, V, obj_value, infocrit] = mle_results(theta, data, model, modelargs, names, mletitle, unscale, control, nslaves); diff --git a/octave_packages/econometrics-1.0.8/mle_obj.m b/octave_packages/econometrics-1.0.8/mle_obj.m new file mode 100644 index 0000000..700dc72 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/mle_obj.m @@ -0,0 +1,64 @@ +# Copyright (C) 2003,2004,2005 Michael Creel +# +# 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 . + +## usage: [obj_value, score] = mle_obj(theta, data, model, modelargs, nslaves) +## +## Returns the average log-likelihood for a specified model +## This is for internal use by mle_estimate + + +function [obj_value, score] = mle_obj(theta, data, model, modelargs, nslaves) + + n = rows(data); + + if nargin < 5 nslaves = 0; endif + if nslaves > 0 + global NSLAVES PARALLEL NEWORLD NSLAVES TAG; + + nn = floor(n/(NSLAVES + 1)); # number of obsns per slave + + # The command that the slave nodes will execute + cmd=['contrib = mle_obj_nodes(theta, data, model, modelargs, nn); ',... + 'MPI_Send(contrib,0,TAG,NEWORLD);']; + + # send items to slaves + NumCmds_Send({"theta", "nn", "cmd"}, {theta, nn, cmd}); + + # evaluate last block on master while slaves are busy + obj_value = mle_obj_nodes(theta, data, model, modelargs, nn); + + # collect slaves' results + contrib = 0.0; # must be initialized to use MPI_Recv + for i = 1:NSLAVES + MPI_Recv(contrib,i,TAG,NEWORLD); + obj_value = obj_value + contrib; + endfor + + # compute the average + obj_value = - obj_value / n; + score = "na"; # fix this later to allow analytic score in parallel + + else # serial version + [contribs, score] = feval(model, theta, data, modelargs); + obj_value = - mean(contribs); + if isnumeric(score) score = - mean(score)'; endif # model passes "na" when score not available + endif + + # let's bullet-proof this in case the model goes nuts + if (((abs(obj_value) == Inf)) || (isnan(obj_value))) + obj_value = realmax/10; + endif + +endfunction diff --git a/octave_packages/econometrics-1.0.8/mle_obj_nodes.m b/octave_packages/econometrics-1.0.8/mle_obj_nodes.m new file mode 100644 index 0000000..ac6bf0f --- /dev/null +++ b/octave_packages/econometrics-1.0.8/mle_obj_nodes.m @@ -0,0 +1,33 @@ +## Copyright (C) 2003,2004,2005 Michael Creel +## +## 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 . + +function contrib = mle_obj_nodes(theta, data, model, modelargs, nn) + global NEWORLD NSLAVES + + # Who am I? + [info, rank] = MPI_Comm_rank(NEWORLD); + if rank == 0 # Do this if I'm master + startblock = NSLAVES*nn + 1; + endblock = rows(data); + else # this is for the slaves + startblock = rank*nn-nn+1; + endblock = rank*nn; + endif + + data = data(startblock:endblock,:); + contrib = feval(model, theta, data, modelargs); + contrib = sum(contrib); + +endfunction diff --git a/octave_packages/econometrics-1.0.8/mle_results.m b/octave_packages/econometrics-1.0.8/mle_results.m new file mode 100644 index 0000000..f931c85 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/mle_results.m @@ -0,0 +1,89 @@ +# Copyright (C) 2003,2004,2005 Michael Creel +# +# 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 . + +# usage: [theta, V, obj_value, infocrit] = +# mle_results(theta, data, model, modelargs, names, title, unscale, control) +# +# inputs: +# theta: column vector of model parameters +# data: data matrix +# model: name of function that computes log-likelihood +# modelargs: (cell) additional inputs needed by model. May be empty ("") +# names: vector of parameter names, e.g., use names = char("param1", "param2"); +# title: string, describes model estimated +# unscale: (optional) cell that holds means and std. dev. of data (see scale_data) +# control: (optional) BFGS or SA controls (see bfgsmin and samin). May be empty (""). +# nslaves: (optional) number of slaves if executed in parallel (requires MPITB) +# +# outputs: +# theta: ML estimated value of parameters +# obj_value: the value of the log likelihood function at ML estimate +# conv: return code from bfgsmin (1 means success, see bfgsmin for details) +# iters: number of BFGS iteration used + + +## +## Please see mle_example for information on how to use this + +# report results +function [theta, V, obj_value, infocrit] = mle_results(theta, data, model, modelargs, names, mletitle, unscale, control = {-1}, nslaves = 0) + if nargin < 6 mletitle = "Generic MLE title"; endif + + [theta, obj_value, convergence] = mle_estimate(theta, data, model, modelargs, control, nslaves); + V = mle_variance(theta, data, model, modelargs); + + # unscale results if argument has been passed + # this puts coefficients into scale corresponding to the original modelargs + if (nargin > 6) + if iscell(unscale) # don't try it if unscale is simply a placeholder + [theta, V] = unscale_parameters(theta, V, unscale); + endif + endif + + [theta, V] = delta_method("parameterize", theta, {data, model, modelargs}, V); + + n = rows(data); + k = rows(V); + se = sqrt(diag(V)); + if convergence == 1 convergence="Normal convergence"; + elseif convergence == 2 convergence="No convergence"; + elseif convergence == -1 convergence = "Max. iters. exceeded"; + endif + printf("\n\n******************************************************\n"); + disp(mletitle); + printf("\nMLE Estimation Results\n"); + printf("BFGS convergence: %s\n\n", convergence); + + printf("Average Log-L: %f\n", obj_value); + printf("Observations: %d\n", n); + a =[theta, se, theta./se, 2 - 2*normcdf(abs(theta ./ se))]; + + clabels = char("estimate", "st. err", "t-stat", "p-value"); + + printf("\n"); + if names !=0 prettyprint(a, names, clabels); + else prettyprint_c(a, clabels); + endif + + printf("\nInformation Criteria \n"); + caic = -2*n*obj_value + rows(theta)*(log(n)+1); + bic = -2*n*obj_value + rows(theta)*log(n); + aic = -2*n*obj_value + 2*rows(theta); + infocrit = [caic, bic, aic]; + printf("CAIC : %8.4f Avg. CAIC: %8.4f\n", caic, caic/n); + printf(" BIC : %8.4f Avg. BIC: %8.4f\n", bic, bic/n); + printf(" AIC : %8.4f Avg. AIC: %8.4f\n", aic, aic/n); + printf("******************************************************\n"); +endfunction diff --git a/octave_packages/econometrics-1.0.8/mle_variance.m b/octave_packages/econometrics-1.0.8/mle_variance.m new file mode 100644 index 0000000..6466f49 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/mle_variance.m @@ -0,0 +1,29 @@ +## Copyright (C) 2003,2004,2005 Michael Creel +## +## 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 . + +## usage: [V,scorecontribs,J_inv] = +## mle_variance(theta, data, model, modelargs) +## +## This is for internal use by mle_results + +# sandwich form of var-cov matrix +function [V, scorecontribs, J_inv] = mle_variance(theta, data, model, modelargs) + scorecontribs = numgradient(model, {theta, data, modelargs}); + n = rows(scorecontribs); + I = scorecontribs'*scorecontribs / n; + J = numhessian("mle_obj", {theta, data, model, modelargs}); + J_inv = inverse(J); + V = J_inv*I*J_inv/n; +endfunction diff --git a/octave_packages/econometrics-1.0.8/nls_estimate.m b/octave_packages/econometrics-1.0.8/nls_estimate.m new file mode 100644 index 0000000..70ef350 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/nls_estimate.m @@ -0,0 +1,70 @@ +## Copyright (C) 2005 Michael Creel +## +## 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 . + +# usage: +# [theta, obj_value, conv, iters] = nls_estimate(theta, data, model, modelargs, control, nslaves) +# +# inputs: +# theta: column vector of model parameters +# data: data matrix +# model: name of function that computes the vector of sums of squared errors +# modelargs: (cell) additional inputs needed by model. May be empty ("") +# control: (optional) BFGS or SA controls (see bfgsmin and samin). May be empty (""). +# nslaves: (optional) number of slaves if executed in parallel (requires MPITB) +# +# outputs: +# theta: NLS estimated value of parameters +# obj_value: the value of the sum of squared errors at NLS estimate +# conv: return code from bfgsmin (1 means success, see bfgsmin for details) +# iters: number of BFGS iteration used +# +# please see nls_example.m for examples of how to use this +function [theta, obj_value, convergence, iters] = nls_estimate(theta, data, model, modelargs, control, nslaves) + + if nargin < 3 + error("nls_estimate: 3 arguments required"); + endif + + if nargin < 4 modelargs = {}; endif # create placeholder if not used + if !iscell(modelargs) modelargs = {}; endif # default controls if receive placeholder + if nargin < 5 control = {Inf,0,1,1}; endif # default controls and method + if !iscell(control) control = {Inf,0,1,1}; endif # default controls if receive placeholder + if nargin < 6 nslaves = 0; endif + + if nslaves > 0 + global NSLAVES PARALLEL NEWORLD TAG + LAM_Init(nslaves); + # Send the data to all nodes + NumCmds_Send({"data", "model", "modelargs"}, {data, model, modelargs}); + endif + + # bfgs or sa? + if (size(control,1)*size(control,2) == 0) # use default bfgs if no control + control = {Inf,0,1,1}; + method = "bfgs"; + elseif (size(control,1)*size(control,2) < 11) + method = "bfgs"; + else method = "sa"; + endif + + if strcmp(method, "bfgs") + [theta, obj_value, convergence, iters] = bfgsmin("nls_obj", {theta, data, model, modelargs, nslaves}, control); + elseif strcmp(method, "sa") + [theta, obj_value, convergence] = samin("nls_obj", {theta, data, model, modelargs, nslaves}, control); + endif + + # cleanup + if nslaves > 0 LAM_Finalize; endif +endfunction diff --git a/octave_packages/econometrics-1.0.8/nls_example.m b/octave_packages/econometrics-1.0.8/nls_example.m new file mode 100644 index 0000000..9a26dff --- /dev/null +++ b/octave_packages/econometrics-1.0.8/nls_example.m @@ -0,0 +1,57 @@ +## Copyright (C) 2006 Michael Creel +## +## 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 . + +## Example to show how to use NLS + +# Generate data +n = 100; # how many observations? + +# the explanatory variables: note that they have unequal scales +x = [ones(n,1) rand(n,2)]; +theta = 1:3; # true coefficients are 1,2,3 +theta = theta'; + +lambda = exp(x*theta); +y = randp(lambda); # generate the dependent variable + +# example objective function for nls +function [obj_contrib, score] = nls_example_obj(theta, data, otherargs) + y = data(:,1); + x = data(:,2:columns(data)); + lambda = exp(x*theta); + errors = y - lambda; + obj_contrib = errors .* errors; + score = "na"; +endfunction + + +##################################### +# define arguments for nls_estimate # +##################################### +# starting values +theta = zeros(3,1); +# data +data = [y, x]; +# name of model to estimate +model = "nls_example_obj"; +modelargs = {}; # none required for this obj fn. +# controls for bfgsmin - limit to 50 iters, and print final results +control = {50,1}; + +#################################### +# do the estimation # +#################################### +printf("\nNLS estimation example\n"); +[theta, obj_value, convergence] = nls_estimate(theta, data, model, modelargs, control); diff --git a/octave_packages/econometrics-1.0.8/nls_obj.m b/octave_packages/econometrics-1.0.8/nls_obj.m new file mode 100644 index 0000000..e3d2375 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/nls_obj.m @@ -0,0 +1,60 @@ +# Copyright (C) 2005 Michael Creel +# +# 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 . + +# usage: [obj_value, score] = nls_obj(theta, data, model, modelargs, nslaves) +# +# Returns the average sum of squared errors for a specified model +# This is for internal use by nls_estimate + + +function [obj_value, score] = nls_obj(theta, data, model, modelargs, nslaves) + + n = rows(data); + + if nslaves > 0 + global NEWORLD NSLAVES TAG + nn = floor(n/(NSLAVES + 1)); # number of obsns per slave + + # The command that the slave nodes will execute + cmd=['contrib = nls_obj_nodes(theta, data, model, modelargs, nn); ',... + 'MPI_Send(contrib,0,TAG,NEWORLD);']; + + # send items to slaves + NumCmds_Send({"theta", "nn", "cmd"}, {theta, nn, cmd}); + + # evaluate last block on master while slaves are busy + obj_value = nls_obj_nodes(theta, data, model, modelargs, nn); + + # collect slaves' results + contrib = 0.0; # must be initialized to use MPI_Recv + for i = 1:NSLAVES + MPI_Recv(contrib,i,TAG,NEWORLD); + obj_value = obj_value + contrib; + endfor + + # compute the average + obj_value = obj_value / n; + score = "na"; # fix this later to allow analytic score in parallel + + else # serial version + [contribs, score] = feval(model, theta, data, modelargs); + obj_value = mean(contribs); + if isnumeric(score) score = mean(score)'; endif # model passes "na" when score not available + endif + + # let's bullet-proof this in case the model goes nuts + if (((abs(obj_value) == Inf)) || (isnan(obj_value))) obj_value = realmax; endif + +endfunction diff --git a/octave_packages/econometrics-1.0.8/nls_obj_nodes.m b/octave_packages/econometrics-1.0.8/nls_obj_nodes.m new file mode 100644 index 0000000..5733b70 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/nls_obj_nodes.m @@ -0,0 +1,36 @@ +# Copyright (C) 2005 Michael Creel +# +# 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 . + +# This is for internal use by nls_estimate + + +function contrib = nls_obj_nodes(theta, data, model, modelargs, nn) + global NEWORLD NSLAVES + # Who am I? + [info, rank] = MPI_Comm_rank(NEWORLD); + + if rank == 0 # Do this if I'm master + startblock = NSLAVES*nn + 1; + endblock = rows(data); + else # this is for the slaves + startblock = rank*nn-nn+1; + endblock = rank*nn; + endif + + data = data(startblock:endblock,:); + contrib = feval(model, theta, data, modelargs); + contrib = sum(contrib); + +endfunction diff --git a/octave_packages/econometrics-1.0.8/packinfo/.autoload b/octave_packages/econometrics-1.0.8/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/econometrics-1.0.8/packinfo/DESCRIPTION b/octave_packages/econometrics-1.0.8/packinfo/DESCRIPTION new file mode 100644 index 0000000..e5ee656 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: Econometrics +Version: 1.0.8 +Date: 2009-05-03 +Author: Michael Creel +Maintainer: Michael Creel +Title: Econometrics. +Description: Econometrics functions including MLE and GMM based techniques. +Depends: octave (>= 2.9.7), optim +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net diff --git a/octave_packages/econometrics-1.0.8/packinfo/INDEX b/octave_packages/econometrics-1.0.8/packinfo/INDEX new file mode 100644 index 0000000..9ee407c --- /dev/null +++ b/octave_packages/econometrics-1.0.8/packinfo/INDEX @@ -0,0 +1,22 @@ +econometrics >> Econometrics +Econometrics + average_moments delta_method + gmm_estimate gmm_example gmm_obj gmm_results gmm_variance gmm_variance_inefficient + mle_estimate mle_example mle_obj mle_results mle_variance + parameterize prettyprint scale_data unscale_parameters + nls_estimate nls_obj + mle_obj_nodes + nls_example + nls_obj_nodes + poisson + poisson_moments + prettyprint_c + sum_moments_nodes + kernel_density + kernel_density_cvscore + kernel_density_nodes + kernel_example + kernel_optimal_bandwidth + kernel_regression + kernel_regression_cvscore + kernel_regression_nodes diff --git a/octave_packages/econometrics-1.0.8/parameterize.m b/octave_packages/econometrics-1.0.8/parameterize.m new file mode 100644 index 0000000..464272f --- /dev/null +++ b/octave_packages/econometrics-1.0.8/parameterize.m @@ -0,0 +1,28 @@ +# Copyright (C) 2003,2004 Michael Creel +# +# 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 . +# + +# usage: theta = parameterize(theta, otherargs) +# +# This is an empty function, provided so that +# delta_method will work as is. Replace it with +# the parameter transformations your models use. +# Note: you can let "otherargs" contain the model +# name so that this function can do parameterizations +# for a variety of models + +function theta = parameterize(theta, otherargs) + +endfunction diff --git a/octave_packages/econometrics-1.0.8/poisson.m b/octave_packages/econometrics-1.0.8/poisson.m new file mode 100644 index 0000000..3b321cd --- /dev/null +++ b/octave_packages/econometrics-1.0.8/poisson.m @@ -0,0 +1,25 @@ +# Copyright (C) 2005 Michael Creel +# +# 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 . + +# Example likelihood function (Poisson for count data) with score + +function [log_density, score] = poisson(theta, data, otherargs) + y = data(:,1); + x = data(:,2:columns(data)); + lambda = exp(x*theta); + log_density = -lambda + y .* (x*theta) - lgamma(y+1); + score = diag (y - lambda) * x; + if (otherargs{1} == 1) score = "na"; endif # provide analytic score or not? +endfunction diff --git a/octave_packages/econometrics-1.0.8/poisson_moments.m b/octave_packages/econometrics-1.0.8/poisson_moments.m new file mode 100644 index 0000000..3372cf3 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/poisson_moments.m @@ -0,0 +1,26 @@ +# Copyright (C) 2005 Michael Creel +# +# 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 . + +# the form a user-written moment function should take + +function m = poisson_moments(theta, data, momentargs) + k = momentargs{1}; # use this so that data can hold dep, indeps, and instr + y = data(:,1); + x = data(:,2:k+1); + w = data(:, k+2:columns(data)); + lambda = exp(x*theta); + e = y ./ lambda - 1; + m = diag(e) * w; +endfunction diff --git a/octave_packages/econometrics-1.0.8/prettyprint.m b/octave_packages/econometrics-1.0.8/prettyprint.m new file mode 100644 index 0000000..cf36683 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/prettyprint.m @@ -0,0 +1,47 @@ +# Copyright (C) 2003,2004 Michael Creel +# +# 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 . + +## this prints matrices with row and column labels +function prettyprint(mat, rlabels, clabels) + + # left pad the column labels + a = columns(rlabels); + for i = 1:a + printf(" "); + endfor + printf(" "); + + # print the column labels + clabels = [" ";clabels]; # pad to 8 characters wide + clabels = strjust(clabels,"right"); + + k = columns(mat); + for i = 1:k + printf("%s ",clabels(i+1,:)); + endfor + + # now print the row labels and rows + printf("\n"); + k = rows(mat); + for i = 1:k + if ischar(rlabels(i,:)) + printf(rlabels(i,:)); + else + printf("%i", rlabels(i,:)); + endif + printf(" %10.3f", mat(i,:)); + printf("\n"); + endfor +endfunction diff --git a/octave_packages/econometrics-1.0.8/prettyprint_c.m b/octave_packages/econometrics-1.0.8/prettyprint_c.m new file mode 100644 index 0000000..972a134 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/prettyprint_c.m @@ -0,0 +1,37 @@ +# Copyright (C) 2003,2004 Michael Creel +# +# 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 . + +# this prints matrices with column labels but no row labels +function prettyprint_c(mat, clabels) + + printf(" "); + + # print the column labels + clabels = [" ";clabels]; # pad to 8 characters wide + clabels = strjust(clabels,"right"); + + k = columns(mat); + for i = 1:k + printf("%s ",clabels(i+1,:)); + endfor + + # now print the row labels and rows + printf("\n"); + k = rows(mat); + for i = 1:k + printf(" %8.3f", mat(i,:)); + printf("\n"); + endfor +endfunction diff --git a/octave_packages/econometrics-1.0.8/scale_data.m b/octave_packages/econometrics-1.0.8/scale_data.m new file mode 100644 index 0000000..a103e4d --- /dev/null +++ b/octave_packages/econometrics-1.0.8/scale_data.m @@ -0,0 +1,45 @@ +# Copyright (C) 2003,2004 Michael Creel +# +# 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 . + +# Standardizes and normalizes data matrix, +# primarily for use by BFGS + +function [zz, scalecoefs] = scale_data(z); + + n = rows(z); + k = columns(z); + + # Scale data + s = std(z)'; + test = s != 0; + s = s + (1 - test); # don't scale if column is a constant (avoid div by zero) + A = diag(1 ./ s); + + # De-mean all variables except constant, if a constant is present + test = std(z(:,1)) != 0; + if test + bb = zeros(n,k); + b = zeros(k,1); + else + b = -mean(z)'; + test = std(z)' != 0; + # don't take out mean if the column is a constant, to preserve identification + b = b .* test; + b = A*b; + bb = (diag(b) * ones(k,n))'; + endif + zz = z*A + bb; + scalecoefs = {A,b}; +endfunction diff --git a/octave_packages/econometrics-1.0.8/sum_moments_nodes.m b/octave_packages/econometrics-1.0.8/sum_moments_nodes.m new file mode 100644 index 0000000..7248f83 --- /dev/null +++ b/octave_packages/econometrics-1.0.8/sum_moments_nodes.m @@ -0,0 +1,37 @@ +# Copyright (C) 2005 Michael Creel +# +# 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 . + +# for internal use by gmm_estimate + +function contrib = sum_moments_nodes(theta, data, moments, momentargs, nn) + + global NEWORLD NSLAVES + + # Who am I? + [info, rank] = MPI_Comm_rank(NEWORLD); + + if rank == 0 # Do this if I'm master + startblock = NSLAVES*nn + 1; + endblock = rows(data); + else # this is for the slaves + startblock = rank*nn-nn+1; + endblock = rank*nn; + endif + + data = data(startblock:endblock,:); + contrib = feval(moments, theta, data, momentargs); + contrib = sum(contrib); + +endfunction diff --git a/octave_packages/econometrics-1.0.8/unscale_parameters.m b/octave_packages/econometrics-1.0.8/unscale_parameters.m new file mode 100644 index 0000000..0fcc16f --- /dev/null +++ b/octave_packages/econometrics-1.0.8/unscale_parameters.m @@ -0,0 +1,39 @@ +# Copyright (C) 2003,2004 Michael Creel +# +# 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 . + +# Unscales parameters that were estimated using scaled data +# primarily for use by BFGS +function [theta_us, vartheta_us] = unscale_parameters(theta, vartheta, scalecoefs); + k = rows(theta); + A = scalecoefs {1}; + b = scalecoefs {2}; + + kk = rows(b); + B = zeros(kk-1,kk); + B = [b'; B]; + + C = A + B; + + # allow for parameters that aren't associated with x + if (k > kk) + D = zeros(kk, k - kk); + C = [C, D; D', eye(k - kk)]; + endif; + + + + theta_us = C*theta; + vartheta_us = C * vartheta * C'; +endfunction diff --git a/octave_packages/financial-0.4.0/bolling.m b/octave_packages/financial-0.4.0/bolling.m new file mode 100644 index 0000000..d383d6f --- /dev/null +++ b/octave_packages/financial-0.4.0/bolling.m @@ -0,0 +1,72 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} bolling (@var{asset}, @var{samples}) +## @deftypefnx {Function File} {} bolling (@var{asset}, @var{samples}, @var{alpha}) +## @deftypefnx {Function File} {} bolling (@var{asset}, @var{samples}, @var{alpha}, @var{width}) +## @deftypefnx {Function File} {[@var{movavg}, @var{upperband}, @var{lowerband}] =} bolling (@var{asset}, @var{samples}, ...) +## +## If no output is requested, plot the bollinger bands of the +## @var{asset}. If output is requested, return the values for the +## bollinger bands. If given, @var{alpha} is the weighting power of the +## moving average; 0 (default) is the simple moving average, see +## @code{movavg} for the full definition. @var{width} is the number of +## standard deviations to plot above and below the moving average +## (default: 2). +## +## @seealso{movavg, candle, dateaxis, highlow, pointfig} +## @end deftypefn + +function [varargout] = bolling (asset, samples, alpha, width) + + ## Check input and set the defaults + if nargin < 2 || nargin > 4 + print_usage (); + elseif nargin < 3 + alpha = 0; + endif + if nargin < 4 + width = 2; + endif + + if samples > length (asset) + error ("Samples must be <= the length of the asset") + endif + + ## the moving average and the standard deviation + avg = movavg(asset, samples, samples, alpha); + s = zeros(size(avg)); + + ## Assume that the standard deviation is constant for the first samples + ## FIXME: is this what matlab assumes + s(1:samples) = std (asset(1:samples)); + for i = samples+1:length (asset) + s(i) = std (asset(i - samples + 1:i)); + endfor + + if nargout > 0 + varargout{1} = avg; + else + plot((1:length(avg))', [avg(:), avg(:)+s(:), avg(:)-s(:)]); + endif + if nargout > 1 + varargout{2} = avg + s; + endif + if nargout > 2 + varargout{3} = avg - s; + endif + +endfunction diff --git a/octave_packages/financial-0.4.0/busdate.m b/octave_packages/financial-0.4.0/busdate.m new file mode 100644 index 0000000..f90f175 --- /dev/null +++ b/octave_packages/financial-0.4.0/busdate.m @@ -0,0 +1,97 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {b =} busdate (refdate) +## @deftypefnx {Function File} {b =} busdate (refdate, direction) +## @deftypefnx {Function File} {b =} busdate (refdate, direction, holiday) +## @deftypefnx {Function File} {b =} busdate (refdate, direction, holiday, weekend) +## +## Return the datenum of the next or previous business day from +## @var{refdate}. @var{direction} indicates the next day (default) if 1 +## and the previous day if -1. @var{holiday} is a vector of datenums +## that defines the holidays observed (the holidays function is used if +## not given). @var{weekend} defines the days of the week that should +## be considered weekends; [1 0 0 0 0 0 1] (default) indicates that +## Sunday and Saturday are holidays. +## +## If any of the optional inputs (@var{direction}, @var{holiday}, +## @var{weekend}) are empty, then the default is used. +## +## @seealso{holidays, lbusdate, isbusday, fbusdate} +## @end deftypefn + +function rd = busdate (rd, d, hol, wkend) + + if ~isnumeric (rd) + rd = datenum ( rd); + endif + if nargin < 2 || isempty (d) + d = 1; + elseif ~ all (abs (d) == 1) + ## People could use other numbers to skip days, but that is not + ## supported. + error ("directions must all be either 1 or -1.") + endif + if nargin < 3 + hol = []; + end + if nargin < 4 + wkend = []; + elseif nargin > 4 + print_usage (); + endif + + rd += d; + mask = ~isbusday (rd, hol, wkend); + while any (mask) + ## Only recompute for the days that are not yet business days + if isscalar (d) + rd(mask) += d; + else + rd(mask) += d(mask); + endif + mask(mask) = ~isbusday (rd(mask), hol, wkend); + endwhile + +endfunction + +## Tests +## A normal day +%!assert(busdate(datenum(2008,1,2)), datenum(2008,1,3)) +## A holiday +%!assert(busdate(datenum(2007,12,31)), datenum(2008,1,2)) +## Go over a weekend and start in a weekend +%!assert(busdate(datenum(2007,1,5)), datenum(2007,1,8)) +%!assert(busdate(datenum(2007,1,6)), datenum(2007,1,8)) +## Backward +%!assert(busdate(datenum(2008,1,3), -1), datenum(2008,1,2)) +## Backward holiday +%!assert(busdate(datenum(2008,1,2), -1), datenum(2007,12,31)) +## Backward with alternate holidays +%!assert(busdate(datenum(2008,1,2), -1, datenum(2007,1,1):datenum(2008,1,1)), datenum(2006,12,29)) +## Multiple dates in both orientations +%!assert(busdate([datenum(2008,1,2) datenum(2007,1,1)]), [datenum(2008,1,3) datenum(2007,1,2)]) +%!assert(busdate([datenum(2008,1,2) datenum(2007,1,1)], [1 1]), [datenum(2008,1,3) datenum(2007,1,2)]) +%!assert(busdate([datenum(2008,1,2) datenum(2007,1,1)], 1), [datenum(2008,1,3) datenum(2007,1,2)]) +%!assert(busdate([datenum(2008,1,2);datenum(2007,1,1)], [1;1]), [datenum(2008,1,3);datenum(2007,1,2)]) +## Multiple dates with opposite directions holidays and weekends +%!assert(busdate([datenum(2008,1,2);datenum(2007,1,2)], [1;-1]), [datenum(2008,1,3);datenum(2006,12,29)]) +## Alternate weekends +%!assert(busdate(datenum(2008,1,2), 1, holidays(datenum(2008,1,1), datenum(2008,1,31)), [1 0 0 0 0 0 0]), datenum(2008,1,3)) +%!assert(busdate(datenum(2008,1,4), 1, holidays(datenum(2008,1,1), datenum(2008,1,31)), [1 0 0 0 0 0 0]), datenum(2008,1,5)) +%!assert(busdate(datenum(2008,1,5), 1, holidays(datenum(2008,1,1), datenum(2008,1,31)), [1 0 0 0 0 0 0]), datenum(2008,1,7)) +%!assert(busdate(datenum(2008,1,6), 1, holidays(datenum(2008,1,1), datenum(2008,1,31)), [1 0 0 0 0 0 0]), datenum(2008,1,7)) +%!assert(busdate(datenum(2008,1,1), 1, holidays(datenum(2008,1,1), datenum(2008,1,31)), [1 1 1 1 1 1 0]), datenum(2008,1,5)) diff --git a/octave_packages/financial-0.4.0/busdays.m b/octave_packages/financial-0.4.0/busdays.m new file mode 100644 index 0000000..35aff3f --- /dev/null +++ b/octave_packages/financial-0.4.0/busdays.m @@ -0,0 +1,127 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{bdates} =} busdays (@var{sdate}, @var{edate}) +## @deftypefnx {Function File} {@var{bdates} =} busdays (@var{sdate}, @var{edate}, @var{bdmode}) +## @deftypefnx {Function File} {@var{bdates} =} busdays (@var{sdate}, @var{edate}, @var{bdmode}, @var{holvec}) +## Generate a list of business dates at the end of the periods defined +## between (including) @var{sdate} and @var{edate}. +## +## @var{sdate} is the starting date, @var{edate} is the ending date, +## both are in serial date format (see datenum). @var{bdmode} is the +## business day frequency ("daily", "weekly", "monthly", "quarterly", +## "semiannual", or "annual"); these can be abbreviated by the first +## letter and they may also use an integer corresponding to the order in +## the above list (i.e. "daily" = 1). @var{holvec} is an optional list +## of holidays. If the holidays are not given, then the holidays +## function is used. +## @seealso{holidays, busdate, lbusdate, isbusday, fbusdate, datenum} +## @end deftypefn + +function bd = busdays (sd, ed, mode=1, hol=[]) + + if nargin < 2 || nargin > 4 + print_usage (); + endif + if ~isnumeric (sd) + sd = datenum (sd); + endif + if ~isnumeric (ed) + ed = datenum (ed); + endif + if ed < sd + error ("busdays: the start date must be less than the end date") + endif + if isempty (hol) + ## make the holidays take into account the whole ending year because + ## the day may extend beyond the actual ending date + edtmp = datevec (ed); + edtmp(2:3) = [12 31]; + hol = holidays (sd, datenum (edtmp)); + endif + ## Convert the mode to the numeric + modestr = "dwmqsa"; + if ischar (mode) + mode = find (lower (mode(1)) == modestr); + if isempty (mode) + error ("busdays: mode must be one of '%s'", modestr) + endif + elseif isnumeric (mode) + if mode < 1 || mode > length (modestr) + error ("busdays: mode must be between 1 and %d", length (modestr)) + endif + else + error ("busdays: mode must be a number or string") + endif + + ## do the computation + if mode == 1 + ## daily + bd = (sd:ed)'(isbusday (sd:ed, hol)); + elseif mode < 6 + if mode == 2 + ## weekly make the start and end dates Fridays and then move back + ## from there + wd = weekday ([sd;ed]); + d = [sd;ed] - wd + 7; + ## there are generally not more than one week of holidays at a + ## time, but the call to unique will make certain of that. + bd = unique (busdate ([d(1):7:d(2)]', -1, hol)); + else + d = datevec ([sd:ed]); + ## unique year and month list within the date range + ym = unique (d(:,1:2), "rows"); + if mode == 3 + ## monthly, do nothing to the ym list + elseif mode == 4 + ## quarterly + if mod (ym(end), 3) != 0 + ## make the last month an end of quarter month + ym(end) = ym(end) + 3 - mod (ym(end), 3); + endif + ym(mod (ym(:,2), 3) != 0, :) = []; + elseif mode == 5 + ## semi-annually + if mod (ym(end), 6) != 0 + ## make the last month an end of semi-annual month (6, 12) + ym(end) = ym(end) + 6 - mod (ym(end), 6); + endif + ym(mod (ym(:,2), 6) != 0, :) = []; + endif + bd = lbusdate (ym(:,1), ym(:,2), hol); + endif + elseif mode == 6 + ## annual + d = datevec ([sd;ed]); + bd = lbusdate ((d(1,1):d(2,1))', 12, hol); + else + ## this should have been caught before now + error ("busdays: invalid mode") + endif + +endfunction + +## Tests +%!assert (busdays (datenum (2008, 1, 1), datenum (2008, 1, 12)), datenum (2008, 1, [2;3;4;7;8;9;10;11])) +%!assert (busdays (datenum (2008, 1, 1), datenum (2008, 1, 12), "d"), datenum (2008, 1, [2;3;4;7;8;9;10;11])) +%!assert (busdays (datenum (2001, 1, 2), datenum (2001, 1, 9), "w"), datenum (2001, 1, [5;12])) +%!assert (busdays (datenum (2008, 1, 1), datenum (2008, 1, 2), "m"), datenum (2008, 1, 31)) +%!assert (busdays (datenum (2008, 1, 1), datenum (2010, 5, 2), "m"), lbusdate ([2008*ones(12,1);2009*ones(12,1);2010*ones(5,1)], [1:12 1:12 1:5]')) +%!assert (busdays (datenum (2008, 1, 1), datenum (2008, 1, 2), "q"), datenum (2008, 3, 31)) +%!assert (busdays (datenum (2008, 1, 1), datenum (2010, 5, 2), "q"), lbusdate ([2008*ones(4,1);2009*ones(4,1);2010*ones(2,1)], [3:3:12 3:3:12 3 6]')) +%!assert (busdays (datenum (2008, 1, 1), datenum (2008, 1, 2), "s"), datenum (2008, 6, 30)) +%!assert (busdays (datenum (2008, 1, 1), datenum (2010, 5, 2), "s"), lbusdate ([2008;2008;2009;2009;2010], [6 12 6 12 6]')) +%!assert (busdays (datenum (2008, 1, 1), datenum (2011, 1, 2), "a"), datenum ([2008;2009;2010;2011], [12;12;12;12], [31;31;30;30])) diff --git a/octave_packages/financial-0.4.0/cfconv.m b/octave_packages/financial-0.4.0/cfconv.m new file mode 100644 index 0000000..4d1d084 --- /dev/null +++ b/octave_packages/financial-0.4.0/cfconv.m @@ -0,0 +1,60 @@ +## Copyright (C) 2011 Hong Yu +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{cfConv} =} cfconv (@var{cf}, @var{yield}) +## Calculate convexity @var{cfConv} from given fixed-paid cash flow @var{cf} and +## period yield @var{yield}. +## +## Reference: +## +## [1] http://thismatter.com/money/bonds/duration-convexity.htm +## +## [2] http://en.wikipedia.org/wiki/Bond_convexity +## +## @seealso{cfdur} +## @end deftypefn + +function [cfConv] = cfconv (cf, yield) + + if ( nargin != 2 ) + print_usage (); + elseif ( ! isscalar(yield) ) + error("yield: must be scalar"); + elseif ( rows(cf) != 1 ) + error("Cash Flow: must be 1xN"); + endif + + v_idx = 1:columns(cf); + t1 = (1+yield) .^ (-v_idx); + t2 = ((v_idx .^ 2) + v_idx) .* t1; + + cfConv = (cf*t2') / (cf*t1') / (1+yield) / (1+yield); + +endfunction + +%!demo +%! cf = [2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 102.5]; +%! yield = 0.025; +%! cfConv = cfconv( cf, yield ) +%! %-------------------------------------------------- +%! % Input cash flow and yield, output convexity + +%!test +%! cf = [2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 102.5]; +%! cfConv = cfconv( cf, 0.025 ); +%! errVal = round(cfConv*(1e+4))*(1e-4) - 90.4493; +%! errVal = round(errVal*(1e+10)); +%! assert(errVal, 0) diff --git a/octave_packages/financial-0.4.0/cfdur.m b/octave_packages/financial-0.4.0/cfdur.m new file mode 100644 index 0000000..f6940c4 --- /dev/null +++ b/octave_packages/financial-0.4.0/cfdur.m @@ -0,0 +1,62 @@ +## Copyright (C) 2011 Hong Yu +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{dur}, @var{mod_dur}] =} cfdur (@var{cf}, @var{yield}) +## Calculate duration @var{dur} and modified duration @var{mod_dur}, from given +## fixed-paid cash flow @var{cf} and period yield @var{yield}. +## +## Reference: +## http://en.wikipedia.org/wiki/Bond_duration +## Using periodic compounding instead of continuous compounding. +## +## @seealso{cfconv} +## @end deftypefn + +function [dur, modDur] = cfdur (cf, yield) + + if ( nargin != 2 ) + print_usage (); + elseif ( ! isscalar(yield) ) + error("input yield must be a scalar"); + endif + + if ( rows(1) != 1 ) + error("input cash flow must be a 1xN matrix"); + endif + + v_idx = 1:columns(cf); + t1 = (1+yield) .^ (-v_idx); + t2 = v_idx .* t1; + + dur = (cf*t2') / (cf*t1'); + modDur = dur / (1+yield); + +endfunction + +%!demo +%! cf = [2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 102.5]; +%! yield = 0.025; +%! [ duration, modDuration ] = cfdur( cf, yield ) +%! %-------------------------------------------------- +%! % Input cash flow and yield, output duration and modified duration + +%!test +%! cf = [2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 2.5 102.5]; +%! [dur modDur] = cfdur( cf, 0.025 ); +%! errVal1 = round(dur*(1e+4))*(1e-4) - 8.9709; +%! errVal2 = round(modDur*(1e+4))*(1e-4) - 8.7521; +%! assert( errVal1, 0 ) +%! assert( errVal2, 0 ) diff --git a/octave_packages/financial-0.4.0/corr2cov.m b/octave_packages/financial-0.4.0/corr2cov.m new file mode 100644 index 0000000..4e68a0c --- /dev/null +++ b/octave_packages/financial-0.4.0/corr2cov.m @@ -0,0 +1,55 @@ +## Copyright (C) 2011 Hong Yu +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{cov} =} corr2cov (@var{sigma}, @var{corr}) +## Convert standard deviation @var{sigma} and correlation coefficients @var{corr} +## to covariance @var{cov}. +## +## Note that the rate @var{r} is specified as a fraction (i.e., 0.05, +## not 5 percent). +## @seealso{corrcoef, cov, cov2corr, std} +## @end deftypefn + +function ret = corr2cov (sigma, corr) + + if ( nargin != 2 ) + print_usage (); + elseif ( rows(corr) != columns(corr) || ndims(corr) != 2 ) + error("correlation coefficients must be a NxN matrix"); + elseif ( rows(sigma) != 1 || ndims(sigma) != 2 ) + error("sigma must be a 1xN vector (single row) with the standard deviation values"); + elseif ( columns(sigma) < columns(1) ) + error("sigma: must be 1xN \ncorr: must be NxN"); + endif + + sigma = sigma(:); + ret = corr .* (sigma * sigma'); + +endfunction + +%!demo +%! sigma = [ 0.5 2.0 ]; +%! corr = [ 1.0 -0.5; -0.5 1.0 ]; +%! cov = corr2cov( sigma, corr ) +%! %-------------------------------------------------- +%! % Input standard deviations and correlation matrix, output covariance +%! % matrix + +%!test +%! sigma = [0.5 2.0]; +%! corr = [1.0 -0.5; -0.5 1.0]; +%! cov = corr2cov( sigma, corr ); +%! assert( cov, [ 0.25 -0.5; -0.5 4.0 ] ) diff --git a/octave_packages/financial-0.4.0/cov2corr.m b/octave_packages/financial-0.4.0/cov2corr.m new file mode 100644 index 0000000..8d6d5b6 --- /dev/null +++ b/octave_packages/financial-0.4.0/cov2corr.m @@ -0,0 +1,53 @@ +## Copyright (C) 2011 Hong Yu +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{sigma}, @var{corr}] =} cov2corr (@var{cov}) +## Convert covariance @var{cov} from input to standard deviation @var{sigma} and +## correlation coefficients @var{corr}. +## +## @seealso{corr2cov, corrcoef, cov, std} +## @end deftypefn + +function [sigma, corr] = cov2corr (cov_m) + + if ( nargin != 1 ) + print_usage (); + elseif ( ndims (cov_m) != 2 || rows(cov_m) != columns(cov_m) ) + error("covariances must be a NxN matrix"); + endif + + sigma = diag(cov_m); + if ( min(sigma) <= 0 ) + error("covariance: must have all positive values along the diagonal") + endif + + sigma = sqrt(sigma)'; + corr = cov_m ./ ( sigma' * sigma ); + +endfunction + +%!demo +%! cov = [ 0.25 -0.5; -0.5 4.0 ]; +%! [ sigma, corr ] = cov2corr( cov ) +%! %-------------------------------------------------- +%! % Input covariance matrix, output standard deviations and correlation +%! % matrix + +%!test +%! cov = [ 0.25 -0.5; -0.5 4.0 ]; +%! [sigma, corr] = cov2corr( cov ); +%! assert( sigma, [0.5 2.0] ) +%! assert( corr, [1.0 -0.5; -0.5 1.0] ); diff --git a/octave_packages/financial-0.4.0/dateaxis.m b/octave_packages/financial-0.4.0/dateaxis.m new file mode 100644 index 0000000..5711ca9 --- /dev/null +++ b/octave_packages/financial-0.4.0/dateaxis.m @@ -0,0 +1,101 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} dateaxis () +## @deftypefnx {Function File} {} dateaxis (@var{ax}) +## @deftypefnx {Function File} {} dateaxis (@var{ax}, @var{dateform}) +## @deftypefnx {Function File} {} dateaxis (@var{ax}, @var{dateform}, @var{startdate}) +## @deftypefnx {Function File} {} dateaxis (@var{h}, ...) +## +## Convert the current axis tick labels (or the axis handle @var{h}) to +## a date format. The axis given by @var{ax} ("x", "y", or "z") will be +## changed; the default is "x". The date format, @var{dateform}, used +## will be either auto-determined or an integer corresponding to the +## date formats in datestr. If @var{startdate} is given, then the first +## tick value on the given axis is assumed to be that date. +## +## @seealso{bolling, candle, highlow, movavg, pointfig} +## @end deftypefn + +function dateaxis (varargin) + + ## defaults + h = []; + ax = "x"; + dateform = []; + startdate = []; + + ## check inputs + if nargin > 0 + if ishandle(varargin{1}) + h = varargin{1}; + varargin(1) = []; + endif + if length(varargin) > 0 + ax = varargin{1}; + endif + if length(varargin) > 1 + dateform = varargin{2}; + endif + if length(varargin) > 2 + startdate = varargin{3}; + if ischar(startdate) + startdate = datenum(startdate); + elseif !isnumeric(startdate) + error ("dateaxis: startdate must be either a datenum or numeric") + endif + endif + if length(varargin) > 3 + print_usage (); + endif + endif + + if (isempty (h)) + h = gca (); + endif + + if isempty(dateform) + r = range(get(h, [ax "lim"])); + if r < 10/60/24 + ## minutes and seconds + dateform = 13; + elseif r < 2 + ## hours + dateform = 15; + elseif r < 15 + ## days + dateform = 8; + elseif r < 365 + ## months + dateform = 6; + elseif r < 90*12 + ## quarters + dateform = 27; + else + ## years + dateform = 10; + endif + endif + + ticks = get (h, [ax "tick"]); + if (!isempty (startdate)) + ticks = ticks - ticks(1) + startdate; + endif + ticks = datestr(ticks, dateform); + ticks = mat2cell(ticks, ones(size(ticks,1),1), size(ticks,2)); + set (h, [ax "ticklabel"], ticks); + +endfunction diff --git a/octave_packages/financial-0.4.0/datefind.m b/octave_packages/financial-0.4.0/datefind.m new file mode 100644 index 0000000..30a97a2 --- /dev/null +++ b/octave_packages/financial-0.4.0/datefind.m @@ -0,0 +1,44 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {indices =} datefind (subset, superset, tol) +## +## Find any instances of the @code{subset} in the @code{superset} with +## the @code{tol}erance. @code{tol} is 0 by default. +## +## @seealso{date, datenum} +## @end deftypefn + +function idx = datefind (subset, superset, tol=0) + + if (nargin < 2 || nargin > 3) + print_usage (); + elseif ! isscalar (tol) + error ("datefind: tol must be a scalar") + endif + + idx = []; + for i = 1:numel (superset) + if any (subset(:) - tol <= superset(i) & superset(i) <= subset(:) + tol) + idx(end+1, 1) = i; + endif + endfor + +endfunction + +## Tests +%!assert (datefind (datenum (1999, 7, [10;20]), datenum (1999, 7, 1:31)), [10;20]) +%!assert (datefind (datenum (1999, 7, [10;20]), datenum (1999, 7, 1:31), 1), [9;10;11;19;20;21]) diff --git a/octave_packages/financial-0.4.0/datesplit.m b/octave_packages/financial-0.4.0/datesplit.m new file mode 100644 index 0000000..84ecf32 --- /dev/null +++ b/octave_packages/financial-0.4.0/datesplit.m @@ -0,0 +1,492 @@ +## Copyright (C) 2001 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {Y =} datesplit(date, P) +## @deftypefnx {Function File} {[Y,M,D,h,m,s] =} datesplit(date, P) +## Split a date string into the Year, Month, Day, hour, minute, and +## second. This routine tries to be as forgiving as possible to the +## date input while requiring that the date is not ambiguous. +## +## Anywhere possible where it would not be ambiguous, efforts were made +## to make times possible with seconds and AM/PM as optional. Also, +## along the same lines, where possible, commas were allowed with +## spaces, and the year/month/day separators were allowed as period (.), +## slash (/), and dash (-). Not all format possibilities are shown in +## the following table, but a date like @code{dd-mmm-yyyy HH:MM:SS} is +## parsed just as well as @code{d/mmm.yyyy, ,H:MM, AM}. +## +## Supported @code{date} formats include (the same as datestr): +## @multitable @columnfractions 0.1 0.45 0.45 +## @item @strong{Code} @tab @strong{Format} @tab @strong{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 6 @tab mm/dd @tab 09/13 +## @item 10 @tab yyyy @tab 2000 +## @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 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 +## +## The parameter @code{P} is needed to convert date strings with 2 digit +## years into dates with 4 digit years. 2 digit years are assumed to be +## between @code{P} and @code{P+99}. If @code{P} is not given then the +## current year - 50 is used, so that dates are centered on the present. +## For birthdates, you would want @code{P} to be current year - 99. For +## appointments, you would want @code{P} to be current year. +## +## This function makes no strong attempt to verify the accuracy of the +## numbers that it returns in that it doesn't (currently) check to see +## that you're not trying to use the date Feb 30. When applicable, it +## tries to make your input work, though. It will try to determine if +## you're using the date "03/13/95" that the date is "March 13, 1995", +## but if there is doubt, datesplit will return an error instead of +## trying to guess the wrong value. +## +## @seealso{date,clock,now,datestr,datenum,calendar,weekday} +## @end deftypefn + +## TODO: +## * Some formats are ambiguous. Allow the user to specify the format +## to remove ambiguity. +## * Validate the dates. +## * Possible bug (after dates are validated): There are times where +## the year is assumed, Feb 29 may be a valid date, but with the +## assumed year, it may become invalid. +## * Internationalize. Not all months use the English system. +## * Vectorize. That requires vectorization of regexp though... + +function [y, m, d, h, mi, s] = datesplit(ds, P) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "`datesplit' has been deprecated in favor of `datevec' from Octave core. This function will be removed from future versions of the `financial' package"); + endif + + if nargin < 2 + P = []; + endif + + today = datevec(now); + + if (isempty(P)) + P = today(1)-50; + endif + + global __month_names = ["Jan";"Feb";"Mar";"Apr";"May";"Jun";... + "Jul";"Aug";"Sep";"Oct";"Nov";"Dec"]; + global __day_names = ["Sun";"Mon";"Tue";"Wed";"Thu";"Fri";"Sat"]; + global __time_names = ["AM";"PM"]; + + if (iscellstr(ds)) + ds = ds{1}; + endif + ds = tolower(deblank(ds)); + + if (nargin < 1) + error("datesplit: no input arguments"); + elseif (nargin == 1) + fmt = []; + endif + %% we have to determine the format, this could be error prone + + ## format 0 dd-mmm-yyyy HH:MM:SS e.g. 07-Sep-2000 15:38:09 + [match, d, m, y, h, mi, s, ap] = \ + of_regexp("^(3[01]|[0-2]?[0-9])[-./]([a-z]{3})[-./]([0-9]{4})[, ]+(2[0-3]|[01]?[0-9]):([0-5][0-9])(:[0-5][0-9]|)[, ]*([ap]m|)$", ds); + + ## format 21 mmm.dd.yyyy HH:MM:SS e.g. Mar.03.1962 13:53:06 + if (isempty(match)) + [match, m, d, y, h, mi, s, ap] = \ + of_regexp("^([a-z]{3})[-./](3[01]|[0-2]?[0-9])[-./]([0-9]{4})[, ]+(2[0-3]|[01]?[0-9]):([0-5][0-9])(:[0-5][0-9]|)[, ]*([ap]m|)$", ds); + endif + + ## format 31 yyyy-mm-dd HH:MM:SS e.g. 2004-03-13 13:26:03 + if (isempty(match)) + [match, y, m, d, h, mi, s, ap] = \ + of_regexp("^([0-9]{4})[-./](1[012]|0?[0-9])[-./](3[01]|[0-2]?[0-9])[, ]+(2[0-3]|[01]?[0-9]):([0-5][0-9])(:[0-5][0-9]|)[, ]*([ap]m|)$", ds); + endif + + ## format 30 yyyymmddTHHMMSS e.g. 20470313T132603 + if (isempty(match)) + [match, y, m, d, h, mi, s] = \ + of_regexp("^([0-9]{4})(1[012]|0[0-9])(3[01]|[012][0-9])t(2[0-3]|[01][0-9])([0-5][0-9])([0-5][0-9])$", ds); + ap = "NA"; + endif + + ## format 13 HH:MM:SS e.g. 15:38:09 + ## format 14 HH:MM:SS PM e.g. 03:38:09 PM + ## format 15 HH:MM e.g. 15:38 + ## format 16 HH:MM PM e.g. 03:38 PM + if (isempty(match)) + [match, h, mi, s, ap] = \ + of_regexp("^(2[0-3]|[01]?[0-9]):([0-5][0-9])(:[0-5][0-9]|)[, ]*([ap]m|)$", ds); + + if (! isempty(match)) + %% assume that it is as of today + y = today(1); + m = today(2); + d = today(3); + endif + endif + + ## format 1 dd-mmm-yyyy e.g. 07-Sep-2000 + if (isempty(match)) + [match, d, m, y] = \ + of_regexp("^(3[01]|[012]?[0-9])[-./]([a-z]{3})[-./]([0-9]{4})$", ds); + + if (! isempty(match)) + %% assume the beginning of the day + h = 0; + mi = 0; + s = 0; + ap = "NA"; + endif + endif + + ## format 22 mmm.dd.yyyy e.g. Mar.03.1962 + if (isempty(match)) + [match, m, d, y] = \ + of_regexp("^([a-z]{3})[-./](3[01]|[012]?[0-9])[-./]([0-9]{4})$", ds); + + if (! isempty(match)) + %% assume the beginning of the day + h = 0; + mi = 0; + s = 0; + ap = "NA"; + endif + endif + + ## format 2 mm/dd/yy e.g. 09/07/00 + ## format 23 mm/dd/yyyy e.g. 03/13/1962 + ## format 20 dd/mm/yy e.g. 13/03/95 + ## format 24 dd/mm/yyyy e.g. 12/03/1962 + ## format 25 yy/mm/dd e.g. 95/03/13 + ## format 26 yyyy/mm/dd e.g. 1995/03/13 + if (isempty(match)) + [match, d, m, y] = \ + of_regexp("^([0-9]{1,2}|[0-9]{4})[-./](3[01]|[012]?[0-9])[-./]([0-9]{1,2}|[0-9]{4})$", ds); + + if (! isempty(match)) + %% we have to determine if the date is unambiguous + d = str2num(d); + m = str2num(m); + y = str2num(y); + + if ((y == 0) || (y > 31)) + %% we've got the year correct + if ((m > 12) && (d < 13)) + %% we're operating on mm/dd/yyyy + tmp = m; + m = d; + d = tmp; + elseif ((m < 13) && (d > 12)) + %% it's fine + else + %% it's ambiguous + error(["datesplit: ambiguous date " ds]); + endif + elseif ((d == 0) || (d > 31)) + %% the day and the year need to be switched + tmp = y; + y = d; + d = tmp; + else + %% it's ambiguous + error(["datesplit: ambiguous date " ds]); + endif + + %% assume the beginning of the day + h = 0; + mi = 0; + s = 0; + ap = "NA"; + endif + + endif + + ## format 29 yyyymmdd e.g. 20470313 + if (isempty(match)) + [match, y, m, d] = \ + of_regexp("^([0-9]{4})(1[012]|0?[0-9])(3[01]|[012][0-9])$", ds); + %% I've never seen a date that has the year first that was not + %% yyyy/mm/dd, so I'm going to assume that it's unambiguous. + + if (! isempty(match)) + %% assume the beginning of the day + h = 0; + mi = 0; + s = 0; + ap = "NA"; + endif + endif + + ## format 17 QQ-YY e.g. Q3-00 + ## format 27 QQ-YYYY e.g. Q4-2132 + if (isempty(match)) + [match, q, y] = \ + of_regexp("^q([1-4])[-./]([0-9]{2}|[0-9]{4})$", ds); + if (! isempty(match)) + %% Assume that it's the end of the quarter + q = str2num(q); + m = 3*q; + dayopts = [31 30 30 31]; + d = dayopts(q); + + %% assume the end of the day + h = 23; + mi = 59; + s = 59; + ap = "NA"; + endif + endif + + ## format 28 mmmyyyy e.g. Mar2047 + ## format 12 mmmyy e.g. Sep00 + if (isempty(match)) + [match, m, y] = \ + of_regexp("^([a-z]{3})([0-9]{2}|[0-9]{4})$", ds); + if (! isempty(match)) + %% assume the beginning of the month + d = 1; + h = 0; + mi = 0; + s = 0; + ap = "NA"; + endif + endif + + ## format 6 mm/dd e.g. 09/07 + ## format 19 dd/mm e.g. 13/03 + if (isempty(match)) + [match, m, d] = \ + of_regexp("^(3[01]|[012]?[0-9])[-./](3[01]|[012][0-9])$", ds); + + if (! isempty(match)) + m = str2num(m); + d = str2num(d); + + %% we have to determine if the date is unambiguous + if ((m > 12) && (d < 13)) + %% we're operating on mm/dd/yyyy + tmp = m; + m = d; + d = tmp; + elseif ((m < 13) && (d > 12)) + %% it's fine + else + %% it's ambiguous + error(["datesplit: ambiguous date " ds]); + endif + %% assume this year and the beginning of the day + y = today(1); + h = 0; + mi = 0; + s = 0; + ap = "NA"; + endif + endif + + ## format 10 yyyy e.g. 2000 + if (isempty(match)) + [match, y] = of_regexp("^([0-9]{4})$", ds); + + if (! isempty(match)) + %% assume the beginning of the year + m = 1; + d = 1; + h = 0; + mi = 0; + s = 0; + ap = "NA"; + endif + endif + + ## format 3 mmm e.g. Sep + if (isempty(match)) + m = strmatch(ds, tolower(__month_names)); + + if (! isempty(m)) + match = 1; + %% assuming the beginning of the month, this year + y = today(1); + d = 1; + h = 0; + mi = 0; + s = 0; + ap = "NA"; + endif + endif + + ## format 8 ddd e.g. Thu + %% People shouldn't use this function for something like this + + if (isempty(match)) + %% you mean I did all that work, and you still didn't use a valid + %% date? Darn you! + error(["datesplit: Unknown date format " ds]); + endif + + if (! isempty(match)) + if isempty(s) + s = 0; + elseif (ischar(s) && (1 == findstr(s,":"))) + s = s(2:3); + endif + if isempty(ap) + ap = "NA"; + endif + endif + + %% start converting the date from characters to numbers + if (ischar(y)) + y = str2num(y); + if (isempty(y)) + error(["datesplit: Invalid year specification " y]); + endif + endif + %% Handle Y2K issues... + if (y < 100) + y = y + 1900; + if (y < P) + y = y + 100; + endif + endif + + if (ischar(m)) + m_num = str2num(m); + if (isempty(m_num)) + m = strmatch(m, tolower(__month_names)); + else + m = m_num; + endif + if (isempty(m)) + error(["datesplit: Invalid month specification"]); + endif + endif + + if (ischar(d)) + d = str2num(d); + if (isempty(d)) + error(["datesplit: Invalid day specification " d]); + endif + endif + + if (ischar(h)) + h = str2num(h); + if (isempty(h)) + error(["datesplit: Invalid hour specification " h]); + elseif ((ap(2) == "M") && (h > 12)) + error(["datesplit: Invalid hour specification, AM or PM specified but" + "hour is greater than 12."]); + endif + + if (strcmpi(ap, "PM") && (h < 12)) + h = h + 12; + elseif (strcmpi(ap, "AM") && (h == 12)) + h = 0; + endif + endif + + if (ischar(mi)) + mi = str2num(mi); + if (isempty(mi) || (mi > 59)) + error(["datesplit: Invalid minute specification " mi]); + endif + endif + + if (ischar(s)) + s = str2num(s); + if (isempty(s) || (s > 59)) + error(["datesplit: Invalid second specification " s]); + endif + endif + + if (nargout <= 1) + y = [y, m, d, h, mi, s]; + endif + +endfunction + +# wrapper around Octave's regexp +# compatible with octave-forge's regexp + +function varargout = of_regexp(pattern,string) + [S, E, TE, M, T, NM] = regexp(string,pattern); + varargout{1} = S; + + # return sub-strings if match + if (S) + for i=2:nargout + varargout{i} = T{1}{i-1}; + end + else + for i=2:nargout + varargout{i} = []; + end + end +endfunction + + +%!shared nowvec +%! nowvec=datevec(now); % Some tests could fail around midnight! +%!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("1 Jan 2000"),[2000,1,1,0,0,0]); +%!assert (datevec("Sep00"),[2000,9,1,0,0,0]); +%!assert (datevec("15:38:09"),[nowvec(1:3),15,38,9]); +%!assert (datevec("03:38:09 PM"),[nowvec(1:3),15,38,9]); +%!assert (datevec("15:38"),[nowvec(1:3),15,38,0]); +%!assert (datevec("3:38 PM"),[nowvec(1:3),15,38,0]); +%!assert (datevec("03/13/1962"),[1962,3,13,0,0,0]); + +## Ambiguous +%!#assert (datevec("09/07/00"),[2000,9,7,0,0,0]); +%!#assert (datevec("09/13"),[nowvec(1),9,13,0,0,0]); + +## Not supported in octave version of datevec +%!#assert (datevec("Sep"),[nowvec(1),9,1,0,0,0]); +%!#assert (datevec("Q3-00"),[2000,9,30,23,59,59]); +%!#assert (datevec("Q4-2132"),[2132,12,31,23,59,59]); + +## This should be a standard string (without or without the time) +%!assert (datevec("Mar.03.1962 13:53:06","mmm.dd.yyyy HH:MM:SS"),[1962,3,3,13,53,6]); + +## No longer a predefined string to parse the date in octave version +%!assert (datevec("1995/03/13","yyyy/mm/dd"),[1995,3,13,0,0,0]); +%!assert (datevec("Mar2047","mmmyyyy"),[2047,3,1,0,0,0]); +%!assert (datevec("20470313","yyyymmdd"),[2047,3,13,0,0,0]); +%!assert (datevec("20470313T132603","yyyymmddTHHMMSS"),[2047,3,13,13,26,3]); +%!assert (datevec("1047-03-13 13:26:03","yyyy-mm-dd HH:MM:SS"),[1047,3,13,13,26,3]); diff --git a/octave_packages/financial-0.4.0/day.m b/octave_packages/financial-0.4.0/day.m new file mode 100644 index 0000000..4f83cf7 --- /dev/null +++ b/octave_packages/financial-0.4.0/day.m @@ -0,0 +1,31 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {dom =} day (Date) +## +## Returns the day of the month from a serial date number or a date +## string. +## +## @seealso{date, datevec, now, month, year} +## @end deftypefn + +function t = day (dates) + + t = datevec (dates); + t = t (:,3); + +endfunction + diff --git a/octave_packages/financial-0.4.0/daysact.m b/octave_packages/financial-0.4.0/daysact.m new file mode 100644 index 0000000..69e6d52 --- /dev/null +++ b/octave_packages/financial-0.4.0/daysact.m @@ -0,0 +1,76 @@ +## Copyright (C) 2007 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} daysact (@var{d1}) +## @deftypefnx {Function File} {} daysact (@var{d1}, @var{d2}) +## Calculates the number of days between two dates. If the second date is not +## given, calculate the number of days since 1-Jan-0000. The variables @var{d1} +## and @var{d2} can either be strings or an @var{n}-row string matrix. If both +## @var{d1} and @var{d2} are string matrices, then the number of rows must +## match. An example of the use of @code{daysact} is +## +## @example +## @group +## daysact ("01-Jan-2007", ["10-Jan-2007"; "23-Feb-2007"; "23-Jul-2007"]) +## @result{} 9 +## 53 +## 203 +## @end group +## @end example +## @seealso{datenum} +## @end deftypefn + +function days = daysact (d1, d2) + if (nargin == 1) + nr = size (d1, 1); + if (nr != 1) + days = zeros (nr,1); + for i = 1 : nr + days (i) = datenum (d1 (i,:)); + endfor + else + days = datenum(d1); + endif + elseif (nargin == 2) + nr1 = size (d1, 1); + nr2 = size (d2, 1); + if (nr1 != nr2 && nr1 != 1 && nr2 != 1) + error ("daysact: size mismatch"); + endif + if (nr1 == 1 && nr2 == 1) + days = datenum (d2) - datenum(d1); + elseif (nr1 == 1) + days = zeros (nr2, 1); + for i = 1 : nr2 + days(i) = datenum (d2 (i,:)) - datenum (d1); + endfor + elseif (nr2 == 1) + days = zeros (nr1, 1); + for i = 1 : nr1 + days(i) = datenum (d2) - datenum (d1 (i,:)); + endfor + else + days = zeros (nr1, 1); + for i = 1 : nr1 + days(i) = datenum (d2 (i, :)) - datenum (d1 (i,:)); + endfor + endif + else + print_usage(); + endif +endfunction + +%!assert (daysact ("01-Jan-2007", ["10-Jan-2007"; "23-Feb-2007"; "23-Jul-2007"]),[9;53;203]) diff --git a/octave_packages/financial-0.4.0/doc-cache b/octave_packages/financial-0.4.0/doc-cache new file mode 100644 index 0000000..8dc2a9f --- /dev/null +++ b/octave_packages/financial-0.4.0/doc-cache @@ -0,0 +1,2059 @@ +# Created by Octave 3.6.1, Sat Apr 28 20:53:21 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 57 +# name: +# type: sq_string +# elements: 1 +# length: 7 +bolling + + +# name: +# type: sq_string +# elements: 1 +# length: 716 + -- Function File: bolling (ASSET, SAMPLES) + -- Function File: bolling (ASSET, SAMPLES, ALPHA) + -- Function File: bolling (ASSET, SAMPLES, ALPHA, WIDTH) + -- Function File: [MOVAVG, UPPERBAND, LOWERBAND] = bolling (ASSET, + SAMPLES, ...) + If no output is requested, plot the bollinger bands of the ASSET. + If output is requested, return the values for the bollinger bands. + If given, ALPHA is the weighting power of the moving average; 0 + (default) is the simple moving average, see `movavg' for the full + definition. WIDTH is the number of standard deviations to plot + above and below the moving average (default: 2). + + See also: movavg, candle, dateaxis, highlow, pointfig + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 +If no output is requested, plot the bollinger bands of the ASSET. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +busdate + + +# name: +# type: sq_string +# elements: 1 +# length: 833 + -- Function File: b = busdate (refdate) + -- Function File: b = busdate (refdate, direction) + -- Function File: b = busdate (refdate, direction, holiday) + -- Function File: b = busdate (refdate, direction, holiday, weekend) + Return the datenum of the next or previous business day from + REFDATE. DIRECTION indicates the next day (default) if 1 and the + previous day if -1. HOLIDAY is a vector of datenums that defines + the holidays observed (the holidays function is used if not + given). WEEKEND defines the days of the week that should be + considered weekends; [1 0 0 0 0 0 1] (default) indicates that + Sunday and Saturday are holidays. + + If any of the optional inputs (DIRECTION, HOLIDAY, WEEKEND) are + empty, then the default is used. + + See also: holidays, lbusdate, isbusday, fbusdate + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +Return the datenum of the next or previous business day from REFDATE. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +busdays + + +# name: +# type: sq_string +# elements: 1 +# length: 870 + -- Function File: BDATES = busdays (SDATE, EDATE) + -- Function File: BDATES = busdays (SDATE, EDATE, BDMODE) + -- Function File: BDATES = busdays (SDATE, EDATE, BDMODE, HOLVEC) + Generate a list of business dates at the end of the periods defined + between (including) SDATE and EDATE. + + SDATE is the starting date, EDATE is the ending date, both are in + serial date format (see datenum). BDMODE is the business day + frequency ("daily", "weekly", "monthly", "quarterly", + "semiannual", or "annual"); these can be abbreviated by the first + letter and they may also use an integer corresponding to the order + in the above list (i.e. "daily" = 1). HOLVEC is an optional list + of holidays. If the holidays are not given, then the holidays + function is used. + + See also: holidays, busdate, lbusdate, isbusday, fbusdate, datenum + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Generate a list of business dates at the end of the periods defined +between (inc + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +cfconv + + +# name: +# type: sq_string +# elements: 1 +# length: 305 + -- Function File: CFCONV = cfconv (CF, YIELD) + Calculate convexity CFCONV from given fixed-paid cash flow CF and + period yield YIELD. + + Reference: + + [1] http://thismatter.com/money/bonds/duration-convexity.htm + + [2] http://en.wikipedia.org/wiki/Bond_convexity + + See also: cfdur + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Calculate convexity CFCONV from given fixed-paid cash flow CF and +period yield Y + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +cfdur + + +# name: +# type: sq_string +# elements: 1 +# length: 329 + -- Function File: [DUR, MOD_DUR] = cfdur (CF, YIELD) + Calculate duration DUR and modified duration MOD_DUR, from given + fixed-paid cash flow CF and period yield YIELD. + + Reference: http://en.wikipedia.org/wiki/Bond_duration Using + periodic compounding instead of continuous compounding. + + See also: cfconv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Calculate duration DUR and modified duration MOD_DUR, from given +fixed-paid cash + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +corr2cov + + +# name: +# type: sq_string +# elements: 1 +# length: 279 + -- Function File: COV = corr2cov (SIGMA, CORR) + Convert standard deviation SIGMA and correlation coefficients CORR + to covariance COV. + + Note that the rate R is specified as a fraction (i.e., 0.05, not 5 + percent). + + See also: corrcoef, cov, cov2corr, std + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Convert standard deviation SIGMA and correlation coefficients CORR to +covariance + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +cov2corr + + +# name: +# type: sq_string +# elements: 1 +# length: 204 + -- Function File: [SIGMA, CORR] = cov2corr (COV) + Convert covariance COV from input to standard deviation SIGMA and + correlation coefficients CORR. + + See also: corr2cov, corrcoef, cov, std + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Convert covariance COV from input to standard deviation SIGMA and +correlation co + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +dateaxis + + +# name: +# type: sq_string +# elements: 1 +# length: 669 + -- Function File: dateaxis () + -- Function File: dateaxis (AX) + -- Function File: dateaxis (AX, DATEFORM) + -- Function File: dateaxis (AX, DATEFORM, STARTDATE) + -- Function File: dateaxis (H, ...) + Convert the current axis tick labels (or the axis handle H) to a + date format. The axis given by AX ("x", "y", or "z") will be + changed; the default is "x". The date format, DATEFORM, used will + be either auto-determined or an integer corresponding to the date + formats in datestr. If STARTDATE is given, then the first tick + value on the given axis is assumed to be that date. + + See also: bolling, candle, highlow, movavg, pointfig + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 77 +Convert the current axis tick labels (or the axis handle H) to a date +format. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +datefind + + +# name: +# type: sq_string +# elements: 1 +# length: 203 + -- Function File: indices = datefind (subset, superset, tol) + Find any instances of the `subset' in the `superset' with the + `tol'erance. `tol' is 0 by default. + + See also: date, datenum + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 74 +Find any instances of the `subset' in the `superset' with the +`tol'erance. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +datesplit + + +# name: +# type: sq_string +# elements: 1 +# length: 3210 + -- Function File: Y = datesplit(date, P) + -- Function File: [Y,M,D,h,m,s] = datesplit(date, P) + Split a date string into the Year, Month, Day, hour, minute, and + second. This routine tries to be as forgiving as possible to the + date input while requiring that the date is not ambiguous. + + Anywhere possible where it would not be ambiguous, efforts were + made to make times possible with seconds and AM/PM as optional. + Also, along the same lines, where possible, commas were allowed + with spaces, and the year/month/day separators were allowed as + period (.), slash (/), and dash (-). Not all format possibilities + are shown in the following table, but a date like `dd-mmm-yyyy + HH:MM:SS' is parsed just as well as `d/mmm.yyyy, ,H:MM, AM'. + + Supported `date' formats include (the same as datestr): + *Code* *Format* *Example* + 0 dd-mmm-yyyy HH:MM:SS 07-Sep-2000 15:38:09 + 1 dd-mmm-yyyy 07-Sep-2000 + 2 mm/dd/yy 09/07/00 + 3 mmm Sep + 6 mm/dd 09/13 + 10 yyyy 2000 + 12 mmmyy Sep00 + 13 HH:MM:SS 15:38:09 + 14 HH:MM:SS PM 03:38:09 PM + 15 HH:MM 15:38 + 16 HH:MM PM 03:38 PM + 17 QQ-YY Q3-00 + 19 dd/mm 13/03 + 20 dd/mm/yy 13/03/95 + 21 mmm.dd.yyyy HH:MM:SS Mar.03.1962 13:53:06 + 22 mmm.dd.yyyy Mar.03.1962 + 23 mm/dd/yyyy 03/13/1962 + 24 dd/mm/yyyy 12/03/1962 + 25 yy/mm/dd 95/03/13 + 26 yyyy/mm/dd 1995/03/13 + 27 QQ-YYYY Q4-2132 + 28 mmmyyyy Mar2047 + 29 yyyymmdd 20470313 + 30 yyyymmddTHHMMSS 20470313T132603 + 31 yyyy-mm-dd HH:MM:SS 1047-03-13 13:26:03 + + The parameter `P' is needed to convert date strings with 2 digit + years into dates with 4 digit years. 2 digit years are assumed to + be between `P' and `P+99'. If `P' is not given then the current + year - 50 is used, so that dates are centered on the present. For + birthdates, you would want `P' to be current year - 99. For + appointments, you would want `P' to be current year. + + This function makes no strong attempt to verify the accuracy of the + numbers that it returns in that it doesn't (currently) check to see + that you're not trying to use the date Feb 30. When applicable, it + tries to make your input work, though. It will try to determine if + you're using the date "03/13/95" that the date is "March 13, 1995", + but if there is doubt, datesplit will return an error instead of + trying to guess the wrong value. + + See also: date, clock, now, datestr, datenum, calendar, weekday + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 +Split a date string into the Year, Month, Day, hour, minute, and +second. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +day + + +# name: +# type: sq_string +# elements: 1 +# length: 169 + -- Function File: dom = day (Date) + Returns the day of the month from a serial date number or a date + string. + + See also: date, datevec, now, month, year + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 +Returns the day of the month from a serial date number or a date string. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +daysact + + +# name: +# type: sq_string +# elements: 1 +# length: 578 + -- Function File: daysact (D1) + -- Function File: daysact (D1, D2) + Calculates the number of days between two dates. If the second + date is not given, calculate the number of days since 1-Jan-0000. + The variables D1 and D2 can either be strings or an N-row string + matrix. If both D1 and D2 are string matrices, then the number of + rows must match. An example of the use of `daysact' is + + daysact ("01-Jan-2007", ["10-Jan-2007"; "23-Feb-2007"; "23-Jul-2007"]) + => 9 + 53 + 203 + + See also: datenum + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Calculates the number of days between two dates. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +easter + + +# name: +# type: sq_string +# elements: 1 +# length: 211 + -- Function File: [m, d] = easter (y) + -- Function File: datenum = easter (y) + Return the month (M) and day (D) of Easter in the Gregorial + calendar on a given year or years. + + See also: holidays + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the month (M) and day (D) of Easter in the Gregorial calendar on +a given + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +effrr + + +# name: +# type: sq_string +# elements: 1 +# length: 191 + -- Function File: RETURN = effrr (RATE, NUMPERIODS) + Compute the effective rate of return based on a nominal RATE over + a number of periods, NUMPERIODS. + + See also: irr, nomrr + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the effective rate of return based on a nominal RATE over a +number of pe + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +eomdate + + +# name: +# type: sq_string +# elements: 1 +# length: 169 + -- Function File: E = eomdate (Y, M) + Return the last day of the month M for the year Y in datenum + format. + + See also: datenum, datevec, weekday, eomday + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 68 +Return the last day of the month M for the year Y in datenum format. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +fbusdate + + +# name: +# type: sq_string +# elements: 1 +# length: 679 + -- Function File: b = fbusdate (year, month) + -- Function File: b = fbusdate (year, month, holiday) + -- Function File: b = fbusdate (year, month, holiday, weekend) + Return the datenum of the first business day of the YEAR and + MONTH. HOLIDAY is a vector of datenums that defines the holidays + observed (the holidays function is used if not given). WEEKEND + defines the days of the week that should be considered weekends; + [1 0 0 0 0 0 1] (default) indicates that Sunday and Saturday are + holidays. + + If any of the optional inputs (HOLIDAY, WEEKEND) are empty, then + the default is used. + + See also: holidays, lbusdate, isbusday, busdate + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 +Return the datenum of the first business day of the YEAR and MONTH. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +fetch + + +# name: +# type: sq_string +# elements: 1 +# length: 1237 + -- DATA =: fetch (CONN, SYMBOL) + -- DATA =: fetch (..., FIELDS) + -- DATA =: fetch (..., DATE) + -- DATA =: fetch (..., FROMDATE, TODATE) + -- DATA =: fetch (..., PERIOD) + -- [DATA, FIELDS] =: fetch (...) + Download stock data from a connection. + + FIELDS are the data fields to download and must come from the set + * "Symbol" + + * "Last" + + * "Date" + + * "Time" + + * "Change" + + * "Open" + + * "High", + + * "Low" + + * "Volume" + + As an output, FIELDS may be different than your request. This is + because there is mapping of field names from the data source to + the output, and what is returned is the source mapping to allow + validation. + + DATE is the date string or datenum for the requested data. If you + enter today's date, you will get yesterday's data. FROMDATE and + TODATE allow you to specify a date range for the data. + + PERIOD (default: "d") allows you to select the period for the data + which can be any of the below as long as they are supported by the + associated backend. + * 'd': daily + + * 'w': weekly + + * 'm': monthly (Yahoo only) + + * 'v': dividends (Yahoo only) + + See also: yahoo, google + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Download stock data from a connection. + + + +# name: +# type: sq_string +# elements: 1 +# length: 2 +fv + + +# name: +# type: sq_string +# elements: 1 +# length: 551 + -- Function File: fv (R, N, P, L, METHOD) + Return the future value at the end of period N of an investment + which consists of N payments of P in each period, assuming an + interest rate R. + + The optional argument L may be used to specify an additional + lump-sum payment. + + The optional argument METHOD may be used to specify whether the + payments are made at the end (`"e"', default) or at the beginning + (`"b"') of each period. + + Note that the rate R is specified as a fraction (i.e., 0.05, not 5 + percent). + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the future value at the end of period N of an investment which +consists o + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +fvl + + +# name: +# type: sq_string +# elements: 1 +# length: 254 + -- Function File: fvl (R, N, L) + Return the future value at the end of N periods of an initial lump + sum investment L, given a per-period interest rate R. + + Note that the rate R is specified as a fraction (i.e., 0.05, not 5 + percent). + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the future value at the end of N periods of an initial lump sum +investmen + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +google + + +# name: +# type: sq_string +# elements: 1 +# length: 414 + -- Function File: CONN = google () + -- Function File: CONN = google (URL, IPADDRESS, PORT) + Prepare a Google connection for the fetch command to get Google + historical quote data. + + If given, the URL must be "http://finance.google.com". The + IPADDRESS and PORT is the proxy ipaddress and port. These + parameters are currently ignored (with a warning if given). + + See also: fetch, yahoo + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Prepare a Google connection for the fetch command to get Google +historical quote + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +hhigh + + +# name: +# type: sq_string +# elements: 1 +# length: 287 + -- Function File: HHV = hhigh (DATA) + -- Function File: HHV = hhigh (DATA, NPERIODS) + -- Function File: HHV = hhigh (DATA, NPERIODS, DIM) + Compute the highest high value of DATA for the past NPERIODS + (default: 14) across the dimension, DIM (default: 1). + + See also: llow + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the highest high value of DATA for the past NPERIODS (default: +14) acros + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +highlow + + +# name: +# type: sq_string +# elements: 1 +# length: 471 + -- Function File: H = highlow (HIGH, LOW, CLOSE) + -- Function File: H = highlow (HIGH, LOW, CLOSE, OPEN) + -- Function File: H = highlow (HIGH, LOW, CLOSE, OPEN, COLOR) + Plot the HIGH, LOW, and CLOSE of a security. The CLOSE is plotted + as a tick to the right, and if OPEN is given and non-empty, it is + plotted as a tick to the left. The color can override the default + color for the plot. + + See also: bolling, candle, dateaxis, movavg, pointfig + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 +Plot the HIGH, LOW, and CLOSE of a security. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +holidays + + +# name: +# type: sq_string +# elements: 1 +# length: 586 + -- Function File: h = holidays (startdate, enddate) + Return a vector of datenums that were holidays between STARTDATE + and ENDDATE, inclusive. These holidays are trading holidays + observed by the NYSE according to its rule 51.10. It does not take + into account the exceptions for "unusual business conditions" or + for additional days that have been called as holidays for one-time + purposes. + + The complete list can be found at + http://www.chronos-st.org/NYSE_Observed_Holidays-1885-Present.html + + See also: busdate, lbusdate, isbusday, fbusdate + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return a vector of datenums that were holidays between STARTDATE and +ENDDATE, in + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +hour + + +# name: +# type: sq_string +# elements: 1 +# length: 154 + -- Function File: h = hour (Date) + Returns the hour from a serial date number or a date string. + + See also: date, datevec, now, minute, second + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 +Returns the hour from a serial date number or a date string. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +irr + + +# name: +# type: sq_string +# elements: 1 +# length: 266 + -- Function File: irr (P, I) + Return the internal rate of return of a series of payments P from + an initial investment I (i.e., the solution of `npv (r, p) = i'. + If the second argument is omitted, a value of 0 is used. + + See also: npv, pv, rate + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the internal rate of return of a series of payments P from an +initial inv + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +isbusday + + +# name: +# type: sq_string +# elements: 1 +# length: 551 + -- Function File: r = isbusday (refdate) + -- Function File: r = isbusday (refdate, holiday) + -- Function File: r = isbusday (refdate, holiday, weekend) + Return true if the REFDATE is a business date REFDATE. HOLIDAY is + a vector of datenums that defines the holidays observed (the + holidays function is used if not given). WEEKEND defines the days + of the week that should be considered weekends; [1 0 0 0 0 0 1] + (default) indicates that Sunday and Saturday are weekends. + + See also: holidays, lbusdate, busdate, fbusdate + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Return true if the REFDATE is a business date REFDATE. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +lbusdate + + +# name: +# type: sq_string +# elements: 1 +# length: 672 + -- Function File: b = lbusdate (year, month) + -- Function File: b = lbusdate (year, month, holiday) + -- Function File: b = lbusdate (year, month, holiday, weekend) + Return the datenum of the last business day of the YEAR and MONTH. + HOLIDAY is a vector of datenums that defines the holidays observed + (the holidays function is used if not given). WEEKEND defines the + days of the week that should be considered weekends; [1 0 0 0 0 0 + 1] (default) indicates that Sunday and Saturday are holidays. + + If any of the optional inputs (HOLIDAY, WEEKEND) are empty, then + the default is used. + + See also: holidays, fbusdate, isbusday, busdate + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +Return the datenum of the last business day of the YEAR and MONTH. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +llow + + +# name: +# type: sq_string +# elements: 1 +# length: 283 + -- Function File: LLV = llow (DATA) + -- Function File: LLV = llow (DATA, NPERIODS) + -- Function File: LLV = llow (DATA, NPERIODS, DIM) + Compute the lowest low value of DATA for the past NPERIODS + (default: 14) across the dimension, DIM (default: 1). + + See also: hhigh + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the lowest low value of DATA for the past NPERIODS (default: +14) across + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +lweekdate + + +# name: +# type: sq_string +# elements: 1 +# length: 277 + -- Function File: last = lweekdate (weekday, year, month, nextday) + Returns the last occurrence of WEEKDAY from the MONTH and YEAR. + If the optional NEXTDAY argument is given, then the week must also + contain NEXTDAY. + + See also: eomdate, nweekdate, weekday + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Returns the last occurrence of WEEKDAY from the MONTH and YEAR. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +m2xdate + + +# name: +# type: sq_string +# elements: 1 +# length: 966 + -- Function File: exceldatenums = m2xdate (datenums) + -- Function File: exceldatenums = m2xdate (datenums, convention) + -- Function File: exceldatenums = m2xdate (datenums, convention, + "ExcelBug") + Convert DATENUMS from the internal date format to the format used + by Microsoft Excel. If set to 0 (default, Excel for Windows), + CONVENTION specifies to use the Excel 1900 convention where Jan 1, + 1900 corresponds to Excel serial date number 1. If set to 1 + (Excel for Mac), CONVENTION specifies to use the Excel 1904 + convention where Jan 1, 1904 corresponds to Excel serial date + number 0. + + Note that this does not take into account the Excel bug where 1900 + is considered to be a leap year unless you give the "ExcelBug" + option. + + Excel does not represent dates prior to 1 January 1900 using this + format, so a warning will be issued if any dates preceed this date. + + See also: datenum, x2mdate + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Convert DATENUMS from the internal date format to the format used by +Microsoft E + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +minute + + +# name: +# type: sq_string +# elements: 1 +# length: 156 + -- Function File: m = minute (Date) + Returns the minute from a serial date number or a date string. + + See also: date, datevec, now, hour, second + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +Returns the minute from a serial date number or a date string. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +mirr + + +# name: +# type: sq_string +# elements: 1 +# length: 338 + -- Function File: RETURN = mirr (CASHFLOW, FINRATE, REINVESTRATE) + Compute the modified internal rate of return. Take periodic + CASHFLOWs as a vector and the finance rate, FINRATE, for negative + cash flows and a reinvestment rate, REINVESTRATE, for positive + cash flows. + + See also: irr, effrr, nomrr, pvvar, xirr + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Compute the modified internal rate of return. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +month + + +# name: +# type: sq_string +# elements: 1 +# length: 169 + -- Function File: mon = month (Date) + Returns the day of the month from a serial date number or a date + string. + + See also: date, datevec, now, day, year + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 +Returns the day of the month from a serial date number or a date string. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +months + + +# name: +# type: sq_string +# elements: 1 +# length: 514 + -- Function File: mos = months (startdate, enddate) + -- Function File: mos = months (startdate, enddate, endmonthflag) + Return the number of whole months between STARTDATE and ENDDATE. + ENDMONTHFLAG defaults to 1. + + If ENDMONTHFLAG is true, then if both the STARTDATE and the + ENDDATE are end of month dates and ENDDATE has fewer days in the + month than STARTDATE, ENDMONTHFLAG = 1 treats ENDDATE as the end + of a month, but ENDMONTHFLAG = 0 does not. + + See also: yeardays, yearfrac + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 +Return the number of whole months between STARTDATE and ENDDATE. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +movavg + + +# name: +# type: sq_string +# elements: 1 +# length: 726 + -- Function File: movavg (ASSET, LEAD, LAG) + -- Function File: movavg (ASSET, LEAD, LAG, ALPHA) + -- Function File: [SHORT, LONG] = movavg (ASSET, LEAD, LAG, ALPHA) + Calculate the LEADing and LAGging moving average of an ASSET. If + given, ALPHA is the weighting power of the delay; 0 (default) is + the simple moving average, 0.5 would be the square root weighted + moving average, 1 would be linear, 2 would be squared, ..., and + 'e' is the exponential moving average. + + If no output is requested the data is plotted. The plots are drawn + in the following order: asset, lag, lead. If output is requested, + no plot is generated. + + See also: bolling, candle, dateaxis, highlow, pointfig + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +Calculate the LEADing and LAGging moving average of an ASSET. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +negvolidx + + +# name: +# type: sq_string +# elements: 1 +# length: 570 + -- Function File: NVI = negvolidx (CLOSEPRICE, VOL) + -- Function File: NVI = negvolidx ([CLOSEPRICE VOL]) + -- Function File: NVI = negvolidx (CLOSEPRICE, VOL, INITNVI) + -- Function File: NVI = negvolidx ([CLOSEPRICE VOL], INITNVI) + Compute the negative volume index of a security based on its + closing price (CLOSEPRICE) and VOLume. They may be given as + separate arguments or as an nx2 matrix. If given, the INITNVI is + the starting value of the nvi (default: 100). + + The NVI will always be a column vector. + + See also: onbalvol, posvolidx + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the negative volume index of a security based on its closing +price (CLOS + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +nomrr + + +# name: +# type: sq_string +# elements: 1 +# length: 191 + -- Function File: RETURN = nomrr (RATE, NUMPERIODS) + Compute the nominal rate of return based on a effective RATE over + a number of periods, NUMPERIODS. + + See also: irr, effrr + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the nominal rate of return based on a effective RATE over a +number of pe + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +nper + + +# name: +# type: sq_string +# elements: 1 +# length: 579 + -- Function File: nper (R, P, A, L, METHOD) + Return the number of regular payments of P necessary to amortize A + loan of amount A and interest R. + + The optional argument L may be used to specify an additional + lump-sum payment of L made at the end of the amortization time. + + The optional argument METHOD may be used to specify whether + payments are made at the end ("E", default) or at the beginning + ("B") of each period. + + Note that the rate R is specified as a fraction (i.e., 0.05, not 5 + percent). + + See also: pv, pmt, rate, npv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the number of regular payments of P necessary to amortize A loan +of amoun + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +npv + + +# name: +# type: sq_string +# elements: 1 +# length: 577 + -- Function File: npv (R, P, I) + Net present value of a series of payments. + + Returns the net present value of a series of irregular (i.e., not + necessarily identical) payments P which occur at the ends of N + consecutive periods. R specifies the one-period interest rates and + can either be a scalar (constant rates) or a vector of the same + length as P. + + The optional argument I may be used to specify an initial + investment. + + Note that the rate R is specified as a fraction (i.e., 0.05, not 5 + percent). + + See also: irr, pv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 +Net present value of a series of payments. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +nweekdate + + +# name: +# type: sq_string +# elements: 1 +# length: 374 + -- Function File: last = nweekdate (n, weekday, year, month, nextday) + Returns the Nth occurrence of WEEKDAY from the MONTH and YEAR. If + the optional NEXTDAY argument is given, then the week must also + contain NEXTDAY. If N is greater than the number of occurrences + of that day in the month, 0 is returned. + + See also: eomdate, lweekdate, weekday + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +Returns the Nth occurrence of WEEKDAY from the MONTH and YEAR. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +onbalvol + + +# name: +# type: sq_string +# elements: 1 +# length: 412 + -- Function File: OBV = onbalvol (CLOSEPRICE, VOL) + -- Function File: OBV = onbalvol ([CLOSEPRICE VOL]) + Compute the on balance volume of a security based on its closing + price (CLOSEPRICE) and VOLume. They may be given as separate + arguments or as an nx2 matrix. + + The output will be a column vector, and the first number in the + output is always 0. + + See also: negvolidx, posvolidx + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the on balance volume of a security based on its closing price +(CLOSEPRI + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +pmt + + +# name: +# type: sq_string +# elements: 1 +# length: 451 + -- Function File: pmt (R, N, A, L, METHOD) + Return the amount of periodic payment necessary to amortize a loan + of amount a with interest rate R in N periods. + + The optional argument L may be used to specify a terminal lump-sum + payment. + + The optional argument METHOD may be used to specify whether + payments are made at the end ("E", default) or at the beginning + ("B") of each period. + + See also: pv, nper, rate + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the amount of periodic payment necessary to amortize a loan of +amount a w + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +pointfig + + +# name: +# type: sq_string +# elements: 1 +# length: 233 + -- Function File: pointfig (ASSET) + Plot the point figure chart of an ASSET. Upward price movements + are plotted as Xs and downward movements are plotted as Os. + + See also: bolling, candle, dateaxis, highlow, movavg + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Plot the point figure chart of an ASSET. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +posvolidx + + +# name: +# type: sq_string +# elements: 1 +# length: 570 + -- Function File: PVI = posvolidx (CLOSEPRICE, VOL) + -- Function File: PVI = posvolidx ([CLOSEPRICE VOL]) + -- Function File: PVI = posvolidx (CLOSEPRICE, VOL, INITPVI) + -- Function File: PVI = posvolidx ([CLOSEPRICE VOL], INITPVI) + Compute the positive volume index of a security based on its + closing price (CLOSEPRICE) and VOLume. They may be given as + separate arguments or as an nx2 matrix. If given, the INITPVI is + the starting value of the pvi (default: 100). + + The PVI will always be a column vector. + + See also: onbalvol, negvolidx + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the positive volume index of a security based on its closing +price (CLOS + + + +# name: +# type: sq_string +# elements: 1 +# length: 2 +pv + + +# name: +# type: sq_string +# elements: 1 +# length: 580 + -- Function File: pv (R, N, P, L, METHOD) + Returns the present value of an investment that will pay off P for + N consecutive periods, assuming an interest R. + + The optional argument L may be used to specify an additional + lump-sum payment made at the end of N periods. + + The optional argument METHOD may be used to specify whether + payments are made at the end (`"e"', default) or at the beginning + (`"b"') of each period. + + Note that the rate R is specified as a fraction (i.e., 0.05, not 5 + percent). + + See also: pmt, nper, rate, npv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Returns the present value of an investment that will pay off P for N +consecutive + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +pvl + + +# name: +# type: sq_string +# elements: 1 +# length: 268 + -- Function File: V = pvl (R, N, P) + Return the present value V of an investment that will pay off P in + one lump sum at the end of N periods, given the interest rate R. + + Note that the rate R is specified as a fraction (i.e., 0.05, not 5 + percent). + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the present value V of an investment that will pay off P in one +lump sum + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +rate + + +# name: +# type: sq_string +# elements: 1 +# length: 616 + -- Function File: R = rate (N, P, V) + -- Function File: R = rate (N, P, V, L) + -- Function File: R = rate (N, P, V, L, METHOD) + -- Function File: R = rate (N, P, V, METHOD) + Return the rate of return R on an investment of present value V + which pays P in N consecutive periods. + + The optional argument L may be used to specify an additional + lump-sum payment made at the end of N periods. + + The optional string argument METHOD may be used to specify whether + payments are made at the end (`"e"', default) or at the beginning + (`"b"') of each period. + + See also: pv, pmt, nper, npv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the rate of return R on an investment of present value V which +pays P in + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +rsindex + + +# name: +# type: sq_string +# elements: 1 +# length: 408 + -- Function File: RSI = rsindex (CLOSEPRICE) + -- Function File: RSI = rsindex (CLOSEPRICE, NPERIODS) + Compute the relative strength index (RSI) of an asset from the + vector of closing prices (CLOSEPRICE). NPERIODS defines the + number of periods that the rsi should be calculated for (default: + 14). + + The beginning of the RSI is padded with nans to match the size of + CLOSEPRICE. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the relative strength index (RSI) of an asset from the vector +of closing + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +second + + +# name: +# type: sq_string +# elements: 1 +# length: 156 + -- Function File: s = second (Date) + Returns the second from a serial date number or a date string. + + See also: date, datevec, now, hour, minute + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +Returns the second from a serial date number or a date string. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +taxedrr + + +# name: +# type: sq_string +# elements: 1 +# length: 196 + -- Function File: RETURN = taxedrr (PRETAXRETURN, TAXRATE) + Compute the taxed rate of RETURN based on a PRETAXRETURN rate and + a TAXRATE. + + See also: irr, effrr, nomrr, pvvar, xirr + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 76 +Compute the taxed rate of RETURN based on a PRETAXRETURN rate and a +TAXRATE. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +thirdwednesday + + +# name: +# type: sq_string +# elements: 1 +# length: 391 + -- Function File: [begindate, enddate] = thirdwednesday (month, year) + Find the third Wednesday of the month specified by the MONTH and + YEAR. The BEGINDATE is the third Wednesday of the month, and the + ENDDATE is three months after that. Outputs are in the form of + datenums. + + The third Wednesday is used for Eurodollar futures. + + See also: nweekdate, datenum + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +Find the third Wednesday of the month specified by the MONTH and YEAR. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +today + + +# name: +# type: sq_string +# elements: 1 +# length: 360 + -- Function File: datenum = today () + Returns the current local date as the number of days since Jan 1, + 0000. By this reckoning, Jan 1, 1970 is day number 719529. + + The returned number corresponds to 00:00:00 today. + + The returned value is also called a "serial date number" (see + `datenum'). + + See also: clock, date, datenum, now + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +Returns the current local date as the number of days since Jan 1, 0000. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +vol + + +# name: +# type: sq_string +# elements: 1 +# length: 477 + -- Function File: VOLAT = vol (X, M, N) + Return the volatility VOLAT of each column of the input matrix X. + + The number of data sets per period is given by M (e.g. the number + of data per year if you want to compute the volatility per year). + The optional parameter N gives the number of past periods used for + computation, if it is omitted, a value of 1 is used. + + If T is the number of rows of X, `vol' returns the volatility from + `n*m' to T. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 +Return the volatility VOLAT of each column of the input matrix X. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +x2mdate + + +# name: +# type: sq_string +# elements: 1 +# length: 967 + -- Function File: datenums = x2mdate (exceldatenums) + -- Function File: datenums = x2mdate (exceldatenums, convention) + -- Function File: datenums = x2mdate (exceldatenums, convention, + "ExcelBug") + Convert DATENUMS from the Microsoft Excel date format to the + format used by `datenum'. If set to 0 (default, Excel for + Windows), CONVENTION specifies to use the Excel 1900 convention + where Jan 1, 1900 corresponds to Excel serial date number 1. If + set to 1 (Excel for Mac), CONVENTION specifies to use the Excel + 1904 convention where Jan 1, 1904 corresponds to Excel serial date + number 0. + + Note that this does not take into account the Excel bug where 1900 + is considered to be a leap year unless you give the "ExcelBug" + option. + + Excel does not represent dates prior to 1 January 1900 using this + format, so a warning will be issued if any dates preceed this date. + + See also: datenum, x2mdate + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Convert DATENUMS from the Microsoft Excel date format to the format +used by `dat + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +yahoo + + +# name: +# type: sq_string +# elements: 1 +# length: 408 + -- Function File: CONN = yahoo () + -- Function File: CONN = yahoo (URL, IPADDRESS, PORT) + Prepare a Yahoo connection for the fetch command to get Yahoo + historical quote data. + + If given, the URL must be "http://quote.yahoo.com". The IPADDRESS + and PORT is the proxy ipaddress and port. These parameters are + currently ignored (with a warning if given). + + See also: fetch, google + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Prepare a Yahoo connection for the fetch command to get Yahoo +historical quote d + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +year + + +# name: +# type: sq_string +# elements: 1 +# length: 150 + -- Function File: y = year (Date) + Returns the year from a serial date number or a date string. + + See also: date, datevec, now, day, month + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 +Returns the year from a serial date number or a date string. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +yeardays + + +# name: +# type: sq_string +# elements: 1 +# length: 596 + -- Function File: D = yeardays (Y) + -- Function File: D = yeardays (Y, B) + Return the number of days in the year Y with an optional basis B. + + Valid bases + * 0 actual/actual (default) + + * 1 30/360 (SIA) + + * 2 actual/360 + + * 3 actual/365 + + * 4 30/360 (PSA) + + * 5 30/360 (IDSA) + + * 6 30/360 (European) + + * 7 actual/365 (Japanese) + + * 8 actual/actual (ISMA) + + * 9 actual/360 (ISMA) + + * 10 actual/365 (ISMA) + + * 11 30/360E (ISMA) + + See also: days365, days360, daysact, daysdif + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 +Return the number of days in the year Y with an optional basis B. + + + + + diff --git a/octave_packages/financial-0.4.0/easter.m b/octave_packages/financial-0.4.0/easter.m new file mode 100644 index 0000000..deffef2 --- /dev/null +++ b/octave_packages/financial-0.4.0/easter.m @@ -0,0 +1,69 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[m, d] =} easter (y) +## @deftypefnx {Function File} {datenum =} easter (y) +## +## Return the month (@var{m}) and day (@var{d}) of Easter in the +## Gregorial calendar on a given year or years. +## +## @seealso{holidays} +## @end deftypefn + +function varargout = easter (y) + + ## This uses the Meesus/Jones/Butcher Gregorian algorithm as described + ## on http://en.wikipedia.org/wiki/Computus#Algorithms + a = mod (y, 19); + b = floor (y/100); + c = mod (y, 100); + d = floor (b/4); + e = mod (b, 4); + f = floor ((b + 8)/25); + g = floor ((b - f + 1)/3); + h = mod ((19*a+b-d-g+15), 30); + i = floor (c/4); + k = mod (c, 4); + L = mod ((32 + 2*e + 2*i - h - k), 7); + m = floor ((a + 11*h + 22*L)/451); + mon = floor ((h + L - 7*m + 114)/31); + day = 1 + mod ((h + L - 7*m + 114), 31); + + if nargout == 2 + varargout = {mon(:), day(:)}; + else + varargout{1} = reshape (datenum (y(:), mon(:), day(:)), size (y)); + end + +endfunction + +## Tests +## Validate that it calculates the correct date for a decade +%!assert(easter(1990), datenum(1990, 4, 15)) +%!assert(easter(1991), datenum(1991, 3, 31)) +%!assert(easter(1992), datenum(1992, 4, 19)) +%!assert(easter(1993), datenum(1993, 4, 11)) +%!assert(easter(1994), datenum(1994, 4, 3)) +%!assert(easter(1995), datenum(1995, 4, 16)) +%!assert(easter(1996), datenum(1996, 4, 7)) +%!assert(easter(1997), datenum(1997, 3, 30)) +%!assert(easter(1998), datenum(1998, 4, 12)) +%!assert(easter(1999), datenum(1999, 4, 4)) +## Validate vector and matrix inputs +%!assert(easter([2000 2001]), [datenum(2000, 4, 23) datenum(2001, 4, 15)]) +%!assert(easter([2002;2003]), [datenum(2002, 3, 31);datenum(2003, 4, 20)]) +%!assert(easter([2004 2005;2006 2007;2008 2009]), [datenum(2004, 4, 11) datenum(2005, 3, 27);datenum(2006, 4, 16) datenum(2007, 4, 8);datenum(2008, 3, 23) datenum(2009, 4, 12)]) +%!assert(easter([2002;2003]), [datenum(2002, 3, 31);datenum(2003, 4, 20)]) diff --git a/octave_packages/financial-0.4.0/effrr.m b/octave_packages/financial-0.4.0/effrr.m new file mode 100644 index 0000000..3e0ba89 --- /dev/null +++ b/octave_packages/financial-0.4.0/effrr.m @@ -0,0 +1,34 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{return} =} effrr (@var{rate}, @var{numperiods}) +## Compute the effective rate of return based on a nominal @var{rate} +## over a number of periods, @var{numperiods}. +## @seealso{irr, nomrr} +## @end deftypefn + +function rate = effrr (rate, numperiods) + + if (nargin != 2) + print_usage (); + endif + + rate = (1+rate./numperiods).^numperiods - 1; + +endfunction + +## Tests +%!assert (effrr (0.09, 12), 0.0938, 0.00005) diff --git a/octave_packages/financial-0.4.0/eomdate.m b/octave_packages/financial-0.4.0/eomdate.m new file mode 100644 index 0000000..cd066b8 --- /dev/null +++ b/octave_packages/financial-0.4.0/eomdate.m @@ -0,0 +1,40 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{e} =} eomdate (@var{y}, @var{m}) +## Return the last day of the month @var{m} for the year @var{y} in +## datenum format. +## @seealso{datenum, datevec, weekday, eomday} +## @end deftypefn + +function e = eomdate (y, m) + + if (nargin != 2) + print_usage (); + endif + + d = eomday (y, m); + e = datenum (y, m, d); + +endfunction + +## Tests +## Leap years +%!assert(eomdate(2008, 2), datenum(2008, 2, 29)) +%!assert(eomdate(2007, 2), datenum(2007, 2, 28)) +## Vectors +%!assert(eomdate([2008 2007], [3 4]), [datenum(2008, 3, 31) datenum(2007, 4, 30)]) +%!assert(eomdate([2008;2007], [3;4]), [datenum(2008, 3, 31);datenum(2007, 4, 30)]) diff --git a/octave_packages/financial-0.4.0/fbusdate.m b/octave_packages/financial-0.4.0/fbusdate.m new file mode 100644 index 0000000..9d0390f --- /dev/null +++ b/octave_packages/financial-0.4.0/fbusdate.m @@ -0,0 +1,58 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {b =} fbusdate (year, month) +## @deftypefnx {Function File} {b =} fbusdate (year, month, holiday) +## @deftypefnx {Function File} {b =} fbusdate (year, month, holiday, weekend) +## +## Return the datenum of the first business day of the @var{year} and +## @var{month}. @var{holiday} is a vector of datenums that defines the +## holidays observed (the holidays function is used if not given). +## @var{weekend} defines the days of the week that should be considered +## weekends; [1 0 0 0 0 0 1] (default) indicates that Sunday and +## Saturday are holidays. +## +## If any of the optional inputs (@var{holiday}, @var{weekend}) are +## empty, then the default is used. +## +## @seealso{holidays, lbusdate, isbusday, busdate} +## @end deftypefn + +function rd = fbusdate (y, m, hol, wkend) + + rd = datenum (y, m, 1); + if nargin < 3 + hol = []; + end + if nargin < 4 + wkend = []; + elseif nargin < 3 || nargin > 4 + print_usage (); + endif + + ## Test from the day before the beginning of the month so that the + ## first day of the month is captured. + rd = busdate (rd-1, 1, hol, wkend); + +endfunction + +## Tests +## A normal day +%!assert(fbusdate(2008,2), datenum(2008,2,1)) +## A holiday +%!assert(fbusdate(2008,1), datenum(2008,1,2)) +## A weekend +%!assert(fbusdate(2008,3), datenum(2008,3,3)) diff --git a/octave_packages/financial-0.4.0/fetch.m b/octave_packages/financial-0.4.0/fetch.m new file mode 100644 index 0000000..1be3557 --- /dev/null +++ b/octave_packages/financial-0.4.0/fetch.m @@ -0,0 +1,149 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {@var{data} =} fetch (@var{conn}, @var{symbol}) +## @deftypefnx {@var{data} =} fetch (@dots{}, @var{fields}) +## @deftypefnx {@var{data} =} fetch (@dots{}, @var{date}) +## @deftypefnx {@var{data} =} fetch (@dots{}, @var{fromdate}, @var{todate}) +## @deftypefnx {@var{data} =} fetch (@dots{}, @var{period}) +## @deftypefnx {[@var{data}, @var{fields}] =} fetch (@dots{}) +## +## Download stock data from a connection. +## +## @var{fields} are the data fields to download and must come from the +## set +## @itemize @bullet +## @item "Symbol" +## @item "Last" +## @item "Date" +## @item "Time" +## @item "Change" +## @item "Open" +## @item "High", +## @item "Low" +## @item "Volume" +## @end itemize +## +## As an output, @var{fields} may be different than your request. This +## is because there is mapping of field names from the data source to +## the output, and what is returned is the source mapping to allow +## validation. +## +## @var{date} is the date string or datenum for the requested data. If +## you enter today's date, you will get yesterday's data. @var{fromdate} +## and @var{todate} allow you to specify a date range for the data. +## +## @var{period} (default: "d") allows you to select the period for the +## data which can be any of the below as long as they are supported by +## the associated backend. +## @itemize @bullet +## @item 'd': daily +## @item 'w': weekly +## @item 'm': monthly (Yahoo only) +## @item 'v': dividends (Yahoo only) +## @end itemize +## +## @seealso{yahoo, google} +## @end deftypefn + +## FIXME: Actually use the proxy info if given in the connection. +## FIXME: Do not ignore the fields input. + +function [data fields] = fetch (conn=[], symbol="", varargin) + + fields = {"Symbol", "Last", "Date", "Time", "Change", "Open", ... + "High", "Low", "Volume"}; + fromdate = []; + todate = []; + period = "d"; + + firstdate = datenum (1900, 1, 1); + lastdate = today (); + + if isempty (conn) + ## By default, use yahoo now since it's the only connection + ## currently available. + conn = yahoo (); + endif + if isempty (symbol) + error ("The ticker symbol must be given") + elseif ! ischar (symbol) + error ("The symbol must be either a string") + endif + for i = 1:numel (varargin) + if ischar (varargin{i}) && (length (varargin{i}) == 1) + period = varargin{i}; + elseif iscellstr (varargin{i}) || ischar (varargin{i}) + ## if it's a character and it's a valid date, make it into our + ## dates + if ischar (varargin{i}) + thisdate = []; + try + thisdate = datenum (varargin{i}); + if isempty (fromdate) + fromdate = thisdate; + endif + todate = thisdate; + end_try_catch + endif + if isempty (thisdate) + fields = varargin{i}; + warning ("Fields are currently ignored and all data is returned") + endif + thisdate = []; + elseif isnumeric (varargin{i}) + ## it must be our dates + if isempty (fromdate) + fromdate = varargin{i}; + endif + todate = varargin{i}; + else + error ("Invalid input for argument %d", i + 2) + endif + endfor + + if isempty (fromdate) + fromdate = firstdate; + todate = lastdate; + endif + + if strcmpi (conn.url, "http://quote.yahoo.com") + [data fields] = fetch_yahoo (conn, symbol, fromdate, todate, period); + elseif strcmpi (conn.url, "http://finance.google.com") + [data fields] = fetch_google (conn, symbol, fromdate, todate, period); + else + error ("Unrecgonized connection type") + endif + +endfunction + +%!shared fgood, dgood +%! fgood = {"Date", "Open", "High", "Low", "Close", "Volume", "Adj Close"}; +%! dgood = [732501,34.77,34.87,34.25,34.62,15515400,34.62; +%! 732500,33.87,34.77,33.72,34.63,16354300,34.63; +%! 732499,34.64,34.97,34.03,34.12,13585700,34.12; +%! 732498,34.25,35.08,34.20,34.60,16086700,34.60; +%! 732494,34.76,34.85,34.22,34.44,9861600,34.44]; +%!test +%! [d f] = fetch(yahoo(), "yhoo", "01-Jul-2005", "10-Jul-2005"); +%! assert(d, dgood, eps); +%! assert(f, fgood, eps); + +## The test below fails because yahoo gives a different volume on 732498 +##%!xtest +##%! [d f] = fetch(yahoo(), "yhoo", "01-Jul-2005", "10-Jul-2005", "w"); +##%! assert(d, dgood(4:5,:), eps); +##%! assert(f, fgood, eps); diff --git a/octave_packages/financial-0.4.0/fv.m b/octave_packages/financial-0.4.0/fv.m new file mode 100644 index 0000000..1ce5ce6 --- /dev/null +++ b/octave_packages/financial-0.4.0/fv.m @@ -0,0 +1,74 @@ +## Copyright (C) 1995-1998, 2000, 2002, 2005-2007 Kurt Hornik +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fv (@var{r}, @var{n}, @var{p}, @var{l}, @var{method}) +## Return the future value at the end of period @var{n} of an investment +## which consists of @var{n} payments of @var{p} in each period, +## assuming an interest rate @var{r}. +## +## The optional argument @var{l} may be used to specify an +## additional lump-sum payment. +## +## The optional argument @var{method} may be used to specify whether the +## payments are made at the end (@code{"e"}, default) or at the +## beginning (@code{"b"}) of each period. +## +## Note that the rate @var{r} is specified as a fraction (i.e., 0.05, +## not 5 percent). +## @end deftypefn + +function v = fv (r, n, p, l, m) + + if (nargin < 3 || nargin > 5) + print_usage (); + endif + + if (! (isscalar (r) && r > -1)) + error ("fv: r must be a scalar > -1"); + elseif (! (isscalar (n) && n > 0)) + error ("fv: n must be a positive scalar"); + elseif (! isscalar (p)) + error ("fv: p must be a scalar"); + endif + + if (r != 0) + v = p * ((1 + r)^n - 1) / r; + else + v = p * n; + endif + + if (nargin > 3) + if (nargin == 5) + if (! ischar (m)) + error ("fv: `method' must be a string"); + endif + elseif ischar (l) + m = l; + l = 0; + else + m = "e"; + endif + if strcmp (m, "b") + v = v * (1 + r); + endif + if isscalar (l) + v = v + fvl (r, n, l); + else + error ("fv: l must be a scalar"); + endif + endif + +endfunction diff --git a/octave_packages/financial-0.4.0/fvl.m b/octave_packages/financial-0.4.0/fvl.m new file mode 100644 index 0000000..115aa48 --- /dev/null +++ b/octave_packages/financial-0.4.0/fvl.m @@ -0,0 +1,42 @@ +## Copyright (C) 1995-1998, 2000, 2002, 2005-2007 Kurt Hornik +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fvl (@var{r}, @var{n}, @var{l}) +## Return the future value at the end of @var{n} periods of an initial +## lump sum investment @var{l}, given a per-period interest rate +## @var{r}. +## +## Note that the rate @var{r} is specified as a fraction (i.e., 0.05, +## not 5 percent). +## @end deftypefn + +function v = fvl (r, n, l) + + if (nargin != 3) + print_usage (); + endif + + if (! (isscalar (r) && r > -1)) + error ("fvl: r has to be a scalar > -1"); + elseif (! (isscalar (n) && n > 0)) + error ("fvl: n has to be a positive scalar"); + elseif (! isscalar (l)) + error ("fvl: l has to be a scalar"); + endif + + v = l * (1 + r)^n; + +endfunction diff --git a/octave_packages/financial-0.4.0/google.m b/octave_packages/financial-0.4.0/google.m new file mode 100644 index 0000000..3397c4a --- /dev/null +++ b/octave_packages/financial-0.4.0/google.m @@ -0,0 +1,44 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{conn} =} google () +## @deftypefnx {Function File} {@var{conn} =} google (@var{URL}, @var{ipaddress}, @var{port}) +## +## Prepare a Google connection for the fetch command to get Google +## historical quote data. +## +## If given, the @var{URL} must be "http://finance.google.com". The +## @var{ipaddress} and @var{port} is the proxy ipaddress and port. These +## parameters are currently ignored (with a warning if given). +## +## @seealso{fetch, yahoo} +## @end deftypefn + +## FIXME: Actually use the proxy info if given. + +function conn = google (url="http://finance.google.com", ipaddr="", port=[]) + + if ! strcmpi (url, "http://finance.google.com") + error ("url must be 'http://finance.google.com'") + elseif ! (isempty (ipaddr) && isempty (port)) + warning ("Proxy information is currently ignored") + endif + + conn.url = url; + conn.ip = ipaddr; + conn.port = port; + +endfunction diff --git a/octave_packages/financial-0.4.0/hhigh.m b/octave_packages/financial-0.4.0/hhigh.m new file mode 100644 index 0000000..d48eba2 --- /dev/null +++ b/octave_packages/financial-0.4.0/hhigh.m @@ -0,0 +1,54 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{hhv} =} hhigh (@var{data}) +## @deftypefnx {Function File} {@var{hhv} =} hhigh (@var{data}, @var{nperiods}) +## @deftypefnx {Function File} {@var{hhv} =} hhigh (@var{data}, @var{nperiods}, @var{dim}) +## +## Compute the highest high value of @var{data} for the past +## @var{nperiods} (default: 14) across the dimension, @var{dim} +## (default: 1). +## +## @seealso{llow} +## @end deftypefn + +function hhv = hhigh (data, nperiods = 14, dim = find (size (data) > 1, 1)) + + if nargin < 1 || nargin > 3 + print_usage (); + elseif ! isvector (data) + ## FIXME + error ("cannot yet handle more than one dimensional data") + endif + + if dim > ndims (data) + error ("dim cannot be greater than the number of dimensions in data"); + endif + + sz = size (data); + hhv = data; + for i = 1:sz(dim) + hhv(i) = max (data(max (i-nperiods+1, 1):i)); + endfor + +endfunction + +## Tests +%!shared c, h +%! c = [22.44 22.61 22.67 22.88 23.36 23.23 23.08 22.86 23.17 23.69 23.77 23.84 24.32 24.8 24.16 24.1 23.37 23.61 23.21 25]; +%! h = [22.44 22.61 22.67 22.88 23.36 23.36 23.36 23.36 23.36 23.69 23.77 23.84 24.32 24.8 24.8 24.8 24.8 24.8 24.8 25]; +%!assert(hhigh(c), h) +%!assert(hhigh(c'), h') diff --git a/octave_packages/financial-0.4.0/highlow.m b/octave_packages/financial-0.4.0/highlow.m new file mode 100644 index 0000000..b1cf068 --- /dev/null +++ b/octave_packages/financial-0.4.0/highlow.m @@ -0,0 +1,71 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} highlow (@var{high}, @var{low}, @var{close}) +## @deftypefnx {Function File} {@var{h} =} highlow (@var{high}, @var{low}, @var{close}, @var{open}) +## @deftypefnx {Function File} {@var{h} =} highlow (@var{high}, @var{low}, @var{close}, @var{open}, @var{color}) +## +## Plot the @var{high}, @var{low}, and @var{close} of a security. The +## @var{close} is plotted as a tick to the right, and if @var{open} is +## given and non-empty, it is plotted as a tick to the left. The color +## can override the default color for the plot. +## +## @seealso{bolling, candle, dateaxis, movavg, pointfig} +## @end deftypefn + +function h = highlow (high, low, close, open = [], color) + + if nargin < 3 || nargin > 5 + print_usage (); + elseif nargin < 5 + plotargs = {}; + else + plotargs = {"color", color}; + endif + + if isempty (high) || isempty (low) || isempty (close) + error ("high, low, and close may not be empty") + elseif ~(isvector (high) && isvector (low) && isvector (close)) + error ("high, low, and close must be vectors") + elseif ( (numel (high) != numel (low)) || (numel (high) != numel (close)) ) + error ("high, low, and close must have the same number of elements") + elseif ( !isempty (open) && (numel (high) != numel (open)) ) + error ("open must have the same number of elements as high, low, and close") + endif + + holdstat = ishold (); + ## h = hggroup (); + ## plotargs(end+1:end+2) = {"parent", h}; + hold on; + x = (1:length(high)) + 0.5; + x = reshape([x;x;nan(size(x))], [], 1); + y = reshape([high(:)'; low(:)'; nan(1, length(high))], [], 1); + plot(x, y, plotargs{:}); + x = 1:length(high); + x = reshape([x+0.5;x+1;nan(size(x))], [], 1); + y = reshape([close(:)';close(:)';nan(1, length(close))], [], 1); + plot(x, y, plotargs{:}); + if ! isempty(open) + x -= 0.5; + y = reshape([open(:)';open(:)';nan(1, length(open))], [], 1); + plot(x, y, plotargs{:}); + endif + + if !holdstat + hold off; + endif + +endfunction diff --git a/octave_packages/financial-0.4.0/holidays.m b/octave_packages/financial-0.4.0/holidays.m new file mode 100644 index 0000000..d286da1 --- /dev/null +++ b/octave_packages/financial-0.4.0/holidays.m @@ -0,0 +1,91 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {h =} holidays (startdate, enddate) +## +## Return a vector of datenums that were holidays between +## @var{startdate} and @var{enddate}, inclusive. These holidays are +## trading holidays observed by the NYSE according to its rule 51.10. It +## does not take into account the exceptions for "unusual business +## conditions" or for additional days that have been called as holidays +## for one-time purposes. +## +## The complete list can be found at +## http://www.chronos-st.org/NYSE_Observed_Holidays-1885-Present.html +## +## @seealso{busdate, lbusdate, isbusday, fbusdate} +## @end deftypefn + +function hol = holidays (sd, ed) + + sd = datenum (datevec (sd)); + ed = datenum (datevec (ed)); + + ## just get the start and end years and generate all holidays in that range + yrs = year(sd):year(ed); + + hol = []; + ## New Year's Day + tmphol = datenum (yrs, 1, 1); + hol = [hol; tmphol(:)]; + ## Martin Luther King Day, the third Monday in January + tmphol = nweekdate (3, 2, yrs, 1); + hol = [hol; tmphol(:)]; + ## Washington's Birthday, the third Monday in February + tmphol = nweekdate (3, 2, yrs, 2); + hol = [hol; tmphol(:)]; + ## Good Friday + tmphol = easter (yrs) - 2; + hol = [hol; tmphol(:)]; + ## Memorial Day, the last Monday in May + tmphol = lweekdate (2, yrs, 5); + hol = [hol; tmphol(:)]; + ## Independence Day, July 4 + tmphol = datenum (yrs, 7, 4); + hol = [hol; tmphol(:)]; + ## Labor Day, the first Monday in September + tmphol = nweekdate (1, 2, yrs, 9); + hol = [hol; tmphol(:)]; + ## Thanksgiving Day, the fourth Thursday in November + tmphol = nweekdate (4, 5, yrs, 11); + hol = [hol; tmphol(:)]; + ## Christmas Day + tmphol = datenum (yrs, 12, 25); + hol = [hol; tmphol(:)]; + + ## Adjust for Saturdays and Sundays + wd = weekday (hol); + if any (wd == 1) + hol(wd == 1) = hol(wd == 1) + 1; + endif + if any (wd == 7) + hol(wd == 7) = hol(wd == 7) - 1; + endif + + ## Trim out the days that are not in the date range + hol(hol > ed | hol < sd) = []; + hol = sort (hol); + +endfunction + +## Tests +%!assert(holidays(datenum(2008,1,1), datenum(2008,12,31)), datenum(2008*ones(9,1), [1;1;2;3;5;7;9;11;12], [1;21;18;21;26;4;1;27;25])) +## Test Independence day observing on a Monday (July 5) and Christmas +## observing on a Friday (Dec 24) +%!assert(holidays(datenum(2004,1,1), datenum(2004,12,31)), datenum(2004*ones(9,1), [1;1;2;4;5;7;9;11;12], [1;19;16;9;31;5;6;25;24])) +%!assert(holidays(datenum(2008,3,5), datenum(2008,3,8)), zeros(0,1)) +%!assert(holidays(datenum(2008,3,5), datenum(2008,3,5)), zeros(0,1)) +%!assert(holidays(datenum(2008,1,1), datenum(2008,1,1)), datenum(2008,1,1)) diff --git a/octave_packages/financial-0.4.0/hour.m b/octave_packages/financial-0.4.0/hour.m new file mode 100644 index 0000000..f343bfe --- /dev/null +++ b/octave_packages/financial-0.4.0/hour.m @@ -0,0 +1,30 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {h =} hour (Date) +## +## Returns the hour from a serial date number or a date string. +## +## @seealso{date, datevec, now, minute, second} +## @end deftypefn + +function t = hour (dates) + + t = datevec (dates); + t = t (:,4); + +endfunction + diff --git a/octave_packages/financial-0.4.0/irr.m b/octave_packages/financial-0.4.0/irr.m new file mode 100644 index 0000000..3155c24 --- /dev/null +++ b/octave_packages/financial-0.4.0/irr.m @@ -0,0 +1,39 @@ +## Copyright (C) 1995-1998, 2000, 2002, 2004-2007 Kurt Hornik +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} irr (@var{p}, @var{i}) +## Return the internal rate of return of a series of payments @var{p} +## from an initial investment @var{i} (i.e., the solution of +## @code{npv (r, p) = i}. If the second argument is omitted, a value of +## 0 is used. +## @seealso{npv, pv, rate} +## @end deftypefn + +function r = irr (p, i = 0) + ## Check input + if (nargin != 1 && nargin != 2) + print_usage (); + elseif (! (isvector (p))) + error ("irr: p must be a vector"); + elseif (! isscalar (i)) + error ("irr: i must be a scalar"); + endif + + ## Solve system + f = @(x) npv (x, p) - i; + r = fsolve (f, 0); + +endfunction diff --git a/octave_packages/financial-0.4.0/isbusday.m b/octave_packages/financial-0.4.0/isbusday.m new file mode 100644 index 0000000..8294676 --- /dev/null +++ b/octave_packages/financial-0.4.0/isbusday.m @@ -0,0 +1,72 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {r =} isbusday (refdate) +## @deftypefnx {Function File} {r =} isbusday (refdate, holiday) +## @deftypefnx {Function File} {r =} isbusday (refdate, holiday, weekend) +## +## Return true if the @var{refdate} is a business date @var{refdate}. +## @var{holiday} is a vector of datenums that defines the holidays +## observed (the holidays function is used if not given). @var{weekend} +## defines the days of the week that should be considered weekends; +## [1 0 0 0 0 0 1] (default) indicates that Sunday and Saturday are +## weekends. +## +## @seealso{holidays, lbusdate, busdate, fbusdate} +## @end deftypefn + +function mask = isbusday (rd, hol=[], wkend=[]) + + if ~ isnumeric (rd) + rd = datenum (rd); + endif + if isempty (hol) + ## Get all possible holidays that could affect the output. + hol = holidays (min(rd), max(rd)); + end + if isempty (wkend) + wkend = [1 0 0 0 0 0 1]; + elseif numel (wkend) ~= 7 + error ("wkend must have 7 elements") + elseif nargin > 3 + print_usage (); + endif + + mask = reshape (wkend (weekday (rd)), size (rd)); + if ~ isempty (hol) + ## Is it a holiday? + mask = mask | ismember(rd, hol); + endif + mask = ~mask; +endfunction + +## Tests +## A normal day +%!assert(isbusday(datenum(2008,1,2)), true()) +## A holiday +%!assert(isbusday(datenum(2008,1,1)), false()) +%!assert(isbusday(datenum(2008,1,1), []), false()) +## A weekend +%!assert(isbusday(datenum(2008,2,2)), false()) +## An alternate holiday +%!assert(isbusday(datenum(2008,1,2), datenum(2008,1,2)), false()) +## An alternate weekend +%!assert(isbusday(datenum(2008,1,2), [], zeros(1,7)), true()) +%!assert(isbusday(datenum(2008,1,2), [], ones(1,7)), false()) +## A vector +%!assert(isbusday([datenum(2008,1,2) datenum(2008,2,2)]), [true() false()]) +## A vector in the other direction +%!assert(isbusday([datenum(2008,1,2);datenum(2008,2,2)]), [true();false()]) diff --git a/octave_packages/financial-0.4.0/lbusdate.m b/octave_packages/financial-0.4.0/lbusdate.m new file mode 100644 index 0000000..fc7e8b1 --- /dev/null +++ b/octave_packages/financial-0.4.0/lbusdate.m @@ -0,0 +1,56 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {b =} lbusdate (year, month) +## @deftypefnx {Function File} {b =} lbusdate (year, month, holiday) +## @deftypefnx {Function File} {b =} lbusdate (year, month, holiday, weekend) +## +## Return the datenum of the last business day of the @var{year} and +## @var{month}. @var{holiday} is a vector of datenums that defines the +## holidays observed (the holidays function is used if not given). +## @var{weekend} defines the days of the week that should be considered +## weekends; [1 0 0 0 0 0 1] (default) indicates that Sunday and +## Saturday are holidays. +## +## If any of the optional inputs (@var{holiday}, @var{weekend}) are +## empty, then the default is used. +## +## @seealso{holidays, fbusdate, isbusday, busdate} +## @end deftypefn + +function rd = lbusdate (y, m, hol, wkend) + + rd = eomdate (y, m); + if nargin < 3 + hol = []; + end + if nargin < 4 + wkend = []; + elseif nargin < 3 || nargin > 4 + print_usage (); + endif + + ## Test from the day after the end of the month so that the + ## last day of the month is captured. + rd = busdate (rd+1, -1, hol, wkend); + +endfunction + +## Tests +## A normal day +%!assert(lbusdate(2008,4), datenum(2008,4,30)) +## A weekend +%!assert(lbusdate(2008,5), datenum(2008,5,30)) diff --git a/octave_packages/financial-0.4.0/llow.m b/octave_packages/financial-0.4.0/llow.m new file mode 100644 index 0000000..8133121 --- /dev/null +++ b/octave_packages/financial-0.4.0/llow.m @@ -0,0 +1,52 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{llv} =} llow (@var{data}) +## @deftypefnx {Function File} {@var{llv} =} llow (@var{data}, @var{nperiods}) +## @deftypefnx {Function File} {@var{llv} =} llow (@var{data}, @var{nperiods}, @var{dim}) +## +## Compute the lowest low value of @var{data} for the past +## @var{nperiods} (default: 14) across the dimension, @var{dim} +## (default: 1). +## +## @seealso{hhigh} +## @end deftypefn + +function llv = llow (data, nperiods = 14, dim = find (size (data) > 1, 1)) + + if nargin < 1 || nargin > 3 + print_usage (); + elseif ! isvector (data) + ## FIXME + error ("cannot yet handle more than one dimensional data") + elseif dim > ndims (data) + error ("dim cannot be greater than the number of dimensions in data"); + endif + + sz = size (data); + llv = data; + for i = 1:sz(dim) + llv(i) = min (data(max (i-nperiods+1, 1):i)); + endfor + +endfunction + +## Tests +%!shared c, l +%! c = [22.44 22.61 22.67 22.88 23.36 23.23 23.08 22.86 23.17 23.69 23.77 23.84 24.32 24.8 24.16 24.1 23.37 23.61 23.21 25]; +%! l = [22.44 22.44 22.44 22.44 22.44 22.44 22.44 22.44 22.44 22.44 22.44 22.44 22.44 22.44 22.61 22.67 22.86 22.86 22.86 22.86]; +%!assert(llow(c), l) +%!assert(llow(c'), l') diff --git a/octave_packages/financial-0.4.0/lweekdate.m b/octave_packages/financial-0.4.0/lweekdate.m new file mode 100644 index 0000000..d372314 --- /dev/null +++ b/octave_packages/financial-0.4.0/lweekdate.m @@ -0,0 +1,37 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {last =} lweekdate (weekday, year, month, nextday) +## +## Returns the last occurrence of @var{weekday} from the @var{month} and +## @var{year}. If the optional @var{nextday} argument is given, then +## the week must also contain @var{nextday}. +## +## @seealso{eomdate, nweekdate, weekday} +## @end deftypefn + +function t = lweekdate (varargin) + if nargin < 3 || nargin > 4 + error ("3 or 4 input arguments are required") + elseif nargin == 3 + varargin{4} = 0; + endif + + t = nweekdate ("lweekdate", varargin{:}); + +endfunction + +## Tests are in nweekdate diff --git a/octave_packages/financial-0.4.0/m2xdate.m b/octave_packages/financial-0.4.0/m2xdate.m new file mode 100644 index 0000000..a340e0c --- /dev/null +++ b/octave_packages/financial-0.4.0/m2xdate.m @@ -0,0 +1,74 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {exceldatenums =} m2xdate (datenums) +## @deftypefnx {Function File} {exceldatenums =} m2xdate (datenums, convention) +## @deftypefnx {Function File} {exceldatenums =} m2xdate (datenums, convention, "ExcelBug") +## +## Convert @var{datenums} from the internal date format to the format +## used by Microsoft Excel. If set to 0 (default, Excel for Windows), +## @var{convention} specifies to use the Excel 1900 convention where Jan +## 1, 1900 corresponds to Excel serial date number 1. If set to 1 +## (Excel for Mac), @var{convention} specifies to use the Excel 1904 +## convention where Jan 1, 1904 corresponds to Excel serial date number +## 0. +## +## Note that this does not take into account the Excel bug where 1900 is +## considered to be a leap year unless you give the "ExcelBug" option. +## +## Excel does not represent dates prior to 1 January 1900 using this +## format, so a warning will be issued if any dates preceed this date. +## +## @seealso{datenum, x2mdate} +## @end deftypefn + +function dates = m2xdate (dates, convention, excelbug) + + if nargin == 1 + convention = 0; + excelbug = false(); + elseif nargin == 2 + excelbug = false(); + elseif nargin == 3 + excelbug = strcmpi(excelbug, "ExcelBug"); + else + print_usage (); + endif + + if convention == 0 + adj = datenum(1900, 1, 1) - 2; + elseif convention == 1 + adj = datenum(1904, 1, 1); + endif + + if excelbug + datemask = (dates < datenum(1900, 3, 1)); + dates(datemask) = dates(datemask) - 1; + endif + dates = dates - adj; + if any (dates < 0) + warning ("Negative date found, this will not work within MS Excel.") + endif + +endfunction + +## Tests +%!assert(m2xdate(datenum(2008, 1, 1)), 39448) +%!assert(m2xdate(datenum(2007:2008, 1, 1)), [39083 39448]) +%!assert(m2xdate(datenum(1900, 1, 1)), 2) +%!assert(m2xdate(datenum(1900, 1, 1), 0, "ExcelBug"), 1) +%!assert(m2xdate(datenum(1904, 1, 1), 1), 0) + diff --git a/octave_packages/financial-0.4.0/minute.m b/octave_packages/financial-0.4.0/minute.m new file mode 100644 index 0000000..cf375d9 --- /dev/null +++ b/octave_packages/financial-0.4.0/minute.m @@ -0,0 +1,30 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {m =} minute (Date) +## +## Returns the minute from a serial date number or a date string. +## +## @seealso{date, datevec, now, hour, second} +## @end deftypefn + +function t = minute (dates) + + t = datevec (dates); + t = t (:,6); + +endfunction + diff --git a/octave_packages/financial-0.4.0/mirr.m b/octave_packages/financial-0.4.0/mirr.m new file mode 100644 index 0000000..18f461d --- /dev/null +++ b/octave_packages/financial-0.4.0/mirr.m @@ -0,0 +1,48 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{return} =} mirr (@var{cashflow}, @var{finrate}, @var{reinvestrate}) +## Compute the modified internal rate of return. +## Take periodic @var{cashflow}s as a vector and the finance rate, +## @var{finrate}, for negative cash flows and a reinvestment rate, +## @var{reinvestrate}, for positive cash flows. +## @seealso{irr, effrr, nomrr, pvvar, xirr} +## @end deftypefn + +## Algorithm from +## http://en.wikipedia.org/wiki/Modified_Internal_Rate_of_Return + +function rate = mirr (flow, finrate, reinvestrate) + + if (nargin != 3) + print_usage (); + endif + + posflow = zeros (size (flow)); + negflow = zeros (size (flow)); + mask = flow >= 0; + posflow(mask) = flow(mask); + negflow(!mask) = flow(!mask); + + n = numel (flow); + + rate = (-npv (reinvestrate, posflow)*(1+reinvestrate)^n/ + (npv (finrate, negflow)*(1+finrate)))^(1/(n-1))-1; + +endfunction + +## Tests +%!assert (mirr ([-100000 20000 -10000 30000 38000 50000], 0.09, 0.12), 0.0832, 0.00005) diff --git a/octave_packages/financial-0.4.0/month.m b/octave_packages/financial-0.4.0/month.m new file mode 100644 index 0000000..b2fbbcc --- /dev/null +++ b/octave_packages/financial-0.4.0/month.m @@ -0,0 +1,31 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {mon =} month (Date) +## +## Returns the day of the month from a serial date number or a date +## string. +## +## @seealso{date, datevec, now, day, year} +## @end deftypefn + +function t = month (dates) + + t = datevec (dates); + t = t (:,2); + +endfunction + diff --git a/octave_packages/financial-0.4.0/months.m b/octave_packages/financial-0.4.0/months.m new file mode 100644 index 0000000..ac27c98 --- /dev/null +++ b/octave_packages/financial-0.4.0/months.m @@ -0,0 +1,58 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {mos =} months (startdate, enddate) +## @deftypefnx {Function File} {mos =} months (startdate, enddate, endmonthflag) +## +## Return the number of whole months between @var{startdate} and +## @var{enddate}. @var{endmonthflag} defaults to 1. +## +## If @var{endmonthflag} is true, then if both the @var{startdate} and +## the @var{enddate} are end of month dates and @var{enddate} has fewer +## days in the month than @var{startdate}, @var{endmonthflag} = 1 treats +## @var{enddate} as the end of a month, but @var{endmonthflag} = 0 does +## not. +## +## @seealso{yeardays, yearfrac} +## @end deftypefn + +function mos = months (startdate, enddate, endmonthflag = 1) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + s = datevec (startdate); + e = datevec (enddate); + s_eom = (s(:,3) == eomday(s(:,1), s(:,2))); + e_eom = (e(:,3) == eomday(e(:,1), e(:,2))); + + ## Handle the end of the month correctly + dayadj = ((s(:,3) > e(:,3)) & endmonthflag & s_eom & e_eom); + + mos = 12*(e(:,1) - s(:,1)) + (e(:,2) - s(:,2)) - (s(:,3) > e(:,3)) + dayadj; + +endfunction + +## Tests +%!assert(months('may 31 2004', 'jun 30 2004'), 1) +%!assert(months({'may 31 2004' 'may 30 2004'}, 'jun 30 2004'), [1;1]) +%!assert(months('may 31 2004', 'jun 30 2004', 1), 1) +%!assert(months({'may 31 2004' 'may 30 2004'}, 'jun 30 2004', 1), [1;1]) +%!assert(months('may 31 2004', 'jun 30 2004', 0), 0) +%!assert(months({'may 31 2004' 'may 30 2004'}, 'jun 30 2004', 0), [0;1]) +%!assert(months('jun 30 2005', 'june 30 2006'), 12) +%!assert(months('jun 30 2005', 'june 29 2006'), 11) diff --git a/octave_packages/financial-0.4.0/movavg.m b/octave_packages/financial-0.4.0/movavg.m new file mode 100644 index 0000000..a1cb192 --- /dev/null +++ b/octave_packages/financial-0.4.0/movavg.m @@ -0,0 +1,105 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} movavg (@var{asset}, @var{lead}, @var{lag}) +## @deftypefnx {Function File} {} movavg (@var{asset}, @var{lead}, @var{lag}, @var{alpha}) +## @deftypefnx {Function File} {[@var{short}, @var{long}] =} movavg (@var{asset}, @var{lead}, @var{lag}, @var{alpha}) +## +## Calculate the @var{lead}ing and @var{lag}ging moving average of an +## @var{asset}. If given, @var{alpha} is the weighting power of the +## delay; 0 (default) is the simple moving average, 0.5 would be the +## square root weighted moving average, 1 would be linear, 2 would be +## squared, ..., and 'e' is the exponential moving average. +## +## If no output is requested the data is plotted. The plots are drawn +## in the following order: asset, lag, lead. If output is requested, no +## plot is generated. +## +## @seealso{bolling, candle, dateaxis, highlow, pointfig} +## @end deftypefn + +function [varargout] = movavg (asset, lead, lag, alpha = 0) + + if nargin < 3 || nargin > 4 + print_usage (); + endif + + if lead > lag + error ("lead must be <= lag") + elseif ischar (alpha) + if ! strcmpi (alpha, "e") + error ("alpha must be 'e' if it is a char"); + endif + elseif ! isnumeric (alpha) + error ("alpha must be numeric or 'e'") + endif + + ## Compute the weights + if ischar (alpha) + lead = exp(1:lead); + lag = exp(1:lag); + else + lead = (1:lead).^alpha; + lag = (1:lag).^alpha; + endif + ## Adjust the weights to equal 1 + lead = lead / sum (lead); + lag = lag / sum (lag); + + short = asset; + long = asset; + for i = 1:length (asset) + if i < length (lead) + ## Compute the run-in period + r = length (lead) - i + 1:length(lead); + short(i) = dot (asset(1:i), lead(r))./sum (lead(r)); + else + short(i) = dot (asset(i - length(lead) + 1:i), lead); + endif + if i < length (lag) + r = length (lag) - i + 1:length(lag); + long(i) = dot (asset(1:i), lag(r))./sum (lag(r)); + else + long(i) = dot (asset(i - length(lag) + 1:i), lag); + endif + endfor + + if nargout > 0 + varargout{1} = short; + else + plot((1:length(asset))', [asset(:), long(:), short(:)]); + endif + if nargout > 1 + varargout{2} = long; + endif + +endfunction + +## Tests +%!shared a +%! a = [1 2 3 2 4 2 1]; +%!test +%! [s l] = movavg(a, 2, 4); +%! assert(s, [1 1.5 2.5 2.5 3 3 1.5]) +%! assert(l, [1 1.5 2 2 2.75 2.75 2.25]) +%!test +%! [s l] = movavg(a', 2, 4); +%! assert(s, [1;1.5;2.5;2.5;3;3;1.5]) +%! assert(l, [1;1.5;2;2;2.75;2.75;2.25]) +%!test +%! [s l] = movavg(a, 3, 4, 1); +%! assert(s, [3 4.8 7 7 9.5 8 5.5]./3, 10*eps) +%! assert(l, [1 11/7 20/9 2.2 3 2.7 2], 10*eps) diff --git a/octave_packages/financial-0.4.0/negvolidx.m b/octave_packages/financial-0.4.0/negvolidx.m new file mode 100644 index 0000000..cff16e1 --- /dev/null +++ b/octave_packages/financial-0.4.0/negvolidx.m @@ -0,0 +1,82 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{nvi} =} negvolidx (@var{closeprice}, @var{vol}) +## @deftypefnx {Function File} {@var{nvi} =} negvolidx ([@var{closeprice} @var{vol}]) +## @deftypefnx {Function File} {@var{nvi} =} negvolidx (@var{closeprice}, @var{vol}, @var{initnvi}) +## @deftypefnx {Function File} {@var{nvi} =} negvolidx ([@var{closeprice} @var{vol}], @var{initnvi}) +## +## Compute the negative volume index of a security based on its closing +## price (@var{closeprice}) and @var{vol}ume. They may be given as +## separate arguments or as an nx2 matrix. If given, the @var{initnvi} +## is the starting value of the nvi (default: 100). +## +## The @var{nvi} will always be a column vector. +## +## @seealso{onbalvol, posvolidx} +## @end deftypefn + +function nvi = negvolidx (c, vol, initnvi) + + default_nvi = 100; + nvi = zeros (length (c), 1); + if isvector (c) + if nargin < 2 + ## a closing price was given without a volume + print_usage (); + elseif isscalar (vol) + ## probably initnvi was given as the second argument + print_usage (); + elseif !isvector (vol) + print_usage (); + elseif length (c) != length (vol) + error ("closeprice and vol must be the same length"); + endif + c = [c(:) vol(:)]; + if nargin < 3 + nvi(1) = default_nvi; + else + nvi(1) = initnvi; + endif + elseif size (c, 2) != 2 + error ("If given as a matrix, c must have exactly two columns.") + elseif size (c, 2) == 2 + if nargin == 2 + nvi(1) = vol; + else + nvi(1) = default_nvi; + endif + else + print_usage (); + endif + + ## Start doing the work + for i = 2:size (c, 1) + nvi(i) = nvi(i-1) + (c(i,2) < c(i-1,2))*nvi(i-1)*(c(i,1)-c(i-1,1))/c(i-1,1); + endfor + +endfunction + +## Tests +%!shared c, v, nvia, nvib +%! c = [22.44 22.61 22.67 22.88 23.36 23.23 23.08 22.86 23.17 23.69 23.77 23.84 24.32 24.8 24.16 24.1 23.37 23.61 23.21]; +%! v = [10 12 23 25 34 12 32 15 15 34 54 12 86 45 32 76 89 13 28]; +%! nvia = [100 100 100 100 100 99.44349315 99.44349315 98.49559157 98.49559157 98.49559157 98.49559157 98.78565011 98.78565011 100.7353669 98.13574451 98.13574451 98.13574451 99.14355704 99.14355704]'; +%! nvib = [5 5 5 5 5 4.972174658 4.972174658 4.924779578 4.924779578 4.924779578 4.924779578 4.939282505 4.939282505 5.036768344 4.906787226 4.906787226 4.906787226 4.957177852 4.957177852]'; +%!assert(negvolidx(c, v), nvia, 1e-5) +%!assert(negvolidx([c' v']), nvia, 1e-5) +%!assert(negvolidx(c, v, 5), nvib, 1e-5) +%!assert(negvolidx([c' v'], 5), nvib, 1e-5) diff --git a/octave_packages/financial-0.4.0/nomrr.m b/octave_packages/financial-0.4.0/nomrr.m new file mode 100644 index 0000000..84c50bc --- /dev/null +++ b/octave_packages/financial-0.4.0/nomrr.m @@ -0,0 +1,34 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{return} =} nomrr (@var{rate}, @var{numperiods}) +## Compute the nominal rate of return based on a effective @var{rate} +## over a number of periods, @var{numperiods}. +## @seealso{irr, effrr} +## @end deftypefn + +function rate = nomrr (rate, numperiods) + + if (nargin != 2) + print_usage (); + endif + + rate = numperiods.*((1+rate).^(1./numperiods) - 1); + +endfunction + +## Tests +%!assert (nomrr (0.0938, 12), 0.09, 0.00005) diff --git a/octave_packages/financial-0.4.0/nper.m b/octave_packages/financial-0.4.0/nper.m new file mode 100644 index 0000000..891188d --- /dev/null +++ b/octave_packages/financial-0.4.0/nper.m @@ -0,0 +1,75 @@ +## Copyright (C) 1995-1998, 2000, 2002, 2004-2007 Kurt Hornik +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} nper (@var{r}, @var{p}, @var{a}, @var{l}, @var{method}) +## Return the number of regular payments of @var{p} necessary to +## amortize @var{a} loan of amount @var{a} and interest @var{r}. +## +## The optional argument @var{l} may be used to specify an additional +## lump-sum payment of @var{l} made at the end of the amortization time. +## +## The optional argument @var{method} may be used to specify whether +## payments are made at the end (@var{"e"}, default) or at the beginning +## (@var{"b"}) of each period. +## +## Note that the rate @var{r} is specified as a fraction (i.e., 0.05, +## not 5 percent). +## @seealso{pv, pmt, rate, npv} +## @end deftypefn + +function n = nper (r, p, a, l, m) + + if (nargin < 3 || nargin > 5) + print_usage (); + endif + + if (! (isscalar (r) && r > -1)) + error ("nper: r must be a scalar > -1"); + elseif (! isscalar (p)) + error ("nper: p must be a scalar"); + elseif (! isscalar (a)) + error ("nper: a must be a scalar"); + endif + + if (nargin == 5) + if (! ischar (m)) + error ("nper: `method' must be a string"); + endif + elseif (nargin == 4) + if (ischar (l)) + m = l; + l = 0; + else + m = "e"; + endif + else + m = "e"; + l = 0; + endif + + if (strcmp (m, "b")) + p = p * (1 + r); + endif + + q = (p - r * a) / (p - r * l); + + if (q > 0) + n = - log (q) / log (1 + r); + else + n = Inf; + endif + +endfunction diff --git a/octave_packages/financial-0.4.0/npv.m b/octave_packages/financial-0.4.0/npv.m new file mode 100644 index 0000000..516a0d7 --- /dev/null +++ b/octave_packages/financial-0.4.0/npv.m @@ -0,0 +1,69 @@ +## Copyright (C) 1995-2000, 2002, 2004-2007 Kurt Hornik +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} npv (@var{r}, @var{p}, @var{i}) +## Net present value of a series of payments. +## +## Returns the net present value of a series of irregular (i.e., not +## necessarily identical) payments @var{p} which occur at the ends of @var{n} +## consecutive periods. @var{r} specifies the one-period interest rates and +## can either be a scalar (constant rates) or a vector of the same +## length as @var{p}. +## +## The optional argument @var{i} may be used to specify an initial +## investment. +## +## Note that the rate @var{r} is specified as a fraction (i.e., 0.05, +## not 5 percent). +## @seealso{irr, pv} +## @end deftypefn + +function v = npv (r, p, i) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (! (isvector (p))) + error ("npv: p has to be a vector"); + else + n = length (p); + p = reshape (p, 1, n); + endif + + if (any (any (r <= -1))) + error ("npv: all interest rates must be > -1"); + endif + if (isscalar (r)) + d = 1 ./ (1 + r) .^ (0 : n); + elseif (isvector (r) && (length (r) == n)) + d = [1, (1 ./ cumprod (reshape (1 + r, 1, n)))]; + else + error ("npv: r must be a scalar or a vector of the same length as p"); + endif + + if (nargin == 3) + if (! isscalar (i)) + error ("npv: I_0 must be a scalar"); + endif + else + i = 0; + endif + + p = [i, p]; + v = sum (d .* p); + +endfunction diff --git a/octave_packages/financial-0.4.0/nweekdate.m b/octave_packages/financial-0.4.0/nweekdate.m new file mode 100644 index 0000000..28b86ed --- /dev/null +++ b/octave_packages/financial-0.4.0/nweekdate.m @@ -0,0 +1,152 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {last =} nweekdate (n, weekday, year, month, nextday) +## +## Returns the @var{n}th occurrence of @var{weekday} from the +## @var{month} and @var{year}. If the optional @var{nextday} argument +## is given, then the week must also contain @var{nextday}. If @var{n} +## is greater than the number of occurrences of that day in the month, 0 +## is returned. +## +## @seealso{eomdate, lweekdate, weekday} +## @end deftypefn + +function t = nweekdate (varargin) + if nargin < 4 || nargin > 5 + error ("4 or 5 input arguments are required") + elseif nargin == 4 + varargin{5} = 0; + endif + + ## special handling so that most of this code will not need to be + ## duplicated in lweekdate + do_lweekdate = is_lweekdate(varargin{1}); + if do_lweekdate + varargin{1} = 1; + endif + + scale = cellfun (@numel, varargin); + if ~ all (scale == 1 | scale == max(scale)); + error("All inputs must be either scalars or have the same number of elements"); + else + ## make sure that the sizes are the same for any non-scalar inputs + ind = find (scale > 1); + if length(ind) > 1 + for i = 2:length (ind) + if ndims (varargin{ind(1)}) ~= ndims (varargin{ind(i)}) + error("Mismatching dimensions on inputs %d and %d", ind(1), ind(i)); + elseif ~ all (size (varargin{ind(1)}) == size (varargin{ind(i)})) + error("The sizes of inputs %d and %d do not match", ind(1), ind(i)); + endif + endfor + endif + endif + + if max(scale) > 1 + t = zeros (size (varargin{ind(1)})); + for i = 1:numel (varargin{ind(1)}) + args = cell(5,1); + for j = 1:5 + if isscalar (varargin{j}) + args{j} = varargin{j}; + else + args{j} = varargin{j}(i); + endif + endfor + if do_lweekdate + args{1} = "lweekdate"; + end + t(i) = nweekdate (args{:}); + endfor + else + ## Do the real work. + n = varargin{1}; + wd = varargin{2}; + y = varargin{3}; + mon = varargin{4}; + nextday = varargin{5}; + + ## Find the day of the week for the last day of the mon. + doml = eomday (y, mon); + dowl = weekday (datenum (y, mon, doml)); + ## Make sure that the day is in the weeks for the last then the + ## first week. + if (wd < nextday) || (dowl < wd) + ## adjust the last day + adjust = 7; + else + adjust = 0; + endif + dom = sort((doml - dowl + wd - adjust):-7:1); + if nextday && (dom(1) <= wd - nextday) + # adjust the first day + dom(1) = []; + endif + if do_lweekdate + t = datenum (y, mon, dom(end)); + elseif n > length(dom) + t = 0; + else + t = datenum (y, mon, dom(n)); + end + endif + +endfunction + +function v = is_lweekdate(v) + if ischar(v) + if strcmp (v, "lweekdate") + v = true(); + else + error("Invalid input for n") + endif + else + v = false(); + endif +endfunction + +# Tests for all calling options +# Find the first Wednesday in Jan 2008 +%!assert(nweekdate(1, 4, 2008, 1), datenum(2008, 1, 2)) +# Find the second Wednesday in Jan 2008 +%!assert(nweekdate(2, 4, 2008, 1), datenum(2008, 1, 9)) +# Find the third Wednesday in Jan 2008 +%!assert(nweekdate(3, 4, 2008, 1), datenum(2008, 1, 16)) +# Find the fourth Wednesday in Jan 2008 +%!assert(nweekdate(4, 4, 2008, 1), datenum(2008, 1, 23)) +# Find the fifth Wednesday in Jan 2008 +%!assert(nweekdate(5, 4, 2008, 1), datenum(2008, 1, 30)) +# Find the sixth Wednesday in Jan 2008, it doesn't exist, so return 0 +%!assert(nweekdate(6, 4, 2008, 1), 0) +# Find the fifth Friday in Jan 2008, it doesn't exist, so return 0 +%!assert(nweekdate(5, 6, 2008, 1), 0) +# Find the first Wednesday in Jan 2008 in the same week as a Monday +# WARNING: it is unclear from the Matlab docs if this should work or if +# this should be called the second Wednesday in Jan 2008. +%!assert(nweekdate(1, 4, 2008, 1, 2), datenum(2008, 1, 9)) +# Find the fifth Wednesday in Jan 2008 in the same week as a Friday. +# It doesn't exist, so return 0 +%!assert(nweekdate(5, 4, 2008, 1, 6), 0) +# Try vector arguments +%!assert(nweekdate(1:6, 4, 2008, 1, 6), [datenum(2008, 1, 2:7:23), 0, 0]) + +# Try the lweekdate operation of this function: +# Find the last Wednesday in Jan 2008 +%!assert(nweekdate('lweekdate', 4, 2008, 1), datenum(2008, 1, 30)) +# Find the last Wednesday in Jan 2008 with a Friday +%!assert(nweekdate('lweekdate', 4, 2008, 1, 6), datenum(2008, 1, 23)) + diff --git a/octave_packages/financial-0.4.0/onbalvol.m b/octave_packages/financial-0.4.0/onbalvol.m new file mode 100644 index 0000000..4040b6a --- /dev/null +++ b/octave_packages/financial-0.4.0/onbalvol.m @@ -0,0 +1,59 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{obv} =} onbalvol (@var{closeprice}, @var{vol}) +## @deftypefnx {Function File} {@var{obv} =} onbalvol ([@var{closeprice} @var{vol}]) +## +## Compute the on balance volume of a security based on its closing +## price (@var{closeprice}) and @var{vol}ume. They may be given as +## separate arguments or as an nx2 matrix. +## +## The output will be a column vector, and the first number in the +## output is always 0. +## +## @seealso{negvolidx, posvolidx} +## @end deftypefn + +function obv = onbalvol (c, vol) + + if nargin == 1 + % do nothing + elseif nargin == 2 + c = [c(:) vol(:)]; + else + print_usage (); + endif + + obv = zeros (size (c, 1), 1); + for i = 2:size (c, 1) + if c(i,1) > c(i-1,1) + obv(i) = obv(i-1) + c(i,2); + elseif c(i,1) < c(i-1,1) + obv(i) = obv(i-1) - c(i,2); + else + obv(i) = obv(i-1); + endif + endfor + +endfunction + +## Tests +%!shared c, v, obv +%! c = [22.44 22.61 22.67 22.88 23.36 23.23 23.08 22.86 23.17 23.69 23.77 23.84 24.32 24.8 24.16 24.1 23.37 23.61 23.21]; +%! v = [10 12 23 25 34 12 32 15 15 34 54 12 86 45 32 76 89 13 28]; +%! obv = [0 12 35 60 94 82 50 35 50 84 138 150 236 281 249 173 84 97 69]'; +%!assert(onbalvol(c, v), obv) +%!assert(onbalvol([c' v']), obv) diff --git a/octave_packages/financial-0.4.0/packinfo/.autoload b/octave_packages/financial-0.4.0/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/financial-0.4.0/packinfo/DESCRIPTION b/octave_packages/financial-0.4.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..a2c203c --- /dev/null +++ b/octave_packages/financial-0.4.0/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: financial +Version: 0.4.0 +Date: 2012-04-18 +Author: Bill Denney , Kurt Hornik +Maintainer: Octave-Forge community +Title: Financial +Description: Financial manipulation, plotting functions and additional + date manipulation tools. +Depends: octave (>= 3.0.1), io (>= 1.0.18) +Autoload: yes +License: GPLv3+ +Url: http://octave.sf.net diff --git a/octave_packages/financial-0.4.0/packinfo/INDEX b/octave_packages/financial-0.4.0/packinfo/INDEX new file mode 100644 index 0000000..c0c0df4 --- /dev/null +++ b/octave_packages/financial-0.4.0/packinfo/INDEX @@ -0,0 +1,61 @@ +financial >> Financial +Financial + cfconv + cfdur + corr2cov + cov2corr + effrr + fetch + fvl + fv + google + hhigh + irr + llow + mirr + movavg + negvolidx + nomrr + nper + npv + onbalvol + pmt + posvolidx + pvl + pv + rate + rsindex + taxedrr + vol + yahoo +Plot + bolling + dateaxis + highlow + pointfig +Time + busdate + busdays + datefind + datesplit + day + daysact + easter + eomdate + fbusdate + holidays + hour + isbusday + lbusdate + lweekdate + m2xdate + minute + month + months + nweekdate + second + thirdwednesday + today + x2mdate + yeardays + year diff --git a/octave_packages/financial-0.4.0/packinfo/NEWS b/octave_packages/financial-0.4.0/packinfo/NEWS new file mode 100644 index 0000000..99dd3da --- /dev/null +++ b/octave_packages/financial-0.4.0/packinfo/NEWS @@ -0,0 +1,41 @@ +Summary of important user-visible changes for financial 0.4.0: +------------------------------------------------------------------- + + ** The following functions are new at financial 0.4.0: + + cfconv cfdur corr2cov cov2corr + + ** The following functions have been imported from the time package + which has been removed (it is now simply a dummy package that + lists the financial package as its single dependency): + + busdate busdays datefind datesplit + day daysact easter eomdate + fbusdate holidays hour isbusday + lbusdate lweekdate m2xdate minute + month months nweekdate second + thirdwednesday today x2mdate year + yeardays + + ** The following functions were made private (`fetch' should be used + directly instead): + + __fetch_google__ __fetch_yahoo__ + + ** The function `datesplit' (just imported from the time package) has + been deprecated in favour of `datevec' from Octave-core. + + ** The functions `rate' and `irr' should now be compatible with new + releases of octave. + + ** The function `fetch' should now work properly when using google + finnance to adapt to the UTF-8 file received. + + ** The function `dateaxis' should no longer enter in debug mode at the + end of its call. + + ** The package is now dependent on the io package (version 1.0.18 or + later) since the functions that it depended of from miscellaneous + package have been moved to io. + + ** Package is no longer automatically loaded. diff --git a/octave_packages/financial-0.4.0/pmt.m b/octave_packages/financial-0.4.0/pmt.m new file mode 100644 index 0000000..9b662c1 --- /dev/null +++ b/octave_packages/financial-0.4.0/pmt.m @@ -0,0 +1,66 @@ +## Copyright (C) 1995-1998, 2000-2002, 2004-2007 Kurt Hornik +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} pmt (@var{r}, @var{n}, @var{a}, @var{l}, @var{method}) +## Return the amount of periodic payment necessary to amortize a loan +## of amount a with interest rate @var{r} in @var{n} periods. +## +## The optional argument @var{l} may be used to specify a terminal +## lump-sum payment. +## +## The optional argument @var{method} may be used to specify whether +## payments are made at the end (@var{"e"}, default) or at the beginning +## (@var{"b"}) of each period. +## @seealso{pv, nper, rate} +## @end deftypefn + +function p = pmt (r, n, a, l, m) + + if (nargin < 3 || nargin > 5) + print_usage (); + endif + + if (! (isscalar (r) && r > -1)) + error ("pmt: rate must be a scalar > -1"); + elseif (! (isscalar (n) && n > 0)) + error ("pmt: n must be a positive scalar"); + elseif (! (isscalar (a) && a > 0)) + error ("pmt: a must be a positive scalar"); + endif + + if (nargin == 5) + if (! ischar (m)) + error ("pmt: `method' must be a string"); + endif + elseif (nargin == 4) + if (ischar (l)) + m = l; + l = 0; + else + m = "e"; + endif + else + l = 0; + m = "e"; + endif + + p = r * (a - l * (1 + r)^(-n)) / (1 - (1 + r)^(-n)); + + if (strcmp (m, "b")) + p = p / (1 + r); + endif + +endfunction diff --git a/octave_packages/financial-0.4.0/pointfig.m b/octave_packages/financial-0.4.0/pointfig.m new file mode 100644 index 0000000..75a5311 --- /dev/null +++ b/octave_packages/financial-0.4.0/pointfig.m @@ -0,0 +1,88 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} pointfig (@var{asset}) +## +## Plot the point figure chart of an @var{asset}. Upward price +## movements are plotted as Xs and downward movements are plotted as Os. +## +## @seealso{bolling, candle, dateaxis, highlow, movavg} +## @end deftypefn + +function pointfig (asset) + + if nargin != 1 + print_usage (); + endif + + upmask = asset(2:end) > asset(1:end-1); + # if the data is equal, it will not change the trend + equalmask = asset(2:end) == asset(1:end-1); + downmask = asset(2:end) < asset(1:end-1); + + lx = 0; + ly = 0; + direction = 0; + up = zeros(0,2); + down = zeros(0,2); + + for i = 1:length (upmask) + if direction > 0 && (upmask(i) || equalmask(i)) + ## moving in the same direction as previously: up + ly += 1; + up(end+1,:) = [lx ly]; + elseif direction < 0 && (downmask(i) || equalmask(i)) + ## moving in the same direction as previously: down + ly -= 1; + down(end+1,:) = [lx ly]; + else + ## moving in a different direction than previously + lx += 1; + if upmask(i) + up(end+1,:) = [lx ly]; + direction = 1; + else + down(end+1,:) = [lx ly]; + direction = -1; + endif + endif + endfor + + hstat = ishold(); + hold("on"); + plot(up(:,1), up(:,2), "x", "color", [0 0 1]); + plot(down(:,1), down(:,2), "o", "color", [1 0 0]); + if ! hstat + hold("off"); + endif + +endfunction + +## Tests +%!shared a +%! a = [1 2 3 2 4 2 1]; +%!test +%! [s l] = movavg(a, 2, 4); +%! assert(s, [1 1.5 2.5 2.5 3 3 1.5]) +%! assert(l, [1 1.5 2 2 2.75 2.75 2.25]) +%!test +%! [s l] = movavg(a', 2, 4); +%! assert(s, [1;1.5;2.5;2.5;3;3;1.5]) +%! assert(l, [1;1.5;2;2;2.75;2.75;2.25]) +%!test +%! [s l] = movavg(a, 3, 4, 1); +%! assert(s, [3 4.8 7 7 9.5 8 5.5]./3, 10*eps) +%! assert(l, [1 11/7 20/9 2.2 3 2.7 2], 10*eps) diff --git a/octave_packages/financial-0.4.0/posvolidx.m b/octave_packages/financial-0.4.0/posvolidx.m new file mode 100644 index 0000000..fefc77b --- /dev/null +++ b/octave_packages/financial-0.4.0/posvolidx.m @@ -0,0 +1,82 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{pvi} =} posvolidx (@var{closeprice}, @var{vol}) +## @deftypefnx {Function File} {@var{pvi} =} posvolidx ([@var{closeprice} @var{vol}]) +## @deftypefnx {Function File} {@var{pvi} =} posvolidx (@var{closeprice}, @var{vol}, @var{initpvi}) +## @deftypefnx {Function File} {@var{pvi} =} posvolidx ([@var{closeprice} @var{vol}], @var{initpvi}) +## +## Compute the positive volume index of a security based on its closing +## price (@var{closeprice}) and @var{vol}ume. They may be given as +## separate arguments or as an nx2 matrix. If given, the @var{initpvi} +## is the starting value of the pvi (default: 100). +## +## The @var{pvi} will always be a column vector. +## +## @seealso{onbalvol, negvolidx} +## @end deftypefn + +function pvi = posvolidx (c, vol, initpvi) + + default_pvi = 100; + pvi = zeros (length (c), 1); + if isvector (c) + if nargin < 2 + ## a closing price was given without a volume + print_usage (); + elseif isscalar (vol) + ## probably initpvi was given as the second argument + print_usage (); + elseif !isvector (vol) + print_usage (); + elseif length (c) != length (vol) + error ("closeprice and vol must be the same length"); + endif + c = [c(:) vol(:)]; + if nargin < 3 + pvi(1) = default_pvi; + else + pvi(1) = initpvi; + endif + elseif size (c, 2) != 2 + error ("If given as a matrix, c must have exactly two columns.") + elseif size (c, 2) == 2 + if nargin == 2 + pvi(1) = vol; + else + pvi(1) = default_pvi; + endif + else + print_usage (); + endif + + ## Start doing the work + for i = 2:size (c, 1) + pvi(i) = pvi(i-1) + (c(i,2) > c(i-1,2))*pvi(i-1)*(c(i,1)-c(i-1,1))/c(i-1,1); + endfor + +endfunction + +## Tests +%!shared c, v, pvia, pvib +%! c = [22.44 22.61 22.67 22.88 23.36 23.23 23.08 22.86 23.17 23.69 23.77 23.84 24.32 24.8 24.16 24.1 23.37 23.61 23.21]; +%! v = [10 12 23 25 34 12 32 15 15 34 54 12 86 45 32 76 89 13 28]; +%! pvia = [100 100.7575758 101.0249554 101.9607843 104.0998217 104.0998217 103.4276318 103.4276318 103.4276318 105.7488389 106.1059477 106.1059477 108.242309 108.242309 108.242309 107.9734953 104.7029289 104.7029289 102.9290546]'; +%! pvib = [5 5.037878788 5.051247772 5.098039216 5.204991087 5.204991087 5.171381588 5.171381588 5.171381588 5.287441943 5.305297383 5.305297383 5.412115451 5.412115451 5.412115451 5.398674767 5.235146444 5.235146444 5.14645273]'; +%!assert(posvolidx(c, v), pvia, 1e-5) +%!assert(posvolidx([c' v']), pvia, 1e-5) +%!assert(posvolidx(c, v, 5), pvib, 1e-5) +%!assert(posvolidx([c' v'], 5), pvib, 1e-5) diff --git a/octave_packages/financial-0.4.0/private/fetch_google.m b/octave_packages/financial-0.4.0/private/fetch_google.m new file mode 100644 index 0000000..72db813 --- /dev/null +++ b/octave_packages/financial-0.4.0/private/fetch_google.m @@ -0,0 +1,102 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {[@var{data} @var{fields}] =} +## fetch_google (@var{conn}, @var{symbol}, @var{fromdate}, @var{todate}, @var{period}) +## +## Download stock data from google. (Helper for fetch.) +## +## @var{fields} are the data fields returned by Google. +## +## @var{fromdate} and @var{todate} is the date datenum for the requested +## date range. If you enter today's date, you will get yesterday's +## data. +## +## @var{period} (default: "d") allows you to select the period for the +## data which can be any of +## @itemize @bullet +## @item 'd': daily +## @item 'w': weekly +## @end itemize +## +## @seealso{google, fetch} +## @end deftypefn + +## FIXME: Actually use the proxy info if given in the connection. +## FIXME: Do not ignore the fields input. + +function [data fields] = fetch_google (conn=[], symbol="", + fromdate, todate, period="d") + + periods = struct("d", "daily", "w", "weekly"); + if strcmpi (conn.url, "http://finance.google.com") + fromdatestr = datestr (fromdate); + todatestr = datestr (todate); + ## http://finance.google.com/finance/historical?q=T&startdate=Sep+1%2C+2007&enddate=Aug+31%2C+2008&histperiod=weekly&output=csv + geturl = sprintf (["http://finance.google.com/finance/" ... + "historical?" ... + "q=%s&startdate=%s&enddate=%s&" ... + "histperiod=%s&output=csv"], + symbol, fromdatestr, todatestr, periods.(period)); + ## FIXME: This would be more efficient if csv2cell could work on + ## strings instead of files. + [f, success, msg] = urlwrite (geturl, tmpnam ()); + if ! success + error (["Could not write Google data to tmp file:" ... + "\n%s\nURL was:\n%s"], msg, geturl) + endif + d = csv2cell (f); + d{1,1} = d{1,1}(4:end); # Remove byte order mark (BOM) + unlink(f); + ## Pull off the header + fields = d(1,:); + d(1,:) = []; + ## Put the dates into datenum format + data = [datenum(datevec(d(:,1), "dd-mmm-yy")), \ + cell2mat(d(:,2:end))]; + ## Note that google appears to have an off-by-one error in + ## returning historical data, so make sure that we only return the + ## requested data and not what Google sent. + data((data(:,1) < fromdate) | (data(:,1) > todate), :) = []; + else + error ("Non-google connection passed to google fetch") + endif + +endfunction + +%!shared fgood, dgood, wgood +%! fgood = {"Date", "Open", "High", "Low", "Close", "Volume"}; +%! dgood = [732501,34.77,34.87,34.25,34.62,15296900; +%! 732500,33.87,34.77,33.72,34.63,16265900; +%! 732499,34.64,34.97,34.03,34.12,13451500; +%! 732498,34.25,35.08,34.20,34.60,15845100; +%! 732494,34.76,34.85,34.22,34.44,9740300]; +%! wgood = [732501,34.25,35.08,33.72,34.62,60859400; +%! 732494,35.88,36.24,34.22,34.44,67132100]; +%!test +%! [d f] = fetch_google (google(), "yhoo", 732494, 732501, "d"); +%! assert(d, dgood, eps); +%! assert(f, fgood, eps); +## test that the automatic period works +%!test +%! [d f] = fetch_google (google(), "yhoo", 732494, 732501); +%! assert(d, dgood, eps); +%! assert(f, fgood, eps); +## Test that weekly works +%!test +%! [d f] = fetch_google (google(), "yhoo", 732494, 732501, "w"); +%! assert(d, wgood, eps); +%! assert(f, fgood, eps); diff --git a/octave_packages/financial-0.4.0/private/fetch_yahoo.m b/octave_packages/financial-0.4.0/private/fetch_yahoo.m new file mode 100644 index 0000000..dfddfeb --- /dev/null +++ b/octave_packages/financial-0.4.0/private/fetch_yahoo.m @@ -0,0 +1,98 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {[@var{data} @var{fields}] =} +## fetch_yahoo (@var{conn}, @var{symbol}, @var{fromdate}, @var{todate}, @var{period}) +## +## Download stock data from yahoo. (Helper for fetch.) +## +## @var{fields} are the data fields returned by Yahoo. +## +## @var{fromdate} and @var{todate} is the date datenum for the requested +## date range. If you enter today's date, you will get yesterday's +## data. +## +## @var{period} (default: "d") allows you to select the period for the +## data which can be any of +## @itemize @bullet +## @item 'd': daily +## @item 'w': weekly +## @item 'm': monthly +## @item 'v': dividends +## @end itemize +## +## @seealso{yahoo, fetch} +## @end deftypefn + +## FIXME: Actually use the proxy info if given in the connection. +## FIXME: Do not ignore the fields input. + +function [data fields] = fetch_yahoo (conn=[], symbol="", + fromdate, todate, period="d") + + if strcmpi (conn.url, "http://quote.yahoo.com") + fromdate = datevec (fromdate); + todate = datevec (todate); + geturl = sprintf (["http://ichart.finance.yahoo.com/table.csv" ... + "?s=%s&d=%d&e=%d&f=%d&g=%s&a=%d&b=%d&c=%d&" ... + "ignore=.csv"], + symbol, todate(2)-1, todate(3), todate(1), + period, + fromdate(2)-1, fromdate(3), fromdate(1)); + ## FIXME: This would be more efficient if csv2cell could work on + ## strings instead of files. + [f, success, msg] = urlwrite (geturl, tmpnam ()); + if ! success + error ("Could not write Yahoo data to tmp file:\n%s", msg) + endif + d = csv2cell (f); + unlink(f); + ## Pull off the header + fields = d(1,:); + d(1,:) = []; + dates = strvcat (d(:,1)); + dates = datenum(str2num(dates(:,1:4)), + str2num(dates(:,6:7)), + str2num(dates(:,9:10))); + data = [dates, cell2mat(d(:,2:end))]; + else + error ("Non-yahoo connection passed to yahoo fetch") + endif + +endfunction + +%!shared fgood, dgood +%! fgood = {"Date", "Open", "High", "Low", "Close", "Volume", "Adj Close"}; +%! dgood = [732501,34.77,34.87,34.25,34.62,15515400,34.62; +%! 732500,33.87,34.77,33.72,34.63,16354300,34.63; +%! 732499,34.64,34.97,34.03,34.12,13585700,34.12; +%! 732498,34.25,35.08,34.20,34.60,16086700,34.60; +%! 732494,34.76,34.85,34.22,34.44,9861600,34.44]; +%!test +%! [d f] = fetch_yahoo (yahoo(), "yhoo", 732494, 732501, "d"); +%! assert(d, dgood, eps); +%! assert(f, fgood, eps); +## test that the automatic period works +%!test +%! [d f] = fetch_yahoo (yahoo(), "yhoo", 732494, 732501); +%! assert(d, dgood, eps); +%! assert(f, fgood, eps); + +## The test below fails because yahoo gives a different volume on 732498 +##%!xtest +##%! [d f] = fetch(yahoo(), "yhoo", "01-Jul-2005", "10-Jul-2005", "w"); +##%! assert(d, dgood(4:5,:), eps); +##%! assert(f, fgood, eps); diff --git a/octave_packages/financial-0.4.0/pv.m b/octave_packages/financial-0.4.0/pv.m new file mode 100644 index 0000000..8585a20 --- /dev/null +++ b/octave_packages/financial-0.4.0/pv.m @@ -0,0 +1,74 @@ +## Copyright (C) 1995-1996, 1998, 2000, 2002, 2004-2007 Kurt Hornik +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} pv (@var{r}, @var{n}, @var{p}, @var{l}, @var{method}) +## Returns the present value of an investment that will pay off @var{p} for @var{n} +## consecutive periods, assuming an interest @var{r}. +## +## The optional argument @var{l} may be used to specify an additional +## lump-sum payment made at the end of @var{n} periods. +## +## The optional argument @var{method} may be used to specify whether +## payments are made at the end (@code{"e"}, default) or at the +## beginning (@code{"b"}) of each period. +## +## Note that the rate @var{r} is specified as a fraction (i.e., 0.05, +## not 5 percent). +## @seealso{pmt, nper, rate, npv} +## @end deftypefn + +function v = pv (r, n, p, l, m) + + if (nargin < 3 || nargin > 5) + print_usage (); + endif + + if (! (isscalar (r) && r > -1)) + error ("pv: r must be a scalar > -1"); + elseif (! (isscalar (n) && n > 0)) + error ("pv: n must be a positive scalar"); + elseif (! isscalar (p)) + error ("pv: p must be a scalar"); + endif + + if (r != 0) + v = p * (1 - (1 + r)^(-n)) / r; + else + v = p * n; + endif + + if (nargin > 3) + if (nargin == 5) + if (! ischar (m)) + error ("pv: `method' must be a string"); + endif + elseif (ischar (l)) + m = l; + l = 0; + else + m = "e"; + endif + if (strcmp (m, "b")) + v = v * (1 + r); + endif + if (isscalar (l)) + v = v + pvl (r, n, l); + else + error ("pv: l must be a scalar"); + endif + endif + +endfunction diff --git a/octave_packages/financial-0.4.0/pvl.m b/octave_packages/financial-0.4.0/pvl.m new file mode 100644 index 0000000..d6dbcb0 --- /dev/null +++ b/octave_packages/financial-0.4.0/pvl.m @@ -0,0 +1,42 @@ +## Copyright (C) 1995-1998, 2000, 2002, 2005-2007 Kurt Hornik +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{v} =} pvl (@var{r}, @var{n}, @var{p}) +## Return the present value @var{v} of an investment that will pay off @var{p} +## in one lump sum at the end of @var{n} periods, given the interest +## rate @var{r}. +## +## Note that the rate @var{r} is specified as a fraction (i.e., 0.05, +## not 5 percent). +## @end deftypefn + +function v = pvl (r, n, p) + + if (nargin != 3) + print_usage (); + endif + + if (! (isscalar (r) && (r > -1))) + error ("pvl: r has to be a scalar > -1"); + elseif (! (isscalar (n) && n > 0)) + error ("pvl: n has to be a positive scalar"); + elseif (! isscalar (p)) + error ("pvl: p has to be a scalar"); + endif + + v = p / (1 + r)^n; + +endfunction diff --git a/octave_packages/financial-0.4.0/rate.m b/octave_packages/financial-0.4.0/rate.m new file mode 100644 index 0000000..64d02f8 --- /dev/null +++ b/octave_packages/financial-0.4.0/rate.m @@ -0,0 +1,67 @@ +## Copyright (C) 1995-1998, 2000, 2002, 2004-2007 Kurt Hornik +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{r} =} rate (@var{n}, @var{p}, @var{v}) +## @deftypefnx {Function File} {@var{r} =} rate (@var{n}, @var{p}, @var{v}, @var{l}) +## @deftypefnx {Function File} {@var{r} =} rate (@var{n}, @var{p}, @var{v}, @var{l}, @var{method}) +## @deftypefnx {Function File} {@var{r} =} rate (@var{n}, @var{p}, @var{v}, @var{method}) +## Return the rate of return @var{r} on an investment of present value @var{v} +## which pays @var{p} in @var{n} consecutive periods. +## +## The optional argument @var{l} may be used to specify an additional +## lump-sum payment made at the end of @var{n} periods. +## +## The optional string argument @var{method} may be used to specify +## whether payments are made at the end (@code{"e"}, default) or at the +## beginning (@code{"b"}) of each period. +## @seealso{pv, pmt, nper, npv} +## @end deftypefn + +function r = rate (n, p, v, l = 0, m = "e") + + if (nargin < 3 || nargin > 5) + print_usage (); + elseif (!isnumeric (n) || !isscalar (n) || n <= 0) + error ("number of consecutive periods `n' must be a positive scalar"); + elseif (!isnumeric (p) || !isscalar (p)) + error ("second argument `p' must be a numeric scalar"); + elseif (!isnumeric (v) || !isscalar (v)) + error ("present value `v' must be a numeric scalar"); + + ## the following checks is to allow using default value for `l' while specifying `m' + elseif (nargin == 5) + if (!isnumeric (l) || !isscalar (l)) + error ("value of additional lump-sum payment `l' must be numeric scalar"); + elseif (!ischar (m)) + error ("`method' must be a string") + endif + elseif (nargin == 4) + if (ischar (l)) + m = l; + l = 0; # default value for `l' again + elseif (!isnumeric (l) || !isscalar (l)) + error ("fourth argument must either be a numeric scalar for lump-sum payment `l' or a string for `method'"); + endif + endif + + if (!any (strcmpi (l, {"e","b"}))) + error ("`method' must either be `e' or `b") + endif + + f = @(x) pv (x, n, p, l, m) - v; + r = fsolve (f, 0); + +endfunction diff --git a/octave_packages/financial-0.4.0/rsindex.m b/octave_packages/financial-0.4.0/rsindex.m new file mode 100644 index 0000000..670488c --- /dev/null +++ b/octave_packages/financial-0.4.0/rsindex.m @@ -0,0 +1,66 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{rsi} =} rsindex (@var{closeprice}) +## @deftypefnx {Function File} {@var{rsi} =} rsindex (@var{closeprice}, @var{nperiods}) +## +## Compute the relative strength index (RSI) of an asset from the vector +## of closing prices (@var{closeprice}). @var{nperiods} defines the +## number of periods that the rsi should be calculated for +## (default: 14). +## +## The beginning of the @var{rsi} is padded with nans to match the size +## of @var{closeprice}. +## +## @end deftypefn + +function rsi = rsindex (cl, n = 14) + + if nargin < 1 || nargin > 2 + print_usage (); + elseif n > length(cl) + error ("nperiods must be <= the length of closeprice") + elseif ! isvector (cl) + error ("closeprice must be a vector") + endif + + diff = cl(2:end) - cl(1:end-1); + rsi = nan (size (cl)); + + for i = n:length (cl) + changes = diff(i-n+1:i-1); + downs = changes < 0; + ups = changes > 0; + if isempty (downs) + ## prevent division by zero + rsi(i) = 100; + elseif isempty (ups) + rsi(i) = 0; + else + ups = sum(changes(ups)); + downs = -sum(changes(downs)); + rsi(i) = 100*(1-1/(1+ups/downs)); + endif + endfor + +endfunction + +## Tests +%!shared c, r +%! c = [22.44 22.61 22.67 22.88 23.36 23.23 23.08 22.86 23.17 23.69 23.77 23.84 24.32 24.8 24.16 24.1 23.37 23.61 23.21]; +%! r = [nan(1, 13) 85.1190 70.235 68.6684 55.6322 53.0414 49.7717]; +%!assert(rsindex(c), r, 0.0001) +%!assert(rsindex(c'), r', 0.0001) diff --git a/octave_packages/financial-0.4.0/second.m b/octave_packages/financial-0.4.0/second.m new file mode 100644 index 0000000..8f5831f --- /dev/null +++ b/octave_packages/financial-0.4.0/second.m @@ -0,0 +1,30 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {s =} second (Date) +## +## Returns the second from a serial date number or a date string. +## +## @seealso{date, datevec, now, hour, minute} +## @end deftypefn + +function t = second (dates) + + t = datevec (dates); + t = t (:,6); + +endfunction + diff --git a/octave_packages/financial-0.4.0/taxedrr.m b/octave_packages/financial-0.4.0/taxedrr.m new file mode 100644 index 0000000..2501ac7 --- /dev/null +++ b/octave_packages/financial-0.4.0/taxedrr.m @@ -0,0 +1,38 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{return} =} taxedrr (@var{pretaxreturn}, @var{taxrate}) +## Compute the taxed rate of @var{return} based on a @var{pretaxreturn} +## rate and a @var{taxrate}. +## @seealso{irr, effrr, nomrr, pvvar, xirr} +## @end deftypefn + +function rate = taxedrr (pretax, taxrate) + + if (nargin != 2) + print_usage (); + elseif (taxrate < 0 || taxrate > 1) + error ("taxedrr: taxrate must be between 0 and 1") + endif + + rate = pretax.*(1-taxrate); + +endfunction + +## Tests +%!assert (taxedrr (0.12, 0.30), 0.084, 10*eps) +%!assert (taxedrr (0.12, 0), 0.12, 10*eps) +%!assert (taxedrr (0.12, 1), 0, 10*eps) diff --git a/octave_packages/financial-0.4.0/thirdwednesday.m b/octave_packages/financial-0.4.0/thirdwednesday.m new file mode 100644 index 0000000..18ce73d --- /dev/null +++ b/octave_packages/financial-0.4.0/thirdwednesday.m @@ -0,0 +1,68 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[begindate, enddate]} = thirdwednesday (month, year) +## +## Find the third Wednesday of the month specified by the @var{month} +## and @var{year}. The @var{begindate} is the third Wednesday of the +## month, and the @var{enddate} is three months after that. Outputs are +## in the form of datenums. +## +## The third Wednesday is used for Eurodollar futures. +## +## @seealso{nweekdate, datenum} +## @end deftypefn + +function [wednesdays, enddate] = thirdwednesday (month, year) + + if nargin ~= 2 + print_usage (); + elseif ~ ((numel(year) == 1) || + (numel(month) == 1) || + ~isequal (size (month), size (year))) + error("month and year must have the same size or one of them must be a scalar") + endif + + if numel (year) == 1 + sz = size (month); + else + sz = size (year); + endif + + wednesdays = nweekdate (3, 4, year, month); + dates = datevec (wednesdays); + ## adjust the year when the date will wrap + dates(:,1) += dates (:,2) > 9; + ## adjust the month by three + dates(:,2) = mod (dates(:,2) + 2, 12) + 1; + enddate = reshape (datenum (dates), sz); + +endfunction + +## Tests +%!shared m, y, bt, et +%! m = (1:12)'; +%! y = 2008; +%! bt = datenum(2008, m, [16;20;19;16;21;18;16;20;17;15;19;17]); +%! et = datenum([2008*ones(9,1);2009*ones(3,1)], [4:12 1:3]', [16;20;19;16;21;18;16;20;17;15;19;17]); +%!test +%! [b e] = thirdwednesday (m, y); +%! assert(b, bt) +%! assert(e, et) +%!test +%! [b e] = thirdwednesday (m', y); +%! assert(b, bt') +%! assert(e, et') diff --git a/octave_packages/financial-0.4.0/today.m b/octave_packages/financial-0.4.0/today.m new file mode 100644 index 0000000..6ca1c99 --- /dev/null +++ b/octave_packages/financial-0.4.0/today.m @@ -0,0 +1,32 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {datenum =} today () +## Returns the current local date as the number of days since Jan 1, 0000. +## By this reckoning, Jan 1, 1970 is day number 719529. +## +## The returned number corresponds to 00:00:00 today. +## +## The returned value is also called a "serial date number" +## (see @code{datenum}). +## @seealso{clock, date, datenum, now} +## @end deftypefn + +function t = today () + + t = floor (now ()); + +endfunction diff --git a/octave_packages/financial-0.4.0/vol.m b/octave_packages/financial-0.4.0/vol.m new file mode 100644 index 0000000..0444ed5 --- /dev/null +++ b/octave_packages/financial-0.4.0/vol.m @@ -0,0 +1,70 @@ +## Copyright (C) 1995-1998, 2000, 2002, 2005-2007 Friedrich Leisch +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{volat} =} vol (@var{x}, @var{m}, @var{n}) +## Return the volatility @var{volat} of each column of the input matrix @var{x}. +## +## The number of data sets per period is given by @var{m} (e.g. the +## number of data per year if you want to compute the volatility per +## year). The optional parameter @var{n} gives the number of past +## periods used for computation, if it is omitted, a value of 1 is used. +## +## If @var{t} is the number of rows of @var{x}, @code{vol} returns the +## volatility from @code{n*m} to @var{t}. +## +## @end deftypefn + +function retval = vol (X, m, n) + + if (nargin < 2) + print_usage (); + endif + + [xr, xc] = size (X); + + if (nargin > 2) + if (n * m > xr) + error ("vol: I need more data!"); + endif + else + n = 1; + if (n * m > xr) + error ("vol: I need more data!"); + endif + endif + + U = zeros (xr - 1, xc); + + if (all (X)) + U = X ((2 : xr), :) ./ X((1 : (xr-1)), :); + else + error ("vol: zero element in X"); + endif + + U = log(U); + U = U - ones (xr - 1, 1) * sum (U) / (xr - 1); + + retval = zeros (xr - n * m, xc); + + retval(1, :) = sumsq (U((1 : n*m), :)); + for i = 2 : (xr - n * m) + retval(i, :) = retval(i - 1, :) ... + - U(i - 1, :).^2 + U(i + n * m - 1, :).^2; + endfor + + retval = sqrt (retval * m / (n * m - 1)); + +endfunction diff --git a/octave_packages/financial-0.4.0/x2mdate.m b/octave_packages/financial-0.4.0/x2mdate.m new file mode 100644 index 0000000..7db9743 --- /dev/null +++ b/octave_packages/financial-0.4.0/x2mdate.m @@ -0,0 +1,75 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {datenums =} x2mdate (exceldatenums) +## @deftypefnx {Function File} {datenums =} x2mdate (exceldatenums, convention) +## @deftypefnx {Function File} {datenums =} x2mdate (exceldatenums, convention, "ExcelBug") +## +## Convert @var{datenums} from the Microsoft Excel date format to the +## format used by @code{datenum}. If set to 0 (default, Excel for +## Windows), @var{convention} specifies to use the Excel 1900 convention +## where Jan 1, 1900 corresponds to Excel serial date number 1. If set +## to 1 (Excel for Mac), @var{convention} specifies to use the Excel +## 1904 convention where Jan 1, 1904 corresponds to Excel serial date +## number 0. +## +## Note that this does not take into account the Excel bug where 1900 is +## considered to be a leap year unless you give the "ExcelBug" option. +## +## Excel does not represent dates prior to 1 January 1900 using this +## format, so a warning will be issued if any dates preceed this date. +## +## @seealso{datenum, x2mdate} +## @end deftypefn + +function dates = x2mdate (dates, convention, excelbug) + + if nargin == 1 + convention = 0; + excelbug = false(); + elseif nargin == 2 + excelbug = false(); + elseif nargin == 3 + excelbug = strcmpi(excelbug, "ExcelBug"); + else + print_usage (); + endif + + if any (dates < 0) + warning ("Negative date found, this will not work within MS Excel.") + endif + + if convention == 0 + adj = datenum(1900, 1, 1) - 2; + elseif convention == 1 + adj = datenum(1904, 1, 1); + endif + + if excelbug + datemask = (dates < 61); + dates(datemask) = dates(datemask) + 1; + endif + dates = dates + adj; + +endfunction + +## Tests +%!assert(x2mdate(39448), datenum(2008, 1, 1)) +%!assert(x2mdate([39083 39448]), datenum(2007:2008, 1, 1)) +%!assert(x2mdate(2), datenum(1900, 1, 1)) +%!assert(x2mdate(1, 0, "ExcelBug"), datenum(1900, 1, 1)) +%!assert(x2mdate(0, 1), datenum(1904, 1, 1)) + diff --git a/octave_packages/financial-0.4.0/yahoo.m b/octave_packages/financial-0.4.0/yahoo.m new file mode 100644 index 0000000..1088d5b --- /dev/null +++ b/octave_packages/financial-0.4.0/yahoo.m @@ -0,0 +1,44 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{conn} =} yahoo () +## @deftypefnx {Function File} {@var{conn} =} yahoo (@var{URL}, @var{ipaddress}, @var{port}) +## +## Prepare a Yahoo connection for the fetch command to get Yahoo +## historical quote data. +## +## If given, the @var{URL} must be "http://quote.yahoo.com". The +## @var{ipaddress} and @var{port} is the proxy ipaddress and port. These +## parameters are currently ignored (with a warning if given). +## +## @seealso{fetch, google} +## @end deftypefn + +## FIXME: Actually use the proxy info if given. + +function conn = yahoo (url="http://quote.yahoo.com", ipaddr="", port=[]) + + if ! strcmpi (url, "http://quote.yahoo.com") + error ("url must be 'http://quote.yahoo.com'") + elseif ! (isempty (ipaddr) && isempty (port)) + warning ("Proxy information is currently ignored") + endif + + conn.url = url; + conn.ip = ipaddr; + conn.port = port; + +endfunction diff --git a/octave_packages/financial-0.4.0/year.m b/octave_packages/financial-0.4.0/year.m new file mode 100644 index 0000000..ae522e4 --- /dev/null +++ b/octave_packages/financial-0.4.0/year.m @@ -0,0 +1,30 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {y =} year (Date) +## +## Returns the year from a serial date number or a date string. +## +## @seealso{date, datevec, now, day, month} +## @end deftypefn + +function t = year (dates) + + t = datevec (dates); + t = t (:,1); + +endfunction + diff --git a/octave_packages/financial-0.4.0/yeardays.m b/octave_packages/financial-0.4.0/yeardays.m new file mode 100644 index 0000000..ed99a7e --- /dev/null +++ b/octave_packages/financial-0.4.0/yeardays.m @@ -0,0 +1,111 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{d} =} yeardays (@var{y}) +## @deftypefnx {Function File} {@var{d} =} yeardays (@var{y}, @var{b}) +## Return the number of days in the year @var{y} with an optional basis +## @var{b}. +## +## Valid bases +## @itemize @bullet +## @item 0 +## actual/actual (default) +## @item 1 +## 30/360 (SIA) +## @item 2 +## actual/360 +## @item 3 +## actual/365 +## @item 4 +## 30/360 (PSA) +## @item 5 +## 30/360 (IDSA) +## @item 6 +## 30/360 (European) +## @item 7 +## actual/365 (Japanese) +## @item 8 +## actual/actual (ISMA) +## @item 9 +## actual/360 (ISMA) +## @item 10 +## actual/365 (ISMA) +## @item 11 +## 30/360E (ISMA) +## @end itemize +## @seealso{days365, days360, daysact, daysdif} +## @end deftypefn + +function d = yeardays (y, basis) + + if (nargin == 1) + basis = 0; + elseif (nargin != 2) + print_usage (); + endif + + if isscalar (y) + d = zeros (size (basis)); + elseif isscalar (basis) + ## the rest of the code is much simpler if you can be sure that + ## basis is a matrix if y is a matrix + basis = basis * ones (size (y)); + d = zeros (size (y)); + else + if ndims (y) == ndims (basis) + if ~ all (size (y) == size (basis)) + error ("year and basis must be the same size or one must be a scalar"); + else + d = zeros (size (y)); + endif + else + error ("year and basis must be the same size or one must be a scalar.") + endif + endif + + bact = ismember (basis(:), [0 8]); + b360 = ismember (basis(:), [1 2 4 5 6 9 11]); + b365 = ismember (basis(:), [3 7 10]); + + badbasismask = ~ (bact | b360 | b365); + if any (badbasismask) + badbasis = unique (basis(badbasismask)); + error ("Unsupported basis: %g\n", badbasis) + endif + + d(bact) = 365 + (eomday(y(bact), 2) == 29); + d(b360) = 360; + d(b365) = 365; + +endfunction + +## Tests +%!assert(yeardays(2000), 366) +%!assert(yeardays(2001), 365) +%!assert(yeardays(2000:2004), [366 365 365 365 366]) +%!assert(yeardays(2000, 0), 366) +%!assert(yeardays(2000, 1), 360) +%!assert(yeardays(2000, 2), 360) +%!assert(yeardays(2000, 3), 365) +%!assert(yeardays(2000, 4), 360) +%!assert(yeardays(2000, 5), 360) +%!assert(yeardays(2000, 6), 360) +%!assert(yeardays(2000, 7), 365) +%!assert(yeardays(2000, 8), 366) +%!assert(yeardays(2000, 9), 360) +%!assert(yeardays(2000, 10), 365) +%!assert(yeardays(2000, 11), 360) + diff --git a/octave_packages/fixed-0.7.10/PKG_ADD b/octave_packages/fixed-0.7.10/PKG_ADD new file mode 100644 index 0000000..1523018 --- /dev/null +++ b/octave_packages/fixed-0.7.10/PKG_ADD @@ -0,0 +1,5 @@ + +dispatch ("sort", "fsort", "fixed scalar") +dispatch ("sort", "fsort", "fixed matrix") +dispatch ("sort", "fsort", "fixed complex") +dispatch ("sort", "fsort", "fixed complex matrix") diff --git a/octave_packages/fixed-0.7.10/concat.m b/octave_packages/fixed-0.7.10/concat.m new file mode 100644 index 0000000..f0f1200 --- /dev/null +++ b/octave_packages/fixed-0.7.10/concat.m @@ -0,0 +1,105 @@ +## Copyright (C) 2003 Motorola Inc +## Copyright (C) 2003 David Bateman +## +## 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} =} concat (@var{a}, @var{b}) +## @deftypefnx {Function File} {@var{x} =} concat (@var{a}, @var{b}, @var{dim}) +## Concatenate two matrices regardless of their type. Due to the implementation +## of the matrix concatenation in Octave being hard-coded for the types it +## knowns, user types can not use the matrix concatenation operator. Thus +## for the @emph{Galois} and @emph{Fixed Point} types, the in-built matrix +## concatenation functions will return a matrix value as their solution. +## +## This function allows these types to be concatenated. If called with a +## user type that is not known by this function, the in-built concatenate +## function is used. +## +## If @var{dim} is 1, then the matrices are concatenated, else if @var{dim} +## is 2, they are stacked. +## @end deftypefn + +function y = concat ( a, b, dim) + + if (nargin < 2) || (nargin > 3) + usage("concat(a, b, [dim])"); + elseif (nargin == 2) + dim = 1; + endif + + done = 0; + ## Protect this with try for the case is the Galois package isn't installed + try + if (isgalois(a) || isgalois(b)) + if (isgalois(a)) + m = a.m; + p = a.prim_poly; + ax = a.x; + if isgalois(b) + if ((b.m != m) || (b.prim_poly != p)) + error("concat: incompatiable galois variables"); + else + bx = b.x; + endif + else + bx = b; + endif + else + ax = a; + m = b.m; + p = b.prim_poly; + bx = b.x; + endif + if (dim == 1) + y = gf([ax, bx], m, p); + else + y = gf([ax; bx], m, p); + endif + done = 1; + endif + catch + end + + ## Protect this with try for the case is the fixed package isn't installed + if (! done) + try + if (isfixed(a) || isfixed(b)) + if (!isfixed(a)) + a = fixed(a); + endif + if (!isfixed(b)) + b = fixed(b); + endif + if (dim == 1) + y = fixed([a.int, b.int], [a.dec, b.dec], [a.x, b.x]); + else + y = fixed([a.int; b.int], [a.dec; b.dec], [a.x; b.x]); + endif + done = 1; + endif + catch + end + endif + + if (!done) + fprintf("What are we doing here!!\n"); + if (dim == 1) + y = [a, b]; + else + y = [a; b]; + endif + endif + +endfunction diff --git a/octave_packages/fixed-0.7.10/create_lookup_table.m b/octave_packages/fixed-0.7.10/create_lookup_table.m new file mode 100644 index 0000000..1d4975a --- /dev/null +++ b/octave_packages/fixed-0.7.10/create_lookup_table.m @@ -0,0 +1,33 @@ +## Copyright (C) 2003 Motorola Inc +## Copyright (C) 2003 David Bateman +## +## 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{table} =} create_lookup_table (@var{x}, @var{y}) +## Creates a lookup table betwen the vectors @var{x} and @var{y}. If @var{x} +## is not in increasing order, the vectors are sorted before being stored. +## @end deftypefn + +function table = create_lookup_table (x, y) + if any(size(x) != size(y)) + error("create_lookup_table: tables must have the same dimension"); + elseif ! isvector(x) + error("create_lookup_table: tables must be vectors"); + else + ## This assumes that fsort is overloading sort for fixed point types + [table.x, idx] = sort(x); + table.y = y(idx); + endif +endfunction diff --git a/octave_packages/fixed-0.7.10/doc-cache b/octave_packages/fixed-0.7.10/doc-cache new file mode 100644 index 0000000..0324703 --- /dev/null +++ b/octave_packages/fixed-0.7.10/doc-cache @@ -0,0 +1,244 @@ +# Created by Octave 3.6.1, Tue Apr 03 18:18:25 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 6 +# name: +# type: sq_string +# elements: 1 +# length: 6 +concat + + +# name: +# type: sq_string +# elements: 1 +# length: 733 + -- Function File: X = concat (A, B) + -- Function File: X = concat (A, B, DIM) + Concatenate two matrices regardless of their type. Due to the + implementation of the matrix concatenation in Octave being + hard-coded for the types it knowns, user types can not use the + matrix concatenation operator. Thus for the _Galois_ and _Fixed + Point_ types, the in-built matrix concatenation functions will + return a matrix value as their solution. + + This function allows these types to be concatenated. If called + with a user type that is not known by this function, the in-built + concatenate function is used. + + If DIM is 1, then the matrices are concatenated, else if DIM is 2, + they are stacked. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Concatenate two matrices regardless of their type. + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +create_lookup_table + + +# name: +# type: sq_string +# elements: 1 +# length: 193 + -- Function File: TABLE = create_lookup_table (X, Y) + Creates a lookup table betwen the vectors X and Y. If X is not in + increasing order, the vectors are sorted before being stored. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Creates a lookup table betwen the vectors X and Y. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +fixedpoint + + +# name: +# type: sq_string +# elements: 1 +# length: 1356 + -- Function File: fixedpoint ('help') + -- Function File: fixedpoint ('info') + -- Function File: fixedpoint ('info', MOD) + -- Function File: fixedpoint ('test') + -- Function File: fixedpoint ('test', MOD) + Manual and test code for the Octave Fixed Point toolbox. There are + 5 possible ways to call this function. + + `fixedpoint ('help')' + Display this help message. Called with no arguments, this + function also displays this help message + + `fixedpoint ('info')' + Open the Fixed Point toolbox manual + + `fixedpoint ('info', MOD)' + Open the Fixed Point toolbox manual at the section specified + by MOD + + `fixedpoint ('test')' + Run all of the test code for the Fixed Point toolbox. MOD. + + Valid values for the varibale MOD are + + 'basics' + The section describing the use of the fixed point toolbox + within Octave + + 'programming' + The section descrining how to use the fixed-point type with + oct-files + + 'example' + The section describing an in-depth example of the use of the + fixed-point type + + 'reference' + The refernce section of all of the specific fixed point + operators and functions + + Please note that this function file should be used as an example + of the use of this toolbox. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 +Manual and test code for the Octave Fixed Point toolbox. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +float + + +# name: +# type: sq_string +# elements: 1 +# length: 203 + -- Function File: Y = float (X) + Converts a fixed point object to the equivalent floating point + object. This is equivalent to `X.x' if `isfixed(X)' returns true, + and returns X otherwise. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +Converts a fixed point object to the equivalent floating point object. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +fsort + + +# name: +# type: sq_string +# elements: 1 +# length: 712 + -- Function File: [S, I] = fsort (X) + Return a copy of the fixed point variable X with the elements + arranged in increasing order. For matrices, `fsort' orders the + elements in each column. + + For example, + + fsort (fixed(4,0,[1, 2; 2, 3; 3, 1])) + => 1 1 + 2 2 + 3 3 + + The `fsort' function may also be used to produce a matrix + containing the original row indices of the elements in the sorted + matrix. For example, + + [s, i] = sort ([1, 2; 2, 3; 3, 1]) + => s = 1 1 + 2 2 + 3 3 + => i = 1 3 + 2 1 + 3 2 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return a copy of the fixed point variable X with the elements arranged +in increa + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +lookup_table + + +# name: +# type: sq_string +# elements: 1 +# length: 621 + -- Function File: Y = lookup_table (TABLE, X) + -- Function File: Y = lookup_table (TABLE, X, INTERP, EXTRAP) + Using the lookup table created by "create_lookup_table", find the + value Y corresponding to X. With two arguments the lookup is done + to the nearest value below in the table less than the desired + value. With three arguments a simple linear interpolation is + performed. With four arguments an extrapolation is also performed. + The exact values of arguments three and four are irrelevant, as + only there presence detremines whether interpolation and/or + extrapolation are used. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Using the lookup table created by "create_lookup_table", find the value +Y corres + + + + + diff --git a/octave_packages/fixed-0.7.10/doc.info b/octave_packages/fixed-0.7.10/doc.info new file mode 100644 index 0000000..864728d --- /dev/null +++ b/octave_packages/fixed-0.7.10/doc.info @@ -0,0 +1,3630 @@ +This is fixed.info, produced by makeinfo version 4.11 from fixed.texi. + + +File: fixed.info, Node: Top, Next: Basics + +Fixed Point Toolbox for Octave +****************************** + +* Menu: + +* Basics:: The basics of the fixed point types +* Programming:: Using the fixed-point type in C++ and oct-files +* Example:: Fixed point type applied to real signal processing example +* Function Reference:: Documentation from the fixed point specific functions + + +File: fixed.info, Node: Basics, Next: Programming, Prev: Top, Up: Top + +1 The Basics of the Fixed Point Types +************************************* + +When implementing algorithms in hardware, it is common to reduce the +accuracy of the representation of numbers to a smaller number of bits. +This allows much lower complexity in the hardware, at the cost of +accuracy and potential overflow problems. Such representations are +known as fixed point. + + This toolbox supplies a fixed point type that allows Octave to model +the effects of such a reduction in accuracy of the representation of +numbers. The major advantage of this toolbox is that with correctly +written Octave scripts, the same code can be used to test both fixed +and floating point representations of numbers. + + The authors have tried to take all care to ensure the correct +functionality of this package. However, as this code is relatively +recent we expect that there will be a certain number of problems. We +welcome all reports of bugs, etc or even success stories. The authors +can be contacted at the e-mail address . + +* Menu: + +* License:: The License used with this Package +* Representation:: Representation of fixed point numbers +* Creation:: Creation of fixed point numbers +* Overflow:: Overflow Behavior of Fixed Point Numbers +* Built-in Variables:: Fixed Point Built-in Variables +* Accessing Internal Fields:: The properties of fixed point numbers +* Function Overloading:: Fixed point numbers with existing Octave functions +* Together:: Putting it all together +* Precision:: Problems of precision in calculations +* Lookup Tables:: The use of Lookup tables with fixed point values; +* Known Problems:: Read this before reporting a bug + + +File: fixed.info, Node: License, Next: Representation, Prev: Basics, Up: Basics + +1.1 The License used with this Package +====================================== + +The license used with this package is the GNU General Public License, a +copy of which is distributed with this package in the file `COPYING'. +Some commercial users have seemed quite concerned about the use of +software licensed under the GPL in their development. To ease these +concerns, the authors state in clear English the terms of the GPL allow +that + + 1. Any algorithm developed with this package remains the sole property + of the party developing the algorithm. + + 2. Changes can be made to the fixed point package, with the + constraint that if you supply a version of the fixed point package + to another party it must equally be covered by the terms of the + GPL. + + We believe that there is little reason to make proprietary changes to +the fixed point package itself. So this clear distinction between the +fixed point code itself and algorithms developed with it means that +there should be little concern for a use of this package in the +development of a proprietary algorithms. + + Proprietary changes to the fixed point package itself are possible. +The GPL only comes into play in if you distribute the fixed point +package with these changes. The algorithms developed on these modified +versions of the fixed point package remain proprietary in all cases. + + +File: fixed.info, Node: Representation, Next: Creation, Prev: License, Up: Basics + +1.2 Fixed Point Representation +============================== + +Fixed point numbers can be represented digitally in several manners, +including _sign-magnitude_, _ones-complement_ and _twos-complement_. +The most commonly used technique is _twos-complement_ due to the easier +implementation of certain operations in this representation. As such +this toolbox uses the _twos-complement_ representation of numbers + + All fixed point objects in this toolbox are represented by an _int_ +that is used in the following manner + +1 bit representing the sign, + +IS bits representing the integer part of the number, and + +DS bits representing the decimal part of the number. + + The numbers that can then be represented are then given by + + - 2 ^ IS <= X <= 2 ^IS -1 + + and the distance between two values of X that are not represented by +the same fixed point value is 2 ^ (-DS) . + + The number of bits that can be used in the representation of the +fixed point objects is determined by the number of bits in an _int_ on +the platform. Valid values include 32- and 64-bits. To avoid issues with +overflows in additions, one of these bits can not be used. Therefore +valid values of IS and DS are given by + + 0 < ( IS + DS ) < N - 2 + + where N is either 32 or 64, depending on the number of bits in an +_int_. It should be noted that given the above criteria it is possible +to create a fixed point representation that lacks a representation of +the number 1. This makes the implementation of certain operators +difficult, and so the valid representations are further limited to + + 0 < ( IS, DS, IS + DS ) < N - 2 + + This does not mean that other numbers can not be represented by this +toolbox, but rather that the numbers must be scaled prior to their +being represented. + + This toolbox allows both fixed point real and complex scalars to be +represented, as well as fixed point real and complex matrices. The real +and imaginary parts of the fixed point number and each element of a +fixed point matrix has its own fixed point representation. + + +File: fixed.info, Node: Creation, Next: Overflow, Prev: Representation, Up: Basics + +1.3 Creating Fixed Point Numbers +================================ + +Before using a fixed point type, some variables must be created that +use this type. This is done with the function "fixed". The function +"fixed" can be used in several manners, depending on the number and +type of the arguments that are given. It can be used to create scalar, +complex, matrix and complex matrix values of the fixed type. + + The generic call to "fixed" is `fixed(IS,DS,F)', where the variables +are + +IS + The number of bits to use in the representation of the integer + part of the fixed point value. This can be either a real or + complex value, and can be either a scalar or a matrix. As the + fixed point representation of complex values uses separate + representations for the real and imaginary parts, a complex value + of IS gives the representation of the real and imaginary parts + separately. IS must contain only integer or complex integer values + greater than zero, and less than 30 or 62 as discussed in the + previous section. + +DS + Similarly to IS, DS represents the number of bits in the decimal + part of the fixed point representation. The same conditions as for + IS apply to DS + +F + This variable can be either a scalar, complex, matrix or complex + matrix of values that will be converted to a fixed point + representation. It can equally be another fixed point value, in + which case "fixed" has the effect of changing the representation + of F to another representation given by IS and DS. + + If matrices are used for IS, DS, or F, then the dimensions of all of +the matrices must match. However, it is valid to have IS or DS as +scalar values, which will be expanded to the same dimension as the +other matrices, before use in the conversion to a fixed point value. +The variable F however, must be a matrix if either IS or DS is a matrix. + + The most basic use of the function "fixed" can be seen in the example + + octave:1> a = fixed(7,2,1) + ans = 1 + octave:2> isfixed(a) + ans = 1 + octave:3> whos a + *** local user variables: + + prot type rows cols name + ==== ==== ==== ==== ==== + rwd fixed scalar 1 1 a + + which demonstrates the creation of a real scalar fixed point value +with 7 bits of precision in the integer part, 2 bits in the decimal +part and the value 1. The function "isfixed" can be used to identify +whether a variable is of the fixed point type or not. Equally, using +the "whos" function allows the variable to be identified as "fixed +scalar". + + Other examples of valid uses of "fixed" are + + octave:1> a = fixed(7, 2, 1); + octave:2> b = fixed(7, 2+1i, 1+1i); + octave:3> c = fixed(7, 2, 255*rand(10,10) - 128); + octave:4> is = 3*ones(10,10) + 4*eye(10); + octave:5> d = fixed(is, 1, eye(10)); + octave:6> e = fixed(7, 2, 255*rand(10,10)-128 + + > 1i*(255*rand(10,10)-128)); + octave:7> whos + + *** local user variables: + + prot type rows cols name + ==== ==== ==== ==== ==== + rwd fixed scalar 1 1 a + rwd fixed complex 1 1 b + rwd fixed matrix 10 10 c + rwd fixed matrix 10 10 d + rwd fixed complex matrix 10 10 e + + With two arguments given to "fixed", it is assumed that F is zero or +a matrix of zeros, and so "fixed" called with two arguments is +equivalent to calling with three arguments with the third arguments +being zero. For example + + octave:1> a = fixed([7,7], [2,2], zeros(1,2)); + octave:2> b = fixed([7,7], [2,2]); + octave:3> assert(a == b); + + Called with a single argument "fixed", and a fixed point argument, +`b = fixed(A)' is equivalent to `b = a'. If A is not itself fixed +point, then the integer part of A is used to create a fixed point +value, with the minimum number of bits needed to represent it. For +example + + octave:1> b = fixed(1:4); + + creates a fixed point row vector with 4 values. Each of these values +has the minimum number of bits needed to represent it. That is b(1) +uses 1 bit to represent the integer part, b(2:3) use 2 bits and b(4) +uses 3 bits. The single argument used with "fixed" can equally be a +complex value, in which case the real and imaginary parts are treated +separately to create a composite fixed point value. + + +File: fixed.info, Node: Overflow, Next: Built-in Variables, Prev: Creation, Up: Basics + +1.4 Overflow Behavior of Fixed Point Numbers +============================================ + +When converting a floating point number to a fixed point number the +overflow behavior of the fixed point type is such that it implements +clipping of the data to the maximum or minimum value that is +representable in the fixed point type. This effectively simulates the +behavior of an analog to digital conversion. For example + + octave:1> a = fixed(7,2,200) + a = 127.75 + octave:2> a = fixed(7,2,-200) + a = -128 + + However, the overflow behavior of the fixed point type is distinctly +different if the overflow occurs within a fixed point operation itself. +In this case the excess bits generated by the overflow are dropped. +For example + + octave:1> a = fixed(7,2,127) + fixed(7,2,2) + a = -127 + octave:2> a = fixed(7,2,-127) + fixed(7,2,-2) + a = 127 + + The case where the representation of the fixed point object changes +is different again. In this case the sign is maintained, while the +most-significant bits of the representation are dropped. For example + + octave:1> a = fixed(6, 2, fixed(7, 2, -127.25)) + a = -63.25 + octave:2> a = fixed(6, 2, fixed(7, 2, 127.25)) + a = 63.25 + octave:3> a = fixed(7, 1, fixed(7, 2, -127.25)) + a = -127.5 + octave:4> a = fixed(7, 1, fixed(7, 2, 127.25)) + a = 127 + + In addition to the overflow issue discussed above, it is important to +take into account what happens when an operator is used on two fixed +point values with different representations. For example + + octave:1> a = fixed(7,2,1); + octave:2> b = fixed(6,3,1); + octave:3> c = a + b; + octave:4> fprintf("%d integer, and %d decimal bits\n", c.int, c.dec); + 7 integer, and 3 decimal bits + + as can be seen the fixed point value is promoted to have an output +fixed point representation such that `c.int = max(a.int,b.int)' and +`c.dec = max(a.dec,b.dec)'. If this promotion causes the maximum number +of bits in a fixed point representation to be exceeded, then an error +will occur. + + +File: fixed.info, Node: Built-in Variables, Next: Accessing Internal Fields, Prev: Overflow, Up: Basics + +1.5 Fixed Point Built-in Variables +================================== + +After the fixed point type is first used, four variables are +initialized. These are + +fixed_point_version + The version number of the fixed point code + +fixed_point_warn_overflow + If non-zero warn of fixed point overflows. The default is 0. + +fixed_point_count_operations + If non-zero count number of fixed point operations, for later + complexity analysis + +fixed_point_debug + If non-zero keep a copy of fixed point value to allow easier + debugging with gdb + + and they can be accessed as normal Octave built-in variables. The +variable `fixed_point_version' can be used to create tests in the users +code, to work-around any eventual problems in the fixed point type. For +example + + if (strcmp(fixed_point_version, "0.6.0")) + a = fixed([a.int, b.int], [a.dec, b.dec], + [a.x, b.x]); + else + a = concat(a, b); + endif + + although this is not a real example, since both versions of the +above code work with the released version of the fixed point type. + + When optimizing the number of bits in a fixed point type, it is +normal to expect overflows to occur, causing errors in the calculations +which due to the implementation have little effect on the end result of +the system. However, it is sometimes useful to know exactly where +overflows are happening or not. A non-zero value of variable +`fixed_point_warn_overflow' permits the errors conditions in fixed +point operations to cause a warning message to be printed by octave. +The default behavior is to have `fixed_point_warn_overflow' be 0. + + The octave fixed point type can keep track of all of the fixed point +operations and their type. This is very useful for a simple complexity +analysis of the algorithms. To allow the fixed point type to track +operations the variable `fixed_point_count_operations' must be +non-zero. The count of operations can then be reset with the +"reset_fixed_operations", and the number of operations since the last +reset can be given by the "display_fixed_operations" function. + + The final in-built variable of the fixed point type is +`fixed_point_debug'. In normal operation this variable is of no use. +However setting it to a non-zero value causes a copy of the floating +point representation of a fixed point value to be stored internally. +This makes debugging code using the fixed point type significantly +easier using gdb. + + +File: fixed.info, Node: Accessing Internal Fields, Next: Function Overloading, Prev: Built-in Variables, Up: Basics + +1.6 Accessing Internal Fields +============================= + +Once a variable has been defined as a fixed point object, the +parameters of the field of this structure can be obtained by adding a +suffix to the variable. Valid suffixes are '.x', '.i', '.sign', '.int' +and '.dec', which return + +.x + The floating point representation of the fixed point number + +.i + The internal integer representation of the fixed point number + +.sign + The sign of the fixed point number + +.int + The number of bits representing the integer part of the fixed + point number + +.dec + The number of bits representing the decimal part of the fixed + point number + + As each fixed point value in a matrix can have a different number of +bits in its representation, these suffixes return objects of the same +size as the original fixed point object. For example + + octave:1> a = [-3:3]; + octave:2> b = fixed(7,2,a); + octave:3> b.sign + ans = + + -1 -1 -1 0 1 1 1 + octave:4> b.int + ans = + + 7 7 7 7 7 7 7 + octave:5> b.dec + ans = + + 2 2 2 2 2 2 2 + octave:5> c = b.x; + octave:6> whos + + *** local user variables: + + prot type rows cols name + ==== ==== ==== ==== ==== + rwd matrix 1 7 a + rwd fixed matrix 1 7 b + rwd matrix 1 7 c + + The suffixes '.int' and '.dec' can also be used to change the +internal representation of a fixed point value. This can result in a +loss of precision in the representation of the fixed point value, which +models the same process as occurs in hardware. For example + + octave:1> b = fixed(7,2,[3.25, 3.25]); + octave:2> b(1).dec = [0, 2]; + b = + + 3 3.25 + + However, the value itself should not be changed using the suffix +'.x'. For instance + + octave:3> b.x = [3, 3]; + error: can not directly change the value of a fixed structure + error: assignment failed, or no method for `fixed matrix = matrix' + error: evaluating assignment expression near line 3, column 6 + + +File: fixed.info, Node: Function Overloading, Next: Together, Prev: Accessing Internal Fields, Up: Basics + +1.7 Function Overloading +======================== + +An important consideration in the use of the fixed point toolbox is +that many of the internal functions of Octave, such as "diag", can not +accept fixed point objects as an input. This package therefore uses the +"dispatch" function of Octave-Forge to _overload_ the internal Octave +functions with equivalent functions that work with fixed point objects, +so that the standard function names can be used. However, at any time +the fixed point specific version of the function can be used by +explicitly calling its function name. The correspondence between the +internal function names and the fixed point versions is as follows + +`abs' - `fabs', `atan2' - `fatan2', `ceil' - `fceil', +`conj' - `fconj', `cos' - `fcos', `cosh' - `fcosh', +`cumprod'- `fcumprod', `cumsum' - `fcumsum', `diag' - `fdiag', +`exp' - `fexp', `floor' - `ffloor', `imag' - `fimag', +`log10' - `flog10', `log' - `flog', `prod' - `fprod', +`real' - `freal', `reshape' - `freshape', `round' - `fround', +`sin' - `fsin', `sinh' - `fsinh', `sort' - `fsort', +`sqrt' - `fsqrt', `sum' - `fsum', `sumsq' - `fsumsq', +`tan' - `ftan', `tanh' - `ftanh'. + + The version of the function that is chosen is determined by the first +argument of the function. So, considering the "atan2" function, if the +first argument is a _Matrix_, then the normal version of the function +is called regardless of whether the other argument of the function is a +fixed point objects or not. + + Many other Octave functions work correctly with fixed point objects +and so overloaded versions are not necessary. This includes such +functions as "size" and "any". + + It is also useful to use the '.x' option discussed in the previous +section, to extract a floating point representation of the fixed point +object for use with some functions. + + +File: fixed.info, Node: Together, Next: Precision, Prev: Function Overloading, Up: Basics + +1.8 Putting it all Together +=========================== + +Now that the basic functioning of the fixed point type has been +discussed, it is time to consider how to put all of it together. The +list of functions available for the fixed point type can be found in a +later section of this document (*note Function Reference::) + + The main advantage of this fixed point type over an implementation of +specific fixed point code, is the ability to define a function once and +use as either fixed or floating point. Consider the example + + function [b, bf] = testfixed(is,ds,n) + a = randn(n,n); + af = fixed(is,ds,a); + b = myfunc(a,a); + bf = myfunc(af,af); + endfunction + + function y = myfunc(a,b) + y = a + b; + endfunction + + In this case `b' and `bf' will be returned from the function +"testfixed" as floating and fixed point types respectively, while the +underlying function "myfunc" does not explicitly define that it uses a +fixed point type. This is a major advantage, as it is critical to +understand the loss of precision in an algorithm when converting from +floating to fixed point types for an optimal hardware implementation. +This mixing of functions that treat both floating and fixed point types +can even apply to Oct-files (*note Oct-files::). + + The main limitation to the above is the use of the concatenation +operator, such as `[a,b]', that is hard-coded in versions of Octave +prior to 2.1.58 and is thus not aware of the fixed-point type. +Therefore, such code should be avoided in earlier versions of Octave +and the function "concat" supplied with this package used instead. + + +File: fixed.info, Node: Precision, Next: Lookup Tables, Prev: Together, Up: Basics + +1.9 Problems of Precision in Calculations +========================================= + +When dimensioning the fixed point variables, care must be taken so that +all intermediate operations don't cause a loss in the precision. This +can occur with any operator or function that takes a large argument and +gives a small result. Minor variations in the initial argument can +result in large changes in the final result. + + For instance, consider the "log" operator, in the example + + octave:1> a = fixed(7,2,5.25); + octave:2> b = exp(log(a)) + b = 4.25 + + The logarithm `log(a)' is 1.65, which is rounded to 1.5. The +exponential `exp(log(a))' is then 4.48 which is rounded to 4.25. + + A particular case in point is the power operator for complex number, +which is implemented by the standard C++ class as + + X ^ Y = exp ( Y * log(X) ) + + Unless a large decimal precision is specified for this operator, the +results will be wildly different than expected. For example + + octave:1> fixed(7,2,4*1i) ^ fixed(7,2,1) + ans = 0.000 + 2.250i + octave:2> fixed(7,5,4*1i) ^ fixed(7,5,1) + ans = 0.000000 + 3.812500i + + If the user chooses to use certain functions and operators, it is +their responsibility to understand the implementation of the these +operators, as used by their compilers to ensure the desired behavior. +Alternatively, the user is recommended to implement certain operations +as lookup tables, rather than use the built-in operator or function. +This is how such general functions are implemented in hardware and so +this is not a significant problem. + + +File: fixed.info, Node: Lookup Tables, Next: Known Problems, Prev: Precision, Up: Basics + +1.10 Lookup Tables +================== + +It is common to implement complex functions in hardware by an equivalent +lookup table. This has the advantage of speed, saving on the complexity +of a full implementation of certain functions, and avoiding rounding +errors if the complex function is implemented as a combination of +sub-functions. The disadvantage is that the lookup requires the use of +a read-only memory in hardware. Due to size limitations on this memory +it might not be possible to represent all possible values of a function. + + This section discusses the use of lookup tables with the fixed point +type. It is assumed that the function "lookup" of Octave-forge is +installed. The easiest way to explain the use of a fixed point lookup +table is to discuss an example. Consider a fixed point value in the +range `-pi:pi', and we wish to represent the sine function in this +range. The creation of the lookup table can then be performed as +follows. + + octave:1> is = 2; ds = 6; + octave:2> x = [-3.125:0.125:3.125]; % 3.125 ~ pi + octave:3> y = sin(x); + octave:4> table_float = create_lookup_table(x, y); + octave:5> table_fixed = create_lookup_table(fixed(is,ds,x), + > fixed(is,ds,y)); + + A real implementation of this function in hardware might use to the +symmetry of the sine function to only require the lookup table for +`[0:pi/2]' to be stored. However, for simulation there is little reason +to introduce this complication. + + To evaluate the value of the function use the lookup table created by +"create_lookup_table", the function "lookup_table" is then used. This +function can either be used to give the closest evalued value below the +desired value, or it can be used to interpolate the table as might be +done in hardware. For example + + octave:6> x0 = [-pi:0.01:pi]; + octave:7> y0 = sin(x); + octave:8> y1 = lookup_table(table_float, x0, "linear"); + octave:9> y2 = lookup_table(table_fixed, fixed(is,ds,x0), "linear"); + + +File: fixed.info, Node: Known Problems, Prev: Lookup Tables, Up: Basics + +1.11 Known Problems +=================== + +Before reporting a bug compare it to this list of known problems + +Concatenation + For versions of Octave prior to 2.1.58, the concatenation of fixed + point objects returns a Matrix type. That is `[fixed(7,2,[1, 2]), + fixed(7,2,3)]' returns a matrix when it should return another + fixed point matrix. This problem is due to the implementation of + matrix concatenation in earlier versions of Octave being + hard-coded for the basic types it knows rather than being + expandable. + + The workaround is to explicitly convert the returned value back to + the correct fixed point object. For instance + + octave:1> a = fixed(7,2,[1,2]); + octave:2> b = fixed(7,2,3); + octave:3> c = fixed([a.int, b.int], [a.dec, b.dec], + > [a.x, b.x]); + + Alternatively, use the supplied function "concat" that explicitly + performs the above above, but can also be used for normal matrices. + + Since Octave version 2.1.58, `[fixed(7,2,[1,2]),fixed(7,2,3)]' + returns another fixed point object as expected. + +Saving fixed point objects + Saving of fixed point variables is only implemented in versions of + Octave later than 2.1.53. If you are using a recent version of + Octave then saving a fixed point variable is as simple as + + octave:2> save a.mat a + + where A is a fixed point variable. To reload the variable within + octave, the fixed point types must be installed prior to a call to + "load". That is + + octave:1> dummy = fixed(1,1); + octave:2> load a.mat + + With versions of octave later than 2.1.53, fixed point variables + can be saved in the octave binary and ascii formats, as well as + the HDF5 format. If you are using an earlier version of octave, + you can not directly save a fixed point variable. You can however + save the information it contains and reconstruct the data + afterwards by doing something like + + octave:2> x = a.x; is = a.int; ds = a.dec; + octave:3> save a.mat x is ds; + + where A is a fixed point object. + +Some functions and operators return very poor results + Please read the previous section. Also if the problem manifests + when using complex arguments, try to understand your compilers + constructor of complex operators and functions from the base fixed + point operators and functions. The relevant file for the gcc 3.x + versions of the compiler can be found in + `/usr/include/g++-v3/bits/std_complex.h'. + +Function "foo" returns fixed point types while "bar" + does not? If the existing functions, written as m-files, respect + the use (or rather non-use) of the concatentaion operator, then + these functions will operate correctly. However, many functions + don't and thus will return a floating type for a fixed point + input, when run on versions of Octave earlier than 2.1.58. All + functions should be checked by the user for their correct + operation before using them. + + Additionally, existing oct-files will not operate correctly with + fixed point inputs, as they are not aware of the fixed point type + and will just extract the floating point value to operate on. + + A third class of function are the inbuilt functions like "any", + "size", etc. As the fixed point type includes the underlying + functions for these to work correctly, they give the correct + result even though there is no corresponding fixed point specific + version of these functions. + +Why is my code so slow when using fixed point + This is due to several reasons, firstly the normal functions in + octave use optimized libraries to accelerate their operation. This + is not possible when using fixed point. + + Also there is no fixed point type native to the machines Octave + runs on. This naturally makes the fixed point type slow, due to + the fact that the fixed point operators check for overflows, etc + at all steps in the operation and act accordingly. This is + particularly true in the case of matrix multiplication where each + multiplication and addition can be subject to overflows. Thus + + octave:1> x = randn(100,100); + octave:2> y0 = fixed(7,6,x*x); + octave:3> y1 = fixed(7,6,x)*fixed(7,6,x); + + does not give equivalent operations for Y0 and Y1. With all this + additionally checking, you can not expect your code to run as fast + when using the fixed point type. + +When running under cygwin I get a dlopen error. + The build under cygwin is slightly different, in that most of the + fixed point functions are compiled as a shared library that is + linked to the main oct-file. This is to allow other oct-files to + use the fixed-point type which is not possible under cygwin + otherwise, since compilation under cygwin requires that all + symbols are resolved at compile time. + + If the shared libraries are not installed somewhere that can be + found when running octave, then you will get an error like + + octave:1> a = fixed(7,2,1) + error: dlopen: Win32 error 126 + error: `fixed' undefined near line 1 column 5 + error: evaluating assignment expression near line 1, column 3 + + There are two files `liboctave_fixed.dll' and `liboctave_fixed.dll.a' +that must be installed. Typically, these should be installed in the same +directory that you can `liboctave.dll' and `liboctave.dll.a' +respectively. If you use the same `--prefix' option to configure both +octave and octave-forge then this should happen automatically. + + +File: fixed.info, Node: Programming, Next: Example, Prev: Basics, Up: Top + +2 Using the fixed-point type in C++ and oct-files +************************************************* + +Octave supplies a matrix template library to create matrix and vector +objects from basic types. All of the properties of these Octave classes +will not be described here. However the base classes and the +particularly of the classes created using the Octave matrix templates +will be discussed. + + There are two basic fixed point types: `FixedPoint' and +`FixedPointComplex' representing the fixed point representation of real +and complex numbers respectively. The Octave matrix templates are used +to created the classes `FixedMatrix', `FixedRowVector' and +`FixedColumnVector' from the base class `FixedPoint'. Similar the +complex fixed point types `FixedComplexMatrix', `FixedComplexRowVector' +and `FixedComplexColumnVectors' are constructed from the base class +`FixedPointComplex' + + This section discusses the definitions of the base classes, their +extension with the Octave matrix templates, the upper level Octave +classes and the use of all of these when writing oct-files. + +* Menu: + +* FixedPoint:: The `FixedPoint' base class +* FixedPointComplex:: The `FixedPointComplex' base class +* Derived:: The derived classes using the Octave template classes +* Upper:: The upper level Octave classes +* Oct-files:: Writing oct-files with the fixed point type + + +File: fixed.info, Node: FixedPoint, Next: FixedPointComplex, Prev: Programming, Up: Programming + +2.1 The `FixedPoint' Base Class +=============================== + +* Menu: + +* FPConstructors:: `FixedPoint' constructors +* FPSpecific:: `FixedPoint' specific methods +* FPOperators:: `FixedPoint' operators +* FPFunctions:: `FixedPoint' functions + + +File: fixed.info, Node: FPConstructors, Next: FPSpecific, Prev: FixedPoint, Up: FixedPoint + +2.1.1 `FixedPoint' Constructors +------------------------------- + +`FixedPoint::FixedPoint ()' + Create a fixed point object with only a sign bit + +`FixedPoint::FixedPoint (unsigned int is, unsigned int ds)' + Create a fixed point object with `is' bits for the integer part and + `ds' bits for the decimal part. The fixed point object will be + initialized to be zero + +`FixedPoint::FixedPoint (unsigned int is, unsigned int ds, FixedPoint &x)' + Create a fixed point object with `is' bits for the integer part and + `ds' bits for the decimal part, loaded with the fixed point value + `x'. If `is + ds' is greater than `sizeof(int)*8 - 2', the error + handler is called. + +`FixedPoint::FixedPoint (unsigned int is, unsigned int ds, const double x)' + Create a fixed point object with `is' bits for the integer part and + `ds' bits for the decimal part, loaded with the value `x'. If `is + + ds' is greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedPoint::FixedPoint (unsigned int is, unsigned int ds, unsigned int i, unsigned int d)' + Create a fixed point object with `is' bits for the integer part and + `ds' bits for the decimal part, loading the integer part with `i' + and the decimal part with `d'. It should be noted that `i' and `d' + are both unsigned and are the strict representation of the bits of + the fixed point value. + +`FixedPoint::FixedPoint (const int x)' + Create a fixed point object with the minimum number of bits for + the integer part `is' needed to represent `x'. If `is' is greater + than `sizeof(int)*8 - 2', the error handler is called. + +`FixedPoint::FixedPoint (const double x)' + Create a fixed point object with the minimum number of bits for + the integer part `is' needed to represent the integer part of `x'. + If `is' is greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedPoint::FixedPoint (const FixedPoint &x)' + Create a copy of the fixed point object `x' + + +File: fixed.info, Node: FPSpecific, Next: FPOperators, Prev: FPConstructors, Up: FixedPoint + +2.1.2 `FixedPoint' Specific Methods +----------------------------------- + +`double FixedPoint::fixedpoint()' + Method to create a `double' from the current fixed point object + +`double fixedpoint (const FixedPoint &x)' + Create a `double' from the fixed point object `x' + +`int FixedPoint::sign ()' + Return `-1' for negative numbers, `1' for positive and `0' if the + current fixed point object is zero. + +`int sign (FixedPoint &x)' + Return `-1' for negative numbers, `1' for positive and `0' if the + fixed point object `x' is zero. + +`char FixedPoint::signbit ()' + Return the sign bit of the current fixed point number (`0' for + positive number, `1' for negative number). + +`char signbit (FixedPoint &x)' + Return the sign bit of the fixed point number `x' (`0' for positive + number, `1' for negative number). + +`int FixedPoint::getintsize ()' + Return the number of bit `is' used to represent the integer part + of the current fixed point object. + +`int getintsize (FixedPoint &x)' + Return the number of bit `is' used to represent the integer part + of the fixed point object `x'. + +`int FixedPoint::getdecsize ()' + Return the number of bit `ds' used to represent the decimal part + of the current fixed point object. + +`int getdecsize (FixedPoint &x)' + Return the number of bit `ds' used to represent the decimal part + of the fixed point object `x'. + +`unsigned int FixedPoint::getnumber ()' + Return the integer representation of the fixed point value of the + current fixed point object. + +`unsigned int getnumber (FixedPoint &x)' + Return the integer representation of the fixed point value of the + fixed point object `x'. + +`FixedPoint FixedPoint::chintsize (const int n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' changed to `n'. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedPoint FixedPoint::chdecsize (const int n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' changed to `n'. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedPoint FixedPoint::incintsize (const int n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by `n'. If `n' is negative, then `is' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedPoint FixedPoint::incintsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedPoint FixedPoint::incdecsize (const int n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by `n'. If `n' is negative, then `ds' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedPoint FixedPoint::incdecsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + + +File: fixed.info, Node: FPOperators, Next: FPFunctions, Prev: FPSpecific, Up: FixedPoint + +2.1.3 `FixedPoint' Operators +---------------------------- + +`FixedPoint operator +' + Unary `+' of a fixed point object + +`FixedPoint operator -' + Unary `-' of a fixed point object + +`FixedPoint operator !' + Unary `!' operator of the fixedpoint object, with the the sign bit. + This is not the same operator as `-' and is not the same operator + as the octave `!' operator. + +`FixedPoint operator ++' + Unary increment operator (pre and postfix). Uses the smallest + representable value to increment (ie `2 ^ (- ds)' ) + +`FixedPoint operator --' + Unary decrement operator (pre and postfix). Uses the smallest + representable value to decrement (ie `2 ^ (- ds)' ) + +`FixedPoint operator = (const FixedPoint &x)' + Assignment operators. Copies fixed point object `x' + +`FixedPoint operator += (const FixedPoint &x)' +`FixedPoint operator -= (const FixedPoint &x)' +`FixedPoint operator *= (const FixedPoint &x)' +`FixedPoint operator /= (const FixedPoint &x)' + Assignment operators, working on both the input and output + objects. The output object's fixed point representation is + promoted such that the largest values of `is' and `ds' are taken + from the input and output objects. If the result of this operation + causes `is + ds' to be greater than `sizeof(int)*8 - 2', the error + handler is called. + +`FixedPoint operator <<= (const int s)' +`FixedPoint operator << (const FixedPoint &x, const int s)' + Perform a left-shift of a fixed point object. This is equivalent + to a multiplication by a power of 2. The sign-bit is preserved. + This differs from the `rshift' function discussed below in the + `is' and `ds' are unchanged. + +`FixedPoint operator >>= (const int s)' +`FixedPoint operator >> (const FixedPoint &x, const int s)' + Perform a right-shift of the fixed point object. This is + equivalent to a division by a power of 2. Note that the sign-bit + is preserved. This differs from the `rshift' function discussed + below in the `is' and `ds' are unchanged. + +`FixedPoint operator + (const FixedPoint &x, const FixedPoint &y)' +`FixedPoint operator - (const FixedPoint &x, const FixedPoint &y)' +`FixedPoint operator * (const FixedPoint &x, const FixedPoint &y)' +`FixedPoint operator / (const FixedPoint &x, const FixedPoint &y)' + Two argument operators. The output objects fixed point + representation is promoted such that the largest values of `is' + and `ds' are taken from the two arguments. If the result of this + operation causes `is + ds' to be greater than `sizeof(int)*8 - + 2', the error handler is called. + +`bool operator == (const FixedPoint &x, const FixedPoint &y)' +`bool operator != (const FixedPoint &x, const FixedPoint &y)' +`bool operator < (const FixedPoint &x, const FixedPoint &y)' +`bool operator <= (const FixedPoint &x, const FixedPoint &y)' +`bool operator > (const FixedPoint &x, const FixedPoint &y)' +`bool operator >= (const FixedPoint &x, const FixedPoint &y)' + Fixed point comparison operators. The fixed point object `x' and + `y' can have different representations (values of `is' and `ds'). + +`std::istream &operator >> (std::istream &s, FixedPoint &x)' + Read a fixed point object from `s' stream and store it into `x' + keeping the fixed point representation in `x'. If the value read is + not a fixed point object, the error handler is invoked. + +`std::ostream &operator << (std::ostream &s, const FixedPoint &x)' + Send into the stream `s', a formatted fixed point value `x' + + +File: fixed.info, Node: FPFunctions, Prev: FPOperators, Up: FixedPoint + +2.1.4 `FixedPoint' Functions +---------------------------- + +`FixedPoint rshift (const FixedPoint &x, int s)' + Do a right shift of `s' bits of a fixed precision number + (equivalent to a division by a power of 2). The representation of + the fixed point object is adjusted to suit the new fixed point + object (i.e. `ds++' and `is = is == 0 ? 0 : is-1') + +`FixedPoint lshift (const FixedPoint &x, int s)' + Do a left shift of `s' bits of a fixed precision number (equivalent + to a multiplication by a power of 2). The representation of the + fixed point object is adjusted to suit the new fixed point object + (i.e. `is++' and `ds = ds == 0 ? 0 : ds-1') + +`FixedPoint abs (const FixedPoint &x)' + Returns the modulus of `x' + +`FixedPoint cos (const FixedPoint &x)' + Returns the cosine of `x' + +`FixedPoint cosh (const FixedPoint &x)' + Returns the hyperbolic cosine of `x' + +`FixedPoint sin (const FixedPoint &x)' + Returns the sine of `x' + +`FixedPoint sinh (const FixedPoint &x)' + Returns the hyperbolic sine of `x' + +`FixedPoint tan (const FixedPoint &x)' + Returns the tangent of `x' + +`FixedPoint tanh (const FixedPoint &x)' + Returns the hyperbolic tangent of `x' + +`FixedPoint sqrt (const FixedPoint &x)' + Returns the square root of `x' + +`FixedPoint pow (const FixedPoint &x, int y)' +`FixedPoint pow (const FixedPoint &x, double y)' +`FixedPoint pow (const FixedPoint &x, const FixedPoint &y)' + Returns the `x' raised to the power `y' + +`FixedPoint exp (const FixedPoint &x)' + Returns the exponential of `x' + +`FixedPoint log (const FixedPoint &x)' + Returns the logarithm of `x' + +`FixedPoint log10 (const FixedPoint &x)' + Returns the base 10 logarithm of `x' + +`FixedPoint atan2 (const FixedPoint &y, const FixedPoint &x)' + Returns the arc tangent of `x' and `y' + +`FixedPoint floor (const FixedPoint &x)' + Returns the rounded value of `x' downwards to the nearest integer + +`FixedPoint ceil (const FixedPoint &x)' + Returns the rounded value of `x' upwards to the nearest integer + +`FixedPoint rint (const FixedPoint &x)' + Returns the rounded value of `x' to the nearest integer + +`FixedPoint round (const FixedPoint &x)' + Returns the rounded value of `x' to the nearest integer. The + difference with `rint' is that `0.5' is rounded to `1' and not `0'. + This conforms to the behavior of the octave `round' function. + +`std::string getbitstring (const FixedPoint &x)' + Return a string containing the bits of `x' + + +File: fixed.info, Node: FixedPointComplex, Next: Derived, Prev: FixedPoint, Up: Programming + +2.2 The `FixedPointComplex' Base Class +====================================== + +The `FixedPointComplex' class is derived using the C++ compilers +inbuilt `complex' class and is instantiated as +`std::complex'. Therefore the exact behavior of the complex +fixed point type is determined by the complex class used by the C++ +compiler. The user is advised to understand their C++ compilers +implementation of the complex functions that they use, and particularly +the effects that they will have on the precision of fixed point +operations. + +* Menu: + +* FPCConstructors:: `FixedPointComplex' constructors +* FPCSpecific:: `FixedPointComplex' specific methods +* FPCOperators:: `FixedPointComplex' operators +* FPCFunctions:: `FixedPointComplex' functions + + +File: fixed.info, Node: FPCConstructors, Next: FPCSpecific, Prev: FixedPointComplex, Up: FixedPointComplex + +2.2.1 `FixedPointComplex' Constructors +-------------------------------------- + +`FixedPointComplex::FixedPointComplex ()' + Create a complex fixed point object with only a sign bit + +`FixedPointComplex::FixedPointComplex (unsigned int is, unsigned int ds)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part. The fixed point object + will be initialized to zero. + +`FixedPointComplex::FixedPointComplex (unsigned int is, unsigned int ds, FixedPoint &x)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part of both real and imaginary + parts, loaded with the fixed point value `x' in the real part and + zero in the imaginary. If `is + ds' is greater than `sizeof(int)*8 + - 2', the error handler is called. + +`FixedPointComplex::FixedPointComplex (unsigned int is, unsigned int ds, FixedPoint &r, FixedPoint &i)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part of both real and imaginary + parts, loaded with the fixed point value `r' in the real part and + `i' the imaginary part. If `is + ds' is greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedPointComplex::FixedPointComplex (unsigned int is, unsigned int ds, FixedPointComplex &x)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part of both real and imaginary + parts, loaded with the complex fixed point value `x'. If `is + ds' + is greater than `sizeof(int)*8 - 2', the error handler is called. + +`FixedPointComplex::FixedPointComplex (unsigned int is, unsigned int ds, const double x)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part of both real and imaginary + parts, loaded with the fixed point value `x' in the real part and + zero in the imaginary. If `is + ds' is greater than `sizeof(int)*8 + - 2', the error handler is called. + +`FixedPointComplex::FixedPointComplex (unsigned int is, unsigned int ds, const double r, const double i)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part of both real and imaginary + parts, loaded with the fixed point value `r' in the real part and + `i' in the imaginary part. If `is + ds' is greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedPointComplex::FixedPointComplex (unsigned int is, unsigned int ds, const Complex c)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part of both real and imaginary + parts, loaded with the fixed point value `c' in the real and + imaginary parts. If `is + ds' is greater than `sizeof(int)*8 - + 2', the error handler is called. + +`FixedPointComplex::FixedPointComplex (unsigned int is, unsigned int ds, const Complex a, const Complex b)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part of both real and imaginary + parts, loaded with the fixed point value `a' in the integer parts + of the of the value and `b' in the decimal part. It should be + noted that `a' and `b' are both unsigned and are the strict + representation of the bits of the fixed point value and considered + as integers. If `is + ds' is greater than `sizeof(int)*8 - 2', the + error handler is called. + +`FixedPointComplex::FixedPointComplex (const Complex& is, const Complex& ds)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part of both real and imaginary + parts, loaded with zero in the real and imaginary parts. The real + part of `is' is used for the real part of the complex fixed point + object, while the imaginary part of `is' is used for the imaginary + part. If either the sum of the real or imaginary parts of `is + + ds' is greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedPointComplex::FixedPointComplex (const Complex& is, const Complex& ds, const Complex& c)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part of both real and imaginary + parts, loaded with the complex fixed point value `c' in the real + and imaginary parts. The real part of `is' is used for the real + part of the complex fixed point object, while the imaginary part + of `is' is used for the imaginary part. If either the sum of the + real or imaginary parts of `is + ds' is greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedPointComplex::FixedPointComplex (const Complex& is, const Complex& ds, const FixedPointComplex& c)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part of both real and imaginary + parts, loaded with the complex fixed point value `c' in the real + and imaginary parts. The real part of `is' is used for the real + part of the complex fixed point object, while the imaginary part + of `is' is used for the imaginary part. If either the sum of the + real or imaginary parts of `is + ds' is greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedPointComplex::FixedPointComplex (const Complex& is, const Complex& ds, const Complex& a, const Complex& b)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part of both real and imaginary + parts, loaded with the fixed point value `a' in the integer parts + of the of the value and `b' in the decimal part. It should be + noted that `a' and `b' are both unsigned and are the strict + representation of the bits of the fixed point value and considered + as integers. If either the sum of the real or imaginary parts of + `is + ds' is greater than `sizeof(int)*8 - 2', the error handler + is called. + +`FixedPointComplex::FixedPointComplex (const std::complex &c)' + Create a complex fixed point object with the minimum number of + bits for the integer part `is' needed to represent the real and + imaginary integer parts of `x'. If `is' is greater than + `sizeof(int)*8 - 2', the error handler is called. The real and + imaginary parts are treated separately. + +`FixedPointComplex::FixedPointComplex (const FixedPointComplex &x)' + Create a copy of the complex fixed point object `x' + +`FixedPointComplex::FixedPointComplex (const FixedPoint &x)' + Create a copy of the fixed point object `x', into a complex fixed + point object leaving the imaginary part at zero. + +`FixedPointComplex::FixedPointComplex (const FixedPoint &r, const FixedPoint &i)' + Create a copy of the fixed point objects `r' and `i', into a the + real and imaginary parts of a complex fixed point object + respectively + +`FixedPointComplex::FixedPointComplex (const int x)' + Create a fixed point object with the minimum number of bits for + the integer part `is' needed to represent `x'. If `is' is greater + than `sizeof(int)*8 - 2', the error handler is called. + +`FixedPointComplex::FixedPointComplex (const double x)' + Create a fixed point object with the minimum number of bits for + the integer part `is' needed to represent the integer part of `x'. + If `is' is greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedPointComplex (const Complex& is, const Complex& ds, const double& d)' + Create a complex fixed point object with `is' bits for the integer + part and `ds' bits for the decimal part of both real and imaginary + parts, loaded with the double value `d' in the real and zero in + the imaginary parts. The real part of `is' is used for the real + part of the complex fixed point object, while the imaginary part + of `is' is used for the imaginary part. If either the sum of the + real or imaginary parts of `is + ds' is greater than + `sizeof(int)*8 - 2', the error handler is called. + + +File: fixed.info, Node: FPCSpecific, Next: FPCOperators, Prev: FPCConstructors, Up: FixedPointComplex + +2.2.2 `FixedPointComplex' Specific Methods +------------------------------------------ + +`Complex FixedPointComplex::fixedpoint()' + Method to create a `Complex' from the current fixed point object + +`Complex fixedpoint (const FixedPointComplex &x)' + Create a `Complex' from the fixed point object `x' + +`Complex FixedPointComplex::sign ()' + Return `-1' for negative numbers, `1' for positive and `0' if the + current fixed point object is zero. Real and imaginary parts + treated separately and returned in the real and imaginary parts of + the return object. + +`Complex sign (FixedPointComplex &x)' + Return `-1' for negative numbers, `1' for positive and `0' if the + fixed point object `x' is zero. Real and imaginary parts treated + separately and returned in the real and imaginary parts of the + return object. + +`Complex FixedPointComplex::getintsize ()' + Return the number of bit `is' used to represent the integer part + of the current fixed point object. Real and imaginary parts + treated separately and returned in the real and imaginary parts of + the return object. + +`Complex getintsize (FixedPointComplex &x)' + Return the number of bit `is' used to represent the integer part + of the fixed point object `x'. Real and imaginary parts treated + separately and returned in the real and imaginary parts of the + return object. + +`Complex FixedPointComplex::getdecsize ()' + Return the number of bit `ds' used to represent the decimal part + of the current fixed point object. Real and imaginary parts + treated separately and returned in the real and imaginary parts of + the return object. + +`Complex getdecsize (FixedPointComplex &x)' + Return the number of bit `ds' used to represent the decimal part + of the fixed point object `x'. Real and imaginary parts treated + separately and returned in the real and imaginary parts of the + return object. + +`Complex FixedPointComplex::getnumber ()' + Return the integer representation of the fixed point value of the + current fixed point object. Real and imaginary parts treated + separately and returned in the real and imaginary parts of the + return object. + +`Complex getnumber (FixedPointComplex &x)' + Return the integer representation of the fixed point value of the + fixed point object `x'. Real and imaginary parts treated + separately and returned in the real and imaginary parts of the + return object. + +`FixedPointComplex FixedPointComplex::chintsize (const Complex n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' changed to `n'. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. Real and imaginary parts treated separately and returned + in the real and imaginary parts of the return object. + +`FixedPointComplex FixedPointComplex::chdecsize (const Complex n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' changed to `n'. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. Real and imaginary parts treated separately and returned + in the real and imaginary parts of the return object. + +`FixedPointComplex FixedPointComplex::incintsize (const Complex n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by `n'. If `n' is negative, then `is' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. Real and + imaginary parts treated separately and returned in the real and + imaginary parts of the return object. + +`FixedPointComplex FixedPointComplex::incintsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. Real and imaginary parts treated separately and returned + in the real and imaginary parts of the return object. + +`FixedPointComplex FixedPointComplex::incdecsize (const Complex n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by `n'. If `n' is negative, then `ds' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. Real and + imaginary parts treated separately and returned in the real and + imaginary parts of the return object. + +`FixedPointComplex FixedPointComplex::incdecsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. Real and imaginary parts treated separately and returned + in the real and imaginary parts of the return object. + + +File: fixed.info, Node: FPCOperators, Next: FPCFunctions, Prev: FPCSpecific, Up: FixedPointComplex + +2.2.3 `FixedPointComplex' Operators +----------------------------------- + +`FixedPointComplex operator +' + Unary `+' of a complex fixed point object + +`FixedPointComplex operator -' + Unary `-' of a complex fixed point object + +`FixedPointComplex operator = (const FixedPointComplex &x)' + Assignment operators. Copies complex fixed point object `x' + +`FixedPointComplex operator += (const FixedPointComplex &x)' +`FixedPointComplex operator -= (const FixedPointComplex &x)' +`FixedPointComplex operator *= (const FixedPointComplex &x)' +`FixedPointComplex operator /= (const FixedPointComplex &x)' + Assignment operators, working on both the input and output + objects. The output object's fixed point representation is + promoted such that the largest values of `is' and `ds' are taken + from the input and output objects. If the result of this operation + causes `is + ds' to be greater than `sizeof(int)*8 - 2', the error + handler is called. + +`FixedPointComplex operator + (const FixedPointComplex &x, const FixedPointComplex &y)' +`FixedPointComplex operator - (const FixedPointComplex &x, const FixedPointComplex &y)' +`FixedPointComplex operator * (const FixedPointComplex &x, const FixedPointComplex &y)' +`FixedPointComplex operator / (const FixedPointComplex &x, const FixedPointComplex &y)' + Two argument operators. The output objects complex fixed point + representation is promoted such that the largest values of `is' + and `ds' are taken from the two arguments. If the result of this + operation causes `is + ds' to be greater than `sizeof(int)*8 - + 2', the error handler is called. + +`bool operator == (const FixedPointComplex &x, const FixedPointComplex &y)' +`bool operator != (const FixedPointComplex &x, const FixedPointComplex &y)' + Complex fixed point comparison operators. The complex fixed point + object `x' and `y' can have different representations (values of + `is' and `ds'). + +`std::istream &operator >> (std::istream &s, FixedPointComplex &x)' + Read a fixed point object from `s' stream and store it into `x' + keeping the fixed point representation in `x'. If the value read is + not a fixed point object, the error handler is invoked. + +`std::ostream &operator << (std::ostream &s, const FixedPointComplex &x)' + Send into the stream `s', a formatted fixed point value `x' + + +File: fixed.info, Node: FPCFunctions, Prev: FPCOperators, Up: FixedPointComplex + +2.2.4 `FixedPointComplex' Functions +----------------------------------- + +`FixedPoint abs (const FixedPointComplex &x)' + Returns the modulus of `x' + +`FixedPoint norm (const FixedPointComplex &x)' + Returns the squared magnitude of `x' + +`FixedPoint arg (const FixedPointComplex &x)' + Returns the arc-tangent of `x' + +`FixedPointComplex std::polar (const FixedPoint &r, const FixedPoint &p)' + Convert from polar fixed point to a complex fixed point object + +`FixedPoint real (const FixedPointComplex &x)' + Returns the real part of `x' + +`FixedPoint imag (const FixedPointComplex &x)' + Returns the imaginary part of `x' + +`FixedPointComplex conj (const FixedPointComplex &x)' + Returns the conjugate of `x' + +`FixedPointComplex cos (const FixedPointComplex &x)' + Returns the transcendental cosine of `x' + +`FixedPointComplex cosh (const FixedPointComplex &x)' + Returns the transcendental hyperbolic cosine of `x' + +`FixedPointComplex sin (const FixedPointComplex &x)' + Returns the transcendental sine of `x' + +`FixedPointComplex sinh (const FixedPointComplex &x)' + Returns the transcendental hyperbolic sine of `x' + +`FixedPointComplex tan (const FixedPointComplex &x)' + Returns the transcendental tangent of `x' + +`FixedPointComplex tanh (const FixedPointComplex &x)' + Returns the transcendental hyperbolic tangent of `x' + +`FixedPointComplex sqrt (const FixedPointComplex &x)' + Returns the square root of `x' + +`FixedPointComplex pow (const FixedPointComplex &x, int y)' +`FixedPointComplex pow (const FixedPointComplex &x, const FixedPoint &y)' +`FixedPointComplex pow (const FixedPointComplex &x, const FixedPointComplex &y)' +`FixedPointComplex pow (const FixedPoint &x, const FixedPointComplex &y)' + Returns the `x' raised to the power `y'. Be careful of precision + errors associated with the implementation of this function as a + complex type + +`FixedPointComplex exp (const FixedPointComplex &x)' + Returns the exponential of `x'. Be careful of precision errors + associated with the implementation of this function as a complex + type + +`FixedPointComplex log (const FixedPointComplex &x)' + Returns the transcendental logarithm of `x'. Be careful of + precision errors associated with the implementation of this + function as a complex type + +`FixedPointComplex log10 (const FixedPointComplex &x)' + Returns the transcendental base 10 logarithm of `x'. Be careful of + precision errors associated with the implementation of this + function as a complex type + +`FixedPointComplex floor (const FixedPointComplex &x)' + Returns the rounded value of `x' downwards to the nearest integer, + treating the real and imaginary parts separately + +`FixedPointComplex ceil (const FixedPointComplex &x)' + Returns the rounded value of `x' upwards to the nearest integer, + treating the real and imaginary parts separately + +`FixedPointComplex rint (const FixedPointComplex &x)' + Returns the rounded value of `x' to the nearest integer, treating + the real and imaginary parts separately + +`FixedPointComplex round (const FixedPointComplex &x)' + Returns the rounded value of `x' to the nearest integer. The + difference with `rint' is that `0.5' is rounded to `1' and not `0'. + This conforms to the behavior of the octave `round' function. + Treats the real and imaginary parts separately + + +File: fixed.info, Node: Derived, Next: Upper, Prev: FixedPointComplex, Up: Programming + +2.3 The Derived Classes using the Octave Template Classes +========================================================= + +It is not the purpose of this section to discuss the use of the Octave +template classes, but rather only the additions to the fixed point +classes that are based on these. For instance the basic constructors +and operations that are available in the normal floating point Octave +classes are available within the fixed point classes. + + The notable exceptions are operations involving matrix +decompositions, including inversion, left division, etc. The reason for +this is that the precision of these operators and functions will be +highly implementation dependent. As additional these operators and +functions are used rarely with a fixed point type, there is no point in +implementing these operators and function within the fixed point +classes. + + In addition the the functions and operators previously described for +the `FixedPoint' and the `FixedPointComplex' types are all available, +in the same from as previously. So these functions are not documented +below. Only the constructors and methods that vary from the previously +described versions are described. + + To fully understand these classes, the user is advised to examine the +header files `fixedMatrix.h', `fixedRowVector.h' and `fixedColVector.h' +for the real fixed point objects and `fixedCMatrix.h', +`fixedCRowVector.h' and `fixedCColVector.h' for the complex fixed point +objects. In addition the files `MArray.h' and `MArray2.h' from Octave +should also be examined. + +* Menu: + +* FixedMatrix:: `FixedMatrix' class +* FixedRowVector:: `FixedRowVector' class +* FixedColumnVector:: `FixedColumnVector' class +* FixedComplexMatrix:: `FixedComplexMatrix' class +* FixedComplexRowVector:: `FixedComplexRowVector' class +* FixedComplexColumnVector:: `FixedComplexColumnVector' class + + +File: fixed.info, Node: FixedMatrix, Next: FixedRowVector, Prev: Derived, Up: Derived + +2.3.1 `FixedMatrix' class +------------------------- + +`FixedMatrix::FixedMatrix (const MArray2 &is, const MArray2 &ds)' +`FixedMatrix::FixedMatrix (const Matrix &is, const Matrix &ds)' + Create a fixed point matrix with the number of bits in the integer + part of each element represented by `is' and the number in the + decimal part by `ds'. The fixed point elements themselves will be + initialized to zero. + +`FixedMatrix::FixedMatrix (unsigned int is, unsigned int ds, const FixedMatrix& a)' +`FixedMatrix::FixedMatrix (const MArray2 &is, const MArray2 &ds, const FixedMatrix& a)' +`FixedMatrix::FixedMatrix (const Matrix &is, const Matrix &ds, const FixedMatrix& a)' + Create a fixed point matrix with the number of bits in the integer + part of each element represented by `is' and the number in the + decimal part by `ds'. The fixed point elements themselves will be + initialized to the fixed point matrix `a' + +`FixedMatrix::FixedMatrix (unsigned int is, unsigned int ds, const Matrix& a)' +`FixedMatrix::FixedMatrix (const MArray2 &is, const MArray2 &ds, const Matrix& a)' +`FixedMatrix::FixedMatrix (const Matrix &is, const Matrix &ds, const Matrix& a)' + Create a fixed point matrix with the number of bits in the integer + part of each element represented by `is' and the number in the + decimal part by `ds'. The fixed point elements themselves will be + initialized to the matrix `a' + +`FixedMatrix::FixedMatrix (unsigned int is, unsigned int ds, const Matrix& a, const Matrix& b)' +`FixedMatrix::FixedMatrix (const MArray2 &is, const MArray2 &ds, const Matrix& a, const Matrix& b)' +`FixedMatrix::FixedMatrix (const Matrix &is, const Matrix &ds, const Matrix& a, const Matrix& b)' + Create a fixed point matrix with the number of bits in the integer + part of each element represented by `is' and the number in the + decimal part by `ds'. The fixed point elements themselves will + have the integer parts loaded by the matrix `a' and the decimal + part by the matrix `b'. It should be noted that `a' and `b' are + both considered as unsigned integers and are the strict + representation of the bits of the fixed point value. + +`Matrix FixedMatrix::fixedpoint ()' + Method to create a `Matrix' from a fixed point matrix `x' + +`Matrix fixedpoint (const FixedMatrix &x)' + Create a `Matrix' from a fixed point matrix `x' + +`Matrix FixedMatrix::sign ()' + Return `-1' for negative numbers, `1' for positive and `0' if the + fixed point element is zero, for every element of the current + fixed point object. + +`Matrix sign (const FixedMatrix &x)' + Return `-1' for negative numbers, `1' for positive and `0' if + zero, for every element of the fixed point object `x'. + +`Matrix FixedMatrix::signbit ()' + Return the sign bit for every element of the current fixed point + matrix (`0' for positive number, `1' for negative number). + +`Matrix signbit (const FixedMatrix &x)' + Return the sign bit for every element of the fixed point matrix `x' + (`0' for positive number, `1' for negative number). + +`Matrix FixedMatrix::getintsize ()' + Return the number of bit `is' used to represent the integer part + of each element of the current fixed point object. + +`Matrix getintsize (const FixedMatrix &x)' + Return the number of bit `is' used to represent the integer part + of each element of the fixed point object `x'. + +`Matrix FixedMatrix::getdecsize ()' + Return the number of bit `ds' used to represent the decimal part + of each element of the current fixed point object. + +`Matrix getdecsize (const FixedMatrix &x)' + Return the number of bit `ds' used to represent the decimal part + of each element of the fixed point object `x'. + +`Matrix FixedMatrix::getnumber ()' + Return the integer representation of the fixed point value of the + each eleement of the current fixed point object. + +`Matrix getnumber (const FixedMatrix &x)' + Return the integer representation of the fixed point value of the + each eleement of the fixed point object `x'. + +`FixedMatrix FixedMatrix::chintsize (const Matrix &n)' +`FixedMatrix FixedMatrix::chintsize (const double n)' + Return a fixed point object equivalent to the current fixed point + object but with the number of bits representing the integer part + `is' of every element changed to `n'. If the result of this + operation causes any element of `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedMatrix FixedMatrix::chdecsize (const double n)' +`FixedMatrix FixedMatrix::chdecsize (const Matrix &n)' + Return a fixed point object equivalent to the current fixed point + object but with the number of bits representing the decimal part + `ds' of every element changed to `n'. If the result of this + operation causes any element of `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedMatrix FixedMatrix::incintsize (const double n)' +`FixedMatrix FixedMatrix::incintsize (const Matrix &n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by `n'. If `n' is negative, then `is' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedMatrix FixedMatrix::incintsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedMatrix FixedMatrix::incdecsize (const double n)' +`FixedMatrix FixedMatrix::incdecsize (const Matrix &n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by `n'. If `n' is negative, then `ds' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedMatrix FixedMatrix::incdecsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + + +File: fixed.info, Node: FixedRowVector, Next: FixedColumnVector, Prev: FixedMatrix, Up: Derived + +2.3.2 `FixedRowVector' class +---------------------------- + +`FixedRowVector::FixedRowVector (const MArray &is, const MArray &ds)' +`FixedRowVector::FixedRowVector (const RowVector &is, const RowVector &ds)' + Create a fixed point row vector with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + be initialized to zero. + +`FixedRowVector::FixedRowVector (unsigned int is, unsigned int ds, const FixedRowVector& a)' +`FixedRowVector::FixedRowVector (const MArray &is, const MArray &ds, const FixedRowVector& a)' +`FixedRowVector::FixedRowVector (const RowVector &is, const RowVector &ds, const FixedRowVector& a)' + Create a fixed point row vector with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + be initialized to the fixed point row rector `a' + +`FixedRowVector::FixedRowVector (unsigned int is, unsigned int ds, const RowVector& a)' +`FixedRowVector::FixedRowVector (const MArray &is, const MArray &ds, const RowVector& a)' +`FixedRowVector::FixedRowVector (const RowVector &is, const RowVector &ds, const RowVector& a)' + Create a fixed point row vector with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + be initialized to the row vector `a' + +`FixedRowVector::FixedRowVector (unsigned int is, unsigned int ds, const RowVector& a, const RowVector& b)' +`FixedRowVector::FixedRowVector (const MArray &is, const MArray &ds, const RowVector& a, const RowVector& b)' +`FixedRowVector::FixedRowVector (const RowVector &is, const RowVector &ds, const RowVector& a, const RowVector& b)' + Create a fixed point row vector with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + have the integer parts loaded by the row vector `a' and the + decimal part by the row vector `b'. It should be noted that `a' + and `b' are both considered as unsigned integers and are the + strict representation of the bits of the fixed point value. + +`RowVector FixedRowVector::fixedpoint ()' + Method to create a `RowVector' from a fixed point row vector `x' + +`RowVector fixedpoint (const FixedRowVector &x)' + Create a `RowVector' from a fixed point row vector `x' + +`RowVector FixedRowVector::sign ()' + Return `-1' for negative numbers, `1' for positive and `0' if the + fixed point element is zero, for every element of the current + fixed point object. + +`RowVector sign (const FixedRowVector &x)' + Return `-1' for negative numbers, `1' for positive and `0' if + zero, for every element of the fixed point object `x'. + +`RowVector FixedRowVector::signbit ()' + Return the sign bit for every element of the current fixed point + row vector (`0' for positive number, `1' for negative number). + +`RowVector signbit (const FixedRowVector &x)' + Return the sign bit for every element of the fixed point row + vector `x' (`0' for positive number, `1' for negative number). + +`RowVector FixedRowVector::getintsize ()' + Return the number of bit `is' used to represent the integer part + of each element of the current fixed point object. + +`RowVector getintsize (const FixedRowVector &x)' + Return the number of bit `is' used to represent the integer part + of each element of the fixed point object `x'. + +`RowVector FixedRowVector::getdecsize ()' + Return the number of bit `ds' used to represent the decimal part + of each element of the current fixed point object. + +`RowVector getdecsize (const FixedRowVector &x)' + Return the number of bit `ds' used to represent the decimal part + of each element of the fixed point object `x'. + +`RowVector FixedRowVector::getnumber ()' + Return the integer representation of the fixed point value of the + each eleement of the current fixed point object. + +`RowVector getnumber (const FixedRowVector &x)' + Return the integer representation of the fixed point value of the + each eleement of the fixed point object `x'. + +`FixedRowVector FixedRowVector::chintsize (const RowVector n)' +`FixedRowVector FixedRowVector::chintsize (const double n)' + Return a fixed point object equivalent to the current fixed point + object but with the number of bits representing the integer part + `is' of every element changed to `n'. If the result of this + operation causes any element of `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedRowVector FixedRowVector::chdecsize (const double n)' +`FixedRowVector FixedRowVector::chdecsize (const RowVector n)' + Return a fixed point object equivalent to the current fixed point + object but with the number of bits representing the decimal part + `ds' of every element changed to `n'. If the result of this + operation causes any element of `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedRowVector FixedRowVector::incintsize (const double n)' +`FixedRowVector FixedRowVector::incintsize (const RowVector &n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by `n'. If `n' is negative, then `is' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedRowVector FixedRowVector::incintsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedRowVector FixedRowVector::incdecsize (const double n)' +`FixedRowVector FixedRowVector::incdecsize (const RowVector &n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by `n'. If `n' is negative, then `ds' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedRowVector FixedRowVector::incdecsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + + +File: fixed.info, Node: FixedColumnVector, Next: FixedComplexMatrix, Prev: FixedRowVector, Up: Derived + +2.3.3 `FixedColumnVector' class +------------------------------- + +`FixedColumnVector::FixedColumnVector (const MArray &is, const MArray &ds)' +`FixedColumnVector::FixedColumnVector (const ColumnVector &is, const ColumnVector &ds)' + Create a fixed point row vector with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + be initialized to zero. + +`FixedColumnVector::FixedColumnVector (unsigned int is, unsigned int ds, const FixedColumnVector& a)' +`FixedColumnVector::FixedColumnVector (const MArray &is, const MArray &ds, const FixedColumnVector& a)' +`FixedColumnVector::FixedColumnVector (const ColumnVector &is, const ColumnVector &ds, const FixedColumnVector& a)' + Create a fixed point row vector with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + be initialized to the fixed point column vector `a' + +`FixedColumnVector::FixedColumnVector (unsigned int is, unsigned int ds, const ColumnVector& a)' +`FixedColumnVector::FixedColumnVector (const MArray &is, const MArray &ds, const ColumnVector& a)' +`FixedColumnVector::FixedColumnVector (const ColumnVector &is, const ColumnVector &ds, const ColumnVector& a)' + Create a fixed point row vector with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + be initialized to the column vector `a' + +`FixedColumnVector::FixedColumnVector (unsigned int is, unsigned int ds, const ColumnVector& a, const ColumnVector& b)' +`FixedColumnVector::FixedColumnVector (const MArray &is, const MArray &ds, const ColumnVector& a, const ColumnVector& b)' +`FixedColumnVector::FixedColumnVector (const ColumnVector &is, const ColumnVector &ds, const ColumnVector& a, const ColumnVector& b)' + Create a fixed point row vector with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + have the integer parts loaded by the column vector `a' and the + decimal part by the column vector `b'. It should be noted that `a' + and `b' are both considered as unsigned integers and are the + strict representation of the bits of the fixed point value. + +`ColumnVector FixedColumnVector::fixedpoint ()' + Method to create a `ColumnVector' from a fixed point column vector + `x' + +`ColumnVector fixedpoint (const FixedColumnVector &x)' + Create a `ColumnVector' from a fixed point column vector `x' + +`ColumnVector FixedColumnVector::sign ()' + Return `-1' for negative numbers, `1' for positive and `0' if the + fixed point element is zero, for every element of the current + fixed point object. + +`ColumnVector sign (const FixedColumnVector &x)' + Return `-1' for negative numbers, `1' for positive and `0' if + zero, for every element of the fixed point object `x'. + +`ColumnVector FixedColumnVector::signbit ()' + Return the sign bit for every element of the current fixed point + column vector (`0' for positive number, `1' for negative number). + +`ColumnVector signbit (const FixedColumnVector &x)' + Return the sign bit for every element of the fixed point column + vector `x' (`0' for positive number, `1' for negative number). + +`ColumnVector FixedColumnVector::getintsize ()' + Return the number of bit `is' used to represent the integer part + of each element of the current fixed point object. + +`ColumnVector getintsize (const FixedColumnVector &x)' + Return the number of bit `is' used to represent the integer part + of each element of the fixed point object `x'. + +`ColumnVector FixedColumnVector::getdecsize ()' + Return the number of bit `ds' used to represent the decimal part + of each element of the current fixed point object. + +`ColumnVector getdecsize (const FixedColumnVector &x)' + Return the number of bit `ds' used to represent the decimal part + of each element of the fixed point object `x'. + +`ColumnVector FixedColumnVector::getnumber ()' + Return the integer representation of the fixed point value of the + each eleement of the current fixed point object. + +`ColumnVector getnumber (const FixedColumnVector &x)' + Return the integer representation of the fixed point value of the + each eleement of the fixed point object `x'. + +`FixedColumnVector FixedColumnVector::chintsize (const ColumnVector n)' +`FixedColumnVector FixedColumnVector::chintsize (const double n)' + Return a fixed point object equivalent to the current fixed point + object but with the number of bits representing the integer part + `is' of every element changed to `n'. If the result of this + operation causes any element of `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedColumnVector FixedColumnVector::chdecsize (const double n)' +`FixedColumnVector FixedColumnVector::chdecsize (const ColumnVector n)' + Return a fixed point object equivalent to the current fixed point + object but with the number of bits representing the decimal part + `ds' of every element changed to `n'. If the result of this + operation causes any element of `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedColumnVector FixedColumnVector::incintsize (const double n)' +`FixedColumnVector FixedColumnVector::incintsize (const ColumnVector &n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by `n'. If `n' is negative, then `is' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedColumnVector FixedColumnVector::incintsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedColumnVector FixedColumnVector::incdecsize (const double n)' +`FixedColumnVector FixedColumnVector::incdecsize (const ColumnVector &n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by `n'. If `n' is negative, then `ds' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedColumnVector FixedColumnVector::incdecsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + + +File: fixed.info, Node: FixedComplexMatrix, Next: FixedComplexRowVector, Prev: FixedColumnVector, Up: Derived + +2.3.4 `FixedComplexMatrix' class +-------------------------------- + +`FixedComplexMatrix::FixedComplexMatrix (const MArray2 &is, const MArray2 &ds)' +`FixedComplexMatrix::FixedComplexMatrix (const Matrix &is, const Matrix &ds)' + Create a complex fixed point matrix with the number of bits in the + integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to zero. + +`FixedComplexMatrix::FixedComplexMatrix (const ComplexMatrix &is, const ComplexMatrix &ds)' + Create a complex fixed point matrix with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + be initialized to zero. + +`FixedComplexMatrix::FixedComplexMatrix (unsigned int is, unsigned int ds, const FixedComplexMatrix& a)' +`FixedComplexMatrix::FixedComplexMatrix (Complex is, Complex ds, const FixedComplexMatrix& a)' + +`FixedComplexMatrix::FixedComplexMatrix (const MArray2 &is, const MArray2 &ds, const FixedComplexMatrix& a)' +`FixedComplexMatrix::FixedComplexMatrix (const Matrix &is, const Matrix &ds, const FixedComplexMatrix& a)' + Create a complex fixed point matrix with the number of bits in the + integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to the + complex fixed point matrix `a' + +`FixedComplexMatrix::FixedComplexMatrix (const ComplexMatrix &is, const ComplexMatrix &ds, const FixedComplexMatrix &x)' +`FixedComplexMatrix::FixedComplexMatrix (const ComplexMatrix &is, const ComplexMatrix &ds, const FixedMatrix &r, const FixedMatrix &i)' + Create a complex fixed point matrix with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + be initialized to the complex fixed point matrix `a', or the real + part by `r' and the imaginary by `i'. + +`FixedComplexMatrix::FixedComplexMatrix (unsigned int is, unsigned int ds, const FixedMatrix& a)' +`FixedComplexMatrix::FixedComplexMatrix (Complex is, Complex ds, const FixedMatrix& a)' + +`FixedComplexMatrix::FixedComplexMatrix (const MArray2 &is, const MArray2 &ds, const FixedMatrix& a)' +`FixedComplexMatrix::FixedComplexMatrix (const Matrix &is, const Matrix &ds, const FixedMatrix& a)' + Create a complex fixed point matrix with the number of bits in the + integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to the + fixed point matrix `a' + +`FixedComplexMatrix::FixedComplexMatrix (const ComplexMatrix &is, const ComplexMatrix &ds, const FixedMatrix &x)' + Create a complex fixed point matrix with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + be initialized to the fixed point matrix `a'. + +`FixedComplexMatrix::FixedComplexMatrix (unsigned int is, unsigned int ds, const ComplexMatrix& a)' +`FixedComplexMatrix::FixedComplexMatrix (Complex is, Complex ds, const ComplexMatrix& a)' +`FixedComplexMatrix::FixedComplexMatrix (const MArray2 &is, const MArray2 &ds, const ComplexMatrix& a)' +`FixedComplexMatrix::FixedComplexMatrix (const ComplexMatrix &is, const ComplexMatrix &ds, const ComplexMatrix& a)' + Create a complex fixed point matrix with the number of bits in the + integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to the + complex matrix `a' + +`FixedComplexMatrix::FixedComplexMatrix (const ComplexMatrix &is, const ComplexMatrix &ds, const ComplexMatrix &x)' +`FixedComplexMatrix::FixedComplexMatrix (const ComplexMatrix &is, const ComplexMatrix &ds, const Matrix &r, const Matrix &i)' + Create a complex fixed point matrix with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + be initialized to the complex matrix `a', or the real part by `r' + and the imaginary by `i'. + +`FixedComplexMatrix::FixedComplexMatrix (unsigned int is, unsigned int ds, const Matrix& a)' +`FixedComplexMatrix::FixedComplexMatrix (Complex is, Complex ds, const Matrix& a)' +`FixedComplexMatrix::FixedComplexMatrix (const MArray2 &is, const MArray2 &ds, const Matrix& a)' +`FixedComplexMatrix::FixedComplexMatrix (const ComplexMatrix &is, const ComplexMatrix &ds, const Matrix& a)' + Create a complex fixed point matrix with the number of bits in the + integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to the + matrix `a' + +`FixedComplexMatrix::FixedComplexMatrix (const ComplexMatrix &is, const ComplexMatrix &ds, const Matrix &x)' + Create a complex fixed point matrix with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + be initialized to the matrix `a'. + +`FixedComplexMatrix::FixedComplexMatrix (unsigned int is, unsigned int ds, const ComplexMatrix& a, const ComplexMatrix& b)' +`FixedComplexMatrix::FixedComplexMatrix (Complex is, Complex ds, const ComplexMatrix& a, const ComplexMatrix& b)' +`FixedComplexMatrix::FixedComplexMatrix (const MArray2 &is, const MArray2 &ds, const ComplexMatrix& a, const ComplexMatrix& b)' + +`FixedComplexMatrix::FixedComplexMatrix (const Matrix &is, const Matrix &ds, const ComplexMatrix& a, const ComplexMatrix& b)' +`FixedComplexMatrix::FixedComplexMatrix (const ComplexMatrix &is, const ComplexMatrix &ds, const ComplexMatrix& a, const ComplexMatrix& b)' + Create a fixed point matrix with the number of bits in the integer + part of each element represented by `is' and the number in the + decimal part by `ds'.The fixed point elements themselves will have + the integer parts loaded by the complex matrix `a' and the decimal + part by the complex matrix `b'. It should be noted that `a' and + `b' are both considered as unsigned complex integers and are the + strict representation of the bits of the fixed point value. + +`ComplexMatrix FixedComplexMatrix::fixedpoint ()' + Method to create a `Matrix' from a fixed point matrix `x' + +`ComplexMatrix fixedpoint (const FixedComplexMatrix &x)' + Create a `Matrix' from a fixed point matrix `x' + +`ComplexMatrix FixedComplexMatrix::sign ()' + Return `-1' for negative numbers, `1' for positive and `0' if the + fixed point element is zero, for every element of the current + fixed point object. + +`ComplexMatrix sign (const FixedComplexMatrix &x)' + Return `-1' for negative numbers, `1' for positive and `0' if + zero, for every element of the fixed point object `x'. + +`ComplexMatrix FixedComplexMatrix::getintsize ()' + Return the number of bit `is' used to represent the integer part + of each element of the current fixed point object. + +`ComplexMatrix getintsize (const FixedComplexMatrix &x)' + Return the number of bit `is' used to represent the integer part + of each element of the fixed point object `x'. + +`ComplexMatrix FixedComplexMatrix::getdecsize ()' + Return the number of bit `ds' used to represent the decimal part + of each element of the current fixed point object. + +`ComplexMatrix getdecsize (const FixedComplexMatrix &x)' + Return the number of bit `ds' used to represent the decimal part + of each element of the fixed point object `x'. + +`ComplexMatrix FixedComplexMatrix::getnumber ()' + Return the integer representation of the fixed point value of the + each eleement of the current fixed point object. + +`ComplexMatrix getnumber (const FixedComplexMatrix &x)' + Return the integer representation of the fixed point value of the + each eleement of the fixed point object `x'. + +`FixedComplexMatrix FixedComplexMatrix::chintsize (const ComplexMatrix &n)' +`FixedComplexMatrix FixedComplexMatrix::chintsize (const double n)' + Return a fixed point object equivalent to the current fixed point + object but with the number of bits representing the integer part + `is' of every element changed to `n'. If the result of this + operation causes any element of `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedComplexMatrix FixedComplexMatrix::chdecsize (const double n)' +`FixedComplexMatrix FixedComplexMatrix::chdecsize (const ComplexMatrix &n)' + Return a fixed point object equivalent to the current fixed point + object but with the number of bits representing the decimal part + `ds' of every element changed to `n'. If the result of this + operation causes any element of `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedComplexMatrix FixedComplexMatrix::incintsize (const double n)' +`FixedComplexMatrix FixedComplexMatrix::incintsize (const ComplexMatrix &n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by `n'. If `n' is negative, then `is' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedComplexMatrix FixedComplexMatrix::incintsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedComplexMatrix FixedComplexMatrix::incdecsize (const double n)' +`FixedComplexMatrix FixedComplexMatrix::incdecsize (const ComplexMatrix &n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by `n'. If `n' is negative, then `ds' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedComplexMatrix FixedComplex::incdecsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + + +File: fixed.info, Node: FixedComplexRowVector, Next: FixedComplexColumnVector, Prev: FixedComplexMatrix, Up: Derived + +2.3.5 `FixedComplexRowVector' class +----------------------------------- + +`FixedComplexRowVector::FixedComplexRowVector (const MArray &is, const MArray &ds)' +`FixedComplexRowVector::FixedComplexRowVector (const RowVector &is, const RowVector &ds)' + Create a complex fixed point row vector with the number of bits in + the integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to zero. + +`FixedComplexRowVector::FixedComplexRowVector (const ComplexRowVector &is, const ComplexRowVector &ds)' + Create a complex fixed point row vector with the number of bits in + the integer part of each element represented by `is' and the + number in the decimal part by `ds'. The fixed point elements + themselves will be initialized to zero. + +`FixedComplexRowVector::FixedComplexRowVector (unsigned int is, unsigned int ds, const FixedComplexRowVector& a)' +`FixedComplexRowVector::FixedComplexRowVector (Complex is, Complex ds, const FixedComplexRowVector& a)' +`FixedComplexRowVector::FixedComplexRowVector (const MArray &is, const MArray &ds, const FixedComplexRowVector& a)' +`FixedComplexRowVector::FixedComplexRowVector (const RowVector &is, const RowVector &ds, const FixedComplexRowVector& a)' + Create a complex fixed point row vector with the number of bits in + the integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to the + complex fixed point row vector `a' + +`FixedComplexRowVector::FixedComplexRowVector (const ComplexRowVector &is, const ComplexRowVector &ds, const FixedComplexRowVector &x)' +`FixedComplexRowVector::FixedComplexRowVector (const ComplexRowVector &is, const ComplexRowVector &ds, const FixedRowVector &r, const FixedRowVector &i)' + Create a complex fixed point row vector with the number of bits in + the integer part of each element represented by `is' and the + number in the decimal part by `ds'. The fixed point elements + themselves will be initialized to the complex fixed point row + vector `a', or the real part by `r' and the imaginary by `i'. + +`FixedComplexRowVector::FixedComplexRowVector (unsigned int is, unsigned int ds, const FixedRowVector& a)' +`FixedComplexRowVector::FixedComplexRowVector (Complex is, Complex ds, const FixedRowVector& a)' +`FixedComplexRowVector::FixedComplexRowVector (const MArray &is, const MArray &ds, const FixedRowVector& a)' +`FixedComplexRowVector::FixedComplexRowVector (const RowVector &is, const RowVector &ds, const FixedRowVector& a)' + Create a complex fixed point row vector with the number of bits in + the integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to the + fixed point row vector `a' + +`FixedComplexRowVector::FixedComplexRowVector (const ComplexRowVector &is, const ComplexRowVector &ds, const FixedRowVector &x)' + Create a complex fixed point row vector with the number of bits in + the integer part of each element represented by `is' and the + number in the decimal part by `ds'. The fixed point elements + themselves will be initialized to the fixed point row vector `a'. + +`FixedComplexRowVector::FixedComplexRowVector (unsigned int is, unsigned int ds, const ComplexRowVector& a)' +`FixedComplexRowVector::FixedComplexRowVector (Complex is, Complex ds, const ComplexRowVector& a)' +`FixedComplexRowVector::FixedComplexRowVector (const MArray &is, const MArray &ds, const ComplexRowVector& a)' +`FixedComplexRowVector::FixedComplexRowVector (const ComplexRowVector &is, const ComplexRowVector &ds, const ComplexRowVector& a)' + Create a complex fixed point row vector with the number of bits in + the integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to the + complex row vector `a' + +`FixedComplexRowVector::FixedComplexRowVector (const ComplexRowVector &is, const ComplexRowVector &ds, const ComplexRowVector &x)' +`FixedComplexRowVector::FixedComplexRowVector (const ComplexRowVector &is, const ComplexRowVector &ds, const RowVector &r, const RowVector &i)' + Create a complex fixed point row vector with the number of bits in + the integer part of each element represented by `is' and the + number in the decimal part by `ds'. The fixed point elements + themselves will be initialized to the complex row vector `a', or + the real part by `r' and the imaginary by `i'. + +`FixedComplexRowVector::FixedComplexRowVector (unsigned int is, unsigned int ds, const RowVector& a)' +`FixedComplexRowVector::FixedComplexRowVector (Complex is, Complex ds, const RowVector& a)' +`FixedComplexRowVector::FixedComplexRowVector (const MArray &is, const MArray &ds, const RowVector& a)' +`FixedComplexRowVector::FixedComplexRowVector (const ComplexRowVector &is, const ComplexRowVector &ds, const RowVector& a)' + Create a complex fixed point row vector with the number of bits in + the integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to the row + vector `a' + +`FixedComplexRowVector::FixedComplexRowVector (const ComplexRowVector &is, const ComplexRowVector &ds, const RowVector &x)' + Create a complex fixed point row vector with the number of bits in + the integer part of each element represented by `is' and the + number in the decimal part by `ds'. The fixed point elements + themselves will be initialized to the row vector `a'. + +`FixedComplexRowVector::FixedComplexRowVector (unsigned int is, unsigned int ds, const ComplexRowVector& a, const ComplexRowVector& b)' +`FixedComplexRowVector::FixedComplexRowVector (Complex is, Complex ds, const ComplexRowVector& a, const ComplexRowVector& b)' +`FixedComplexRowVector::FixedComplexRowVector (const MArray &is, const MArray &ds, const ComplexRowVector& a, const ComplexRowVector& b)' +`FixedComplexRowVector::FixedComplexRowVector (const RowVector &is, const RowVector &ds, const ComplexRowVector& a, const ComplexRowVector& b)' +`FixedComplexRowVector::FixedComplexRowVector (const ComplexRowVector &is, const ComplexRowVector &ds, const ComplexRowVector& a, const ComplexRowVector& b)' + Create a fixed point row vector with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + have the integer parts loaded by the complex row vector `a' and + the decimal part by the complex row vector `b'. It should be noted + that `a' and `b' are both considered as unsigned complex integers + and are the strict representation of the bits of the fixed point + value. + +`ComplexRowVector FixedComplexRowVector::fixedpoint ()' + Method to create a `RowVector' from a fixed point row vector `x' + +`ComplexRowVector fixedpoint (const FixedComplexRowVector &x)' + Create a `RowVector' from a fixed point row vector `x' + +`ComplexRowVector FixedComplexRowVector::sign ()' + Return `-1' for negative numbers, `1' for positive and `0' if the + fixed point element is zero, for every element of the current + fixed point object. + +`ComplexRowVector sign (const FixedComplexRowVector &x)' + Return `-1' for negative numbers, `1' for positive and `0' if + zero, for every element of the fixed point object `x'. + +`ComplexRowVector FixedComplexRowVector::getintsize ()' + Return the number of bit `is' used to represent the integer part + of each element of the current fixed point object. + +`ComplexRowVector getintsize (const FixedComplexRowVector &x)' + Return the number of bit `is' used to represent the integer part + of each element of the fixed point object `x'. + +`ComplexRowVector FixedComplexRowVector::getdecsize ()' + Return the number of bit `ds' used to represent the decimal part + of each element of the current fixed point object. + +`ComplexRowVector getdecsize (const FixedComplexRowVector &x)' + Return the number of bit `ds' used to represent the decimal part + of each element of the fixed point object `x'. + +`ComplexRowVector getdecsize (const FixedComplexRowVector &x)' + Return the number of bit `ds' used to represent the decimal part + of each element of the fixed point object `x'. + +`ComplexRowVector FixedComplexRowVector::getnumber ()' + Return the integer representation of the fixed point value of the + each eleement of the current fixed point object. + +`FixedComplexRowVector FixedComplexRowVector::chintsize (const ComplexRowVector &n)' +`FixedComplexRowVector FixedComplexRowVector::chintsize (const double n)' + Return a fixed point object equivalent to the current fixed point + object but with the number of bits representing the integer part + `is' of every element changed to `n'. If the result of this + operation causes any element of `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedComplexRowVector FixedComplexRowVector::chdecsize (const double n)' +`FixedComplexRowVector FixedComplexRowVector::chdecsize (const ComplexRowVector &n)' + Return a fixed point object equivalent to the current fixed point + object but with the number of bits representing the decimal part + `ds' of every element changed to `n'. If the result of this + operation causes any element of `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedComplexRowVector FixedComplexRowVector::incintsize (const Complex n)' +`FixedComplexRowVector FixedComplexRowVector::incintsize (const ComplexRowVector &n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by `n'. If `n' is negative, then `is' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedComplexRowVector FixedComplexRowVector::incintsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedComplexRowVector FixedComplexRowVector::incdecsize (const Complex n)' +`FixedComplexRowVector FixedComplexRowVector::incdecsize (const ComplexRowVector &n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by `n'. If `n' is negative, then `ds' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedComplexRowVector FixedComplexRowVector::incdecsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + + +File: fixed.info, Node: FixedComplexColumnVector, Prev: FixedComplexRowVector, Up: Derived + +2.3.6 `FixedComplexColumnVector' class +-------------------------------------- + +`FixedComplexColumnVector::FixedComplexColumnVector (const MArray &is, const MArray &ds)' +`FixedComplexColumnVector::FixedComplexColumnVector (const ColumnVector &is, const ColumnVector &ds)' + Create a complex fixed point column vector with the number of bits + in the integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to zero. + +`FixedComplexColumnVector::FixedComplexColumnVector (const ComplexColumnVector &is, const ComplexColumnVector &ds)' + Create a complex fixed point column vector with the number of bits + in the integer part of each element represented by `is' and the + number in the decimal part by `ds'. The fixed point elements + themselves will be initialized to zero. + +`FixedComplexColumnVector::FixedComplexColumnVector (unsigned int is, unsigned int ds, const FixedComplexColumnVector& a)' +`FixedComplexColumnVector::FixedComplexColumnVector (Complex is, Complex ds, const FixedComplexColumnVector& a)' +`FixedComplexColumnVector::FixedComplexColumnVector (const MArray &is, const MArray &ds, const FixedComplexColumnVector& a)' +`FixedComplexColumnVector::FixedComplexColumnVector (const ColumnVector &is, const ColumnVector &ds, const FixedComplexColumnVector& a)' + Create a complex fixed point column vector with the number of bits + in the integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to the + complex fixed point column vector `a' + +`FixedComplexColumnVector::FixedComplexColumnVector (const ComplexColumnVector &is, const ComplexColumnVector &ds, const FixedComplexColumnVector &x)' +`FixedComplexColumnVector::FixedComplexColumnVector (const ComplexColumnVector &is, const ComplexColumnVector &ds, const FixedColumnVector &r, const FixedColumnVector &i)' + Create a complex fixed point column vector with the number of bits + in the integer part of each element represented by `is' and the + number in the decimal part by `ds'. The fixed point elements + themselves will be initialized to the complex fixed point column + vector `a', or the real part by `r' and the imaginary by `i'. + +`FixedComplexColumnVector::FixedComplexColumnVector (unsigned int is, unsigned int ds, const FixedColumnVector& a)' +`FixedComplexColumnVector::FixedComplexColumnVector (Complex is, Complex ds, const FixedColumnVector& a)' +`FixedComplexColumnVector::FixedComplexColumnVector (const MArray &is, const MArray &ds, const FixedColumnVector& a)' +`FixedComplexColumnVector::FixedComplexColumnVector (const ColumnVector &is, const ColumnVector &ds, const FixedColumnVector& a)' + Create a complex fixed point column vector with the number of bits + in the integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to the + fixed point column vector `a' + +`FixedComplexColumnVector::FixedComplexColumnVector (const ComplexColumnVector &is, const ComplexColumnVector &ds, const FixedColumnVector &x)' + Create a complex fixed point column vector with the number of bits + in the integer part of each element represented by `is' and the + number in the decimal part by `ds'. The fixed point elements + themselves will be initialized to the fixed point column vector + `a'. + +`FixedComplexColumnVector::FixedComplexColumnVector (unsigned int is, unsigned int ds, const ComplexColumnVector& a)' +`FixedComplexColumnVector::FixedComplexColumnVector (Complex is, Complex ds, const ComplexColumnVector& a)' +`FixedComplexColumnVector::FixedComplexColumnVector (const MArray &is, const MArray &ds, const ComplexColumnVector& a)' +`FixedComplexColumnVector::FixedComplexColumnVector (const ComplexColumnVector &is, const ComplexColumnVector &ds, const ComplexColumnVector& a)' + Create a complex fixed point column vector with the number of bits + in the integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to the + complex column vector `a' + +`FixedComplexColumnVector::FixedComplexColumnVector (const ComplexColumnVector &is, const ComplexColumnVector &ds, const ComplexColumnVector &x)' +`FixedComplexColumnVector::FixedComplexColumnVector (const ComplexColumnVector &is, const ComplexColumnVector &ds, const ColumnVector &r, const ColumnVector &i)' + Create a complex fixed point column vector with the number of bits + in the integer part of each element represented by `is' and the + number in the decimal part by `ds'. The fixed point elements + themselves will be initialized to the complex column vector `a', + or the real part by `r' and the imaginary by `i'. + +`FixedComplexColumnVector::FixedComplexColumnVector (unsigned int is, unsigned int ds, const ColumnVector& a)' +`FixedComplexColumnVector::FixedComplexColumnVector (Complex is, Complex ds, const ColumnVector& a)' + +`FixedComplexColumnVector::FixedComplexColumnVector (const MArray &is, const MArray &ds, const ColumnVector& a)' +`FixedComplexColumnVector::FixedComplexColumnVector (const ComplexColumnVector &is, const ComplexColumnVector &ds, const ColumnVector& a)' + Create a complex fixed point column vector with the number of bits + in the integer part of the real and imaginary part of each element + represented by `is' and the number in the decimal part by `ds'. + The fixed point elements themselves will be initialized to the + column vector `a' + +`FixedComplexColumnVector::FixedComplexColumnVector (const ComplexColumnVector &is, const ComplexColumnVector &ds, const ColumnVector &x)' + Create a complex fixed point column vector with the number of bits + in the integer part of each element represented by `is' and the + number in the decimal part by `ds'. The fixed point elements + themselves will be initialized to the column vector `a'. + +`FixedComplexColumnVector::FixedComplexColumnVector (unsigned int is, unsigned int ds, const ComplexColumnVector& a, const ComplexColumnVector& b)' +`FixedComplexColumnVector::FixedComplexColumnVector (Complex is, Complex ds, const ComplexColumnVector& a, const ComplexColumnVector& b)' +`FixedComplexColumnVector::FixedComplexColumnVector (const MArray &is, const MArray &ds, const ComplexColumnVector& a, const ComplexColumnVector& b)' +`FixedComplexColumnVector::FixedComplexColumnVector (const ColumnVector &is, const ColumnVector &ds, const ComplexColumnVector& a, const ComplexColumnVector& b)' +`FixedComplexColumnVector::FixedComplexColumnVector (const ComplexColumnVector &is, const ComplexColumnVector &ds, const ComplexColumnVector& a, const ComplexColumnVector& b)' + Create a fixed point column vector with the number of bits in the + integer part of each element represented by `is' and the number in + the decimal part by `ds'. The fixed point elements themselves will + have the integer parts loaded by the complex column vector `a' and + the decimal part by the compelx column vector `b'. It should be + noted that `a' and `b' are both considered as unsigned compelx + integers and are the strict representation of the bits of the + fixed point value. + +`ComplexColumnVector FixedComplexColumnVector::fixedpoint ()' + Method to create a `ColumnVector' from a fixed point column vector + `x' + +`ComplexColumnVector fixedpoint (const FixedComplexColumnVector &x)' + Create a `ColumnVector' from a fixed point column vector `x' + +`ComplexColumnVector FixedComplexColumnVector::sign ()' + Return `-1' for negative numbers, `1' for positive and `0' if the + fixed point element is zero, for every element of the current + fixed point object. + +`ComplexColumnVector sign (const FixedComplexColumnVector &x)' + Return `-1' for negative numbers, `1' for positive and `0' if + zero, for every element of the fixed point object `x'. + +`ComplexColumnVector FixedComplexColumnVector::getintsize ()' + Return the number of bit `is' used to represent the integer part + of each element of the current fixed point object. + +`ComplexColumnVector getintsize (const FixedComplexColumnVector &x)' + Return the number of bit `is' used to represent the integer part + of each element of the fixed point object `x'. + +`ComplexColumnVector FixedComplexColumnVector::getdecsize ()' + Return the number of bit `ds' used to represent the decimal part + of each element of the current fixed point object. + +`ComplexColumnVector getdecsize (const FixedComplexColumnVector &x)' + Return the number of bit `ds' used to represent the decimal part + of each element of the fixed point object `x'. + +`ComplexColumnVector FixedComplexColumnVector::getnumber ()' + Return the integer representation of the fixed point value of the + each eleement of the current fixed point object. + +`ComplexColumnVector getnumber (const FixedComplexColumnVector &x)' + Return the integer representation of the fixed point value of the + each eleement of the fixed point object `x'. + +`FixedComplexColumnVector FixedComplexColumnVector::chintsize (const ComplexColumnVector &n)' +`FixedComplexColumnVector FixedComplexColumnVector::chintsize (const double n)' + Return a fixed point object equivalent to the current fixed point + object but with the number of bits representing the integer part + `is' of every element changed to `n'. If the result of this + operation causes any element of `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedComplexColumnVector FixedComplexColumnVector::chdecsize (const double n)' +`FixedComplexColumnVector FixedComplexColumnVector::chdecsize (const ComplexColumnVector &n)' + Return a fixed point object equivalent to the current fixed point + object but with the number of bits representing the decimal part + `ds' of every element changed to `n'. If the result of this + operation causes any element of `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedComplexColumnVector FixedComplexColumnVector::incintsize (const double n)' +`FixedComplexColumnVector FixedComplexColumnVector::incintsize (const ComplexColumnVector &n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by `n'. If `n' is negative, then `is' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedComplexColumnVector FixedComplexColumnVector::incintsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the integer part + `is' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + +`FixedComplexColumnVector FixedComplexColumnVector::incdecsize (const double n)' +`FixedComplexColumnVector FixedComplexColumnVector::incdecsize (const ComplexColumnVector &n)' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by `n'. If `n' is negative, then `ds' is decreased. + If the result of this operation causes `is + ds' to be greater than + `sizeof(int)*8 - 2', the error handler is called. + +`FixedComplexColumnVector FixedComplexColumnVector::incdecsize ()' + Return a fixed point object equivalent to the current fixed point + number but with the number of bits representing the decimal part + `ds' increased by 1. If the result of this operation causes `is + + ds' to be greater than `sizeof(int)*8 - 2', the error handler is + called. + + +File: fixed.info, Node: Upper, Next: Oct-files, Prev: Derived, Up: Programming + +2.4 The Upper Level Octave Classes +================================== + +There are 4 upper level classes that define the interface of the fixed +point type to the octave interpreter. These mirror similar definitions +for floating values in octave and are + + `octave_fixed' -> `octave_scalar' + `octave_fixed_complex' -> `octave_complex' + `octave_fixed_matrix' -> `octave_matrix' + `octave_fixed_complex_matrix' -> `octave_complex_matrix' + + These fixed point classes use the same base classes as the +corresponding floating classes, and so have similar capabilities. +However, one notable addition are the methods to obtain the base fixed +point objects from these classes, and also correspond to similar +floating point methods. These are + + `fixed_value' -> `scalar_value' + `fixed_complex_value' -> `complex_value' + `fixed_matrix_value' -> `matrix_value' + `fixed_complex_matrix_value' -> `complex_matrix_value' + + and can be used in all fixed point classes, subject to a possible +reduction operations (eg. casts a `FixedComplexMatrix' as a +`FixedPoint'). In addition the methods `scalar_value', `complex_value', +`matrix_value' and `complex_matrix_value' can all be used. + + The user should examine the files `ov-fixed-cx-mat.h', +`ov-fixed-complex.h', `ov-fixed-mat.h' and `ov-fixed.h' and the base +classes in the files `ov-base-fixed.h', `ov-base-fixed-mat.h', and +file `ov-base.h' within octave to see the methods that are available +for the upper level classes. + + +File: fixed.info, Node: Oct-files, Prev: Upper, Up: Programming + +2.5 Writing Oct-files with the Fixed Point Type +=============================================== + +It is not the purpose of this section to discuss how to write an +oct-file, or discuss what they are, but rather the specifics of using +oct-files with the fixed point type. An oct-file is a means of writing +an octave function in a compilable language like C++, rather than as a +script file. This results in a significant acceleration in the code. +The reader is referred to the tutorial available at +`http://octave.sourceforge.net/coda/coda.html'. The examples discussed +here assume that the oct-file is written entirely in C++. + +* Menu: + +* Templates:: Using C++ Templates in Oct-files +* Problems:: Specific Problems of Oct-files using Fixed Point +* Cygwin:: Specific points to note when using Oct-files and Cygwin +* OctExample:: A Simple Example of an Oct-file + + +File: fixed.info, Node: Templates, Next: Problems, Prev: Oct-files, Up: Oct-files + +2.5.1 Using C++ Templates in Oct-files +-------------------------------------- + +When using the fixed point toolbox, you will almost certainly want to +compare an implementation in fixed-point against the corresponding +implementation in floating point. This allows the degradation due to +the conversion to a fixed-point algorithm to be easily observed. The +concept of C++ templates allows easy implementation of both fixed and +floating point versions of the same code. For example consider + + template + A myfunc(const A &a, const B &b) { + return (a + b); + } + + // Floating point instantiations + template double myfunc (const double&, const double&); + template Complex myfunc (const Complex&, const double&); + template Matrix myfunc (const Matrix&, const double&); + template ComplexMatrix myfunc (const ComplexMatrix&, const double&); + + // Fixed point instantiations + template FixedPoint myfunc (const FixedPoint&, const FixedPoint&); + template FixedPointComplex myfunc (const FixedPointComplex&, + const FixedPoint&); + template FixedMatrix myfunc (const FixedMatrix&, const FixedPoint&); + template FixedComplexMatrix myfunc (const FixedComplexMatrix&, + const FixedPoint&); + + Eight versions of the function `myfunc' are created, that allow its +use with all floating and fixed types. + + +File: fixed.info, Node: Problems, Next: Cygwin, Prev: Templates, Up: Oct-files + +2.5.2 Specific Problems of Oct-files using Fixed Point +------------------------------------------------------ + +The fact that the fixed point type is loadable, means that the symbols +of this type are not available till the first use of a fixed point +variable. This means that the function "fixed" must be called at least +once prior to accessing fixed point values in an oct-file. If a user +function is called, that uses a fixed point type, before the type is +loaded the result will be an error message complaining of unknown +symbols. For example + + octave:1> fixed_inc(a) + error: /home/dbateman/octave/fixed/fixed_inc.oct: undefined symbol: + _ZN24octave_base_fixed_matrixI18FixedComplexMatrixE7subsref + ERKSsRKSt4listI17octave_value_listSaIS5_EE + error: `fixed_inc' undefined near line 1 column 1 + + This should not in itself result in an abnormal exit from Octave. + + Another problem when accessing fixed point variables within +oct-files, is that the Octave `octave_value' class knows nothing about +this type. So you can not directly call a method such as +`fixed_value()' on the input arguments, but rather must cast the +representation of the `octave_value' as a fixed type and then call the +relevant method. An example of extracting a fixed point value from an +`octave_value' variable `arg' is then + + octave_value arg; + ... + if (arg.type_id () == octave_fixed::static_type_id ()) { + FixedPoint f = ((const octave_fixed&) arg.get_rep()).fixed_value(); + + Similarly, the return value from an oct-file is itself either an +`octave_value' or an `octave_value_list'. So a special means of +creating the return value must be used. For example + + octave_value_list retval; + Matrix m; + FixedPoint f; + ... + retval(0) = octave_value(m); + retval(1) = new octave_fixed (f); + + +File: fixed.info, Node: Cygwin, Next: OctExample, Prev: Problems, Up: Oct-files + +2.5.3 Specific points to note when using Oct-files and Cygwin +------------------------------------------------------------- + +When using the GNU C++ compiler under Cygwin to create a shared object, +such as an oct-file, the symbols must be resolved at compile time. This +is as opposed to a Unix platform where the resolution of the symbols +can be left till runtime. For this reason the fixed point type, when +built under Cygwin is split into an oct-file and a shared library +called `liboctave_fixed.dll'. This is as opposed to the situation under +Unix, where only the Oct-file containing all of the fixed point type is +needed. + + This has the implication that when you build an Oct-file under Cygwin +using the fixed point type, that they must be linked to +`liboctave_fixed.dll'. An appropriate means to do this is for example + + % mkoctfile -loctave_fixed myfile.cc + + The file `liboctave_fixed.dll' and `liboctave_fixed.dll.a' must be +located somewhere that the compiler can find them. If these are +installed in the same directory as `liboctave.dll' and +`liboctave.dll.a' respectively, then `mkoctfile' will find them +automatically. + + +File: fixed.info, Node: OctExample, Prev: Cygwin, Up: Oct-files + +2.5.4 A Simple Example of an Oct-file +------------------------------------- + +An example of a simple oct-file written in C++ using the fixed point +type can be seen below. It integrates the ideas discussed previously. + + #include + #include + #include "fixed.h" + + template + A myfunc(const A &a, const B &b) { + return (a + b); + } + + // Floating point instantiations + template double myfunc (const double&, const double&); + template Complex myfunc (const Complex&, const double&); + template Matrix myfunc (const Matrix&, const double&); + template ComplexMatrix myfunc (const ComplexMatrix&, const double&); + + // Fixed point instantiations + template FixedPoint myfunc (const FixedPoint&, const FixedPoint&); + template FixedPointComplex myfunc (const FixedPointComplex&, + const FixedPoint&); + template FixedMatrix myfunc (const FixedMatrix&, const FixedPoint&); + template FixedComplexMatrix myfunc (const FixedComplexMatrix&, + const FixedPoint&); + + DEFUN_DLD (fixed_inc, args, , + "-*- texinfo -*-\n\ + @deftypefn {Loadable Function} {@var{y} =} fixed_inc (@var{x})\n\ + Example code of the use of the fixed point types in an oct-file.\n\ + Returns @code{@var{x} + 1}\n\ + @end deftypefn") + { + octave_value retval; + FixedPoint one(1,0,1,0); // Fixed Point value of 1 + + if (args.length() != 1) + print_usage("fixed_inc"); + else + if (args(0).type_id () == octave_fixed_matrix::static_type_id ()) { + FixedMatrix f = ((const octave_fixed_matrix&) args(0).get_rep()). + fixed_matrix_value(); + retval = new octave_fixed_matrix (myfunc(f,one)); + } else if (args(0).type_id () == octave_fixed::static_type_id ()) { + FixedPoint f = ((const octave_fixed&) args(0).get_rep()). + fixed_value(); + retval = new octave_fixed (myfunc(f,one)); + } else if (args(0).type_id () == + octave_fixed_complex::static_type_id ()) { + FixedPointComplex f = ((const octave_fixed_complex&) + args(0).get_rep()).fixed_complex_value(); + retval = new octave_fixed_complex (myfunc(f,one)); + } else if (args(0).type_id () == + octave_fixed_complex_matrix::static_type_id ()) { + FixedComplexMatrix f = ((const octave_fixed_complex_matrix&) + args(0).get_rep()).fixed_complex_matrix_value(); + retval = new octave_fixed_complex_matrix (myfunc(f,one)); + } else { + // promote the operation to complex matrix. The narrowing op in + // octave_value will later change the type if needed. This is not + // optimal but is convenient.... + ComplexMatrix f = args(0).complex_matrix_value(); + retval = octave_value (myfunc(f,1.)); + } + return retval; + } + + +File: fixed.info, Node: Example, Next: Function Reference, Prev: Programming, Up: Top + +3 Fixed Point Type Applied to Real Signal Processing Example +************************************************************ + +As an example of the use of the fixed point toolbox applied to a real +signal processing example, we consider the implementation of a Radix-4 +IFFT in an OFDM modulator. Code for this IFFT has been written as a C++ +template class, and integrated as an Octave Oct-file. This allowed a +single version of the code to be instantiated to perform both the fixed +and floating point implementations of the same code. The instantiations +of this class are + + template Fft; + template Fft; + + template Ifft; + template Ifft; + + The code for this example is available as part of the release of this +software package. + + A particular problem of a hardware implementation of an IFFT is that +each butterfly in the radix-4 IFFT consists of the summation of four +terms with a suitable phase. Thus, an additional 2 output bits are +potentially needed after each butterfly of the radix-4 IFFT. There are +several ways of addressing this issue + + 1. Increase the number of bits in the fixed point representation by + two after each radix-4 butterfly. There are then two ways of + treating these added bits: + + A. Accept them and let the size of the representation of the + fixed point numbers grows. For large IFFT's this is not + acceptable + + B. Cut the least significant bits of representation, either + after each butterfly, or after groups of butterflies. This + reduces the number of bits in the representation, but still + trades off complexity to avoid an overflow condition + + 2. Keep the fixed point representation used in the IFFT fixed, but + reduce the input signal level to avoid overflows. The IFFT can + then have internal overflows. + + An overflow will cause a bit-error which is not necessarily +critical. The last option is therefore attractive in that it allows the +minimum complexity in the hardware implementation of the IFFT. However, +careful investigation of the overflow effects are needed, which can be +performed with the fixed point toolbox. + + The table below shows the case of a 64QAM OFDM signal similar to that +used in the 802.11a standard. In this table the OFDM modulator has been +represented using fixed point, while the rest of the system is assumed +to be perfect. The table shows the tradeoff between the backoff of the +RMS power in the frequency domain signal relative to the fixed point +representation for several different fixed point representations. + + Backoff BER BER BER + dB 8+1 Bits 10+1 Bits 12+1 Bits + ------ ------- -------- -------- + 5.00 2.11e-01 2.27e-01 2.30e-01 + 6.00 1.09e-01 1.18e-01 1.21e-01 + 7.00 4.23e-02 5.25e-02 5.53e-02 + 8.00 1.17e-02 1.36e-02 1.48e-02 + 9.00 5.34e-03 2.21e-03 2.33e-03 + 10.00 7.49e-03 3.78e-04 3.71e-04 + 11.00 1.22e-02 0.00e+00 0.00e+00 + 12.00 2.00e-02 0.00e+00 0.00e+00 + 13.00 3.12e-02 0.00e+00 0.00e+00 + 14.00 4.34e-02 0.00e+00 0.00e+00 + 15.00 6.12e-02 2.31e-07 0.00e+00 + 16.00 7.53e-02 2.31e-06 0.00e+00 + 17.00 9.00e-02 1.87e-05 0.00e+00 + 18.00 1.15e-01 5.56e-05 0.00e+00 + 19.00 1.30e-01 4.69e-04 0.00e+00 + 20.00 1.55e-01 1.30e-03 0.00e+00 + 21.00 1.84e-01 2.96e-03 0.00e+00 + 22.00 1.98e-01 7.41e-03 0.00e+00 + 23.00 2.30e-01 1.09e-02 0.00e+00 + 24.00 2.50e-01 1.99e-02 0.00e+00 + 25.00 2.73e-01 2.99e-02 0.00e+00 + 26.00 2.99e-01 4.38e-02 0.00e+00 + 27.00 3.39e-01 6.09e-02 2.31e-07 + 28.00 3.51e-01 7.57e-02 2.31e-06 + 29.00 3.86e-01 8.99e-02 9.72e-06 + 30.00 3.97e-01 1.16e-01 6.99e-05 + + Two regions are clearly visible in this table. When the backoff of +the RMS power is small, the effects of the overflow in the IFFT +dominate, and reduce the performance. When the backoff is large, there +are fewer bits in the fixed point representation relative to the +average signal power and therefore a slow degradation in the +performance. It is clear that somewhere between 11 and 13 bits in the +representation of the fixed point numbers in the IFFT is optimal, with a +backoff of approximately 13dB. + + +File: fixed.info, Node: Function Reference, Prev: Example, Up: Top + +4 Function Reference +******************** + +* Menu: + +* concat:: Concatenate two matrices regardless of their type. +* create_lookup_table:: Creates a lookup table betwen the vectors X and Y. +* display_fixed_operations:: Displays out a summary of the number of fixed + point operations of each type that have been used. +* fabs:: Compute the magnitude of the fixed point value X. +* fangle:: See "farg". +* farg:: Compute the argument of X, defined as THETA = `atan2 (Y, + X)' in radians. +* fatan2:: Compute atan (Y / X) for corresponding fixed point elements + of Y and X. +* fceil:: Return the smallest integer not less than X. +* fconj:: Returns the conjuate of the fixed point value X. +* fcos:: Compute the cosine of the fixed point value X. +* fcosh:: Compute the hyperbolic cosine of the fixed point value X. +* fcumprod:: Cumulative product of elements along dimension DIM. +* fcumsum:: Cumulative sum of elements along dimension DIM. +* fdiag:: Return a diagonal matrix with fixed point vector V on + diagonal K. +* fexp:: Compute the exponential of the fixed point value X. +* ffft:: Radix-4 fft in floating and fixed point for vectors of + length 4^N, where N is an integer. +* ffloor:: Return the largest integer not greater than X. +* fifft:: Radix-4 ifft in fixed point for vectors of length 4^N, + where. +* fimag:: Returns the imaginary part of the fixed point value X. +* fixed:: Used the create a fixed point variable. +* fixed_inc:: Example code of the use of the fixed point types in an + oct-file. +* fixed_point_count_operations:: Query or set the internal variable + `fixed_point_count_operations'. +* fixed_point_debug:: Query or set the internal variable + `fixed_point_debug'. +* fixed_point_library_version:: A function returning the version number of + the fixed point library used. +* fixed_point_version:: A function returning the version number of the + fixed point package used. +* fixed_point_warn_overflow:: Query or set the internal variable + `fixed_point_warn_overflow'. +* fixedpoint:: Manual and test code for the Octave Fixed Point toolbox. +* float:: Converts a fixed point object to the equivalent floating + point object. +* flog:: Compute the natural logarithm of the fixed point value X. +* flog10:: Compute the base-10 logarithm of the fixed point value X. +* fprod:: Product of elements along dimension DIM. +* freal:: Returns the real part of the fixed point value X. +* freshape:: Return a fixed matrix with M rows and N columns whose + elements are taken from the fixed matrix A. +* fround:: Return the rounded value to the nearest integer of X. +* fsin:: Compute the sine of the fixed point value X. +* fsinh:: Compute the hyperbolic sine of the fixed point value X. +* fsort:: Return a copy of the fixed point variable X with the + elements arranged in increasing order. +* fsqrt:: Compute the square-root of the fixed point value X. +* fsum:: Sum of elements along dimension DIM. +* fsumsq:: Sum of squares of elements along dimension DIM. +* ftan:: Compute the tan of the fixed point value X. +* ftanh:: Compute the hyperbolic tan of the fixed point value X. +* isfixed:: Return 1 if the value of the expression EXPR is a fixed + point value. +* lookup_table:: Using the lookup table created by "create_lookup_table", + find the value Y corresponding to X. +* reset_fixed_operations:: Reset the count of fixed point operations to + zero. + + +File: fixed.info, Node: concat, Next: create_lookup_table, Up: Function Reference + +4.0.1 concat +------------ + + -- Function File: X = concat (A, B) + -- Function File: X = concat (A, B, DIM) + Concatenate two matrices regardless of their type. Due to the + implementation of the matrix concatenation in Octave being + hard-coded for the types it knowns, user types can not use the + matrix concatenation operator. Thus for the _Galois_ and _Fixed + Point_ types, the in-built matrix concatenation functions will + return a matrix value as their solution + + This function allows these types to be concatenated. If called + with a user type that is not known by this function, the in-built + concatenate function is used + + If DIM is 1, then the matrices are concatenated, else if DIM is 2, + they are stacked + + +File: fixed.info, Node: create_lookup_table, Next: display_fixed_operations, Prev: concat, Up: Function Reference + +4.0.2 create_lookup_table +------------------------- + + -- Function File: TABLE = create_lookup_table (X, Y) + Creates a lookup table betwen the vectors X and Y. If X is not in + increasing order, the vectors are sorted before being stored + + +File: fixed.info, Node: display_fixed_operations, Next: fabs, Prev: create_lookup_table, Up: Function Reference + +4.0.3 display_fixed_operations +------------------------------ + + -- Loadable Function: display_fixed_operations ( ) + Displays out a summary of the number of fixed point operations of + each type that have been used. This can be used to give a estimate + of the complexity of an algorithm. +See also: fixed_point_count_operations, reset_fixed_operations + + +File: fixed.info, Node: fabs, Next: fangle, Prev: display_fixed_operations, Up: Function Reference + +4.0.4 fabs +---------- + + -- Loadable Function: Y = fabs (X) + Compute the magnitude of the fixed point value X. + + +File: fixed.info, Node: fangle, Next: farg, Prev: fabs, Up: Function Reference + +4.0.5 fangle +------------ + + -- Loadable Function: Y = fangle (X) + See "farg". + + +File: fixed.info, Node: farg, Next: fatan2, Prev: fangle, Up: Function Reference + +4.0.6 farg +---------- + + -- Loadable Function: Y = farg (X) + Compute the argument of X, defined as THETA = `atan2 (Y, X)' in + radians. For example + + farg (fixed (3,5,3+4i)) + => 0.90625 + + +File: fixed.info, Node: fatan2, Next: fceil, Prev: farg, Up: Function Reference + +4.0.7 fatan2 +------------ + + -- Loadable Function: fatan2 (Y, X) + Compute atan (Y / X) for corresponding fixed point elements of Y + and X. The result is in range -pi to pi. + + +File: fixed.info, Node: fceil, Next: fconj, Prev: fatan2, Up: Function Reference + +4.0.8 fceil +----------- + + -- Loadable Function: Y = fceil (X) + Return the smallest integer not less than X. +See also: fround, ffloor + + +File: fixed.info, Node: fconj, Next: fcos, Prev: fceil, Up: Function Reference + +4.0.9 fconj +----------- + + -- Loadable Function: Y = fconj (X) + Returns the conjuate of the fixed point value X. + + +File: fixed.info, Node: fcos, Next: fcosh, Prev: fconj, Up: Function Reference + +4.0.10 fcos +----------- + + -- Loadable Function: Y = fcos (X) + Compute the cosine of the fixed point value X. +See also: fcosh, fsin, fsinh, ftan, ftanh + + +File: fixed.info, Node: fcosh, Next: fcumprod, Prev: fcos, Up: Function Reference + +4.0.11 fcosh +------------ + + -- Loadable Function: Y = fcosh (X) + Compute the hyperbolic cosine of the fixed point value X. +See also: fcos, fsin, fsinh, ftan, ftanh + + +File: fixed.info, Node: fcumprod, Next: fcumsum, Prev: fcosh, Up: Function Reference + +4.0.12 fcumprod +--------------- + + -- Loadable Function: Y = fcumprod (X,DIM) + Cumulative product of elements along dimension DIM. If DIM is + omitted, it defaults to 1 (column-wise cumulative products). +See also: fcumsum + + +File: fixed.info, Node: fcumsum, Next: fdiag, Prev: fcumprod, Up: Function Reference + +4.0.13 fcumsum +-------------- + + -- Loadable Function: Y = fcumsum (X,DIM) + Cumulative sum of elements along dimension DIM. If DIM is + omitted, it defaults to 1 (column-wise cumulative sums). +See also: fcumprod + + +File: fixed.info, Node: fdiag, Next: fexp, Prev: fcumsum, Up: Function Reference + +4.0.14 fdiag +------------ + + -- Loadable Function: fdiag (V, K) + Return a diagonal matrix with fixed point vector V on diagonal K. + The second argument is optional. If it is positive, the vector is + placed on the K-th super-diagonal. If it is negative, it is placed + on the -K-th sub-diagonal. The default value of K is 0, and the + vector is placed on the main diagonal. For example, + + fdiag (fixed(3,2,[1, 2, 3]), 1) + ans = + + 0.00 1.00 0.00 0.00 + 0.00 0.00 2.00 0.00 + 0.00 0.00 0.00 3.00 + 0.00 0.00 0.00 0.00 + + Note that if all of the elements of the original vector have the + same fixed point representation, then the zero elements in the + matrix are created with the same representation. Otherwise the + zero elements are created with the equivalent of the fixed point + value `fixed(0,0,0)'.n +See also: diag + + +File: fixed.info, Node: fexp, Next: ffft, Prev: fdiag, Up: Function Reference + +4.0.15 fexp +----------- + + -- Loadable Function: Y = fexp (X) + Compute the exponential of the fixed point value X. +See also: log, log10, pow + + +File: fixed.info, Node: ffft, Next: ffloor, Prev: fexp, Up: Function Reference + +4.0.16 ffft +----------- + + -- Loadable Function: Y = ffft (X) + Radix-4 fft in floating and fixed point for vectors of length 4^N, + where N is an integer. The variable X can be a either a row of + column vector, in which case a single fft is carried out over the + vector of length 4^N. If X is a matrix, the fft is carried on each + column of X and the matrix must contain 4^N rows. + + The radix-4 fft is implemented in a manner that attempts to + approximate how it will be implemented in hardware, rather than + use a generic butterfly. The radix-4 algorithm is faster and more + precise than the equivalent radix-2 algorithm, and thus is + preferred for hardware implementation. See also: fifft + + +File: fixed.info, Node: ffloor, Next: fifft, Prev: ffft, Up: Function Reference + +4.0.17 ffloor +------------- + + -- Loadable Function: Y = ffloor (X) + Return the largest integer not greater than X. +See also: fround, fceil + + +File: fixed.info, Node: fifft, Next: fimag, Prev: ffloor, Up: Function Reference + +4.0.18 fifft +------------ + + -- Loadable Function: Y = fifft (X) + Radix-4 ifft in fixed point for vectors of length 4^N, where. N + is an integer. The variable X can be a either a row of column + vector, in which case a single ifft is carried out over the vector + of length 4^N. If X is a matrix, the ifft is carried on each + column of X and the matrix must contain 4^N rows. + + The radix-4 ifft is implemented in a manner that attempts to + approximate how it will be implemented in hardware, rather than + use a generic butterfly. The radix-4 algorithm is faster and more + precise than the equivalent radix-2 algorithm, and thus is + preferred for hardware implementation. See also: ffft + + +File: fixed.info, Node: fimag, Next: fixed, Prev: fifft, Up: Function Reference + +4.0.19 fimag +------------ + + -- Loadable Function: Y = fimag (X) + Returns the imaginary part of the fixed point value X. + + +File: fixed.info, Node: fixed, Next: fixed_inc, Prev: fimag, Up: Function Reference + +4.0.20 fixed +------------ + + -- Loadable Function: Y = fixed (F) + -- Loadable Function: Y = fixed (IS,DS) + -- Loadable Function: Y = fixed (IS,DS,F) + Used the create a fixed point variable. Called with a single + argument, if F is itself a fixed point value, then "fixed" is + equivalent to `Y = F'. Otherwise the integer part of F is used to + create a fixed point variable with the minimum number of bits + needed to represent it. F can be either real of complex. + + Called with two or more arguments IS represents the number of bits + used to represent the integer part of the fixed point numbers, and + DS the number used to represent the decimal part. These variables + must be either positive integer scalars or matrices. If they are + matrices they must be of the same dimension, and each fixed point + number in the created matrix will have the representation given by + the corresponding values of IS and DS. + + When creating complex fixed point values, the fixed point + representation can be different for the real and imaginary parts. + In this case IS and DS are complex integers. Additionally the + maximum value of the sum of IS and DS is limited by the + representation of long integers to either 30 or 62. + + Called with only two arguments, the fixed point variable that is + created will contain only zeros. A third argument can be used to + give the values of the fixed variables elements. This third + argument F can be either a fixed point variable itself, which + results in a new fixed point variable being created with a + different representation, or a real or complex matrix. + + +File: fixed.info, Node: fixed_inc, Next: fixed_point_count_operations, Prev: fixed, Up: Function Reference + +4.0.21 fixed_inc +---------------- + + -- Loadable Function: Y = fixed_inc (X) + Example code of the use of the fixed point types in an oct-file. + Returns `X + 1' + + +File: fixed.info, Node: fixed_point_count_operations, Next: fixed_point_debug, Prev: fixed_inc, Up: Function Reference + +4.0.22 fixed_point_count_operations +----------------------------------- + + -- Loadable Function: VAL = fixed_point_count_operations () + -- Loadable Function: OLD_VAL = fixed_point_count_operations (NEW_VAL) + Query or set the internal variable `fixed_point_count_operations'. + If enabled, Octave keeps track of how many times each type of + floating point operation has been used internally. This can be + used to give an approximation of the algorithms complexity. By + default, this feature is disabled. See also: + display_fixed_operations + + +File: fixed.info, Node: fixed_point_debug, Next: fixed_point_library_version, Prev: fixed_point_count_operations, Up: Function Reference + +4.0.23 fixed_point_debug +------------------------ + + -- Loadable Function: VAL = fixed_point_debug () + -- Loadable Function: OLD_VAL = fixed_point_debug (NEW_VAL) + Query or set the internal variable `fixed_point_debug'. If + enabled, Octave keeps a copy of the value of fixed point variable + internally. This is useful for use with a debug to allow easy + access to the variables value. By default this feature is + disabled. + + +File: fixed.info, Node: fixed_point_library_version, Next: fixed_point_version, Prev: fixed_point_debug, Up: Function Reference + +4.0.24 fixed_point_library_version +---------------------------------- + + -- Loadable Function: fixed_point_library_version () + A function returning the version number of the fixed point library + used. + + +File: fixed.info, Node: fixed_point_version, Next: fixed_point_warn_overflow, Prev: fixed_point_library_version, Up: Function Reference + +4.0.25 fixed_point_version +-------------------------- + + -- Loadable Function: fixed_point_version () + A function returning the version number of the fixed point package + used. + + +File: fixed.info, Node: fixed_point_warn_overflow, Next: fixedpoint, Prev: fixed_point_version, Up: Function Reference + +4.0.26 fixed_point_warn_overflow +-------------------------------- + + -- Loadable Function: VAL = fixed_point_warn_overflow () + -- Loadable Function: OLD_VAL = fixed_point_warn_overflow (NEW_VAL) + Query or set the internal variable `fixed_point_warn_overflow'. + If enabled, Octave warns of overflows in fixed point operations. + By default, these warnings are disabled. + + +File: fixed.info, Node: fixedpoint, Next: float, Prev: fixed_point_warn_overflow, Up: Function Reference + +4.0.27 fixedpoint +----------------- + + -- Function File: fixedpoint ('help') + -- Function File: fixedpoint ('info') + -- Function File: fixedpoint ('info', MOD) + -- Function File: fixedpoint ('test') + -- Function File: fixedpoint ('test', MOD) + Manual and test code for the Octave Fixed Point toolbox. There are + 5 possible ways to call this function + + `fixedpoint ('help')' + Display this help message. Called with no arguments, this + function also displays this help message + + `fixedpoint ('info')' + Open the Fixed Point toolbox manual + + `fixedpoint ('info', MOD)' + Open the Fixed Point toolbox manual at the section specified + by MOD + + `fixedpoint ('test')' + Run all of the test code for the Fixed Point toolbox MOD + + Valid values for the varibale MOD are + + 'basics' + The section describing the use of the fixed point toolbox + within Octave + + 'programming' + The section descrining how to use the fixed-point type with + oct-files + + 'example' + The section describing an in-depth example of the use of the + fixed-point type + + 'reference' + The refernce section of all of the specific fixed point + operators and functions + + Please note that this function file should be used as an example + of the use of this toolbox + + +File: fixed.info, Node: float, Next: flog, Prev: fixedpoint, Up: Function Reference + +4.0.28 float +------------ + + -- Function File: Y = float (X) + Converts a fixed point object to the equivalent floating point + object. This is equivalent to `X.x' if `isfixed(X)' returns true, + and returns X otherwise + + +File: fixed.info, Node: flog, Next: flog10, Prev: float, Up: Function Reference + +4.0.29 flog +----------- + + -- Loadable Function: Y = flog (X) + Compute the natural logarithm of the fixed point value X. +See also: fexp, flog10, fpow + + +File: fixed.info, Node: flog10, Next: fprod, Prev: flog, Up: Function Reference + +4.0.30 flog10 +------------- + + -- Loadable Function: Y = flog10 (X) + Compute the base-10 logarithm of the fixed point value X. +See also: fexp, flog, fpow + + +File: fixed.info, Node: fprod, Next: freal, Prev: flog10, Up: Function Reference + +4.0.31 fprod +------------ + + -- Loadable Function: Y = fprod (X,DIM) + Product of elements along dimension DIM. If DIM is omitted, it + defaults to 1 (column-wise products). +See also: fsum, fsumsq + + +File: fixed.info, Node: freal, Next: freshape, Prev: fprod, Up: Function Reference + +4.0.32 freal +------------ + + -- Loadable Function: Y = freal (X) + Returns the real part of the fixed point value X. + + +File: fixed.info, Node: freshape, Next: fround, Prev: freal, Up: Function Reference + +4.0.33 freshape +--------------- + + -- Loadable Function: freshape (A, M, N) + Return a fixed matrix with M rows and N columns whose elements are + taken from the fixed matrix A. To decide how to order the + elements, Octave pretends that the elements of a matrix are stored + in column-major order (like Fortran arrays are stored). + + For example, + + freshape (fixed(3, 2, [1, 2, 3, 4]), 2, 2) + ans = + + 1.00 3.00 + 2.00 4.00 + + If the variable `do_fortran_indexing' is nonzero, the `freshape' + function is equivalent to + + retval = fixed(0,0,zeros (m, n)); + retval (:) = a; + + but it is somewhat less cryptic to use `freshape' instead of the + colon operator. Note that the total number of elements in the + original matrix must match the total number of elements in the new + matrix. +See also: `:' and do_fortran_indexing + + +File: fixed.info, Node: fround, Next: fsin, Prev: freshape, Up: Function Reference + +4.0.34 fround +------------- + + -- Loadable Function: Y = fround (X) + Return the rounded value to the nearest integer of X. +See also: ffloor, fceil + + +File: fixed.info, Node: fsin, Next: fsinh, Prev: fround, Up: Function Reference + +4.0.35 fsin +----------- + + -- Loadable Function: Y = fsin (X) + Compute the sine of the fixed point value X. +See also: fcos, fcosh, fsinh, ftan, ftanh + + +File: fixed.info, Node: fsinh, Next: fsort, Prev: fsin, Up: Function Reference + +4.0.36 fsinh +------------ + + -- Loadable Function: Y = fsinh (X) + Compute the hyperbolic sine of the fixed point value X. +See also: fcos, fcosh, fsin, ftan, ftanh + + +File: fixed.info, Node: fsort, Next: fsqrt, Prev: fsinh, Up: Function Reference + +4.0.37 fsort +------------ + + -- Function File: [S, I] = fsort (X) + Return a copy of the fixed point variable X with the elements + arranged in increasing order. For matrices, `fsort' orders the + elements in each column + + For example, + + fsort (fixed(4,0,[1, 2; 2, 3; 3, 1])) + => 1 1 + 2 2 + 3 3 + + The `fsort' function may also be used to produce a matrix + containing the original row indices of the elements in the sorted + matrix. For example, + + [s, i] = sort ([1, 2; 2, 3; 3, 1]) + => s = 1 1 + 2 2 + 3 3 + => i = 1 3 + 2 1 + 3 2 + + +File: fixed.info, Node: fsqrt, Next: fsum, Prev: fsort, Up: Function Reference + +4.0.38 fsqrt +------------ + + -- Loadable Function: Y = fsqrt (X) + Compute the square-root of the fixed point value X. + + +File: fixed.info, Node: fsum, Next: fsumsq, Prev: fsqrt, Up: Function Reference + +4.0.39 fsum +----------- + + -- Loadable Function: Y = fsum (X,DIM) + Sum of elements along dimension DIM. If DIM is omitted, it + defaults to 1 (column-wise sum). +See also: fprod, fsumsq + + +File: fixed.info, Node: fsumsq, Next: ftan, Prev: fsum, Up: Function Reference + +4.0.40 fsumsq +------------- + + -- Loadable Function: Y = fsumsq (X,DIM) + Sum of squares of elements along dimension DIM. If DIM is + omitted, it defaults to 1 (column-wise sum of squares). This + function is equivalent to computing + fsum (x .* fconj (x), dim) + but it uses less memory and avoids calling `fconj' if X is real. +See also: fprod, fsum + + +File: fixed.info, Node: ftan, Next: ftanh, Prev: fsumsq, Up: Function Reference + +4.0.41 ftan +----------- + + -- Loadable Function: Y = ftan (X) + Compute the tan of the fixed point value X. +See also: fcos, fcosh, fsinh, ftan, ftanh + + +File: fixed.info, Node: ftanh, Next: isfixed, Prev: ftan, Up: Function Reference + +4.0.42 ftanh +------------ + + -- Loadable Function: Y = ftanh (X) + Compute the hyperbolic tan of the fixed point value X. +See also: fcos, fcosh, fsin, fsinh, ftan + + +File: fixed.info, Node: isfixed, Next: lookup_table, Prev: ftanh, Up: Function Reference + +4.0.43 isfixed +-------------- + + -- Loadable Function: isfixed (EXPR) + Return 1 if the value of the expression EXPR is a fixed point + value. + + +File: fixed.info, Node: lookup_table, Next: reset_fixed_operations, Prev: isfixed, Up: Function Reference + +4.0.44 lookup_table +------------------- + + -- Function File: Y = lookup_table (TABLE, X) + -- Function File: Y = lookup_table (TABLE, X, INTERP, EXTRAP) + Using the lookup table created by "create_lookup_table", find the + value Y corresponding to X. With two arguments the lookup is done + to the nearest value below in the table less than the desired + value. With three arguments a simple linear interpolation is + performed. With four arguments an extrapolation is also performed. + The exact values of arguments three and four are irrelevant, as + only there presence detremines whether interpolation and/or + extrapolation are used + + +File: fixed.info, Node: reset_fixed_operations, Prev: lookup_table, Up: Function Reference + +4.0.45 reset_fixed_operations +----------------------------- + + -- Loadable Function: reset_fixed_operations ( ) + Reset the count of fixed point operations to zero. +See also: fixed_point_count_operations, display_fixed_operations + + + +Tag Table: +Node: Top0 +Node: Basics451 +Node: License2189 +Node: Representation3637 +Node: Creation5758 +Node: Overflow10324 +Node: Built-in Variables12463 +Node: Accessing Internal Fields15016 +Node: Function Overloading17290 +Node: Together19419 +Node: Precision21133 +Node: Lookup Tables22801 +Node: Known Problems24895 +Node: Programming30612 +Node: FixedPoint32047 +Node: FPConstructors32393 +Node: FPSpecific34500 +Node: FPOperators38437 +Node: FPFunctions42058 +Node: FixedPointComplex44635 +Node: FPCConstructors45488 +Node: FPCSpecific53798 +Node: FPCOperators59333 +Node: FPCFunctions61802 +Node: Derived65276 +Node: FixedMatrix67221 +Node: FixedRowVector73874 +Node: FixedColumnVector80858 +Node: FixedComplexMatrix88161 +Node: FixedComplexRowVector99293 +Node: FixedComplexColumnVector111035 +Node: Upper123337 +Node: Oct-files125003 +Node: Templates125932 +Node: Problems127400 +Node: Cygwin129334 +Node: OctExample130559 +Node: Example133601 +Node: Function Reference138734 +Node: concat142156 +Node: create_lookup_table143001 +Node: display_fixed_operations143367 +Node: fabs143849 +Node: fangle144070 +Node: farg144239 +Node: fatan2144545 +Node: fceil144815 +Node: fconj145041 +Node: fcos145244 +Node: fcosh145486 +Node: fcumprod145744 +Node: fcumsum146066 +Node: fdiag146378 +Node: fexp147393 +Node: ffft147623 +Node: ffloor148441 +Node: fifft148672 +Node: fimag149487 +Node: fixed149699 +Node: fixed_inc151463 +Node: fixed_point_count_operations151745 +Node: fixed_point_debug152436 +Node: fixed_point_library_version153025 +Node: fixed_point_version153370 +Node: fixed_point_warn_overflow153699 +Node: fixedpoint154205 +Node: float155705 +Node: flog156025 +Node: flog10156266 +Node: fprod156511 +Node: freal156803 +Node: freshape157013 +Node: fround158021 +Node: fsin158262 +Node: fsinh158503 +Node: fsort158756 +Node: fsqrt159503 +Node: fsum159711 +Node: fsumsq159991 +Node: ftan160450 +Node: ftanh160690 +Node: isfixed160944 +Node: lookup_table161190 +Node: reset_fixed_operations161964 + +End Tag Table diff --git a/octave_packages/fixed-0.7.10/fixedpoint.m b/octave_packages/fixed-0.7.10/fixedpoint.m new file mode 100644 index 0000000..72bf125 --- /dev/null +++ b/octave_packages/fixed-0.7.10/fixedpoint.m @@ -0,0 +1,1744 @@ +## Copyright (C) 2003 Motorola Inc +## Copyright (C) 2003 David Bateman +## +## 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} {} fixedpoint ('help') +## @deftypefnx {Function File} {} fixedpoint ('info') +## @deftypefnx {Function File} {} fixedpoint ('info', @var{mod}) +## @deftypefnx {Function File} {} fixedpoint ('test') +## @deftypefnx {Function File} {} fixedpoint ('test', @var{mod}) +## +## Manual and test code for the Octave Fixed Point toolbox. There are +## 5 possible ways to call this function. +## +## @table @code +## @item fixedpoint ('help') +## Display this help message. Called with no arguments, this function also +## displays this help message +## @item fixedpoint ('info') +## Open the Fixed Point toolbox manual +## @item fixedpoint ('info', @var{mod}) +## Open the Fixed Point toolbox manual at the section specified by +## @var{mod} +## @item fixedpoint ('test') +## Run all of the test code for the Fixed Point toolbox. +## @var{mod}. +## @end table +## +## Valid values for the varibale @var{mod} are +## +## @table @asis +## @item 'basics' +## The section describing the use of the fixed point toolbox within Octave +## @item 'programming' +## The section descrining how to use the fixed-point type with oct-files +## @item 'example' +## The section describing an in-depth example of the use of the fixed-point +## type +## @item 'reference' +## The refernce section of all of the specific fixed point operators and +## functions +## @end table +## +## Please note that this function file should be used as an example of the +## use of this toolbox. +## @end deftypefn + +function retval = fixedpoint(typ, tests) + + if (nargin < 1) + typ = "help"; + tests = "all"; + elseif (nargin < 2) + tests = "all"; + endif + + infofile = [fileparts(mfilename('fullpath')),'/doc.info']; + n = 10; + m = 20; + is = 7; + ds = 6; + vals = [-10,10]; + + vers = sscanf(OCTAVE_VERSION, "%i.%i.%i"); + + if strcmp(tests,"all") + nodename = "Top"; + elseif strcmp(tests,"basics") + nodename = "Basics"; + elseif strcmp(tests,"programming") + nodename = "Programming"; + elseif strcmp(tests,"example") + nodename = "Example"; + elseif strcmp(tests,"reference") + nodename = "Function Reference"; + else + error ("fixedpoint: unrecognized section"); + endif + + if (strcmp(typ,"help")) + help ("fixedpoint"); + elseif (strcmp(typ,"info")) + infopaths = ["."]; + if (!isempty(char (strsplit (path, ":")))) + infopaths =[infopaths; char (strsplit (path, ":"))]; + endif + if (!isempty(char (strsplit (DEFAULT_LOADPATH, ":")))) + infopaths =[infopaths; char (strsplit (DEFAULT_LOADPATH, ":"))]; + endif + for i=1:size(infopaths,1) + infopath = deblank(infopaths(i,:)); + len = length(infopath); + if (len) + if (len > 1 && strcmp(infopath([len-1, len]),"//")) + [status, showfile] = system(["find '", infopath(1:len-1), ... + "' -name ", infofile]); + else + [status, showfile] = system(["find '", infopath, "' -name ", ... + infofile, " -maxdepth 1"]); + endif + if (length(showfile)) + break; + endif + endif + end + if (!exist("showfile") || !length(showfile)) + error("fixedpoint: info file not found"); + endif + if (showfile(length(showfile)) == "\n") + showfile = showfile(1:length(showfile)-1); + endif + + if (exist("INFO_PROGAM")) + [testret, testout] = system(["'", INFO_PROGRAM, "' --version"]); + if (testret) + error("fixedpoint: info command not found"); + else + system(["'", INFO_PROGRAM, "' --file '", showfile, "' --node '", ... + nodename, "'"]); + endif + else + [testret, testout] = system("info --version"); + if (testret) + error("fixedpoint: info command not found"); + else + system(["info --file '", showfile, "' --node '", nodename, "'"]); + endif + endif + elseif (strcmp(typ,"test")) + pso = page_screen_output(); + unwind_protect + page_screen_output(0); + feps = 1 / 2 ^ ds; + + fprintf("\n<< Fixed Point Load Type >>\n"); + + ## Load a fixed point variable to start things off + x = fixed(is,ds); + + if (!exist("fixed_point_warn_overflow") || !exist("fixed_point_debug") || + !exist("fixed_point_count_operations") || + !exist("fixed_point_version")) + error("Can not find fixed point type") + endif + + fprintf(" Found Fixed Point Toolbox (version %s)\n", + fixed_point_version); + + fprintf("\n<< Fixed Point Creation >>\n"); + fprintf(" Scalar Creation: "); + zero = fixed(is,ds); + if (zero.x != 0.) || (zero.int != is) || (zero.dec != ds) + error ("FAILED"); + endif + if (!isscalar(zero) || !ismatrix(zero) || !isfixed(zero) || + !isvector(zero)) + error ("FAILED"); + endif + if any(zero) || all(zero) + error ("FAILED"); + endif + if (size(zero) != [1,1]) || (length(zero) != 1) + error ("FAILED"); + endif + zero.int = zero.int+1; + zero.dec = zero.dec+1; + if (zero.x != 0.) || (zero.int != is+1) || (zero.dec != ds+1) + error ("FAILED"); + endif + empty = fixed(is,ds,[]); + if (isscalar(empty) || ismatrix(empty) || !isfixed(empty) || + isvector(empty) || !isempty(empty) || isempty(zero)) + error ("FAILED"); + endif + for i=1:100 + x = (vals(2)-vals(1))*rand(1,1)+vals(1); + a = fixed(is, ds, x); + if (abs(a.x - x) > feps) || (a.sign != sign(a.x)) || !isfixed(a) + error ("FAILED"); + endif + endfor + fprintf("PASSED\n"); + fprintf(" Matrix Creation: "); + zero = fixed(is,ds,zeros(n,n)); + + if (any(any(zero.x)) || any(any(zero.int != is)) || + any(any(zero.dec != ds))) + error ("FAILED"); + endif + if (isscalar(zero) || !ismatrix(zero) || !isfixed(zero) || + isvector(zero)) + error ("FAILED"); + endif + if any(any(zero)) || all(all(zero)) + error ("FAILED"); + endif + if (size(zero) != [n,n]) + error ("FAILED"); + endif + zero.int = zero.int+1; + zero.dec = zero.dec+1; + if (any(any(zero.x)) || any(any(zero.int != is+1)) || + any(any(zero.dec != ds+1))) + error ("FAILED"); + endif + for i=1:100 + x = (vals(2)-vals(1))*rand(n,n)+vals(1); + a = fixed(is, ds, x); + if (any(any(abs(a.x - x) > feps)) || any(any(a.sign != sign(a.x))) + || !isfixed(a)) + error ("FAILED"); + endif + endfor + b = freshape(a,n*n,1); + if (isscalar(b) || !ismatrix(b) || !isfixed(b) || !isvector(b)) + error ("FAILED"); + endif + if any(b != a(:)) + error ("FAILED"); + endif + zero = fixed(is,ds,0); + vec = fixed(is,ds,[1:n]); + a = fdiag(vec); + if (size(a,1) != n || size(a,2) != n) + error("FAILED"); + endif + for i=1:n + for j=1:n + if ((i == j) && (a(i,j) != vec(i))) + error("FAILED"); + elseif ((i != j) && (a(i,j) != zero)) + error("FAILED"); + endif + end + end + vec = fdiag(a); + if (length(vec) != n) + error("FAILED"); + endif + for i=1:n + if (a(i,i) != vec(i)) + error("FAILED"); + endif + end + fprintf("PASSED\n"); + fprintf(" Complex Scalar Creation: "); + onei = fixed(is*(1+1i),ds*(1+1i),1+1i); + if ((onei.x != 1+1i) || (onei.int != is*(1+1i)) || + (onei.dec != ds*(1+1i))) + error ("FAILED"); + endif + if (!isscalar(onei) || !ismatrix(onei) || !isfixed(onei) || + !isvector(onei) || !iscomplex(onei)) + error ("FAILED"); + endif + if !any(onei) || !all(onei) + error ("FAILED"); + endif + if (size(onei) != [1,1]) || (length(onei) != 1) + error ("FAILED"); + endif + onei.int = onei.int+1; + onei.dec = onei.dec+1; + if ((onei.x != 1+1i) || (onei.int != is*(1+1i)+1) || + (onei.dec != ds*(1+1i)+1)) + error ("FAILED"); + endif + empty = fixed(is*(1+1i),ds*(1+1i),[]); + if (isscalar(empty) || ismatrix(empty) || !isfixed(empty) || + isvector(empty) || !isempty(empty) || isempty(onei) || + iscomplex(empty)) + ## Not complex, since its type is narrowed!! + error ("FAILED"); + endif + + for i=1:100 + x = (vals(2)-vals(1))*rand(1,1)+vals(1) + ... + 1i * (vals(2)-vals(1))*rand(1,1)+vals(1); + a = fixed(is, ds, x); + if ((abs(real(a.x) - real(x)) > feps) || + (abs(imag(a.x) - imag(x)) > feps) || !isfixed(a)) + error ("FAILED"); + endif + endfor + fprintf("PASSED\n"); + fprintf(" Complex Matrix Creation: "); + onei = fixed(is*(1+1i),ds*(1+1i),ones(n,n)*(1+1i)); + + if (any(any(onei.x != 1+1i)) || any(any(onei.int != is*(1+1i))) || + any(any(onei.dec != ds*(1+1i)))) + error ("FAILED"); + endif + if (isscalar(onei) || !ismatrix(onei) || !isfixed(onei) || + isvector(onei) || !iscomplex(onei)) + error ("FAILED"); + endif + if !any(any(onei)) || !all(all(onei)) + error ("FAILED"); + endif + if (size(onei) != [n,n]) + error ("FAILED"); + endif + onei.int = onei.int+1; + onei.dec = onei.dec+1; + if (any(any(onei.x != 1+1i)) || any(any(onei.int != is*(1+1i)+1)) || + any(any(onei.dec != ds*(1+1i)+1))) + error ("FAILED"); + endif + for i=1:100 + x = (vals(2)-vals(1))*rand(n,n)+vals(1) + ... + 1i * (vals(2)-vals(1))*rand(n,n)+vals(1); + a = fixed(is, ds, x); + if (any(any(abs(real(a.x) - real(x)) > feps)) || + any(any(abs(imag(a.x) - imag(x)) > feps)) || !isfixed(a)) + error ("FAILED"); + endif + endfor + b = freshape(a,n*n,1); + if (isscalar(b) || !ismatrix(b) || !isfixed(b) || !isvector(b)) + error ("FAILED"); + endif + if any(b != a(:)) + error ("FAILED"); + endif + zero = fixed(is,ds,0); + vec = fixed(is*(1+1i),ds*(1+1i),[1:n]*(1+1i)); + a = fdiag(vec); + if (size(a,1) != n || size(a,2) != n) + error("FAILED"); + endif + for i=1:n + for j=1:n + if ((i == j) && (a(i,j) != vec(i))) + error("FAILED"); + elseif ((i != j) && (a(i,j) != zero)) + error("FAILED"); + endif + end + end + vec = fdiag(a); + if (length(vec) != n) + error("FAILED"); + endif + for i=1:n + if (a(i,i) != vec(i)) + error("FAILED"); + endif + end + fprintf("PASSED\n"); + fprintf(" Indexed Access of Scalars: "); + a = fixed(is,ds,1); + a(2) = fixed(is,ds,2); + if (!isvector(a) || !isfixed(a)) + error("FAILED"); + endif + a = fixed(is,ds,1); + a(2) = fixed(is,ds,1i); + if (!isvector(a) || !isfixed(a) || !iscomplex(a)) + error("FAILED"); + endif + a = fixed(is,ds,1); + a(1).dec = a(1).dec + 1; + if (a.dec != ds+1) + error("FAILED"); + endif + a = fixed(is,ds,1i); + a(2) = fixed(is,ds,2*1i); + if (!isvector(a) || !isfixed(a) || !iscomplex(a)) + error("FAILED"); + endif + a = fixed(is,ds,1i); + a(1).dec = a(1).dec + 1; + if (a.dec != ds*(1+1i)+1) + error("FAILED"); + endif + fprintf("PASSED\n"); + fprintf(" Indexed Access of Matrices: "); + x = (vals(2)-vals(1))*rand(n,n)+vals(1); + a = fixed(is, ds, x); + if (any(any(abs(a(1,:).x - x(1,:)) > feps)) || !isfixed(a)) + error ("FAILED"); + endif + a(1,:).dec = a(1,:).dec + 1; + if (a(1,:).dec != ds+1) + error("FAILED"); + endif + if (a(2,:).dec != ds) + error("FAILED"); + endif + a(1,1) = fixed(is,ds,1i); + if (!ismatrix(a) || !isfixed(a) || !iscomplex(a)) + error("FAILED"); + endif + x = ((vals(2)-vals(1))*rand(n,n)+vals(1) + + ((vals(2)-vals(1))*rand(n,n)+vals(1)) * 1i); + a = fixed(is, ds, x); + if (any(any(abs(real(a(1,:).x) - real(x(1,:))) > feps)) || + any(any(abs(imag(a(1,:).x) - imag(x(1,:))) > feps)) || + !isfixed(a)) + error ("FAILED"); + endif + a(1,:).dec = a(1,:).dec + 1; + if (a(1,:).dec != ds*(1+1i)+1) + error("FAILED"); + endif + if (a(2,:).dec != ds*(1+1i)) + error("FAILED"); + endif + fprintf("PASSED\n"); + + fprintf("\n<< Fixed Point Operators >>\n"); + + fprintf(" Logical Operators: "); + if (_fixedpoint_test_bool_operator("==",is,ds,n) || + _fixedpoint_test_bool_operator("!=",is,ds,n) || + _fixedpoint_test_bool_operator(">",is,ds,n) || + _fixedpoint_test_bool_operator("<",is,ds,n) || + _fixedpoint_test_bool_operator(">=",is,ds,n) || + _fixedpoint_test_bool_operator("<=",is,ds,n)) + error("FAILED"); + else + fprintf("PASSED\n"); + endif + + fprintf(" Unary Operators: "); + if (_fixedpoint_test_unary_operator("-",is,ds,n,1) || + _fixedpoint_test_unary_operator("+",is,ds,n,1) || + _fixedpoint_test_unary_operator("'",is,ds,n,0) || + _fixedpoint_test_unary_operator(".'",is,ds,n,0)) + error("FAILED"); + else + fprintf("PASSED\n"); + endif + # This has special meaning for fixed point. Whats the test !!!! + # Is the damn operator even correct !! + # b = ! a; + + fprintf(" Arithmetic Operators: "); + if (_fixedpoint_test_operator("-",is,ds,n,1,1,1) || + _fixedpoint_test_operator("+",is,ds,n,1,1,1) || + _fixedpoint_test_operator(".*",is,ds,n,1,1,1) || + _fixedpoint_test_operator("*",is,ds,n,1,1,1) || + _fixedpoint_test_operator("./",is,ds,n,0,1,1) || + +## Bug in octave 2.1.50 and earlier for el_ldiv in op-cs-s.cc. + ((vers(1) > 2 || (vers(1) >= 2 && vers(2) > 1) || + (vers(1) >= 2 && vers(2) >= 1 && vers(3) > 50)) && + _fixedpoint_test_operator(".\\",is,ds,n,0,1,1)) || + +## Rounding errors in complex pow functions make these fail +## _fixedpoint_test_operator(".**",is,ds,n,0,1,1) || +## _fixedpoint_test_operator(".^",is,ds,n,0,1,1) + +## Can't do "matrix-by-matrix", as well as above problem +## _fixedpoint_test_operator("**",is,ds,n,0,1,0) || +## _fixedpoint_test_operator("^",is,ds,n,0,1,0) || + +## Can't divide by a matrix as don't have inversion + _fixedpoint_test_operator("/",is,ds,n,0,1,0) || + _fixedpoint_test_operator("\\",is,ds,n,0,0,1)) + error("FAILED"); + else + fprintf("PASSED\n"); + endif + + fprintf("\n<< Fixed Point Functions >>\n"); + fprintf(" Rounding Functions: "); + + if (_fixedpoint_test_function("ceil",is,ds,n,0) || + _fixedpoint_test_function("floor",is,ds,n,0) || + _fixedpoint_test_function("round",is,ds,n,0)) + error("FAILED"); + else + fprintf("PASSED\n"); + endif + + fprintf(" Matrix Sum and Product Functions: "); + if (_fixedpoint_test_function("sum",is,ds,n,0) || + _fixedpoint_test_function("cumsum",is,ds,n,0)) + error("FAILED"); + endif + + ## These can easily under- or over-flow. Trick the code by + ## foring ds=0, which simplifies the internal calculations, + ## effectively limiting the values used to 1 and 0. If you + ## can think of a better way, tell me... + tmpds = ds; + ds = 0; + if (_fixedpoint_test_function("sumsq",is,ds,n,feps) || + _fixedpoint_test_function("prod",is,ds,n,feps) || + _fixedpoint_test_function("cumprod",is,ds,n,feps)) + error("FAILED"); + else + fprintf("PASSED\n"); + endif + ds = tmpds; + + fprintf(" Miscellaneous Functions: "); + if (_fixedpoint_test_function("real",is,ds,n,0) || + _fixedpoint_test_function("imag",is,ds,n,0) || + _fixedpoint_test_function("conj",is,ds,n,0) || + _fixedpoint_test_function("arg",is,ds,n,feps) || + _fixedpoint_test_function("angle",is,ds,n,feps) || + _fixedpoint_test_function("abs",is,ds,n,sqrt(2)*feps) || + _fixedpoint_test_function("sqrt",is,ds,n,sqrt(2)*feps)) + error("FAILED"); + else + fprintf("PASSED\n"); + endif + + ## These will underflow/overflow, use larger feps that should be + ## ok upto ds = 6. Again if you can think of a better way to check!! + fprintf(" Exponential Functions: "); + if (_fixedpoint_test_function("log",is,ds,n,2*feps,0) || + _fixedpoint_test_function("log10",is,ds,n,20*feps,0) || + _fixedpoint_test_function("exp",is,ds,n,4*feps)) + error("FAILED"); + else + fprintf("PASSED\n"); + endif + + ## These will underflow/overflow, use larger feps that should be + ## ok upto ds = 6. Again if you can think of a better way to check!! + fprintf(" Trigonometric Functions: "); + if (_fixedpoint_test_function("sin",is,ds,n,4*feps) || + _fixedpoint_test_function("sinh",is,ds,n,4*feps) || + _fixedpoint_test_function("cos",is,ds,n,4*feps) || + _fixedpoint_test_function("cosh",is,ds,n,4*feps) || + _fixedpoint_test_function("tan",is,ds,n,4*feps) || + _fixedpoint_test_function("tanh",is,ds,n,4*feps)) + error("FAILED"); + endif + + ## Special case for fatan2 + fzero = fixed(is,ds,0); + fzeros = fixed(is,ds,zeros(n,1)); + fone = fixed(is,ds,1); + fones = fixed(is,ds,ones(n,1)); + fpi2 = fixed(is,ds,pi/2); + fpi4 = fixed(is,ds,pi/4); + if (fatan2(fzero,fzero) != fzero || + fatan2(fzero,fone) != fzero || + fatan2(fone,fzero) != fpi2 || + fatan2(fone,fone) != fpi4 || + any(fatan2(fzeros,fzeros) != fzero) || + any(fatan2(fzeros,fones) != fzero) || + any(fatan2(fones,fzeros) != fpi2) || + any(fatan2(fones,fones) != fpi4)) + error("FAILED"); + else + fprintf("PASSED\n"); + endif + + fprintf("\n"); + unwind_protect_cleanup + page_screen_output(pso); + end_unwind_protect + else + usage("fixedpoint: Unknown argument"); + endif +endfunction + +function ret = _fixedpoint_test_operator(op,is,ds,n,includezero,matrixleft, + matrixright) + # Properly test all 16 possible combinations of an operator + + ret = 0; + + tzero = 0; + tone = 1; + tzeros = zeros(n,n); + tones = ones(n,n); + tczero = 1i; + tczeros = 1i*ones(n,n); + tcone = 1 + 1i; + tcones = (1 + 1i)*ones(n,n); + + fzero = fixed(is,ds,tzero); + fone = fixed(is,ds,tone); + fzeros = fixed(is,ds,tzeros); + fones = fixed(is,ds,tones); + fczero = fixed(is,ds,tczero); + fczeros = fixed(is,ds,tczeros); + fcone = fixed(is,ds,tcone); + fcones = fixed(is,ds,tcones); + + # scalar by scalar + if (includezero) + t1 = eval(["tzero" op "tzero;"]); + f1 = eval(["fzero" op "fzero;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + t1 = eval(["tzero" op "tone;"]); + f1 = eval(["fzero" op "fone;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + t1 = eval(["tone" op "tzero;"]); + f1 = eval(["fone" op "fzero;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + endif + t1 = eval(["tone" op "tone;"]); + f1 = eval(["fone" op "fone;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + + # scalar by matrix + if (matrixright) + if (includezero) + t1 = eval(["tzero" op "tzeros;"]); + f1 = eval(["fzero" op "fzeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tzero" op "tones;"]); + f1 = eval(["fzero" op "fones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tone" op "tzeros;"]); + f1 = eval(["fone" op "fzeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + t1 = eval(["tone" op "tones;"]); + f1 = eval(["fone" op "fones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + + # matrix by scalar + if (matrixleft) + if (includezero) + t1 = eval(["tzeros" op "tzero;"]); + f1 = eval(["fzeros" op "fzero;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tzeros" op "tone;"]); + f1 = eval(["fzeros" op "fone;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tones" op "tzero;"]); + f1 = eval(["fones" op "fzero;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + t1 = eval(["tones" op "tone;"]); + f1 = eval(["fones" op "fone;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + + # matrix by matrix + if (matrixleft && matrixright) + if (includezero) + t1 = eval(["tzeros" op "tzeros;"]); + f1 = eval(["fzeros" op "fzeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tzeros" op "tones;"]); + f1 = eval(["fzeros" op "fones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tones" op "tzeros;"]); + f1 = eval(["fones" op "fzeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + t1 = eval(["tones" op "tones;"]); + f1 = eval(["fones" op "fones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + + # scalar by complex scalar + if (includezero) + t1 = eval(["tzero" op "tczero;"]); + f1 = eval(["fzero" op "fczero;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + t1 = eval(["tzero" op "tcone;"]); + f1 = eval(["fzero" op "fcone;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + endif + t1 = eval(["tone" op "tczero;"]); + f1 = eval(["fone" op "fczero;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + t1 = eval(["tone" op "tcone;"]); + f1 = eval(["fone" op "fcone;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + + # scalar by complex matrix + if (matrixright) + if (includezero) + t1 = eval(["tzero" op "tczeros;"]); + f1 = eval(["fzero" op "fczeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tzero" op "tcones;"]); + f1 = eval(["fzero" op "fcones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + t1 = eval(["tone" op "tczeros;"]); + f1 = eval(["fone" op "fczeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tone" op "tcones;"]); + f1 = eval(["fone" op "fcones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + + # matrix by complex scalar + if (matrixleft) + if (includezero) + t1 = eval(["tzeros" op "tczero;"]); + f1 = eval(["fzeros" op "fczero;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tzeros" op "tcone;"]); + f1 = eval(["fzeros" op "fcone;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + t1 = eval(["tones" op "tczero;"]); + f1 = eval(["fones" op "fczero;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tones" op "tcone;"]); + f1 = eval(["fones" op "fcone;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + + # matrix by complex matrix + if (matrixleft && matrixright) + if (includezero) + t1 = eval(["tzeros" op "tczeros;"]); + f1 = eval(["fzeros" op "fczeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tzeros" op "tcones;"]); + f1 = eval(["fzeros" op "fcones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + t1 = eval(["tones" op "tczeros;"]); + f1 = eval(["fones" op "fczeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tones" op "tcones;"]); + f1 = eval(["fones" op "fcones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + + # complex scalar by scalar + if (includezero) + t1 = eval(["tczero" op "tzero;"]); + f1 = eval(["fczero" op "fzero;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tzero;"]); + f1 = eval(["fcone" op "fzero;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + endif + t1 = eval(["tczero" op "tone;"]); + f1 = eval(["fczero" op "fone;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tone;"]); + f1 = eval(["fcone" op "fone;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + + # complex scalar by matrix + if (matrixright) + if (includezero) + t1 = eval(["tczero" op "tzeros;"]); + f1 = eval(["fczero" op "fzeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tzeros;"]); + f1 = eval(["fcone" op "fzeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + t1 = eval(["tczero" op "tones;"]); + f1 = eval(["fczero" op "fones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tones;"]); + f1 = eval(["fcone" op "fones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + + # complex matrix by scalar + if (matrixleft) + if (includezero) + t1 = eval(["tczeros" op "tzero;"]); + f1 = eval(["fczeros" op "fzero;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tzero;"]); + f1 = eval(["fcones" op "fzero;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + t1 = eval(["tczeros" op "tone;"]); + f1 = eval(["fczeros" op "fone;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tone;"]); + f1 = eval(["fcones" op "fone;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + + # complex matrix by matrix + if (matrixleft && matrixright) + if (includezero) + t1 = eval(["tczeros" op "tzeros;"]); + f1 = eval(["fczeros" op "fzeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tzeros;"]); + f1 = eval(["fcones" op "fzeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + t1 = eval(["tczeros" op "tones;"]); + f1 = eval(["fczeros" op "fones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tones;"]); + f1 = eval(["fcones" op "fones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + + # complex scalar by complex scalar + t1 = eval(["tczero" op "tczero;"]); + f1 = eval(["fczero" op "fczero;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + t1 = eval(["tczero" op "tcone;"]); + f1 = eval(["fczero" op "fcone;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tczero;"]); + f1 = eval(["fcone" op "fczero;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tcone;"]); + f1 = eval(["fcone" op "fcone;"]); + if (t1 != f1.x) + ret = 1; + return; + endif + + # complex scalar by complex matrix + if (matrixright) + t1 = eval(["tczero" op "tczeros;"]); + f1 = eval(["fczero" op "fczeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tczero" op "tcones;"]); + f1 = eval(["fczero" op "fcones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tczeros;"]); + f1 = eval(["fcone" op "fczeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tcones;"]); + f1 = eval(["fcone" op "fcones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + + # complex matrix by complex scalar + if (matrixleft) + t1 = eval(["tczeros" op "tczero;"]); + f1 = eval(["fczeros" op "fczero;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tczeros" op "tcone;"]); + f1 = eval(["fczeros" op "fcone;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tczero;"]); + f1 = eval(["fcones" op "fczero;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tcone;"]); + f1 = eval(["fcones" op "fcone;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + + # complex matrix by complex matrix + if (matrixleft && matrixright) + t1 = eval(["tczeros" op "tczeros;"]); + f1 = eval(["fczeros" op "fczeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tczeros" op "tcones;"]); + f1 = eval(["fczeros" op "fcones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tczeros;"]); + f1 = eval(["fcones" op "fczeros;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tcones;"]); + f1 = eval(["fcones" op "fcones;"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + endif + +endfunction + +function ret = _fixedpoint_test_bool_operator(op,is,ds,n) + # Properly test all 16 possible combinations of an operator + + ret = 0; + + tzero = 0; + tone = 1; + tzeros = zeros(n,n); + tones = ones(n,n); + tczero = 1i; + tczeros = 1i*ones(n,n); + tcone = 1 + 1i; + tcones = (1 + 1i)*ones(n,n); + + fzero = fixed(is,ds,tzero); + fone = fixed(is,ds,tone); + fzeros = fixed(is,ds,tzeros); + fones = fixed(is,ds,tones); + fczero = fixed(is,ds,tczero); + fczeros = fixed(is,ds,tczeros); + fcone = fixed(is,ds,tcone); + fcones = fixed(is,ds,tcones); + + # scalar by scalar + t1 = eval(["tzero" op "tzero;"]); + f1 = eval(["fzero" op "fzero;"]); + if (t1 != f1) + ret = 1; + return; + endif + t1 = eval(["tzero" op "tone;"]); + f1 = eval(["fzero" op "fone;"]); + if (t1 != f1) + ret = 1; + return; + endif + t1 = eval(["tone" op "tzero;"]); + f1 = eval(["fone" op "fzero;"]); + if (t1 != f1) + ret = 1; + return; + endif + t1 = eval(["tone" op "tone;"]); + f1 = eval(["fone" op "fone;"]); + if (t1 != f1) + ret = 1; + return; + endif + + # scalar by matrix + t1 = eval(["tzero" op "tzeros;"]); + f1 = eval(["fzero" op "fzeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tzero" op "tones;"]); + f1 = eval(["fzero" op "fones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tone" op "tzeros;"]); + f1 = eval(["fone" op "fzeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tone" op "tones;"]); + f1 = eval(["fone" op "fones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + + # matrix by scalar + t1 = eval(["tzeros" op "tzero;"]); + f1 = eval(["fzeros" op "fzero;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tzeros" op "tone;"]); + f1 = eval(["fzeros" op "fone;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tones" op "tzero;"]); + f1 = eval(["fones" op "fzero;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tones" op "tone;"]); + f1 = eval(["fones" op "fone;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + + # matrix by matrix + t1 = eval(["tzeros" op "tzeros;"]); + f1 = eval(["fzeros" op "fzeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tzeros" op "tones;"]); + f1 = eval(["fzeros" op "fones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tones" op "tzeros;"]); + f1 = eval(["fones" op "fzeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tones" op "tones;"]); + f1 = eval(["fones" op "fones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + + + # scalar by complex scalar + t1 = eval(["tzero" op "tczero;"]); + f1 = eval(["fzero" op "fczero;"]); + if (t1 != f1) + ret = 1; + return; + endif + t1 = eval(["tzero" op "tcone;"]); + f1 = eval(["fzero" op "fcone;"]); + if (t1 != f1) + ret = 1; + return; + endif + t1 = eval(["tone" op "tczero;"]); + f1 = eval(["fone" op "fczero;"]); + if (t1 != f1) + ret = 1; + return; + endif + t1 = eval(["tone" op "tcone;"]); + f1 = eval(["fone" op "fcone;"]); + if (t1 != f1) + ret = 1; + return; + endif + + # scalar by complex matrix + t1 = eval(["tzero" op "tczeros;"]); + f1 = eval(["fzero" op "fczeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tzero" op "tcones;"]); + f1 = eval(["fzero" op "fcones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tone" op "tczeros;"]); + f1 = eval(["fone" op "fczeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tone" op "tcones;"]); + f1 = eval(["fone" op "fcones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + + # matrix by complex scalar + t1 = eval(["tzeros" op "tczero;"]); + f1 = eval(["fzeros" op "fczero;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tzeros" op "tcone;"]); + f1 = eval(["fzeros" op "fcone;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tones" op "tczero;"]); + f1 = eval(["fones" op "fczero;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tones" op "tcone;"]); + f1 = eval(["fones" op "fcone;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + + # matrix by complex matrix + t1 = eval(["tzeros" op "tczeros;"]); + f1 = eval(["fzeros" op "fczeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tzeros" op "tcones;"]); + f1 = eval(["fzeros" op "fcones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tones" op "tczeros;"]); + f1 = eval(["fones" op "fczeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tones" op "tcones;"]); + f1 = eval(["fones" op "fcones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + + # complex scalar by scalar + t1 = eval(["tczero" op "tzero;"]); + f1 = eval(["fczero" op "fzero;"]); + if (t1 != f1) + ret = 1; + return; + endif + t1 = eval(["tczero" op "tone;"]); + f1 = eval(["fczero" op "fone;"]); + if (t1 != f1) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tzero;"]); + f1 = eval(["fcone" op "fzero;"]); + if (t1 != f1) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tone;"]); + f1 = eval(["fcone" op "fone;"]); + if (t1 != f1) + ret = 1; + return; + endif + + # complex scalar by matrix + t1 = eval(["tczero" op "tzeros;"]); + f1 = eval(["fczero" op "fzeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tczero" op "tones;"]); + f1 = eval(["fczero" op "fones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tzeros;"]); + f1 = eval(["fcone" op "fzeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tones;"]); + f1 = eval(["fcone" op "fones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + + # complex matrix by scalar + t1 = eval(["tczeros" op "tzero;"]); + f1 = eval(["fczeros" op "fzero;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tczeros" op "tone;"]); + f1 = eval(["fczeros" op "fone;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tzero;"]); + f1 = eval(["fcones" op "fzero;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tone;"]); + f1 = eval(["fcones" op "fone;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + + # complex matrix by matrix + t1 = eval(["tczeros" op "tzeros;"]); + f1 = eval(["fczeros" op "fzeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tczeros" op "tones;"]); + f1 = eval(["fczeros" op "fones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tzeros;"]); + f1 = eval(["fcones" op "fzeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tones;"]); + f1 = eval(["fcones" op "fones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + + # complex scalar by complex scalar + t1 = eval(["tczero" op "tczero;"]); + f1 = eval(["fczero" op "fczero;"]); + if (t1 != f1) + ret = 1; + return; + endif + t1 = eval(["tczero" op "tcone;"]); + f1 = eval(["fczero" op "fcone;"]); + if (t1 != f1) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tczero;"]); + f1 = eval(["fcone" op "fczero;"]); + if (t1 != f1) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tcone;"]); + f1 = eval(["fcone" op "fcone;"]); + if (t1 != f1) + ret = 1; + return; + endif + + # complex scalar by complex matrix + t1 = eval(["tczero" op "tczeros;"]); + f1 = eval(["fczero" op "fczeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tczero" op "tcones;"]); + f1 = eval(["fczero" op "fcones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tczeros;"]); + f1 = eval(["fcone" op "fczeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tcone" op "tcones;"]); + f1 = eval(["fcone" op "fcones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + + # complex matrix by complex scalar + t1 = eval(["tczeros" op "tczero;"]); + f1 = eval(["fczeros" op "fczero;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tczeros" op "tcone;"]); + f1 = eval(["fczeros" op "fcone;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tczero;"]); + f1 = eval(["fcones" op "fczero;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tcone;"]); + f1 = eval(["fcones" op "fcone;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + + # complex matrix by complex matrix + t1 = eval(["tczeros" op "tczeros;"]); + f1 = eval(["fczeros" op "fczeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tczeros" op "tcones;"]); + f1 = eval(["fczeros" op "fcones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tczeros;"]); + f1 = eval(["fcones" op "fczeros;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + t1 = eval(["tcones" op "tcones;"]); + f1 = eval(["fcones" op "fcones;"]); + if any(any(t1 != f1)) + ret = 1; + return; + endif + +endfunction + +function ret = _fixedpoint_test_unary_operator(op,is,ds,n,front) + # Properly test all 4 possible combinations of an operator + + ret = 0; + + tzero = 0; + tone = 1; + tzeros = zeros(n,n); + tones = ones(n,n); + tczero = 1i; + tczeros = 1i*ones(n,n); + tcone = 1 + 1i; + tcones = (1 + 1i)*ones(n,n); + + fzero = fixed(is,ds,tzero); + fone = fixed(is,ds,tone); + fzeros = fixed(is,ds,tzeros); + fones = fixed(is,ds,tones); + fczero = fixed(is,ds,tczero); + fczeros = fixed(is,ds,tczeros); + fcone = fixed(is,ds,tcone); + fcones = fixed(is,ds,tcones); + + if (front) + op1 = op; + op2 = ""; + else + op1 = ""; + op2 = op; + endif + + # scalar by scalar + t1 = eval([ op1 "tzero" op2 ";"]); + f1 = eval([ op1 "fzero" op2 ";"]); + if (t1 != f1.x) + ret = 1; + return; + endif + t1 = eval([ op1 "tone" op2 ";"]); + f1 = eval([ op1 "fone" op2 ";"]); + if (t1 != f1.x) + ret = 1; + return; + endif + + # matrix + t1 = eval([ op1 "tzeros" op2 ";"]); + f1 = eval([ op1 "fzeros" op2 ";"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval([ op1 "tones" op2 ";"]); + f1 = eval([ op1 "fones" op2 ";"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + + # complex scalar + t1 = eval([ op1 "tczero" op2 ";"]); + f1 = eval([ op1 "fczero" op2 ";"]); + if (t1 != f1.x) + ret = 1; + return; + endif + t1 = eval([ op1 "tcone" op2 ";"]); + f1 = eval([ op1 "fcone" op2 ";"]); + if (t1 != f1.x) + ret = 1; + return; + endif + + # complex matrix + t1 = eval([ op1 "tczeros" op2 ";"]); + f1 = eval([ op1 "fczeros" op2 ";"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + t1 = eval([ op1 "tcones" op2 ";"]); + f1 = eval([ op1 "fcones" op2 ";"]); + if any(any(t1 != f1.x)) + ret = 1; + return; + endif + +endfunction + +function ret = _fixedpoint_test_function(func,is,ds,n,eps,includezero) + # Properly test all 4 possible combinations of a function + + if (nargin < 6) + includezero = 1; + endif + + ret = 0; + tzero = 0; + tone = 1; + tzeros = zeros(n,n); + tones = ones(n,n); + tczero = 1i; + tczeros = 1i*ones(n,n); + tcone = 1 + 1i; + tcones = (1 + 1i)*ones(n,n); + if (ds == 0) + tval = tone; + tvals = tones; + tcval = tcone; + tcvals = tcones; + else + tval = 0.5; + if (includezero) + tvals = ones(n,1) * (round(2^ds * (0:(n-1))/(n-1)) / 2^ds); + else + tvals = ones(n,1) * (round(2^ds * (1 + 2^(is-1)*(1:(n-1))/(n-1))) + / 2^ds); + endif + tcval = tval * (1+1i); + tcvals = tvals * (1+1i); + endif + + fzero = fixed(is,ds,tzero); + fone = fixed(is,ds,tone); + fzeros = fixed(is,ds,tzeros); + fones = fixed(is,ds,tones); + fczero = fixed(is,ds,tczero); + fczeros = fixed(is,ds,tczeros); + fcone = fixed(is,ds,tcone); + fcones = fixed(is,ds,tcones); + fval = fixed(is,ds,tval); + fvals = fixed(is,ds,tvals); + fcval = fixed(is,ds,tcval); + fcvals = fixed(is,ds,tcvals); + + ffunc = [ "f" func]; + + # scalar by scalar + if (includezero) + t1 = eval([ func "(tzero);"]); + f1 = eval([ ffunc "(fzero);"]); + if (abs(t1 - f1.x) > eps) + ret = 1; + return; + endif + endif + t1 = eval([ func "(tone);"]); + f1 = eval([ ffunc "(fone);"]); + if (abs(t1 - f1.x) > eps) + ret = 1; + return; + endif + t1 = eval([ func "(tval);"]); + f1 = eval([ ffunc "(fval);"]); + if (abs(t1 - f1.x) > eps) + ret = 1; + return; + endif + + # matrix + if (includezero) + t1 = eval([ func "(tzeros);"]); + f1 = eval([ ffunc "(fzeros);"]); + if any(any(abs(t1 - f1.x) > eps)) + ret = 1; + return; + endif + endif + t1 = eval([ func "(tones);"]); + f1 = eval([ ffunc "(fones);"]); + if any(any(abs(t1 - f1.x) > eps)) + ret = 1; + return; + endif + t1 = eval([ func "(tvals);"]); + f1 = eval([ ffunc "(fvals);"]); + if any(any(abs(t1 - f1.x) > eps)) + ret = 1; + return; + endif + + # complex scalar + if (includezero) + t1 = eval([ func "(tczero);"]); + f1 = eval([ ffunc "(fczero);"]); + if ((abs(real(t1) - freal(f1).x) > eps) || + (abs(imag(t1) - fimag(f1).x) > eps)) + ret = 1; + return; + endif + endif + t1 = eval([ func "(tcone);"]); + f1 = eval([ ffunc "(fcone);"]); + if ((abs(real(t1) - freal(f1).x) > eps) || (abs(imag(t1) - fimag(f1).x) > eps)) + ret = 1; + return; + endif + t1 = eval([ func "(tcval);"]); + f1 = eval([ ffunc "(fcval);"]); + if ((abs(real(t1) - freal(f1).x) > eps) || (abs(imag(t1) - fimag(f1).x) > eps)) + ret = 1; + return; + endif + + # complex matrix + if (includezero) + t1 = eval([ func "(tczeros);"]); + f1 = eval([ ffunc "(fczeros);"]); + if (any(any(abs(real(t1) - freal(f1).x) > eps)) || + any(any(abs(imag(t1) - fimag(f1).x) > eps))) + ret = 1; + return; + endif + endif + t1 = eval([ func "(tcones);"]); + f1 = eval([ ffunc "(fcones);"]); + if (any(any(abs(real(t1) - freal(f1).x) > eps)) || + any(any(abs(imag(t1) - fimag(f1).x) > eps))) + ret = 1; + return; + endif + t1 = eval([ func "(tcvals);"]); + f1 = eval([ ffunc "(fcvals);"]); + if (any(any(abs(real(t1) - freal(f1).x) > eps)) || + any(any(abs(imag(t1) - fimag(f1).x) > eps))) + ret = 1; + return; + endif + +endfunction + +%!test +%! try fixedpoint("test"); +%! catch disp(lasterr()); end + +## Local Variables: *** +## mode: Octave *** +## End: *** diff --git a/octave_packages/fixed-0.7.10/float.m b/octave_packages/fixed-0.7.10/float.m new file mode 100644 index 0000000..278f809 --- /dev/null +++ b/octave_packages/fixed-0.7.10/float.m @@ -0,0 +1,32 @@ +## Copyright (C) 2003 Motorola Inc +## Copyright (C) 2003 David Bateman +## +## 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{y} =} float (@var{x}) +## Converts a fixed point object to the equivalent floating point object. This +## is equivalent to @code{@var{x}.x} if @code{isfixed(@var{x})} returns true, +## and returns @var{x} otherwise. +## @end deftypefn + +function y = float (x) + + if isfixed(x) + y = x.x; + else + y = x; + endif + +endfunction diff --git a/octave_packages/fixed-0.7.10/fsort.m b/octave_packages/fixed-0.7.10/fsort.m new file mode 100644 index 0000000..5d1b217 --- /dev/null +++ b/octave_packages/fixed-0.7.10/fsort.m @@ -0,0 +1,69 @@ +## Copyright (C) 2003 Motorola Inc +## Copyright (C) 2003 David Bateman +## +## 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{s}, @var{i}] =} fsort (@var{x}) +## Return a copy of the fixed point variable @var{x} with the elements +## arranged in increasing order. For matrices, @code{fsort} orders the +## elements in each column. +## +## For example, +## +## @example +## @group +## fsort (fixed(4,0,[1, 2; 2, 3; 3, 1])) +## @result{} 1 1 +## 2 2 +## 3 3 +## @end group +## @end example +## +## The @code{fsort} function may also be used to produce a matrix +## containing the original row indices of the elements in the sorted +## matrix. For example, +## +## @example +## @group +## [s, i] = sort ([1, 2; 2, 3; 3, 1]) +## @result{} s = 1 1 +## 2 2 +## 3 3 +## @result{} i = 1 3 +## 2 1 +## 3 2 +## @end group +## @end example +## @end deftypefn + +## PKG_ADD: dispatch ("sort", "fsort", "fixed scalar") +## PKG_ADD: dispatch ("sort", "fsort", "fixed matrix") +## PKG_ADD: dispatch ("sort", "fsort", "fixed complex") +## PKG_ADD: dispatch ("sort", "fsort", "fixed complex matrix") + +function [s, i] = fsort (x) + if (!isfixed(x)) + error("fsort: input argument not of fixed point type"); + endif + [a, i] = sort(x.x); + if isvector(a) + s = x(i); + else + s = x; + for j=1:size(i,2) + s(:,j) = s(i(:,j),j); + endfor + endif +endfunction diff --git a/octave_packages/fixed-0.7.10/lookup_table.m b/octave_packages/fixed-0.7.10/lookup_table.m new file mode 100644 index 0000000..58b2b91 --- /dev/null +++ b/octave_packages/fixed-0.7.10/lookup_table.m @@ -0,0 +1,54 @@ +## Copyright (C) 2003 Motorola Inc +## Copyright (C) 2003 David Bateman +## +## 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{y} =} lookup_table (@var{table}, @var{x}) +## @deftypefnx {Function File} {@var{y} =} lookup_table (@var{table}, @var{x}, @var{interp}, @var{extrap}) +## Using the lookup table created by @dfn{create_lookup_table}, find the value +## @var{y} corresponding to @var{x}. With two arguments the lookup is done +## to the nearest value below in the table less than the desired value. With +## three arguments a simple linear interpolation is performed. With four +## arguments an extrapolation is also performed. The exact values of arguments +## three and four are irrelevant, as only there presence detremines whether +## interpolation and/or extrapolation are used. +## @end deftypefn + +function y = lookup_table (table, x, interp, extrap); + if (nargin < 2) + error("lookup_table: needs two or more arguments"); + else + idx = lookup(table.x, x); + if (nargin == 2) + y = table.y (max(1,idx)); + else + len = length(table.x); + before = find(idx == 0); + after = find(idx == len); + idx = max(1,min(idx, len-1)); + xl = table.x(idx); + yl = table.y(idx); + xu = table.x(idx+1); + yu = table.y(idx+1); + ## Careful with the order of this interpolation to avoid underflow + ## in fixed point calculations. + y = ( yl + (yu - yl) ./ (xu - xl) .* (x - xl)); + if (nargin < 4) + y(before) = table.y(1); + y(after) = table.y(len); + endif + endif + endif +endfunction diff --git a/octave_packages/fixed-0.7.10/packinfo/.autoload b/octave_packages/fixed-0.7.10/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/fixed-0.7.10/packinfo/DESCRIPTION b/octave_packages/fixed-0.7.10/packinfo/DESCRIPTION new file mode 100644 index 0000000..7203563 --- /dev/null +++ b/octave_packages/fixed-0.7.10/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: Fixed +Version: 0.7.10 +Date: 2009-05-18 +Author: David Bateman +Maintainer: David Bateman +Title: Fixed Point Computations +Description: Fixed point real and complex matrix toolbox +Depends: octave (> 3.1.54) +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net diff --git a/octave_packages/fixed-0.7.10/packinfo/INDEX b/octave_packages/fixed-0.7.10/packinfo/INDEX new file mode 100644 index 0000000..107ddf4 --- /dev/null +++ b/octave_packages/fixed-0.7.10/packinfo/INDEX @@ -0,0 +1,62 @@ +fixed >> Fixed Point Type +Fixed Point Operators + + - = Addition/subtraction in a fixed point algebra. + * / \ = Multiplication/division in fixed point (Division for scalars only). + .* ./ .\ = Element by element multiplication/division of fixed point arrays. + ** ^ = Matrix exponentiation of fixed point arrays. + .** .^ = Element by element matrix exponentiation of fixed point arrays. + ' .' = Matrix transpose of fixed point arrays. + == ~= != > >= < <= = Logical operators on fixed point arrays. +Fixed Point Variables + fixed_point_warn_overflow + fixed_point_debug + fixed_point_count_operations + fixed_point_version + fixed_point_library_version +Fixed Point Utility Functions + concat + create_lookup_table + display_fixed_operations + fdiag + fixed + fixedpoint + float + freshape + fsort + isfixed + length + lookup_table + reset_fixed_operations + size + all + any +Fixed Point Functions + fabs + fangle + farg + fatan2 + fceil + fconj + fcosh + fcos + fcumprod + fcumsum + fexp + ffloor + fimag + flog10 + flog + fprod + freal + fround + fsinh + fsin + fsqrt + fsum + fsumsq + ftanh + ftan +Examples + ffft + fifft + fixed_inc diff --git a/octave_packages/fpl-1.2.0/FPL2coloredgradient.net b/octave_packages/fpl-1.2.0/FPL2coloredgradient.net new file mode 100644 index 0000000..b6eccfc --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2coloredgradient.net @@ -0,0 +1,635 @@ +// +// time: Wed Jun 13 18:54:22 2007 +// +// version: 3.2.0 (format), 4.4.4 (DX) +// +// +// MODULE main +// workspace: width = 459, height = 507 +// layout: snap = 0, width = 50, height = 50, align = NN +// +macro main( +) -> ( +) { + // + // node FileSelector[1]: x = 28, y = 29, inputs = 0, label = FileSelector + // output[1]: visible = 1, type = 32, value = "__FILE__DX__" + // output[2]: visible = 1, type = 32, value = "__FILE__DX__" + // + // + // node Import[1]: x = 34, y = 109, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_FileSelector_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node Post[1]: x = 124, y = 167, inputs = 2, label = Post + // input[2]: defaulting = 0, visible = 1, type = 32, value = "positions" + // +main_Post_1_out_1 = + Post( + main_Import_1_out_1, + main_Post_1_in_2 + ) [instance: 1, cache: 1]; + // + // node Gradient[1]: x = 227, y = 144, inputs = 2, label = Gradient + // +main_Gradient_1_out_1 = + Gradient( + main_Post_1_out_1, + main_Gradient_1_in_2 + ) [instance: 1, cache: 1]; + // + // node AutoGlyph[1]: x = 241, y = 215, inputs = 7, label = AutoGlyph + // +main_AutoGlyph_1_out_1 = + AutoGlyph( + main_Gradient_1_out_1, + main_AutoGlyph_1_in_2, + main_AutoGlyph_1_in_3, + main_AutoGlyph_1_in_4, + main_AutoGlyph_1_in_5, + main_AutoGlyph_1_in_6, + main_AutoGlyph_1_in_7 + ) [instance: 1, cache: 1]; + // + // node AutoColor[1]: x = 253, y = 283, inputs = 10, label = AutoColor + // +main_AutoColor_1_out_1, +main_AutoColor_1_out_2 = + AutoColor( + main_AutoGlyph_1_out_1, + main_AutoColor_1_in_2, + main_AutoColor_1_in_3, + main_AutoColor_1_in_4, + main_AutoColor_1_in_5, + main_AutoColor_1_in_6, + main_AutoColor_1_in_7, + main_AutoColor_1_in_8, + main_AutoColor_1_in_9, + main_AutoColor_1_in_10 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 39, y = 242, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_Post_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Color[1]: x = 72, y = 328, inputs = 5, label = Color + // input[2]: defaulting = 0, visible = 1, type = 32, value = "black" + // input[3]: defaulting = 0, visible = 1, type = 5, value = .5 + // +main_Color_1_out_1 = + Color( + main_ShowConnections_1_out_1, + main_Color_1_in_2, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node ColorBar[1]: x = 339, y = 285, inputs = 16, label = ColorBar + // input[9]: defaulting = 0, visible = 0, type = 16777248, value = {"black"} + // +main_ColorBar_1_out_1 = + ColorBar( + main_AutoColor_1_out_2, + main_ColorBar_1_in_2, + main_ColorBar_1_in_3, + main_ColorBar_1_in_4, + main_ColorBar_1_in_5, + main_ColorBar_1_in_6, + main_ColorBar_1_in_7, + main_ColorBar_1_in_8, + main_ColorBar_1_in_9, + main_ColorBar_1_in_10, + main_ColorBar_1_in_11, + main_ColorBar_1_in_12, + main_ColorBar_1_in_13, + main_ColorBar_1_in_14, + main_ColorBar_1_in_15, + main_ColorBar_1_in_16 + ) [instance: 1, cache: 1]; + // + // node Collect[1]: x = 280, y = 393, inputs = 3, label = Collect + // +main_Collect_1_out_1 = + Collect( + main_Color_1_out_1, + main_AutoColor_1_out_1, + main_ColorBar_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 188, y = 445, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 67108863, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[5]: defaulting = 0, visible = 0, type = 8, value = [0.182894 0.102434 0] + // input[6]: defaulting = 0, visible = 0, type = 8, value = [0.182894 0.102434 3.60504] + // input[7]: defaulting = 0, visible = 0, type = 5, value = 0.460265 + // input[8]: defaulting = 0, visible = 0, type = 1, value = 772 + // input[9]: defaulting = 0, visible = 0, type = 5, value = 0.791 + // input[10]: defaulting = 0, visible = 0, type = 8, value = [0 1 0] + // input[11]: defaulting = 1, visible = 0, type = 5, value = 7.30519 + // input[12]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[15]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[16]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[17]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[18]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[22]: defaulting = 0, visible = 0, type = 32, value = "snow" + // input[25]: defaulting = 0, visible = 0, type = 32, value = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/doping.tif" + // input[26]: defaulting = 0, visible = 0, type = 32, value = "tiff" + // input[29]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[31]: defaulting = 0, visible = 0, type = 1, value = -5 + // input[33]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[34]: defaulting = 0, visible = 0, type = 3, value = 0 + // input[36]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[37]: defaulting = 0, visible = 0, type = 16777248, value = {"clear", "black", "blue", "blue"} + // input[38]: defaulting = 0, visible = 0, type = 16777248, value = {"background", "grid", "ticks", "labels"} + // input[39]: defaulting = 0, visible = 0, type = 5, value = 0.65 + // input[40]: defaulting = 0, visible = 0, type = 32, value = "roman_d" + // input[41]: defaulting = 0, visible = 0, type = 32, value = "panzoom" + // depth: value = 24 + // window: position = (0.0000,0.0000), size = 0.6141x0.6396 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Collect_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_FileSelector_1_out_1 = "/tmp/SECS2D.6003912.dx"; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_Post_1_in_2 = "positions"; +main_Post_1_out_1 = NULL; +main_Gradient_1_in_2 = NULL; +main_Gradient_1_out_1 = NULL; +main_AutoGlyph_1_in_2 = NULL; +main_AutoGlyph_1_in_3 = NULL; +main_AutoGlyph_1_in_4 = NULL; +main_AutoGlyph_1_in_5 = NULL; +main_AutoGlyph_1_in_6 = NULL; +main_AutoGlyph_1_in_7 = NULL; +main_AutoGlyph_1_out_1 = NULL; +main_AutoColor_1_in_2 = NULL; +main_AutoColor_1_in_3 = NULL; +main_AutoColor_1_in_4 = NULL; +main_AutoColor_1_in_5 = NULL; +main_AutoColor_1_in_6 = NULL; +main_AutoColor_1_in_7 = NULL; +main_AutoColor_1_in_8 = NULL; +main_AutoColor_1_in_9 = NULL; +main_AutoColor_1_in_10 = NULL; +main_AutoColor_1_out_1 = NULL; +main_AutoColor_1_out_2 = NULL; +main_ShowConnections_1_out_1 = NULL; +main_Color_1_in_2 = "black"; +main_Color_1_in_3 = .5; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +main_ColorBar_1_in_2 = NULL; +main_ColorBar_1_in_3 = NULL; +main_ColorBar_1_in_4 = NULL; +main_ColorBar_1_in_5 = NULL; +main_ColorBar_1_in_6 = NULL; +main_ColorBar_1_in_7 = NULL; +main_ColorBar_1_in_8 = NULL; +main_ColorBar_1_in_9 = {"black"}; +main_ColorBar_1_in_10 = NULL; +main_ColorBar_1_in_11 = NULL; +main_ColorBar_1_in_12 = NULL; +main_ColorBar_1_in_13 = NULL; +main_ColorBar_1_in_14 = NULL; +main_ColorBar_1_in_15 = NULL; +main_ColorBar_1_in_16 = NULL; +main_ColorBar_1_out_1 = NULL; +main_Collect_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 1; +main_Image_1_in_5 = [0.182894 0.102434 0]; +main_Image_1_in_6 = [0.182894 0.102434 3.60504]; +main_Image_1_in_7 = 0.460265; +main_Image_1_in_8 = 772; +main_Image_1_in_9 = 0.791; +main_Image_1_in_10 = [0 1 0]; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = 0; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = NULL; +main_Image_1_in_18 = NULL; +main_Image_1_in_19 = 0; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = "snow"; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/doping.tif"; +main_Image_1_in_26 = "tiff"; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = 1; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = -5; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = 1; +main_Image_1_in_34 = 0; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = 1; +main_Image_1_in_37 = {"clear", "black", "blue", "blue"}; +main_Image_1_in_38 = {"background", "grid", "ticks", "labels"}; +main_Image_1_in_39 = 0.65; +main_Image_1_in_40 = "roman_d"; +main_Image_1_in_41 = "panzoom"; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +Executive("product version 4 4 4"); +$sync +main(); diff --git a/octave_packages/fpl-1.2.0/FPL2coloredrubbersheet.net b/octave_packages/fpl-1.2.0/FPL2coloredrubbersheet.net new file mode 100644 index 0000000..04aed1c --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2coloredrubbersheet.net @@ -0,0 +1,619 @@ +// +// time: Wed Jun 13 17:16:01 2007 +// +// version: 3.2.0 (format), 4.4.4 (DX) +// +// +// MODULE main +// workspace: width = 533, height = 507 +// layout: snap = 0, width = 50, height = 50, align = NN +// +macro main( +) -> ( +) { + // + // node FileSelector[1]: x = 51, y = 31, inputs = 0, label = FileSelector + // output[1]: visible = 1, type = 32, value = "__FILE__DX__" + // output[2]: visible = 1, type = 32, value = "__FILE__DX__" + // + // + // node Import[1]: x = 104, y = 118, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_FileSelector_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node Post[1]: x = 249, y = 57, inputs = 2, label = Post + // input[2]: defaulting = 0, visible = 1, type = 32, value = "__DATA_DEPENDENCY__" + // +main_Post_1_out_1 = + Post( + main_Import_1_out_1, + main_Post_1_in_2 + ) [instance: 1, cache: 1]; + // + // node RubberSheet[1]: x = 228, y = 142, inputs = 4, label = RubberSheet + // +main_RubberSheet_1_out_1 = + RubberSheet( + main_Post_1_out_1, + main_RubberSheet_1_in_2, + main_RubberSheet_1_in_3, + main_RubberSheet_1_in_4 + ) [instance: 1, cache: 1]; + // + // node AutoColor[1]: x = 253, y = 283, inputs = 10, label = AutoColor + // +main_AutoColor_1_out_1, +main_AutoColor_1_out_2 = + AutoColor( + main_RubberSheet_1_out_1, + main_AutoColor_1_in_2, + main_AutoColor_1_in_3, + main_AutoColor_1_in_4, + main_AutoColor_1_in_5, + main_AutoColor_1_in_6, + main_AutoColor_1_in_7, + main_AutoColor_1_in_8, + main_AutoColor_1_in_9, + main_AutoColor_1_in_10 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 49, y = 232, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_RubberSheet_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Color[1]: x = 72, y = 328, inputs = 5, label = Color + // input[2]: defaulting = 0, visible = 1, type = 32, value = "black" + // input[3]: defaulting = 0, visible = 1, type = 5, value = .5 + // +main_Color_1_out_1 = + Color( + main_ShowConnections_1_out_1, + main_Color_1_in_2, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node ColorBar[1]: x = 413, y = 290, inputs = 16, label = ColorBar + // input[9]: defaulting = 0, visible = 0, type = 16777248, value = {"black"} + // +main_ColorBar_1_out_1 = + ColorBar( + main_AutoColor_1_out_2, + main_ColorBar_1_in_2, + main_ColorBar_1_in_3, + main_ColorBar_1_in_4, + main_ColorBar_1_in_5, + main_ColorBar_1_in_6, + main_ColorBar_1_in_7, + main_ColorBar_1_in_8, + main_ColorBar_1_in_9, + main_ColorBar_1_in_10, + main_ColorBar_1_in_11, + main_ColorBar_1_in_12, + main_ColorBar_1_in_13, + main_ColorBar_1_in_14, + main_ColorBar_1_in_15, + main_ColorBar_1_in_16 + ) [instance: 1, cache: 1]; + // + // node Collect[1]: x = 280, y = 393, inputs = 3, label = Collect + // +main_Collect_1_out_1 = + Collect( + main_Color_1_out_1, + main_AutoColor_1_out_1, + main_ColorBar_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 188, y = 445, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 67108863, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[5]: defaulting = 0, visible = 0, type = 8, value = [0.466889 0.863877 0.166499] + // input[6]: defaulting = 0, visible = 0, type = 8, value = [0.466889 0.863877 4.74189] + // input[7]: defaulting = 0, visible = 0, type = 5, value = 1.01623 + // input[8]: defaulting = 0, visible = 0, type = 1, value = 1254 + // input[9]: defaulting = 0, visible = 0, type = 5, value = 0.730064 + // input[10]: defaulting = 0, visible = 0, type = 8, value = [0 1 0] + // input[11]: defaulting = 1, visible = 0, type = 5, value = 12.6739 + // input[12]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[15]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[16]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[17]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[18]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[22]: defaulting = 0, visible = 0, type = 32, value = "snow" + // input[25]: defaulting = 0, visible = 0, type = 32, value = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/doping.tif" + // input[26]: defaulting = 0, visible = 0, type = 32, value = "tiff" + // input[29]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[31]: defaulting = 0, visible = 0, type = 1, value = -5 + // input[33]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[34]: defaulting = 0, visible = 0, type = 3, value = 0 + // input[36]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[37]: defaulting = 0, visible = 0, type = 16777248, value = {"clear", "black", "blue", "blue"} + // input[38]: defaulting = 0, visible = 0, type = 16777248, value = {"background", "grid", "ticks", "labels"} + // input[39]: defaulting = 0, visible = 0, type = 5, value = 0.65 + // input[40]: defaulting = 0, visible = 0, type = 32, value = "roman_d" + // input[41]: defaulting = 0, visible = 0, type = 32, value = "panzoom" + // depth: value = 24 + // window: position = (0.0000,0.0283), size = 0.9906x0.9375 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Collect_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_FileSelector_1_out_1 = "__FILE__DX__"; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_Post_1_in_2 = "positions"; +main_Post_1_out_1 = NULL; +main_RubberSheet_1_in_2 = NULL; +main_RubberSheet_1_in_3 = NULL; +main_RubberSheet_1_in_4 = NULL; +main_RubberSheet_1_out_1 = NULL; +main_AutoColor_1_in_2 = NULL; +main_AutoColor_1_in_3 = NULL; +main_AutoColor_1_in_4 = NULL; +main_AutoColor_1_in_5 = NULL; +main_AutoColor_1_in_6 = NULL; +main_AutoColor_1_in_7 = NULL; +main_AutoColor_1_in_8 = NULL; +main_AutoColor_1_in_9 = NULL; +main_AutoColor_1_in_10 = NULL; +main_AutoColor_1_out_1 = NULL; +main_AutoColor_1_out_2 = NULL; +main_ShowConnections_1_out_1 = NULL; +main_Color_1_in_2 = "black"; +main_Color_1_in_3 = .5; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +main_ColorBar_1_in_2 = NULL; +main_ColorBar_1_in_3 = NULL; +main_ColorBar_1_in_4 = NULL; +main_ColorBar_1_in_5 = NULL; +main_ColorBar_1_in_6 = NULL; +main_ColorBar_1_in_7 = NULL; +main_ColorBar_1_in_8 = NULL; +main_ColorBar_1_in_9 = {"black"}; +main_ColorBar_1_in_10 = NULL; +main_ColorBar_1_in_11 = NULL; +main_ColorBar_1_in_12 = NULL; +main_ColorBar_1_in_13 = NULL; +main_ColorBar_1_in_14 = NULL; +main_ColorBar_1_in_15 = NULL; +main_ColorBar_1_in_16 = NULL; +main_ColorBar_1_out_1 = NULL; +main_Collect_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 1; +main_Image_1_in_5 = [0.466889 0.863877 0.166499]; +main_Image_1_in_6 = [0.466889 0.863877 4.74189]; +main_Image_1_in_7 = 1.01623; +main_Image_1_in_8 = 1254; +main_Image_1_in_9 = 0.730064; +main_Image_1_in_10 = [0 1 0]; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = 0; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = NULL; +main_Image_1_in_18 = NULL; +main_Image_1_in_19 = 0; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = "snow"; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/doping.tif"; +main_Image_1_in_26 = "tiff"; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = 1; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = -5; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = 1; +main_Image_1_in_34 = 0; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = 1; +main_Image_1_in_37 = {"clear", "black", "blue", "blue"}; +main_Image_1_in_38 = {"background", "grid", "ticks", "labels"}; +main_Image_1_in_39 = 0.65; +main_Image_1_in_40 = "roman_d"; +main_Image_1_in_41 = "panzoom"; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +Executive("product version 4 4 4"); +$sync +main(); diff --git a/octave_packages/fpl-1.2.0/FPL2dxappenddata.m b/octave_packages/fpl-1.2.0/FPL2dxappenddata.m new file mode 100644 index 0000000..0b915e1 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2dxappenddata.m @@ -0,0 +1,90 @@ +## Copyright (C) 2004-2008 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## @deftypefn {Function File} {} FPL2dxappenddata ( @var{filename}, +## @var{p}, @var{t}, @var{u}, @var{attr_name}, @var{attr_rank}, +## @var{attr_shape}, @var{endflie} ) +## +## Apends data to a file in DX form. +## Only one variable can be written to the file +## variable must be a scalar, vector or tensor of doubles +## mesh data in the file must be consistent with this variable +## +## Variable must be a scalar, vector or tensor of doubles +## +## @itemize @minus +## @item @var{filename}= name of file to save (type string) +## @item @var{p}, @var{t} = mesh +## @item @var{u} = variable to save +## @item @var{attr_name} = name of the variable (type string) +## @item @var{attr_rank} = rank of variable data (0 for scalar, 1 for vector, etc.) +## @item @var{attr_shape} = number of components of variable data (assumed 1 for scalar) +## @item @var{endfile} = 0 if you want to add other variables to the +## same file, 1 otherwise +## @end itemize +## @end deftypefn + +function FPL2dxappenddata(filename,p,t,u,attr_name,attr_rank,attr_shape,endfile) + + p = p'; + t = t'; + t = t(:,1:3); + + fid=fopen (filename,'a'); + Nnodi = size(p,1); + Ntriangoli = size(t,1); + + fprintf(fid,'\nattribute "element type" string "triangles"\nattribute "ref" string "positions"\n\n'); + + if ((attr_rank==0) & (min(size(u))==1)) + fprintf(fid,'object "%s.data"\nclass array type double rank 0 items %d data follows',attr_name,Nnodi); + fprintf(fid,'\n %1.7e',u); + else + fprintf(fid,'object "%s.data"\nclass array type double rank %d shape %d items %d data follows', ... + attr_name,attr_rank,attr_shape,Nnodi); + for i=1:Nnodi + fprintf(fid,'\n'); + fprintf(fid,' %1.7e',u(i,:)); + endfor + endif + fprintf(fid,['\nattribute "dep" string "positions"\n\n' ... + 'object "%s" class field\n'... + 'component "positions" value "pos"\n'... + 'component "connections" value "con"\n'... + 'component "data" value "%s.data"\n'],... + attr_name,attr_name); + + if(endfile) + fprintf(fid,'\nend\n'); + endif + + fclose (fid); + +endfunction \ No newline at end of file diff --git a/octave_packages/fpl-1.2.0/FPL2dxoutputdata.m b/octave_packages/fpl-1.2.0/FPL2dxoutputdata.m new file mode 100644 index 0000000..60aba7c --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2dxoutputdata.m @@ -0,0 +1,126 @@ +## Copyright (C) 2004-2008,2009 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## @deftypefn {Function File} {} FPL2dxoutputdata ( @var{filename}, @ +## @var{p}, @var{t}, @var{u}, @var{attr_name}, @var{attr_rank}, @ +## @var{attr_shape}, @var{endfile} ) +## +## Outputs data in DX form. +## +## Variable must be a scalar, vector or tensor of doubles +## +## @itemize @minus +## @item @var{filename}= name of file to save (type string) +## @item @var{p}, @var{t} = mesh +## @item @var{u} = variable to save +## @item @var{attr_name} = name of the variable (type string) +## @item @var{attr_rank} = rank of variable data (0 for scalar, 1 for vector, etc.) +## @item @var{attr_shape} = number of components of variable data (assumed 1 for scalar) +## @item @var{endfile} = 0 if you want to add other variables to the +## same file, 1 otherwise +## @end itemize +## @end deftypefn + +function FPL2dxoutputdata(filename,p,t,u,attr_name,attr_rank,attr_shape,endfile) + + p = p'; + t = t'; + t = t(:,1:3); + + fid=fopen (filename,'w'); + Nnodi = size(p,1); + Ntriangoli = size(t,1); + Ndati = size(u,1); + + fprintf(fid,"object ""pos""\nclass array type float rank 1 shape 2 items %d data follows",Nnodi); + + for i=1:Nnodi + fprintf(fid,"\n"); + fprintf(fid," %1.7e",p(i,:)); + endfor + + if (min(min(t))==1) + t=t-1; + elseif(min(min(t))~=0) + disp('WARNING: check triangle structure') + endif + ## In DX format nodes are + ## numbered starting from zero, + ## instead we want to number + ## them starting from 1! + ## Here we restore the DX + ## format + + fprintf(fid,"\n\nobject ""con""\nclass array type int rank 1 shape 3 items %d data follows",Ntriangoli); + for i=1:Ntriangoli + fprintf(fid,"\n"); + fprintf(fid," %d",t(i,:)); + endfor + + fprintf(fid,"\nattribute ""element type"" string ""triangles""\nattribute ""ref"" string ""positions""\n\n"); + + if ((attr_rank==0) & (min(size(u))==1)) + fprintf(fid,"object ""%s.data""\nclass array type double rank 0 items %d data follows",attr_name,Ndati); + fprintf(fid,"\n %1.7e",u); + + else + fprintf(fid,"object ""%s.data""\nclass array type double rank %d shape %d items %d data follows", ... + attr_name,attr_rank,attr_shape,Ndati); + for i=1:Ndati + fprintf(fid,"\n"); + fprintf(fid," %1.7e",u(i,:)); + endfor + + endif + + if Ndati==Nnodi + fprintf(fid,["\nattribute ""dep"" string ""positions""\n\n" ... + "object ""%s"" class field\n"... + "component ""positions"" value ""pos""\n"... + "component ""connections"" value ""con""\n"... + "component ""data"" value ""%s.data""\n"],... + attr_name,attr_name); + elseif Ndati==Ntriangoli + fprintf(fid,["\nattribute ""dep"" string ""connections""\n\n" ... + "object ""%s"" class field\n"... + "component ""positions"" value ""pos""\n"... + "component ""connections"" value ""con""\n"... + "component ""data"" value ""%s.data""\n"],... + attr_name,attr_name); + endif + + if(endfile) + fprintf(fid,"\nend\n"); + endif + + fclose (fid); + + +endfunction \ No newline at end of file diff --git a/octave_packages/fpl-1.2.0/FPL2dxoutputtimeseries.m b/octave_packages/fpl-1.2.0/FPL2dxoutputtimeseries.m new file mode 100644 index 0000000..c20bc31 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2dxoutputtimeseries.m @@ -0,0 +1,71 @@ +## Copyright (C) 2004-2008 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## @deftypefn {Function File} {} FPL2dxoutputtimeseries ( @var{filename}, @var{p}, @var{t}, @var{u}, @var{attr_name}, @var{attr_rank}, @var{attr_shape}, @var{time} ) +## +## Outputs a time series in DX form. +## variable must be a scalar, vector or tensor of doubles +## @itemize @minus +## @item @var{filename}= name of file to save (type string) +## @item @var{p}, @var{t} = mesh +## @item @var{u} = variable to save +## @item @var{attr_name} = name of the variable (type string) +## @item @var{attr_rank} = rank of variable data (0 for scalar, 1 for vector, etc.) +## @item @var{attr_shape} = number of components of variable data (assumed 1 for scalar) +## @item @var{time} = time instants +## @end itemize +## @end deftypefn + +function FPL2dxoutputtimeseries(filename,p,t,u,attr_name,attr_rank,attr_shape,time) + + Nsteps = length(time); + if (Nsteps<=1) + endfile = 1; + else + endfile = 0; + endif + + FPL2dxoutputdata(filename,p,t,u(:,1:attr_shape),[attr_name "1"],attr_rank,attr_shape,endfile); + + for it = 2:Nsteps + FPL2dxappenddata(filename,p,t,u(:,[1:attr_shape]+attr_shape*(it-1)),... + [attr_name num2str(it)],attr_rank,attr_shape,endfile); + endfor + + fid=fopen(filename,"a"); + + fprintf (fid, "object \"%s_series\" class series\n",attr_name); + for it = 1:Nsteps + fprintf (fid,"member %d position %g value \"%s\"\n",it-1,time(it),[attr_name num2str(it)]); + endfor + fprintf (fid, "\nend\n"); + fclose(fid); + +endfunction \ No newline at end of file diff --git a/octave_packages/fpl-1.2.0/FPL2pdequiver.m b/octave_packages/fpl-1.2.0/FPL2pdequiver.m new file mode 100644 index 0000000..66767a0 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2pdequiver.m @@ -0,0 +1,92 @@ +## Copyright (C) 2004-2008 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## @deftypefn {Function File} {} FPL2pdequiver (@var{mesh}, @ +## @var{vx}, @var{vy}, [ @var{property}, @var{value} ...]) +## +## Plots the 2D vector field @var{vx}, @var{vy} +## defined on the triangulation @var{mesh} using opendx. +## +## Options (default values): +## @var{sample_density} (100) +## +## @seealso{FPL2pdesurf, FPL2ptcsurf, FPL2ptcquiver} +## @end deftypefn + +function FPL2pdequiver(mesh,vecfieldx,vecfieldy,varargin); + + sample_density = "100"; + + if( (nargin >= 3) && (rem(nargin,2)==1) ) + for ii=1:2:length(varargin) + [ varargin{ii} " = " varargin{ii+1} ";" ] + eval([ varargin{ii} " = """ varargin{ii+1} """;" ]); + endfor + else + error(["wrong number of parameters " num2str (nargin)]) + endif + + JX = sum(vecfieldx,1)'/3; + JY = sum(vecfieldy,1)'/3; + + dataname = mktemp("/tmp",".dx"); + scriptname = mktemp("/tmp",".net"); + + FPL2dxoutputdata(dataname,mesh.p,mesh.t,[ JX JY],'J',1,2,1); + + showmesh = file_in_path(path,"FPL2pdequiver.net"); + + system (["cp " showmesh " " scriptname]); + system (["sed -i \'s|__FILE__DX__|" dataname "|g\' " scriptname]); + system (["sed -i \'s|__SAMPLE__DENSITY__|" sample_density "|g\' " scriptname]); + + command = ["dx -noConfirmedQuit -program " scriptname " -execute -image >& /dev/null & "]; + + system(command); + + +endfunction + +function filename = mktemp (direct,ext); + + if (~exist(direct,"dir")) + error("trying to save temporary file to non existing directory") + endif + + done=false; + + while ~done + filename = [direct,"/FPL.",num2str(floor(rand*1e7)),ext]; + if ~exist(filename,"file") + done =true; + endif + endwhile + +endfunction diff --git a/octave_packages/fpl-1.2.0/FPL2pdequiver.net b/octave_packages/fpl-1.2.0/FPL2pdequiver.net new file mode 100644 index 0000000..f9d7af8 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2pdequiver.net @@ -0,0 +1,613 @@ +// +// time: Fri Jun 15 19:24:56 2007 +// +// version: 3.2.0 (format), 4.4.4 (DX) +// +// +// MODULE main +// workspace: width = 481, height = 614 +// layout: snap = 0, width = 50, height = 50, align = NN +// +macro main( +) -> ( +) { + // + // node FileSelector[1]: x = 173, y = 81, inputs = 0, label = FileSelector + // output[1]: visible = 1, type = 32, value = "__FILE__DX__" + // output[2]: visible = 1, type = 32, value = "__FILE__DX__" + // + // + // node Import[1]: x = 203, y = 177, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_FileSelector_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node Sample[1]: x = 89, y = 238, inputs = 2, label = Sample + // input[2]: defaulting = 0, visible = 1, type = 1, value = __SAMPLE__DENSITY__ + // +main_Sample_1_out_1 = + Sample( + main_Import_1_out_1, + main_Sample_1_in_2 + ) [instance: 1, cache: 1]; + // + // node AutoGlyph[1]: x = 64, y = 323, inputs = 7, label = AutoGlyph + // +main_AutoGlyph_1_out_1 = + AutoGlyph( + main_Sample_1_out_1, + main_AutoGlyph_1_in_2, + main_AutoGlyph_1_in_3, + main_AutoGlyph_1_in_4, + main_AutoGlyph_1_in_5, + main_AutoGlyph_1_in_6, + main_AutoGlyph_1_in_7 + ) [instance: 1, cache: 1]; + // + // node AutoColor[1]: x = 76, y = 415, inputs = 10, label = AutoColor + // +main_AutoColor_1_out_1, +main_AutoColor_1_out_2 = + AutoColor( + main_AutoGlyph_1_out_1, + main_AutoColor_1_in_2, + main_AutoColor_1_in_3, + main_AutoColor_1_in_4, + main_AutoColor_1_in_5, + main_AutoColor_1_in_6, + main_AutoColor_1_in_7, + main_AutoColor_1_in_8, + main_AutoColor_1_in_9, + main_AutoColor_1_in_10 + ) [instance: 1, cache: 1]; + // + // node ColorBar[1]: x = 238, y = 367, inputs = 16, label = ColorBar + // +main_ColorBar_1_out_1 = + ColorBar( + main_AutoColor_1_out_2, + main_ColorBar_1_in_2, + main_ColorBar_1_in_3, + main_ColorBar_1_in_4, + main_ColorBar_1_in_5, + main_ColorBar_1_in_6, + main_ColorBar_1_in_7, + main_ColorBar_1_in_8, + main_ColorBar_1_in_9, + main_ColorBar_1_in_10, + main_ColorBar_1_in_11, + main_ColorBar_1_in_12, + main_ColorBar_1_in_13, + main_ColorBar_1_in_14, + main_ColorBar_1_in_15, + main_ColorBar_1_in_16 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 348, y = 295, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_Import_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Color[1]: x = 359, y = 398, inputs = 5, label = Color + // input[2]: defaulting = 0, visible = 1, type = 32, value = "black" + // +main_Color_1_out_1 = + Color( + main_ShowConnections_1_out_1, + main_Color_1_in_2, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node Collect[1]: x = 198, y = 465, inputs = 3, label = Collect + // +main_Collect_1_out_1 = + Collect( + main_AutoColor_1_out_1, + main_ColorBar_1_out_1, + main_Color_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 195, y = 552, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 67108863, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[5]: defaulting = 0, visible = 0, type = 8, value = [0.555651 0.5 0] + // input[6]: defaulting = 0, visible = 0, type = 8, value = [0.555651 0.5 3.71222] + // input[7]: defaulting = 0, visible = 0, type = 5, value = 1.98938 + // input[8]: defaulting = 0, visible = 0, type = 1, value = 1254 + // input[9]: defaulting = 0, visible = 0, type = 5, value = 0.759 + // input[10]: defaulting = 0, visible = 0, type = 8, value = [0 1 0] + // input[11]: defaulting = 1, visible = 0, type = 5, value = 30.0001 + // input[12]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[15]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[16]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[17]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[18]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[22]: defaulting = 0, visible = 0, type = 32, value = "grey70" + // input[29]: defaulting = 1, visible = 0, type = 3, value = 0 + // input[41]: defaulting = 0, visible = 0, type = 32, value = "panzoom" + // depth: value = 24 + // window: position = (0.0000,0.0000), size = 0.9906x0.9697 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Collect_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_FileSelector_1_out_1 = "__FILE__DX__"; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_Sample_1_in_2 = __SAMPLE__DENSITY__; +main_Sample_1_out_1 = NULL; +main_AutoGlyph_1_in_2 = NULL; +main_AutoGlyph_1_in_3 = NULL; +main_AutoGlyph_1_in_4 = NULL; +main_AutoGlyph_1_in_5 = NULL; +main_AutoGlyph_1_in_6 = NULL; +main_AutoGlyph_1_in_7 = NULL; +main_AutoGlyph_1_out_1 = NULL; +main_AutoColor_1_in_2 = NULL; +main_AutoColor_1_in_3 = NULL; +main_AutoColor_1_in_4 = NULL; +main_AutoColor_1_in_5 = NULL; +main_AutoColor_1_in_6 = NULL; +main_AutoColor_1_in_7 = NULL; +main_AutoColor_1_in_8 = NULL; +main_AutoColor_1_in_9 = NULL; +main_AutoColor_1_in_10 = NULL; +main_AutoColor_1_out_1 = NULL; +main_AutoColor_1_out_2 = NULL; +main_ColorBar_1_in_2 = NULL; +main_ColorBar_1_in_3 = NULL; +main_ColorBar_1_in_4 = NULL; +main_ColorBar_1_in_5 = NULL; +main_ColorBar_1_in_6 = NULL; +main_ColorBar_1_in_7 = NULL; +main_ColorBar_1_in_8 = NULL; +main_ColorBar_1_in_9 = NULL; +main_ColorBar_1_in_10 = NULL; +main_ColorBar_1_in_11 = NULL; +main_ColorBar_1_in_12 = NULL; +main_ColorBar_1_in_13 = NULL; +main_ColorBar_1_in_14 = NULL; +main_ColorBar_1_in_15 = NULL; +main_ColorBar_1_in_16 = NULL; +main_ColorBar_1_out_1 = NULL; +main_ShowConnections_1_out_1 = NULL; +main_Color_1_in_2 = "black"; +main_Color_1_in_3 = NULL; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +main_Collect_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 1; +main_Image_1_in_5 = [0.555651 0.5 0]; +main_Image_1_in_6 = [0.555651 0.5 3.71222]; +main_Image_1_in_7 = 1.98938; +main_Image_1_in_8 = 1254; +main_Image_1_in_9 = 0.759; +main_Image_1_in_10 = [0 1 0]; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = 0; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = NULL; +main_Image_1_in_18 = NULL; +main_Image_1_in_19 = 0; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = "grey70"; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = NULL; +main_Image_1_in_26 = NULL; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = NULL; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = NULL; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = NULL; +main_Image_1_in_34 = NULL; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = NULL; +main_Image_1_in_37 = NULL; +main_Image_1_in_38 = NULL; +main_Image_1_in_39 = NULL; +main_Image_1_in_40 = NULL; +main_Image_1_in_41 = "panzoom"; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +Executive("product version 4 4 4"); +$sync +main(); diff --git a/octave_packages/fpl-1.2.0/FPL2pdeshowmesh.m b/octave_packages/fpl-1.2.0/FPL2pdeshowmesh.m new file mode 100644 index 0000000..812444a --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2pdeshowmesh.m @@ -0,0 +1,94 @@ +## Copyright (C) 2004-2008,2009 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## +## @deftypefn {Function File} {} FPL2pdeshowmesh (@var{mesh},@var{color}) +## +## Displays one 2-D triangulations using opendx +## +## Examples: +## @example +## +## FPL2pdeshowmesh(mesh) +## FPL2pdeshowmesh(mesh,"blue") +## +## @end example +## +## @seealso{FPL2ptcshowmesh} +## @end deftypefn + +function FPL2pdeshowmesh (varargin) + + if nargin == 1 + colorname = "red"; + else + colorname = varargin{2}; + endif + + dataname = mktemp("/tmp",".dx"); + FPL2dxoutputdata(dataname,varargin{1}.p,varargin{1}.t,varargin{1}.p(1,:)','x',0,1,1); + + scriptname = mktemp("/tmp",".net"); + + showmesh = file_in_path(path,"FPL2pdeshowmesh.net"); + + system (["cp " showmesh " " scriptname]); + system (["sed -i \'s|FILENAME|" dataname "|g\' " scriptname]); + system (["sed -i \'s|COLORNAME|" colorname "|g\' " scriptname]); + + command = ["dx -noConfirmedQuit -program " scriptname " -execute -image >& /dev/null & "]; + system(command); + +endfunction + +function filename = mktemp (direct,ext); + + if (~exist(direct,"dir")) + error("trying to save temporary file to non existing directory") + end + + done=false; + + while ~done + filename = [direct,"/FPL.",num2str(floor(rand*1e7)),ext]; + if ~exist(filename,"file") + done =true; + endif + endwhile + +endfunction + +%!demo +%! msh.p = [0 0; 1 0; 1 1; 0 1].'; +%! msh.t = [1 2 3 1; 1 3 4 1].'; +%! msh.e = [1 2 0 0 1 0 1; 2 3 0 0 2 0 1; 3 4 0 0 3 0 1; 4 1 0 0 4 0 1].'; +%! FPL2pdeshowmesh (msh, "red"); +%! s = input ("do you see a red outlined square divided in two triangles (if you see an empty plot try ctrl-F)? (y/n): " ,"s"); +%! assert(s, "y") \ No newline at end of file diff --git a/octave_packages/fpl-1.2.0/FPL2pdeshowmesh.net b/octave_packages/fpl-1.2.0/FPL2pdeshowmesh.net new file mode 100644 index 0000000..63b1887 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2pdeshowmesh.net @@ -0,0 +1,518 @@ +// +// time: Sat Jan 5 12:20:20 2008 +// +// version: 3.2.0 (format), 4.4.4 (DX) +// +// +// MODULE main +// workspace: width = 260, height = 456 +// layout: snap = 1, width = 10, height = 10, align = CC +// +macro main( +) -> ( +) { + // + // node String[1]: x = 81, y = 24, inputs = 0, label = String + // output[1]: visible = 1, type = 32, value = "FILENAME" + // + // + // node Import[1]: x = 79, y = 104, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_String_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node String[2]: x = 211, y = 24, inputs = 0, label = String + // output[1]: visible = 1, type = 32, value = "COLORNAME" + // + // + // node Color[1]: x = 149, y = 184, inputs = 5, label = Color + // input[2]: defaulting = 1, visible = 1, type = 32, value = "indianred" + // +main_Color_1_out_1 = + Color( + main_Import_1_out_1, + main_String_2_out_1, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 119, y = 294, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_Color_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 149, y = 394, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 67108863, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[5]: defaulting = 0, visible = 0, type = 8, value = [7.5 7.5 0] + // input[6]: defaulting = 0, visible = 0, type = 8, value = [7.5 7.5 39.3199] + // input[7]: defaulting = 0, visible = 0, type = 5, value = 21.0715 + // input[8]: defaulting = 0, visible = 0, type = 1, value = 804 + // input[9]: defaulting = 0, visible = 0, type = 5, value = 0.610075 + // input[10]: defaulting = 0, visible = 0, type = 8, value = [0 1 0] + // input[11]: defaulting = 1, visible = 0, type = 5, value = 30.0 + // input[12]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[15]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[16]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[17]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[18]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[22]: defaulting = 0, visible = 0, type = 32, value = "snow" + // input[25]: defaulting = 0, visible = 0, type = 32, value = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/grid.tif" + // input[26]: defaulting = 0, visible = 0, type = 32, value = "tiff" + // input[29]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[31]: defaulting = 0, visible = 0, type = 1, value = -15 + // input[33]: defaulting = 0, visible = 0, type = 3, value = 0 + // input[34]: defaulting = 0, visible = 0, type = 3, value = 0 + // input[37]: defaulting = 0, visible = 0, type = 16777248, value = {"clear", "grey5", "saddlebrown", "saddlebrown"} + // input[38]: defaulting = 0, visible = 0, type = 16777248, value = {"background", "grid", "ticks", "labels"} + // input[39]: defaulting = 0, visible = 0, type = 5, value = 0.7 + // input[40]: defaulting = 0, visible = 0, type = 32, value = "roman_s" + // input[41]: defaulting = 0, visible = 0, type = 32, value = "none" + // depth: value = 24 + // window: position = (0.2479,0.1267), size = 0.6389x0.6833 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_ShowConnections_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_String_1_out_1 = "FILENAME"; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_String_2_out_1 = "COLORNAME"; +main_Color_1_in_3 = NULL; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +main_ShowConnections_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 1; +main_Image_1_in_5 = [7.5 7.5 0]; +main_Image_1_in_6 = [7.5 7.5 39.3199]; +main_Image_1_in_7 = 21.0715; +main_Image_1_in_8 = 804; +main_Image_1_in_9 = 0.610075; +main_Image_1_in_10 = [0 1 0]; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = 0; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = 1; +main_Image_1_in_18 = 1; +main_Image_1_in_19 = 1; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = "snow"; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/grid.tif"; +main_Image_1_in_26 = "tiff"; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = 1; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = -15; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = 0; +main_Image_1_in_34 = 0; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = NULL; +main_Image_1_in_37 = {"clear", "grey5", "saddlebrown", "saddlebrown"}; +main_Image_1_in_38 = {"background", "grid", "ticks", "labels"}; +main_Image_1_in_39 = 0.7; +main_Image_1_in_40 = "roman_s"; +main_Image_1_in_41 = "none"; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +Executive("product version 4 4 4"); +$sync +main(); diff --git a/octave_packages/fpl-1.2.0/FPL2pdesurf.m b/octave_packages/fpl-1.2.0/FPL2pdesurf.m new file mode 100644 index 0000000..acd7b22 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2pdesurf.m @@ -0,0 +1,130 @@ +## Copyright (C) 2004-2008,2009 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## @deftypefn {Function File} {} FPL2pdesurf (@var{mesh}, @ +## @var{u} [ @var{property}, @var{value} ...]) +## +## plots the scalar field @var{u} +## defined on the triangulation @var{mesh} using opendx. +## +## options (default value): +## @itemize @minus +## @item data_dep ("positions") defines wether data depends on +## positions or connections +## @item plot_field ("scalar") defines wether to plot the scalar field +## itself or its gradient +## @end itemize +## +## @seealso{MSH2Mgmsh, MSH2Mstructmesh} +## @end deftypefn + +function FPL2pdesurf(varargin) + + data_dep = "positions"; + plot_field = "scalar"; + + if nargin == 1 + FPL2showmesh(varargin{1}); + elseif nargin == 2 + mesh = varargin{1}; + u = varargin{2}; + elseif ( (nargin > 2) && (rem(nargin,2)==0) ) + mesh = varargin{1}; + u = varargin{2}; + for ii=3:2:nargin + eval([ varargin{ii} " = """ varargin{ii+1} """;" ]); + endfor + else + keyboard ,error(["wrong number of parameters " num2str (nargin)]) + endif + + dataname = mktemp("/tmp",".dx"); + scriptname = mktemp("/tmp",".net"); + + FPL2dxoutputdata(dataname,mesh.p,mesh.t,u,'u',0,1,1); + + switch plot_field + case {"scalar","scal"} + showmesh = file_in_path(path,"FPL2coloredrubbersheet.net"); + case {"gradient","grad"} + showmesh = file_in_path(path,"FPL2coloredgradient.net"); + otherwise + error ([ "incorrect value " plot_field " for option plot_field "]) + endswitch + + system (["cp " showmesh " " scriptname]); + system (["sed -i \'s|__FILE__DX__|" dataname "|g\' " scriptname]); + + switch data_dep + case {"positions","continuous","interpolate","P1"} + system (["sed -i \'s|__DATA_DEPENDENCY__|positions|g\' " scriptname]); + case {"connections","discontinuous","P0"} + system (["sed -i \'s|__DATA_DEPENDENCY__|positions|g\' " scriptname]); + otherwise + error ([ "incorrect value " data_dep " for option data_dep "]) + endswitch + + ##command = ["dx -noConfirmedQuit -noImageRWNetFile -program " scriptname " -execute -image >& /dev/null & "]; + command = ["dx -noConfirmedQuit -program " scriptname " -execute -image >& /dev/null & "]; + + system(command); + +endfunction + +function filename = mktemp (direct,ext); + + if (~exist(direct,"dir")) + error("trying to save temporary file to non existing directory") + endif + + done=false; + + while ~done + filename = [direct,"/FPL.",num2str(floor(rand*1e7)),ext]; + if ~exist(filename,"file") + done =true; + endif + endwhile + +endfunction + +%!shared msh +%!demo +%! msh.p = [0 0; 1 0; 1 1; 0 1].'; +%! msh.t = [1 2 3 1; 1 3 4 1].'; +%! msh.e = [1 2 0 0 1 0 1; 2 3 0 0 2 0 1; 3 4 0 0 3 0 1; 4 1 0 0 4 0 1].'; +%! u = [0 1].'; +%! FPL2pdesurf (msh, u, "data_dep", "connections"); +%! s = input ("do you see a square divided into two triangles with a diagonal red-to-blue gradient color (if you see an empty plot try ctrl-F)? (y/n): " ,"s"); +%! assert(s, "y") +%!demo +%! v = [0 0 1 1].'; +%! FPL2pdesurf (msh, v); +%! s = input ("do you see a square divided into two triangles with a vertical red-to-blue gradient color (if you see an empty plot try ctrl-F)? (y/n): " ,"s"); diff --git a/octave_packages/fpl-1.2.0/FPL2ptcquiver.m b/octave_packages/fpl-1.2.0/FPL2ptcquiver.m new file mode 100644 index 0000000..d1bc880 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2ptcquiver.m @@ -0,0 +1,83 @@ +## Copyright (C) 2004-2008 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## @deftypefn {Function File} {} FPL2ptcquiver (@var{mesh1}, @var{color1} +## @var{vx1}, @var{vy1}, [ @var{mesh2}, @var{color2}, @var{vx2}, @var{vy2} ...]) +## +## Plots the 2D vector fields @var{vx}, @var{vy} +## defined on the triangulations @var{mesh} using opendx. +## +## +## @seealso{FPL2pdesurf, FPL2ptcsurf, FPL2pdequiver} +## @end deftypefn + +function FPL2ptcquiver(varargin) + + colorlist = ""; + datalist = ""; + + for ii = 1:4:nargin + dataname{ii} = mktemp("/tmp",".dx"); + JX = sum(varargin{ii+2},1)'/3; + JY = sum(varargin{ii+3},1)'/3; + FPL2dxoutputdata(dataname{ii},varargin{ii}.p,varargin{ii}.t,[ JX JY],'J',1,2,1); + datalist = strcat (datalist, """", dataname{ii} , """"); + colorlist= strcat (colorlist, """", varargin{ii+1} , """"); + endfor + + scriptname = mktemp("/tmp",".net"); + + view = file_in_path(path,"FPL2ptcquiver.net"); + + system (["cp " view " " scriptname]); + system (["sed -i \'s|""FILELIST""|" datalist "|g\' " scriptname]); + system (["sed -i \'s|""COLORLIST""|" colorlist "|g\' " scriptname]); + + command = ["dx -noConfirmedQuit -program " scriptname " -execute -image >& /dev/null & "]; + system(command); + +endfunction + +function filename = mktemp (direct,ext); + + if (~exist(direct,"dir")) + error("trying to save temporary file to non existing directory") + endif + + done=false; + + while ~done + filename = [direct,"/FPL.",num2str(floor(rand*1e7)),ext]; + if ~exist(filename,"file") + done =true; + endif + endwhile + +endfunction diff --git a/octave_packages/fpl-1.2.0/FPL2ptcquiver.net b/octave_packages/fpl-1.2.0/FPL2ptcquiver.net new file mode 100644 index 0000000..6f23e98 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2ptcquiver.net @@ -0,0 +1,710 @@ +// +// time: Mon Jan 7 11:37:04 2008 +// +// version: 3.2.0 (format), 4.4.4 (DX) +// +// +// MODULE main +// workspace: width = 875, height = 996 +// layout: snap = 1, width = 10, height = 10, align = CC +// +macro main( +) -> ( +) { + // + // node CollectMultiGrid[1]: x = 125, y = 584, inputs = 4, label = CollectMultiGrid + // +main_CollectMultiGrid_1_out_1 = + CollectMultiGrid( + main_CollectMultiGrid_1_in_1, + main_CollectMultiGrid_1_in_2, + main_CollectMultiGrid_1_in_3, + main_CollectMultiGrid_1_in_4 + ) [instance: 1, cache: 1]; + // + // node StringList[1]: x = 478, y = 14, inputs = 0, label = StringList + // output[1]: visible = 1, type = 16777248, value = { "FILELIST" } + // + // + // node ForEachMember[1]: x = 455, y = 94, inputs = 1, label = ForEachMember + // +main_ForEachMember_1_out_1, +main_ForEachMember_1_out_2, +main_ForEachMember_1_out_3 = + ForEachMember( + main_StringList_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Import[1]: x = 479, y = 194, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_ForEachMember_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 239, y = 384, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_Import_1_out_1 + ) [instance: 1, cache: 1]; + // + // node StringList[2]: x = 418, y = 384, inputs = 0, label = StringList + // output[1]: visible = 1, type = 16777248, value = { "COLORLIST" } + // + // + // node ForEachMember[2]: x = 395, y = 474, inputs = 1, label = ForEachMember + // +main_ForEachMember_2_out_1, +main_ForEachMember_2_out_2, +main_ForEachMember_2_out_3 = + ForEachMember( + main_StringList_2_out_1 + ) [instance: 2, cache: 1]; + // + // node Color[1]: x = 289, y = 584, inputs = 5, label = Color + // +main_Color_1_out_1 = + Color( + main_ShowConnections_1_out_1, + main_ForEachMember_2_out_1, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node GetLocal[1]: x = 452, y = 614, inputs = 3, label = GetLocal + // +main_GetLocal_1_out_1, +main_GetLocal_1_out_2 = + GetLocal( + main_GetLocal_1_in_1, + main_GetLocal_1_in_2, + main_GetLocal_1_in_3 + ) [instance: 1, cache: 1]; + // + // node Append[1]: x = 285, y = 724, inputs = 5, label = Append + // +main_Append_1_out_1 = + Append( + main_CollectMultiGrid_1_out_1, + main_Color_1_out_1, + main_Append_1_in_3, + main_GetLocal_1_out_1, + main_Append_1_in_5 + ) [instance: 1, cache: 1]; + // + // node GetLocal[2]: x = 802, y = 264, inputs = 3, label = GetLocal + // +main_GetLocal_2_out_1, +main_GetLocal_2_out_2 = + GetLocal( + main_GetLocal_2_in_1, + main_GetLocal_2_in_2, + main_GetLocal_2_in_3 + ) [instance: 2, cache: 1]; + // + // node Append[2]: x = 595, y = 384, inputs = 5, label = Append + // +main_Append_2_out_1 = + Append( + main_CollectMultiGrid_1_out_1, + main_Import_1_out_1, + main_Append_2_in_3, + main_GetLocal_2_out_1, + main_Append_2_in_5 + ) [instance: 2, cache: 1]; + // + // node Sample[1]: x = 627, y = 474, inputs = 2, label = Sample + // +main_Sample_1_out_1 = + Sample( + main_Append_2_out_1, + main_Sample_1_in_2 + ) [instance: 1, cache: 1]; + // + // node AutoGlyph[1]: x = 625, y = 544, inputs = 7, label = AutoGlyph + // +main_AutoGlyph_1_out_1 = + AutoGlyph( + main_Sample_1_out_1, + main_AutoGlyph_1_in_2, + main_AutoGlyph_1_in_3, + main_AutoGlyph_1_in_4, + main_AutoGlyph_1_in_5, + main_AutoGlyph_1_in_6, + main_AutoGlyph_1_in_7 + ) [instance: 1, cache: 1]; + // + // node AutoColor[1]: x = 626, y = 614, inputs = 10, label = AutoColor + // input[8]: visible = 1 + // +main_AutoColor_1_out_1, +main_AutoColor_1_out_2 = + AutoColor( + main_AutoGlyph_1_out_1, + main_AutoColor_1_in_2, + main_AutoColor_1_in_3, + main_AutoColor_1_in_4, + main_AutoColor_1_in_5, + main_AutoColor_1_in_6, + main_AutoColor_1_in_7, + main_AutoColor_1_in_8, + main_AutoColor_1_in_9, + main_AutoColor_1_in_10 + ) [instance: 1, cache: 1]; + // + // node ColorBar[1]: x = 755, y = 724, inputs = 16, label = ColorBar + // +main_ColorBar_1_out_1 = + ColorBar( + main_AutoColor_1_out_2, + main_ColorBar_1_in_2, + main_ColorBar_1_in_3, + main_ColorBar_1_in_4, + main_ColorBar_1_in_5, + main_ColorBar_1_in_6, + main_ColorBar_1_in_7, + main_ColorBar_1_in_8, + main_ColorBar_1_in_9, + main_ColorBar_1_in_10, + main_ColorBar_1_in_11, + main_ColorBar_1_in_12, + main_ColorBar_1_in_13, + main_ColorBar_1_in_14, + main_ColorBar_1_in_15, + main_ColorBar_1_in_16 + ) [instance: 1, cache: 1]; + // + // node Collect[1]: x = 599, y = 844, inputs = 3, label = Collect + // +main_Collect_1_out_1 = + Collect( + main_Append_1_out_1, + main_AutoColor_1_out_1, + main_ColorBar_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 599, y = 934, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 32, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 3, value = 0 + // depth: value = 24 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Collect_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; + // + // node SetLocal[1]: x = 462, y = 724, inputs = 3, label = SetLocal + // + SetLocal( + main_Append_1_out_1, + main_GetLocal_1_out_2, + main_SetLocal_1_in_3 + ) [instance: 1, cache: 1]; + // + // node SetLocal[2]: x = 792, y = 384, inputs = 3, label = SetLocal + // + SetLocal( + main_Append_2_out_1, + main_GetLocal_2_out_2, + main_SetLocal_2_in_3 + ) [instance: 2, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_CollectMultiGrid_1_in_1 = NULL; +main_CollectMultiGrid_1_in_2 = NULL; +main_CollectMultiGrid_1_in_3 = NULL; +main_CollectMultiGrid_1_in_4 = NULL; +main_CollectMultiGrid_1_out_1 = NULL; +main_StringList_1_out_1 = { "FILELIST" }; +main_ForEachMember_1_out_1 = NULL; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_ShowConnections_1_out_1 = NULL; +main_StringList_2_out_1 = { "COLORLIST" }; +main_ForEachMember_2_out_1 = NULL; +main_Color_1_in_3 = NULL; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +main_GetLocal_1_in_1 = NULL; +main_GetLocal_1_in_2 = NULL; +main_GetLocal_1_in_3 = NULL; +main_GetLocal_1_out_1 = NULL; +main_GetLocal_1_out_2 = NULL; +main_Append_1_in_3 = NULL; +main_Append_1_in_5 = NULL; +main_Append_1_out_1 = NULL; +main_GetLocal_2_in_1 = NULL; +main_GetLocal_2_in_2 = NULL; +main_GetLocal_2_in_3 = NULL; +main_GetLocal_2_out_1 = NULL; +main_GetLocal_2_out_2 = NULL; +main_Append_2_in_3 = NULL; +main_Append_2_in_5 = NULL; +main_Append_2_out_1 = NULL; +main_Sample_1_in_2 = NULL; +main_Sample_1_out_1 = NULL; +main_AutoGlyph_1_in_2 = NULL; +main_AutoGlyph_1_in_3 = NULL; +main_AutoGlyph_1_in_4 = NULL; +main_AutoGlyph_1_in_5 = NULL; +main_AutoGlyph_1_in_6 = NULL; +main_AutoGlyph_1_in_7 = NULL; +main_AutoGlyph_1_out_1 = NULL; +main_AutoColor_1_in_2 = NULL; +main_AutoColor_1_in_3 = NULL; +main_AutoColor_1_in_4 = NULL; +main_AutoColor_1_in_5 = NULL; +main_AutoColor_1_in_6 = NULL; +main_AutoColor_1_in_7 = NULL; +main_AutoColor_1_in_8 = NULL; +main_AutoColor_1_in_9 = NULL; +main_AutoColor_1_in_10 = NULL; +main_AutoColor_1_out_1 = NULL; +main_AutoColor_1_out_2 = NULL; +main_ColorBar_1_in_2 = NULL; +main_ColorBar_1_in_3 = NULL; +main_ColorBar_1_in_4 = NULL; +main_ColorBar_1_in_5 = NULL; +main_ColorBar_1_in_6 = NULL; +main_ColorBar_1_in_7 = NULL; +main_ColorBar_1_in_8 = NULL; +main_ColorBar_1_in_9 = NULL; +main_ColorBar_1_in_10 = NULL; +main_ColorBar_1_in_11 = NULL; +main_ColorBar_1_in_12 = NULL; +main_ColorBar_1_in_13 = NULL; +main_ColorBar_1_in_14 = NULL; +main_ColorBar_1_in_15 = NULL; +main_ColorBar_1_in_16 = NULL; +main_ColorBar_1_out_1 = NULL; +main_Collect_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 0; +main_Image_1_in_5 = NULL; +main_Image_1_in_6 = NULL; +main_Image_1_in_7 = NULL; +main_Image_1_in_8 = NULL; +main_Image_1_in_9 = NULL; +main_Image_1_in_10 = NULL; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = NULL; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = NULL; +main_Image_1_in_18 = NULL; +main_Image_1_in_19 = 0; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = NULL; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = NULL; +main_Image_1_in_26 = NULL; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = NULL; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = NULL; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = NULL; +main_Image_1_in_34 = NULL; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = NULL; +main_Image_1_in_37 = NULL; +main_Image_1_in_38 = NULL; +main_Image_1_in_39 = NULL; +main_Image_1_in_40 = NULL; +main_Image_1_in_41 = NULL; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +main_SetLocal_1_in_3 = NULL; +main_SetLocal_2_in_3 = NULL; +Executive("product version 4 4 4"); +$sync +main(); diff --git a/octave_packages/fpl-1.2.0/FPL2ptcshowmesh.m b/octave_packages/fpl-1.2.0/FPL2ptcshowmesh.m new file mode 100644 index 0000000..c4ceddf --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2ptcshowmesh.m @@ -0,0 +1,80 @@ +## Copyright (C) 2004-2008 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## @deftypefn {Function File} {} FPL2ptcshowmesh (@var{mesh1}, @ +## @var{color1}, @ [@var{mesh2}, @var{color2}, ...]) +## +## Displays two or more 2-D triangulations using opendx +## +## @seealso{FPL2pdeshowmesh} +## @end deftypefn + +function FPL2ptcshowmesh (varargin) + + datalist = ""; + colorlist= ""; + + for ii=1:2:nargin + dataname{ii} = mktemp("/tmp",".dx"); + FPL2dxoutputdata(dataname{ii},varargin{ii}.p,varargin{ii}.t,... + varargin{ii}.p(1,:)','x',0,1,1); + datalist = strcat (datalist, """", dataname{ii} ,""""); + colorlist= strcat (colorlist, """", varargin{ii+1} ,""""); + endfor + + scriptname = mktemp("/tmp",".net"); + + showmesh = file_in_path(path,"FPL2ptcshowmesh.net"); + + system (["cp " showmesh " " scriptname]); + system (["sed -i \'s|""FILELIST""|" datalist "|g\' " scriptname]); + system (["sed -i \'s|""COLORLIST""|" colorlist "|g\' " scriptname]); + + command = ["dx -noConfirmedQuit -program " scriptname " -execute -image >& /dev/null & "]; + system(command); + +endfunction + +function filename = mktemp (direct,ext); + + if (~exist(direct,"dir")) + error("trying to save temporary file to non existing directory") + endif + + done=false; + + while ~done + filename = [direct,"/FPL.",num2str(floor(rand*1e7)),ext]; + if ~exist(filename,"file") + done =true; + endif + endwhile + +endfunction \ No newline at end of file diff --git a/octave_packages/fpl-1.2.0/FPL2ptcshowmesh.net b/octave_packages/fpl-1.2.0/FPL2ptcshowmesh.net new file mode 100644 index 0000000..9e45cf8 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2ptcshowmesh.net @@ -0,0 +1,565 @@ +// +// time: Sun Jan 6 13:50:14 2008 +// +// version: 3.2.0 (format), 4.4.4 (DX) +// +// +// MODULE main +// workspace: width = 489, height = 756 +// layout: snap = 1, width = 10, height = 10, align = CC +// +macro main( +) -> ( +) { + // + // node CollectMultiGrid[1]: x = 55, y = 504, inputs = 4, label = CollectMultiGrid + // +main_CollectMultiGrid_1_out_1 = + CollectMultiGrid( + main_CollectMultiGrid_1_in_1, + main_CollectMultiGrid_1_in_2, + main_CollectMultiGrid_1_in_3, + main_CollectMultiGrid_1_in_4 + ) [instance: 1, cache: 1]; + // + // node StringList[1]: x = 128, y = 34, inputs = 0, label = StringList + // output[1]: visible = 1, type = 16777248, value = { "FILELIST" } + // + // + // node ForEachMember[1]: x = 105, y = 134, inputs = 1, label = ForEachMember + // +main_ForEachMember_1_out_1, +main_ForEachMember_1_out_2, +main_ForEachMember_1_out_3 = + ForEachMember( + main_StringList_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Import[1]: x = 119, y = 244, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_ForEachMember_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 89, y = 354, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_Import_1_out_1 + ) [instance: 1, cache: 1]; + // + // node StringList[2]: x = 278, y = 34, inputs = 0, label = StringList + // output[1]: visible = 1, type = 16777248, value = { "COLORLIST" } + // + // + // node ForEachMember[2]: x = 255, y = 134, inputs = 1, label = ForEachMember + // +main_ForEachMember_2_out_1, +main_ForEachMember_2_out_2, +main_ForEachMember_2_out_3 = + ForEachMember( + main_StringList_2_out_1 + ) [instance: 2, cache: 1]; + // + // node Color[1]: x = 239, y = 454, inputs = 5, label = Color + // +main_Color_1_out_1 = + Color( + main_ShowConnections_1_out_1, + main_ForEachMember_2_out_1, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node GetLocal[1]: x = 422, y = 494, inputs = 3, label = GetLocal + // +main_GetLocal_1_out_1, +main_GetLocal_1_out_2 = + GetLocal( + main_GetLocal_1_in_1, + main_GetLocal_1_in_2, + main_GetLocal_1_in_3 + ) [instance: 1, cache: 1]; + // + // node Append[1]: x = 235, y = 574, inputs = 5, label = Append + // +main_Append_1_out_1 = + Append( + main_CollectMultiGrid_1_out_1, + main_Color_1_out_1, + main_Append_1_in_3, + main_GetLocal_1_out_1, + main_Append_1_in_5 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 249, y = 694, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 32, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 3, value = 0 + // depth: value = 24 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Append_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; + // + // node SetLocal[1]: x = 422, y = 644, inputs = 3, label = SetLocal + // + SetLocal( + main_Append_1_out_1, + main_GetLocal_1_out_2, + main_SetLocal_1_in_3 + ) [instance: 1, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_CollectMultiGrid_1_in_1 = NULL; +main_CollectMultiGrid_1_in_2 = NULL; +main_CollectMultiGrid_1_in_3 = NULL; +main_CollectMultiGrid_1_in_4 = NULL; +main_CollectMultiGrid_1_out_1 = NULL; +main_StringList_1_out_1 = { "FILELIST" }; +main_ForEachMember_1_out_1 = NULL; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_ShowConnections_1_out_1 = NULL; +main_StringList_2_out_1 = { "COLORLIST" }; +main_ForEachMember_2_out_1 = NULL; +main_Color_1_in_3 = NULL; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +main_GetLocal_1_in_1 = NULL; +main_GetLocal_1_in_2 = NULL; +main_GetLocal_1_in_3 = NULL; +main_GetLocal_1_out_1 = NULL; +main_GetLocal_1_out_2 = NULL; +main_Append_1_in_3 = NULL; +main_Append_1_in_5 = NULL; +main_Append_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 0; +main_Image_1_in_5 = NULL; +main_Image_1_in_6 = NULL; +main_Image_1_in_7 = NULL; +main_Image_1_in_8 = NULL; +main_Image_1_in_9 = NULL; +main_Image_1_in_10 = NULL; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = NULL; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = NULL; +main_Image_1_in_18 = NULL; +main_Image_1_in_19 = 0; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = NULL; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = NULL; +main_Image_1_in_26 = NULL; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = NULL; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = NULL; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = NULL; +main_Image_1_in_34 = NULL; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = NULL; +main_Image_1_in_37 = NULL; +main_Image_1_in_38 = NULL; +main_Image_1_in_39 = NULL; +main_Image_1_in_40 = NULL; +main_Image_1_in_41 = NULL; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +main_SetLocal_1_in_3 = NULL; +Executive("product version 4 4 4"); +$sync +main(); diff --git a/octave_packages/fpl-1.2.0/FPL2ptcsurf.m b/octave_packages/fpl-1.2.0/FPL2ptcsurf.m new file mode 100644 index 0000000..2a05991 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2ptcsurf.m @@ -0,0 +1,81 @@ +## Copyright (C) 2004-2008 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## +## @deftypefn {Function File} {} FPL2ptcsurf (@var{mesh1}, @ +## @var{color1}, @var{data1} @ [@var{mesh2}, @var{color2},@var{data2}]) +## +## Plots the scalar fields @var{data} over the triangulation +## @var{mesh} using opendx. Connections will be displayed as defined +## in @var{color}. +## +## @end deftypefn + +function FPL2ptcsurf(varargin) + + colorlist = ""; + datalist = ""; + + for ii=1:3:nargin + dataname{ii} = mktemp("/tmp",".dx"); + FPL2dxoutputdata(dataname{ii},varargin{ii}.p,varargin{ii}.t,varargin{ii+2},"var",0,1,1); + datalist = strcat (datalist, """", dataname{ii} ,""""); + colorlist= strcat (colorlist, """", varargin{ii+1} ,""""); + endfor + + scriptname = mktemp("/tmp",".net"); + + ptcview = file_in_path(path,"FPL2ptcsurf.net"); + + system (["cp " ptcview " " scriptname]); + system (["sed -i \'s|""FILELIST""|" datalist "|g\' " scriptname]); + system (["sed -i \'s|""COLORLIST""|" colorlist "|g\' " scriptname]); + + command = ["dx -noConfirmedQuit -program " scriptname " -execute -image >& /dev/null & "]; + system(command); + +endfunction + +function filename = mktemp (direct,ext); + + if (~exist(direct,"dir")) + error("Trying to save temporary file to non existing directory") + endif + + done = false; + + while ~done + filename = [direct,"/FPL.",num2str(floor(rand*1e7)),ext]; + if ~exist(filename,"file") + done = true; + endif + endwhile + +endfunction \ No newline at end of file diff --git a/octave_packages/fpl-1.2.0/FPL2ptcsurf.net b/octave_packages/fpl-1.2.0/FPL2ptcsurf.net new file mode 100644 index 0000000..952325d --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2ptcsurf.net @@ -0,0 +1,749 @@ +// +// time: Fri Jan 4 17:10:29 2008 +// +// version: 3.2.0 (format), 4.4.4 (DX) +// +// +// MODULE main +// workspace: width = 968, height = 946 +// layout: snap = 1, width = 10, height = 10, align = CC +// +macro main( +) -> ( +) { + // + // node CollectMultiGrid[5]: x = 45, y = 424, inputs = 4, label = CollectMultiGrid + // +main_CollectMultiGrid_5_out_1 = + CollectMultiGrid( + main_CollectMultiGrid_5_in_1, + main_CollectMultiGrid_5_in_2, + main_CollectMultiGrid_5_in_3, + main_CollectMultiGrid_5_in_4 + ) [instance: 5, cache: 1]; + // + // node StringList[1]: x = 178, y = 34, inputs = 0, label = StringList + // output[1]: visible = 1, type = 16777248, value = { "FILELIST" } + // + // + // node ForEachMember[1]: x = 155, y = 124, inputs = 1, label = ForEachMember + // +main_ForEachMember_1_out_1, +main_ForEachMember_1_out_2, +main_ForEachMember_1_out_3 = + ForEachMember( + main_StringList_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Import[2]: x = 169, y = 224, inputs = 6, label = Import + // +main_Import_2_out_1 = + Import( + main_ForEachMember_1_out_1, + main_Import_2_in_2, + main_Import_2_in_3, + main_Import_2_in_4, + main_Import_2_in_5, + main_Import_2_in_6 + ) [instance: 2, cache: 1]; + // + // node ShowConnections[4]: x = 139, y = 324, inputs = 1, label = ShowConnections + // +main_ShowConnections_4_out_1 = + ShowConnections( + main_Import_2_out_1 + ) [instance: 4, cache: 1]; + // + // node StringList[2]: x = 368, y = 34, inputs = 0, label = StringList + // output[1]: visible = 1, type = 16777248, value = { "COLORLIST" } + // + // + // node ForEachMember[2]: x = 345, y = 124, inputs = 1, label = ForEachMember + // +main_ForEachMember_2_out_1, +main_ForEachMember_2_out_2, +main_ForEachMember_2_out_3 = + ForEachMember( + main_StringList_2_out_1 + ) [instance: 2, cache: 1]; + // + // node Color[3]: x = 179, y = 404, inputs = 5, label = Color + // input[3]: defaulting = 0, visible = 1, type = 5, value = .3 + // +main_Color_3_out_1 = + Color( + main_ShowConnections_4_out_1, + main_ForEachMember_2_out_1, + main_Color_3_in_3, + main_Color_3_in_4, + main_Color_3_in_5 + ) [instance: 3, cache: 1]; + // + // node GetLocal[4]: x = 322, y = 404, inputs = 3, label = GetLocal + // +main_GetLocal_4_out_1, +main_GetLocal_4_out_2 = + GetLocal( + main_GetLocal_4_in_1, + main_GetLocal_4_in_2, + main_GetLocal_4_in_3 + ) [instance: 4, cache: 1]; + // + // node Append[1]: x = 185, y = 504, inputs = 5, label = Append + // +main_Append_1_out_1 = + Append( + main_CollectMultiGrid_5_out_1, + main_Color_3_out_1, + main_Append_1_in_3, + main_GetLocal_4_out_1, + main_Append_1_in_5 + ) [instance: 1, cache: 1]; + // + // node CollectMultiGrid[4]: x = 615, y = 454, inputs = 4, label = CollectMultiGrid + // +main_CollectMultiGrid_4_out_1 = + CollectMultiGrid( + main_CollectMultiGrid_4_in_1, + main_CollectMultiGrid_4_in_2, + main_CollectMultiGrid_4_in_3, + main_CollectMultiGrid_4_in_4 + ) [instance: 4, cache: 1]; + // + // node GetLocal[5]: x = 872, y = 394, inputs = 3, label = GetLocal + // +main_GetLocal_5_out_1, +main_GetLocal_5_out_2 = + GetLocal( + main_GetLocal_5_in_1, + main_GetLocal_5_in_2, + main_GetLocal_5_in_3 + ) [instance: 5, cache: 1]; + // + // node Append[2]: x = 765, y = 514, inputs = 5, label = Append + // +main_Append_2_out_1 = + Append( + main_CollectMultiGrid_4_out_1, + main_Import_2_out_1, + main_Append_2_in_3, + main_GetLocal_5_out_1, + main_Append_2_in_5 + ) [instance: 2, cache: 1]; + // + // node AutoColor[2]: x = 736, y = 604, inputs = 10, label = AutoColor + // input[8]: visible = 1 + // +main_AutoColor_2_out_1, +main_AutoColor_2_out_2 = + AutoColor( + main_Append_2_out_1, + main_AutoColor_2_in_2, + main_AutoColor_2_in_3, + main_AutoColor_2_in_4, + main_AutoColor_2_in_5, + main_AutoColor_2_in_6, + main_AutoColor_2_in_7, + main_AutoColor_2_in_8, + main_AutoColor_2_in_9, + main_AutoColor_2_in_10 + ) [instance: 2, cache: 1]; + // + // node RubberSheet[1]: x = 176, y = 624, inputs = 4, label = RubberSheet + // +main_RubberSheet_1_out_1 = + RubberSheet( + main_Append_1_out_1, + main_RubberSheet_1_in_2, + main_RubberSheet_1_in_3, + main_RubberSheet_1_in_4 + ) [instance: 1, cache: 1]; + // + // node Shade[1]: x = 599, y = 654, inputs = 8, label = Shade + // input[2]: defaulting = 0, visible = 1, type = 3, value = 1 + // input[3]: defaulting = 0, visible = 1, type = 32, value = "smooth" + // +main_Shade_1_out_1 = + Shade( + main_AutoColor_2_out_1, + main_Shade_1_in_2, + main_Shade_1_in_3, + main_Shade_1_in_4, + main_Shade_1_in_5, + main_Shade_1_in_6, + main_Shade_1_in_7, + main_Shade_1_in_8 + ) [instance: 1, cache: 1]; + // + // node RubberSheet[2]: x = 526, y = 734, inputs = 4, label = RubberSheet + // +main_RubberSheet_2_out_1 = + RubberSheet( + main_Shade_1_out_1, + main_RubberSheet_2_in_2, + main_RubberSheet_2_in_3, + main_RubberSheet_2_in_4 + ) [instance: 2, cache: 1]; + // + // node ColorBar[1]: x = 755, y = 734, inputs = 16, label = ColorBar + // input[4]: defaulting = 0, visible = 1, type = 3, value = 1 + // +main_ColorBar_1_out_1 = + ColorBar( + main_AutoColor_2_out_2, + main_ColorBar_1_in_2, + main_ColorBar_1_in_3, + main_ColorBar_1_in_4, + main_ColorBar_1_in_5, + main_ColorBar_1_in_6, + main_ColorBar_1_in_7, + main_ColorBar_1_in_8, + main_ColorBar_1_in_9, + main_ColorBar_1_in_10, + main_ColorBar_1_in_11, + main_ColorBar_1_in_12, + main_ColorBar_1_in_13, + main_ColorBar_1_in_14, + main_ColorBar_1_in_15, + main_ColorBar_1_in_16 + ) [instance: 1, cache: 1]; + // + // node Collect[1]: x = 349, y = 774, inputs = 3, label = Collect + // +main_Collect_1_out_1 = + Collect( + main_RubberSheet_1_out_1, + main_RubberSheet_2_out_1, + main_ColorBar_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Image[5]: x = 339, y = 884, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 32, value = "Image_5" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 3, value = 0 + // depth: value = 24 + // internal caching: 1 + // +main_Image_5_out_1, +main_Image_5_out_2, +main_Image_5_out_3 = + Image( + main_Image_5_in_1, + main_Collect_1_out_1, + main_Image_5_in_3, + main_Image_5_in_4, + main_Image_5_in_5, + main_Image_5_in_6, + main_Image_5_in_7, + main_Image_5_in_8, + main_Image_5_in_9, + main_Image_5_in_10, + main_Image_5_in_11, + main_Image_5_in_12, + main_Image_5_in_13, + main_Image_5_in_14, + main_Image_5_in_15, + main_Image_5_in_16, + main_Image_5_in_17, + main_Image_5_in_18, + main_Image_5_in_19, + main_Image_5_in_20, + main_Image_5_in_21, + main_Image_5_in_22, + main_Image_5_in_23, + main_Image_5_in_24, + main_Image_5_in_25, + main_Image_5_in_26, + main_Image_5_in_27, + main_Image_5_in_28, + main_Image_5_in_29, + main_Image_5_in_30, + main_Image_5_in_31, + main_Image_5_in_32, + main_Image_5_in_33, + main_Image_5_in_34, + main_Image_5_in_35, + main_Image_5_in_36, + main_Image_5_in_37, + main_Image_5_in_38, + main_Image_5_in_39, + main_Image_5_in_40, + main_Image_5_in_41, + main_Image_5_in_42, + main_Image_5_in_43, + main_Image_5_in_44, + main_Image_5_in_45, + main_Image_5_in_46, + main_Image_5_in_47, + main_Image_5_in_48, + main_Image_5_in_49 + ) [instance: 5, cache: 1]; + // + // node SetLocal[4]: x = 322, y = 514, inputs = 3, label = SetLocal + // + SetLocal( + main_Append_1_out_1, + main_GetLocal_4_out_2, + main_SetLocal_4_in_3 + ) [instance: 4, cache: 1]; + // + // node SetLocal[5]: x = 902, y = 514, inputs = 3, label = SetLocal + // + SetLocal( + main_Append_2_out_1, + main_GetLocal_5_out_2, + main_SetLocal_5_in_3 + ) [instance: 5, cache: 1]; +// network: end of macro body +CacheScene(main_Image_5_in_1, main_Image_5_out_1, main_Image_5_out_2); +} +main_CollectMultiGrid_5_in_1 = NULL; +main_CollectMultiGrid_5_in_2 = NULL; +main_CollectMultiGrid_5_in_3 = NULL; +main_CollectMultiGrid_5_in_4 = NULL; +main_CollectMultiGrid_5_out_1 = NULL; +main_StringList_1_out_1 = { "FILELIST" }; +main_ForEachMember_1_out_1 = NULL; +main_Import_2_in_2 = NULL; +main_Import_2_in_3 = NULL; +main_Import_2_in_4 = NULL; +main_Import_2_in_5 = NULL; +main_Import_2_in_6 = NULL; +main_Import_2_out_1 = NULL; +main_ShowConnections_4_out_1 = NULL; +main_StringList_2_out_1 = { "COLORLIST" }; +main_ForEachMember_2_out_1 = NULL; +main_Color_3_in_3 = .3; +main_Color_3_in_4 = NULL; +main_Color_3_in_5 = NULL; +main_Color_3_out_1 = NULL; +main_GetLocal_4_in_1 = NULL; +main_GetLocal_4_in_2 = NULL; +main_GetLocal_4_in_3 = NULL; +main_GetLocal_4_out_1 = NULL; +main_GetLocal_4_out_2 = NULL; +main_Append_1_in_3 = NULL; +main_Append_1_in_5 = NULL; +main_Append_1_out_1 = NULL; +main_CollectMultiGrid_4_in_1 = NULL; +main_CollectMultiGrid_4_in_2 = NULL; +main_CollectMultiGrid_4_in_3 = NULL; +main_CollectMultiGrid_4_in_4 = NULL; +main_CollectMultiGrid_4_out_1 = NULL; +main_GetLocal_5_in_1 = NULL; +main_GetLocal_5_in_2 = NULL; +main_GetLocal_5_in_3 = NULL; +main_GetLocal_5_out_1 = NULL; +main_GetLocal_5_out_2 = NULL; +main_Append_2_in_3 = NULL; +main_Append_2_in_5 = NULL; +main_Append_2_out_1 = NULL; +main_AutoColor_2_in_2 = NULL; +main_AutoColor_2_in_3 = NULL; +main_AutoColor_2_in_4 = NULL; +main_AutoColor_2_in_5 = NULL; +main_AutoColor_2_in_6 = NULL; +main_AutoColor_2_in_7 = NULL; +main_AutoColor_2_in_8 = NULL; +main_AutoColor_2_in_9 = NULL; +main_AutoColor_2_in_10 = NULL; +main_AutoColor_2_out_1 = NULL; +main_AutoColor_2_out_2 = NULL; +main_RubberSheet_1_in_2 = NULL; +main_RubberSheet_1_in_3 = NULL; +main_RubberSheet_1_in_4 = NULL; +main_RubberSheet_1_out_1 = NULL; +main_Shade_1_in_2 = 1; +main_Shade_1_in_3 = "smooth"; +main_Shade_1_in_4 = NULL; +main_Shade_1_in_5 = NULL; +main_Shade_1_in_6 = NULL; +main_Shade_1_in_7 = NULL; +main_Shade_1_in_8 = NULL; +main_Shade_1_out_1 = NULL; +main_RubberSheet_2_in_2 = NULL; +main_RubberSheet_2_in_3 = NULL; +main_RubberSheet_2_in_4 = NULL; +main_RubberSheet_2_out_1 = NULL; +main_ColorBar_1_in_2 = NULL; +main_ColorBar_1_in_3 = NULL; +main_ColorBar_1_in_4 = 1; +main_ColorBar_1_in_5 = NULL; +main_ColorBar_1_in_6 = NULL; +main_ColorBar_1_in_7 = NULL; +main_ColorBar_1_in_8 = NULL; +main_ColorBar_1_in_9 = NULL; +main_ColorBar_1_in_10 = NULL; +main_ColorBar_1_in_11 = NULL; +main_ColorBar_1_in_12 = NULL; +main_ColorBar_1_in_13 = NULL; +main_ColorBar_1_in_14 = NULL; +main_ColorBar_1_in_15 = NULL; +main_ColorBar_1_in_16 = NULL; +main_ColorBar_1_out_1 = NULL; +main_Collect_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_5_in_1 = "Image_5"; +main_Image_5_in_3 = "X24,,"; +main_Image_5_in_4 = 0; +main_Image_5_in_5 = NULL; +main_Image_5_in_6 = NULL; +main_Image_5_in_7 = NULL; +main_Image_5_in_8 = NULL; +main_Image_5_in_9 = NULL; +main_Image_5_in_10 = NULL; +main_Image_5_in_11 = NULL; +main_Image_5_in_12 = NULL; +main_Image_5_in_13 = NULL; +main_Image_5_in_14 = 1; +main_Image_5_in_15 = NULL; +main_Image_5_in_16 = NULL; +main_Image_5_in_17 = NULL; +main_Image_5_in_18 = NULL; +main_Image_5_in_19 = 0; +main_Image_5_in_20 = NULL; +main_Image_5_in_21 = NULL; +main_Image_5_in_22 = NULL; +main_Image_5_in_23 = NULL; +main_Image_5_in_25 = NULL; +main_Image_5_in_26 = NULL; +main_Image_5_in_27 = NULL; +main_Image_5_in_28 = NULL; +main_Image_5_in_29 = NULL; +main_Image_5_in_30 = NULL; +main_Image_5_in_31 = NULL; +main_Image_5_in_32 = NULL; +main_Image_5_in_33 = NULL; +main_Image_5_in_34 = NULL; +main_Image_5_in_35 = NULL; +main_Image_5_in_36 = NULL; +main_Image_5_in_37 = NULL; +main_Image_5_in_38 = NULL; +main_Image_5_in_39 = NULL; +main_Image_5_in_40 = NULL; +main_Image_5_in_41 = NULL; +main_Image_5_in_42 = NULL; +main_Image_5_in_43 = NULL; +main_Image_5_in_44 = NULL; +main_Image_5_in_45 = NULL; +main_Image_5_in_46 = NULL; +main_Image_5_in_47 = NULL; +main_Image_5_in_48 = NULL; +main_Image_5_in_49 = NULL; +main_SetLocal_4_in_3 = NULL; +main_SetLocal_5_in_3 = NULL; +Executive("product version 4 4 4"); +$sync +main(); diff --git a/octave_packages/fpl-1.2.0/FPL2showmesh.net b/octave_packages/fpl-1.2.0/FPL2showmesh.net new file mode 100644 index 0000000..cd89e0f --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2showmesh.net @@ -0,0 +1,587 @@ +// +// time: Wed Jun 27 18:36:54 2007 +// +// version: 3.2.0 (format), 4.4.4 (DX) +// +// +// MODULE main +// workspace: width = 464, height = 625 +// layout: snap = 0, width = 50, height = 50, align = NN +// +macro main( +) -> ( +) { + // + // node Collect[1]: x = 409, y = 272, inputs = 2, label = Collect + // +main_Collect_1_out_1 = + Collect( + main_Collect_1_in_1, + main_Collect_1_in_2 + ) [instance: 1, cache: 1]; + // + // node GetLocal[1]: x = 308, y = 381, inputs = 3, label = GetLocal + // +main_GetLocal_1_out_1, +main_GetLocal_1_out_2 = + GetLocal( + main_Collect_1_out_1, + main_GetLocal_1_in_2, + main_GetLocal_1_in_3 + ) [instance: 1, cache: 1]; + // + // node StringList[1]: x = 42, y = 74, inputs = 0, label = StringList + // output[1]: visible = 1, type = 16777248, value = {__FILE__DX__ } + // + // + // node ForEachMember[1]: x = 28, y = 151, inputs = 1, label = ForEachMember + // +main_ForEachMember_1_out_1, +main_ForEachMember_1_out_2, +main_ForEachMember_1_out_3 = + ForEachMember( + main_StringList_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Import[1]: x = 40, y = 234, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_ForEachMember_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node StringList[2]: x = 215, y = 61, inputs = 0, label = StringList + // output[1]: visible = 1, type = 16777248, value = { __MESH__COLOR__ } + // + // + // node ForEachMember[2]: x = 198, y = 159, inputs = 1, label = ForEachMember + // +main_ForEachMember_2_out_1, +main_ForEachMember_2_out_2, +main_ForEachMember_2_out_3 = + ForEachMember( + main_StringList_2_out_1 + ) [instance: 2, cache: 1]; + // + // node Color[1]: x = 179, y = 312, inputs = 5, label = Color + // input[2]: defaulting = 1, visible = 1, type = 32, value = "indianred" + // +main_Color_1_out_1 = + Color( + main_Import_1_out_1, + main_ForEachMember_2_out_1, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 31, y = 354, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_Color_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Append[1]: x = 60, y = 453, inputs = 5, label = Append + // +main_Append_1_out_1 = + Append( + main_GetLocal_1_out_1, + main_ShowConnections_1_out_1, + main_Append_1_in_3, + main_Append_1_in_4, + main_Append_1_in_5 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 153, y = 563, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 67108863, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[5]: defaulting = 0, visible = 0, type = 8, value = [7.5 7.5 0] + // input[6]: defaulting = 0, visible = 0, type = 8, value = [7.5 7.5 39.3199] + // input[7]: defaulting = 0, visible = 0, type = 5, value = 21.0715 + // input[8]: defaulting = 0, visible = 0, type = 1, value = 804 + // input[9]: defaulting = 0, visible = 0, type = 5, value = 0.610075 + // input[10]: defaulting = 0, visible = 0, type = 8, value = [0 1 0] + // input[11]: defaulting = 1, visible = 0, type = 5, value = 30.0 + // input[12]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[15]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[16]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[17]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[18]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[22]: defaulting = 0, visible = 0, type = 32, value = "snow" + // input[25]: defaulting = 0, visible = 0, type = 32, value = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/grid.tif" + // input[26]: defaulting = 0, visible = 0, type = 32, value = "tiff" + // input[29]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[31]: defaulting = 0, visible = 0, type = 1, value = -15 + // input[33]: defaulting = 0, visible = 0, type = 3, value = 0 + // input[34]: defaulting = 0, visible = 0, type = 3, value = 0 + // input[37]: defaulting = 0, visible = 0, type = 16777248, value = {"clear", "grey5", "saddlebrown", "saddlebrown"} + // input[38]: defaulting = 0, visible = 0, type = 16777248, value = {"background", "grid", "ticks", "labels"} + // input[39]: defaulting = 0, visible = 0, type = 5, value = 0.7 + // input[40]: defaulting = 0, visible = 0, type = 32, value = "roman_s" + // input[41]: defaulting = 0, visible = 0, type = 32, value = "none" + // depth: value = 24 + // window: position = (0.2477,0.1272), size = 0.6391x0.6838, screen = 0 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Append_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; + // + // node SetLocal[1]: x = 316, y = 471, inputs = 3, label = SetLocal + // + SetLocal( + main_Append_1_out_1, + main_GetLocal_1_out_2, + main_SetLocal_1_in_3 + ) [instance: 1, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_Collect_1_in_1 = NULL; +main_Collect_1_in_2 = NULL; +main_Collect_1_out_1 = NULL; +main_GetLocal_1_in_2 = NULL; +main_GetLocal_1_in_3 = NULL; +main_GetLocal_1_out_1 = NULL; +main_GetLocal_1_out_2 = NULL; +main_StringList_1_out_1 = {__FILE__DX__}; +main_ForEachMember_1_out_1 = NULL; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_StringList_2_out_1 = {__MESH__COLOR__ }; +main_ForEachMember_2_out_1 = NULL; +main_Color_1_in_3 = NULL; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +main_ShowConnections_1_out_1 = NULL; +main_Append_1_in_3 = NULL; +main_Append_1_in_4 = NULL; +main_Append_1_in_5 = NULL; +main_Append_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 1; +main_Image_1_in_5 = [7.5 7.5 0]; +main_Image_1_in_6 = [7.5 7.5 39.3199]; +main_Image_1_in_7 = 21.0715; +main_Image_1_in_8 = 804; +main_Image_1_in_9 = 0.610075; +main_Image_1_in_10 = [0 1 0]; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = 0; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = 1; +main_Image_1_in_18 = 1; +main_Image_1_in_19 = 1; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = "snow"; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/grid.tif"; +main_Image_1_in_26 = "tiff"; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = 1; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = -15; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = 0; +main_Image_1_in_34 = 0; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = NULL; +main_Image_1_in_37 = {"clear", "grey5", "saddlebrown", "saddlebrown"}; +main_Image_1_in_38 = {"background", "grid", "ticks", "labels"}; +main_Image_1_in_39 = 0.7; +main_Image_1_in_40 = "roman_s"; +main_Image_1_in_41 = "none"; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +main_SetLocal_1_in_3 = NULL; +Executive("product version 4 4 4"); +$sync +main(); diff --git a/octave_packages/fpl-1.2.0/FPL2trspdesurf.m b/octave_packages/fpl-1.2.0/FPL2trspdesurf.m new file mode 100644 index 0000000..174c928 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2trspdesurf.m @@ -0,0 +1,83 @@ +## Copyright (C) 2004-2008 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## @deftypefn {Function File} {} FPL2trspdesurf (@var{mesh}, @ +## @var{color}, @var{data}) +## +## Plots the transient scalar field @var{u} defined on the triangulation +## @var{mesh} using opendx. Connections are rendered as defined by +## @var{color} +## +## Example: +## @example +## +## FPL2trspdesurf(mesh,"blue",data) +## +## @end example +## @seealso{FPL2pdesurf, FPL2ptcsurf, FPL2trsptcsurf} +## @end deftypefn + +function FPL2trspdesurf(varargin) + + seriesend = columns(varargin{3}); + dataname = mktemp("/tmp",".dx"); + colorname = varargin{2}; + FPL2dxoutputtimeseries(dataname, varargin{1}.p, varargin{1}.t, \ + varargin{3}, "dataseries", 0, 1, 1:seriesend); + + scriptname = mktemp("/tmp",".net"); + + view = file_in_path(path,"FPL2trspdesurf.net"); + + system (["cp " view " " scriptname]); + system (["sed -i \'s|FILENAME|" dataname "|g\' " scriptname]); + system (["sed -i \'s|COLORNAME|" colorname "|g\' " scriptname]); + + command = ["dx -noConfirmedQuit -program " scriptname " -execute -image >& /dev/null & "]; + system(command); + +endfunction + +function filename = mktemp (direct,ext); + + if (~exist(direct,"dir")) + error("Trying to save temporary file to non existing directory") + endif + + done = false; + + while ~done + filename = [direct,"/FPL.",num2str(floor(rand*1e7)),ext]; + if ~exist(filename,"file") + done = true; + endif + endwhile + +endfunction \ No newline at end of file diff --git a/octave_packages/fpl-1.2.0/FPL2trspdesurf.net b/octave_packages/fpl-1.2.0/FPL2trspdesurf.net new file mode 100644 index 0000000..cb582f1 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2trspdesurf.net @@ -0,0 +1,702 @@ +// +// time: Sat Jan 5 19:47:19 2008 +// +// version: 3.2.0 (format), 4.4.4 (DX) +// +// +// MODULE main +// workspace: width = 1161, height = 826 +// layout: snap = 1, width = 10, height = 10, align = CC +// +macro main( +) -> ( +) { + // + // node String[1]: x = 281, y = 24, inputs = 0, label = String + // output[1]: visible = 1, type = 32, value = "FILENAME" + // + // + // node Import[1]: x = 269, y = 114, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_String_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node Value[1]: x = 513, y = 104, inputs = 0, label = Value + // output[1]: visible = 1, type = 29, value = 0 + // + // + // node Inquire[1]: x = 509, y = 24, inputs = 3, label = Inquire + // input[2]: defaulting = 0, visible = 1, type = 32, value = "member count" + // +main_Inquire_1_out_1 = + Inquire( + main_Import_1_out_1, + main_Inquire_1_in_2, + main_Inquire_1_in_3 + ) [instance: 1, cache: 1]; + // + // node Value[2]: x = 643, y = 4, inputs = 0, label = Value + // output[1]: visible = 1, type = 29, value = 1 + // + // + // node Compute[1]: x = 601, y = 94, inputs = 3, label = Compute + // input[1]: defaulting = 0, visible = 0, type = 32, value = "$0 - $1" + // expression: value = a - b + // name[2]: value = a + // name[3]: value = b + // +main_Compute_1_out_1 = + Compute( + main_Compute_1_in_1, + main_Inquire_1_out_1, + main_Value_2_out_1 + ) [instance: 1, cache: 1]; + // + // node Sequencer[1]: x = 585, y = 184, inputs = 7, label = Sequencer + // input[1]: defaulting = 0, visible = 0, type = 32, value = "Sequencer_1" + // input[4]: defaulting = 1, visible = 1, type = 1, value = 0 + // input[5]: defaulting = 1, visible = 1, type = 1, value = 95 + // input[6]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[7]: defaulting = 0, visible = 0, type = 16777217, value = { 0 95 1 0 95 1 } + // vcr[1]: min = 0, max = 95, beg = 0, end = 95, cur = 38, inc = 1, loop = off, step = off, pal = off + // window: position = (0.0132,0.0833), size = 0.1750x0.0667 + // + main_Sequencer_1_in_3 = @frame; +main_Sequencer_1_out_1[cache: 2] = + Sequencer( + main_Sequencer_1_in_1, + main_Sequencer_1_in_2, + main_Sequencer_1_in_3, + main_Value_1_out_1, + main_Compute_1_out_1, + main_Sequencer_1_in_6, + main_Sequencer_1_in_7 + ) [instance: 1, cache: 1]; + // + // node Select[1]: x = 411, y = 214, inputs = 3, label = Select + // +main_Select_1_out_1 = + Select( + main_Import_1_out_1, + main_Sequencer_1_out_1, + main_Select_1_in_3 + ) [instance: 1, cache: 1]; + // + // node RubberSheet[3]: x = 406, y = 364, inputs = 4, label = RubberSheet + // +main_RubberSheet_3_out_1 = + RubberSheet( + main_Select_1_out_1, + main_RubberSheet_3_in_2, + main_RubberSheet_3_in_3, + main_RubberSheet_3_in_4 + ) [instance: 3, cache: 1]; + // + // node Statistics[4]: x = 185, y = 234, inputs = 1, label = Statistics + // +main_Statistics_4_out_1, +main_Statistics_4_out_2, +main_Statistics_4_out_3, +main_Statistics_4_out_4, +main_Statistics_4_out_5 = + Statistics( + main_Import_1_out_1 + ) [instance: 4, cache: 1]; + // + // node AutoColor[1]: x = 336, y = 474, inputs = 10, label = AutoColor + // input[8]: visible = 1 + // +main_AutoColor_1_out_1, +main_AutoColor_1_out_2 = + AutoColor( + main_RubberSheet_3_out_1, + main_AutoColor_1_in_2, + main_AutoColor_1_in_3, + main_AutoColor_1_in_4, + main_AutoColor_1_in_5, + main_AutoColor_1_in_6, + main_Statistics_4_out_4, + main_Statistics_4_out_5, + main_AutoColor_1_in_9, + main_AutoColor_1_in_10 + ) [instance: 1, cache: 1]; + // + // node Shade[2]: x = 299, y = 574, inputs = 8, label = Shade + // input[3]: defaulting = 0, visible = 1, type = 32, value = "smooth" + // +main_Shade_2_out_1 = + Shade( + main_AutoColor_1_out_1, + main_Shade_2_in_2, + main_Shade_2_in_3, + main_Shade_2_in_4, + main_Shade_2_in_5, + main_Shade_2_in_6, + main_Shade_2_in_7, + main_Shade_2_in_8 + ) [instance: 2, cache: 1]; + // + // node ColorBar[1]: x = 775, y = 574, inputs = 16, label = ColorBar + // input[4]: defaulting = 0, visible = 1, type = 3, value = 1 + // +main_ColorBar_1_out_1 = + ColorBar( + main_AutoColor_1_out_2, + main_ColorBar_1_in_2, + main_ColorBar_1_in_3, + main_ColorBar_1_in_4, + main_ColorBar_1_in_5, + main_ColorBar_1_in_6, + main_ColorBar_1_in_7, + main_ColorBar_1_in_8, + main_ColorBar_1_in_9, + main_ColorBar_1_in_10, + main_ColorBar_1_in_11, + main_ColorBar_1_in_12, + main_ColorBar_1_in_13, + main_ColorBar_1_in_14, + main_ColorBar_1_in_15, + main_ColorBar_1_in_16 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 869, y = 474, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_RubberSheet_3_out_1 + ) [instance: 1, cache: 1]; + // + // node String[2]: x = 1091, y = 474, inputs = 0, label = String + // output[1]: visible = 1, type = 32, value = "COLORNAME" + // + // + // node Color[1]: x = 929, y = 574, inputs = 5, label = Color + // input[3]: defaulting = 0, visible = 1, type = 5, value = .3 + // +main_Color_1_out_1 = + Color( + main_ShowConnections_1_out_1, + main_String_2_out_1, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node Collect[1]: x = 799, y = 684, inputs = 3, label = Collect + // +main_Collect_1_out_1 = + Collect( + main_Shade_2_out_1, + main_ColorBar_1_out_1, + main_Color_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 1089, y = 764, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 32, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 3, value = 0 + // depth: value = 24 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Collect_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_String_1_out_1 = "FILENAME"; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_Value_1_out_1 = 0; +main_Inquire_1_in_2 = "member count"; +main_Inquire_1_in_3 = NULL; +main_Inquire_1_out_1 = NULL; +main_Value_2_out_1 = 1; +main_Compute_1_in_1 = "$0 - $1"; +main_Compute_1_out_1 = NULL; +main_Sequencer_1_in_1 = "Sequencer_1"; +main_Sequencer_1_in_2 = NULL; +main_Sequencer_1_in_3 = NULL; +main_Sequencer_1_in_6 = NULL; +main_Sequencer_1_in_7 = { 0 95 1 0 95 1 }; +main_Sequencer_1_out_1 = NULL; + +@startframe = 0; +@nextframe = @startframe; +@endframe = 95; +@deltaframe = 1; +main_Select_1_in_3 = NULL; +main_Select_1_out_1 = NULL; +main_RubberSheet_3_in_2 = NULL; +main_RubberSheet_3_in_3 = NULL; +main_RubberSheet_3_in_4 = NULL; +main_RubberSheet_3_out_1 = NULL; +main_Statistics_4_out_4 = NULL; +main_Statistics_4_out_5 = NULL; +main_AutoColor_1_in_2 = NULL; +main_AutoColor_1_in_3 = NULL; +main_AutoColor_1_in_4 = NULL; +main_AutoColor_1_in_5 = NULL; +main_AutoColor_1_in_6 = NULL; +main_AutoColor_1_in_9 = NULL; +main_AutoColor_1_in_10 = NULL; +main_AutoColor_1_out_1 = NULL; +main_AutoColor_1_out_2 = NULL; +main_Shade_2_in_2 = NULL; +main_Shade_2_in_3 = "smooth"; +main_Shade_2_in_4 = NULL; +main_Shade_2_in_5 = NULL; +main_Shade_2_in_6 = NULL; +main_Shade_2_in_7 = NULL; +main_Shade_2_in_8 = NULL; +main_Shade_2_out_1 = NULL; +main_ColorBar_1_in_2 = NULL; +main_ColorBar_1_in_3 = NULL; +main_ColorBar_1_in_4 = 1; +main_ColorBar_1_in_5 = NULL; +main_ColorBar_1_in_6 = NULL; +main_ColorBar_1_in_7 = NULL; +main_ColorBar_1_in_8 = NULL; +main_ColorBar_1_in_9 = NULL; +main_ColorBar_1_in_10 = NULL; +main_ColorBar_1_in_11 = NULL; +main_ColorBar_1_in_12 = NULL; +main_ColorBar_1_in_13 = NULL; +main_ColorBar_1_in_14 = NULL; +main_ColorBar_1_in_15 = NULL; +main_ColorBar_1_in_16 = NULL; +main_ColorBar_1_out_1 = NULL; +main_ShowConnections_1_out_1 = NULL; +main_String_2_out_1 = "COLORNAME"; +main_Color_1_in_3 = .3; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +main_Collect_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 0; +main_Image_1_in_5 = NULL; +main_Image_1_in_6 = NULL; +main_Image_1_in_7 = NULL; +main_Image_1_in_8 = NULL; +main_Image_1_in_9 = NULL; +main_Image_1_in_10 = NULL; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = NULL; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = NULL; +main_Image_1_in_18 = NULL; +main_Image_1_in_19 = 0; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = NULL; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = NULL; +main_Image_1_in_26 = NULL; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = NULL; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = NULL; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = NULL; +main_Image_1_in_34 = NULL; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = NULL; +main_Image_1_in_37 = NULL; +main_Image_1_in_38 = NULL; +main_Image_1_in_39 = NULL; +main_Image_1_in_40 = NULL; +main_Image_1_in_41 = NULL; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +Executive("product version 4 4 4"); +$sync + +sequence main(); +play; diff --git a/octave_packages/fpl-1.2.0/FPL2trsptcsurf.m b/octave_packages/fpl-1.2.0/FPL2trsptcsurf.m new file mode 100644 index 0000000..4925766 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2trsptcsurf.m @@ -0,0 +1,90 @@ +## Copyright (C) 2004-2008 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## @deftypefn {Function File} {} FPL2trsptcsurf (@var{mesh1}, @ +## @var{color1}, @var{data1}, [@var{mesh2}, @var{color2}, @var{data2}]) +## +## Plots the transient scalar fields @var{data} defined on the triangulation +## @var{mesh} using opendx. Connections are rendered as defined by +## @var{color} +## +## Example: +## @example +## +## FPL2trspdesurf(mesh1,"blue",data1, mesh2,"red",data2) +## +## @end example +## @seealso{FPL2pdesurf, FPL2ptcsurf, FPL2trspdesurf} +## @end deftypefn + +function FPL2trsptcsurf(varargin) + + datalist = ""; + colorlist = ""; + + for ii = 1:3:nargin + seriesend = columns(varargin{ii+2}); + dataname = mktemp("/tmp",".dx"); + colorname = varargin{ii+1}; + FPL2dxoutputtimeseries(dataname, varargin{ii}.p, varargin{ii}.t, \ + varargin{ii+2}, "dataseries", 0, 1, \ + 1:seriesend); + datalist = strcat(datalist, """", dataname ,""""); + colorlist = strcat(colorlist, """", colorname, """"); + endfor + + scriptname = mktemp("/tmp",".net"); + + view = file_in_path(path,"FPL2trsptcsurf.net"); + + system (["cp " view " " scriptname]); + system (["sed -i \'s|""FILELIST""|" datalist "|g\' " scriptname]); + system (["sed -i \'s|""COLORLIST""|" colorlist "|g\' " scriptname]); + + command = ["dx -noConfirmedQuit -program " scriptname " -execute -image >& /dev/null & "]; + system(command); +endfunction + +function filename = mktemp (direct,ext); + + if (~exist(direct,"dir")) + error("Trying to save temporary file to non existing directory") + endif + + done = false; + + while ~done + filename = [direct,"/FPL.",num2str(floor(rand*1e7)),ext]; + if ~exist(filename,"file") + done = true; + endif + endwhile + +endfunction \ No newline at end of file diff --git a/octave_packages/fpl-1.2.0/FPL2trsptcsurf.net b/octave_packages/fpl-1.2.0/FPL2trsptcsurf.net new file mode 100644 index 0000000..f9571bb --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2trsptcsurf.net @@ -0,0 +1,923 @@ +// +// time: Sun Jan 6 17:08:01 2008 +// +// version: 3.2.0 (format), 4.4.4 (DX) +// +// +// MODULE main +// workspace: width = 1098, height = 1006 +// layout: snap = 1, width = 10, height = 10, align = CC +// +macro main( +) -> ( +) { + // + // node CollectMultiGrid[1]: x = 425, y = 404, inputs = 4, label = CollectMultiGrid + // input[1]: defaulting = 0, visible = 1, type = 67108863, value = NULL + // input[3]: defaulting = 0, visible = 1, type = 67108863, value = NULL + // +main_CollectMultiGrid_1_out_1 = + CollectMultiGrid( + main_CollectMultiGrid_1_in_1, + main_CollectMultiGrid_1_in_2, + main_CollectMultiGrid_1_in_3, + main_CollectMultiGrid_1_in_4 + ) [instance: 1, cache: 1]; + // + // node StringList[1]: x = 178, y = 24, inputs = 0, label = StringList + // output[1]: visible = 1, type = 16777248, value = { "FILELIST" } + // + // + // node ForEachMember[1]: x = 155, y = 124, inputs = 1, label = ForEachMember + // +main_ForEachMember_1_out_1, +main_ForEachMember_1_out_2, +main_ForEachMember_1_out_3 = + ForEachMember( + main_StringList_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Import[1]: x = 159, y = 224, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_ForEachMember_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node Value[1]: x = 993, y = 294, inputs = 0, label = Value + // output[1]: visible = 1, type = 29, value = 0 + // + // + // node Inquire[1]: x = 879, y = 294, inputs = 3, label = Inquire + // input[2]: defaulting = 0, visible = 1, type = 32, value = "member count" + // +main_Inquire_1_out_1 = + Inquire( + main_Import_1_out_1, + main_Inquire_1_in_2, + main_Inquire_1_in_3 + ) [instance: 1, cache: 1]; + // + // node Value[2]: x = 1053, y = 74, inputs = 0, label = Value + // output[1]: visible = 1, type = 29, value = 1 + // + // + // node Compute[1]: x = 1021, y = 164, inputs = 3, label = Compute + // input[1]: defaulting = 0, visible = 0, type = 32, value = "$0 - $1" + // expression: value = a - b + // name[2]: value = a + // name[3]: value = b + // +main_Compute_1_out_1 = + Compute( + main_Compute_1_in_1, + main_Inquire_1_out_1, + main_Value_2_out_1 + ) [instance: 1, cache: 1]; + // + // node Sequencer[1]: x = 995, y = 394, inputs = 7, label = Sequencer + // input[1]: defaulting = 0, visible = 0, type = 32, value = "Sequencer_1" + // input[4]: defaulting = 1, visible = 1, type = 1, value = 0 + // input[5]: defaulting = 1, visible = 1, type = 1, value = 95 + // input[6]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[7]: defaulting = 0, visible = 0, type = 16777217, value = { 0 95 1 0 95 1 } + // vcr[1]: min = 0, max = 95, beg = 0, end = 95, cur = 38, inc = 1, loop = off, step = off, pal = off + // window: position = (0.0132,0.0833), size = 0.1750x0.0667 + // + main_Sequencer_1_in_3 = @frame; +main_Sequencer_1_out_1[cache: 2] = + Sequencer( + main_Sequencer_1_in_1, + main_Sequencer_1_in_2, + main_Sequencer_1_in_3, + main_Value_1_out_1, + main_Compute_1_out_1, + main_Sequencer_1_in_6, + main_Sequencer_1_in_7 + ) [instance: 1, cache: 1]; + // + // node Select[1]: x = 851, y = 394, inputs = 3, label = Select + // +main_Select_1_out_1 = + Select( + main_Import_1_out_1, + main_Sequencer_1_out_1, + main_Select_1_in_3 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 449, y = 324, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_Select_1_out_1 + ) [instance: 1, cache: 1]; + // + // node StringList[2]: x = 628, y = 224, inputs = 0, label = StringList + // output[1]: visible = 1, type = 16777248, value = { "COLORLIST" } + // + // + // node ForEachMember[2]: x = 605, y = 324, inputs = 1, label = ForEachMember + // +main_ForEachMember_2_out_1, +main_ForEachMember_2_out_2, +main_ForEachMember_2_out_3 = + ForEachMember( + main_StringList_2_out_1 + ) [instance: 2, cache: 1]; + // + // node Color[1]: x = 589, y = 404, inputs = 5, label = Color + // input[3]: defaulting = 0, visible = 1, type = 5, value = .3 + // +main_Color_1_out_1 = + Color( + main_ShowConnections_1_out_1, + main_ForEachMember_2_out_1, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node GetLocal[3]: x = 732, y = 394, inputs = 3, label = GetLocal + // +main_GetLocal_3_out_1, +main_GetLocal_3_out_2 = + GetLocal( + main_GetLocal_3_in_1, + main_GetLocal_3_in_2, + main_GetLocal_3_in_3 + ) [instance: 3, cache: 1]; + // + // node Append[1]: x = 555, y = 484, inputs = 5, label = Append + // +main_Append_1_out_1 = + Append( + main_CollectMultiGrid_1_out_1, + main_Color_1_out_1, + main_Append_1_in_3, + main_GetLocal_3_out_1, + main_Append_1_in_5 + ) [instance: 1, cache: 1]; + // + // node GetLocal[4]: x = 1012, y = 484, inputs = 3, label = GetLocal + // +main_GetLocal_4_out_1, +main_GetLocal_4_out_2 = + GetLocal( + main_GetLocal_4_in_1, + main_GetLocal_4_in_2, + main_GetLocal_4_in_3 + ) [instance: 4, cache: 1]; + // + // node Append[2]: x = 835, y = 484, inputs = 5, label = Append + // +main_Append_2_out_1 = + Append( + main_CollectMultiGrid_1_out_1, + main_Select_1_out_1, + main_Append_2_in_3, + main_GetLocal_4_out_1, + main_Append_2_in_5 + ) [instance: 2, cache: 1]; + // + // node RubberSheet[2]: x = 786, y = 644, inputs = 4, label = RubberSheet + // input[2]: defaulting = 1, visible = 1, type = 5, value = .1 + // +main_RubberSheet_2_out_1 = + RubberSheet( + main_Append_2_out_1, + main_RubberSheet_2_in_2, + main_RubberSheet_2_in_3, + main_RubberSheet_2_in_4 + ) [instance: 2, cache: 1]; + // + // node Shade[1]: x = 899, y = 684, inputs = 8, label = Shade + // input[2]: defaulting = 0, visible = 1, type = 3, value = 1 + // input[3]: defaulting = 0, visible = 1, type = 32, value = "smooth" + // +main_Shade_1_out_1 = + Shade( + main_RubberSheet_2_out_1, + main_Shade_1_in_2, + main_Shade_1_in_3, + main_Shade_1_in_4, + main_Shade_1_in_5, + main_Shade_1_in_6, + main_Shade_1_in_7, + main_Shade_1_in_8 + ) [instance: 1, cache: 1]; + // + // node Statistics[1]: x = 135, y = 324, inputs = 1, label = Statistics + // +main_Statistics_1_out_1, +main_Statistics_1_out_2, +main_Statistics_1_out_3, +main_Statistics_1_out_4, +main_Statistics_1_out_5 = + Statistics( + main_Import_1_out_1 + ) [instance: 1, cache: 1]; + // + // node GetLocal[2]: x = 12, y = 324, inputs = 3, label = GetLocal + // +main_GetLocal_2_out_1, +main_GetLocal_2_out_2 = + GetLocal( + main_GetLocal_2_in_1, + main_GetLocal_2_in_2, + main_GetLocal_2_in_3 + ) [instance: 2, cache: 1]; + // + // node List[2]: x = 111, y = 464, inputs = 2, label = List + // +main_List_2_out_1 = + List( + main_Statistics_1_out_4, + main_GetLocal_2_out_1 + ) [instance: 2, cache: 1]; + // + // node Statistics[3]: x = 75, y = 594, inputs = 1, label = Statistics + // +main_Statistics_3_out_1, +main_Statistics_3_out_2, +main_Statistics_3_out_3, +main_Statistics_3_out_4, +main_Statistics_3_out_5 = + Statistics( + main_List_2_out_1 + ) [instance: 3, cache: 1]; + // + // node GetLocal[1]: x = 302, y = 324, inputs = 3, label = GetLocal + // +main_GetLocal_1_out_1, +main_GetLocal_1_out_2 = + GetLocal( + main_GetLocal_1_in_1, + main_GetLocal_1_in_2, + main_GetLocal_1_in_3 + ) [instance: 1, cache: 1]; + // + // node List[1]: x = 231, y = 464, inputs = 2, label = List + // +main_List_1_out_1 = + List( + main_Statistics_1_out_5, + main_GetLocal_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Statistics[2]: x = 235, y = 594, inputs = 1, label = Statistics + // +main_Statistics_2_out_1, +main_Statistics_2_out_2, +main_Statistics_2_out_3, +main_Statistics_2_out_4, +main_Statistics_2_out_5 = + Statistics( + main_List_1_out_1 + ) [instance: 2, cache: 1]; + // + // node AutoColor[1]: x = 896, y = 804, inputs = 10, label = AutoColor + // input[2]: defaulting = 0, visible = 0, type = 5, value = 1.0 + // input[8]: visible = 1 + // +main_AutoColor_1_out_1, +main_AutoColor_1_out_2 = + AutoColor( + main_Shade_1_out_1, + main_AutoColor_1_in_2, + main_AutoColor_1_in_3, + main_AutoColor_1_in_4, + main_AutoColor_1_in_5, + main_AutoColor_1_in_6, + main_Statistics_3_out_4, + main_Statistics_2_out_5, + main_AutoColor_1_in_9, + main_AutoColor_1_in_10 + ) [instance: 1, cache: 1]; + // + // node RubberSheet[4]: x = 606, y = 734, inputs = 4, label = RubberSheet + // input[2]: defaulting = 1, visible = 1, type = 5, value = .1 + // +main_RubberSheet_4_out_1 = + RubberSheet( + main_Append_1_out_1, + main_RubberSheet_4_in_2, + main_RubberSheet_4_in_3, + main_RubberSheet_4_in_4 + ) [instance: 4, cache: 1]; + // + // node ColorBar[1]: x = 835, y = 934, inputs = 16, label = ColorBar + // input[4]: defaulting = 0, visible = 1, type = 3, value = 1 + // +main_ColorBar_1_out_1 = + ColorBar( + main_AutoColor_1_out_2, + main_ColorBar_1_in_2, + main_ColorBar_1_in_3, + main_ColorBar_1_in_4, + main_ColorBar_1_in_5, + main_ColorBar_1_in_6, + main_ColorBar_1_in_7, + main_ColorBar_1_in_8, + main_ColorBar_1_in_9, + main_ColorBar_1_in_10, + main_ColorBar_1_in_11, + main_ColorBar_1_in_12, + main_ColorBar_1_in_13, + main_ColorBar_1_in_14, + main_ColorBar_1_in_15, + main_ColorBar_1_in_16 + ) [instance: 1, cache: 1]; + // + // node Collect[1]: x = 619, y = 844, inputs = 3, label = Collect + // +main_Collect_1_out_1 = + Collect( + main_RubberSheet_4_out_1, + main_AutoColor_1_out_1, + main_ColorBar_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 609, y = 944, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 67108863, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 3, value = 0 + // depth: value = 24 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Collect_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; + // + // node SetLocal[1]: x = 332, y = 464, inputs = 3, label = SetLocal + // + SetLocal( + main_List_1_out_1, + main_GetLocal_1_out_2, + main_SetLocal_1_in_3 + ) [instance: 1, cache: 1]; + // + // node SetLocal[2]: x = 12, y = 464, inputs = 3, label = SetLocal + // + SetLocal( + main_List_2_out_1, + main_GetLocal_2_out_2, + main_SetLocal_2_in_3 + ) [instance: 2, cache: 1]; + // + // node SetLocal[3]: x = 732, y = 484, inputs = 3, label = SetLocal + // + SetLocal( + main_Append_1_out_1, + main_GetLocal_3_out_2, + main_SetLocal_3_in_3 + ) [instance: 3, cache: 1]; + // + // node SetLocal[4]: x = 1012, y = 564, inputs = 3, label = SetLocal + // + SetLocal( + main_Append_2_out_1, + main_GetLocal_4_out_2, + main_SetLocal_4_in_3 + ) [instance: 4, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_CollectMultiGrid_1_in_1 = NULL; +main_CollectMultiGrid_1_in_2 = NULL; +main_CollectMultiGrid_1_in_3 = NULL; +main_CollectMultiGrid_1_in_4 = NULL; +main_CollectMultiGrid_1_out_1 = NULL; +main_StringList_1_out_1 = { "FILELIST" }; +main_ForEachMember_1_out_1 = NULL; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_Value_1_out_1 = 0; +main_Inquire_1_in_2 = "member count"; +main_Inquire_1_in_3 = NULL; +main_Inquire_1_out_1 = NULL; +main_Value_2_out_1 = 1; +main_Compute_1_in_1 = "$0 - $1"; +main_Compute_1_out_1 = NULL; +main_Sequencer_1_in_1 = "Sequencer_1"; +main_Sequencer_1_in_2 = NULL; +main_Sequencer_1_in_3 = NULL; +main_Sequencer_1_in_6 = NULL; +main_Sequencer_1_in_7 = { 0 95 1 0 95 1 }; +main_Sequencer_1_out_1 = NULL; + +@startframe = 0; +@nextframe = @startframe; +@endframe = 95; +@deltaframe = 1; +main_Select_1_in_3 = NULL; +main_Select_1_out_1 = NULL; +main_ShowConnections_1_out_1 = NULL; +main_StringList_2_out_1 = { "COLORLIST" }; +main_ForEachMember_2_out_1 = NULL; +main_Color_1_in_3 = .3; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +main_GetLocal_3_in_1 = NULL; +main_GetLocal_3_in_2 = NULL; +main_GetLocal_3_in_3 = NULL; +main_GetLocal_3_out_1 = NULL; +main_GetLocal_3_out_2 = NULL; +main_Append_1_in_3 = NULL; +main_Append_1_in_5 = NULL; +main_Append_1_out_1 = NULL; +main_GetLocal_4_in_1 = NULL; +main_GetLocal_4_in_2 = NULL; +main_GetLocal_4_in_3 = NULL; +main_GetLocal_4_out_1 = NULL; +main_GetLocal_4_out_2 = NULL; +main_Append_2_in_3 = NULL; +main_Append_2_in_5 = NULL; +main_Append_2_out_1 = NULL; +main_RubberSheet_2_in_2 = NULL; +main_RubberSheet_2_in_3 = NULL; +main_RubberSheet_2_in_4 = NULL; +main_RubberSheet_2_out_1 = NULL; +main_Shade_1_in_2 = 1; +main_Shade_1_in_3 = "smooth"; +main_Shade_1_in_4 = NULL; +main_Shade_1_in_5 = NULL; +main_Shade_1_in_6 = NULL; +main_Shade_1_in_7 = NULL; +main_Shade_1_in_8 = NULL; +main_Shade_1_out_1 = NULL; +main_Statistics_1_out_4 = NULL; +main_Statistics_1_out_5 = NULL; +main_GetLocal_2_in_1 = NULL; +main_GetLocal_2_in_2 = NULL; +main_GetLocal_2_in_3 = NULL; +main_GetLocal_2_out_1 = NULL; +main_GetLocal_2_out_2 = NULL; +main_List_2_out_1 = NULL; +main_Statistics_3_out_4 = NULL; +main_GetLocal_1_in_1 = NULL; +main_GetLocal_1_in_2 = NULL; +main_GetLocal_1_in_3 = NULL; +main_GetLocal_1_out_1 = NULL; +main_GetLocal_1_out_2 = NULL; +main_List_1_out_1 = NULL; +main_Statistics_2_out_5 = NULL; +main_AutoColor_1_in_2 = 1.0; +main_AutoColor_1_in_3 = NULL; +main_AutoColor_1_in_4 = NULL; +main_AutoColor_1_in_5 = NULL; +main_AutoColor_1_in_6 = NULL; +main_AutoColor_1_in_9 = NULL; +main_AutoColor_1_in_10 = NULL; +main_AutoColor_1_out_1 = NULL; +main_AutoColor_1_out_2 = NULL; +main_RubberSheet_4_in_2 = NULL; +main_RubberSheet_4_in_3 = NULL; +main_RubberSheet_4_in_4 = NULL; +main_RubberSheet_4_out_1 = NULL; +main_ColorBar_1_in_2 = NULL; +main_ColorBar_1_in_3 = NULL; +main_ColorBar_1_in_4 = 1; +main_ColorBar_1_in_5 = NULL; +main_ColorBar_1_in_6 = NULL; +main_ColorBar_1_in_7 = NULL; +main_ColorBar_1_in_8 = NULL; +main_ColorBar_1_in_9 = NULL; +main_ColorBar_1_in_10 = NULL; +main_ColorBar_1_in_11 = NULL; +main_ColorBar_1_in_12 = NULL; +main_ColorBar_1_in_13 = NULL; +main_ColorBar_1_in_14 = NULL; +main_ColorBar_1_in_15 = NULL; +main_ColorBar_1_in_16 = NULL; +main_ColorBar_1_out_1 = NULL; +main_Collect_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 0; +main_Image_1_in_5 = NULL; +main_Image_1_in_6 = NULL; +main_Image_1_in_7 = NULL; +main_Image_1_in_8 = NULL; +main_Image_1_in_9 = NULL; +main_Image_1_in_10 = NULL; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = NULL; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = NULL; +main_Image_1_in_18 = NULL; +main_Image_1_in_19 = 0; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = NULL; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = NULL; +main_Image_1_in_26 = NULL; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = NULL; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = NULL; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = NULL; +main_Image_1_in_34 = NULL; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = NULL; +main_Image_1_in_37 = NULL; +main_Image_1_in_38 = NULL; +main_Image_1_in_39 = NULL; +main_Image_1_in_40 = NULL; +main_Image_1_in_41 = NULL; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +main_SetLocal_1_in_3 = NULL; +main_SetLocal_2_in_3 = NULL; +main_SetLocal_3_in_3 = NULL; +main_SetLocal_4_in_3 = NULL; +Executive("product version 4 4 4"); +$sync + +sequence main(); +play; diff --git a/octave_packages/fpl-1.2.0/FPL2vtkoutputdata.m b/octave_packages/fpl-1.2.0/FPL2vtkoutputdata.m new file mode 100644 index 0000000..737f8fe --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL2vtkoutputdata.m @@ -0,0 +1,144 @@ +## Copyright (C) 2008 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, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +## -*- texinfo -*- +## @deftypefn {Function File} {} FPL2vtkoutputdata ( @var{filename}, @var{p}, @var{t}, @var{nodedata}, @var{celldata}, @var{header}, @var{vtkver}) +## +## Save data in VTK ASCII format. +## +## @itemize @minus +## @item @var{filename} = name of file to save into +## @item @var{p}, @var{t} = mesh node coordinates and connectivity +## @item @var{name} = name of a mesh variable +## @item @var{nodedata}/@var{celldata} = node/cell centered data +## fields (2xNfields cell array), @var{*data}@{:,1@} = variable names; +## @var{*data}@{:,2@} = variable data; +## @item @var{header} comment to add in the file header +## @item @var{vtkver} format version (default is 3.0) +## @end itemize +## +## @seealso{FPL2dxoutputdata} +## @end deftypefn + +function FPL2vtkoutputdata (filename, p, t, nodedata, celldata, header, vtkver) + + fid = fopen (filename, "w"); + if ( fid ) + + ## version ID + if (!exist("vtkver")) + vtkver = [3 0]; + endif + + fprintf (fid, "# vtk DataFile Version %d.%d\n", vtkver(1), vtkver(2)); + + ## header + if (!exist("header")) + header = ""; + elseif (length(header) > 255) + header (255:end) = []; + endif + + fprintf (fid, "%s\n", header); + + ## File format: only ASCII supported for the moment + fprintf (fid, "ASCII\n"); + + ## Mesh: only triangles suported + fprintf (fid, "DATASET UNSTRUCTURED_GRID\n"); + + Nnodes = columns(p); + fprintf (fid,"POINTS %d double\n", Nnodes); + fprintf (fid,"%g %g 0\n", p); + + Nelem = columns(t); + T = zeros(4,Nelem); + T(1,:)= 3; + T(2:4,:) = t(1:3,:) -1; + fprintf (fid,"CELLS %d %d\n", Nelem, Nelem*4); + fprintf (fid,"%d %d %d %d\n", T); + fprintf (fid,"CELL_TYPES %d \n", Nelem); + fprintf (fid,"%d\n", 5*ones(Nelem,1)); + + ## node data + if (exist("nodedata")) + nfields = rows(nodedata); + if nfields + fprintf (fid,"POINT_DATA %d\n", Nnodes); + for ifield = 1:nfields + V = nodedata {ifield, 2}; + N = nodedata {ifield, 1}; + if (isvector (V)) + fprintf (fid,"SCALARS %s double\nLOOKUP_TABLE default\n", N); + fprintf (fid,"%g\n", V); + else + V(:,3) = 0; + fprintf (fid,"VECTORS %s double\nLOOKUP_TABLE default\n", N); + fprintf (fid,"%g %g %g\n", V); + endif + endfor + endif + endif + + ## cell data + if (exist("celldata")) + nfields = rows(celldata); + if nfields + fprintf (fid,"CELL_DATA %d\n", Nelem); + for ifield = 1:nfields + V = celldata {ifield, 2}; + N = celldata {ifield, 1}; + if (isvector (V)) + fprintf (fid,"SCALARS %s double\nLOOKUP_TABLE default\n", N); + fprintf (fid,"%g\n", V); + else + V(:,3) = 0; + fprintf (fid,"VECTORS %s double\nLOOKUP_TABLE default\n", N); + fprintf (fid,"%g %g %g\n", V); + endif + endfor + endif + endif + + ## cleanup + fclose (fid); + else + error(["FPL2vtkoutputdata: could not open file " filename]); + endif +endfunction + +%!test +%! msh.p =[ 0 0 0 0 1 1 1 1 2 2 2 2 3 3 3 3 +%! 0 1 2 3 0 1 2 3 0 1 2 3 0 1 2 3]; +%! msh.e =[1 5 9 13 14 15 4 8 12 1 2 3 +%! 5 9 13 14 15 16 8 12 16 2 3 4 +%! 0 0 0 0 0 0 0 0 0 0 0 0 +%! 0 0 0 0 0 0 0 0 0 0 0 0 +%! 1 1 1 2 2 2 3 3 3 4 4 4 +%! 0 0 0 0 0 0 0 0 0 0 0 0 +%! 1 1 1 1 1 1 1 1 1 1 1 1]; +%! msh.t =[ 1 2 3 5 6 7 9 10 11 1 2 3 5 6 7 9 10 11 +%! 5 6 7 9 10 11 13 14 15 6 7 8 10 11 12 14 15 16 +%! 6 7 8 10 11 12 14 15 16 2 3 4 6 7 8 10 11 12 +%! 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1]; +%! testfile = "# vtk DataFile Version 3.0\n\nASCII\nDATASET UNSTRUCTURED_GRID\nPOINTS 16 double\n0 0 0\n0 1 0\n0 2 0\n0 3 0\n1 0 0\n1 1 0\n1 2 0\n1 3 0\n2 0 0\n2 1 0\n2 2 0\n2 3 0\n3 0 0\n3 1 0\n3 2 0\n3 3 0\nCELLS 18 72\n3 0 4 5\n3 1 5 6\n3 2 6 7\n3 4 8 9\n3 5 9 10\n3 6 10 11\n3 8 12 13\n3 9 13 14\n3 10 14 15\n3 0 5 1\n3 1 6 2\n3 2 7 3\n3 4 9 5\n3 5 10 6\n3 6 11 7\n3 8 13 9\n3 9 14 10\n3 10 15 11\nCELL_TYPES 18 \n5\n5\n5\n5\n5\n5\n5\n5\n5\n5\n5\n5\n5\n5\n5\n5\n5\n5\nPOINT_DATA 16\nSCALARS u double\nLOOKUP_TABLE default\n0\n0\n0\n0\n1\n1\n1\n1\n2\n2\n2\n2\n3\n3\n3\n3\n"; +%! FPL2vtkoutputdata ("__FPL2vtkoutputdata__test__.vtk", msh.p, msh.t, {"u", msh.p(1,:).'}); +%! fid = fopen("__FPL2vtkoutputdata__test__.vtk","r"); +%! s = fread(fid); +%! fclose(fid); +%! assert (char(s'), testfile); +%! delete __FPL2vtkoutputdata__test__.vtk diff --git a/octave_packages/fpl-1.2.0/FPL3dxoutputfield.m b/octave_packages/fpl-1.2.0/FPL3dxoutputfield.m new file mode 100644 index 0000000..f99c218 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL3dxoutputfield.m @@ -0,0 +1,76 @@ +## Copyright (C) 2004-2008 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## @deftypefn {Function File} {} FPL3dxoutputfield( @var{filename}, @ +## @var{meshfilename}, @var{dep}, @var{u}, @var{attr_name}, @var{attr_rank}, @ +## @var{attr_shape}, @var{endfile} ) +## +## Outputs data in DX form. +## +## Variable must be a scalar, vector or tensor of doubles +## +## @itemize @minus +## @item @var{filename} = name of file to save (type string) +## @item @var{meshfilename} = name of mesh file (type string) +## @item @var{dep} = "positions" for node data, "connections" for element data +## @item @var{field} = field data to be saved +## @item @var{attr_name} = name of the variable (type string) +## @item @var{attr_rank} = rank of variable data (0 for scalar, 1 for vector, etc.) +## @item @var{attr_shape} = number of components of variable data (assumed 1 for scalar) +## @end itemize +## @end deftypefn + +function FPL3dxoutputfield(filename,meshfilename,dep,field,attr_name,attr_rank,attr_shape) + + fid = fopen (filename,"w"); + nnodes = size(field,1); + + if ((attr_rank==0) & (min(size(field))==1)) + fprintf(fid,"object ""%s.data""\nclass array type double rank 0 items %d data follows",attr_name,nnodes); + fprintf(fid,"\n %e",field); + else + fprintf(fid,"object ""%s.data""\nclass array type double rank %d shape %d items %d data follows",attr_name,attr_rank,attr_shape,nnodes); + for ii = 1:nnodes + fprintf(fid,"\n"); + fprintf(fid," %e",field(ii,:)); + endfor + endif + fprintf(fid,"\nattribute ""dep"" string ""%s""\n\n",dep); + fprintf(fid,"object ""%s"" class field\n",attr_name); + fprintf(fid,"component ""positions"" file %s ""pos""\n",meshfilename); + fprintf(fid,"component ""connections"" file %s ""con""\n",meshfilename); + fprintf(fid,"component ""data"" value ""%s.data""\n",attr_name); + + fprintf(fid,"\nend\n"); + fclose (fid); + +endfunction + + diff --git a/octave_packages/fpl-1.2.0/FPL3dxoutputmesh.m b/octave_packages/fpl-1.2.0/FPL3dxoutputmesh.m new file mode 100644 index 0000000..afa62d6 --- /dev/null +++ b/octave_packages/fpl-1.2.0/FPL3dxoutputmesh.m @@ -0,0 +1,110 @@ +## Copyright (C) 2004-2008,2009 Carlo de Falco, Massimiliano Culpo +## +## This file is part of +## +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## +## AUTHORS: +## Carlo de Falco +## +## Culpo Massimiliano +## Bergische Universitaet Wuppertal +## Fachbereich C - Mathematik und Naturwissenschaften +## Arbeitsgruppe fuer Angewandte MathematD-42119 Wuppertal Gaussstr. 20 +## D-42119 Wuppertal, Germany + +## -*- texinfo -*- +## @deftypefn {Function File} {} FPL3dxoutputmesh ( @var{filename}, @ +## @var{mesh} ) +## +## Outputs data in DX form. +## +## Variable must be a scalar, vector or tensor of doubles +## +## @itemize @minus +## @item @var{filename} = name of file to save (type string) +## @item @var{mesh} = PDE-tool like mesh +## @end itemize +## @end deftypefn + + +function FPL3dxoutputmesh(filename,mesh) + + nodes = mesh.p'; + elem = mesh.t(1:4,:)'; + + fid = fopen (filename,"w"); + nnodes = columns(mesh.p); + nelem = columns(mesh.t); + + fprintf(fid,"object ""pos""\nclass array type float rank 1 shape 3 items %d data follows",nnodes); + for ii = 1:nnodes + fprintf(fid,"\n"); + fprintf(fid," %e",nodes(ii,:)); + endfor + + ## In DX format nodes are numbered starting from zero, + ## instead we want to number them starting from 1. + if (min(min(elem))==1) + elem = elem - 1; + elseif(min(min(elem))~=0) + error("WARNING: check tetrahedra structure"); + end + + fprintf(fid,"\n\nobject ""con""\nclass array type int rank 1 shape 4 items %d data follows",nelem); + for ii = 1:nelem + fprintf(fid,"\n"); + fprintf(fid," %d",elem(ii,:)); + endfor + + fprintf(fid,"\nattribute ""element type"" string ""tetrahedra""\nattribute ""ref"" string ""positions""\n\n"); + + fprintf(fid,"object ""themesh"" class field\n"); + fprintf(fid,"component ""positions"" value ""pos""\n"); + fprintf(fid,"component ""connections"" value ""con""\n"); + + fprintf(fid,"\nend\n"); + fclose (fid); + +endfunction + +%!test +%! msh.p =[ 0 0 1 1 0 0 1 1 +%! 0 1 0 1 0 1 0 1 +%! 0 0 0 0 1 1 1 1]; +%! msh.e =[1 5 7 8 5 5 6 8 1 3 5 7 +%! 2 6 3 3 7 3 2 6 3 2 6 6 +%! 6 1 8 4 3 1 4 4 2 4 7 8 +%! 0 0 0 0 0 0 0 0 0 0 0 0 +%! 0 0 0 0 0 0 0 0 0 0 0 0 +%! 0 0 0 0 0 0 0 0 0 0 0 0 +%! 0 0 0 0 0 0 0 0 0 0 0 0 +%! 0 0 0 0 0 0 0 0 0 0 0 0 +%! 1 1 1 1 1 1 1 1 1 1 1 1 +%! 1 1 2 2 3 3 4 4 5 5 6 6]; +%! msh.t =[ 1 5 5 6 7 8 +%! 3 6 6 3 3 3 +%! 2 7 3 2 6 6 +%! 6 3 1 4 8 4 +%! 1 1 1 1 1 1]; +%! testfile = "object ""pos""\nclass array type float rank 1 shape 3 items 8 data follows\n 0.000000e+00 0.000000e+00 0.000000e+00\n 0.000000e+00 1.000000e+00 0.000000e+00\n 1.000000e+00 0.000000e+00 0.000000e+00\n 1.000000e+00 1.000000e+00 0.000000e+00\n 0.000000e+00 0.000000e+00 1.000000e+00\n 0.000000e+00 1.000000e+00 1.000000e+00\n 1.000000e+00 0.000000e+00 1.000000e+00\n 1.000000e+00 1.000000e+00 1.000000e+00\n\nobject ""con""\nclass array type int rank 1 shape 4 items 6 data follows\n 0 2 1 5\n 4 5 6 2\n 4 5 2 0\n 5 2 1 3\n 6 2 5 7\n 7 2 5 3\nattribute ""element type"" string ""tetrahedra""\nattribute ""ref"" string ""positions""\n\nobject ""themesh"" class field\ncomponent ""positions"" value ""pos""\ncomponent ""connections"" value ""con""\n\nend\n"; +%! FPL3dxoutputmesh ("__FPL3dxoutputmesh__test__.dx",msh); +%! fid = fopen("__FPL3dxoutputmesh__test__.dx","r"); +%! s = fread(fid); +%! fclose(fid); +%! assert (char(s'), testfile); +%! delete __FPL3dxoutputmesh__test__.dx diff --git a/octave_packages/fpl-1.2.0/doc-cache b/octave_packages/fpl-1.2.0/doc-cache new file mode 100644 index 0000000..8162299 --- /dev/null +++ b/octave_packages/fpl-1.2.0/doc-cache @@ -0,0 +1,746 @@ +# Created by Octave 3.6.1, Fri Mar 23 19:03:15 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 19 +# name: +# type: sq_string +# elements: 1 +# length: 16 +FPL2dxappenddata + + +# name: +# type: sq_string +# elements: 1 +# length: 848 + -- Function File: FPL2dxappenddata ( FILENAME, + P, T, U, ATTR_NAME, ATTR_RANK, ATTR_SHAPE, ENDFLIE ) + + Apends data to a file in DX form. Only one variable can be + written to the file variable must be a scalar, vector or tensor + of doubles mesh data in the file must be consistent with this + variable + + Variable must be a scalar, vector or tensor of doubles + + - FILENAME= name of file to save (type string) + + - P, T = mesh + + - U = variable to save + + - ATTR_NAME = name of the variable (type string) + + - ATTR_RANK = rank of variable data (0 for scalar, 1 for + vector, etc.) + + - ATTR_SHAPE = number of components of variable data (assumed + 1 for scalar) + + - ENDFILE = 0 if you want to add other variables to the same + file, 1 otherwise + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +P, T, U, ATTR_NAME, ATTR_RANK, ATTR_SHAPE, ENDFLIE ) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +FPL2dxoutputdata + + +# name: +# type: sq_string +# elements: 1 +# length: 660 + -- Function File: FPL2dxoutputdata ( FILENAME, P, T, U, ATTR_NAME, + ATTR_RANK, ATTR_SHAPE, ENDFILE ) + Outputs data in DX form. + + Variable must be a scalar, vector or tensor of doubles + + - FILENAME= name of file to save (type string) + + - P, T = mesh + + - U = variable to save + + - ATTR_NAME = name of the variable (type string) + + - ATTR_RANK = rank of variable data (0 for scalar, 1 for + vector, etc.) + + - ATTR_SHAPE = number of components of variable data (assumed + 1 for scalar) + + - ENDFILE = 0 if you want to add other variables to the same + file, 1 otherwise + + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +Outputs data in DX form. + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +FPL2dxoutputtimeseries + + +# name: +# type: sq_string +# elements: 1 +# length: 606 + -- Function File: FPL2dxoutputtimeseries ( FILENAME, P, T, U, + ATTR_NAME, ATTR_RANK, ATTR_SHAPE, TIME ) + Outputs a time series in DX form. variable must be a scalar, + vector or tensor of doubles + - FILENAME= name of file to save (type string) + + - P, T = mesh + + - U = variable to save + + - ATTR_NAME = name of the variable (type string) + + - ATTR_RANK = rank of variable data (0 for scalar, 1 for + vector, etc.) + + - ATTR_SHAPE = number of components of variable data (assumed + 1 for scalar) + + - TIME = time instants + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Outputs a time series in DX form. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +FPL2pdequiver + + +# name: +# type: sq_string +# elements: 1 +# length: 275 + -- Function File: FPL2pdequiver (MESH, VX, VY, [ PROPERTY, VALUE ...]) + Plots the 2D vector field VX, VY defined on the triangulation MESH + using opendx. + + Options (default values): SAMPLE_DENSITY (100) + + See also: FPL2pdesurf, FPL2ptcsurf, FPL2ptcquiver + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Plots the 2D vector field VX, VY defined on the triangulation MESH +using opendx. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +FPL2pdeshowmesh + + +# name: +# type: sq_string +# elements: 1 +# length: 221 + -- Function File: FPL2pdeshowmesh (MESH,COLOR) + Displays one 2-D triangulations using opendx + + Examples: + + FPL2pdeshowmesh(mesh) + FPL2pdeshowmesh(mesh,"blue") + + See also: FPL2ptcshowmesh + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Displays one 2-D triangulations using opendx + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +FPL2pdesurf + + +# name: +# type: sq_string +# elements: 1 +# length: 429 + -- Function File: FPL2pdesurf (MESH, U [ PROPERTY, VALUE ...]) + plots the scalar field U defined on the triangulation MESH using + opendx. + + options (default value): + - data_dep ("positions") defines wether data depends on + positions or connections + + - plot_field ("scalar") defines wether to plot the scalar field + itself or its gradient + + See also: MSH2Mgmsh, MSH2Mstructmesh + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 +plots the scalar field U defined on the triangulation MESH using opendx. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +FPL2ptcquiver + + +# name: +# type: sq_string +# elements: 1 +# length: 248 + -- Function File: FPL2ptcquiver (MESH1, COLOR1 + VX1, VY1, [ MESH2, COLOR2, VX2, VY2 ...]) + + Plots the 2D vector fields VX, VY defined on the triangulations + MESH using opendx. + + See also: FPL2pdesurf, FPL2ptcsurf, FPL2pdequiver + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 +VX1, VY1, [ MESH2, COLOR2, VX2, VY2 . + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +FPL2ptcshowmesh + + +# name: +# type: sq_string +# elements: 1 +# length: 177 + -- Function File: FPL2ptcshowmesh (MESH1, COLOR1, [MESH2, COLOR2, + ...]) + Displays two or more 2-D triangulations using opendx + + See also: FPL2pdeshowmesh + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Displays two or more 2-D triangulations using opendx + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +FPL2ptcsurf + + +# name: +# type: sq_string +# elements: 1 +# length: 222 + -- Function File: FPL2ptcsurf (MESH1, COLOR1, DATA1 [MESH2, + COLOR2,DATA2]) + Plots the scalar fields DATA over the triangulation MESH using + opendx. Connections will be displayed as defined in COLOR. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +Plots the scalar fields DATA over the triangulation MESH using opendx. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +FPL2trspdesurf + + +# name: +# type: sq_string +# elements: 1 +# length: 311 + -- Function File: FPL2trspdesurf (MESH, COLOR, DATA) + Plots the transient scalar field U defined on the triangulation + MESH using opendx. Connections are rendered as defined by COLOR + + Example: + + FPL2trspdesurf(mesh,"blue",data) + + See also: FPL2pdesurf, FPL2ptcsurf, FPL2trsptcsurf + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Plots the transient scalar field U defined on the triangulation MESH +using opend + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +FPL2trsptcsurf + + +# name: +# type: sq_string +# elements: 1 +# length: 373 + -- Function File: FPL2trsptcsurf (MESH1, COLOR1, DATA1, [MESH2, + COLOR2, DATA2]) + Plots the transient scalar fields DATA defined on the triangulation + MESH using opendx. Connections are rendered as defined by COLOR + + Example: + + FPL2trspdesurf(mesh1,"blue",data1, mesh2,"red",data2) + + See also: FPL2pdesurf, FPL2ptcsurf, FPL2trspdesurf + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Plots the transient scalar fields DATA defined on the triangulation +MESH using o + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +FPL2vtkoutputdata + + +# name: +# type: sq_string +# elements: 1 +# length: 586 + -- Function File: FPL2vtkoutputdata ( FILENAME, P, T, NODEDATA, + CELLDATA, HEADER, VTKVER) + Save data in VTK ASCII format. + + - FILENAME = name of file to save into + + - P, T = mesh node coordinates and connectivity + + - NAME = name of a mesh variable + + - NODEDATA/CELLDATA = node/cell centered data fields + (2xNfields cell array), *DATA{:,1} = variable names; + *DATA{:,2} = variable data; + + - HEADER comment to add in the file header + + - VTKVER format version (default is 3.0) + + See also: FPL2dxoutputdata + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Save data in VTK ASCII format. + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +FPL3dxoutputfield + + +# name: +# type: sq_string +# elements: 1 +# length: 730 + -- Function File: FPL3dxoutputfield( FILENAME, MESHFILENAME, DEP, U, + ATTR_NAME, ATTR_RANK, ATTR_SHAPE, ENDFILE ) + Outputs data in DX form. + + Variable must be a scalar, vector or tensor of doubles + + - FILENAME = name of file to save (type string) + + - MESHFILENAME = name of mesh file (type string) + + - DEP = "positions" for node data, "connections" for + element data + + - FIELD = field data to be saved + + - ATTR_NAME = name of the variable (type string) + + - ATTR_RANK = rank of variable data (0 for scalar, 1 for + vector, etc.) + + - ATTR_SHAPE = number of components of variable data + (assumed 1 for scalar) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +Outputs data in DX form. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +FPL3dxoutputmesh + + +# name: +# type: sq_string +# elements: 1 +# length: 246 + -- Function File: FPL3dxoutputmesh ( FILENAME, MESH ) + Outputs data in DX form. + + Variable must be a scalar, vector or tensor of doubles + + - FILENAME = name of file to save (type string) + + - MESH = PDE-tool like mesh + + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +Outputs data in DX form. + + + +# name: +# type: sq_string +# elements: 1 +# length: 18 +fpl_dx_write_field + + +# name: +# type: sq_string +# elements: 1 +# length: 1662 + -- Function File: fpl_dx_writefield (BASENAME, MESH, U, ATTR_NAME, + ATTR_RANK, ATTR_SHAPE, ENDFILE) + Output data field in ASCII Open-DX format. + + BASENAME is a string containing the base-name of the dx file where + the data will be saved. + + MESH is a PDE-tool like mesh, like the ones generated by the "msh" + package. + + U is the field to be saved. It should represent scalar, vector or + tensor of doubles. + + ATTR_NAME is a descriptive name for the field U, while ATTR_RANK + is the rank of the field (0 for scalar, 1 for vector, etc.) and + ATTR_SHAPE is the number of components of the field (assumed 1 for + scalar). + + ENDFILE should be 0 if you want to add other variables to the same + file, 1 otherwise. + + Notice that when appending fields to an already existing file: + + * MESH will not be printed to FILENAME, but it will be only + used to determine if the field is piece-wise constant or + piece-wise linear + + * U is not checked for consistency against the MESH already + printed in FILENAME + + Example 1 (wrong usage): + + fpl_dx_write_field("field.dx",msh1,u1,"density",1,0,0); + fpl_dx_write_field("field.dx",msh2,u2,"temperature",1,0,1); + generate a file that fails at OpenDX run-time. + + Example 2: + + fpl_dx_write_field("field",msh1,u1,"density",1,0,0); + fpl_dx_write_field("field",msh1,u2,"temperature",1,0,1); + will generate a valid OpenDX ASCII data file. + + See also: fpl_dx_write_series + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 +Output data field in ASCII Open-DX format. + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +fpl_dx_write_series + + +# name: +# type: sq_string +# elements: 1 +# length: 812 + -- Function File: fpl_dx_write_series (BASENAME, MESH, U, SP, + ATTR_NAME, ATTR_RANK, ATTR_SHAPE) + Output data series in ASCII Open-DX format. + + BASENAME is a string containing the base-name of the dx file where + the data will be saved. + + MESH is a PDE-tool like mesh, like the ones generated by the "msh" + package. + + U is the series to be saved. It should represent scalar, vector or + tensor of doubles. SP is the vector of the sampled points (e.g. + time points in the case of a time series). + + ATTR_NAME is a descriptive name for the series U, while ATTR_RANK + is the rank of the field items (0 for scalar, 1 for vector, etc.) + and ATTR_SHAPE is the number of components of the field items + (assumed 1 for scalar). + + See also: fpl_dx_write_field + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Output data series in ASCII Open-DX format. + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +fpl_vtk_write_field + + +# name: +# type: sq_string +# elements: 1 +# length: 1099 + -- Function File: fpl_vtk_write_field (BASENAME, MESH, NODEDATA, + CELLDATA, ENDFILE) + Output data field in serial XML-VTK UnstructuredGrid format. + + BASENAME is a string containing the base-name of the (vtu) file + where the data will be saved. + + MESH is a PDE-tool like mesh, like the ones generated by the "msh" + package. + + NODEDATA and CELLDATA are (Ndata x 2) cell arrays containing + respectively and representing scalars or + vectors: + - *DATA{:,1} = variable data; + + - *DATA{:,2} = variable names; + + ENDFILE should be 0 if you want to add other variables to the same + file, 1 otherwise. + + Example: + + fpl_vtk_write_field("example",msh1,{nc1, "temperature"}, {cc1, "density"},0); + + fpl_vtk_write_field("example",msh2,{nc2, "temperature"}, {},1); + will generate a valid XML-VTK UnstructuredGrid file. + + See also: fpl_dx_write_field, fpl_dx_write_series + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 +Output data field in serial XML-VTK UnstructuredGrid format. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +pdemesh + + +# name: +# type: sq_string +# elements: 1 +# length: 295 + -- Function File: H = pdemesh (P, E, T, U) + Plot a triangular mesh in 3D given a mesh structure and node data. + P, T are the mesh vertices and connectivity, U node data. E is + ignored and is accepted only for compatibiity. + + See also: fpl_dx_write_field, fpl_vtk_write_field + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +Plot a triangular mesh in 3D given a mesh structure and node data. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +pdesurf + + +# name: +# type: sq_string +# elements: 1 +# length: 250 + -- Function File: H = pdesurf (P, T, U) + Plot a 3D surface given node or element data on a triangular mesh. + P, T are the mesh vertices and connectivity, U node or element + data. + + See also: fpl_dx_write_field, fpl_vtk_write_field + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +Plot a 3D surface given node or element data on a triangular mesh. + + + + + diff --git a/octave_packages/fpl-1.2.0/fpl_dx_write_field.m b/octave_packages/fpl-1.2.0/fpl_dx_write_field.m new file mode 100644 index 0000000..ca91cf4 --- /dev/null +++ b/octave_packages/fpl-1.2.0/fpl_dx_write_field.m @@ -0,0 +1,222 @@ +## Copyright (C) 2006,2007,2008,2009,2010 Carlo de Falco, Massimiliano Culpo +## +## This file is part of: +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## author: Carlo de Falco +## author: Massimiliano Culpo + +## -*- texinfo -*- +## @deftypefn {Function File} {} fpl_dx_writefield (@var{basename}, @ +## @var{mesh}, @var{u}, @var{attr_name}, @var{attr_rank}, @ +## @var{attr_shape}, @var{endfile}) +## +## Output data field in ASCII Open-DX format. +## +## @var{basename} is a string containing the base-name of the dx file where the +## data will be saved. +## +## @var{mesh} is a PDE-tool like mesh, like the ones generated by the +## "msh" package. +## +## @var{u} is the field to be saved. It should represent scalar, vector +## or tensor of doubles. +## +## @var{attr_name} is a descriptive name for the field @var{u}, while +## @var{attr_rank} is the rank of the field (0 for scalar, 1 for vector, +## etc.) and @var{attr_shape} is the number of components of the field +## (assumed 1 for scalar). +## +## @var{endfile} should be 0 if you want to add other variables to the +## same file, 1 otherwise. +## +## Notice that when appending fields to an already existing file: +## +## @itemize +## @item @var{mesh} will not be printed to @var{filename}, but it will +## be only used to determine if the field is piece-wise constant or +## piece-wise linear +## @item @var{u} is not checked for consistency against the @var{mesh} +## already printed in @var{filename} +## @end itemize +## +## Example 1 (wrong usage): +## @example +## +## fpl_dx_write_field("field.dx",msh1,u1,"density",1,0,0); +## fpl_dx_write_field("field.dx",msh2,u2,"temperature",1,0,1); +## @end example +## generate a file that fails at OpenDX run-time. +## +## Example 2: +## @example +## +## fpl_dx_write_field("field",msh1,u1,"density",1,0,0); +## fpl_dx_write_field("field",msh1,u2,"temperature",1,0,1); +## @end example +## will generate a valid OpenDX ASCII data file. +## +## @seealso{fpl_dx_write_series} +## +## @end deftypefn + +function fpl_dx_write_field(basename,mesh,u,attr_name,attr_rank,attr_shape,endfile) + + ## Check input + if nargin!=7 + error("fpl_dx_write_field: wrong number of input"); + endif + + if !ischar(basename) + error("fpl_dx_write_field: basename should be a valid string"); + elseif !( isstruct(mesh) ) + error("fpl_dx_write_field: mesh should be a valid structure"); + elseif !ismatrix(u) + error("fpl_dx_write_field: u should be a valid matrix"); + elseif !ischar(attr_name) + error("fpl_dx_write_field: attr_name should be a valid string"); + elseif !isscalar(attr_rank) + error("fpl_dx_write_field: attr_rank should be a valid scalar"); + elseif !isscalar(attr_shape) + error("fpl_dx_write_field: attr_shape should be a valid scalar"); + elseif !isscalar(endfile) + error("fpl_dx_write_field: endfile should be a valid scalar"); + endif + + filename = [basename ".dx"]; + + if ! exist(filename,"file") + ## If file does not exist, create it + fid = fopen (filename,"w"); + create = 1; + else + ## FIXME: the following should be performed in a cleaner way! Does a + ## backward fgetl function exist? + + ## If file exist, check if it was already closed + fid = fopen (filename,"r"); + fseek(fid,-4,SEEK_END); + tst = fgetl(fid); + if strcmp(tst,"end") + error("fpl_dx_write_field: file %s exist and was already closed",filename); + endif + fclose(fid); + fid = fopen(filename,"a"); + create = 0; + endif + + p = mesh.p'; + dim = columns(p); # 2D or 3D + + if dim == 2 + t = mesh.t(1:3,:)'; + elseif dim == 3 + t = mesh.t(1:4,:)'; + else + error("fpl_dx_write_field: neither 2D triangle nor 3D tetrahedral mesh"); + endif + + nnodes = rows(p); + nelems = rows(t); + ndatas = rows(u); + + if ndatas == nnodes + dep = "positions"; + elseif ndatas == nelems + dep = "connections"; + else + error("fpl_dx_write_field: neither position nor connection data type") + endif + + if create + ## If the file has just been created, print mesh information + print_grid(fid,dim,p,nnodes,t,nelems); + endif + ## Otherwise assume the mesh is consistent with the one in the file + ## and print only field information + print_data(fid,u,ndatas,dep,attr_name,attr_rank,attr_shape); + + if(endfile) + fprintf(fid,"\nend\n"); + endif + fclose (fid); + +endfunction + +## fprint a 2Dtrg or 3Dtet mesh +function print_grid(fid,dim,p,nnodes,t,nelems) + + fprintf(fid,"object ""pos""\n"); + fprintf(fid,"class array type float rank 1 shape %d items %d data follows",dim,nnodes); + + for ii = 1:nnodes + fprintf(fid,"\n"); + fprintf(fid," %1.7e",p(ii,:)); + endfor + + ## In DX format nodes are + ## numbered starting from zero, + ## instead we want to number + ## them starting from 1! + ## Here we restore the DX + ## format + if (min(min(t))==1) + t -= 1; + elseif(min(min(t))~=0) + error("fpl_dx_write_field: check triangle structure") + endif + + fprintf(fid,"\n\nobject ""con""\n"); + fprintf(fid,"class array type int rank 1 shape %d items %d data follows",dim+1,nelems); + for ii = 1:nelems + fprintf(fid,"\n"); + fprintf(fid," %d",t(ii,:)); + endfor + + fprintf(fid,"\n"); + if dim == 2 + fprintf(fid,"attribute ""element type"" string ""triangles""\n"); + elseif dim == 3 + fprintf(fid,"\nattribute ""element type"" string ""tetrahedra""\n"); + endif + fprintf(fid,"attribute ""ref"" string ""positions""\n\n"); + +endfunction + +## fprint data on a trg grid +function print_data(fid,u,ndatas,dep,attr_name,attr_rank,attr_shape) + + if ((attr_rank == 0) && (min(size(u))==1)) + fprintf(fid,"object ""%s.data""\n",attr_name); + fprintf(fid,"class array type double rank 0 items %d data follows",ndatas); + fprintf(fid,"\n %1.7e",u); + else + fprintf(fid,"object ""%s.data""\n",attr_name); + fprintf(fid,"class array type double rank %d shape %d items %d data follows",attr_rank,attr_shape,ndatas); + for ii=1:ndatas + fprintf(fid,"\n"); + fprintf(fid," %1.7e",u(ii,:)); + endfor + endif + + fprintf(fid,"\n"); + fprintf(fid,"attribute ""dep"" string ""%s"" \n\n",dep); + fprintf(fid,"object ""%s"" class field\n",attr_name); + fprintf(fid,"component ""positions"" value ""pos""\n"); + fprintf(fid,"component ""connections"" value ""con""\n"); + fprintf(fid,"component ""data"" value ""%s.data""\n",attr_name); + fprintf(fid,"\n"); +endfunction diff --git a/octave_packages/fpl-1.2.0/fpl_dx_write_series.m b/octave_packages/fpl-1.2.0/fpl_dx_write_series.m new file mode 100644 index 0000000..f1da4b0 --- /dev/null +++ b/octave_packages/fpl-1.2.0/fpl_dx_write_series.m @@ -0,0 +1,119 @@ +## Copyright (C) 2006,2007,2008,2009,2010 Carlo de Falco, Massimiliano Culpo +## +## This file is part of: +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## author: Carlo de Falco +## author: Massimiliano Culpo + +## -*- texinfo -*- +## @deftypefn {Function File} {} fpl_dx_write_series (@var{basename}, @ +## @var{mesh}, @var{u}, @var{sp}, @var{attr_name}, @var{attr_rank}, @ +## @var{attr_shape}) +## +## Output data series in ASCII Open-DX format. +## +## @var{basename} is a string containing the base-name of the dx file where the +## data will be saved. +## +## @var{mesh} is a PDE-tool like mesh, like the ones generated by the +## "msh" package. +## +## @var{u} is the series to be saved. It should represent scalar, vector +## or tensor of doubles. @var{sp} is the vector of the sampled points +## (e.g. time points in the case of a time series). +## +## @var{attr_name} is a descriptive name for the series @var{u}, while +## @var{attr_rank} is the rank of the field items (0 for scalar, 1 for +## vector, etc.) and @var{attr_shape} is the number of components of the +## field items (assumed 1 for scalar). +## +## @seealso{fpl_dx_write_field} +## +## @end deftypefn + +function fpl_dx_write_series(basename,mesh,u,tp,attr_name,attr_rank,attr_shape) + + ## FIXME: add append capabilities as in fpl_dx_write_field?? + + if nargin!=7 + error("fpl_dx_write_series: wrong number of input"); + endif + + if !ischar(basename) + error("fpl_dx_write_series: basename should be a valid string"); + elseif !( isstruct(mesh) ) + error("fpl_dx_write_series: mesh should be a valid structure"); + elseif !ismatrix(u) + error("fpl_dx_write_series: u should be a valid matrix"); + elseif !ischar(attr_name) + error("fpl_dx_write_series: attr_name should be a valid string"); + elseif !isscalar(attr_rank) + error("fpl_dx_write_series: attr_rank should be a valid scalar"); + elseif !isscalar(attr_shape) + error("fpl_dx_write_series: attr_shape should be a valid scalar"); + ##elseif !isscalar(endfile) + ##error("fpl_dx_write_series: endfile should be a valid scalar"); + endif + + filename = [basename ".dx"]; + + npoints = length(tp); + + p = mesh.p'; + dim = columns(p); # 2D or 3D + + if dim == 2 + t = mesh.t(1:3,:)'; + elseif dim == 3 + t = mesh.t(1:4,:)'; + else + error("fpl_dx_write_series: neither 2D triangle nor 3D tetrahedral mesh"); + endif + + nnodes = rows(p); + nelems = rows(t); + ndatas = rows(u); + + if ndatas == nnodes + dep = "positions"; + elseif ndatas == nelems + dep = "connections"; + else + error("fpl_dx_write_series: neither position nor connection data type") + endif + + ## Write field items to file + idx = (1:attr_shape); + for ii = 1:npoints + field = u(:,idx); + fname = sprintf("%s.%d",attr_name,ii); + fpl_dx_write_field(basename,mesh,field,fname,attr_rank,attr_shape,0); + idx += attr_shape; + endfor + + ##if endfile + fid = fopen(filename,"a"); + fprintf (fid, "object \"%s_series\" class series\n",attr_name); + for ii = 1:npoints + fname = sprintf("%s.%d",attr_name,ii); + fprintf (fid,"member %d position %g value \"%s\"\n",ii-1,tp(ii),fname); + endfor + fprintf (fid, "\nend\n"); + fclose(fid); + ##endif + +endfunction \ No newline at end of file diff --git a/octave_packages/fpl-1.2.0/fpl_vtk_write_field.m b/octave_packages/fpl-1.2.0/fpl_vtk_write_field.m new file mode 100644 index 0000000..f5108ec --- /dev/null +++ b/octave_packages/fpl-1.2.0/fpl_vtk_write_field.m @@ -0,0 +1,227 @@ +## Copyright (C) 2006,2007,2008,2009,2010 Carlo de Falco, Massimiliano Culpo +## +## This file is part of: +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## author: Carlo de Falco +## author: Massimiliano Culpo + +## -*- texinfo -*- +## @deftypefn {Function File} {} fpl_vtk_write_field (@var{basename}, @ +## @var{mesh}, @var{nodedata}, @var{celldata}, @var{endfile}) +## +## Output data field in serial XML-VTK UnstructuredGrid format. +## +## @var{basename} is a string containing the base-name of the (vtu) file +## where the data will be saved. +## +## @var{mesh} is a PDE-tool like mesh, like the ones generated by the +## "msh" package. +## +## @var{nodedata} and @var{celldata} are (Ndata x 2) cell arrays containing +## respectively and representing scalars or +## vectors: +## @itemize @minus +## @item @var{*data}@{:,1@} = variable data; +## @item @var{*data}@{:,2@} = variable names; +## @end itemize +## +## @var{endfile} should be 0 if you want to add other variables to the +## same file, 1 otherwise. +## +## Example: +## @example +## +## fpl_vtk_write_field("example",msh1,@{nc1, "temperature"@},@ +## @{cc1, "density"@},0); +## +## fpl_vtk_write_field("example",msh2,@{nc2, "temperature"@},@ +## @{@},1); +## @end example +## will generate a valid XML-VTK UnstructuredGrid file. +## +## @seealso{fpl_dx_write_field, fpl_dx_write_series} +## +## @end deftypefn + +function fpl_vtk_write_field(basename,mesh,nodedata,celldata,endfile) + + ## Check input + if nargin!=5 + error("fpl_vtk_write_field: wrong number of input"); + endif + + if !ischar(basename) + error("fpl_vtk_write_field: basename should be a valid string"); + elseif !( isstruct(mesh) ) + error("fpl_vtk_write_field: mesh should be a valid structure"); + elseif !(iscell(nodedata) && iscell(celldata)) + error("fpl_vtk_write_field: nodedata and celldata should be a valid cells"); + endif + + filename = [basename ".vtu"]; + + if ! exist(filename,"file") + fid = fopen (filename,"w"); + ## Header + fprintf (fid,"\n"); + fprintf (fid,"\n"); + fprintf (fid,"\n"); + else + ## FIXME: the following should be performed in a cleaner way! Does a + ## backward fgetl function exist? + + ## If file exist, check if it was already closed + fid = fopen (filename,"r"); + fseek(fid,-10,SEEK_END); + tst = fgetl(fid); + if strcmp(tst,"") + error("fpl_vtk_write_field: file %s exist and was already closed",filename); + endif + fclose(fid); + fid = fopen (filename,"a"); + endif + + p = mesh.p; + dim = rows(p); # 2D or 3D + + if dim == 2 + t = mesh.t(1:3,:); + elseif dim == 3 + t = mesh.t(1:4,:); + else + error("fpl_vtk_write_field: neither 2D triangle nor 3D tetrahedral mesh"); + endif + + t -= 1; + + nnodes = columns(p); + nelems = columns(t); + + ## Header for + fprintf (fid,"\n",nnodes,nelems); + ## Print grid + print_grid(fid,dim,p,nnodes,t,nelems); + ## Print PointData + print_data_points(fid,nodedata,nnodes) + print_cell_data (fid,celldata,nelems) + ## Footer for + fprintf (fid, "\n"); + + if (endfile) + ## Footer + fprintf (fid, "\n"); + fprintf (fid, ""); + endif + + fclose (fid); + +endfunction + +## Print Points and Cells Data +function print_grid(fid,dim,p,nnodes,t,nelems) + + if dim == 2 + p = [p; zeros(1,nnodes)]; + eltype = 5; + else + eltype = 10; + endif + + ## VTK-Points (mesh nodes) + fprintf (fid,"\n"); + fprintf (fid,"\n"); + fprintf (fid,"%g %g %g\n", p); + fprintf (fid,"\n"); + fprintf (fid,"\n"); + + ## VTK-Cells (mesh elements) + fprintf (fid, "\n"); + fprintf (fid, "\n"); + if dim == 2 + fprintf (fid, "%d %d %d \n", t); + else + fprintf (fid, "%d %d %d %d \n", t); + endif + fprintf (fid, "\n"); + fprintf (fid, "\n"); + fprintf (fid, "%d %d %d %d %d %d\n", (dim+1):(dim+1):((dim+1)*nelems)); + fprintf (fid, "\n"); + fprintf (fid, "\n"); + fprintf (fid, "%d %d %d %d %d %d\n", eltype*ones(nelems,1)); + fprintf (fid, "\n"); + fprintf (fid, "\n"); + +endfunction + +## Print DataPoints +function print_data_points(fid,nodedata,nnodes) + + ## # of data to print in + ## field + nvdata = size(nodedata,1); + + if (nvdata) + fprintf (fid, "\n"); + for ii = 1:nvdata + data = nodedata{ii,1}; + dataname = nodedata{ii,2}; + nsamples = rows(data); + ncomp = columns(data); + if nsamples != nnodes + error("fpl_vtk_write_field: wrong number of samples in ""%s""",dataname); + endif + fprintf (fid,"\n",ncomp); + for jj = 1:nsamples + fprintf (fid,"%g ",data(jj,:)); + fprintf (fid,"\n"); + endfor + fprintf (fid,"\n"); + endfor + fprintf (fid, "\n"); + endif + +endfunction + +function print_cell_data(fid,celldata,nelems) + + ## # of data to print in + ## field + nvdata = size(celldata,1); + + if (nvdata) + fprintf (fid, "\n"); + for ii = 1:nvdata + data = celldata{ii,1}; + dataname = celldata{ii,2}; + nsamples = rows(data); + ncomp = columns(data); + if nsamples != nelems + error("fpl_vtk_write_field: wrong number of samples in ""%s""",dataname); + endif + fprintf (fid,"\n",ncomp); + for jj = 1:nsamples + fprintf (fid,"%g ",data(jj,:)); + fprintf (fid,"\n"); + endfor + fprintf (fid,"\n"); + endfor + fprintf (fid, "\n"); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/fpl-1.2.0/packinfo/.autoload b/octave_packages/fpl-1.2.0/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/fpl-1.2.0/packinfo/DESCRIPTION b/octave_packages/fpl-1.2.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..83eb389 --- /dev/null +++ b/octave_packages/fpl-1.2.0/packinfo/DESCRIPTION @@ -0,0 +1,13 @@ +Name: fpl +Version: 1.2.0 +Date: 2010-06-12 +Author: Carlo de Falco, Massimiliano Culpo +Maintainer: Carlo de Falco, Massimiliano Culpo +Title: Fem PLotting +Description: Collection of routines to save data in different graphical formats. +Categories: Graphics +Depends: octave ( >= 3.0.0 ) +License: GNU/GPL +SystemRequirements: dx ( >= 4.3.2), sed, bash +SVNRelease: 7425 +Autoload: yes diff --git a/octave_packages/fpl-1.2.0/packinfo/INDEX b/octave_packages/fpl-1.2.0/packinfo/INDEX new file mode 100644 index 0000000..21f17de --- /dev/null +++ b/octave_packages/fpl-1.2.0/packinfo/INDEX @@ -0,0 +1,25 @@ +FPL >> FEM Plotting +Functions to save data in DX format + fpl_dx_write_field.m + fpl_dx_write_series.m +Functions to save data in VTK format + fpl_vtk_write_field.m +Pdetool compatible plotting functions + pdesurf + pdemesh +Legacy DX export functions + FPL2dxappenddata + FPL2dxoutputdata + FPL2dxoutputtimeseries + FPL3dxoutputmesh + FPL3dxoutputfield +Legacy DX wrappers + FPL2pdeshowmesh + FPL2ptcshowmesh + FPL2pdesurf + FPL2ptcsurf + FPL2trspdesurf + FPL2trsptcsurf + FPL2pdequiver + FPL2ptcquiver + FPL2vtkoutputdata diff --git a/octave_packages/fpl-1.2.0/pdemesh.m b/octave_packages/fpl-1.2.0/pdemesh.m new file mode 100644 index 0000000..95e526b --- /dev/null +++ b/octave_packages/fpl-1.2.0/pdemesh.m @@ -0,0 +1,69 @@ +## Copyright (C) 2010 Carlo de Falco +## +## This file is part of: +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} pdemesh (@var{p}, @var{e}, @var{t}, @var{u}) +## +## Plot a triangular mesh in 3D given a mesh structure and node data. +## @var{p}, @var{t} are the mesh vertices and connectivity, @var{u} node data. +## @var{e} is ignored and is accepted only for compatibiity. +## +## @seealso{fpl_dx_write_field, fpl_vtk_write_field} +## +## @end deftypefn + +function h = pdemesh (p, e, t, u) + + ## Check input + if (nargin < 3) + error("pdemesh: wrong number of input parameters"); + elseif (nargin == 3) + u = zeros (1, columns (p)); + endif + + nel = columns (t); + npt = columns (p); + if (numel (u) != npt) + error("pdemesh: wrong data size"); + endif + + hs = ishold (); + +### node data + H = trimesh (t(1:3, :).', p(1,:).', p(2,:).', u(:)); + + if (nargout == 1) + h = H; + endif + + if (hs) + hold on; + else + hold off; + endif + +endfunction + +%!demo +%! msh = msh2m_structured_mesh ([0:.05:1], [0:.1:1], 1, 1:4, 'random'); +%! x = msh.p(1,:)'; xm = sum(x(msh.t(1:3,:)),1)/3; +%! y = msh.p(2,:)'; ym = sum(y(msh.t(1:3,:)),1)/3; +%! pdemesh (msh.p, msh.t, msh.t, x.*(1-x).*y.*(1-y)) +%! view(3) diff --git a/octave_packages/fpl-1.2.0/pdesurf.m b/octave_packages/fpl-1.2.0/pdesurf.m new file mode 100644 index 0000000..ec688d2 --- /dev/null +++ b/octave_packages/fpl-1.2.0/pdesurf.m @@ -0,0 +1,92 @@ +## Copyright (C) 2010 Carlo de Falco +## +## This file is part of: +## FPL - Fem PLotting package for octave +## +## FPL is free software; you can 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. +## +## FPL is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with FPL; If not, see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} pdesurf (@var{p}, @var{t}, @var{u}) +## +## Plot a 3D surface given node or element data on a triangular mesh. +## @var{p}, @var{t} are the mesh vertices and connectivity, @var{u} node or element data. +## +## @seealso{fpl_dx_write_field, fpl_vtk_write_field} +## +## @end deftypefn + +function h = pdesurf (p, t, u) + + ## Check input + if nargin!=3 + error("pdesurf: wrong number of input parameters"); + endif + + nel = columns (t); + npt = columns (p); + if (numel (u) != npt && numel (u) != nel) + error("pdesurf: wrong data size"); + endif + + hs = ishold (); + +### node data + if (numel (u) == npt) + ## normalize data + c = colormap; + uc = sum (u(t(1:3, :)), 1)/3; + uc = floor ((rows (c)-1)*(uc - min (uc))/(max (uc) - min (uc))) + 1; + H = patch ('Faces', t(1:3, :)', + 'Vertices', [p(1,:)', p(2,:)', u], + 'FaceVertexCData', c(uc(:), :)); +### triangle data + elseif (numel (u) == nel) + tri = reshape (1:3*nel, 3, [])'; + pt(:, 1) = p(1, t(1:3, :)); + pt(:, 2) = p(2, t(1:3, :)); + pt(:, 3) = repmat (u(:)', 3, 1)(:); + ## normalize data + c = colormap; + uc = floor ((rows (c)-1)*(u - min (u))/(max (u) - min (u))) + 1; + H = patch ('Faces', tri, + 'Vertices', pt, + 'FaceVertexCData', c(uc(:), :), + 'FaceColor', 'flat'); + endif + + if (nargout == 1) + h = H; + endif + + if (hs) + hold on; + else + hold off; + endif + +endfunction + +%!demo +%! msh = msh2m_structured_mesh ([0:.05:1], [0:.1:1], 1, 1:4, 'random'); +%! x = msh.p(1,:)'; xm = sum(x(msh.t(1:3,:)),1)/3; +%! y = msh.p(2,:)'; ym = sum(y(msh.t(1:3,:)),1)/3; +%! pdesurf (msh.p, msh.t, x.*(1-x).*y.*(1-y)) +%! title ('node data') +%! view(3) +%! figure () +%! pdesurf (msh.p, msh.t, xm.*(1-xm).*ym.*(1-ym)) +%! title ('element data') +%! view(3) \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/__ga_crossoverfcn__.m b/octave_packages/ga-0.10.0/__ga_crossoverfcn__.m new file mode 100644 index 0000000..35550d9 --- /dev/null +++ b/octave_packages/ga-0.10.0/__ga_crossoverfcn__.m @@ -0,0 +1,33 @@ +## Copyright (C) 2008 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 1.3.3 + +function xoverKids = __ga_crossoverfcn__ (parents, options, nvars, FitnessFcn, + unused, + thisPopulation) + + ## preconditions + nc_parents = columns (parents); + if (rem (nc_parents, 2) != 0) + error ("'parents' must have an even number of columns"); + endif + + xoverKids(1:(nc_parents / 2), 1:nvars) = options.CrossoverFcn \ + (parents(1, 1:nc_parents), options, nvars, FitnessFcn, + unused, + thisPopulation(:, 1:nvars)); +endfunction \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/__ga_initial_population__.m b/octave_packages/ga-0.10.0/__ga_initial_population__.m new file mode 100644 index 0000000..5953d07 --- /dev/null +++ b/octave_packages/ga-0.10.0/__ga_initial_population__.m @@ -0,0 +1,92 @@ +## Copyright (C) 2008, 2010 Luca Favatella +## +## 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{Population} =} __ga_initial_population__ (@var{GenomeLength}, @var{FitnessFcn}, @var{options}) +## Create an initial population. +## +## @seealso{__ga_problem__} +## @end deftypefn + +## Author: Luca Favatella +## Version: 3.3 + + #TODO consider PopulationSize as a + #vector for multiple subpopolations + +function Population = \ + __ga_initial_population__ (GenomeLength, FitnessFcn, options) + if (isempty (options.InitialPopulation)) + Population(1:options.PopulationSize, 1:GenomeLength) = \ + options.CreationFcn (GenomeLength, FitnessFcn, options); + else + if (columns (options.InitialPopulation) != GenomeLength) ## columns (InitialPopulation) > 0 + error ("nonempty 'InitialPopulation' must have 'GenomeLength' columns"); + else ## rows (InitialPopulation) > 0 + nrIP = rows (options.InitialPopulation); + if (nrIP > options.PopulationSize) + error ("nonempty 'InitialPopulation' must have no more than \ + 'PopulationSize' rows"); + elseif (nrIP == options.PopulationSize) + Population(1:options.PopulationSize, 1:GenomeLength) = \ + options.InitialPopulation; + else # rows (InitialPopulation) < PopulationSize + + ## create a complete new population, and then select only needed + ## individuals (creating only a partial population is difficult) + CreatedPopulation(1:options.PopulationSize, 1:GenomeLength) = \ + options.CreationFcn (GenomeLength, FitnessFcn, options); + Population(1:options.PopulationSize, 1:GenomeLength) = vertcat \ + (options.InitialPopulation(1:nrIP, 1:GenomeLength), + CreatedPopulation(1:(options.PopulationSize - nrIP), + 1:GenomeLength)); + endif + endif + endif +endfunction + + +%!test +%! GenomeLength = 2; +%! options = gaoptimset (); +%! Population = __ga_initial_population__ (GenomeLength, @rastriginsfcn, options); +%! assert (size (Population), [options.PopulationSize, GenomeLength]); + +%!test +%! GenomeLength = 2; +%! options = gaoptimset ("InitialPopulation", [1, 2; 3, 4; 5, 6]); +%! Population = __ga_initial_population__ (GenomeLength, @rastriginsfcn, options); +%! assert (size (Population), [options.PopulationSize, GenomeLength]); + + +## nonempty 'InitialPopulation' must have 'GenomeLength' columns + +%!error +%! GenomeLength = 2; +%! options = gaoptimset ("InitialPopulation", [1; 3; 5]); +%! __ga_initial_population__ (GenomeLength, @rastriginsfcn, options); + +%!error +%! GenomeLength = 2; +%! options = gaoptimset ("InitialPopulation", [1, 1, 1; 3, 3, 3; 5, 5, 5]); +%! __ga_initial_population__ (GenomeLength, @rastriginsfcn, options); + + +## nonempty 'InitialPopulation' must have no more than 'PopulationSize' rows + +%!error +%! GenomeLength = 2; +%! options = gaoptimset ("InitialPopulation", [1, 2; 3, 4; 5, 6], "PopulationSize", 2); +%! __ga_initial_population__ (GenomeLength, @rastriginsfcn, options); diff --git a/octave_packages/ga-0.10.0/__ga_mutationfcn__.m b/octave_packages/ga-0.10.0/__ga_mutationfcn__.m new file mode 100644 index 0000000..77c5c8a --- /dev/null +++ b/octave_packages/ga-0.10.0/__ga_mutationfcn__.m @@ -0,0 +1,27 @@ +## Copyright (C) 2008 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 1.3 + +function mutationChildren = \ + __ga_mutationfcn__ (parents, options, nvars, FitnessFcn, + state, thisScore, + thisPopulation) + mutationChildren(1:(columns (parents)), 1:nvars) = \ + options.MutationFcn{1, 1} (parents(1, :), options, nvars, FitnessFcn, + state, thisScore, + thisPopulation(:, 1:nvars)); +endfunction \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/__ga_popinitrange__.m b/octave_packages/ga-0.10.0/__ga_popinitrange__.m new file mode 100644 index 0000000..cccd308 --- /dev/null +++ b/octave_packages/ga-0.10.0/__ga_popinitrange__.m @@ -0,0 +1,28 @@ +## Copyright (C) 2008 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 2.1 + +function [LB UB] = __ga_popinitrange__ (PopInitRange, nvars) + switch (columns (PopInitRange)) + case 1 + tmpPIR(1:2, 1:nvars) = PopInitRange(1:2, 1) * ones (1, nvars); + case nvars + tmpPIR(1:2, 1:nvars) = PopInitRange(1:2, 1:nvars); + endswitch + LB(1, 1:nvars) = tmpPIR(1, 1:nvars); + UB(1, 1:nvars) = tmpPIR(2, 1:nvars); +endfunction \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/__ga_problem__.m b/octave_packages/ga-0.10.0/__ga_problem__.m new file mode 100644 index 0000000..7f5be4c --- /dev/null +++ b/octave_packages/ga-0.10.0/__ga_problem__.m @@ -0,0 +1,102 @@ +## Copyright (C) 2008 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 5.9 + +function [x fval exitflag output population scores] = __ga_problem__ (problem) + + ## first instruction + state.StartTime = time (); + + ## second instruction + output = struct ("randstate", rand ("state"), + "randnstate", randn ("state")); + + ## instructions not to be executed at each generation + state.Population(1:problem.options.PopulationSize, 1:problem.nvars) = \ + __ga_initial_population__ (problem.nvars, + problem.fitnessfcn, + problem.options); + state.Generation = 0; + private_state = __ga_problem_private_state__ (problem.options); + state.Selection = __ga_problem_state_selection__ (private_state, + problem.options); + + ## instructions to be executed at each generation + state = __ga_problem_update_state_at_each_generation__ (state, problem, + private_state); + + NextPopulation = zeros (problem.options.PopulationSize, problem.nvars); + while (! __ga_stop__ (problem, state)) ## fix a generation + + ## elite + if (private_state.ReproductionCount.elite > 0) + [trash IndexSortedScores] = sort (state.Score); + NextPopulation(state.Selection.elite, 1:problem.nvars) = \ + state.Population \ + (IndexSortedScores(1:private_state.ReproductionCount.elite, 1), + 1:problem.nvars); + endif + + ## selection for crossover and mutation + parents(1, 1:private_state.nParents) = __ga_selectionfcn__ \ + (state.Expectation, private_state.nParents, problem.options); + + ## crossover + if (private_state.ReproductionCount.crossover > 0) + NextPopulation(state.Selection.crossover, 1:problem.nvars) = \ + __ga_crossoverfcn__ \ + (parents(1, private_state.parentsSelection.crossover), + problem.options, problem.nvars, problem.fitnessfcn, + false, ## unused + state.Population); + endif + + ## mutation + if (private_state.ReproductionCount.mutation > 0) + NextPopulation(state.Selection.mutation, 1:problem.nvars) = \ + __ga_mutationfcn__ \ + (parents(1, private_state.parentsSelection.mutation), + problem.options, problem.nvars, problem.fitnessfcn, + state, state.Score, + state.Population); + endif + + ## update state structure + state.Population(1:problem.options.PopulationSize, + 1:problem.nvars) = NextPopulation; + state.Generation++; + state = __ga_problem_update_state_at_each_generation__ (state, problem, + private_state); + endwhile + + [x fval exitflag output population scores] = \ + __ga_problem_return_variables__ (state, problem); +endfunction + + #state structure fields + #DONE state.Population + #DONE state.Score + #DONE state.Generation + #DONE state.StartTime + #state.StopFlag + #DONE state.Selection + #DONE state.Expectation + #DONE state.Best + #state.LastImprovement + #state.LastImprovementTime + #state.NonlinIneq + #state.NonlinEq \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/__ga_problem_private_state__.m b/octave_packages/ga-0.10.0/__ga_problem_private_state__.m new file mode 100644 index 0000000..28fffc2 --- /dev/null +++ b/octave_packages/ga-0.10.0/__ga_problem_private_state__.m @@ -0,0 +1,49 @@ +## Copyright (C) 2008 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 1.1.1 + +function private_state = __ga_problem_private_state__ (options) + private_state.ReproductionCount.elite = options.EliteCount; + private_state.ReproductionCount.crossover = \ + fix (options.CrossoverFraction * + (options.PopulationSize - options.EliteCount)); + private_state.ReproductionCount.mutation = \ + options.PopulationSize - \ + (private_state.ReproductionCount.elite + + private_state.ReproductionCount.crossover); + assert (private_state.ReproductionCount.elite + + private_state.ReproductionCount.crossover + + private_state.ReproductionCount.mutation, + options.PopulationSize); ## DEBUG + + private_state.parentsCount.crossover = \ + 2 * private_state.ReproductionCount.crossover; + private_state.parentsCount.mutation = \ + 1 * private_state.ReproductionCount.mutation; + private_state.nParents = \ + private_state.parentsCount.crossover + \ + private_state.parentsCount.mutation; + + private_state.parentsSelection.crossover = \ + 1:private_state.parentsCount.crossover; + private_state.parentsSelection.mutation = \ + private_state.parentsCount.crossover + \ + (1:private_state.parentsCount.mutation); + assert (length (private_state.parentsSelection.crossover) + + length (private_state.parentsSelection.mutation), + private_state.nParents); ## DEBUG +endfunction \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/__ga_problem_return_variables__.m b/octave_packages/ga-0.10.0/__ga_problem_return_variables__.m new file mode 100644 index 0000000..1849777 --- /dev/null +++ b/octave_packages/ga-0.10.0/__ga_problem_return_variables__.m @@ -0,0 +1,38 @@ +## Copyright (C) 2008 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 1.1 + +function [x fval exitflag output population scores] = \ + __ga_problem_return_variables__ (state, problem) + [trash IndexMinScore] = min (state.Score); + x = state.Population(IndexMinScore, 1:problem.nvars); + + fval = problem.fitnessfcn (x); + + #TODO exitflag + + ## output.randstate and output.randnstate must be assigned at the + ## start of the algorithm + output.generations = state.Generation; + #TODO output.funccount + #TODO output.message + #TODO output.maxconstraint + + population = state.Population; + + scores = state.Score; +endfunction \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/__ga_problem_state_selection__.m b/octave_packages/ga-0.10.0/__ga_problem_state_selection__.m new file mode 100644 index 0000000..eb10776 --- /dev/null +++ b/octave_packages/ga-0.10.0/__ga_problem_state_selection__.m @@ -0,0 +1,32 @@ +## Copyright (C) 2008 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 1.1.1 + +function Selection = __ga_problem_state_selection__ (private_state, options) + Selection.elite = 1:private_state.ReproductionCount.elite; + Selection.crossover = \ + private_state.ReproductionCount.elite + \ + (1:private_state.ReproductionCount.crossover); + Selection.mutation = \ + private_state.ReproductionCount.elite + \ + private_state.ReproductionCount.crossover + \ + (1:private_state.ReproductionCount.mutation); + #assert (length (Selection.elite) + + # length (Selection.crossover) + + # length (Selection.mutation), + # options.PopulationSize); ##DEBUG +endfunction \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/__ga_problem_update_state_at_each_generation__.m b/octave_packages/ga-0.10.0/__ga_problem_update_state_at_each_generation__.m new file mode 100644 index 0000000..990fd5d --- /dev/null +++ b/octave_packages/ga-0.10.0/__ga_problem_update_state_at_each_generation__.m @@ -0,0 +1,48 @@ +## Copyright (C) 2008, 2010 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 1.3.1 + +function state = \ + __ga_problem_update_state_at_each_generation__ (state, problem, + private_state) + if ((state.Generation > 0) || isempty (problem.options.InitialScores)) + state.Score(1:problem.options.PopulationSize, 1) = \ + __ga_scores__ (problem, state.Population); + else ## (Generation == 0) && (! isempty (InitialScores)) + nrIS = rows (problem.options.InitialScores); + #assert (rows (problem.options.InitialPopulation) <= problem.options.PopulationSize); ## DEBUG + if (nrIS <= rows (problem.options.InitialPopulation)) + missing_rows = (nrIS+1):problem.options.PopulationSize; + state.Score(1:problem.options.PopulationSize, 1) = \ + [problem.options.InitialScores(:, 1); + (__ga_scores__ (problem, state.Population(missing_rows, :))) + ]; + else + error ("rows (InitialScores) > rows (InitialPopulation)"); + endif + endif + state.Expectation(1, 1:problem.options.PopulationSize) = \ + problem.options.FitnessScalingFcn (state.Score, private_state.nParents); + state.Best(state.Generation + 1, 1) = min (state.Score); +endfunction + + +%!error +%! state.Generation = 0; +%! problem = struct ("fitnessfcn", @rastriginsfcn, "nvars", 2, "options", gaoptimset ("Generations", 10, "InitialScores", [0; 0; 0])); +%! unused = 0; +%! __ga_problem_update_state_at_each_generation__ (state, problem, unused); \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/__ga_scores__.m b/octave_packages/ga-0.10.0/__ga_scores__.m new file mode 100644 index 0000000..d865a65 --- /dev/null +++ b/octave_packages/ga-0.10.0/__ga_scores__.m @@ -0,0 +1,48 @@ +## Copyright (C) 2008, 2010 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 5.7 + +function Scores = __ga_scores__ (problem, Population) + [nrP ncP] = size (Population); + switch problem.options.Vectorized + case "on" ## using vectorized evaluation + switch problem.options.UseParallel + case "always" + warning ("'Vectorized' option is 'on': ignoring 'UseParallel' option, even if it is 'always'"); + case "never" + ## Nothing. + otherwise + warning ("'Vectorized' option is 'on': ignoring invalid 'UseParallel' option value (it should be 'always' or 'never')"); + endswitch + Scores = (problem.fitnessfcn (Population))(1:nrP, 1); + case "off" ## not using vectorized evaluation + switch problem.options.UseParallel + case "always" ## using parallel evaluation + error ("TODO: implement parallel evaluation of objective function"); + case "never" ## using serial evaluation (i.e. loop) + tmp = zeros (nrP, 1); + for index = 1:nrP + tmp(index, 1) = problem.fitnessfcn (Population(index, 1:ncP)); + endfor + Scores = tmp(1:nrP, 1); + otherwise + error ("'UseParallel' option must be 'always' or 'never'"); + endswitch + otherwise + error ("'Vectorized' option must be 'on' or 'off'"); + endswitch +endfunction diff --git a/octave_packages/ga-0.10.0/__ga_selectionfcn__.m b/octave_packages/ga-0.10.0/__ga_selectionfcn__.m new file mode 100644 index 0000000..eb9df6c --- /dev/null +++ b/octave_packages/ga-0.10.0/__ga_selectionfcn__.m @@ -0,0 +1,22 @@ +## Copyright (C) 2008 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 1.2 + +function parents = __ga_selectionfcn__ (expectation, nParents, options) + parents(1, 1:nParents) = \ + options.SelectionFcn (expectation(1, :), nParents, options); +endfunction \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/__ga_stop__.m b/octave_packages/ga-0.10.0/__ga_stop__.m new file mode 100644 index 0000000..15e1945 --- /dev/null +++ b/octave_packages/ga-0.10.0/__ga_stop__.m @@ -0,0 +1,39 @@ +## Copyright (C) 2008 Luca Favatella +## +## 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{stop} =} __ga_stop__ (@var{problem}, @var{state}) +## Determine whether the genetic algorithm should stop. +## +## @seealso{__ga_problem__} +## @end deftypefn + +## Author: Luca Favatella +## Version: 5.1 + +function stop = __ga_stop__ (problem, state) + Generations = \ + (state.Generation >= problem.options.Generations); + + TimeLimit = \ + ((time () - state.StartTime) >= problem.options.TimeLimit); + + FitnessLimit = \ + (state.Best(state.Generation + 1, 1) <= problem.options.FitnessLimit); + + stop = (Generations || + TimeLimit || + FitnessLimit); +endfunction \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/__gaoptimset_default_options__.m b/octave_packages/ga-0.10.0/__gaoptimset_default_options__.m new file mode 100644 index 0000000..441e1d6 --- /dev/null +++ b/octave_packages/ga-0.10.0/__gaoptimset_default_options__.m @@ -0,0 +1,53 @@ +## Copyright (C) 2008, 2009, 2010 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 1.2.3 + +function default_options = __gaoptimset_default_options__ () + default_options.CreationFcn = @gacreationuniform; + default_options.CrossoverFcn = @crossoverscattered; + default_options.CrossoverFraction = 0.8; + #default_options.Display = "final"; + #default_options.DistanceMeasureFcn gamultiobj + default_options.EliteCount = 2; + default_options.FitnessLimit = -Inf; + default_options.FitnessScalingFcn = @fitscalingrank; + default_options.Generations = 100; + #default_options.HybridFcn = []; + #default_options.InitialPenalty = 10; + default_options.InitialPopulation = []; + default_options.InitialScores = []; + #default_options.MigrationDirection = "forward"; + #default_options.MigrationFraction = 0.2; + #default_options.MigrationInterval = 20; + default_options.MutationFcn = {@mutationgaussian, 1, 1}; + #default_options.OutputFcns = []; + #default_options.ParetoFraction = 0.35; + #default_options.PenaltyFactor = 100; + #default_options.PlotFcns = []; + #default_options.PlotInterval = 1; + default_options.PopInitRange = [0; 1]; + default_options.PopulationSize = 20; + #default_options.PopulationType = "doubleVector"; + default_options.SelectionFcn = @selectionstochunif; + #default_options.StallGenLimit = 50; + #default_options.StallTimeLimit = Inf; + default_options.TimeLimit = Inf; + #default_options.TolCon = 1e-6; + #default_options.TolFun = 1e-6; + default_options.UseParallel = "never"; + default_options.Vectorized = "off"; +endfunction \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/crossoverscattered.m b/octave_packages/ga-0.10.0/crossoverscattered.m new file mode 100644 index 0000000..db5a8db --- /dev/null +++ b/octave_packages/ga-0.10.0/crossoverscattered.m @@ -0,0 +1,49 @@ +## Copyright (C) 2008, 2009, 2011 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 7.0 + +function xoverKids = crossoverscattered (parents, options, nvars, FitnessFcn, + unused, + thisPopulation) + + ## simplified example (nvars == 4) + ## p1 = [varA varB varC varD] + ## p2 = [var1 var2 var3 var4] + ## b = [1 1 0 1] + ## child = [varA varB var3 varD] + nc_parents = columns (parents); + n_children = nc_parents / 2; + p1(1:n_children, 1:nvars) = \ + thisPopulation(parents(1, 1:n_children), 1:nvars); + p2(1:n_children, 1:nvars) = \ + thisPopulation(parents(1, n_children + (1:n_children)), 1:nvars); + b(1:n_children, 1:nvars) = randi (1, n_children, nvars); ## TODO: test randi + xoverKids(1:n_children, 1:nvars) = \ + b .* p1 + (ones (n_children, nvars) - b) .* p2; +endfunction + + +## number of input arguments +# TODO + +## number of output arguments +# TODO + +## type of arguments +# TODO + +# TODO diff --git a/octave_packages/ga-0.10.0/doc-cache b/octave_packages/ga-0.10.0/doc-cache new file mode 100644 index 0000000..aa9569f --- /dev/null +++ b/octave_packages/ga-0.10.0/doc-cache @@ -0,0 +1,378 @@ +# Created by Octave 3.6.1, Wed Apr 18 13:13:19 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 9 +# name: +# type: sq_string +# elements: 1 +# length: 18 +crossoverscattered + + +# name: +# type: sq_string +# elements: 1 +# length: 135 + simplified example (nvars == 4) + p1 = [varA varB varC varD] + p2 = [var1 var2 var3 var4] + b = [1 1 0 1] + child = [varA varB var3 varD] + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + simplified example (nvars == 4) + p1 = [varA varB varC varD] + p2 = [var1 var2 va + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +fitscalingrank + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +TODO +ranks ([7,2,2]) == [3.0,1.5,1.5] +is [3,1,2] (or [3,2,1]) useful? + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 +TODO +ranks ([7,2,2]) == [3. + + + +# name: +# type: sq_string +# elements: 1 +# length: 2 +ga + + +# name: +# type: sq_string +# elements: 1 +# length: 1866 + -- Function File: X = ga (FITNESSFCN, NVARS) + -- Function File: X = ga (FITNESSFCN, NVARS, A, B) + -- Function File: X = ga (FITNESSFCN, NVARS, A, B, AEQ, BEQ) + -- Function File: X = ga (FITNESSFCN, NVARS, A, B, AEQ, BEQ, LB, UB) + -- Function File: X = ga (FITNESSFCN, NVARS, A, B, AEQ, BEQ, LB, UB, + NONLCON) + -- Function File: X = ga (FITNESSFCN, NVARS, A, B, AEQ, BEQ, LB, UB, + NONLCON, OPTIONS) + -- Function File: X = ga (PROBLEM) + -- Function File: [X, FVAL] = ga (...) + -- Function File: [X, FVAL, EXITFLAG] = ga (...) + -- Function File: [X, FVAL, EXITFLAG, OUTPUT] = ga (...) + -- Function File: [X, FVAL, EXITFLAG, OUTPUT, POPULATION] = ga (...) + -- Function File: [X, FVAL, EXITFLAG, OUTPUT, POPULATION, SCORES] = ga + (...) + Find minimum of function using genetic algorithm. + + *Inputs* + FITNESSFCN + The objective function to minimize. It accepts a vector X of + size 1-by-NVARS, and returns a scalar evaluated at X. + + NVARS + The dimension (number of design variables) of FITNESSFCN. + + OPTIONS + The structure of the optimization parameters; can be created + using the `gaoptimset' function. If not specified, `ga' + minimizes with the default optimization parameters. + + PROBLEM + A structure containing the following fields: + * `fitnessfcn' + + * `nvars' + + * `Aineq' + + * `Bineq' + + * `Aeq' + + * `Beq' + + * `lb' + + * `ub' + + * `nonlcon' + + * `randstate' + + * `randnstate' + + * `solver' + + * `options' + + *Outputs* + X + The local unconstrained found minimum to the objective + function, FITNESSFCN. + + FVAL + The value of the fitness function at X. + + See also: gaoptimset + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Find minimum of function using genetic algorithm. + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +gacreationuniform + + +# name: +# type: sq_string +# elements: 1 +# length: 487 + -- Function File: POPULATION = gacreationuniform (GENOMELENGTH, + FITNESSFCN, OPTIONS) + Create a random initial population with a uniform distribution. + + *Inputs* + GENOMELENGTH + The number of indipendent variables for the fitness function. + + FITNESSFCN + The fitness function. + + OPTIONS + The options structure. + + *Outputs* + POPULATION + The initial population for the genetic algorithm. + + See also: ga, gaoptimset + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Create a random initial population with a uniform distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +gaoptimset + + +# name: +# type: sq_string +# elements: 1 +# length: 1242 + -- Function File: OPTIONS = gaoptimset + -- Function File: OPTIONS = gaoptimset ('PARAM1', VALUE1, 'PARAM2', + VALUE2, ...) + Create genetic algorithm options structure. + + *Inputs* + PARAM + Parameter to set. Unspecified parameters are set to their + default values; specifying no parameters is allowed. + + VALUE + Value of PARAM. + + *Outputs* + OPTIONS + Structure containing the options, or parameters, for the + genetic algorithm. + + *Options* + `CreationFcn' + + `CrossoverFcn' + + `CrossoverFraction' + + `EliteCount' + + `FitnessLimit' + + `FitnessScalingFcn' + + `Generations' + + `InitialPopulation' + Can be partial. + + `InitialScores' + column vector | [] (default) . Can be partial. + + `MutationFcn' + + `PopInitRange' + + `PopulationSize' + + `SelectionFcn' + + `TimeLimit' + + `UseParallel' + "always" | "never" (default) . Parallel evaluation of + objective function. TODO: parallel evaluation of nonlinear + constraints + + `Vectorized' + "on" | "off" (default) . Vectorized evaluation of objective + function. TODO: vectorized evaluation of nonlinear constraints + + See also: ga + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Create genetic algorithm options structure. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +mutationgaussian + + +# name: +# type: sq_string +# elements: 1 +# length: 30 + start mutationgaussian logic + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 + start mutationgaussian logic + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +rastriginsfcn + + +# name: +# type: sq_string +# elements: 1 +# length: 69 + -- Function File: Y = rastriginsfcn (X) + Rastrigin's function. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +Rastrigin's function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 18 +selectionstochunif + + +# name: +# type: sq_string +# elements: 1 +# length: 104 + fix an entry of the steps (or parents) vector +assert (steps(1, index_steps) < max_step_size); ## DEBUG + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + fix an entry of the steps (or parents) vector +assert (steps(1, index_steps) < m + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +test_ga + + +# name: +# type: sq_string +# elements: 1 +# length: 69 + -- Script File: test_ga + Execute all available tests at once. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Execute all available tests at once. + + + + + diff --git a/octave_packages/ga-0.10.0/fitscalingrank.m b/octave_packages/ga-0.10.0/fitscalingrank.m new file mode 100644 index 0000000..65dee7e --- /dev/null +++ b/octave_packages/ga-0.10.0/fitscalingrank.m @@ -0,0 +1,55 @@ +## Copyright (C) 2008, 2009 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 1.3.3 + +function expectation = fitscalingrank (scores, nParents) + nr_scores = rows (scores); + r(1, 1:nr_scores) = ranks (scores(1:nr_scores, 1)); + #TODO + #ranks ([7,2,2]) == [3.0,1.5,1.5] + #is [3,1,2] (or [3,2,1]) useful? + expectation_wo_nParents(1, 1:nr_scores) = arrayfun (@(n) 1 / sqrt (n), r); + expectation(1, 1:nr_scores) = \ + (nParents / sum (expectation_wo_nParents)) * \ + expectation_wo_nParents; +endfunction + + +## number of input arguments +# TODO + +## number of output arguments +# TODO + +## type of arguments +# TODO + +# TODO + +%!shared scores, nParents, expectation +%! scores = rand (20, 1); +%! nParents = 32; +%! expectation = fitscalingrank (scores, nParents); +%!assert (sum (expectation), nParents, 1e-9); +%!test +%! [trash index_min_scores] = min (scores); +%! [trash index_max_expectation] = max (expectation); +%! assert (index_min_scores, index_max_expectation); +%!test +%! [trash index_max_scores] = max (scores); +%! [trash index_min_expectation] = min (expectation); +%! assert (index_max_scores, index_min_expectation); \ No newline at end of file diff --git a/octave_packages/ga-0.10.0/ga.m b/octave_packages/ga-0.10.0/ga.m new file mode 100644 index 0000000..8949b40 --- /dev/null +++ b/octave_packages/ga-0.10.0/ga.m @@ -0,0 +1,372 @@ +## Copyright (C) 2008, 2010, 2012 Luca Favatella +## +## 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} =} ga (@var{fitnessfcn}, @var{nvars}) +## @deftypefnx{Function File} {@var{x} =} ga (@var{fitnessfcn}, @var{nvars}, @var{A}, @var{b}) +## @deftypefnx{Function File} {@var{x} =} ga (@var{fitnessfcn}, @var{nvars}, @var{A}, @var{b}, @var{Aeq}, @var{beq}) +## @deftypefnx{Function File} {@var{x} =} ga (@var{fitnessfcn}, @var{nvars}, @var{A}, @var{b}, @var{Aeq}, @var{beq}, @var{LB}, @var{UB}) +## @deftypefnx{Function File} {@var{x} =} ga (@var{fitnessfcn}, @var{nvars}, @var{A}, @var{b}, @var{Aeq}, @var{beq}, @var{LB}, @var{UB}, @var{nonlcon}) +## @deftypefnx{Function File} {@var{x} =} ga (@var{fitnessfcn}, @var{nvars}, @var{A}, @var{b}, @var{Aeq}, @var{beq}, @var{LB}, @var{UB}, @var{nonlcon}, @var{options}) +## @deftypefnx{Function File} {@var{x} =} ga (@var{problem}) +## @deftypefnx{Function File} {[@var{x}, @var{fval}] =} ga (@dots{}) +## @deftypefnx{Function File} {[@var{x}, @var{fval}, @var{exitflag}] =} ga (@dots{}) +## @deftypefnx{Function File} {[@var{x}, @var{fval}, @var{exitflag}, @var{output}] =} ga (@dots{}) +## @deftypefnx{Function File} {[@var{x}, @var{fval}, @var{exitflag}, @var{output}, @var{population}] =} ga (@dots{}) +## @deftypefnx{Function File} {[@var{x}, @var{fval}, @var{exitflag}, @var{output}, @var{population}, @var{scores}] =} ga (@dots{}) +## Find minimum of function using genetic algorithm. +## +## @strong{Inputs} +## @table @var +## @item fitnessfcn +## The objective function to minimize. It accepts a vector @var{x} of +## size 1-by-@var{nvars}, and returns a scalar evaluated at @var{x}. +## @item nvars +## The dimension (number of design variables) of @var{fitnessfcn}. +## @item options +## The structure of the optimization parameters; can be created using +## the @code{gaoptimset} function. If not specified, @code{ga} minimizes +## with the default optimization parameters. +## @item problem +## A structure containing the following fields: +## @itemize @bullet +## @item @code{fitnessfcn} +## @item @code{nvars} +## @item @code{Aineq} +## @item @code{Bineq} +## @item @code{Aeq} +## @item @code{Beq} +## @item @code{lb} +## @item @code{ub} +## @item @code{nonlcon} +## @item @code{randstate} +## @item @code{randnstate} +## @item @code{solver} +## @item @code{options} +## @end itemize +## @end table +## +## @strong{Outputs} +## @table @var +## @item x +## The local unconstrained found minimum to the objective function, +## @var{fitnessfcn}. +## @item fval +## The value of the fitness function at @var{x}. +## @end table +## +## @seealso{gaoptimset} +## @end deftypefn + +## Author: Luca Favatella +## Version: 6.0.1 + +function [x fval exitflag output population scores] = \ + ga (fitnessfcn_or_problem, + nvars, + A = [], b = [], + Aeq = [], beq = [], + LB = [], UB = [], + nonlcon = [], + options = gaoptimset ()) + if ((nargout > 6) || + (nargin < 1) || + (nargin == 3) || + (nargin == 5) || + (nargin == 7) || + (nargin > 10)) + print_usage (); + else + + ## retrieve the problem structure + if (nargin == 1) + problem = fitnessfcn_or_problem; + else + problem.fitnessfcn = fitnessfcn_or_problem; + problem.nvars = nvars; + problem.Aineq = A; + problem.Bineq = b; + problem.Aeq = Aeq; + problem.Beq = beq; + problem.lb = LB; + problem.ub = UB; + problem.nonlcon = nonlcon; + problem.randstate = rand ("state"); + problem.randnstate = randn ("state"); + problem.solver = "ga"; + problem.options = options; + endif + + ## call the function that manages the problem structure + [x fval exitflag output population scores] = __ga_problem__ (problem); + endif +endfunction + + +## number of input arguments +%!shared f, nvars +%! f = @rastriginsfcn; +%! nvars = 2; +%!error x = ga () +%!error x = ga (f) +%!error x = ga (f, nvars, []) +%!error x = ga (f, nvars, [], [], []) +%!error x = ga (f, nvars, [], [], [], [], []) +%!error x = ga (f, nvars, [], [], [], [], [], [], @(x) [[], []], gaoptimset (), []) + +## number of output arguments +# TODO + +## type of arguments +%!function f = ff (nvars) +%! f = @(x) sum (x(:, 1:nvars) .** 2, 2); +%!error x = ga (ff (3), 2); +# TODO +# TODO: test that each field in the user-specified "problem" structure is checked + + +## flawless execution with right arguments +%!shared f, nvars +%! f = @rastriginsfcn; +%! nvars = 2; +%!function [C, Ceq] = nonlcon (x) +%! C = []; +%! Ceq = []; +%!test x = ga (f, nvars); +%!test x = ga (f, nvars, [], []); +%!test x = ga (f, nvars, ones (3, nvars), ones (3, 1)); +%!test x = ga (f, nvars, [], [], [], []); +%!test x = ga (f, nvars, [], [], ones (4, nvars), ones (4, 1)); +%!test x = ga (f, nvars, [], [], [], [], [], []); +%!test x = ga (f, nvars, [], [], [], [], - Inf (1, nvars), Inf (1, nvars)); +%!test x = ga (f, nvars, [], [], [], [], - ones (1, nvars), ones (1, nvars)); +%!test x = ga (f, nvars, [], [], [], [], [], [], @(x) [[], []]); +%!test x = ga (f, nvars, [], [], [], [], [], [], @nonlcon); +%!test x = ga (f, nvars, [], [], [], [], [], [], @(x) [[], []], gaoptimset ()); +%!test # TODO: convert to error after implementing private ga-specific createOptimProblem. All fields in the user-specified structure should be checked +%! problem = struct ("fitnessfcn", @rastriginsfcn, +%! "nvars", 2, +%! "options", gaoptimset ()); +%! x = ga (problem); + +## flawless execution with any nvars +%!function f = ff (nvars) +%! f = @(x) sum (x(:, 1:nvars) .** 2, 2); +%!test +%! nvars = 1; +%! x = ga (ff (nvars), nvars); +%!test +%! nvars = 2; +%! x = ga (ff (nvars), nvars); +%!test +%! nvars = 3; +%! x = ga (ff (nvars), nvars); + +## flawless execution with any supported optimization parameter +## different from the default value +%!shared f, nvars, default_options +%! f = @rastriginsfcn; +%! nvars = 2; +%! default_options = gaoptimset (); +%!function [C, Ceq] = nonlcon (x) +%! C = []; +%! Ceq = []; +%!test +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, default_options); +%!test # TODO: use non-default value +%! options = gaoptimset ("CreationFcn", @gacreationuniform); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test # TODO: use non-default value +%! options = gaoptimset ("CrossoverFcn", @crossoverscattered); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test +%! options = gaoptimset ("CrossoverFraction", rand); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test +%! ps = getfield (default_options, "PopulationSize"); +%! options = gaoptimset ("EliteCount", randi ([0, ps])); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test +%! options = gaoptimset ("FitnessLimit", 1e-7); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test # TODO: use non-default value +%! options = gaoptimset ("FitnessScalingFcn", @fitscalingrank); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test +%! g = getfield (default_options, "Generations"); +%! options = gaoptimset ("Generations", g + 1); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test +%! ps = getfield (default_options, "PopulationSize"); +%! ## Initial population can be partial +%! options_w_full_ip = \ +%! gaoptimset ("InitialPopulation", rand (ps, nvars)); +%! partial_ip = randi ([0, ps - 1]); +%! options_w_partial_ip = \ +%! gaoptimset ("InitialPopulation", rand (partial_ip, nvars)); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options_w_full_ip); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options_w_partial_ip); +%!test +%! ps = getfield (default_options, "PopulationSize"); +%! ## Initial scores needs initial population +%! +%! options_w_full_ip_full_is = \ +%! gaoptimset ("InitialPopulation", rand (ps, nvars), +%! "InitialScores", rand (ps, 1 )); +%! partial_ip = randi ([2, ps - 1]); +%! options_w_partial_ip_full_is = \ +%! gaoptimset ("InitialPopulation", rand (partial_ip, nvars), +%! "InitialScores", rand (partial_ip, 1 )); +%! +%! ## Initial scores can be partial +%! partial_is_when_full_ip = randi ([1, ps - 1]); +%! partial_is_when_partial_ip = randi ([1, partial_ip - 1]); +%! options_w_full_ip_partial_is = \ +%! gaoptimset ("InitialPopulation", rand (ps, nvars), +%! "InitialScores", rand (partial_is_when_full_ip, 1 )); +%! options_w_partial_ip_partial_is = \ +%! gaoptimset ("InitialPopulation", rand (partial_ip, nvars), +%! "InitialScores", rand (partial_is_when_partial_ip, 1 )); +%! +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, +%! options_w_full_ip_full_is); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, +%! options_w_partial_ip_full_is); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, +%! options_w_full_ip_partial_is); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, +%! options_w_partial_ip_partial_is); +%!test # TODO: use non-default value +%! options = gaoptimset ("MutationFcn", {@mutationgaussian, 1, 1}); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test +%! options = gaoptimset ("PopInitRange", [-2; 2]); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test +%! options = gaoptimset ("PopulationSize", 200); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test # TODO: use non-default value +%! options = gaoptimset ("SelectionFcn", @selectionstochunif); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test # TODO: use non-default value +%! options = gaoptimset ("TimeLimit", Inf); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!error # TODO: this should become test +%! options = gaoptimset ("UseParallel", "always"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test +%! options = gaoptimset ("Vectorized", "on"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); + + +## error with conflicting optimization parameters: population size et al. +%!shared f, nvars +%! f = @rastriginsfcn; +%! nvars = 2; +%!function [C, Ceq] = nonlcon (x) +%! C = []; +%! Ceq = []; +%!error # Elite count cannot be greater than the population size +%! ps = 3; +%! bad_options = gaoptimset ("PopulationSize", ps, +%! "EliteCount", ps + 1); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, bad_options); +%!error # The number of individuals in the initial population cannot be greater of the population size +%! ps = 3; +%! bad_options = gaoptimset ("PopulationSize", ps, +%! "InitialPopulation", zeros (ps + 1, nvars)); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, bad_options); +%!error # Initial scores cannot be specified without specifying the initial population too +%! bad_options = gaoptimset ("InitialScores", zeros (3, 1)); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, bad_options); +%!error # The number of initial scores specified cannot be greater of the number of individuals in the initial population +%! ip = 3; +%! bad_options = gaoptimset ("InitialPopulation", zeros (ip, nvars), +%! "InitialScores", zeros (ip + 1, 1)); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, bad_options); + +## error with vectorized evaluation of objective function. Vectorized +## objective functions are better because can be evaluated both as +## serial and vectorized. +%!shared nvars +%! nvars = 2; +%!function [C, Ceq] = nonlcon (x) +%! C = []; +%! Ceq = []; +%!function f = ff (nvars) +%! f = @(x) sum (x(:, 1:nvars) .** 2, 2); +%!function f_not_vectorized = ff_not_vectorized (nvars) +%! f_not_vectorized = @(x) sum (x(1:nvars) .** 2); +%!test # A non-vectorized objective function works when no vectorization is required +%! f = ff_not_vectorized (nvars); +%! options = gaoptimset ("Vectorized", "off"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!error # A non-vectorized objective function does not work when vectorization is required +%! f = ff_not_vectorized (nvars); +%! options = gaoptimset ("Vectorized", "on"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test # A vectorized objective function works when no vectorization is required +%! f = ff (nvars); +%! options = gaoptimset ("Vectorized", "off"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!test # A vectorized objective function works when vectorization is required +%! f = ff (nvars); +%! options = gaoptimset ("Vectorized", "on"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); + +## error with conflicting optimization parameters: parallel and +## vectorized evaluation of objective function +%!shared f, nvars +%! f = @rastriginsfcn; +%! nvars = 2; +%!function [C, Ceq] = nonlcon (x) +%! C = []; +%! Ceq = []; +%!test +%! options = gaoptimset ("UseParallel", "never", +%! "Vectorized", "off"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!error # TODO: this should become test +%! options = gaoptimset ("UseParallel", "always", +%! "Vectorized", "off"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!error +%! bad_options = gaoptimset ("UseParallel", "garbage", +%! "Vectorized", "off"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, bad_options); +%!test +%! options = gaoptimset ("UseParallel", "never", +%! "Vectorized", "on"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, options); +%!warning +%! bad_options = gaoptimset ("UseParallel", "always", +%! "Vectorized", "on"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, bad_options); +%!warning +%! bad_options = gaoptimset ("UseParallel", "garbage", +%! "Vectorized", "on"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, bad_options); +%!error +%! bad_options = gaoptimset ("UseParallel", "never", +%! "Vectorized", "garbage"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, bad_options); +%!error +%! bad_options = gaoptimset ("UseParallel", "always", +%! "Vectorized", "garbage"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, bad_options); +%!error +%! bad_options = gaoptimset ("UseParallel", "garbage", +%! "Vectorized", "garbage"); +%! x = ga (f, nvars, [], [], [], [], [], [], @nonlcon, bad_options); diff --git a/octave_packages/ga-0.10.0/gacreationuniform.m b/octave_packages/ga-0.10.0/gacreationuniform.m new file mode 100644 index 0000000..a995619 --- /dev/null +++ b/octave_packages/ga-0.10.0/gacreationuniform.m @@ -0,0 +1,65 @@ +## Copyright (C) 2008 Luca Favatella +## +## 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{Population} =} gacreationuniform (@var{GenomeLength}, @var{FitnessFcn}, @var{options}) +## Create a random initial population with a uniform distribution. +## +## @strong{Inputs} +## @table @var +## @item GenomeLength +## The number of indipendent variables for the fitness function. +## @item FitnessFcn +## The fitness function. +## @item options +## The options structure. +## @end table +## +## @strong{Outputs} +## @table @var +## @item Population +## The initial population for the genetic algorithm. +## @end table +## +## @seealso{ga, gaoptimset} +## @end deftypefn + +## Author: Luca Favatella +## Version: 4.9 + +function Population = gacreationuniform (GenomeLength, FitnessFcn, options) + [LB(1, 1:GenomeLength) UB(1, 1:GenomeLength)] = \ + __ga_popinitrange__ (options.PopInitRange, GenomeLength); + + ## pseudocode + ## + ## Population = Delta * RandomPopulationBetween0And1 + Offset + Population(1:options.PopulationSize, 1:GenomeLength) = \ + ((ones (options.PopulationSize, 1) * (UB - LB)) .* \ + rand (options.PopulationSize, GenomeLength)) + \ + (ones (options.PopulationSize, 1) * LB); +endfunction + + +## number of input arguments +# TODO + +## number of output arguments +# TODO + +## type of arguments +# TODO + +# TODO diff --git a/octave_packages/ga-0.10.0/gaoptimset.m b/octave_packages/ga-0.10.0/gaoptimset.m new file mode 100644 index 0000000..dbc70af --- /dev/null +++ b/octave_packages/ga-0.10.0/gaoptimset.m @@ -0,0 +1,121 @@ +## Copyright (C) 2008, 2009, 2010 Luca Favatella +## +## 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{options} =} gaoptimset +## @deftypefnx{Function File} {@var{options} =} gaoptimset ('@var{param1}', @var{value1}, '@var{param2}', @var{value2}, @dots{}) +## Create genetic algorithm options structure. +## +## @strong{Inputs} +## @table @var +## @item param +## Parameter to set. Unspecified parameters are set to their default +## values; specifying no parameters is allowed. +## @item value +## Value of @var{param}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item options +## Structure containing the options, or parameters, for the genetic algorithm. +## @end table +## +## @strong{Options} +## @table @code +## @item CreationFcn +## @item CrossoverFcn +## @item CrossoverFraction +## @item EliteCount +## @item FitnessLimit +## @item FitnessScalingFcn +## @item Generations +## @item InitialPopulation +## Can be partial. +## @item InitialScores +## column vector | [] (default) . Can be partial. +## @item MutationFcn +## @item PopInitRange +## @item PopulationSize +## @item SelectionFcn +## @item TimeLimit +## @item UseParallel +## "always" | "never" (default) . Parallel evaluation of objective function. TODO: parallel evaluation of nonlinear constraints +## @item Vectorized +## "on" | "off" (default) . Vectorized evaluation of objective function. TODO: vectorized evaluation of nonlinear constraints +## @end table +## +## @seealso{ga} +## @end deftypefn + +## Author: Luca Favatella +## Version: 4.4.7 + +function options = gaoptimset (varargin) + if ((nargout != 1) || + (mod (length (varargin), 2) == 1)) + print_usage (); + else + + ## initialize the return variable to a structure with all parameters + ## set to their default value + options = __gaoptimset_default_options__ (); + + ## set custom options + for i = 1:2:length (varargin) + param = varargin{i}; + value = varargin{i + 1}; + if (! isfield (options, param)) + error ("wrong parameter"); + else + options = setfield (options, param, value); + endif + endfor + endif +endfunction + + +## number of input arguments +%!error options = gaoptimset ("odd number of arguments") +%!error options = gaoptimset ("Generations", 123, "odd number of arguments") + +## number of output arguments +%!error gaoptimset ("Generations", 123) +%!error [a, b] = gaoptimset ("Generations", 123) + +## type of arguments +# TODO +%!#error options = gaoptimset ("Vectorized", "bad value") # TODO: fix +%!#error options = gaoptimset ("UseParallel", "bad value") # TODO: fix + +# TODO: structure/add tests below + +%!assert (getfield (gaoptimset ("Generations", 123), "Generations"), 123) + +%!test +%! options = gaoptimset ("EliteCount", 1, +%! "FitnessLimit", 1e-7, +%! "Generations", 1000, +%! "PopInitRange", [-5; 5], +%! "PopulationSize", 200); +%! +%! ## "CrossoverFraction" is not specified, so gaoptimset should put the default value: testing this too +%! assert ([(getfield (options, "CrossoverFraction")); +%! (getfield (options, "EliteCount")); +%! (getfield (options, "FitnessLimit")); +%! (getfield (options, "Generations")); +%! (getfield (options, "PopInitRange")); +%! (getfield (options, "PopulationSize"))], +%! [0.8; 1; 1e-7; 1000; [-5; 5]; 200]) diff --git a/octave_packages/ga-0.10.0/mutationgaussian.m b/octave_packages/ga-0.10.0/mutationgaussian.m new file mode 100644 index 0000000..015d341 --- /dev/null +++ b/octave_packages/ga-0.10.0/mutationgaussian.m @@ -0,0 +1,60 @@ +## Copyright (C) 2008 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 1.7.1 + +function mutationChildren = \ + mutationgaussian (parents, options, nvars, FitnessFcn, + state, thisScore, + thisPopulation) + [LB(1, 1:nvars) UB(1, 1:nvars)] = \ + __ga_popinitrange__ (options.PopInitRange, nvars); + + ## start mutationgaussian logic + Scale = options.MutationFcn{1, 2}; + #assert (size (Scale), [1 1]); ## DEBUG + Shrink = options.MutationFcn{1, 3}; + #assert (size (Shrink), [1 1]); ## DEBUG + + ## initial standard deviation (i.e. when state.Generation == 0) + tmp_std = Scale * (UB - LB); ## vector = scalar * vector + + ## recursively compute current standard deviation + for k = 1:state.Generation + tmp_std(1, 1:nvars) = (1 - Shrink * (k / options.Generations)) * tmp_std; + endfor + current_std(1, 1:nvars) = tmp_std; + nc_parents = columns (parents); + expanded_current_std(1:nc_parents, 1:nvars) = \ + ones (nc_parents, 1) * current_std; + + ## finally add random numbers + mutationChildren(1:nc_parents, 1:nvars) = \ + thisPopulation(parents(1, 1:nc_parents), 1:nvars) + \ + expanded_current_std .* randn (nc_parents, nvars); +endfunction + + +## number of input arguments +# TODO + +## number of output arguments +# TODO + +## type of arguments +# TODO + +# TODO diff --git a/octave_packages/ga-0.10.0/packinfo/.autoload b/octave_packages/ga-0.10.0/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/ga-0.10.0/packinfo/DESCRIPTION b/octave_packages/ga-0.10.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..4d4d604 --- /dev/null +++ b/octave_packages/ga-0.10.0/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: ga +Version: 0.10.0 +Date: 2012-04-06 +Author: Luca Favatella +Maintainer: Luca Favatella +Title: Genetic Algorithm +Description: Genetic optimization code +Categories: Optimization +Depends: octave (>= 3.4.0) +Autoload: yes +License: GPLv2+ +Url: http://octave.sf.net diff --git a/octave_packages/ga-0.10.0/packinfo/INDEX b/octave_packages/ga-0.10.0/packinfo/INDEX new file mode 100644 index 0000000..19bc0bd --- /dev/null +++ b/octave_packages/ga-0.10.0/packinfo/INDEX @@ -0,0 +1,25 @@ +ga >> Genetic Algorithm +Genetic Algorithm + ga + gaoptimset + +Creation + gacreationuniform + +Fitness Scaling + fitscalingrank + +Selection + selectionstochunif + +Crossover + crossoverscattered + +Mutation + mutationgaussian + +Utility + rastriginsfcn + +Miscellaneous + test_ga diff --git a/octave_packages/ga-0.10.0/packinfo/NEWS b/octave_packages/ga-0.10.0/packinfo/NEWS new file mode 100644 index 0000000..a1d6c2c --- /dev/null +++ b/octave_packages/ga-0.10.0/packinfo/NEWS @@ -0,0 +1,18 @@ +Summary of important user-visible changes for releases of the ga package + +=============================================================================== +ga-0.10.0 Release Date: 2012-04-06 Release Manager: Luca Favatella +=============================================================================== + +** Remove dependency on the "communications" package and require + Octave version 3.4.0 (or better). The "communications" package was + used only for its "randint" function; now the "randi" function, + introduced in Octave 3.4.0, is used instead. + +** Reorganize the unit test suite. All available tests can be + executed by running "test_ga". Fix bug #3287917 (Debian bug + #622929). + +** Rename the package from "Genetic Algorithm and Direct Search" to + "Genetic Algorithm" as only the Genetic Algorithm is implemented. + Direct Search will not be implemented in the foreseeable future. diff --git a/octave_packages/ga-0.10.0/rastriginsfcn.m b/octave_packages/ga-0.10.0/rastriginsfcn.m new file mode 100644 index 0000000..be8c156 --- /dev/null +++ b/octave_packages/ga-0.10.0/rastriginsfcn.m @@ -0,0 +1,50 @@ +## Copyright (C) 2008, 2009, 2010, 2012 Luca Favatella +## +## 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{y} =} rastriginsfcn (@var{x}) +## Rastrigin's function. +## @end deftypefn + +## Author: Luca Favatella +## Version: 2.0 + +function retval = rastriginsfcn (x) + if ((nargout != 1) || + (nargin != 1) || (columns (x) != 2)) + print_usage (); + else + x1 = x(:, 1); + x2 = x(:, 2); + retval = 20 + (x1 .** 2) + (x2 .** 2) - 10 .* (cos (2 .* pi .* x1) + + cos (2 .* pi .* x2)); + endif +endfunction + + +## number of input arguments +%!error y = rastriginsfcn () +%!error y = rastriginsfcn ([0, 0], "other argument") + +## number of output arguments +%!error [y1, y2] = rastriginsfcn ([0, 0]) + +## type of arguments +%!error y = rastriginsfcn ([0; 0]) +%!error y = rastriginsfcn (zeros (2, 3)) # TODO: document size of x + +%!assert (rastriginsfcn ([0, 0]), 0) +%!assert (rastriginsfcn ([0, 0; 0, 0]), [0; 0]) +%!assert (rastriginsfcn (zeros (3, 2)), [0; 0; 0]) diff --git a/octave_packages/ga-0.10.0/selectionstochunif.m b/octave_packages/ga-0.10.0/selectionstochunif.m new file mode 100644 index 0000000..bf4855a --- /dev/null +++ b/octave_packages/ga-0.10.0/selectionstochunif.m @@ -0,0 +1,46 @@ +## Copyright (C) 2008 Luca Favatella +## +## 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 . + +## Author: Luca Favatella +## Version: 1.3 + +function parents = selectionstochunif (expectation, nParents, options) + nc_expectation = columns (expectation); + line(1, 1:nc_expectation) = cumsum (expectation(1, 1:nc_expectation)); + max_step_size = line(1, nc_expectation); + step_size = max_step_size * rand (); + steps(1, 1:nParents) = rem (step_size * (1:nParents), max_step_size); + for index_steps = 1:nParents ## fix an entry of the steps (or parents) vector + #assert (steps(1, index_steps) < max_step_size); ## DEBUG + index_line = 1; + while (steps(1, index_steps) >= line(1, index_line)) + #assert ((index_line >= 1) && (index_line < nc_expectation)); ## DEBUG + index_line++; + endwhile + parents(1, index_steps) = index_line; + endfor +endfunction + + +## number of input arguments +# TODO + +## number of output arguments +# TODO + +## type of arguments +# TODO + +# TODO diff --git a/octave_packages/ga-0.10.0/test_ga.m b/octave_packages/ga-0.10.0/test_ga.m new file mode 100644 index 0000000..367a310 --- /dev/null +++ b/octave_packages/ga-0.10.0/test_ga.m @@ -0,0 +1,49 @@ +## Copyright (C) 2012 Luca Favatella +## +## 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{Script File} {} test_ga +## Execute all available tests at once. +## @end deftypefn + +## Author: Luca Favatella +## Created: March 2012 +## Version: 0.3 + +## Creation +test gacreationuniform + +## Fitness Scaling +test fitscalingrank + +## Selection +test selectionstochunif + +## Crossover +test crossoverscattered + +## Mutation +test mutationgaussian + +## Utility +test rastriginsfcn + +## Genetic Algorithm +test gaoptimset +test ga + +## Private functions +test __ga_initial_population__ +test __ga_problem_update_state_at_each_generation__ diff --git a/octave_packages/general-1.3.1/@dict/dict.m b/octave_packages/general-1.3.1/@dict/dict.m new file mode 100644 index 0000000..19171a3 --- /dev/null +++ b/octave_packages/general-1.3.1/@dict/dict.m @@ -0,0 +1,95 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {d =} dict (@var{keys}, @var{values}) +## @deftypefnx{Function File} {d =} dict () +## @deftypefnx{Function File} {d =} dict (@var{str}) +## Creates a dictionary object with given keys and values. @var{keys} +## should be a cell array of strings; @var{values} should be a cell array +## with matching size. @var{values} can also be a singleton array, in +## which case it is expanded to the proper size; or omitted, in which case +## the default value of empty matrix is used. +## If neither @var{keys} nor @var{values} are supplied, an empty dictionary +## is constructed. +## If a scalar structure is supplied as an argument, it is converted to +## a dictionary using field names as keys. +## +## A dictionary can be indexed either by a single string or cell array of +## strings, like this: +## +## @example +## d = dict (keys, values); +## d(str) # result is a single value +## d(cellstr) # result is a cell array +## @end example +## +## In the first case, the stored value is returned directly; in the second case, +## a cell array is returned. The cell array returned inherits the shape of the index. +## +## Similarly, indexed assignment works like this: +## +## @example +## d = dict (keys, values); +## d(str) = val; # store a single value +## d(cellstr) = vals; # store a cell array +## d(cellstr) = []; # delete a range of keys +## @end example +## +## Any keys that are not present in the dictionary are added. The values of +## existing keys are overwritten. In the second case, the lengths of index and +## rhs should match or rhs should be a singleton array, in which case it is +## broadcasted. +## +## It is also possible to retrieve keys and values as cell arrays, using the +## "keys" and "values" properties. These properties are read-only. +## +## @end deftypefn + +## Author: Jaroslav Hajek + +function d = dict (keys, values) + + if (nargin == 0) + keys = values = cell (0, 1); + elseif (nargin == 1) + if (iscellstr (keys)) + keys = sort (keys(:)); + values = cell (numel (keys), 1); + elseif (isstruct (keys)) + values = struct2cell (keys)(:,:); + if (columns (values) != 1) + error ("dict: structure must be a scalar"); + endif + [keys, ind] = sort (fieldnames (keys)); + values = values(ind); + else + error ("dict: keys must be a cell vector of strings"); + endif + elseif (nargin == 2) + [keys, idx] = sort (keys(:)); + values = values (idx)(:); + else + print_usage (); + endif + + d = class (struct ("keys", {keys}, "values", {values}), "dict"); + +endfunction + +%!test +%! free = dict (); +%! free({"computing", "society"}) = {true}; +%! assert (free("computing"), free("society")); diff --git a/octave_packages/general-1.3.1/@dict/display.m b/octave_packages/general-1.3.1/@dict/display.m new file mode 100644 index 0000000..8d68755 --- /dev/null +++ b/octave_packages/general-1.3.1/@dict/display.m @@ -0,0 +1,41 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . +## -*- texinfo -*- +## @deftypefn{Function File} display (d) +## Overloaded display for dictionaries. +## @end deftypefn + +## Author: Jaroslav Hajek + +function display (d) + if (isempty (d.keys)) + printf ("%s = dict: {}\n", argn); + else + printf ("%s = \n\n", argn); + n = numel (d.keys); + puts ("dict: {\n"); + for i = 1:n + keystr = d.keys{i}; + valstr = disp (d.values{i}); + if (any (valstr(1:end-1) == "\n")) + valstr = strrep (valstr, "\n", "\n "); + printf (" %s :\n\n %s", keystr, valstr(1:end-4)); + else + printf (" %s : %s", keystr, valstr); + endif + endfor + puts ("}\n"); + endif +endfunction diff --git a/octave_packages/general-1.3.1/@dict/end.m b/octave_packages/general-1.3.1/@dict/end.m new file mode 100644 index 0000000..3cc6088 --- /dev/null +++ b/octave_packages/general-1.3.1/@dict/end.m @@ -0,0 +1,22 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Author: Jaroslav Hajek + +function end () + + error ("invalid use of end to index a dict"); + +endfunction diff --git a/octave_packages/general-1.3.1/@dict/get.m b/octave_packages/general-1.3.1/@dict/get.m new file mode 100644 index 0000000..b455c3a --- /dev/null +++ b/octave_packages/general-1.3.1/@dict/get.m @@ -0,0 +1,56 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {} get (d, key, defv) +## Queries for the values of specified key(s). Unlike indexing, however, +## this does not throw an error if a key is missing but rather substitutes +## a default value. If @var{key} is a cell array, @var{defv} should be either +## a cell array of the same shape as @var{key}, or a singleton cell. +## Non-cell values will be converted to a singleton cell. +## @end deftypefn + +## Author: Jaroslav Hajek + +function val = get (d, key, defv = []) + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (ischar (key)) + i = lookup (d.keys, key, "m"); + if (i) + val = d.values{i}; + else + val = defv; + endif + elseif (iscellstr (key)) + if (! iscell (defv)) + val = repmat ({defv}, size (key)); + elseif (numel (defv) == 1) + val = repmat (defv, size (key)); + elseif (size_equal (key, defv)) + val = defv; + else + error ("get: sizes of key & defv must match"); + endif + i = lookup (d.keys, key, "m"); + mask = i != 0; + val(mask) = d.values(i(mask)); + else + error ("get: invalid key value"); + endif +endfunction + diff --git a/octave_packages/general-1.3.1/@dict/has.m b/octave_packages/general-1.3.1/@dict/has.m new file mode 100644 index 0000000..7fba8d8 --- /dev/null +++ b/octave_packages/general-1.3.1/@dict/has.m @@ -0,0 +1,37 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {} has (d, key) +## Check whether the dictionary contains specified key(s). +## Key can be either a string or a cell array. In the first case, +## the result is a logical scalar; otherwise, the result is a logical array +## with the same shape as @var{key}. +## @end deftypefn + +## Author: Jaroslav Hajek + +function b = has (d, key) + if (nargin != 2) + print_usage (); + endif + + if (ischar (key) || iscellstr (key)) + b = lookup (d.keys, key, "b"); + else + error ("has: invalid key value"); + endif +endfunction + diff --git a/octave_packages/general-1.3.1/@dict/isempty.m b/octave_packages/general-1.3.1/@dict/isempty.m new file mode 100644 index 0000000..9836788 --- /dev/null +++ b/octave_packages/general-1.3.1/@dict/isempty.m @@ -0,0 +1,28 @@ +## Copyright (C) 2010 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {} isempty (d) +## Returns true if the dictionary is empty. +## @end deftypefn + +## Author: Jaroslav Hajek + +function is = isempty (d) + + is = isempty (d.keys); + +endfunction + diff --git a/octave_packages/general-1.3.1/@dict/join.m b/octave_packages/general-1.3.1/@dict/join.m new file mode 100644 index 0000000..c85be8c --- /dev/null +++ b/octave_packages/general-1.3.1/@dict/join.m @@ -0,0 +1,50 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {} join (d1, d2, joinop) +## Merges two given dictionaries. For common keys, the function @var{joinop} is +## called to combine the two values. If not supplied, values from d2 are taken. +## @end deftypefn + +## Author: Jaroslav Hajek + +function d = join (d1, d2, jop) + if (nargin < 2 || nargin > 3 || ! (isa (d1, "dict") && isa (d2, "dict"))) + print_usage (); + endif + + keys1 = d1.keys; + keys2 = d2.keys; + + [keys, idx] = sort ([keys1; keys2]); + values = [d1.values; d2.values](idx); + n = numel (keys); + + if (n > 1) + idx = find (strcmp (keys(1:n-1), keys(2:n))); + keys(idx) = []; + if (nargin == 3) + values(idx+1) = cellfun (jop, values(idx), values(idx+1), "UniformOutput", false); + endif + values(idx) = []; + endif + + d = dict; + d.keys = keys; + d.values = values; + +endfunction + diff --git a/octave_packages/general-1.3.1/@dict/length.m b/octave_packages/general-1.3.1/@dict/length.m new file mode 100644 index 0000000..ef9b866 --- /dev/null +++ b/octave_packages/general-1.3.1/@dict/length.m @@ -0,0 +1,28 @@ +## Copyright (C) 2010 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {} length (d) +## Returns the number of key/value pairs. +## @end deftypefn + +## Author: Jaroslav Hajek + +function l = length (d) + + l = length (d.keys); + +endfunction + diff --git a/octave_packages/general-1.3.1/@dict/struct.m b/octave_packages/general-1.3.1/@dict/struct.m new file mode 100644 index 0000000..af3bbcc --- /dev/null +++ b/octave_packages/general-1.3.1/@dict/struct.m @@ -0,0 +1,32 @@ +## Copyright (C) 2010 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {} struct (d) +## Converts the dict object to a structure, if possible. +## This requires the keys to be valid variable names. +## @end deftypefn + +## Author: Jaroslav Hajek + +function s = struct (d) + keys = d.keys; + valid = cellfun (@isvarname, keys); + if (all (valid)) + s = cell2struct (d.values, keys, 1); + else + error ("struct: invalid key value: %s", keys{find (! valid, 1)}); + endif +endfunction diff --git a/octave_packages/general-1.3.1/@dict/subsasgn.m b/octave_packages/general-1.3.1/@dict/subsasgn.m new file mode 100644 index 0000000..d2bce91 --- /dev/null +++ b/octave_packages/general-1.3.1/@dict/subsasgn.m @@ -0,0 +1,103 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {d =} subsasgn (d, s, val) +## Overloaded subsasgn for dictionaries. +## @end deftypefn + +## Author: Jaroslav Hajek + +function d = subsasgn (d, s, val) + if (isempty (s)) + error ("dict: missing index"); + endif + + switch (s(1).type) + case "()" + ind = s(1).subs; + if (numel (ind) == 1) + ind = ind{1}; + else + error ("dict: needs exactly one index"); + endif + if (ischar (ind)) + ## Scalar assignment case. Search whether the key is present. + i = lookup (d.keys, ind, "m"); + if (i) + ## The key is present; handle the rest of chain if needed, + ## then assign. + if (numel (s) > 1) + val = subsasgn (d.values{i}, s(2:end), val); + endif + d.values{i} = val; + else + ## The key is missing; handle the rest of chain if needed. + if (numel (s) > 1) + val = subsasgn ([], s(2:end), val); + endif + ## Look up the proper place to insert the new key. + i = lookup (d.keys, ind); + d.keys = [d.keys(1:i,1); {ind}; d.keys(i+1:end,1)]; + ## Insert value. + d.values = [d.values(1:i,1); {val}; d.values(i+1:end,1)]; + endif + elseif (iscellstr (ind)) + ## Multiple assignment case. Perform checks. + if (numel (s) > 1) + error ("chained subscripts not allowed for multiple fields"); + endif + if (isnull (val)) + ## Deleting elements. + i = lookup (d.keys, ind, "m"); + i = i(i != 0); + d.keys(i) = []; + d.values(i) = []; + elseif (iscell (val)) + if (numel (val) == 1) + val = repmat (val, size (ind)); + elseif (numel (ind) != numel (val)) + error ("numbers of elements of index and rhs must match"); + endif + ## Choose from two paths. + if (numel (ind) < numel (d.keys)) + ## Scarce assignment. There's a good chance that all keys will be present. + i = lookup (d.keys, ind, "m"); + mask = i != 0; + if (all (mask)) + d.values(i) = val; + else + d.values(i(mask)) = val(mask); + mask = !mask; + [d.keys, i] = sort ([d.keys; ind(mask)(:)]); + d.values = [d.values; val(mask)(:)](i); + endif + else + ## Mass assignment. Probably most of the keys are new ones, so simply + ## melt all together. + [d.keys, i] = unique ([d.keys; ind(:)]); + d.values = [d.values; val(:)](i); + endif + else + error ("expected cell rhs for cell index"); + endif + else + error ("invalid index"); + endif + otherwise + error ("invalid subscript type for assignment"); + endswitch +endfunction + diff --git a/octave_packages/general-1.3.1/@dict/subsref.m b/octave_packages/general-1.3.1/@dict/subsref.m new file mode 100644 index 0000000..fe0cfc2 --- /dev/null +++ b/octave_packages/general-1.3.1/@dict/subsref.m @@ -0,0 +1,73 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {d =} subsref (d, s) +## Overloaded subsref for dictionaries. +## @end deftypefn + +## Author: Jaroslav Hajek + +function varargout = subsref (d, s) + if (isempty (s)) + error ("dict: missing index"); + endif + + switch (s(1).type) + case "()" + ind = s(1).subs; + if (numel (ind) == 1) + ind = ind{1}; + else + error ("dict: needs exactly one index"); + endif + if (ischar (ind)) + i = lookup (d.keys, ind, "m"); + if (i) + e = d.values {i}; + else + error ("key does not exist: %s", ind); + endif + elseif (iscellstr (ind)) + i = lookup (d.keys, ind, "m"); + if (all (i(:))) + e = reshape (d.values (i), size (ind)); # ensure correct shape. + else + ## Report the first non-existing key. + error ("key does not exist: %s", ind{find (i == 0, 1)}); + endif + else + error ("invalid index"); + endif + case "." + fld = s.subs; + switch (fld) + case 'keys' + e = d.keys; + case 'values' + e = d.values; + otherwise + error ("@dict/subsref: invalid property \"%s\"", fld); + endswitch + otherwise + error ("invalid subscript type"); + endswitch + + if (numel (s) > 1) + varargout = {subsref(e, s(2:end))}; + else + varargout = {e}; + endif +endfunction diff --git a/octave_packages/general-1.3.1/@inputParser/addOptional.m b/octave_packages/general-1.3.1/@inputParser/addOptional.m new file mode 100644 index 0000000..b286352 --- /dev/null +++ b/octave_packages/general-1.3.1/@inputParser/addOptional.m @@ -0,0 +1,63 @@ +## Copyright (C) 2011 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{parser} =} addOptional (@var{parser}, @var{argname}, @var{default}) +## @deftypefnx {Function File} {@var{parser} =} @var{parser}.addOptional (@var{argname}, @var{default}) +## @deftypefnx {Function File} {@var{parser} =} addOptional (@var{parser}, @var{argname}, @var{default}, @var{validator}) +## @deftypefnx {Function File} {@var{parser} =} @var{parser}.addOptional (@var{argname}, @var{default}, @var{validator}) +## Add new optional argument to the object @var{parser} of the class inputParser +## to implement an ordered arguments type of API +## +## @var{argname} must be a string with the name of the new argument. The order +## in which new arguments are added with @command{addOptional}, represents the +## expected order of arguments. +## +## @var{default} will be the value used when the argument is not specified. +## +## @var{validator} is an optional anonymous function to validate the given values +## for the argument with name @var{argname}. Alternatively, a function name +## can be used. +## +## See @command{help inputParser} for examples. +## +## @emph{Note}: if a string argument does not validate, it will be considered a +## ParamValue key. If an optional argument is not given a validator, anything +## will be valid, and so any string will be considered will be the value of the +## optional argument (in @sc{matlab}, if no validator is given and argument is +## a string it will also be considered a ParamValue key). +## +## @seealso{inputParser, @@inputParser/addParamValue, @@inputParser/addSwitch, +## @@inputParser/addParamValue, @@inputParser/addRequired, @@inputParser/parse} +## @end deftypefn + +function inPar = addOptional (inPar, name, def, val) + + ## check @inputParser/subsref for the actual code + if (nargin == 3) + inPar = subsref (inPar, substruct( + '.' , 'addOptional', + '()', {name, def} + )); + elseif (nargin == 4) + inPar = subsref (inPar, substruct( + '.' , 'addOptional', + '()', {name, def, val} + )); + else + print_usage; + endif + +endfunction diff --git a/octave_packages/general-1.3.1/@inputParser/addParamValue.m b/octave_packages/general-1.3.1/@inputParser/addParamValue.m new file mode 100644 index 0000000..95934f0 --- /dev/null +++ b/octave_packages/general-1.3.1/@inputParser/addParamValue.m @@ -0,0 +1,55 @@ +## Copyright (C) 2011 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{parser} =} addParamValue (@var{parser}, @var{argname}, @var{default}) +## @deftypefnx {Function File} {@var{parser} =} @var{parser}.addParamValue (@var{argname}, @var{default}) +## @deftypefnx {Function File} {@var{parser} =} addParamValue (@var{parser}, @var{argname}, @var{default}, @var{validator}) +## @deftypefnx {Function File} {@var{parser} =} @var{parser}.addParamValue (@var{argname}, @var{default}, @var{validator}) +## Add new parameter to the object @var{parser} of the class inputParser to implement +## a name/value pair type of API. +## +## @var{argname} must be a string with the name of the new parameter. +## +## @var{default} will be the value used when the parameter is not specified. +## +## @var{validator} is an optional function handle to validate the given values +## for the parameter with name @var{argname}. Alternatively, a function name +## can be used. +## +## See @command{help inputParser} for examples. +## +## @seealso{inputParser, @@inputParser/addOptional, @@inputParser/addSwitch, +## @@inputParser/addParamValue, @@inputParser/addRequired, @@inputParser/parse} +## @end deftypefn + +function inPar = addParamValue (inPar, name, def, val) + + ## check @inputParser/subsref for the actual code + if (nargin == 3) + inPar = subsref (inPar, substruct( + '.' , 'addParamValue', + '()', {name, def} + )); + elseif (nargin == 4) + inPar = subsref (inPar, substruct( + '.' , 'addParamValue', + '()', {name, def, val} + )); + else + print_usage; + endif + +endfunction diff --git a/octave_packages/general-1.3.1/@inputParser/addRequired.m b/octave_packages/general-1.3.1/@inputParser/addRequired.m new file mode 100644 index 0000000..bd8e7e5 --- /dev/null +++ b/octave_packages/general-1.3.1/@inputParser/addRequired.m @@ -0,0 +1,60 @@ +## Copyright (C) 2011 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{parser} =} addRequired (@var{parser}, @var{argname}) +## @deftypefnx {Function File} {@var{parser} =} @var{parser}.addRequired (@var{argname}) +## @deftypefnx {Function File} {@var{parser} =} addRequired (@var{parser}, @var{argname}, @var{validator}) +## @deftypefnx {Function File} {@var{parser} =} @var{parser}.addRequired (@var{argname}, @var{validator}) +## Add new mandatory argument to the object @var{parser} of inputParser class. +## +## This method belongs to the inputParser class and implements an ordered +## arguments type of API. +## +## @var{argname} must be a string with the name of the new argument. The order +## in which new arguments are added with @command{addrequired}, represents the +## expected order of arguments. +## +## @var{validator} is an optional function handle to validate the given values +## for the argument with name @var{argname}. Alternatively, a function name +## can be used. +## +## See @command{help inputParser} for examples. +## +## @emph{Note}: this can be used together with the other type of arguments but +## it must be the first (see @command{@@inputParser}). +## +## @seealso{inputParser, @@inputParser/addOptional, @@inputParser/addParamValue +## @@inputParser/addParamValue, @@inputParser/addSwitch, @@inputParser/parse} +## @end deftypefn + +function inPar = addRequired (inPar, name, val) + + ## check @inputParser/subsref for the actual code + if (nargin == 2) + inPar = subsref (inPar, substruct( + '.' , 'addRequired', + '()', {name} + )); + elseif (nargin == 3) + inPar = subsref (inPar, substruct( + '.' , 'addRequired', + '()', {name, val} + )); + else + print_usage; + endif + +endfunction diff --git a/octave_packages/general-1.3.1/@inputParser/addSwitch.m b/octave_packages/general-1.3.1/@inputParser/addSwitch.m new file mode 100644 index 0000000..518ff80 --- /dev/null +++ b/octave_packages/general-1.3.1/@inputParser/addSwitch.m @@ -0,0 +1,48 @@ +## Copyright (C) 2011-2012 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{parser} =} addSwitch (@var{parser}, @var{argname}) +## @deftypefnx {Function File} {@var{parser} =} @var{parser}.addSwitch (@var{argname}) +## Add new switch type of argument to the object @var{parser} of inputParser class. +## +## This method belongs to the inputParser class and implements a switch +## arguments type of API. +## +## @var{argname} must be a string with the name of the new argument. Arguments +## of this type can be specified at the end, after @code{Required} and @code{Optional}, +## and mixed between the @code{ParamValue}. They default to false. If one of the +## arguments supplied is a string like @var{argname}, then after parsing the value +## of @var{parse}.Results.@var{argname} will be true. +## +## See @command{help inputParser} for examples. +## +## @seealso{inputParser, @@inputParser/addOptional, @@inputParser/addParamValue +## @@inputParser/addParamValue, @@inputParser/addRequired, @@inputParser/parse} +## @end deftypefn + +function inPar = addSwitch (inPar, name) + + ## check @inputParser/subsref for the actual code + if (nargin == 2) + inPar = subsref (inPar, substruct( + '.' , 'addSwitch', + '()', {name} + )); + else + print_usage; + endif + +endfunction diff --git a/octave_packages/general-1.3.1/@inputParser/createCopy.m b/octave_packages/general-1.3.1/@inputParser/createCopy.m new file mode 100644 index 0000000..86e897a --- /dev/null +++ b/octave_packages/general-1.3.1/@inputParser/createCopy.m @@ -0,0 +1,38 @@ +## Copyright (C) 2011 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{new_parser} =} createCopy (@var{parser}) +## Creates a copy @var{new_parser} of the object @var{parser} of the inputParser +## class. +## +## @seealso{inputParser, @@inputParser/addOptional, @@inputParser/addParamValue +## @@inputParser/addParamValue, @@inputParser/addRequired, @@inputParser/addSwitch, +## @@inputParser/parse} +## @end deftypefn + +function outPar = createCopy (inPar) + + if ( nargin != 1 ) + print_usage; + elseif ( !isa (inPar, 'inputParser') ) + error ("object must be of the inputParser class but '%s' was used", class (inPar) ); + endif + + ## yes, it's a ridiculous function but exists for MatLab compatibility. In there + ## the inputParser class is a 'handle class' and this would just return a reference + outPar = inPar; + +endfunction diff --git a/octave_packages/general-1.3.1/@inputParser/display.m b/octave_packages/general-1.3.1/@inputParser/display.m new file mode 100644 index 0000000..230b8d0 --- /dev/null +++ b/octave_packages/general-1.3.1/@inputParser/display.m @@ -0,0 +1,58 @@ +## Copyright (C) 2011-2012 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +function display (inPar) + + if (inPar.FunctionName) + name = inPar.FunctionName(1:end-3); + else + name = ""; + endif + + required = arg_list (inPar.Required); + optional = arg_list (inPar.Optional); + paramvalue = arg_list (inPar.ParamValue); + switches = arg_list (inPar.Switch); + + printf ("Input Parser object with:\n"); + printf ("CaseSensitive: %s\n", binstr (inPar.CaseSensitive)); + printf ("StructExpand : %s\n", binstr (inPar.StructExpand)); + printf ("KeepUnmatched: %s\n", binstr (inPar.KeepUnmatched)); + printf ("FunctionName : '%s'\n", name); + printf ("\n"); + printf ("Required arguments : %s\n", required); + printf ("Optional arguments : %s\n", optional); + printf ("ParamValue arguments: %s\n", paramvalue); + printf ("Switch arguments : %s\n", switches); + +endfunction + +function [str] = binstr (bin) + if (bin) + str = "true"; + else + str = "false"; + endif +endfunction + +function [str] = arg_list (args) + str = strcat ("'", fieldnames (args), {"', "}); + if (!isempty (str)) + str = cstrcat (str{:}); + str = str(1:end-2); # remove the last comma and space + else + str = ""; + endif +endfunction diff --git a/octave_packages/general-1.3.1/@inputParser/inputParser.m b/octave_packages/general-1.3.1/@inputParser/inputParser.m new file mode 100644 index 0000000..a8718ef --- /dev/null +++ b/octave_packages/general-1.3.1/@inputParser/inputParser.m @@ -0,0 +1,224 @@ +## Copyright (C) 2011-2012 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{parser} =} inputParser () +## Create object @var{parser} of the inputParser class. +## +## This class is designed to allow easy parsing of function arguments. This class +## supports four types of arguments: +## +## @enumerate +## @item mandatory (see @command{@@inputParser/addRequired}); +## @item optional (see @command{@@inputParser/addOptional}); +## @item named (see @command{@@inputParser/addParamValue}); +## @item switch (see @command{@@inputParser/addSwitch}). +## @end enumerate +## +## After defining the function API with this methods, the supplied arguments can +## be parsed with the @command{@@inputParser/parse} method and the parsing results +## accessed with the @command{Results} accessor. +## +## @deftypefnx {Accessor method} parser.Parameters +## Return list of parameters name already defined. +## +## @deftypefnx {Accessor method} parser.Results +## Return structure with argument names as fieldnames and corresponding values. +## +## @deftypefnx {Accessor method} parser.Unmatched +## Return structure similar to @command{Results} for unmatched parameters. See +## the @command{KeepUnmatched} property. +## +## @deftypefnx {Accessor method} parser.UsingDefaults +## Return cell array with the names of arguments that are using default values. +## +## @deftypefnx {Class property} parser.CaseSensitive = @var{boolean} +## Set whether matching of argument names should be case sensitive. Defaults to false. +## +## @deftypefnx {Class property} parser.FunctionName = @var{name} +## Set function name to be used on error messages. Defauls to empty string. +## +## @deftypefnx {Class property} parser.KeepUnmatched = @var{boolean} +## Set whether an error should be given for non-defined arguments. Defaults to +## false. If set to true, the extra arguments can be accessed through +## @code{Unmatched} after the @code{parse} method. Note that since @command{Switch} +## and @command{ParamValue} arguments can be mixed, it is not possible to know +## the unmatched type. If argument is found unmatched it is assumed to be of the +## @command{ParamValue} type and it is expected to be followed by a value. +## +## @deftypefnx {Class property} parser.StructExpand = @var{boolean} +## Set whether a structure can be passed to the function instead of parameter +## value pairs. Defaults to true. Not implemented yet. +## +## The following example shows how to use this class: +## +## @example +## @group +## function check (pack, path, mat, varargin) +## p = inputParser; # create object +## p.FunctionName = "check"; # set function name +## p = p.addRequired ("pack", @@ischar); # create mandatory argument +## +## p = p.addOptional ("path", pwd(), @@ischar); # create optional argument +## +## ## one can create a function handle to anonymous functions for validators +## val_mat = @@(x)isvector(x) && all( x <= 1) && all(x >= 0); +## p = p.addOptional ("mat", [0 0], @@val_mat); +## +## ## create two ParamValue type of arguments +## val_type = @@(x) ischar(x) && any(strcmp(x, @{"linear", "quadratic"@}); +## p = p.addParamValue ("type", "linear", @@val_type); +## val_verb = @@(x) ischar(x) && any(strcmp(x, @{"low", "medium", "high"@}); +## p = p.addParamValue ("tolerance", "low", @@val_verb); +## +## ## create a switch type of argument +## p = p.addSwitch ("verbose"); +## +## p = p.parse (pack, path, mat, varargin@{:@}); +## +## ## the rest of the function can access the input by accessing p.Results +## ## for example, to access the value of tolerance, use p.Results.tolerance +## endfunction +## +## check ("mech"); # valid, will use defaults for other arguments +## check (); # error since at least one argument is mandatory +## check (1); # error since !ischar +## check ("mech", "~/dev"); # valid, will use defaults for other arguments +## +## check ("mech", "~/dev", [0 1 0 0], "type", "linear"); # valid +## +## ## the following is also valid. Note how the Switch type of argument can be +## ## mixed into or before the ParamValue (but still after Optional) +## check ("mech", "~/dev", [0 1 0 0], "verbose", "tolerance", "high"); +## +## ## the following returns an error since not all optional arguments, `path' and +## ## `mat', were given before the named argument `type'. +## check ("mech", "~/dev", "type", "linear"); +## @end group +## @end example +## +## @emph{Note 1}: a function can have any mixture of the four API types but they +## must appear in a specific order. @command{Required} arguments must be the very +## first which can be followed by @command{Optional} arguments. Only the +## @command{ParamValue} and @command{Switch} arguments can be mixed together but +## must be at the end. +## +## @emph{Note 2}: if both @command{Optional} and @command{ParamValue} arguments +## are mixed in a function API, once a string Optional argument fails to validate +## against, it will be considered the end of @command{Optional} arguments and the +## first key for a @command{ParamValue} and @command{Switch} arguments. +## +## @seealso{@@inputParser/addOptional, @@inputParser/addSwitch, +## @@inputParser/addParamValue, @@inputParser/addRequired, +## @@inputParser/createCopy, @@inputParser/parse} +## @end deftypefn + +function inPar = inputParser + + if (nargin != 0) + print_usage; + endif + + inPar = struct; + + ## these are not to be accessed by users. Each will have a field whose names + ## are the argnames which will also be a struct with fieldnames 'validator' + ## and 'default' + inPar.ParamValue = struct; + inPar.Optional = struct; + inPar.Required = struct; + inPar.Switch = struct; + + ## this will be filled when the methodd parse is used and will be a struct whose + ## fieldnames are the argnames that return their value + inPar.Results = struct; + + ## an 1xN cell array with argnames. It is read only by the user and its order + ## showws the order that they were added to the object (which is the order they + ## will be expected) + inPar.Parameters = {}; + + inPar.CaseSensitive = false; + inPar.FunctionName = ''; # name of the function for the error message + inPar.KeepUnmatched = false; + inPar.StructExpand = true; + inPar.Unmatched = struct; + inPar.UsingDefaults = {}; + + inPar = class (inPar, 'inputParser'); + +endfunction + +%!shared p, out +%! p = inputParser; +%! p = p.addRequired ("req1", @(x) ischar (x)); +%! p = p.addOptional ("op1", "val", @(x) ischar (x) && any (strcmp (x, {"val", "foo"}))); +%! p = p.addOptional ("op2", 78, @(x) (x) > 50); +%! p = p.addSwitch ("verbose"); +%! p = p.addParamValue ("line", "tree", @(x) ischar (x) && any (strcmp (x, {"tree", "circle"}))); +%! ## check normal use, only required are given +%! out = p.parse ("file"); +%!assert ({out.Results.req1, out.Results.op1, out.Results.op2, out.Results.verbose, out.Results.line}, +%! {"file" , "val" , 78 , false , "tree"}); +%!assert (out.UsingDefaults, {"op1", "op2", "verbose", "line"}); +%! ## check normal use, but give values different than defaults +%! out = p.parse ("file", "foo", 80, "line", "circle", "verbose"); +%!assert ({out.Results.req1, out.Results.op1, out.Results.op2, out.Results.verbose, out.Results.line}, +%! {"file" , "foo" , 80 , true , "circle"}); +%! ## check optional is skipped and considered ParamValue if unvalidated string +%! out = p.parse ("file", "line", "circle"); +%!assert ({out.Results.req1, out.Results.op1, out.Results.op2, out.Results.verbose, out.Results.line}, +%! {"file" , "val" , 78 , false , "circle"}); +%! ## check case insensitivity +%! out = p.parse ("file", "foo", 80, "LiNE", "circle", "vERbOSe"); +%!assert ({out.Results.req1, out.Results.op1, out.Results.op2, out.Results.verbose, out.Results.line}, +%! {"file" , "foo" , 80 , true , "circle"}); +%! ## check KeepUnmatched +%! p.KeepUnmatched = true; +%! out = p.parse ("file", "foo", 80, "line", "circle", "verbose", "extra", 50); +%!assert (out.Unmatched.extra, 50) +%! ## check error when missing required +%!error(p.parse()) +%! ## check error when given required do not validate +%!error(p.parse(50)) +%! ## check error when given optional do not validate +%!error(p.parse("file", "no-val")) +%! ## check error when given ParamValue do not validate +%!error(p.parse("file", "foo", 51, "line", "round")) + +## check alternative method (obj), ...) API +%!shared p, out +%! p = inputParser; +%! p = addRequired (p, "req1", @(x) ischar (x)); +%! p = addOptional (p, "op1", "val", @(x) ischar (x) && any (strcmp (x, {"val", "foo"}))); +%! p = addOptional (p, "op2", 78, @(x) (x) > 50); +%! p = addSwitch (p, "verbose"); +%! p = addParamValue (p, "line", "tree", @(x) ischar (x) && any (strcmp (x, {"tree", "circle"}))); +%! ## check normal use, only required are given +%! out = parse (p, "file"); +%!assert ({out.Results.req1, out.Results.op1, out.Results.op2, out.Results.verbose, out.Results.line}, +%! {"file" , "val" , 78 , false , "tree"}); +%!assert (out.UsingDefaults, {"op1", "op2", "verbose", "line"}); +%! ## check normal use, but give values different than defaults +%! out = parse (p, "file", "foo", 80, "line", "circle", "verbose"); +%!assert ({out.Results.req1, out.Results.op1, out.Results.op2, out.Results.verbose, out.Results.line}, +%! {"file" , "foo" , 80 , true , "circle"}); + +## if we were matlab compatible... +%!shared p, out +%! p = inputParser; +%! p = p.addOptional ("op1", "val"); +%! p = p.addParamValue ("line", "tree"); +%!xtest assert (getfield (p.parse("line", "circle"), "Results"), struct ("op1", "val", "line", "circle")); diff --git a/octave_packages/general-1.3.1/@inputParser/parse.m b/octave_packages/general-1.3.1/@inputParser/parse.m new file mode 100644 index 0000000..2a7c407 --- /dev/null +++ b/octave_packages/general-1.3.1/@inputParser/parse.m @@ -0,0 +1,37 @@ +## Copyright (C) 2011 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{parser} =} parse (@var{parser}, @var{varargin}) +## @deftypefnx {Function File} {@var{parser} =} @var{parser}.parse (@var{varargin}) +## Parses and validates list of arguments according to object @var{parser} of the +## class inputParser. +## +## After parsing, the results can be accessed with the @command{Results} +## accessor. See @command{help inputParser} for a more complete description. +## +## @seealso{inputParser, @@inputParser/addOptional, @@inputParser/addParamValue +## @@inputParser/addParamValue, @@inputParser/addRequired, @@inputParser/addSwitch} +## @end deftypefn + +function inPar = parse (inPar, varargin) + + ## check @inputParser/subsref for the actual code + inPar = subsref (inPar, substruct( + '.' , 'parse', + '()', varargin + )); + +endfunction diff --git a/octave_packages/general-1.3.1/@inputParser/subsasgn.m b/octave_packages/general-1.3.1/@inputParser/subsasgn.m new file mode 100644 index 0000000..01250e3 --- /dev/null +++ b/octave_packages/general-1.3.1/@inputParser/subsasgn.m @@ -0,0 +1,37 @@ +## Copyright (C) 2011 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +function inPar = subsasgn (inPar, idx, rhs) + + if ( idx.type != '.' ) + error ("invalid index for class %s", class (inPar) ); + endif + + switch idx.subs + case {'CaseSensitive', 'KeepUnmatched', 'StructExpand'} + if ( !islogical (rhs) ) + error("Property '%s' of the class inputParser must be logical", idx.subs) + endif + inPar.(idx.subs) = rhs; + case 'FunctionName' + if ( !ischar (rhs) ) + error("Property 'FunctionName' of the class inputParser can only be set to a string") + endif + inPar.(idx.subs) = sprintf("%s : ", rhs); + otherwise + error ("invalid index for assignment of class %s", class (inPar) ); + endswitch + +endfunction diff --git a/octave_packages/general-1.3.1/@inputParser/subsref.m b/octave_packages/general-1.3.1/@inputParser/subsref.m new file mode 100644 index 0000000..86bd761 --- /dev/null +++ b/octave_packages/general-1.3.1/@inputParser/subsref.m @@ -0,0 +1,336 @@ +## Copyright (C) 2011-2012 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +function inPar = subsref (inPar, idx) + + if ( !isa (inPar, 'inputParser') ) + error ("object must be of the inputParser class but '%s' was used", class (inPar) ); + elseif ( idx(1).type != '.' ) + error ("invalid index for class %s", class (inPar) ); + endif + + ## the following at the end may allow to use the obj.method notation one day + ## jwe is very against this ugly hack + ## what would happen if the user has the obj inside a struct? Bad things! +# ori = inputname(1); +# assignin('caller', ori, inPar); + + method = idx(1).subs; + + switch method + case 'Results' + inPar = retrieve_results (inPar, idx) + case 'Parameters' + inPar = inPar.Parameters; + case 'parse' + inPar = parse_args (inPar, idx); + case 'Unmatched' + case 'UsingDefaults' + case {'addOptional', 'addParamValue', 'addRequired', 'addSwitch'} + inPar = check_methods (inPar, idx); + otherwise + error ("invalid index for reference of class %s", class (inPar) ); + endswitch + + ## TODO we should make inPar an object of the inputParser class again. At + ## least after running parse it becomes just a structure again. While that is + ## bad, at least allows for easy access to the Results and Unmatched fields + ## without extra coding. +# inPar = class (inPar, 'inputParser'); + +endfunction + +function out = retrieve_results (inPar, idx) + + if ( numel(idx) != 2 || idx(2).type != '.' ) + print_usage ("@inputParser/Results"); + endif + + out = inPar.Results.(idx(2).subs); + +endfunction + + +## when parsing options, here's the principle: Required options have to be the +## first ones. They are followed by Optional if any. In the end come the +## ParamValue mixed with Switch. Any other order makes no sense +function inPar = parse_args (inPar, idx) + + ## syntax is inPar.parse (arguments) + if ( numel(idx) != 2 || idx(2).type != '()' ) + print_usage ("@inputParser/parse"); + endif + + ## this makes it easier to read but may be memory instensive + args = idx(2).subs; + + ## make copy of ordered list of Parameters to keep the original intact and readable + inPar.copy = inPar.Parameters; + + if ( numel (fieldnames (inPar.Required)) > numel (args) ) + error("%sNot enough arguments", inPar.FunctionName); + endif + + ## we take names out of 'copy' and values out of 'args', evaluate them and + ## store them into 'Results' + for i = 1 : numel (fieldnames (inPar.Required)) + [name, inPar.copy] = shift (inPar.copy); + [value, args] = shift (args); + if ( !feval (inPar.Required.(name).validator, value) ) + error_invalid (inPar.FunctionName, name, inPar.Required.(name).validator); + endif + inPar.Results.(name) = value; + endfor + + ## loop a maximum #times of the number of Optional, similarly to the required + ## loop. Once ran out of 'args', move their name into usingDefaults, place + ## their default values into 'Results', and break + + ## because if an argument is string and does not validate, should be considered + ## a ParamValue key + found_possible_key = false; + + for i = 1 : numel (fieldnames (inPar.Optional)) + if ( !numel (args) || found_possible_key) + ## loops the number of Optional options minus the number of them already processed + for n = 1 : (numel (fieldnames (inPar.Optional)) - i + 1 ) + [name, inPar.copy] = shift (inPar.copy); + inPar.UsingDefaults = push (inPar.UsingDefaults, name); + inPar.Results.(name) = inPar.Optional.(name).default; + endfor + break + endif + [name, inPar.copy] = shift (inPar.copy); + [value, args] = shift (args); + if ( !feval (inPar.Optional.(name).validator, value) ) + if (ischar (value) ) + ## maybe the other optional are not defined, this can be Paramvalue + ## place this one on defaults and go back to the top with note to clean loop + inPar.UsingDefaults = push (inPar.UsingDefaults, name); + inPar.Results.(name) = inPar.Optional.(name).default; + found_possible_key = true; + args = unshift (args, value); + continue + else + error_invalid (inPar.FunctionName, name, inPar.Optional.(name).validator); + endif + else + inPar.Results.(name) = value; + endif + endfor + + ## loop a maximum #times of the number of ParamValue, taking pairs of keys and + ## values out 'args'. We no longer expect an order so we need the index in + ## 'copy' to remove it from there. Once ran out of 'args', move their name + ## into usingDefaults, place their default values into 'Results', and break + for i = 1 : (numel (fieldnames (inPar.ParamValue)) + numel (fieldnames (inPar.Switch))) + if ( !numel (args) ) + ## loops the number of times left in 'copy' since these are the last type + for n = 1 : numel (inPar.copy) + [name, inPar.copy] = shift (inPar.copy); + inPar.UsingDefaults = push (inPar.UsingDefaults, name); + if (isfield (inPar.ParamValue, name)) + inPar.Results.(name) = inPar.ParamValue.(name).default; + else + inPar.Results.(name) = inPar.Switch.(name).default; + endif + endfor + break + endif + [key, args] = shift (args); + if ( !ischar (key) ) + error("%sParameter/Switch names must be strings", inPar.FunctionName); + endif + if (inPar.CaseSensitive) + index = find( strcmp(inPar.copy, key)); + else + index = find( strcmpi(inPar.copy, key)); + endif + ## we can't use isfield here to support case insensitive + if (any (strcmpi (fieldnames (inPar.Switch), key))) + value = true; + method = "Switch"; + else + ## then it must be a ParamValue (even if unmatched), shift its value + if (numel (args) < 1) + error ("%sparameter '%s' does not have a value", inPar.FunctionName, key); + endif + [value, args] = shift (args); + method = "ParamValue"; + endif + + ## empty index means no match so either return error or move them into 'Unmatched' + if (!isempty (index)) + [name, inPar.copy] = shift (inPar.copy, index); + if ( !feval (inPar.(method).(name).validator, value)) + error_invalid (inPar.FunctionName, key, inPar.(method).(name).validator); + endif + ## we use the name shifted from 'copy' instead of the key from 'args' in case + ## the key is in the wrong case + inPar.Results.(name) = value; + elseif (isempty (index) && inPar.KeepUnmatched ) + inPar.Unmatched.(key) = value; + i = i - 1; # this time didn't count, go back one + else + error ("%sargument '%s' did not match any valid parameter of the parser", inPar.FunctionName, key); + endif + endfor + + ## if there's leftovers they must be unmatched. Note that some unmatched can + ## have already been processed in the ParamValue loop + if ( numel (args) && inPar.KeepUnmatched ) + for i = 1 : ( numel(args) / 2 ) + [key, args] = shift (args); + [value, args] = shift (args); + inPar.Unmatched.(key) = value; + endfor + elseif ( numel (args) ) + error("%sfound unmatched parameters at end of arguments list", inPar.FunctionName); + endif + + ## remove copied field, keep it clean + inPar = rmfield (inPar, 'copy'); + +endfunction + + +function inPar = check_methods (inPar, idx) + + ## this makes it easier to read but is more memory intensive? + method = idx(1).subs; + args = idx(2).subs; + func = sprintf ("@inputParser/%s", method); + + if ( idx(2).type != '()' ) + print_usage (func); + endif + def_val = @() true; + [name, args] = shift (args); + ## a validator is optional but that complicates handling all the parsing with + ## few functions and conditions. If not specified @() true will always return + ## true. Simply using true is not enough because if the argument is zero it + ## return false and if it's too large, takes up memory + switch method + case {'addOptional', 'addParamValue'} + if ( numel (args) == 1 ) + args{2} = def_val; + elseif ( numel (args) == 2 ) + args{2} = validate_validator (args{2}); + else + print_usage(func); + endif + [def, val] = args{:}; + case {'addRequired'} + if ( numel (args) == 0 ) + val = def_val; + elseif ( numel (args) == 1 ) + val = validate_validator (args{1}); + else + print_usage(func); + endif + def = false; + case {'addSwitch'} + if ( numel (args) == 0 ) + val = def_val; + def = false; + else + print_usage(func); + endif + otherwise + error ("invalid index for reference of class %s", class (inPar) ); + endswitch + + inPar = validate_args (method(4:end), inPar, name, val, def); + +endfunction + +## because we are nice we also support using the name of a function and not only +## a function handle +function val = validate_validator (val) + if ( ischar (val) ) + val = str2func (val); + elseif ( !isa (val, 'function_handle') ) + error ("validator must be a function handle or the name of a valid function"); + end +endfunction + +## to have a single function that handles them all, something must be done with +## def value, because addRequire does not have those. That's why the order of +## the last two args is different from the rest and why 'def' has a default value +function inPar = validate_args (method, inPar, name, val, def = false) + + if ( !strcmp (class (inPar), 'inputParser') ) + error ("object must be of the inputParser class but '%s' was used", class (inPar) ); + elseif ( !isvarname (name) ) + error ("invalid variable name in argname"); + endif + + ## because the order arguments are specified are the order they are expected, + ## can't have ParamValue/Switch before Optional, and Optional before Required + n_optional = numel (fieldnames (inPar.Optional)); + n_params = numel (fieldnames (inPar.ParamValue)); + n_switch = numel (fieldnames (inPar.Switch)); + if ( strcmp (method, 'Required') && ( n_optional || n_params || n_switch) ) + error ("Can't specify 'Required' arguments after Optional, ParamValue or Switch"); + elseif ( strcmp (method, 'Optional') && ( n_params || n_switch) ) + error ("Can't specify 'Optional' arguments after ParamValue or Switch"); + endif + + ## even if CaseSensitive is turned on, we still shouldn't have two args with + ## the same. What if they decide to change in the middle of specifying them? + if ( any (strcmpi (inPar.Parameters, name)) ) + error ("argname '%s' has already been specified", name); + else + inPar.Parameters = push (inPar.Parameters, name); + inPar.(method).(name).default = def; + inPar.(method).(name).validator = val; + endif + + ## make sure that the given default value is actually valid + ## TODO make sure that when using the default, it's only validated once + if ( isa (val, 'function_handle') && !strcmpi (method, 'Required') && !feval (val, def) ) + error ("default value for '%s' failed validation with '%s'", name, func2str (val) ); + endif + +endfunction + +## this is just for consistency of error message +function error_invalid (prefix, name, val) + error("%sargument '%s' failed validation %s", prefix, name, func2str (val)); +endfunction + +################################################################################ +## very auxiliary functions +################################################################################ + +function [out, in] = shift (in, idx = 1) + out = in{idx}; + in(idx) = []; +endfunction + +function [in] = unshift (in, add) + if ( !iscell (add) ) + add = {add}; + endif + in (numel(add) + 1 : end + numel(add)) = in; + in (1:numel(add)) = add; +endfunction + +function [in] = push (in, add) + if ( !iscell (add) ) + add = {add}; + endif + in( end+1 : end+numel(add) ) = add; +endfunction diff --git a/octave_packages/general-1.3.1/adresamp2.m b/octave_packages/general-1.3.1/adresamp2.m new file mode 100644 index 0000000..1294a00 --- /dev/null +++ b/octave_packages/general-1.3.1/adresamp2.m @@ -0,0 +1,90 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{xs}, @var{ys}] =} adresamp2 (@var{x}, @var{y}, @var{n}, @var{eps}) +## Perform an adaptive resampling of a planar curve. +## The arrays @var{x} and @var{y} specify x and y coordinates of the points of the curve. +## On return, the same curve is approximated by @var{xs}, @var{ys} that have length @var{n} +## and the angles between successive segments are approximately equal. +## @end deftypefn + +## Author : Jaroslav Hajek + +function [xs, ys] = adresamp2 (x, y, n, eps) + if (! isvector (x) || ! size_equal (x, y) || ! isscalar (n) \ + || ! isscalar (eps)) + print_usage (); + endif + + if (rows (x) == 1) + rowvec = true; + x = x.'; y = y.'; + else + rowvec = false; + endif + + # first differences + dx = diff (x); dy = diff (y); + # arc lengths + ds = hypot (dx, dy); + # derivatives + dx = dx ./ ds; + dy = dy ./ ds; + # second derivatives + d2x = deriv2 (dx, ds); + d2y = deriv2 (dy, ds); + # curvature + k = abs (d2x .* dy - d2y .* dx); + # curvature cut-off + if (eps > 0) + k = max (k, eps*max (k)); + endif + # cumulative integrals + s = cumsum ([0; ds]); + t = cumsum ([0; ds .* k]); + # generate sample points + i = linspace (0, t(end), n); + if (! rowvec) + i = i.'; + endif + # and resample + xs = interp1 (t, x, i); + ys = interp1 (t, y, i); +endfunction + +# calculates second derivatives from first (non-uniform intervals), using local +# quadratic approximations. +function d2x = deriv2 (dx, dt) + n = length (dt); + if (n >= 2) + d2x = diff (dx) ./ (dt(1:n-1) + dt(2:n)); + d2x = [2*d2x(1); d2x(1:n-2) + d2x(2:n-1); 2*d2x(n-1)]; + else + d2x = zeros (n, 1); + endif +endfunction + +%!demo +%! R = 2; r = 3; d = 1.5; +%! th = linspace (0, 2*pi, 1000); +%! x = (R-r) * cos (th) + d*sin ((R-r)/r * th); +%! y = (R-r) * sin (th) + d*cos ((R-r)/r * th); +%! x += 0.3*exp (-(th-0.8*pi).^2); +%! y += 0.4*exp (-(th-0.9*pi).^2); +%! +%! [xs, ys] = adresamp2 (x, y, 40); +%! plot (x, y, "-", xs, ys, "*"); +%! title ("adaptive resampling") diff --git a/octave_packages/general-1.3.1/doc-cache b/octave_packages/general-1.3.1/doc-cache new file mode 100644 index 0000000..17e24eb --- /dev/null +++ b/octave_packages/general-1.3.1/doc-cache @@ -0,0 +1,359 @@ +# Created by Octave 3.6.1, Thu May 17 20:15:05 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 8 +# name: +# type: sq_string +# elements: 1 +# length: 9 +adresamp2 + + +# name: +# type: sq_string +# elements: 1 +# length: 342 + -- Function File: [XS, YS] = adresamp2 (X, Y, N, EPS) + Perform an adaptive resampling of a planar curve. The arrays X + and Y specify x and y coordinates of the points of the curve. On + return, the same curve is approximated by XS, YS that have length N + and the angles between successive segments are approximately equal. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Perform an adaptive resampling of a planar curve. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +majle + + +# name: +# type: sq_string +# elements: 1 +# length: 3339 +MAJLE (Weak) Majorization check + S = MAJLE(X,Y) checks if the real part of X is (weakly) majorized by + the real part of Y, where X and Y must be numeric (full or sparse) + arrays. It returns S=0, if there is no weak majorization of X by Y, + S=1, if there is a weak majorization of X by Y, or S=2, if there is a + strong majorization of X by Y. The shapes of X and Y are ignored. + NUMEL(X) and NUMEL(Y) may be different, in which case one of them is + appended with zeros to match the sizes with the other and, in case of + any negative components, a special warning is issued. + + S = MAJLE(X,Y,MAJLETOL) allows in addition to specify the tolerance in + all inequalities [S,Z] = MAJLE(X,Y,MAJLETOL) also outputs a row vector + Z, which appears in the definition of the (weak) majorization. In the + traditional case, where the real vectors X and Y are of the same size, + Z = CUMSUM(SORT(Y,'descend')-SORT(X,'descend')). Here, X is weakly + majorized by Y, if MIN(Z)>0, and strongly majorized if MIN(Z)=0, see + http://en.wikipedia.org/wiki/Majorization + + The value of MAJLETOL depends on how X and Y have been computed, i.e., + on what the level of error in X or Y is. A good minimal starting point + should be MAJLETOL=eps*MAX(NUMEL(X),NUMEL(Y)). The default is 0. + + % Examples: + x = [2 2 2]; y = [1 2 3]; s = majle(x,y) + % returns the value 2. + x = [2 2 2]; y = [1 2 4]; s = majle(x,y) + % returns the value 1. + x = [2 2 2]; y = [1 2 2]; s = majle(x,y) + % returns the value 0. + x = [2 2 2]; y = [1 2 2]; [s,z] = majle(x,y) + % also returns the vector z = [ 0 0 -1]. + x = [2 2 2]; y = [1 2 2]; s = majle(x,y,1) + % returns the value 2. + x = [2 2]; y = [1 2 2]; s = majle(x,y) + % returns the value 1 and warns on tailing with zeros + x = [2 2]; y = [-1 2 2]; s = majle(x,y) + % returns the value 0 and gives two warnings on tailing with zeros + x = [2 -inf]; y = [4 inf]; [s,z] = majle(x,y) + % returns s = 1 and z = [Inf Inf]. + x = [2 inf]; y = [4 inf]; [s,z] = majle(x,y) + % returns s = 1 and z = [NaN NaN] and a warning on NaNs in z. + x=speye(2); y=sparse([0 2; -1 1]); s = majle(x,y) + % returns the value 2. + x = [2 2; 2 2]; y = [1 3 4]; [s,z] = majle(x,y) %and + x = [2 2; 2 2]+i; y = [1 3 4]-2*i; [s,z] = majle(x,y) + % both return s = 2 and z = [2 3 2 0]. + x = [1 1 1 1 0]; y = [1 1 1 1 1 0 0]'; s = majle(x,y) + % returns the value 1 and warns on tailing with zeros + + % One can use this function to check numerically the validity of the + Schur-Horn,Lidskii-Mirsky-Wielandt, and Gelfand-Naimark theorems: + clear all; n=100; majleTol=n*n*eps; + A = randn(n,n); A = A'+A; eA = -sort(-eig(A)); dA = diag(A); + majle(dA,eA,majleTol) % returns the value 2 + % which is the Schur-Horn theorem; and + B=randn(n,n); B=B'+B; eB=-sort(-eig(B)); + eAmB=-sort(-eig(A-B)); + majle(eA-eB,eAmB,majleTol) % returns the value 2 + % which is the Lidskii-Mirsky-Wielandt theorem; finally + A = randn(n,n); sA = -sort(-svd(A)); + B = randn(n,n); sB = -sort(-svd(B)); + sAB = -sort(-svd(A*B)); + majle(log2(sAB)-log2(sA), log2(sB), majleTol) % retuns the value 2 + majle(log2(sAB)-log2(sB), log2(sA), majleTol) % retuns the value 2 + % which are the log versions of the Gelfand-Naimark theorems + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +MAJLE (Weak) Majorization check + S = MAJLE(X,Y) checks if the real part of X + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +pararrayfun + + +# name: +# type: sq_string +# elements: 1 +# length: 1005 + -- Function File: [O1, O2, ...] = pararrayfun (NPROC, FUN, A1, A2, ...) + -- Function File: pararrayfun (nproc, fun, ..., "UniformOutput", VAL) + -- Function File: pararrayfun (nproc, fun, ..., "ErrorHandler", + ERRFUNC) + Evaluates a function for corresponding elements of an array. + Argument and options handling is analogical to `parcellfun', + except that arguments are arrays rather than cells. If cells occur + as arguments, they are treated as arrays of singleton cells. + Arrayfun supports one extra option compared to parcellfun: + "Vectorized". This option must be given together with + "ChunksPerProc" and it indicates that FUN is able to operate on + vectors rather than just scalars, and returns a vector. The same + must be true for ERRFUNC, if given. In this case, the array is + split into chunks which are then directly served to FUNC for + evaluation, and the results are concatenated to output arrays. + + See also: parcellfun, arrayfun + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 +Evaluates a function for corresponding elements of an array. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +parcellfun + + +# name: +# type: sq_string +# elements: 1 +# length: 2496 + -- Function File: [O1, O2, ...] = parcellfun (NPROC, FUN, A1, A2, ...) + -- Function File: parcellfun (nproc, fun, ..., "UniformOutput", VAL) + -- Function File: parcellfun (nproc, fun, ..., "ErrorHandler", + ERRFUNC) + -- Function File: parcellfun (nproc, fun, ..., "VerboseLevel", VAL) + -- Function File: parcellfun (nproc, fun, ..., "ChunksPerProc", VAL) + Evaluates a function for multiple argument sets using multiple + processes. NPROC should specify the number of processes. A + maximum recommended value is equal to number of CPUs on your + machine or one less. FUN is a function handle pointing to the + requested evaluating function. A1, A2 etc. should be cell arrays + of equal size. O1, O2 etc. will be set to corresponding output + arguments. + + The UniformOutput and ErrorHandler options are supported with + meaning identical to "cellfun". A VerboseLevel option controlling + the level output is supported. A value of 0 is quiet, 1 is + normal, and 2 or more enables debugging output. The ChunksPerProc + option control the number of chunks which contains elementary + jobs. This option particularly useful when time execution of + function is small. Setting this option to 100 is a good choice in + most cases. + + Notice that jobs are served from a single first-come first-served + queue, so the number of jobs executed by each process is generally + unpredictable. This means, for example, that when using this + function to perform Monte-Carlo simulations one cannot expect + results to be exactly reproducible. The pseudo random number + generators of each process are initialised with a unique state. + This currently works only for new style generators. + + NOTE: this function is implemented using "fork" and a number of + pipes for IPC. Suitable for systems with an efficient "fork" + implementation (such as GNU/Linux), on other systems (Windows) it + should be used with caution. Also, if you use a multithreaded + BLAS, it may be wise to turn off multi-threading when using this + function. + + CAUTION: This function should be regarded as experimental. + Although all subprocesses should be cleared in theory, there is + always a danger of a subprocess hanging up, especially if + unhandled errors occur. Under GNU and compatible systems, the + following shell command may be used to display orphaned Octave + processes: ps -ppid 1 | grep octave + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 +Evaluates a function for multiple argument sets using multiple +processes. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +safeprod + + +# name: +# type: sq_string +# elements: 1 +# length: 395 + -- Function File: P = safeprod (X, DIM) + -- Function File: [P, E] = safeprod (X, DIM) + This function forms product(s) of elements of the array X along + the dimension specified by DIM, analogically to `prod', but avoids + overflows and underflows if possible. If called with 2 output + arguments, P and E are computed so that the product is `P * 2^E'. + + See also: prod, log2 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +This function forms product(s) of elements of the array X along the +dimension sp + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +unresamp2 + + +# name: +# type: sq_string +# elements: 1 +# length: 341 + -- Function File: [XS, YS] = unresamp2 (X, Y, N) + Perform a uniform resampling of a planar curve. The arrays X and + Y specify x and y coordinates of the points of the curve. On + return, the same curve is approximated by XS, YS that have length N + and the distances between successive points are approximately + equal. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Perform a uniform resampling of a planar curve. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +unvech + + +# name: +# type: sq_string +# elements: 1 +# length: 477 + -- Function File: M = unvech (V, SCALE) + Performs the reverse of `vech' on the vector V. + + Given a Nx1 array V describing the lower triangular part of a + matrix (as obtained from `vech'), it returns the full matrix. + + The upper triangular part of the matrix will be multiplied by + SCALE such that 1 and -1 can be used for symmetric and + antisymmetric matrix respectively. SCALE must be a scalar and + defaults to 1. + + See also: vech, ind2sub + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Performs the reverse of `vech' on the vector V. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ztvals + + +# name: +# type: sq_string +# elements: 1 +# length: 291 + -- Function File: function ztvals (X, TOL) + Replaces tiny elements of the vector X by zeros. Equivalent to + X(abs(X) < TOL * norm (X, Inf)) = 0 + TOL specifies the chopping tolerance. It defaults to 1e-10 for + double precision and 1e-5 for single precision inputs. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Replaces tiny elements of the vector X by zeros. + + + + + diff --git a/octave_packages/general-1.3.1/majle.m b/octave_packages/general-1.3.1/majle.m new file mode 100644 index 0000000..6533a36 --- /dev/null +++ b/octave_packages/general-1.3.1/majle.m @@ -0,0 +1,160 @@ +## Copyright (c) 2010 Andrew V. Knyazev +## Copyright (c) 2010 Merico .E. Argentati +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions are met: +## +## 1 Redistributions of source code must retain the above copyright notice, +## this list of conditions and the following disclaimer. +## 2 Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## 3 Neither the name of the author nor the names of its contributors may be +## used to endorse or promote products derived from this software without +## specific prior written permission. +## +## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +%MAJLE (Weak) Majorization check +% S = MAJLE(X,Y) checks if the real part of X is (weakly) majorized by +% the real part of Y, where X and Y must be numeric (full or sparse) +% arrays. It returns S=0, if there is no weak majorization of X by Y, +% S=1, if there is a weak majorization of X by Y, or S=2, if there is a +% strong majorization of X by Y. The shapes of X and Y are ignored. +% NUMEL(X) and NUMEL(Y) may be different, in which case one of them is +% appended with zeros to match the sizes with the other and, in case of +% any negative components, a special warning is issued. +% +% S = MAJLE(X,Y,MAJLETOL) allows in addition to specify the tolerance in +% all inequalities [S,Z] = MAJLE(X,Y,MAJLETOL) also outputs a row vector +% Z, which appears in the definition of the (weak) majorization. In the +% traditional case, where the real vectors X and Y are of the same size, +% Z = CUMSUM(SORT(Y,'descend')-SORT(X,'descend')). Here, X is weakly +% majorized by Y, if MIN(Z)>0, and strongly majorized if MIN(Z)=0, see +% http://en.wikipedia.org/wiki/Majorization +% +% The value of MAJLETOL depends on how X and Y have been computed, i.e., +% on what the level of error in X or Y is. A good minimal starting point +% should be MAJLETOL=eps*MAX(NUMEL(X),NUMEL(Y)). The default is 0. +% +% % Examples: +% x = [2 2 2]; y = [1 2 3]; s = majle(x,y) +% % returns the value 2. +% x = [2 2 2]; y = [1 2 4]; s = majle(x,y) +% % returns the value 1. +% x = [2 2 2]; y = [1 2 2]; s = majle(x,y) +% % returns the value 0. +% x = [2 2 2]; y = [1 2 2]; [s,z] = majle(x,y) +% % also returns the vector z = [ 0 0 -1]. +% x = [2 2 2]; y = [1 2 2]; s = majle(x,y,1) +% % returns the value 2. +% x = [2 2]; y = [1 2 2]; s = majle(x,y) +% % returns the value 1 and warns on tailing with zeros +% x = [2 2]; y = [-1 2 2]; s = majle(x,y) +% % returns the value 0 and gives two warnings on tailing with zeros +% x = [2 -inf]; y = [4 inf]; [s,z] = majle(x,y) +% % returns s = 1 and z = [Inf Inf]. +% x = [2 inf]; y = [4 inf]; [s,z] = majle(x,y) +% % returns s = 1 and z = [NaN NaN] and a warning on NaNs in z. +% x=speye(2); y=sparse([0 2; -1 1]); s = majle(x,y) +% % returns the value 2. +% x = [2 2; 2 2]; y = [1 3 4]; [s,z] = majle(x,y) %and +% x = [2 2; 2 2]+i; y = [1 3 4]-2*i; [s,z] = majle(x,y) +% % both return s = 2 and z = [2 3 2 0]. +% x = [1 1 1 1 0]; y = [1 1 1 1 1 0 0]'; s = majle(x,y) +% % returns the value 1 and warns on tailing with zeros +% +% % One can use this function to check numerically the validity of the +% Schur-Horn,Lidskii-Mirsky-Wielandt, and Gelfand-Naimark theorems: +% clear all; n=100; majleTol=n*n*eps; +% A = randn(n,n); A = A'+A; eA = -sort(-eig(A)); dA = diag(A); +% majle(dA,eA,majleTol) % returns the value 2 +% % which is the Schur-Horn theorem; and +% B=randn(n,n); B=B'+B; eB=-sort(-eig(B)); +% eAmB=-sort(-eig(A-B)); +% majle(eA-eB,eAmB,majleTol) % returns the value 2 +% % which is the Lidskii-Mirsky-Wielandt theorem; finally +% A = randn(n,n); sA = -sort(-svd(A)); +% B = randn(n,n); sB = -sort(-svd(B)); +% sAB = -sort(-svd(A*B)); +% majle(log2(sAB)-log2(sA), log2(sB), majleTol) % retuns the value 2 +% majle(log2(sAB)-log2(sB), log2(sA), majleTol) % retuns the value 2 +% % which are the log versions of the Gelfand-Naimark theorems + +% Tested in MATLAB 7.9.0.529 (R2009b) and Octave 3.2.3. +function [s,z]=majle(x,y,majleTol) + + if (nargin < 2) + error('MAJORIZATION:majle:NotEnoughInputs',... + 'Not enough input arguments.'); + end + if (nargin > 3) + error('MAJORIZATION:majle:TooManyInputs',... + 'Too many input arguments.'); + end + if (nargout > 2) + error('MAJORIZATION:majle:TooManyOutputs',... + 'Too many output arguments.'); + end + + % Assign default values to unspecified parameters + if (nargin == 2) + majleTol = 0; + end + + % transform into real (row) vectors + x=real(x); xc=reshape(x,1,numel(x)); clear x; + y=real(y); yc=reshape(y,1,numel(y)); clear y; + + % sort both vectors in descending order + xc=-sort(-xc); yc=-sort(-yc); + + % tail with zeros the shorter vector to make vectors of the same length + if size(xc,2)~=size(yc,2) + checkForNegative = (xc(end) < -majleTol) || (yc(end) < -majleTol); + warning('MAJORIZATION:majle:ResizeVectors', ... + 'The input vectors have different sizes. Tailing with zeros.'); + yc=[yc zeros(size(xc,2)-size(yc,2),1)']; + xc=[xc zeros(size(yc,2)-size(xc,2),1)']; + % but warn if negative + if checkForNegative + warning('MAJORIZATION:majle:ResizeNegativeVectors', ... + sprintf('%s%s\n%s\n%s', ... + 'At least one of the input vectors ',... + 'has negative components.',... + ' Tailing with zeros is most likely senseless.',... + ' Make sure that you know what you are doing.')); + % sort again both vectors in descending order + xc=-sort(-xc); yc=-sort(-yc); + end + end + z=cumsum(yc-xc); + + %check for NaNs in z + if any(isnan(z)) + warning('MAJORIZATION:majle:NaNsInComparisons', ... + sprintf('%s%s\n%s\n%s', ... + 'At least one of the input vectors ',... + 'includes -Inf, Inf, or NaN components.',... + ' Some comparisons could not be made. ',... + ' Make sure that you know what you are doing.')); + end + + if min(z) < -majleTol + s=0; % no majorization + elseif abs(z(end)) <= majleTol + s=2; % strong majorization + else + s=1; % weak majorization + end +endfunction diff --git a/octave_packages/general-1.3.1/packinfo/.autoload b/octave_packages/general-1.3.1/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/general-1.3.1/packinfo/DESCRIPTION b/octave_packages/general-1.3.1/packinfo/DESCRIPTION new file mode 100644 index 0000000..4a1cbda --- /dev/null +++ b/octave_packages/general-1.3.1/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: general +Version: 1.3.1 +Date: 2012-05-14 +Author: various authors +Maintainer: Octave-Forge community +Title: General +Description: General tools for Octave, string dictionary, parallel computing. +Depends: octave (>= 3.4.3) +Autoload: yes +License: GPLv3+, modified BSD, public domain +Url: http://octave.sf.net diff --git a/octave_packages/general-1.3.1/packinfo/INDEX b/octave_packages/general-1.3.1/packinfo/INDEX new file mode 100644 index 0000000..3357e3d --- /dev/null +++ b/octave_packages/general-1.3.1/packinfo/INDEX @@ -0,0 +1,34 @@ +general >> General purpose functions +Dictionaries + @dict/dict + @dict/get + @dict/has + @dict/isempty + @dict/join + @dict/length + @dict/struct +Input check + @inputParser/addOptional + @inputParser/addRequired + @inputParser/addParamValue + @inputParser/addSwitch + @inputParser/createCopy + @inputParser/inputParser + @inputParser/parse +Parallel Computing + pararrayfun + parcellfun +Various Functions + adresamp2 + fload + fsave + majle + mark_for_deletion + packfields + safeprod + SHA1 + unpackfields + unresamp2 + unvech + ztvals + __exit__ diff --git a/octave_packages/general-1.3.1/packinfo/NEWS b/octave_packages/general-1.3.1/packinfo/NEWS new file mode 100644 index 0000000..15b9e0b --- /dev/null +++ b/octave_packages/general-1.3.1/packinfo/NEWS @@ -0,0 +1,39 @@ +Summary of important user-visible changes for general 1.3.1: +------------------------------------------------------------------- + + ** general 1.3.1 is a bug fix release + + ** The `addSwitch' method from inputParser class has been fixed + + ** For Matlab compatibility, optional arguments of the inputParser class + will be skipped and followed by ParamValue and Switch arguments if they + are a string that does not validate. Note that unlike Matlab, if no + validator is given, anything is valid, so giving no validator to an + Optional argument will not turn any string on the list of arguments + to be considered a ParamValue key. + +Summary of important user-visible changes for general 1.3.0: +------------------------------------------------------------------- + + ** The following functions are new: + majle + + ** The class `inputParser' class has been implemented with many methods. It + attempts to be as compatible with Matlab as possible. However, since + classdef is not yet implemented the syntax differs slightly. Unlike the + Matlab implementation, this functions return the object. For example: + + obj.method (arguments) # matlab implementation + obj = obj.method (arguments) # octave implementation + + The octave implementatino expands on the Matlab one as it has one more type + of API, see `help @inputParser/addSwitch'. + + ** The function `unvech' accepts a new argument scale to calculate + the upper triangular part of the matrix thus returning non-symmetric + matrix. + + ** The function `parcellfun' had the random number generator modifed, + a new option to set the verbosity level, and other bugs corrected. + + ** Package is no longer automatically loaded. diff --git a/octave_packages/general-1.3.1/pararrayfun.m b/octave_packages/general-1.3.1/pararrayfun.m new file mode 100644 index 0000000..cf61eb1 --- /dev/null +++ b/octave_packages/general-1.3.1/pararrayfun.m @@ -0,0 +1,73 @@ +## Copyright (C) 2009 Jaroslav Hajek +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## Copyright (C) 2009 Travis Collier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{o1}, @var{o2}, @dots{}] =} pararrayfun (@var{nproc}, @var{fun}, @var{a1}, @var{a2}, @dots{}) +## @deftypefnx{Function File} {} pararrayfun (nproc, fun, @dots{}, "UniformOutput", @var{val}) +## @deftypefnx{Function File} {} pararrayfun (nproc, fun, @dots{}, "ErrorHandler", @var{errfunc}) +## Evaluates a function for corresponding elements of an array. +## Argument and options handling is analogical to @code{parcellfun}, except that +## arguments are arrays rather than cells. If cells occur as arguments, they are treated +## as arrays of singleton cells. +## Arrayfun supports one extra option compared to parcellfun: "Vectorized". +## This option must be given together with "ChunksPerProc" and it indicates +## that @var{fun} is able to operate on vectors rather than just scalars, and returns +## a vector. The same must be true for @var{errfunc}, if given. +## In this case, the array is split into chunks which are then directly served to @var{func} +## for evaluation, and the results are concatenated to output arrays. +## @seealso{parcellfun, arrayfun} +## @end deftypefn + +function varargout = pararrayfun (nproc, func, varargin) + + if (nargin < 3) + print_usage (); + endif + + [nargs, uniform_output, error_handler, ... + verbose_level, chunks_per_proc, vectorized] = parcellfun_opts (varargin); + + args = varargin(1:nargs); + opts = varargin(nargs+1:end); + if (nargs == 0) + print_usage (); + elseif (nargs > 1) + [err, args{:}] = common_size (args{:}); + if (err) + error ("pararrayfun: arguments size must match"); + endif + endif + + njobs = numel (args{1}); + + if (vectorized && chunks_per_proc > 0 && chunks_per_proc < njobs / nproc) + ## If "Vectorized" is on, we apply the function directly on chunks of + ## arrays. + [varargout{1:nargout}] = chunk_parcellfun (nproc, chunks_per_proc, ... + func, error_handler, verbose_level, args{:}); + else + args = cellfun (@num2cell, args, "UniformOutput", false, + "ErrorHandler", @arg_class_error); + + [varargout{1:nargout}] = parcellfun (nproc, func, args{:}, opts{:}); + endif + +endfunction + +function arg_class_error (S, X) + error ("arrayfun: invalid argument of class %s", class (X)) +endfunction diff --git a/octave_packages/general-1.3.1/parcellfun.m b/octave_packages/general-1.3.1/parcellfun.m new file mode 100644 index 0000000..ab3024b --- /dev/null +++ b/octave_packages/general-1.3.1/parcellfun.m @@ -0,0 +1,387 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{o1}, @var{o2}, @dots{}] =} parcellfun (@var{nproc}, @var{fun}, @var{a1}, @var{a2}, @dots{}) +## @deftypefnx{Function File} {} parcellfun (nproc, fun, @dots{}, "UniformOutput", @var{val}) +## @deftypefnx{Function File} {} parcellfun (nproc, fun, @dots{}, "ErrorHandler", @var{errfunc}) +## @deftypefnx{Function File} {} parcellfun (nproc, fun, @dots{}, "VerboseLevel", @var{val}) +## @deftypefnx{Function File} {} parcellfun (nproc, fun, @dots{}, "ChunksPerProc", @var{val}) +## Evaluates a function for multiple argument sets using multiple processes. +## @var{nproc} should specify the number of processes. A maximum recommended value is +## equal to number of CPUs on your machine or one less. +## @var{fun} is a function handle pointing to the requested evaluating function. +## @var{a1}, @var{a2} etc. should be cell arrays of equal size. +## @var{o1}, @var{o2} etc. will be set to corresponding output arguments. +## +## The UniformOutput and ErrorHandler options are supported with meaning identical +## to @dfn{cellfun}. +## A VerboseLevel option controlling the level output is supported. +## A value of 0 is quiet, 1 is normal, and 2 or more enables +## debugging output. +## The ChunksPerProc option control the number of chunks which contains elementary jobs. This +## option particularly useful when time execution of function is small. Setting this option +## to 100 is a good choice in most cases. +## +## Notice that jobs are served from a single first-come first-served queue, +## so the number of jobs executed by each process is generally unpredictable. +## This means, for example, that when using this function to perform Monte-Carlo +## simulations one cannot expect results to be exactly reproducible. The pseudo +## random number generators of each process are initialised with a unique state. +## This currently works only for new style generators. +## +## NOTE: this function is implemented using "fork" and a number of pipes for IPC. +## Suitable for systems with an efficient "fork" implementation (such as GNU/Linux), +## on other systems (Windows) it should be used with caution. +## Also, if you use a multithreaded BLAS, it may be wise to turn off multi-threading +## when using this function. +## +## CAUTION: This function should be regarded as experimental. Although all subprocesses +## should be cleared in theory, there is always a danger of a subprocess hanging up, +## especially if unhandled errors occur. Under GNU and compatible systems, the following +## shell command may be used to display orphaned Octave processes: +## ps --ppid 1 | grep octave +## +## @end deftypefn + +## Author: Jaroslav Hajek +## Several improvements thanks to: Travis Collier + +function varargout = parcellfun (nproc, fun, varargin) + + ## The list of functions to be seeded in each slave. + persistent random_func_list = {@rand, @randn, @rande, @randp, @randg}; + + if (nargin < 3 || ! isscalar (nproc) || nproc <= 0) + print_usage (); + endif + + if (ischar (fun)) + fun = str2func (fun); + elseif (! isa (fun, "function_handle")) + error ("parcellfun: fun must be either a function handle or name") + endif + + [nargs, uniform_output, error_handler, ... + verbose_level, chunks_per_proc] = parcellfun_opts (varargin); + + args = varargin(1:nargs); + if (! all (cellfun ("isclass", args, "cell"))) + error ("parcellfun: all non-option arguments except the first one must be cell arrays"); + endif + + if (nargs == 0) + print_usage (); + elseif (nargs > 1) + [err, args{:}] = common_size (args{:}); + if (err) + error ("parcellfun: arguments size must match"); + endif + endif + + njobs = numel (args{1}); + + if (chunks_per_proc > 0 && chunks_per_proc < njobs / nproc) + ## We need chunked evaluation. + + ## Function executed for a chunk. + if (isempty (error_handler)) + chunk_fun = @(varargin) cellfun (fun, varargin{:}, "UniformOutput", uniform_output); + else + chunk_fun = @(varargin) cellfun (fun, varargin{:}, ... + "UniformOutput", uniform_output, "ErrorHandler", error_handler); + endif + + [varargout{1:nargout}] = chunk_parcellfun (nproc, chunks_per_proc, ... + chunk_fun, [], verbose_level, args{:}); + return + endif + + nproc = min (nproc, numel (args{1})); + + ## create communication pipes. + cmdr = cmdw = resr = resw = zeros (nproc, 1); + err = 0; + for i = 1:nproc + ## command pipes + [cmdr(i), cmdw(i), err, msg] = pipe (); + if (err) + break; + endif + ## result pipes + [resr(i), resw(i), err, msg] = pipe (); + if (err) + break; + endif + endfor + if (! err) + ## status pipe + [statr, statw, err, msg] = pipe (); + endif + if (err) + error ("failed to open pipe: %s", msg); + endif + + iproc = 0; # the parent process + nsuc = 0; # number of processes succesfully forked. + + fflush (stdout); # prevent subprocesses from inheriting buffered output + + ## get a seed and change state + seed = rand; + + pids = zeros (nproc, 1); + + ## fork subprocesses + for i = 1:nproc + [pid, msg] = fork (); + if (pid > 0) + ## parent process. fork succeded. + nsuc ++; + pids(i) = pid; + if (verbose_level > 1) + fprintf (stderr,'parcellfun: child process %d created\n', pids(i)); + fflush (stderr); + endif + elseif (pid == 0) + ## child process. + iproc = i; + break; + elseif (pid < 0) + ## parent process. fork failed. + err = 1; + break; + endif + endfor + + if (iproc) + ## child process. close unnecessary pipe ends. + fclose (statr); + for i = 1:nproc + ## we won't write commands and read results + fclose (cmdw (i)); + fclose (resr (i)); + if (i != iproc) + ## close also those pipes that don't belong to us. + fclose (cmdr (i)); + fclose (resw (i)); + endif + endfor + else + ## parent process. close unnecessary pipe ends. + fclose (statw); + for i = 1:nproc + ## we won't read commands and write results + fclose (cmdr (i)); + fclose (resw (i)); + endfor + + if (nsuc) + ## we forked some processes. if this is less than we opted for, gripe + ## but continue. + if (nsuc < nproc) + warning ("parcellfun: only %d out of %d processes forked", nsuc, nproc); + nproc = nsuc; + endif + else + ## this is bad. + error ("parcellfun: failed to fork processes"); + endif + endif + + ## At this point, everything should be OK (?) + + if (iproc) + ## the border patrol. we really don't want errors escape after the forks. + unwind_protect + try + ## re-seed random number states, adjusted for each process + seed *= iproc*bitmax; + ## FIXME: use cellfun when 3.4. is a requirement + for rf = random_func_list + feval (rf{1}, "state", seed); + endfor + + ## child process. indicate ready state. + fwrite (statw, -iproc, "double"); + fflush (statw); + + do + ## get command + cmd = fread (cmdr(iproc), 1, "double"); + if (cmd) + ## we've got a job to do. prepare argument and return lists. + res = cell (1, nargout); + argsc = cell (1, nargs); + for i = 1:nargs + argsc{i} = args{i}{cmd}; + endfor + + if (isempty (error_handler)) + ## unguarded evaluation. + [res{:}] = fun (argsc{:}); + else + ## guarded evaluation + try + [res{:}] = fun (argsc{:}); + catch + errs.index = cmd; + [errs.message, errs.identifier] = lasterr (); + [res{:}] = error_handler (errs, argsc{:}); + end_try_catch + endif + + ## indicate ready state. + fwrite (statw, iproc, "double"); + fflush (statw); + + ## write the result. + ## FIXME: this can fail. + fsave (resw(iproc), res); + fflush (resw(iproc)); + + endif + until (cmd == 0) + + catch + + ## just indicate the error. don't quit this function !!!! + fputs (stderr, "\n"); + warning ("parcellfun: unhandled error in subprocess %d", iproc); + + ## send a termination notice. + fwrite (statw, -iproc, "double"); + fflush (statw); + + end_try_catch + + unwind_protect_cleanup + + ## This is enclosed in another handler to prevent errors from escaping. + ## If something goes wrong, we'll get a broken pipe signal, but anything + ## is better than skipping the following __exit__. + try + fclose (statw); + fclose (resw(iproc)); + fclose (cmdr(iproc)); + end_try_catch + + ## no more work for us. We call __exit__, which bypasses termination sequences. + __exit__ (); + + ## we should never get here. + exit (); + + end_unwind_protect + + else + ## parent process. + res = cell (nargout, njobs); + + pjobs = 0; + pending = zeros (1, nproc); + + unwind_protect + + while (pjobs < njobs || any (pending)) + ## if pipe contains no more data, that's bad + if (feof (statr)) + warning ("parcellfun: premature exit due to closed pipe"); + break; + endif + ## wait for a process state. + isubp = fread (statr, 1, "double"); + if (isubp > 0) + ijob = pending(isubp); + ## we have a result ready. + res(:, ijob) = fload (resr(isubp)); + ## clear pending state + pending(isubp) = 0; + else + isubp = -isubp; + if (pending(isubp)) + ## premature exit means an unhandled error occured in a subprocess. + ## the process should have griped, we just try to exit gracefully. + pending(isubp) = 0; + ## no more jobs to start. + njobs = pjobs; + ## skip the rest; don't send commands to the process. + fclose(cmdw(isubp)); + continue; + endif + endif + if (pjobs < njobs) + ijob = ++pjobs; + ## send the next job to the process. + fwrite (cmdw(isubp), ijob, "double"); + fflush (cmdw(isubp)); + ## set pending state + pending(isubp) = ijob; + else + ## send terminating signal + fwrite (cmdw(isubp), 0, "double"); + fclose (cmdw(isubp)); + endif + if (verbose_level > 0) + fprintf (stderr, "\rparcellfun: %d/%d jobs done", pjobs - sum (pending != 0), njobs); + fflush (stderr); + endif + endwhile + + if (verbose_level > 0) + fputs (stderr, "\n"); + fflush (stderr); + endif + + unwind_protect_cleanup + + ## send termination signals to active processes. + for isubp = find (pending) + ## send terminating signal + fwrite (cmdw(isubp), 0, "double"); + fclose (cmdw(isubp)); + endfor + + ## explicitly recognize all terminated processes. + for i = 1:nproc + if (verbose_level > 1) + fprintf(stderr,'parcellfun: waiting for child process %d to close\n', pids(i)); + fflush (stderr); + endif + [pid, status] = waitpid (pids(i)); + endfor + + ## FIXME: I think order is possibly important here, and this is correct. + ## close all pipe ends + fclose (statr); + for i = 1:nproc + fclose (resr(i)); + endfor + + end_unwind_protect + + ## we're finished. transform the result. + varargout = cell (1, nargout); + shape = size (varargin{1}); + for i = 1:nargout + varargout{i} = reshape (res(i,:), shape); + if (uniform_output) + varargout{i} = cell2mat (varargout{i}); + endif + endfor + + endif + +endfunction diff --git a/octave_packages/general-1.3.1/private/chunk_parcellfun.m b/octave_packages/general-1.3.1/private/chunk_parcellfun.m new file mode 100644 index 0000000..ef4922f --- /dev/null +++ b/octave_packages/general-1.3.1/private/chunk_parcellfun.m @@ -0,0 +1,53 @@ +## Copyright (C) 2010 VZLU Prague, a.s., Czech Republic +## Copyright (C) 2010 Jean-Benoist Leger +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {} chunk_parcellfun (@dots{:}) +## Undocumented internal function. +## @end deftypefn + +function varargout = chunk_parcellfun (nproc, chunks_per_proc, func, + error_handler, verbose_level, varargin) + + args = varargin; + + nchunks = chunks_per_proc * nproc; + + ## Compute optimal chunk sizes. + N = numel (args{1}); + len_chunk = ceil (N/nchunks); + chunk_sizes = len_chunk (ones(1, nchunks)); + chunk_sizes(1:nchunks*len_chunk - N) -= 1; + + ## Split argument arrays into chunks (thus making arrays of arrays). + chunked_args = cellfun (@(arg) mat2cell (arg(:), chunk_sizes), args, ... + "UniformOutput", false); + + ## Attach error handler if present. + if (! isempty (error_handler)) + chunked_args = [chunked_args, {"ErrorHandler", error_handler}]; + endif + + ## Main call. + [out_brut{1:nargout}] = parcellfun (nproc, func, chunked_args{:}, ... + "UniformOutput", false, "VerboseLevel", verbose_level); + + ## Concatenate output args and reshape them to correct size. + true_size = size (args{1}); + varargout = cellfun (@(arg) reshape (vertcat (arg{:}), true_size), out_brut, "UniformOutput", false); + +endfunction + diff --git a/octave_packages/general-1.3.1/private/parcellfun_opts.m b/octave_packages/general-1.3.1/private/parcellfun_opts.m new file mode 100644 index 0000000..e5acb1a --- /dev/null +++ b/octave_packages/general-1.3.1/private/parcellfun_opts.m @@ -0,0 +1,77 @@ +## Copyright (C) 2010 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {} parcellfun_opts (args) +## Undocumented internal function. +## @end deftypefn + +function [nargs, uniform_output, error_handler, ... + verbose_level, chunks_per_proc, vectorized] = parcellfun_opts (args) + + uniform_output = true; + error_handler = []; + verbose_level = 1; # default to normal output level + chunks_per_proc = 0; # 0 means than size of chunk is 1 + vectorized = false; + + nargs = length (args); + + ## parse options + while (nargs > 1) + opt = args{nargs-1}; + if (! ischar (opt)) + break; + else + opt = tolower (opt); + val = args{nargs}; + endif + switch (opt) + case "uniformoutput" + uniform_output = logical (val); + if (! isscalar (uniform_output)) + error ("parcellfun: UniformOutput must be a logical scalar"); + endif + case "errorhandler" + error_handler = val; + if (! isa (error_handler, "function_handle")) + error ("parcellfun: ErrorHandler must be a function handle"); + endif + case "verboselevel" + verbose_level = val; + if (! isscalar (verbose_level)) + error ("parcellfun: VerboseLevel must be a numeric scalar"); + endif + case "chunksperproc" + chunks_per_proc = round (val); + if (! isscalar (chunks_per_proc) || chunks_per_proc <= 0) + error ("parcellfun: ChunksPerProc must be a positive scalar"); + endif + case "vectorized" + vectorized = logical (val); + if (! isscalar (vectorized)) + error ("parcellfun: Vectorized must be a logical scalar"); + endif + otherwise + break; + endswitch + nargs -= 2; + endwhile + + if (vectorized && chunks_per_proc <= 0) + error ("parcellfun: the ""Vectorized"" option requires also ""ChunksPerProc"""); + endif + +endfunction diff --git a/octave_packages/general-1.3.1/safeprod.m b/octave_packages/general-1.3.1/safeprod.m new file mode 100644 index 0000000..e7e3ce1 --- /dev/null +++ b/octave_packages/general-1.3.1/safeprod.m @@ -0,0 +1,62 @@ +## Copyright (C) 2008 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{p} =} safeprod (@var{x}, @var{dim}) +## @deftypefnx{Function File} {[@var{p}, @var{e}] =} safeprod (@var{x}, @var{dim}) +## This function forms product(s) of elements of the array @var{x} along the dimension +## specified by @var{dim}, analogically to @code{prod}, but avoids overflows and underflows +## if possible. If called with 2 output arguments, @var{p} and @var{e} are computed +## so that the product is @code{@var{p} * 2^@var{e}}. +## @seealso{prod,log2} +## @end deftypefn + +## Author: Jaroslav Hajek + +function [p, e] = safeprod (x, dim) + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin < 2) + if (rows(x) == 1) + dim = 2; + else + dim = 1; + endif + endif + + % try the normal algorithm first + if (nargout < 2) + p = prod (x, dim); + else + p = 0; + endif + + % 0, Inf and NaN are possibly problematic results. If detected, use the safe + % formula. + + flag = (p == 0 | ! isfinite (p)); + + if (any (flag(:))) + [f, e] = log2 (x); + p = prod (f, dim); + e = sum (e, dim); + if (nargout < 2) + p = p .* 2.^e; + endif + endif + +endfunction diff --git a/octave_packages/general-1.3.1/unresamp2.m b/octave_packages/general-1.3.1/unresamp2.m new file mode 100644 index 0000000..af836e9 --- /dev/null +++ b/octave_packages/general-1.3.1/unresamp2.m @@ -0,0 +1,64 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{xs}, @var{ys}] =} unresamp2 (@var{x}, @var{y}, @var{n}) +## Perform a uniform resampling of a planar curve. +## The arrays @var{x} and @var{y} specify x and y coordinates of the points of the curve. +## On return, the same curve is approximated by @var{xs}, @var{ys} that have length @var{n} +## and the distances between successive points are approximately equal. +## @end deftypefn + +## Author: Jaroslav Hajek + +function [xs, ys] = unresamp2 (x, y, n) + if (! isvector (x) || ! size_equal (x, y) || ! isscalar (n)) + print_usage (); + endif + + if (rows (x) == 1) + rowvec = true; + x = x.'; y = y.'; + else + rowvec = false; + endif + + # first differences + dx = diff (x); dy = diff (y); + # arc lengths + ds = hypot (dx, dy); + # cumulative integral + s = cumsum ([0; ds]); + # generate sample points + i = linspace (0, s(end), n); + if (! rowvec) + i = i.'; + endif + # and resample + xs = interp1 (s, x, i); + ys = interp1 (s, y, i); +endfunction + +%!demo +%! R = 2; r = 3; d = 1.5; +%! th = linspace (0, 2*pi, 1000); +%! x = (R-r) * cos (th) + d*sin ((R-r)/r * th); +%! y = (R-r) * sin (th) + d*cos ((R-r)/r * th); +%! x += 0.3*exp (-(th-0.8*pi).^2); +%! y += 0.4*exp (-(th-0.9*pi).^2); +%! +%! [xs, ys] = unresamp2 (x, y, 40); +%! plot (x, y, "-", xs, ys, "*"); +%! title ("uniform resampling") diff --git a/octave_packages/general-1.3.1/unvech.m b/octave_packages/general-1.3.1/unvech.m new file mode 100644 index 0000000..b163544 --- /dev/null +++ b/octave_packages/general-1.3.1/unvech.m @@ -0,0 +1,79 @@ +## Copyright (C) 2006 Michael Creel +## Copyright (C) 2009 Jaroslav Hajek +## Copyright (C) 2011 Juan Pablo Carbajal +## Copyright (C) 2011 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{m} =} unvech (@var{v}, @var{scale}) +## Performs the reverse of @code{vech} on the vector @var{v}. +## +## Given a Nx1 array @var{v} describing the lower triangular part of a +## matrix (as obtained from @code{vech}), it returns the full matrix. +## +## The upper triangular part of the matrix will be multiplied by @var{scale} such +## that 1 and -1 can be used for symmetric and antisymmetric matrix respectively. +## @var{scale} must be a scalar and defaults to 1. +## +## @seealso{vech, ind2sub} +## @end deftypefn + +## TODO remove subfunction ind2sub_tril after new release of octave that will have +## it builtin standard ind2sub + +function M = unvech (v, scale = 1) + + if ( nargin < 1 || nargin > 2 ) + print_usage; + elseif ( !ismatrix (v) && any (size (v) != 1) ) + error ("V must be a row or column matrix") + elseif ( !isnumeric (scale) || !isscalar (scale) ) + error ("SCALE must be a scalar") + endif + + N = length (v); + dim = (sqrt ( 1 + 8*N ) - 1)/2; + [r, c] = ind2sub_tril (dim, 1:N); # replace with core ind2sub after octave 3.6 + M = accumarray ([r; c].', v); + M += scale * tril (M, -1).'; + +endfunction + +function [r c] = ind2sub_tril(N,idx) + + endofrow = 0.5*(1:N) .* (2*N:-1:N + 1); + c = lookup(endofrow, idx-1)+1; + + r = N - endofrow(c) + idx ; + +endfunction + +%!assert(unvech([1;0;0;1;0;1]), full(eye(3,3)) ); + +%!test %symmetric +%! dim = 10; +%! A = tril( floor ( 5*(2*rand(dim)-1) ) ); +%! A += A.'; +%! M = vech(A); +%! M = unvech(M, 1); +%! assert (A, M); + +%!test %antisymmetric +%! dim = 10; +%! A = tril( floor ( 5*(2*rand(dim)-1) ) ); +%! A -= A.'; +%! M = vech(A); +%! M = unvech(M, -1); +%! assert (A, M); diff --git a/octave_packages/general-1.3.1/ztvals.m b/octave_packages/general-1.3.1/ztvals.m new file mode 100644 index 0000000..5328346 --- /dev/null +++ b/octave_packages/general-1.3.1/ztvals.m @@ -0,0 +1,44 @@ +## Copyright (C) 2009 Jaroslav Hajek +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {} function ztvals (@var{x}, @var{tol}) +## Replaces tiny elements of the vector @var{x} by zeros. +## Equivalent to +## @example +## @var{x}(abs(@var{x}) < @var{tol} * norm (@var{x}, Inf)) = 0 +## @end example +## @var{tol} specifies the chopping tolerance. It defaults to +## 1e-10 for double precision and 1e-5 for single precision inputs. +## @end deftypefn + +function x = ztvals (x, tol) + if (nargin == 1) + if (isa (x, 'single')) + tol = 1e-5; + else + tol = 1e-10; + endif + elseif (nargin != 2) + print_usage (); + endif + + if (isfloat (x)) + x(abs(x) < tol*norm (x, Inf)) = 0; + else + error ("ztvals: needs a floating-point argument"); + endif + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/angle2Points.m b/octave_packages/geometry-1.5.0/geom2d/angle2Points.m new file mode 100644 index 0000000..a577b90 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/angle2Points.m @@ -0,0 +1,109 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{alpha} =} angle2Points (@var{p1}, @var{p2}) +%% Compute horizontal angle between 2 points +%% +%% @var{p1} and @var{p2} are either [1x2] arrays, or [Nx2] arrays, in this case +%% @var{alpha} is a [Nx1] array. The angle computed is the horizontal angle of +%% the line (@var{p1},@var{p2}). +%% +%% Result is always given in radians, between 0 and 2*pi. +%% +%% @seealso{points2d, angles2d, angle3points, normalizeAngle, vectorAngle} +%% @end deftypefn + +function theta = angle2Points(varargin) + + % process input arguments + if length(varargin)==2 + p1 = varargin{1}; + p2 = varargin{2}; + elseif length(varargin)==1 + var = varargin{1}; + p1 = var(1,:); + p2 = var(2,:); + end + + % ensure data have correct size + n1 = size(p1, 1); + n2 = size(p2, 1); + if n1~=n2 && min(n1, n2)>1 + error('angle2Points: wrong size for inputs'); + end + + % angle of line (P2 P1), between 0 and 2*pi. + dp = bsxfun(@minus, p2, p1); + theta = mod(atan2(dp(:,2), dp(:,1)) + 2*pi, 2*pi); + +endfunction + +%!test +%! % all points inside window, possibly touching edges +%! p1 = [0 0]; +%! p2 = [10 0]; +%! angle_ = angle2Points (p1, p2); +%! assert (angle_,0,1e-6); +%! angle_ = angle2Points (p2, p1); +%! assert (angle_,pi,1e-6); + + +%!test +%! % all points inside window, possibly touching edges +%! p1 = [0 0]; +%! p2 = [0 10]; +%! angle_ = angle2Points (p1, p2); +%! assert (pi/2, angle_,1e-6); +%! angle_ = angle2Points (p2, p1); +%! assert (3*pi/2, angle_,1e-6); + +%!test +%! % all points inside window, possibly touching edges +%! p1 = [0 0;0 0;0 0;0 0]; +%! p2 = [10 0;10 10;0 10;-10 10]; +%! angle_ = angle2Points (p1, p2); +%! assert (size (p1, 1), size (angle_, 1)); +%! res = [0;pi/4;pi/2;3*pi/4]; +%! assert (res, angle_, 1e-6); + +%!test +%! % all points inside window, possibly touching edges +%! p1 = [0 0]; +%! p2 = [10 0;10 10;0 10;-10 10]; +%! angle_ = angle2Points (p1, p2); +%! assert(size (p2, 1), size (angle_, 1)); +%! res = [0;pi/4;pi/2;3*pi/4]; +%! assert(res, angle_,1e-6); + + diff --git a/octave_packages/geometry-1.5.0/geom2d/angle3Points.m b/octave_packages/geometry-1.5.0/geom2d/angle3Points.m new file mode 100644 index 0000000..54d8d1b --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/angle3Points.m @@ -0,0 +1,82 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{alpha} =} angle3Points (@var{p1}, @var{p2}, @var{p3}) +%% Computes the angle between the points @var{p1}, @var{p2} and @var{p3}. +%% +%% @var{p1}, @var{p2} and @var{p3} are either [1x2] arrays, or [Nx2] arrays, in this case +%% @var{alpha} is a [Nx1] array. The angle computed is the directed angle between line +%% (@var{p2}@var{p1}) and line (@var{p2}@var{p3}). +%% +%% Result is always given in radians, between 0 and 2*pi. +%% +%% @seealso{points2d, angles2d, angle2points} +%% @end deftypefn + +function theta = angle3Points(varargin) + + if length(varargin)==3 + p1 = varargin{1}; + p2 = varargin{2}; + p3 = varargin{3}; + elseif length(varargin)==1 + var = varargin{1}; + p1 = var(1,:); + p2 = var(2,:); + p3 = var(3,:); + end + + % angle line (P2 P1) + theta = lineAngle(createLine(p2, p1), createLine(p2, p3)); + +endfunction + +%!test +%! % all points inside window, possibly touching edges +%! p1 = [10 0]; +%! p2 = [0 0]; +%! p3 = [0 10]; +%! angle_ = angle3Points(p1, p2, p3); +%! assert(pi/2, angle_,1e-6); +%! angle_ = angle3Points([p1; p2; p3]); +%! assert(pi/2, angle_, 1e-6); + +%!test +%! p1 = [10 0; 20 0]; +%! p2 = [0 0;0 0]; +%! p3 = [0 10; 0 20]; +%! angle_ = angle3Points(p1, p2, p3); +%! assert(2, size(angle_, 1)); +%! assert([pi/2;pi/2], angle_, 1e-6); + diff --git a/octave_packages/geometry-1.5.0/geom2d/angleAbsDiff.m b/octave_packages/geometry-1.5.0/geom2d/angleAbsDiff.m new file mode 100644 index 0000000..64eb7df --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/angleAbsDiff.m @@ -0,0 +1,66 @@ +%% Copyright (c) 2011, INRA +%% 2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{dif} =} angleAbsDiff (@var{angle1}, @var{angle2}) +%% Computes the absolute angular difference between two angles in radians. +%% The result is comprised between 0 and pi. +%% +%% @example +%% A = angleAbsDiff(pi/2, pi/3) +%% A = +%% 0.5236 % equal to pi/6 +%% @end example +%% +%% @seealso{angles2d, angleDiff} +%% @end deftypefn + +function dif = angleAbsDiff(angle1, angle2) + + % first, normalization + angle1 = normalizeAngle(angle1); + angle2 = normalizeAngle(angle2); + + % compute difference and normalize + dif = normalizeAngle(angle1 - angle2); + dif = min(dif, 2*pi - dif); + +endfunction + +%!shared xp +%! xp = pi/2; +%!assert (xp, angleAbsDiff (pi/2, 0), 1e-6); +%!assert (xp, angleAbsDiff (0, pi/2), 1e-6); +%!assert (xp, angleAbsDiff (0, 3*pi/2), 1e-6); +%!assert (xp, angleAbsDiff (3*pi/2, 0), 1e-6); + diff --git a/octave_packages/geometry-1.5.0/geom2d/angleDiff.m b/octave_packages/geometry-1.5.0/geom2d/angleDiff.m new file mode 100644 index 0000000..e71b2f2 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/angleDiff.m @@ -0,0 +1,76 @@ +%% Copyright (c) 2011, INRA +%% 2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{dif} =} angleDiff (@var{angle1}, @var{angle2}) +%% Difference between two angles +%% +%% Computes the signed angular difference between two angles in radians. +%% The result is comprised between -PI and +PI. +%% +%% Example +%% A = angleDiff(-pi/4, pi/4) +%% A = +%% 1.5708 % equal to pi/2 +%% A = angleDiff(pi/4, -pi/4) +%% A = +%% -1.5708 % equal to -pi/2 +%% +%% @seealso{angles2d, angleAbsDiff} +%% @end deftypefn + +function dif = angleDiff(angle1, angle2) + + % first, normalization + angle1 = normalizeAngle(angle1); + angle2 = normalizeAngle(angle2); + + % compute difference and normalize in [-pi pi] + dif = normalizeAngle(angle2 - angle1, 0); +endfunction + +%!test +%! dif = angleDiff(0, pi/2); +%! assert (pi/2, dif, 1e-6); + +%!test +%! dif = angleDiff(pi/2, 0); +%! assert (-pi/2, dif, 1e-6); + +%!test +%! dif = angleDiff(0, 3*pi/2); +%! assert (-pi/2, dif, 1e-6); + +%!test +%! dif = angleDiff(3*pi/2, 0); +%! assert (pi/2, dif, 1e-6); diff --git a/octave_packages/geometry-1.5.0/geom2d/angleSort.m b/octave_packages/geometry-1.5.0/geom2d/angleSort.m new file mode 100644 index 0000000..0a62226 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/angleSort.m @@ -0,0 +1,106 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {varargout =} angleSort (@var{pts}, varargin) +%% Sort points in the plane according to their angle to origin +%% +%% +%% PTS2 = angleSort(PTS); +%% Computes angle of points with origin, and sort points with increasing +%% angles in Counter-Clockwise direction. +%% +%% PTS2 = angleSort(PTS, PTS0); +%% Computes angles between each point of PTS and PT0, which can be +%% different from origin. +%% +%% PTS2 = angleSort(..., THETA0); +%% Specifies the starting angle for sorting. +%% +%% [PTS2, I] = angleSort(...); +%% Also returns in I the indices of PTS, such that PTS2 = PTS(I, :); +%% +%% @seealso{points2d, angles2d, angle2points, normalizeAngle} +%% @end deftypefn + +function varargout = angleSort(pts, varargin) + + % default values + pt0 = [0 0]; + theta0 = 0; + + if length(varargin)==1 + var = varargin{1}; + if size(var, 2)==1 + % specify angle + theta0 = var; + else + pt0 = var; + end + elseif length(varargin)==2 + pt0 = varargin{1}; + theta0 = varargin{2}; + end + + + n = size(pts, 1); + pts2 = pts - repmat(pt0, [n 1]); + angle = lineAngle([zeros(n, 2) pts2]); + angle = mod(angle - theta0 + 2*pi, 2*pi); + + [dummy, I] = sort(angle); + + % format output + if nargout<2 + varargout{1} = pts(I, :); + elseif nargout==2 + varargout{1} = pts(I, :); + varargout{2} = I; + end + +endfunction + +%!shared p1,p2,p3,p4,pts,center +%! p1 = [0 0]; +%! p2 = [10 0]; +%! p3 = [10 10]; +%! p4 = [0 10]; +%! pts = [p1;p2;p3;p4]; +%! center = [5 5]; + +%!test +%! expected = pts([3 4 1 2], :); +%! assert (expected, angleSort (pts, center), 1e-6); + +%!assert (pts, angleSort (pts, center, -pi), 1e-6); + diff --git a/octave_packages/geometry-1.5.0/geom2d/angles2d.m b/octave_packages/geometry-1.5.0/geom2d/angles2d.m new file mode 100644 index 0000000..db438a1 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/angles2d.m @@ -0,0 +1,54 @@ +%% Copyright (c) 2011, INRA +%% 2010-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} angles2d () +%% Description of functions for manipulating angles +%% +%% Angles are normalized in an interval of width 2*PI. Most geom2d +%% functions return results in the [0 2*pi] interval, but it can be +%% convenient to consider the [-pi pi] interval as well. See the +%% normalizeAngle function to switch between conventions. +%% +%% Angles are usually oriented. The default orientation is the CCW +%% (Counter-Clockwise) orientation. +%% +%% @seealso{angle2Points, angle3Points, angleAbsDiff, normalizeAngle, vectorAngle, +%% angleDiff, angleSort, lineAngle, edgeAngle, deg2rad, rad2deg} +%% @end deftypefn + +function angles2d + + help('angles2d'); + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/beltproblem.m b/octave_packages/geometry-1.5.0/geom2d/beltproblem.m new file mode 100644 index 0000000..d3207bd --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/beltproblem.m @@ -0,0 +1,136 @@ +%% Copyright (c) 2012 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{tangent},@var{inner}] = } beltproblem (@var{c}, @var{r}) +%% Finds the four lines tangent to two circles with given centers and radii. +%% +%% The function solves the belt problem in 2D for circles with center @var{c} and +%% radii @var{r}. +%% +%% @strong{INPUT} +%% @table @var +%% @item c +%% 2-by-2 matrix containig coordinates of the centers of the circles; one row per circle. +%% @item r +%% 2-by-1 vector with the radii of the circles. +%%@end table +%% +%% @strong{OUPUT} +%% @table @var +%% @item tangent +%% 4-by-4 matrix with the points of tangency. Each row describes a segment(edge). +%% @item inner +%% 4-by-2 vector with the point of intersection of the inner tangents (crossed belts) +%% with the segment that joins the centers of the two circles. If +%% the i-th edge is not an inner tangent then @code{inner(i,:)=[NaN,NaN]}. +%% @end table +%% +%% Example: +%% +%% @example +%% c = [0 0;1 3]; +%% r = [1 0.5]; +%% [T inner] = beltproblem(c,r) +%% @result{} T = +%% -0.68516 0.72839 1.34258 2.63581 +%% 0.98516 0.17161 0.50742 2.91419 +%% 0.98675 -0.16225 1.49338 2.91888 +%% -0.88675 0.46225 0.55663 3.23112 +%% +%% @result{} inner = +%% 0.66667 2.00000 +%% 0.66667 2.00000 +%% NaN NaN +%% NaN NaN +%% +%% @end example +%% +%% @seealso{edges2d} +%% @end deftypefn + +function [edgeTan inner] = beltproblem(c,r) + + x0 = [c(1,1) c(1,2) c(2,1) c(2,2)]; + r0 = r([1 1 2 2]); + + middleEdge = createEdge(c(1,:),c(2,:)); + + ind0 = [1 0 1 0; 0 1 1 0; 1 1 1 0; -1 0 1 0; 0 -1 1 0; -1 -1 1 0;... + 1 0 0 1; 0 1 0 1; 1 1 0 1; -1 0 0 1; 0 -1 0 1; -1 -1 0 1;... + 1 0 1 1; 0 1 1 1; 1 1 1 1; -1 0 1 1; 0 -1 1 1; -1 -1 1 1;... + 1 0 -1 0; 0 1 -1 0; 1 1 -1 0; -1 0 -1 0; 0 -1 -1 0; -1 -1 -1 0;... + 1 0 0 -1; 0 1 0 -1; 1 1 0 -1; -1 0 0 -1; 0 -1 0 -1; -1 -1 0 -1;... + 1 0 -1 -1; 0 1 -1 -1; 1 1 -1 -1; -1 0 -1 -1; 0 -1 -1 -1; -1 -1 -1 -1]; + nInit = size(ind0,1); + ir = randperm(nInit); + edgeTan = zeros(4,4); + inner = zeros(4,2); + nSol = 0; + i=1; + + %% Solve for 2 different lines + while nSol<4 && i 1e-6); + end + if all(notequal) + nSol = nSol+1; + edgeTan(nSol,:) = createEdge(sol(1:2),sol(3:4)); + % Find innerTangent + inner(nSol,:) = intersectEdges(middleEdge,edgeTan(nSol,:)); + end + + i = i+1; + end + +endfunction + +function res = belt(x,c,r) + res = zeros(4,1); + + res(1,1) = (x(3:4) - c(2,1:2))*(x(3:4) - x(1:2))'; + res(2,1) = (x(1:2) - c(1,1:2))*(x(3:4) - x(1:2))'; + res(3,1) = sumsq(x(1:2) - c(1,1:2)) - r(1)^2; + res(4,1) = sumsq(x(3:4) - c(2,1:2)) - r(2)^2; + +end + +%!demo +%! c = [0 0;1 3]; +%! r = [1 0.5]; +%! [T inner] = beltproblem(c,r) +%! +%! figure(1) +%! clf +%! h = drawEdge(T); +%! set(h(find(~isnan(inner(:,1)))),'color','r'); +%! set(h,'linewidth',2); +%! hold on +%! drawCircle([c(1,:) r(1); c(2,:) r(2)],'linewidth',2); +%! axis tight +%! axis equal +%! +%! % ------------------------------------------------------------------- +%! % The circles with the tangents edges are plotted. The solution with +%! % crossed belts (inner tangets) is shown in red. diff --git a/octave_packages/geometry-1.5.0/geom2d/bisector.m b/octave_packages/geometry-1.5.0/geom2d/bisector.m new file mode 100644 index 0000000..f9c4136 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/bisector.m @@ -0,0 +1,126 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{ray} = } bisector (@var{line1}, @var{line2}) +%% @deftypefnx {Function File} {@var{ray} = } bisector (@var{p1}, @var{p2}, @var{p3}) +%% Return the bisector of two lines, or 3 points. +%% +%% Creates the bisector of the two lines, given as [x0 y0 dx dy]. +%% +%% create the bisector of lines (@var{p2} @var{p1}) and (@var{p2} @var{p3}). +%% +%% The result has the form [x0 y0 dx dy], with [x0 y0] being the origin +%% point ans [dx dy] being the direction vector, normalized to have unit +%% norm. +%% +%% @seealso{lines2d, rays2d} +%% @end deftypefn + +function ray = bisector(varargin) + + if length(varargin)==2 + % two lines + line1 = varargin{1}; + line2 = varargin{2}; + + point = intersectLines(line1, line2); + + elseif length(varargin)==3 + % three points + p1 = varargin{1}; + p2 = varargin{2}; + p3 = varargin{3}; + + line1 = createLine(p2, p1); + line2 = createLine(p2, p3); + point = p2; + + elseif length(varargin)==1 + % three points, given in one array + var = varargin{1}; + p1 = var(1, :); + p2 = var(2, :); + p3 = var(3, :); + + line1 = createLine(p2, p1); + line2 = createLine(p2, p3); + point = p2; + end + + % compute line angles + a1 = lineAngle(line1); + a2 = lineAngle(line2); + + % compute bisector angle (angle of first line + half angle between lines) + angle = mod(a1 + mod(a2-a1+2*pi, 2*pi)/2, pi*2); + + % create the resulting ray + ray = [point cos(angle) sin(angle)]; + +endfunction + +%!shared privpath +%! privpath = [fileparts(which('geom2d_Contents')) filesep() 'private']; + +%!test +%! addpath (privpath,'-end') +%! p0 = [0 0]; +%! p1 = [10 0]; +%! p2 = [0 10]; +%! line1 = createLine(p0, p1); +%! line2 = createLine(p0, p2); +%! ray = bisector(line1, line2); +%! assertElementsAlmostEqual([0 0], ray(1,1:2)); +%! assertAlmostEqual(pi/4, lineAngle(ray)); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! p0 = [0 0]; +%! p1 = [10 0]; +%! p2 = [0 10]; +%! ray = bisector(p1, p0, p2); +%! assertElementsAlmostEqual([0 0], ray(1,1:2)); +%! assertAlmostEqual(pi/4, lineAngle(ray)); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! p0 = [0 0]; +%! p1 = [10 0]; +%! p2 = [0 10]; +%! ray = bisector([p1; p0; p2]); +%! assertElementsAlmostEqual([0 0], ray(1,1:2)); +%! assertAlmostEqual(pi/4, lineAngle(ray)); +%! rmpath (privpath); diff --git a/octave_packages/geometry-1.5.0/geom2d/boxes2d.m b/octave_packages/geometry-1.5.0/geom2d/boxes2d.m new file mode 100644 index 0000000..e37bfea --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/boxes2d.m @@ -0,0 +1,53 @@ +%% Copyright (c) 2011, INRA +%% 2008-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} boxes2d () +%% Description of functions operating on bounding boxes. +%% +%% A box is represented as a set of limits in each direction: +%% @example +%% BOX = [XMIN XMAX YMIN YMAX]. +%% @end example +%% @noindent +%% Boxes are used as result of computation for bounding boxes, and to clip +%% shapes. +%% +%% @seealso{clipPoints, clipLine, clipEdge, clipRay, mergeBoxes, +%% intersectBoxes, randomPointInBox, drawBox} +%% @end deftypefn + +function boxes2d(varargin) + help('boxes2d'); +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/cartesianLine.m b/octave_packages/geometry-1.5.0/geom2d/cartesianLine.m new file mode 100644 index 0000000..ec53b99 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/cartesianLine.m @@ -0,0 +1,69 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{line} = } cartesianLine (@var{A}, @var{B},@var{C}) +%% Create a straight line from cartesian equation coefficients. +%% +%% Create a line verifying the Cartesian equation: +%% @var{A}*x + @var{B}*x + @var{C} = 0; +%% +%% @seealso{lines2d, createLine} +%% @end deftypefn + +function line = cartesianLine(varargin) + + if length(varargin)==1 + var = varargin{1}; + a = var(:,1); + b = var(:,2); + c = var(:,3); + elseif length(varargin)==3 + a = varargin{1}; + b = varargin{2}; + c = varargin{3}; + end + + % normalisation factor + d = a.*a + b.*b; + + x0 = -a.*c./d; + y0 = -b.*c./d; + theta = atan2(-a, b); + dx = cos(theta); + dy = sin(theta); + + line = [x0 y0 dx dy]; + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/cbezier2poly.m b/octave_packages/geometry-1.5.0/geom2d/cbezier2poly.m new file mode 100644 index 0000000..6169eac --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/cbezier2poly.m @@ -0,0 +1,154 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{pp} =} cbezier2poly (@var{points}) +%% @deftypefnx {Command} {Function File} {[@var{x} @var{y}] =} cbezier2poly (@var{points},@var{t}) +%% Returns the polynomial representation of the cubic Bezier defined by the control points @var{points}. +%% +%% With only one input argument, calculates the polynomial @var{pp} of the cubic +%% Bezier curve defined by the 4 control points stored in @var{points}. The first +%% point is the inital point of the curve. The segment joining the first point +%% with the second point (first center) defines the tangent of the curve at the initial point. +%% The segment that joints the third point (second center) with the fourth defines the tanget at +%% the end-point of the curve, which is defined in the fourth point. +%% @var{points} is either a 4-by-2 array (vertical concatenation of point +%% coordinates), or a 1-by-8 array (horizotnal concatenation of point +%% coordinates). @var{pp} is a 2-by-3 array, 1st row is the polynomial for the +%% x-coordinate and the 2nd row for the y-coordinate. Each row can be evaluated +%% with @code{polyval}. The polynomial @var{pp}(t) is defined for t in [0,1]. +%% +%% When called with a second input argument @var{t}, it returns the coordinates +%% @var{x} and @var{y} corresponding to the polynomial evaluated at @var{t} in +%% [0,1]. +%% +%% @seealso{drawBezierCurve, polyval} +%% @end deftypefn + +function varargout = cbezier2poly (points, ti=[]) + + + % rename points + if size(points, 2)==2 + % case of points given as a 4-by-2 array + p1 = points(1,:); + c1 = points(2,:); + c2 = points(3,:); + p2 = points(4,:); + elseif size(points,2) == 8 + % case of points given as a 1-by-8 array, [X1 Y1 CX1 CX2..] + p1 = points(1:2); + c1 = points(3:4); + c2 = points(5:6); + p2 = points(7:8); + else + print_usage ; + end + + % compute coefficients of Bezier Polynomial + pp = zeros(2,4); + + pp(:,4) = [p1(1); ... + p1(2)]; + pp(:,3) = [3 * c1(1) - 3 * p1(1); ... + 3 * c1(2) - 3 * p1(2)]; + pp(:,2) = [3 * p1(1) - 6 * c1(1) + 3 * c2(1); ... + 3 * p1(2) - 6 * c1(2) + 3 * c2(2)]; + pp(:,1) = [p2(1) - 3 * c2(1) + 3 * c1(1) - p1(1); ... + p2(2) - 3 * c2(2) + 3 * c1(2) - p1(2)]; + + if isempty (ti) + varargout{1} = pp; + else + varargout{1} = polyval (pp(1,:), ti); + varargout{2} = polyval (pp(2,:), ti); + end + +endfunction + +%!demo +%! points = [45.714286 483.79075; ... +%! 241.65656 110.40445; ... +%! 80.185847 741.77381; ... +%! 537.14286 480.93361]; +%! +%! pp = cbezier2poly(points); +%! t = linspace(0,1,64); +%! x = polyval(pp(1,:),t); +%! y = polyval(pp(2,:),t); +%! plot (x,y,'b-',points([1 4],1),points([1 4],2),'s',... +%! points([2 3],1),points([2 3],2),'o'); +%! line(points([2 1],1),points([2 1],2),'color','r'); +%! line(points([3 4],1),points([3 4],2),'color','r'); + +%!demo +%! points = [0 0; ... +%! 1 1; ... +%! 1 1; ... +%! 2 0]; +%! +%! t = linspace(0,1,64); +%! [x y] = cbezier2poly(points,t); +%! plot (x,y,'b-',points([1 4],1),points([1 4],2),'s',... +%! points([2 3],1),points([2 3],2),'o'); +%! line(points([2 1],1),points([2 1],2),'color','r'); +%! line(points([3 4],1),points([3 4],2),'color','r'); + +%!test +%! points = [0 0; ... +%! 1 1; ... +%! 1 1; ... +%! 2 0]; +%! t = linspace(0,1,64); +%! +%! [x y] = cbezier2poly(points,t); +%! pp = cbezier2poly(points); +%! x2 = polyval(pp(1,:),t); +%! y2 = polyval(pp(2,:),t); +%! assert(x,x2); +%! assert(y,y2); + +%!test +%! points = [0 0; ... +%! 1 1; ... +%! 1 1; ... +%! 2 0]; +%! t = linspace(0,1,64); +%! +%! p = reshape(points,1,8); +%! [x y] = cbezier2poly(p,t); +%! pp = cbezier2poly(p); +%! x2 = polyval(pp(1,:),t); +%! y2 = polyval(pp(2,:),t); +%! assert(x,x2); +%! assert(y,y2); diff --git a/octave_packages/geometry-1.5.0/geom2d/centroid.m b/octave_packages/geometry-1.5.0/geom2d/centroid.m new file mode 100644 index 0000000..ca8b258 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/centroid.m @@ -0,0 +1,129 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{c} = } centroid (@var{points}) +%% @deftypefnx {Function File} {@var{c} = } centroid (@var{px}, @var{py}) +%% @deftypefnx {Function File} {@var{c} = } centroid (@dots{}, @var{mass}) +%% Compute centroid (center of mass) of a set of points. +%% +%% Computes the ND-dimensional centroid of a set of points. +%% @var{points} is an array with as many rows as the number of points, and as +%% many columns as the number of dimensions. +%% @var{px} and @var{py} are two column vectors containing coordinates of the +%% 2-dimensional points. +%% The result @var{c} is a row vector with ND columns. +%% +%% If @var{mass} is given, computes center of mass of @var{points}, weighted by coefficient @var{mass}. +%% @var{points} is a Np-by-Nd array, @var{mass} is Np-by-1 array, and @var{px} and @var{py} are +%% also both Np-by-1 arrays. +%% +%% Example: +%% +%% @example +%% pts = [2 2;6 1;6 5;2 4]; +%% centroid(pts) +%% ans = +%% 4 3 +%%@end example +%% +%% @seealso{points2d, polygonCentroid} +%% @end deftypefn + +function center = centroid(varargin) + + %% extract input arguments + + % use empty mass by default + mass = []; + + if nargin==1 + % give only array of points + pts = varargin{1}; + + elseif nargin==2 + % either POINTS+MASS or PX+PY + var = varargin{1}; + if size(var, 2)>1 + % arguments are POINTS, and MASS + pts = var; + mass = varargin{2}; + else + % arguments are PX and PY + pts = [var varargin{2}]; + end + + elseif nargin==3 + % arguments are PX, PY, and MASS + pts = [varargin{1} varargin{2}]; + mass = varargin{3}; + end + + %% compute centroid + + if isempty(mass) + % no weight + center = mean(pts); + + else + % format mass to have sum equal to 1, and column format + mass = mass(:)/sum(mass(:)); + + % compute weighted centroid + center = sum(bsxfun(@times, pts, mass), 1); + % equivalent to: + % center = sum(pts .* mass(:, ones(1, size(pts, 2)))); + end + +endfunction + +%!test +%! points = [0 0;10 0;10 10;0 10]; +%! centro = centroid(points); +%! assert ([5 5], centro, 1e-6); + +%!test +%! points = [0 0;10 0;10 10;0 10]; +%! centro = centroid(points(:,1), points(:,2)); +%! assert ([5 5], centro, 1e-6); + +%!test +%! points = [0 0;30 0;30 30;0 30]; +%! centro = centroid(points, [1;1;1;3]); +%! assert ([10 20], centro, 1e-6); + +%!test +%! points = [0 0;30 0;30 30;0 30]; +%! centro = centroid(points(:,1), points(:,2), [1;1;1;3]); +%! assert ([10 20], centro, 1e-6); + diff --git a/octave_packages/geometry-1.5.0/geom2d/changelog.txt b/octave_packages/geometry-1.5.0/geom2d/changelog.txt new file mode 100644 index 0000000..7a0ef29 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/changelog.txt @@ -0,0 +1,192 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + + +change log for geom2d + +geom2d, release 2011.??.?? +========================== + +New functions +- added angleDiff and angleAbsDiff + +various doc updates + + +geom2d, release 2011.06.30 +========================== + +New functions +- added function rotateVector +- added function randomPointInBox + +Changes +- Shape orientation is now represented using degrees +- function vectorAngle can now compute the angle between two vectors + +Bug fixes +- enhanced function distancePointEdge +- enhanced function isPointOnEdge +- enhanced function isParallel +- fixed bugs intersectLineCircle + + +geom2d, release 2011.03.21 +========================== + +New functions +- added functions intersectLineCircle and intersectCircles +- added functions inertiaEllipse, isPointInEllipse +- added function drawBezierCurve +- added functions intersectBoxes and mergeBoxes + +Changes +- re-organized the library in three sub-directories: geom2d, polygons2d, and + polynomialCurves2d +- cleanup of code and doc + +Bug fixes +- several bugs fixed in clipEdge, isPointOnEdge + + +geom2d, release 2010.08.06 +========================== + +New functions +- polygonToRow and rowToPolygon, to convert polygon to a row vector +- midPoint, to compute middle points of either 2 points or an edge +- added rad2deg and deg2rad, for angle conversions + +Changes +- createCircle and createdirectedCircle are now vectorized, and use different + convention for 2 input variables (center + point and circle) +- median line has been vectorized + +Bug fixes +- fix bugs in intersectEdges +- fix bugs in clipLine +- rewrite drawLine using clipLine + + +geom2d, release 2010.07.19 +========================== + +new functions + +- isCounterClockwise +- intersectRayPolygon +- clipRay +- reverseEdge +- drawBox +- fitAffineTransform2d + +Changes + +- updated inertiaEllipse +- fixed bugs in intersectEdges.m, isParallel.m and isPerpendicular.m +- vectorized intersectLinePolygon +- fixed precision bug in isPointOnEdge +- renamed formatAngle to normalizeAngle +- created help file 'angles2d' +- fixed bug in weighted centroid computation + +various bug fixes, and doc updates. + + + +geom2d, release 2009.07.22 +========================== + +new features + +- new functions for polygons: + polygonPoint, polygonSubcurve, polygonLoops, distancePointPolygon, + distancePolygons, expandPolygon, polygonSelfIntersections, + projPointOnPolygon, isPointInPolygon, reveresPolygon + +- new functions for polylines: + intersectPolylines, polylineSelfIntersections, distancePolylines, + isPointOnPolyline, reveresPolyline + +- projPointOnPolyline can also return the distance of the point to the polyline + +- function 'edgeToLine' converts an edge to its supporting line + + +Changes + +- Renamed functions + + subcurve -> polylineSubCurve + + curveCentroid -> polylineCentroid + + invertLine -> reverseLine + +- Compatibility considerations + + parallelLine: changed convention for signed distance + +various bug fixes, and doc updates. + + +geom2d, release 2009.06.15 +========================== + +* new features + +- radicalAxis from 2 circles: +- moment of a curve (polyline): curveMoment, curveCMoment, curveCSMoment +- new functions for polylines + distancePointPolyline, drawPolyline, polylineLength, polylinePoint, + polylineSubcurve, projPointOnPolyline + +* changes + +- changed some function names to avoid potential name conflicts, and to make + function names more explicit: + + rotation -> createRotation + + scaling -> createScaling + + translation -> createRotation + + homothecy -> createHomothecy + + lineSymmetry -> createLineReflection + + inCircle -> isPointInCircle + + onCircle -> isPointOnCircle + + onEdge -> isPointOnEdge + + onLine -> isPointOnLine + + onRay -> isPointOnRay + + normalize -> normalizeVector + + +* bug fixes + +- fixed bug in intersectEdges + +many updates in doc. + diff --git a/octave_packages/geometry-1.5.0/geom2d/circleArcAsCurve.m b/octave_packages/geometry-1.5.0/geom2d/circleArcAsCurve.m new file mode 100644 index 0000000..13b32b6 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/circleArcAsCurve.m @@ -0,0 +1,79 @@ +%% Copyright (c) 2011, INRA +%% 2006-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{p} = } circleArcAsCurve (@var{arc}, @var{N}) +%% Convert a circle arc into a series of points +%% +%% P = circleArcAsCurve(ARC, N); +%% convert the circle ARC into a series of N points. +%% ARC is given in the format: [XC YC R THETA1 DTHETA] +%% where XC and YC define the center of the circle, R its radius, THETA1 +%% is the start of the arc and DTHETA is the angle extent of the arc. Both +%% angles are given in degrees. +%% N is the number of vertices of the resulting polyline, default is 65. +%% +%% The result is a N-by-2 array containing coordinates of the N points. +%% +%% [X Y] = circleArcAsCurve(ARC, N); +%% Return the result in two separate arrays with N lines and 1 column. +%% +%% +%% @seealso{circles2d, circleAsPolygon, drawCircle, drawPolygon} +%% @end deftypefn + +function varargout = circleArcAsCurve(arc, N) + + % default value for N + if nargin < 2 + N = 65; + end + + % vector of positions + t0 = deg2rad(arc(4)); + t1 = t0 + deg2rad(arc(5)); + t = linspace(t0, t1, N)'; + + % compute coordinates of vertices + x = arc(1) + arc(3) * cos(t); + y = arc(2) + arc(3) * sin(t); + + % format output + if nargout <= 1 + varargout = {[x y]}; + else + varargout = {x, y}; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/circleAsPolygon.m b/octave_packages/geometry-1.5.0/geom2d/circleAsPolygon.m new file mode 100644 index 0000000..d22c3cb --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/circleAsPolygon.m @@ -0,0 +1,74 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{P} = } circleAsPolygon (@var{circle}, @var{N}) +%% Convert a circle into a series of points +%% +%% P = circleAsPolygon(CIRCLE, N); +%% convert circle given as [x0 y0 r], where x0 and y0 are coordinate of +%% center, and r is the radius, into an array of [(N+1)x2] double, +%% containing x and y values of points. +%% The polygon is closed +%% +%% P = circleAsPolygon(CIRCLE); +%% uses a default value of N=64 points +%% +%% Example +%% circle = circleAsPolygon([10 0 5], 16); +%% figure; +%% drawPolygon(circle); +%% +%% @seealso{circles2d, polygons2d, createCircle} +%% @end deftypefn + +function varargout = circleAsPolygon(circle, varargin) + % determines number of points + N = 64; + if ~isempty(varargin) + N = varargin{1}; + end + + % create circle + t = linspace(0, 2*pi, N+1)'; + x = circle(1) + circle(3)*cos(t); + y = circle(2) + circle(3)*sin(t); + + if nargout==1 + varargout{1}=[x y]; + elseif nargout==2 + varargout{1}=x; + varargout{2}=y; + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/circles2d.m b/octave_packages/geometry-1.5.0/geom2d/circles2d.m new file mode 100644 index 0000000..1b2ad14 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/circles2d.m @@ -0,0 +1,64 @@ +%% Copyright (c) 2011, INRA +%% 2008-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} circles2d () +%% Description of functions operating on circles +%% +%% Circles are represented by their center and their radius: +%% C = [xc yc r]; +%% One sometimes considers orientation of circle, by adding an extra +%% boolean value in 4-th position, with value TRUE for direct (i.e. +%% turning Counter-clockwise) circles. +%% +%% Circle arcs are represented by their center, their radius, the starting +%% angle and the angle extent, both in degrees: +%% CA = [xc yc r theta0 dtheta]; +%% +%% Ellipses are represented by their center, their 2 semi-axis length, and +%% their angle (in degrees) with Ox direction. +%% E = [xc yc A B theta]; +%% +%% @seealso{ellipses2d, createCircle, createDirectedCircle, enclosingCircle +%% isPointInCircle, isPointOnCircle +%% intersectLineCircle, intersectCircles, radicalAxis +%% circleAsPolygon, circleArcAsCurve +%% drawCircle, drawCircleArc} +%% @end deftypefn + +function circles2d(varargin) + + help('circles2d'); + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/clipEdge.m b/octave_packages/geometry-1.5.0/geom2d/clipEdge.m new file mode 100644 index 0000000..78c3721 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/clipEdge.m @@ -0,0 +1,203 @@ +%% Copyright (c) 2011, INRA +%% 2010-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{edge2} =} clipEdge (@var{edge}, @var{box}) +%% Clip an edge with a rectangular box. +%% +%% @var{edge}: [x1 y1 x2 y2], +%% @var{box} : [xmin xmax ; ymin ymax] or [xmin xmax ymin ymax]; +%% return : +%% @var{edge2} = [xc1 yc1 xc2 yc2]; +%% +%% If clipping is null, return [0 0 0 0]; +%% +%% if @var{edge} is a [nx4] array, return an [nx4] array, corresponding to each +%% clipped edge. +%% +%% @seealso{edges2d, boxes2d, clipLine} +%% @end deftypefn + +function edge2 = clipEdge(edge, bb) + + % process data input + if size(bb, 1)==2 + bb = bb'; + end + + % get limits of window + xmin = bb(1); + xmax = bb(2); + ymin = bb(3); + ymax = bb(4); + + + % convert window limits into lines + lineX0 = [xmin ymin xmax-xmin 0]; + lineX1 = [xmin ymax xmax-xmin 0]; + lineY0 = [xmin ymin 0 ymax-ymin]; + lineY1 = [xmax ymin 0 ymax-ymin]; + + + % compute outcodes of each vertex + p11 = edge(:,1)xmax; p22 = edge(:,3)>xmax; + p13 = edge(:,2)ymax; p24 = edge(:,4)>ymax; + out1 = [p11 p12 p13 p14]; + out2 = [p21 p22 p23 p24]; + + % detect edges totally inside window -> no clip. + inside = sum(out1 | out2, 2)==0; + + % detect edges totally outside window + outside = sum(out1 & out2, 2)>0; + + % select edges not totally outside, and process separately edges totally + % inside window + ind = find(~(inside | outside)); + + + edge2 = zeros(size(edge)); + edge2(inside, :) = edge(inside, :); + + + for i=1:length(ind) + % current edge + iedge = edge(ind(i), :); + + % compute intersection points with each line of bounding window + px0 = intersectLineEdge(lineX0, iedge); + px1 = intersectLineEdge(lineX1, iedge); + py0 = intersectLineEdge(lineY0, iedge); + py1 = intersectLineEdge(lineY1, iedge); + + % create array of points + points = [px0; px1; py0; py1; iedge(1:2); iedge(3:4)]; + + % remove infinite points (edges parallel to box edges) + points = points(all(isfinite(points), 2), :); + + % sort points by x then y + points = sortrows(points); + + % get center positions between consecutive points + centers = (points(2:end,:) + points(1:end-1,:))/2; + + % find the centers (if any) inside window + inside = find( centers(:,1)>=xmin & centers(:,2)>=ymin & ... + centers(:,1)<=xmax & centers(:,2)<=ymax); + + % if multiple segments are inside box, which can happen due to finite + % resolution, only take the longest segment + if length(inside)>1 + % compute delta vectors of the segments + dv = points(inside+1,:) - points(inside,:); + % compute lengths of segments + len = hypot(dv(:,1), dv(:,2)); + % find index of longest segment + [a, I] = max(len); %#ok + inside = inside(I); + end + + % if one of the center points is inside box, then the according edge + % segment is indide box + if length(inside)==1 + % restore same direction of edge + if iedge(1)>iedge(3) || (iedge(1)==iedge(3) && iedge(2)>iedge(4)) + edge2(i, :) = [points(inside+1,:) points(inside,:)]; + else + edge2(i, :) = [points(inside,:) points(inside+1,:)]; + end + end + + end % end of loop of edges +endfunction + +%!demo +%! bb = [0 100 0 100]; +%! edge = [-10 10 90 110]; +%! ec = clipEdge (edge, bb); +%! +%! drawBox(bb,'color','k'); +%! line(edge([1 3]),edge([2 4]),'color','b'); +%! line(ec([1 3]),ec([2 4]),'color','r','linewidth',2); +%! axis tight +%! v = axis (); +%! axis(v+[0 10 -10 0]) + +%!shared bb +%! bb = [0 100 0 100]; +%!assert (clipEdge([20 30 80 60], bb), [20 30 80 60],1e-6); +%!assert (clipEdge([0 30 80 60], bb), [0 30 80 60],1e-6); +%!assert (clipEdge([0 30 100 60], bb), [0 30 100 60],1e-6); +%!assert (clipEdge([30 0 80 100], bb), [30 0 80 100],1e-6); +%!assert (clipEdge([0 0 100 100], bb), [0 0 100 100],1e-6); +%!assert (clipEdge([0 100 100 0], bb), [0 100 100 0],1e-6); +%!assert (clipEdge([20 60 120 60], bb), [20 60 100 60],1e-6); +%!assert (clipEdge([-20 60 80 60], bb), [0 60 80 60],1e-6); +%!assert (clipEdge([20 60 20 160], bb), [20 60 20 100],1e-6); +%!assert (clipEdge([20 -30 20 60], bb), [20 0 20 60],1e-6); +%!assert (clipEdge([120 30 180 60], bb), [0 0 0 0],1e-6); +%!assert (clipEdge([-20 30 -80 60], bb), [0 0 0 0],1e-6); +%!assert (clipEdge([30 120 60 180], bb), [0 0 0 0],1e-6); +%!assert (clipEdge([30 -20 60 -80], bb), [0 0 0 0],1e-6); +%!assert (clipEdge([-120 110 190 150], bb), [0 0 0 0],1e-6); +%!assert ([50 50 100 50], clipEdge([50 50 150 50], bb),1e-6); +%!assert ([50 50 0 50], clipEdge([50 50 -50 50], bb),1e-6); +%!assert ([50 50 50 100], clipEdge([50 50 50 150], bb),1e-6); +%!assert ([50 50 50 0], clipEdge([50 50 50 -50], bb),1e-6); +%!assert ([80 50 100 70], clipEdge([80 50 130 100], bb),1e-6); +%!assert ([80 50 100 30], clipEdge([80 50 130 0], bb),1e-6); +%!assert ([20 50 0 70], clipEdge([20 50 -30 100], bb),1e-6); +%!assert ([20 50 0 30], clipEdge([20 50 -30 0], bb),1e-6); +%!assert ([50 80 70 100], clipEdge([50 80 100 130], bb),1e-6); +%!assert ([50 80 30 100], clipEdge([50 80 0 130], bb),1e-6); +%!assert ([50 20 70 0], clipEdge([50 20 100 -30], bb),1e-6); +%!assert ([50 20 30 0], clipEdge([50 20 0 -30], bb),1e-6); +%!assert ([100 50 50 50], clipEdge([150 50 50 50], bb),1e-6); +%!assert ([0 50 50 50], clipEdge([-50 50 50 50], bb),1e-6); +%!assert ([50 100 50 50], clipEdge([50 150 50 50], bb),1e-6); +%!assert ([50 0 50 50], clipEdge([50 -50 50 50], bb),1e-6); +%!assert ([100 70 80 50], clipEdge([130 100 80 50], bb),1e-6); +%!assert ([100 30 80 50], clipEdge([130 0 80 50], bb),1e-6); +%!assert ([0 70 20 50], clipEdge([-30 100 20 50], bb),1e-6); +%!assert ([0 30 20 50], clipEdge([-30 0 20 50], bb),1e-6); +%!assert ([70 100 50 80], clipEdge([100 130 50 80], bb),1e-6); +%!assert ([30 100 50 80], clipEdge([0 130 50 80], bb),1e-6); +%!assert ([70 0 50 20], clipEdge([100 -30 50 20], bb),1e-6); +%!assert ([30 0 50 20], clipEdge([0 -30 50 20], bb),1e-6); +%!assert ([0 20 80 100], clipEdge([-10 10 90 110], bb),1e-6); + + + diff --git a/octave_packages/geometry-1.5.0/geom2d/clipLine.m b/octave_packages/geometry-1.5.0/geom2d/clipLine.m new file mode 100644 index 0000000..59bf3ac --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/clipLine.m @@ -0,0 +1,210 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{edge} =} clipLine (@var{line}, @var{box}) +%% Clip a line with a box. +%% +%% @var{line} is a straight line given as a 4 element row vector: [x0 y0 dx dy], +%% with (x0 y0) being a point of the line and (dx dy) a direction vector, +%% @var{box} is the clipping box, given by its extreme coordinates: +%% [xmin xmax ymin ymax]. +%% The result is given as an edge, defined by the coordinates of its 2 +%% extreme points: [x1 y1 x2 y2]. +%% If line does not intersect the box, [NaN NaN NaN NaN] is returned. +%% +%% Function works also if @var{line} is a Nx4 array, if @var{box} is a Nx4 array, or +%% if both @var{line} and @var{box} are Nx4 arrays. In these cases, @var{edge} is a Nx4 +%% array. +%% +%% Example: +%% +%% @example +%% line = [30 40 10 0]; +%% box = [0 100 0 100]; +%% res = clipLine(line, box) +%% res = +%% 0 40 100 40 +%% @end example +%% +%% @seealso{lines2d, boxes2d, edges2d, clipEdge, clipRay} +%% @end deftypefn + +function edge = clipLine(lin, bb, varargin) + + % adjust size of two input arguments + if size(lin, 1)==1 + lin = repmat(lin, size(bb, 1), 1); + elseif size(bb, 1)==1 + bb = repmat(bb, size(lin, 1), 1); + elseif size(lin, 1) ~= size(bb, 1) + error('bad sizes for input'); + end + + % allocate memory + nbLines = size(lin, 1); + edge = zeros(nbLines, 4); + + % main loop on lines + for i=1:nbLines + % extract limits of the box + xmin = bb(i, 1); + xmax = bb(i, 2); + ymin = bb(i, 3); + ymax = bb(i, 4); + + % use direction vector for box edges similar to direction vector of the + % line in order to reduce computation errors + delta = hypot(lin(i,3), lin(i,4)); + + + % compute intersection with each edge of the box + + % lower edge + px1 = intersectLines(lin(i,:), [xmin ymin delta 0]); + % right edge + px2 = intersectLines(lin(i,:), [xmax ymin 0 delta]); + % upper edge + py1 = intersectLines(lin(i,:), [xmax ymax -delta 0]); + % left edge + py2 = intersectLines(lin(i,:), [xmin ymax 0 -delta]); + + % remove undefined intersections (case of lines parallel to box edges) + points = [px1 ; px2 ; py1 ; py2]; + points = points(isfinite(points(:,1)), :); + + % sort points according to their position on the line + pos = linePosition(points, lin(i,:)); + [pos inds] = sort(pos); %#ok + points = points(inds, :); + + % create clipped edge by using the two points in the middle + ind = size(points, 1)/2; + inter1 = points(ind,:); + inter2 = points(ind+1,:); + edge(i, 1:4) = [inter1 inter2]; + + % check that middle point of the edge is contained in the box + midX = mean(edge(i, [1 3])); + xOk = xmin <= midX && midX <= xmax; + midY = mean(edge(i, [2 4])); + yOk = ymin <= midY && midY <= ymax; + + % if one of the bounding condition is not met, set edge to NaN + if ~(xOk && yOk) + edge (i,:) = NaN; + end + end +endfunction + +%!demo +%! lin = [30 40 10 0]; +%! bb = [0 100 0 100]; +%! res = clipLine(lin, bb) +%! +%! drawBox(bb,'color','k'); +%! line(lin([1 3]),lin([2 4]),'color','b'); +%! line(res([1 3]),res([2 4]),'color','r','linewidth',2); +%! axis tight +%! v = axis (); +%! axis(v+[0 10 -10 0]) + +%!test % inside, to the right % inside, to the left% outside +%! bb = [0 100 0 100]; +%! lin = [30 40 10 0]; +%! edge = [0 40 100 40]; +%! assert (edge, clipLine(lin, bb), 1e-6); +%! lin = [30 40 -10 0]; +%! edge = [100 40 0 40]; +%! assert (edge, clipLine(lin, bb), 1e-6); +%! lin = [30 140 10 0]; +%! assert (sum(isnan(clipLine(lin, bb)))==4); + +%!test % inside, upward % inside, downward % outside +%! bb = [0 100 0 100]; +%! lin = [30 40 0 10]; +%! edge = [30 0 30 100]; +%! assert (edge, clipLine(lin, bb), 1e-6); +%! lin = [30 40 0 -10]; +%! edge = [30 100 30 0]; +%! assert (edge, clipLine(lin, bb), 1e-6); +%! lin = [140 30 0 10]; +%! assert (sum(isnan(clipLine(lin, bb)))==4); + +%!test % inside, top right corner% inside, down right corner % outside +%! bb = [0 100 0 100]; +%! lin = [80 30 10 10]; +%! edge = [50 0 100 50]; +%! assert (edge, clipLine(lin, bb), 1e-6); +%! lin = [20 70 10 10]; +%! edge = [0 50 50 100]; +%! assert (edge, clipLine(lin, bb), 1e-6); +%! lin = [140 -30 10 10]; +%! assert (sum(isnan(clipLine(lin, bb)))==4); +%! lin = [-40 130 10 10]; +%! assert (sum(isnan(clipLine(lin, bb)))==4); + +%!test %multilines % inside, top right corner +%! bb = [0 100 0 100]; +%! lin = [... +%! 80 30 10 10; ... +%! 20 70 10 10; ... +%! 140 -30 10 10; ... +%! -40 130 10 10]; +%! edge = [... +%! 50 0 100 50; ... +%! 0 50 50 100; ... +%! NaN NaN NaN NaN; ... +%! NaN NaN NaN NaN; ... +%! ]; +%! clipped = clipLine(lin, bb); +%! assert (4, size(clipped, 1)); +%! assert (edge(1:2, :), clipped(1:2, :), 1e-6); +%! assert (sum(isnan(clipped(3,:)))==4); +%! assert (sum(isnan(clipped(4,:)))==4); + +%!test % test clipping of horizontal lines % inside, to the right +%! bb = [-1 1 -1 1]*1e10; +%! lin = [3 0 1 2]; +%! D = 1e10; +%! edge = [3-D/2 -D 3+D/2 D]; +%! clipped = clipLine(lin, bb); +%! assert (edge, clipped); + +%!test % inside, to the right +%! bb = [-1 1 -1 1]*100; +%! lin = [3 0 1*1e10 2*1e10]; +%! D = 100; +%! edge = [3-D/2 -D 3+D/2 D]; +%! clipped = clipLine(lin, bb); +%! assert (edge, clipped, 1e-6); diff --git a/octave_packages/geometry-1.5.0/geom2d/clipPoints.m b/octave_packages/geometry-1.5.0/geom2d/clipPoints.m new file mode 100644 index 0000000..76944de --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/clipPoints.m @@ -0,0 +1,101 @@ +%% Copyright (c) 2011, INRA +%% 2008-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{points2} =} clipPoints (@var{points}, @var{box}) +%% Clip a set of points by a box. +%% +%% Returns the set @var{points2} which are located inside of the box @var{box}. +%% +%% @seealso{points2d, boxes2d, clipLine, drawPoint} +%% @end deftypefn + +function points = clipPoints(points, bb) + + % get bounding box limits + xmin = bb(1); + xmax = bb(2); + ymin = bb(3); + ymax = bb(4); + + % compute indices of points inside visible area + xOk = points(:,1)>=xmin & points(:,1)<=xmax; + yOk = points(:,2)>=ymin & points(:,2)<=ymax; + + % keep only points inside box + points = points(xOk & yOk, :); + +endfunction + +%!demo +%! points = 2*rand(100,2)-1; +%! bb = [-0.5 0.5 -0.25 0.25]; +%! cpo = clipPoints (points, bb); +%! +%! plot(points(:,1),points(:,2),'xr') +%! hold on +%! drawBox(bb,'color','k') +%! plot(cpo(:,1),cpo(:,2),'*g') +%! hold off + +%!shared bb +%! bb = [0 10 0 20]; + +%!test +%! corners = [0 0;10 0;0 20;10 20]; +%! cornersClipped = clipPoints(corners, bb); +%! assert (4, size(cornersClipped, 1)); +%! assert (corners, cornersClipped, 1e-6); + +%!test +%! borders = [0 5;10 5;5 0;5 20]; +%! bordersClipped = clipPoints(borders, bb); +%! assert (4, size(bordersClipped, 1)); +%! assert (borders, bordersClipped, 1e-6); + +%!test +%! inside = [5 5;5 10;5 15]; +%! insideClipped = clipPoints(inside, bb); +%! assert (size(inside, 1), size(insideClipped, 1)); +%! assert (inside, insideClipped); + +%!test +%! points = [-1 0;11 0;-1 20;11 20;0 -1;0 21;10 -1;10 21]; +%! pointsClipped = clipPoints(points, bb); +%! assert (0, size(pointsClipped, 1)); + +%!test +%! points = [-5 10;0 10;5 10;10 10; 15 10]; +%! pointsClipped = clipPoints(points, bb); +%! assert (3, size(pointsClipped, 1)); +%! assert (points(2:4,:), pointsClipped, 1e-6); diff --git a/octave_packages/geometry-1.5.0/geom2d/clipRay.m b/octave_packages/geometry-1.5.0/geom2d/clipRay.m new file mode 100644 index 0000000..6501095 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/clipRay.m @@ -0,0 +1,172 @@ +%% Copyright (c) 2011, INRA +%% 2010-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {[@var{edge} @var{inside}] =} clipRay (@var{ray}, @var{box}) +%% Clip a ray with a box. +%% +%% @var{ray} is a straight ray given as a 4 element row vector: [x0 y0 dx dy], +%% with (x0 y0) being the origin of the ray and (dx dy) its direction +%% vector, @var{box} is the clipping box, given by its extreme coordinates: +%% [xmin xmax ymin ymax]. +%% The result is given as an edge, defined by the coordinates of its 2 +%% extreme points: [x1 y1 x2 y2]. +%% If the ray does not intersect the box, [NaN NaN NaN NaN] is returned. +%% +%% Function works also if @var{ray} is a Nx4 array, if @var{box} is a Nx4 array, or +%% if both @var{ray} and @var{box} are Nx4 arrays. In these cases, @var{edge} is a Nx4 +%% array. +%% +%% @seealso{rays2d, boxes2d, edges2d, clipLine, drawRay} +%% @end deftypefn + +function [edge isInside] = clipRay(ray, bb) + + % adjust size of two input arguments + if size(ray, 1)==1 + ray = repmat(ray, size(bb, 1), 1); + elseif size(bb, 1)==1 + bb = repmat(bb, size(ray, 1), 1); + elseif size(ray, 1) != size(bb, 1) + error('bad sizes for input'); + end + + % first compute clipping of supporting line + edge = clipLine(ray, bb); + + % detectes valid edges (edges outside box are all NaN) + inds = find(isfinite(edge(:, 1))); + + % compute position of edge extremities relative to the ray + pos1 = linePosition(edge(inds,1:2), ray(inds,:)); + pos2 = linePosition(edge(inds,3:4), ray(inds,:)); + + % if first point is before ray origin, replace by origin + edge(inds(pos1<0), 1:2) = ray(inds(pos1<0), 1:2); + + % if last point of edge is before origin, set all edge to NaN + edge(inds(pos2<0), :) = NaN; + + % eventually returns result about inside or outside + if nargout>1 + isInside = isfinite(edge(:,1)); + end + +endfunction + +%!shared bb +%! bb = [0 100 0 100]; + +%!test % inside +%! origin = [30 40]; +%! direction = [10 0]; +%! ray = [origin direction]; +%! expected = [30 40 100 40]; +%! assert (expected, clipRay(ray, bb), 1e-6); + +%!test % outside +%! origin = [30 140]; +%! direction = [10 0]; +%! ray = [origin direction]; +%! assert (sum(isnan(clipRay(ray, bb)))==4); + +%!test % line inside, but ray outside +%! origin = [130 40]; +%! direction = [10 0]; +%! ray = [origin direction]; +%! assert (sum(isnan(clipRay(ray, bb)))==4); + +%!test % inside +%! origin = [30 40]; +%! direction = [-10 0]; +%! ray = [origin direction]; +%! expected = [30 40 0 40]; +%! assert (expected, clipRay(ray, bb), 1e-6); + +%!test % outside +%! origin = [30 140]; +%! direction = [-10 0]; +%! ray = [origin direction]; +%! assert (sum(isnan(clipRay(ray, bb)))==4); + +%!test % line inside, but ray outside +%! origin = [-30 40]; +%! direction = [-10 0]; +%! ray = [origin direction]; +%! assert (sum(isnan(clipRay(ray, bb)))==4); + +%!test % inside +%! origin = [30 40]; +%! direction = [0 10]; +%! ray = [origin direction]; +%! expected = [30 40 30 100]; +%! assert (expected, clipRay(ray, bb), 1e-6); + +%!test % outside +%! origin = [130 40]; +%! direction = [0 10]; +%! ray = [origin direction]; +%! assert (sum(isnan(clipRay(ray, bb)))==4); + +%!test % line inside, but ray outside +%! origin = [30 140]; +%! direction = [0 10]; +%! ray = [origin direction]; +%! assert (sum(isnan(clipRay(ray, bb)))==4); + +%!test % inside +%! origin = [30 40]; +%! direction = [0 -10]; +%! ray = [origin direction]; +%! expected = [30 40 30 0]; +%! assert (expected, clipRay(ray, bb), 1e-6); + +%!test % outside +%! origin = [130 40]; +%! direction = [0 -10]; +%! ray = [origin direction]; +%! assert (sum(isnan(clipRay(ray, bb)))==4); + +%!test % line inside, but ray outside +%! origin = [30 -40]; +%! direction = [0 -10]; +%! ray = [origin direction]; +%! assert (sum(isnan(clipRay(ray, bb)))==4); + +%!test +%! origins = [30 40;30 40;30 140;130 40]; +%! directions = [10 0;0 10;10 0;0 10]; +%! rays = [origins directions]; +%! expected = [30 40 100 40;30 40 30 100;NaN NaN NaN NaN;NaN NaN NaN NaN]; +%! clipped = clipRay(rays, bb); +%! assert (expected, clipped, 1e-6); diff --git a/octave_packages/geometry-1.5.0/geom2d/closed_path.m b/octave_packages/geometry-1.5.0/geom2d/closed_path.m new file mode 100644 index 0000000..4ea3839 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/closed_path.m @@ -0,0 +1,105 @@ +%% Copyright (C) 2012 Simeon Simeonov +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{y} =} polygon (@var{x}) +%% Returns a simple closed path that passes through all the points in @var{x}. +%% @var{x} is a vector containing 2D coordinates of the points. +%% +%% @end deftypefn + +%% Author: Simeon Simeonov + +function y = closed_path(x) + + if(size(x,1) > 1 && size(x,1) < size(x,2)) + x = x'; + end + + N = size(x,1); % Number of points + idx = zeros(N, 1); % ind contains the indices of the sorted coordinates + + a = find(x(:,2)==min(x(:,2))); + + if(size(a,1) > 1) + [~, i] = sort(x(a,1)); + a = a(i(1)); + end + + x_1 = x(x(:,2)==x(a,2),:); % find all x with the same y coordinate + + if(x(a,1) == min(x(:,1))) + x_2 = x(x(:,1)==x(a,1),:); % find all x with the same x coordinate + else + x_2 = x(a,:); + end + + if(size(x_1,1) > 1 || size(x_2,1) > 1) + if(size(x_1,1) > 1) + x_1 = sort(x_1); % Sort by x coordinate + y(1,:) = x(a,:); % original starting point + end + + if (size(x_2,1) > 1) + x_2 = sort(x_2, 'descend'); + end + + x_not = [x_1; x_2]; + i = ismember(x,x_not,'rows'); + x(i, :) = []; + x = [x_1(size(x_1,1),:); x]; + x_1(size(x_1, 1),:) = []; + N = size(x,1); + a = 1; + else + x_1 = []; + x_2 = x(a,:); + end + d = x - repmat(x(a,:), N, 1); + th = d(:,2)./(d(:,1) + d(:,2)); + + [~, idx0] = ismember(sort(th(th==0)), th); + [~, idx1] = ismember(sort(th(th>0)), th); + [~, idx2] = ismember(sort(th(th<0)), th); + + idx = [a; idx0; idx1; idx2]; + % I contains the indices of idx in a sorted order. [v i] = sort(idx) then + % i==I. + [~,I,J]= unique(idx); + if(size(I,1) ~= size(J,1)) + R = histc(J, 1:size(I,1)); % R(1) will always be 1? + idx_sorted = idx(I); + r = find(R>1); + for ri = r' + idx_repeated = idx_sorted(ri); + idx(idx==idx_repeated) = find(th==th(idx_sorted(ri))); + end + end + + y = [x_1; x(idx,:); x_2;]; + +endfunction + +%!demo +%! maxInt = 100; +%! N = 25; +%! +%! for i = 1:5 +%! x = randi(maxInt, N, 2); +%! y = closed_path(x); +%! plot(y(:,1), y(:,2), '*'); +%! hold on; +%! plot(y(:,1), y(:,2)); +%! end diff --git a/octave_packages/geometry-1.5.0/geom2d/cov2ellipse.m b/octave_packages/geometry-1.5.0/geom2d/cov2ellipse.m new file mode 100644 index 0000000..214381a --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/cov2ellipse.m @@ -0,0 +1,71 @@ +## Copyright (c) 2012 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR 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{ellipse} = } cov2ellipse (@var{K}) +%% @deftypefnx {Function File} {[@var{ra} @var{rb} @var{theta}] = } cov2ellipse (@var{K}) +%% @deftypefnx {Function File} {@dots{} = } cov2ellipse (@dots{}, @samp{tol},@var{tol}) +%% Calculates ellipse parameters from covariance matrix. +%% +%% @var{K} must be symmetric positive (semi)definite. The optional argument +%% @samp{tol} sets the tolerance for the verification of the +%% positive-(semi)definiteness of the matrix @var{K} (see @command{isdefinite}). +%% +%% If only one output argument is supplied a vector defining a ellipse is returned +%% as defined in @command{ellipses2d}. Otherwise the angle @var{theta} is given +%% in radians. +%% +%% Run @code{demo cov2ellipse} to see an example. +%% +%% @seealso{ellipses2d, cov2ellipse, drawEllipse} +%% @end deftypefn + +function varargout = cov2ellipse (K, varargin); + + parser = inputParser (); + parser.FunctionName = "cov2ellipse"; + parser = addParamValue (parser,'Tol', 100*eps*norm (K, "fro"), @(x)x>0); + parser = parse(parser,varargin{:}); + + if isdefinite (K,parser.Results.Tol) == -1 + print_usage + end + [R S W] = svd (K); + theta = atan (R(1,1)/R(2,2)); + v = sort (diag(S), 'ascend')'; + + if nargout == 1 + varargout{1} = [0 0 v theta*180/pi]; + elseif nargout == 3 + varargout{1} = v(1); + varargout{2} = v(2); + varargout{3} = theta; + end + +endfunction + +%!demo +%! K = [2 1; 1 2]; +%! L = chol(K,'lower'); +%! u = randn(1e3,2)*L'; +%! +%! elli = cov2ellipse (K) +%! +%! figure(1) +%! plot(u(:,1),u(:,2),'.r'); +%! hold on; +%! drawEllipse(elli,'linewidth',2); +%! hold off +%! axis tight diff --git a/octave_packages/geometry-1.5.0/geom2d/crackPattern.m b/octave_packages/geometry-1.5.0/geom2d/crackPattern.m new file mode 100644 index 0000000..3ec4ef5 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/crackPattern.m @@ -0,0 +1,189 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{e} = } crackPattern (@var{box}, @var{points}, @var{alpha}) +%% Create a (bounded) crack pattern tessellation +%% +%% E = crackPattern2(BOX, POINTS, ALPHA) +%% create a crack propagation pattern wit following parameters : +%% - pattern is bounded by area BOX which is a polygon. +%% - each crack originates from points given in POINTS +%% - directions of each crack is given by a [NxM] array ALPHA, where M is +%% the number of rays emanating from each seed/ +%% - a crack stop when it reaches another already created crack. +%% - all cracks stop when they reach the border of the frame, given by box +%% (a serie of 4 points). +%% The result is a collection of edges, in the form [x1 y1 x2 y2]. +%% +%% E = crackPattern2(BOX, POINTS, ALPHA, SPEED) +%% Also specify speed of propagation of each crack. +%% +%% +%% See the result with : +%% figure; +%% drawEdge(E); +%% +%% @seealso{drawEdge} +%% @end deftypefn + +function edges = crackPattern(box, points, alpha, varargin) + + if ~isempty(varargin) + speed = varargin{1}; + else + speed = ones(size(points, 1), 1); + end + + % Compute line equations for each initial crack. + % The two 'Inf' at the end correspond to the position of the limit. + % If an intersection point is found with another line, but whose position + % is after this value, this means that another crack stopped it before it + % reach the intersection point. + % There is one 'end position' for each side of the crack. + lines = [points speed.*cos(alpha) speed.*sin(alpha) Inf*ones(size(points, 1), 2)]; + + % initialize lines for borders, but assign a very high speed, to be sure + % borders will stop all cracks. + dx = (box([2 3 4 1],1)-box([1 2 3 4],1))*max(speed)*5; + dy = (box([2 3 4 1],2)-box([1 2 3 4],2))*max(speed)*5; + + % add borders to the lines set + lines = [lines ; createLine(box, dx, dy) Inf*ones(4,2)]; + + edges = zeros(0, 4); + + + while true + modif = 0; + + % try to update each line + for i=1:size(points, 1) + + % compute intersections with all other lines + pi = intersectLines(lines(i,:), lines); + + % compute position of all intersection points on the current line + pos = linePosition(pi, lines(i,:)); + + % consider points to the right (positive position), and sort them + indr = find(pos>=0 & pos~=Inf); + [posr, indr2] = sort(pos(indr)); + + + % look for the closest intersection to the right + for i2=1:length(indr2) + + % index of intersected line + il = indr(indr2(i2)); + + % position of point relative to intersected line + pos2 = linePosition(pi(il, :), lines(il, :)); + + % depending on the sign of position, tests if the line2 can + % stop the current line, or if it was stopped before + if pos2>0 + if pos20 + if pos2 +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{e} = } crackPattern2 (@var{box}, @var{points}, @var{alpha}) +%% Create a (bounded) crack pattern tessellation +%% +%% E = crackPattern2(BOX, POINTS, ALPHA) +%% create a crack propagation pattern wit following parameters : +%% - pattern is bounded by area BOX which is a polygon. +%% - each crack originates from points given in POINTS +%% - directions of each crack is given by a [NxM] array ALPHA, where M is +%% the number of rays emanating from each seed/ +%% - a crack stop when it reaches another already created crack. +%% - all cracks stop when they reach the border of the frame, given by box +%% (a serie of 4 points). +%% The result is a collection of edges, in the form [x1 y1 x2 y2]. +%% +%% E = crackPattern2(BOX, POINTS, ALPHA, SPEED) +%% Also specify speed of propagation of each crack. +%% +%% +%% See the result with : +%% figure; +%% drawEdge(E); +%% +%% @seealso{drawEdge} +%% @end deftypefn + +function edges = crackPattern2(box, points, alpha, varargin) + + if ~isempty(varargin) + speed = varargin{1}; + else + speed = ones(size(points, 1), 1); + end + + % Compute line equations for each initial crack. + % The 'Inf' at the end correspond to the position of the limit. + % If an intersection point is found with another line, but whose position + % is after this value, this means that another crack stopped it before it + % reach the intersection point. + NP = size(points, 1); + lines = zeros(0, 5); + for i=1:size(alpha, 2) + lines = [lines; points speed.*cos(alpha(:,i)) speed.*sin(alpha(:,i)) Inf*ones(NP, 1)]; + end + NL = size(lines, 1); + + % initialize lines for borders, but assign a very high speed, to be sure + % borders will stop all cracks. + dx = (box([2 3 4 1],1)-box([1 2 3 4],1))*max(speed)*5; + dy = (box([2 3 4 1],2)-box([1 2 3 4],2))*max(speed)*5; + + % add borders to the lines set + lines = [lines ; createLine(box, dx, dy) Inf*ones(4,1)]; + + edges = zeros(0, 4); + + + while true + modif = 0; + + % try to update each line + for i=1:NL + + % initialize first point of edge + edges(i, 1:2) = lines(i, 1:2); + + % compute intersections with all other lines + pi = intersectLines(lines(i,:), lines); + + % compute position of all intersection points on the current line + pos = linePosition(pi, lines(i,:)); + + + % consider points to the right (positive position), and sort them + indr = find(pos>1e-12 & pos~=Inf); + [posr, indr2] = sort(pos(indr)); + + + % look for the closest intersection to the right + for i2=1:length(indr2) + + % index of intersected line + il = indr(indr2(i2)); + + % position of point relative to intersected line + pos2 = linePosition(pi(il, :), lines(il, :)); + + % depending on the sign of position, tests if the line2 can + % stop the current line, or if it was stopped before + if pos2>0 + if pos2 +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in @var{source} and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of @var{source} code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{T} = } createBasisTransfrom (@var{@var{target}}) +%% @deftypefnx {Function File} {@var{T} = } createBasisTransfrom (@var{@var{source}}, @var{@var{target}}) +%% Compute matrix for transforming a basis into another basis +%% +%% With only one input arguemnt, assumes the @var{source} is the standard (Oij) basis, with origin at (0,0), +%% first direction vector equal to (1,0) and second direction vector +%% equal to (0,1). Otherwise @var{@var{source}} specifies the @var{source} basis. +%% +%% Both @var{source} and @var{target} represent basis, in the following form: +%% [x0 y0 ex1 ey1 ex2 ey2] +%% [y0 y0] is the origin of the basis, [ex1 ey1] is the first direction +%% vector, and [ex2 ey2] is the second direction vector. +%% +%% The result @var{T} is a 3-by-3 matrix such that a point expressed with +%% coordinates of the first basis will be represented by new coordinates +%% @code{P2 = transformPoint(P1, @var{T})} in the @var{target} basis. +%% +%% Example +%% @example +%% % standard basis transform +%% src = [0 0 1 0 0 1]; +%% % @var{target} transform, just a rotation by atan(2/3) followed by a scaling +%% tgt = [0 0 .75 .5 -.5 .75]; +%% % compute transform +%% trans = createBasisTransform(src, tgt); +%% % transform the point (.25,1.25) into the point (1,1) +%% p1 = [.25 1.25]; +%% p2 = transformPoint(p1, trans) +%% ans = +%% 1 1 +%% @end example +%% +%% @seealso{transforms2d} +%% @end deftypefn + +function transfo = createBasisTransform(source, target) + + % init basis transform to identity + t1 = eye(3); + t2 = eye(3); + + if nargin==2 + % from source to reference basis + t1(1:2, 1) = source(3:4); + t1(1:2, 2) = source(5:6); + t1(1:2, 3) = source(1:2); + else + % if only one input, use first input as target basis, and leave the + % first matrix to identity + target = source; + end + + % from reference to target basis + t2(1:2, 1) = target(3:4); + t2(1:2, 2) = target(5:6); + t2(1:2, 3) = target(1:2); + + % compute transfo + % same as: transfo = inv(t2)*t1; + transfo = t2\t1; + +endfunction + +%!demo +%! % standard basis transform +%! src = [0 0 1 0 0 1]; +%! % target transform, just a rotation by atan(2/3) followed by a scaling +%! tgt = [0 0 .75 .5 -.5 .75]; +%! % compute transform +%! trans = createBasisTransform(src, tgt); +%! % transform the point (.25,1.25) into the point (1,1) +%! p1 = [.25 1.25]; +%! p2 = transformPoint(p1, trans) + diff --git a/octave_packages/geometry-1.5.0/geom2d/createCircle.m b/octave_packages/geometry-1.5.0/geom2d/createCircle.m new file mode 100644 index 0000000..bf1866b --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/createCircle.m @@ -0,0 +1,129 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{circle} = } createCircle (@var{p1}, @var{p2}, @var{p3}) +%% @deftypefnx {Function File} {@var{circle} = } createCircle (@var{p1}, @var{p2}) +%% Create a circle from 2 or 3 points. +%% +%% Creates the circle passing through the 3 given points. +%% C is a 1x3 array of the form: [XC YX R]. +%% +%% When two points are given, creates the circle whith center @var{p1} and passing +%% throuh the point @var{p2}. +%% +%% Works also when input are point arrays the same size, in this case the +%% result has as many lines as the point arrays. +%% +%% Example +%% +%% @example +%% % Draw a circle passing through 3 points. +%% p1 = [10 15]; +%% p2 = [15 20]; +%% p3 = [10 25]; +%% circle = createCircle(p1, p2, p3); +%% figure; hold on; axis equal; axis([0 50 0 50]); +%% drawPoint([p1 ; p2; p3]); +%% drawCircle(circle); +%% @end example +%% +%% @seealso{circles2d, createDirectedCircle} +%% @end deftypefn + +function circle = createCircle(varargin) + + if nargin == 2 + % inputs are the center and a point on the circle + p1 = varargin{1}; + p2 = varargin{2}; + x0 = p1(:,1); + y0 = p1(:,2); + r = hypot((p2(:,1)-x0), (p2(:,2)-y0)); + + elseif nargin == 3 + % inputs are three points on the circle + p1 = varargin{1}; + p2 = varargin{2}; + p3 = varargin{3}; + + % compute circle center + line1 = medianLine(p1, p2); + line2 = medianLine(p1, p3); + point = intersectLines(line1, line2); + x0 = point(:, 1); + y0 = point(:, 2); + + % circle radius + r = hypot((p1(:,1)-x0), (p1(:,2)-y0)); + end + + % create array for returning result + circle = [x0 y0 r]; + +endfunction + +%!shared privpath +%! privpath = [fileparts(which('geom2d_Contents')) filesep() 'private']; + +%!test +%! addpath (privpath,'-end') +%! p1 = [10 15]; +%! p2 = [15 20]; +%! p3 = [10 25]; +%! exp = [10 20 5]; +%! circle = createCircle(p1, p2, p3); +%! assertEqual(exp, circle); +%! circle = createCircle(p3, p1, p2); +%! assertEqual(exp, circle); +%! circle = createCircle(p2, p3, p1); +%! assertEqual(exp, circle); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! p1 = [10 15]; +%! p2 = [15 20]; +%! p3 = [10 25]; +%! exp = [10 20 5]; +%! p1 = [p1; p1+10; p1+20; p1-5]; +%! p2 = [p2; p2+10; p2+20; p2-5]; +%! p3 = [p3; p3+10; p3+20; p3-5]; +%! exp = repmat(exp, 4, 1) + [0 0 0;10 10 0;20 20 0;-5 -5 0]; +%! circle = createCircle(p1, p2, p3); +%! assertEqual(exp, circle); +%! circle = createCircle(p3, p1, p2); +%! assertEqual(exp, circle); +%! circle = createCircle(p2, p3, p1); +%! assertEqual(exp, circle); +%! rmpath (privpath); diff --git a/octave_packages/geometry-1.5.0/geom2d/createDirectedCircle.m b/octave_packages/geometry-1.5.0/geom2d/createDirectedCircle.m new file mode 100644 index 0000000..9f3a3f9 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/createDirectedCircle.m @@ -0,0 +1,92 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{circle} = } createDirectedCircle (@var{p1}, @var{p2}, @var{p3}) +%% @deftypefnx {Function File} {@var{circle} = } createDirectedCircle (@var{p1}, @var{p2}) +%% Create a circle from 2 or 3 points. +%% +%% Creates the circle passing through the 3 given points. +%% C is a 1x4 array of the form: [XC YX R INV]. +%% +%% When two points are given, creates the circle whith center @var{p1} and passing +%% throuh the point @var{p2}. +%% +%% Works also when input are point arrays the same size, in this case the +%% result has as many lines as the point arrays. +%% +%% Example +%% +%% +%% @seealso{circles2d, createCircle} +%% @end deftypefn + +function circle = createDirectedCircle(varargin) + + if nargin == 2 + % inputs are the center and a point on the circle + p1 = varargin{1}; + p2 = varargin{2}; + x0 = (p1(:,1) + p2(:,1))/2; + y0 = (p1(:,2) + p2(:,2))/2; + r = hypot((p2(:,1)-p1(:,1)), (p2(:,2)-p1(:,2)))/2; + + % circle is direct by default + d = 0; + + elseif nargin == 3 + % inputs are three points on the circle + p1 = varargin{1}; + p2 = varargin{2}; + p3 = varargin{3}; + + % compute circle center + line1 = medianLine(p1, p2); + line2 = medianLine(p1, p3); + center = intersectLines(line1, line2); + x0 = center(:, 1); + y0 = center(:, 2); + + % circle radius + r = hypot((p1(:,1)-x0), (p1(:,2)-y0)); + + % compute circle orientation + angle = angle3Points(p1, center, p2) + angle3Points(p2, center, p3); + d = angle>2*pi; + end + + + circle = [x0 y0 r d]; + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/createEdge.m b/octave_packages/geometry-1.5.0/geom2d/createEdge.m new file mode 100644 index 0000000..eb0aa51 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/createEdge.m @@ -0,0 +1,121 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{edge} = } createEdge (@var{p1}, @var{p2}) +%% @deftypefnx {Function File} {@var{edge} = } createEdge (@var{x0}, @var{y0}, @var{dx}, @var{dy}) +%% @deftypefnx {Function File} {@var{edge} = } createEdge (@var{param}) +%% @deftypefnx {Function File} {@var{edge} = } createEdge (@var{line}, @var{d}) +%% Create an edge between two points, or from a line. +%% +%% The internal format for edge representation is given by coordinates of +%% two points : [x1 y1 x2 y2]. +%% This function can serve as a line to edge converter. +%% +%% +%% Returns the edge between the two given points @var{p1} and @var{p2}. +%% +%% Returns the edge going through point (@var{x0}, @var{y0}) and with direction +%% vector (@var{dx},@var{dy}). +%% +%% When @var{param} is an array of 4 values, creates the edge going through the +%% point (param(1) param(2)), and with direction vector given by +%% (param(3) param(4)). +%% +%% When @var{line} is given, creates the edge contained in @var{line}, with same +%% direction and start point, but with length given by @var{d}. +%% +%% +%% Note: in all cases, parameters can be vertical arrays of the same +%% dimension. The result is then an array of edges, of dimensions [N*4]. +%% +%% @seealso{edges2d, lines2d, drawEdge, clipEdge} +%% @end deftypefn + +function edge = createEdge(varargin) + + if length(varargin)==1 + % Only one input parameter. It can be : + % - line angle + % - array of four parameters + % TODO : add control for arrays of lines. + var = varargin{1}; + + if size(var, 2)==4 + % 4 parameters of the line in a single array. + %edge = var; + edge = zeros(size(var)); + edge(:, 1:2) = var(:,1:2); + edge(:, 3:4) = edge(:, 1:2)+var(:,3:4); + elseif size(var, 2)==1 + % 1 parameter : angle of the line, going through origin. + edge = [zeros(size(var,1)) zeros(size(var,1)) cos(var) sin(var)]; + else + error('wrong number of dimension for arg1 : can be 1 or 4'); + end + + elseif length(varargin)==2 + % 2 input parameters. They can be : + % - 2 points, then 2 arrays of 1*2 double, + % - a line, and a distance. + v1 = varargin{1}; + v2 = varargin{2}; + if size(v1, 2)==2 + % first input parameter is first point, and second input is the + % second point. + %edge = [v1(:,1), v1(:,2), v2(:,1), v2(:,2)]; + edge = [v1 v2]; + else + % first input parameter is a line, and second one a distance. + angle = atan2(v1(:,4), v1(:,3)); + edge = [v1(:,1), v1(:,2), v1(:,1)+v2.*cos(angle), v1(:,2)+v2.*sin(angle)]; + end + + elseif length(varargin)==3 + % 3 input parameters : + % first one is a point belonging to the line, + % second and third ones are direction vector of the line (dx and dy). + p = varargin{1}; + edge = [p(:,1) p(:,2) p(:,1)+varargin{2} p(:,2)+varargin{3}]; + + elseif length(varargin)==4 + % 4 input parameters : + % they are x0, y0 (point belonging to line) and dx, dy (direction + % vector of the line). + % All parameters should have the same size. + edge = [varargin{1} varargin{2} varargin{1}+varargin{3} varargin{2}+varargin{4}]; + else + error('Wrong number of arguments in ''createLine'' '); + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/createHomothecy.m b/octave_packages/geometry-1.5.0/geom2d/createHomothecy.m new file mode 100644 index 0000000..71199f0 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/createHomothecy.m @@ -0,0 +1,61 @@ +%% Copyright (c) 2011, INRA +%% 2009-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{T} = } createHomothecy (@var{point}, @var{ratio}) +%% Create the the 3x3 matrix of an homothetic transform. +% +% @var{point} is the center of the homothecy, @var{ratio} is its factor. +% +% @seealso{transforms2d, transformPoint, createTranslation} +%% @end deftypefn + +function trans = createHomothecy(point, ratio) + + % extract coordinate of center + x0 = point(:,1); + y0 = point(:,2); + + % compute coefficients of the matrix + m00 = ratio; + m01 = 0; + m02 = x0*(1-ratio); + m10 = 0; + m11 = ratio; + m12 = y0*(1-ratio); + + % create transformation + trans = [m00 m01 m02; m10 m11 m12; 0 0 1]; + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/createLine.m b/octave_packages/geometry-1.5.0/geom2d/createLine.m new file mode 100644 index 0000000..ac00400 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/createLine.m @@ -0,0 +1,163 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{line} =} createLine(varargin) +%% Create a straight line from 2 points, or from other inputs +%% +%% Line is represented in a parametric form : [x0 y0 dx dy] +%% x = x0 + t*dx +%% y = y0 + t*dy; +%% +%% +%% L = createLine(p1, p2); +%% Returns the line going through the two given points. +%% +%% L = createLine(x0, y0, dx, dy); +%% Returns the line going through point (x0, y0) and with direction +%% vector(dx, dy). +%% +%% L = createLine(LINE); +%% where LINE is an array of 4 values, creates the line going through the +%% point (LINE(1) LINE(2)), and with direction given by vector (LINE(3) +%% LINE(4)). +%% +%% L = createLine(THETA); +%% Create a polar line originated at (0,0) and with angle THETA. +%% +%% L = createLine(RHO, THETA); +%% Create a polar line with normal theta, and with min distance to origin +%% equal to rho. rho can be negative, in this case, the line is the same +%% as with CREATELINE(-rho, theta+pi), but the orientation is different. +%% +%% +%% Note: in all cases, parameters can be vertical arrays of the same +%% dimension. The result is then an array of lines, of dimensions [N*4]. +%% +%% NOTE : A line can also be represented with a 1*5 array : +%% [x0 y0 dx dy t]. +%% whith 't' being one of the following : +%% - t=0 : line is a singleton (x0,y0) +%% - t=1 : line is an edge segment, between points (x0,y0) and (x0+dx, +%% y0+dy). +%% - t=Inf : line is a Ray, originated from (x0,y0) and going to infinity +%% in the direction(dx,dy). +%% - t=-Inf : line is a Ray, originated from (x0,y0) and going to infinity +%% in the direction(-dx,-dy). +%% - t=NaN : line is a real straight line, and contains all points +%% verifying the above equation. +%% This seems us a convenient way to represent uniformly all kind of lines +%% (including edges, rays, and even point). +%% +%% NOTE2 : Any line object can be represented using a 1x6 array : +%% [x0 y0 dx dy t0 t1] +%% the first 4 parameters define the supporting line, +%% t0 represent the position of the first point on the line, +%% and t1 the position of the last point. +%% * for edges : t0 = 0, and t1=1 +%% * for straight lines : t0 = -inf, t1=inf +%% * for rays : t0=0, t1=inf (or t0=-inf,t1=0 for inverted ray). +%% I propose to call these objects 'lineArc' +%% +%% @seealso{lines2d, createEdge, createRay} +%% @end deftypefn + +function line = createLine(varargin) + + if length(varargin)==1 + % Only one input parameter. It can be : + % - line angle + % - array of four parameters + % TODO : add control for arrays of lines. + var = varargin{1}; + + if size(var, 2)==4 + % 4 parameters of the line in a single array. + line = var; + elseif size(var, 2)==1 + % 1 parameter : angle of the line, going through origin. + line = [zeros(size(var)) zeros(size(var)) cos(var) sin(var)]; + else + error('wrong number of dimension for arg1 : can be 1 or 4'); + end + + elseif length(varargin)==2 + % 2 input parameters. They can be : + % - line angle and signed distance to origin. + % - 2 points, then 2 arrays of 1*2 double. + v1 = varargin{1}; + v2 = varargin{2}; + if size(v1, 2)==1 + % first param is angle of line, and second param is signed distance + % to origin. + line = [v1.*cos(v2) v1.*sin(v2) -sin(v2) cos(v2)]; + else + % first input parameter is first point, and second input is the + % second point. + line = [v1(:,1), v1(:,2), v2(:,1)-v1(:,1), v2(:,2)-v1(:,2)]; + end + + elseif length(varargin)==3 + % 3 input parameters : + % first one is a point belonging to the line, + % second and third ones are direction vector of the line (dx and dy). + p = varargin{1}; + line = [p(:,1) p(:,2) varargin{2} varargin{3}]; + + elseif length(varargin)==4 + % 4 input parameters : + % they are x0, y0 (point belongng to line) and dx, dy (direction vector + % of the line). + % All parameters should have the same size. + line = [varargin{1} varargin{2} varargin{3} varargin{4}]; + else + error('Wrong number of arguments in ''createLine'' '); + end + +endfunction + +%!test +%! p1 = [1 1]; +%! p2 = [2 3]; +%! lin = createLine(p1, p2); +%! assert (p1, lin(1,1:2), 1e-6); +%! assert (p2-p1, lin(1,3:4), 1e-6); + +%!test +%! p1 = [1 1;1 1]; +%! p2 = [2 3;2 4]; +%! lin = createLine(p1, p2); +%! assert (2, size(lin, 1)); +%! assert (p1, lin(:,1:2), 1e-6); +%! assert (p2-p1, lin(:,3:4), 1e-6); + diff --git a/octave_packages/geometry-1.5.0/geom2d/createLineReflection.m b/octave_packages/geometry-1.5.0/geom2d/createLineReflection.m new file mode 100644 index 0000000..a174565 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/createLineReflection.m @@ -0,0 +1,68 @@ +%% Copyright (c) 2011, INRA +%% 2009-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{T} = } function_name (@var{line}) +%% Create the the 3x3 matrix of a line reflection. +%% +%% Where @var{line} is given as [x0 y0 dx dy], return the affine tansform +%% corresponding to the desired line reflection. +%% +%% @seealso{lines2d, transforms2d, transformPoint, +%% createTranslation, createHomothecy, createScaling} +%% @end deftypefn + +function trans = createLineReflection(line) + + % extract line parameters + x0 = line(:,1); + y0 = line(:,2); + dx = line(:,3); + dy = line(:,4); + + % normalisation coefficient of line direction vector + delta = dx*dx + dy*dy; + + % compute coefficients of transform + m00 = (dx*dx - dy*dy)/delta; + m01 = 2*dx*dy/delta; + m02 = 2*dy*(dy*x0 - dx*y0)/delta; + m10 = 2*dx*dy/delta; + m11 = (dy*dy - dx*dx)/delta; + m12 = 2*dx*(dx*y0 - dy*x0)/delta; + + % create transformation + trans = [m00 m01 m02; m10 m11 m12; 0 0 1]; + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/createRay.m b/octave_packages/geometry-1.5.0/geom2d/createRay.m new file mode 100644 index 0000000..ec4f918 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/createRay.m @@ -0,0 +1,104 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} { @var{ray} = } createRay (@var{point}, @var{angle}) +%% @deftypefnx {Function File} { @var{ray} = } createRay (@var{x0},@var{y0}, @var{angle}) +%% @deftypefnx {Function File} { @var{ray} = } createRay (@var{p1}, @var{p2}) +%% Create a ray (half-line), from various inputs. +%% +%% A Ray is represented in a parametric form: [x0 y0 dx dy]. +%% x = x0 + t*dx +%% y = y0 + t*dy; +%% for all t>0. +%% +%% @var{point} is a Nx2 array giving the starting point of the ray, and @var{angle} is the +%% orientation of the ray respect to the positive x-axis. The ray origin can be specified with 2 input arguments @var{x0},@var{y0}. +%% +%% If two points @var{p1}, @var{p2} are given, creates a ray starting from point @var{p1} and going in the direction of point +%% @var{p2}. +%% +%% Example +%% @example +%% origin = [3 4]; +%% theta = pi/6; +%% ray = createRay(origin, theta); +%% axis([0 10 0 10]); +%% drawRay(ray); +%% @end example +%% +%% @seealso{rays2d, createLine, points2d} +%% @end deftypefn + +function ray = createRay(varargin) + + if length(varargin)==2 + p0 = varargin{1}; + arg = varargin{2}; + if size(arg, 2)==1 + % second input is the ray angle + ray = [p0 cos(arg) sin(arg)]; + else + % second input is another point + ray = [p0 arg-p0]; + end + + elseif length(varargin)==3 + x = varargin{1}; + y = varargin{2}; + theta = varargin{3}; + ray = [x y cos(theta) sin(theta)]; + + else + error("Wrong number of arguments in 'createRay'. "); + end + +endfunction + +%!shared p1,p2,ray +%! p1 = [1 1]; +%! p2 = [2 3]; +%! ray = createRay(p1, p2); + +%!assert (p1, ray(1,1:2), 1e-6); +%!assert (p2-p1, ray(1,3:4), 1e-6); + +%!shared p1,p2,ray +%! p1 = [1 1;1 1]; +%! p2 = [2 3;2 4]; +%! ray = createRay(p1, p2); + +%!assert (2, size(ray, 1)); +%!assert (p1, ray(:,1:2), 1e-6); +%!assert (p2-p1, ray(:,3:4), 1e-6); + diff --git a/octave_packages/geometry-1.5.0/geom2d/createRotation.m b/octave_packages/geometry-1.5.0/geom2d/createRotation.m new file mode 100644 index 0000000..b373f5d --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/createRotation.m @@ -0,0 +1,112 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{T} = } createRotation (@var{theta}) +%% @deftypefnx {Function File} {@var{T} = } createRotation (@var{point}, @var{theta}) +%% @deftypefnx {Function File} {@var{T} = } createRotation (@var{x0}, @var{y0}, @var{theta}) +%% Create the 3*3 matrix of a rotation. +%% +%% Returns the rotation corresponding to angle @var{theta} (in radians) +%% The returned matrix has the form : +%% [cos(theta) -sin(theta) 0] +%% [sin(theta) cos(theta) 0] +%% [0 0 1] +%% +%% @var{point} or (@var{x0},@var{y0}), specifies origin of rotation. The result is similar as performing +%% translation(-@var{x0},-@var{y0}), rotation(@var{theta}), and translation(@var{x0},@var{y0}). +%% +%% +%% @seealso{transforms2d, transformPoint, createTranslation, createScaling} +%% @end deftypefn + +function trans = createRotation(varargin) + + % default values + cx = 0; + cy = 0; + theta = 0; + + % get input values + if length(varargin)==1 + % only angle + theta = varargin{1}; + elseif length(varargin)==2 + % origin point (as array) and angle + var = varargin{1}; + cx = var(1); + cy = var(2); + theta = varargin{2}; + elseif length(varargin)==3 + % origin (x and y) and angle + cx = varargin{1}; + cy = varargin{2}; + theta = varargin{3}; + end + + % compute coefs + cot = cos(theta); + sit = sin(theta); + tx = cy*sit - cx*cot + cx; + ty = -cy*cot - cx*sit + cy; + + % create transformation matrix + trans = [cot -sit tx; sit cot ty; 0 0 1]; + +endfunction + +%!test +%! trans = createRotation(0); +%! assert (trans, [1 0 0;0 1 0;0 0 1], 1e-6); + +%!test +%! trans = createRotation(pi/2); +%! assert (trans, [0 -1 0; 1 0 0; 0 0 1], 1e-6); + +%!test +%! trans = createRotation(pi); +%! assert (trans, [-1 0 0;0 -1 0;0 0 1], 1e-6); + +%!test +%! trans = createRotation(3*pi/2); +%! assert (trans, [0 1 0; -1 0 0; 0 0 1], 1e-6); + +%!test +%! p0 = [3 5]; +%! theta = pi/3; +%! trans1 = createRotation(p0, theta); +%! t1 = createTranslation(-p0); +%! rot = createRotation(theta); +%! t2 = createTranslation(p0); +%! trans2 = t2*rot*t1; +%! assert (trans1, trans2, 1e-6); diff --git a/octave_packages/geometry-1.5.0/geom2d/createScaling.m b/octave_packages/geometry-1.5.0/geom2d/createScaling.m new file mode 100644 index 0000000..80ec3bd --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/createScaling.m @@ -0,0 +1,106 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{T} = } createScaling (@var{s}) +%% @deftypefnx {Function File} {@var{T} = } createScaling (@var{sx}, @var{sy}) +%% Create the 3x3 matrix of a scaling in 2 dimensions. +% +% Assume scaling @var{s} is equal n all directions unless @var{sx} and @var{sy} are given. +% Returns the matrix corresponding to scaling in the 2 main directions. +% The returned matrix has the form: +% [SX 0 0] +% [0 SY 0] +% [0 0 1] +% +% @seealso{transforms2d, transformPoint, createTranslation, createRotation} +%% @end deftypefn + +function trans = createScaling(varargin) + + % defined default arguments + sx = 1; + sy = 1; + cx = 0; + cy = 0; + + % process input arguments + if length(varargin)==1 + % the argument is either the scaling factor in both direction, + % or a 1x2 array containing scaling factor in each direction + var = varargin{1}; + sx = var(1); + sy = var(1); + if length(var)>1 + sy = var(2); + end + elseif length(varargin)==2 + % the 2 arguments are the scaling factors in each dimension + sx = varargin{1}; + sy = varargin{2}; + elseif length(varargin)==3 + % first argument is center, 2nd and 3d are scaling factors + center = varargin{1}; + cx = center(1); + cy = center(2); + sx = varargin{2}; + sy = varargin{3}; + end + + % create result matrix + trans = [sx 0 cx*(1-sx); 0 sy cy*(1-sy); 0 0 1]; + +endfunction + +%!test +%! trans = createScaling(2); +%! assert (trans, [2 0 0;0 2 0;0 0 1], 1e-6); + +%!test +%! trans = createScaling(2, 3); +%! assert (trans, [2 0 0;0 3 0;0 0 1], 1e-6); + +%!test +%! trans = createScaling([2 3]); +%! assert (trans, [2 0 0;0 3 0;0 0 1], 1e-6); + +%!test +%! sx = 2; +%! sy = 3; +%! p0 = [4 5]; +%! trans1 = createScaling(p0, sx, sy); +%! t1 = createTranslation(-p0); +%! sca = createScaling(sx, sy); +%! t2 = createTranslation(p0); +%! trans2 = t2*sca*t1; +%! assert (trans1, trans2, 1e-6); diff --git a/octave_packages/geometry-1.5.0/geom2d/createTranslation.m b/octave_packages/geometry-1.5.0/geom2d/createTranslation.m new file mode 100644 index 0000000..8046cc8 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/createTranslation.m @@ -0,0 +1,71 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{T} = } createTranslation (@var{vector}) +%% @deftypefnx {Function File} {@var{T} = } createTranslation (@var{dx},@var{dy}) +%% Create the 3*3 matrix of a translation. +%% +%% Returns the matrix corresponding to a translation by the vector [@var{dx} @var{dy}]. +%% The components can be given as two arguments. +%% The returned matrix has the form : +%% [1 0 TX] +%% [0 1 TY] +%% [0 0 1] +%% +%% @seealso{transforms2d, transformPoint, createRotation, createScaling} +%% @end deftypefn + +function trans = createTranslation(varargin) + + % process input arguments + if isempty(varargin) + tx = 0; + ty = 0; + elseif length(varargin)==1 + var = varargin{1}; + tx = var(1); + ty = var(2); + else + tx = varargin{1}; + ty = varargin{2}; + end + + % create the matrix representing the translation + trans = [1 0 tx ; 0 1 ty ; 0 0 1]; + +endfunction + +%!test +%! trans = createTranslation(2, 3); +%! assert (trans, [1 0 2;0 1 3;0 0 1], 1e-6); diff --git a/octave_packages/geometry-1.5.0/geom2d/createVector.m b/octave_packages/geometry-1.5.0/geom2d/createVector.m new file mode 100644 index 0000000..c63902d --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/createVector.m @@ -0,0 +1,54 @@ +%% Copyright (c) 2011, INRA +%% 2010-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{vect} = } createVector (@var{p1}, @var{p2}) +%% Create a vector from two points. +%% +%% V12 = createVector(P1, P2) +%% Creates the vector V12, defined as the difference between coordinates +%% of points P1 and P2. +%% P1 and P2 are row vectors with ND elements, ND being the space +%% dimension. +%% +%% If one of the inputs is a N-by-Nd array, the other input is +%% automatically repeated, and the result is N-by-Nd. +%% +%% If both inputs have the same size, the result also have the same size. +%% +%% @seealso{vectors2d, vectors3d, points2d} +%% @end deftypefn +function vect = createVector(p1, p2) + vect = bsxfun(@minus, p2, p1); +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/deg2rad.m b/octave_packages/geometry-1.5.0/geom2d/deg2rad.m new file mode 100644 index 0000000..4b19163 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/deg2rad.m @@ -0,0 +1,58 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{rad} =} deg2rad(@var{deg}) +%% Convert angle from degrees to radians +%% +%% Usage: +%% R = deg2rad(D) +%% convert an angle in degrees to an angle in radians. +%% +%% Example +%% deg2rad(180) % gives pi +%% ans = +%% 3.1416 +%% deg2rad(60) % gives pi/3 +%% ans = +%% 1.0472 +%% +%% @seealso{angles2d, rad2deg} +%% @end deftypefn + +function rad = deg2rad(deg) + + rad = deg*pi/180; + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/distancePointEdge.m b/octave_packages/geometry-1.5.0/geom2d/distancePointEdge.m new file mode 100644 index 0000000..4401578 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/distancePointEdge.m @@ -0,0 +1,133 @@ +%% Copyright (c) 2007-2011, David Legland +%% Copyright (c) 2012, Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{dist} = } distancePointEdge (@var{point}, @var{edge}) +%% @deftypefnx {Function File} {@var{dist} = } distancePointEdge (@dots{}, @var{opt}) +%% @deftypefnx {Function File} {[@var{dist} @var{pos}]= } distancePointEdge (@dots{}) +%% Minimum distance between a point and an edge +%% +%% Return the euclidean distance between edge @var{edge} and point @var{point}. +%% @var{edge} has the form: [x1 y1 x2 y2], and @var{point} is [x y]. +%% If @var{edge} is Ne-by-4 and @var{point} is Np-by-2, then @var{dist} is +%% Np-by-Ne, where each row contains the distance of each point to all the edges. +%% +%% If @var{opt} is true (or equivalent), the optput is cmpatible with the original function: +%% @table @samp +%% @item 1 +%% If @var{point} is 1-by-2 array, the result is Ne-by-1 array computed for each edge. +%% @item 2 +%% If @var{edge} is a 1-by-4 array, the result is Np-by-1 computed for each point. +%% @item 3 +%% If both @var{point} and @var{edge} are array, they must have the same number of +%% rows, and the result is computed for each couple @code{@var{point}(i,:),@var{edge}(i,:)}. +%% @end table +%% +%% If the the second output argument @var{pos} is requested, the function also +%% returns the position of closest point on the edge. @var{pos} is comprised +%% between 0 (first point) and 1 (last point). +%% +%% @seealso{edges2d, points2d, distancePoints, distancePointLine} +%% @end deftypefn + +%% Rewritten to accept different numbers of points and edges. +%% 2012 - Juan Pablo Carbajal + +function [dist, tp] = distancePointEdge(point, edge, opt=[]) + + Np = size (point,1); + Ne = size (edge,1); + edge = edge.'; + + % direction vector of each edge + dx = edge(3,:) - edge(1,:); + dy = edge(4,:) - edge(2,:); + + % compute position of points projected on the supporting line + % (Size of tp is the max number of edges or points) + + delta = dx .* dx + dy .* dy; + mask = delta < eps; + delta(mask) = 1; + warning ('off', 'Octave:broadcast'); + tp = ((point(:, 1) - edge(1, :)) .* dx + (point(:, 2) - edge(2, :)) .* dy) ./ delta; + tp(:,mask) = 0; + + % change position to ensure projected point is located on the edge + tp(tp < 0) = 0; + tp(tp > 1) = 1; + + % coordinates of projected point + p0x = (edge(1,:) + tp .* dx); + p0y = (edge(2,:) + tp .* dy); + + % compute distance between point and its projection on the edge + dist = sqrt((point(:,1) - p0x) .^ 2 + (point(:,2) - p0y) .^ 2); + + warning ('on', 'Octave:broadcast'); + + %% backwards compatibility + if opt + if Np != Ne && (Ne != 1 && Np !=1) + error ("geometry:InvalidArgument", ... + "Sizes must be equal or one of the inputs must be 1-by-N array."); + end + if Np == Ne + dist = diag(dist)(:); + tp = diag(tp)(:); + elseif Np == 1 + dist = dist.'; + tp = tp.'; + end + end + +endfunction + +%% Original code +%%tp = ((point(:, 1) - edge(:, 1)) .* dx + (point(:, 2) - edge(:, 2)) .* dy) ./ delta; +%%% ensure degenerated edges are correclty processed (consider the first +%%% vertex is the closest) +%%if Ne > 1 +%% tp(delta < eps) = 0; +%%elseif delta < eps +%% tp(:) = 0; +%%end + +%%% change position to ensure projected point is located on the edge +%%tp(tp < 0) = 0; +%%tp(tp > 1) = 1; + +%%% coordinates of projected point +%%p0 = [edge(:,1) + tp .* dx, edge(:,2) + tp .* dy]; + +%%% compute distance between point and its projection on the edge +%%dist = sqrt((point(:,1) - p0(:,1)) .^ 2 + (point(:,2) - p0(:,2)) .^ 2); diff --git a/octave_packages/geometry-1.5.0/geom2d/distancePointLine.m b/octave_packages/geometry-1.5.0/geom2d/distancePointLine.m new file mode 100644 index 0000000..604dc29 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/distancePointLine.m @@ -0,0 +1,77 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{dist} = } distancePointLine (@var{point}, @var{line}) +%% Minimum distance between a point and a line +%% +%% D = distancePointLine(POINT, LINE) +%% Return the euclidean distance between line LINE and point POINT. +%% +%% LINE has the form : [x0 y0 dx dy], and POINT is [x y]. +%% +%% If LINE is N-by-4 array, result is N-by-1 array computes for each line. +%% +%% If POINT is N-by-2, then result is computed for each point. +%% +%% If both POINT and LINE are array, result is N-by-1, computed for each +%% corresponding point and line. +%% +%% +%% @seealso{lines2d, points2d, distancePoints, distancePointEdge} +%% @end deftypefn + +function dist = distancePointLine(point, line) + + if size(line, 1)==1 && size(point, 1)>1 + line = repmat(line, [size(point, 1) 1]); + end + + if size(point, 1)==1 && size(line, 1)>1 + point = repmat(point, [size(line, 1) 1]); + end + + dx = line(:, 3); + dy = line(:, 4); + + % compute position of points projected on line + tp = ((point(:, 2) - line(:, 2)).*dy + (point(:, 1) - line(:, 1)).*dx) ./ (dx.*dx+dy.*dy); + p0 = line(:, 1:2) + [tp tp].*[dx dy]; + + + % compute distances between points and their projections + dx = point - p0; + dist = sqrt(sum(dx.*dx, 2)); + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/distancePoints.m b/octave_packages/geometry-1.5.0/geom2d/distancePoints.m new file mode 100644 index 0000000..adb0866 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/distancePoints.m @@ -0,0 +1,204 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{d} = } distancePoints (@var{p1}, @var{p2}) +%% @deftypefnx {Function File} {@var{d} = } distancePoints (@var{p1}, @var{p2}, @var{norm}) +%% @deftypefnx {Function File} {@var{d} = } distancePoints (@dots{}, 'diag') +%% Compute distance between two points. +%% +%% Returns the Euclidean distance between points @var{p1} and @var{p2}. +%% If @var{p1} and @var{p2} are two arrays of points, result is a N1xN2 array +%% containing distance between each point of @var{p1} and each point of @var{p2}. +%% +%% Is @var{norm} is given, computes distance using the specified norm. @var{norm}=2 corresponds to usual +%% euclidean distance, @var{norm}=1 corresponds to Manhattan distance, @var{norm}=inf +%% is assumed to correspond to maximum difference in coordinate. Other +%% values (>0) can be specified. +%% +%% When 'diag' is given, computes only distances between @var{p1}(i,:) and @var{p2}(i,:). +%% +%% @seealso{points2d, minDistancePoints} +%% @end deftypefn + +function dist = distancePoints(p1, p2, varargin) + + %% Setup options + + % default values + diag = false; + norm = 2; + + % check first argument: norm or diag + if ~isempty(varargin) + var = varargin{1}; + if isnumeric(var) + norm = var; + elseif strncmp('diag', var, 4) + diag = true; + end + varargin(1) = []; + end + + % check last argument: diag + if ~isempty(varargin) + var = varargin{1}; + if strncmp('diag', var, 4) + diag = true; + end + end + + + % number of points in each array and their dimension + n1 = size(p1, 1); + n2 = size(p2, 1); + d = size(p1, 2); + + if diag + % compute distance only for apparied couples of pixels + dist = zeros(n1, 1); + if norm==2 + % Compute euclidian distance. this is the default case + % Compute difference of coordinate for each pair of point + % and for each dimension. -> dist is a [n1*n2] array. + for i=1:d + dist = dist + (p2(:,i)-p1(:,i)).^2; + end + dist = sqrt(dist); + elseif norm==inf + % infinite norm corresponds to maximal difference of coordinate + for i=1:d + dist = max(dist, abs(p2(:,i)-p1(:,i))); + end + else + % compute distance using the specified norm. + for i=1:d + dist = dist + power((abs(p2(:,i)-p1(:,i))), norm); + end + dist = power(dist, 1/norm); + end + else + % compute distance for all couples of pixels + dist = zeros(n1, n2); + if norm==2 + % Compute euclidian distance. this is the default case + % Compute difference of coordinate for each pair of point + % and for each dimension. -> dist is a [n1*n2] array. + for i=1:d + % equivalent to: + % dist = dist + ... + % (repmat(p1(:,i), [1 n2])-repmat(p2(:,i)', [n1 1])).^2; + dist = dist + (p1(:, i*ones(1, n2))-p2(:, i*ones(n1, 1))').^2; + end + dist = sqrt(dist); + elseif norm==inf + % infinite norm corresponds to maximal difference of coordinate + for i=1:d + dist = max(dist, abs(p1(:, i*ones(1, n2))-p2(:, i*ones(n1, 1))')); + end + else + % compute distance using the specified norm. + for i=1:d + % equivalent to: + % dist = dist + power((abs(repmat(p1(:,i), [1 n2]) - ... + % repmat(p2(:,i)', [n1 1]))), norm); + dist = dist + power((abs(p1(:, i*ones(1, n2))-p2(:, i*ones(n1, 1))')), norm); + end + dist = power(dist, 1/norm); + end + end + +endfunction + +%!shared pt1,pt2,pt3,pt4 +%! pt1 = [10 10]; +%! pt2 = [10 20]; +%! pt3 = [20 20]; +%! pt4 = [20 10]; + +%!assert (distancePoints(pt1, pt2), 10, 1e-6); +%!assert (distancePoints(pt2, pt3), 10, 1e-6); +%!assert (distancePoints(pt1, pt3), 10*sqrt(2), 1e-6); +%!assert (distancePoints(pt1, pt2, 1), 10, 1e-6); +%!assert (distancePoints(pt2, pt3, 1), 10, 1e-6); +%!assert (distancePoints(pt1, pt3, 1), 20, 1e-6); +%!assert (distancePoints(pt1, pt2, inf), 10, 1e-6); +%!assert (distancePoints(pt2, pt3, inf), 10, 1e-6); +%!assert (distancePoints(pt1, pt3, inf), 10, 1e-6); +%!assert (distancePoints(pt1, [pt1; pt2; pt3]), [0 10 10*sqrt(2)], 1e-6); + +%!test +%! array1 = [pt1;pt2;pt3]; +%! array2 = [pt1;pt2;pt3;pt4]; +%! res = [0 10 10*sqrt(2) 10; 10 0 10 10*sqrt(2); 10*sqrt(2) 10 0 10]; +%! assert (distancePoints(array1, array2), res, 1e-6); +%! assert (distancePoints(array2, array2, 'diag'), [0;0;0;0], 1e-6); + +%!test +%! array1 = [pt1;pt2;pt3]; +%! array2 = [pt2;pt3;pt1]; +%! assert (distancePoints(array1, array2, inf, 'diag'), [10;10;10], 1e-6); + +%!shared pt1,pt2,pt3,pt4 +%! pt1 = [10 10 10]; +%! pt2 = [10 20 10]; +%! pt3 = [20 20 10]; +%! pt4 = [20 20 20]; + +%!assert (distancePoints(pt1, pt2), 10, 1e-6); +%!assert (distancePoints(pt2, pt3), 10, 1e-6); +%!assert (distancePoints(pt1, pt3), 10*sqrt(2), 1e-6); +%!assert (distancePoints(pt1, pt4), 10*sqrt(3), 1e-6); +%!assert (distancePoints(pt1, pt2, inf), 10, 1e-6); +%!assert (distancePoints(pt2, pt3, inf), 10, 1e-6); +%!assert (distancePoints(pt1, pt3, inf), 10, 1e-6); +%!assert (distancePoints(pt1, pt4, inf), 10, 1e-6); + + +%!shared pt1,pt2,pt3,pt4 +%! pt1 = [10 10 30]; +%! pt2 = [10 20 30]; +%! pt3 = [20 20 30]; +%! pt4 = [20 20 40]; + +%!assert (distancePoints(pt1, pt2, 1), 10, 1e-6); +%!assert (distancePoints(pt2, pt3, 1), 10, 1e-6); +%!assert (distancePoints(pt1, pt3, 1), 20, 1e-6); +%!assert (distancePoints(pt1, pt4, 1), 30, 1e-6); + +%!test +%! array1 = [pt1;pt2;pt3]; +%! array2 = [pt2;pt3;pt1]; +%! assert (distancePoints(array1, array2, 'diag'), [10;10;10*sqrt(2)], 1e-6); +%! assert (distancePoints(array1, array2, 1, 'diag'), [10;10;20], 1e-6); + diff --git a/octave_packages/geometry-1.5.0/geom2d/doc-cache b/octave_packages/geometry-1.5.0/geom2d/doc-cache new file mode 100644 index 0000000..16926b6 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/doc-cache @@ -0,0 +1,5081 @@ +# Created by Octave 3.6.2, Sun Jun 10 09:53:43 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 117 +# name: +# type: sq_string +# elements: 1 +# length: 12 +angle2Points + + +# name: +# type: sq_string +# elements: 1 +# length: 411 + -- Function File: ALPHA = angle2Points (P1, P2) + Compute horizontal angle between 2 points + + P1 and P2 are either [1x2] arrays, or [Nx2] arrays, in this case + ALPHA is a [Nx1] array. The angle computed is the horizontal angle + of the line (P1,P2). + + Result is always given in radians, between 0 and 2*pi. + + See also: points2d, angles2d, angle3points, normalizeAngle, + vectorAngle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 +Compute horizontal angle between 2 points + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +angle3Points + + +# name: +# type: sq_string +# elements: 1 +# length: 410 + -- Function File: ALPHA = angle3Points (P1, P2, P3) + Computes the angle between the points P1, P2 and P3. + + P1, P2 and P3 are either [1x2] arrays, or [Nx2] arrays, in this + case ALPHA is a [Nx1] array. The angle computed is the directed + angle between line (P2P1) and line (P2P3). + + Result is always given in radians, between 0 and 2*pi. + + See also: points2d, angles2d, angle2points + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +Computes the angle between the points P1, P2 and P3. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +angleAbsDiff + + +# name: +# type: sq_string +# elements: 1 +# length: 323 + -- Function File: DIF = angleAbsDiff (ANGLE1, ANGLE2) + Computes the absolute angular difference between two angles in + radians. The result is comprised between 0 and pi. + + A = angleAbsDiff(pi/2, pi/3) + A = + 0.5236 % equal to pi/6 + + See also: angles2d, angleDiff + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +Computes the absolute angular difference between two angles in radians. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +angleDiff + + +# name: +# type: sq_string +# elements: 1 +# length: 421 + -- Function File: DIF = angleDiff (ANGLE1, ANGLE2) + Difference between two angles + + Computes the signed angular difference between two angles in + radians. The result is comprised between -PI and +PI. + + Example A = angleDiff(-pi/4, pi/4) A = 1.5708 % + equal to pi/2 A = angleDiff(pi/4, -pi/4) A = + -1.5708 % equal to -pi/2 + + See also: angles2d, angleAbsDiff + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Difference between two angles + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +angleSort + + +# name: +# type: sq_string +# elements: 1 +# length: 665 + -- Function File: varargout = angleSort (PTS, varargin) + Sort points in the plane according to their angle to origin + + PTS2 = angleSort(PTS); Computes angle of points with origin, and + sort points with increasing angles in Counter-Clockwise + direction. + + PTS2 = angleSort(PTS, PTS0); Computes angles between each point + of PTS and PT0, which can be different from origin. + + PTS2 = angleSort(..., THETA0); Specifies the starting angle for + sorting. + + [PTS2, I] = angleSort(...); Also returns in I the indices of + PTS, such that PTS2 = PTS(I, :); + + See also: points2d, angles2d, angle2points, normalizeAngle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 +Sort points in the plane according to their angle to origin + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +angles2d + + +# name: +# type: sq_string +# elements: 1 +# length: 620 + -- Function File: angles2d () + Description of functions for manipulating angles + + Angles are normalized in an interval of width 2*PI. Most geom2d + functions return results in the [0 2*pi] interval, but it can be + convenient to consider the [-pi pi] interval as well. See the + normalizeAngle function to switch between conventions. + + Angles are usually oriented. The default orientation is the CCW + (Counter-Clockwise) orientation. + + See also: angle2Points, angle3Points, angleAbsDiff, + normalizeAngle, vectorAngle, angleDiff, angleSort, lineAngle, + edgeAngle, deg2rad, rad2deg + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Description of functions for manipulating angles + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +beltproblem + + +# name: +# type: sq_string +# elements: 1 +# length: 1316 + -- Function File: [TANGENT,INNER] = beltproblem (C, R) + Finds the four lines tangent to two circles with given centers and + radii. + + The function solves the belt problem in 2D for circles with center + C and radii R. + + *INPUT* + C + 2-by-2 matrix containig coordinates of the centers of the + circles; one row per circle. + + R + 2-by-1 vector with the radii of the circles. + + *OUPUT* + TANGENT + 4-by-4 matrix with the points of tangency. Each row describes + a segment(edge). + + INNER + 4-by-2 vector with the point of intersection of the inner + tangents (crossed belts) with the segment that joins the + centers of the two circles. If the i-th edge is not an inner + tangent then `inner(i,:)=[NaN,NaN]'. + + Example: + + c = [0 0;1 3]; + r = [1 0.5]; + [T inner] = beltproblem(c,r) + => T = + -0.68516 0.72839 1.34258 2.63581 + 0.98516 0.17161 0.50742 2.91419 + 0.98675 -0.16225 1.49338 2.91888 + -0.88675 0.46225 0.55663 3.23112 + + => inner = + 0.66667 2.00000 + 0.66667 2.00000 + NaN NaN + NaN NaN + + See also: edges2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 +Finds the four lines tangent to two circles with given centers and +radii. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +bisector + + +# name: +# type: sq_string +# elements: 1 +# length: 474 + -- Function File: RAY = bisector (LINE1, LINE2) + -- Function File: RAY = bisector (P1, P2, P3) + Return the bisector of two lines, or 3 points. + + Creates the bisector of the two lines, given as [x0 y0 dx dy]. + + create the bisector of lines (P2 P1) and (P2 P3). + + The result has the form [x0 y0 dx dy], with [x0 y0] being the + origin point ans [dx dy] being the direction vector, normalized + to have unit norm. + + See also: lines2d, rays2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Return the bisector of two lines, or 3 points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +boxes2d + + +# name: +# type: sq_string +# elements: 1 +# length: 401 + -- Function File: boxes2d () + Description of functions operating on bounding boxes. + + A box is represented as a set of limits in each direction: + BOX = [XMIN XMAX YMIN YMAX]. + Boxes are used as result of computation for bounding boxes, and to + clip shapes. + + See also: clipPoints, clipLine, clipEdge, clipRay, mergeBoxes, + intersectBoxes, randomPointInBox, drawBox + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Description of functions operating on bounding boxes. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +cartesianLine + + +# name: +# type: sq_string +# elements: 1 +# length: 234 + -- Function File: LINE = cartesianLine (A, B,C) + Create a straight line from cartesian equation coefficients. + + Create a line verifying the Cartesian equation: A*x + B*x + C = + 0; + + See also: lines2d, createLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 +Create a straight line from cartesian equation coefficients. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +cbezier2poly + + +# name: +# type: sq_string +# elements: 1 +# length: 1289 + -- Function File: PP = cbezier2poly (POINTS) + -- Command: Function File [X Y] = cbezier2poly (POINTS,T) + Returns the polynomial representation of the cubic Bezier defined + by the control points POINTS. + + With only one input argument, calculates the polynomial PP of the + cubic Bezier curve defined by the 4 control points stored in + POINTS. The first point is the inital point of the curve. The + segment joining the first point with the second point (first + center) defines the tangent of the curve at the initial point. + The segment that joints the third point (second center) with the + fourth defines the tanget at the end-point of the curve, which is + defined in the fourth point. POINTS is either a 4-by-2 array + (vertical concatenation of point coordinates), or a 1-by-8 array + (horizotnal concatenation of point coordinates). PP is a 2-by-3 + array, 1st row is the polynomial for the x-coordinate and the 2nd + row for the y-coordinate. Each row can be evaluated with + `polyval'. The polynomial PP(t) is defined for t in [0,1]. + + When called with a second input argument T, it returns the + coordinates X and Y corresponding to the polynomial evaluated at T + in [0,1]. + + See also: drawBezierCurve, polyval + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Returns the polynomial representation of the cubic Bezier defined by +the control + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +centroid + + +# name: +# type: sq_string +# elements: 1 +# length: 889 + -- Function File: C = centroid (POINTS) + -- Function File: C = centroid (PX, PY) + -- Function File: C = centroid (..., MASS) + Compute centroid (center of mass) of a set of points. + + Computes the ND-dimensional centroid of a set of points. POINTS + is an array with as many rows as the number of points, and as + many columns as the number of dimensions. PX and PY are two + column vectors containing coordinates of the 2-dimensional + points. The result C is a row vector with ND columns. + + If MASS is given, computes center of mass of POINTS, weighted by + coefficient MASS. POINTS is a Np-by-Nd array, MASS is Np-by-1 + array, and PX and PY are also both Np-by-1 arrays. + + Example: + + pts = [2 2;6 1;6 5;2 4]; + centroid(pts) + ans = + 4 3 + + See also: points2d, polygonCentroid + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Compute centroid (center of mass) of a set of points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +circleArcAsCurve + + +# name: +# type: sq_string +# elements: 1 +# length: 783 + -- Function File: P = circleArcAsCurve (ARC, N) + Convert a circle arc into a series of points + + P = circleArcAsCurve(ARC, N); convert the circle ARC into a + series of N points. ARC is given in the format: [XC YC R THETA1 + DTHETA] where XC and YC define the center of the circle, R its + radius, THETA1 is the start of the arc and DTHETA is the angle + extent of the arc. Both angles are given in degrees. N is the + number of vertices of the resulting polyline, default is 65. + + The result is a N-by-2 array containing coordinates of the N + points. + + [X Y] = circleArcAsCurve(ARC, N); Return the result in two + separate arrays with N lines and 1 column. + + See also: circles2d, circleAsPolygon, drawCircle, drawPolygon + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Convert a circle arc into a series of points + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +circleAsPolygon + + +# name: +# type: sq_string +# elements: 1 +# length: 572 + -- Function File: P = circleAsPolygon (CIRCLE, N) + Convert a circle into a series of points + + P = circleAsPolygon(CIRCLE, N); convert circle given as [x0 y0 + r], where x0 and y0 are coordinate of center, and r is the + radius, into an array of [(N+1)x2] double, containing x and y + values of points. The polygon is closed + + P = circleAsPolygon(CIRCLE); uses a default value of N=64 points + + Example circle = circleAsPolygon([10 0 5], 16); figure; + drawPolygon(circle); + + See also: circles2d, polygons2d, createCircle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +Convert a circle into a series of points + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +circles2d + + +# name: +# type: sq_string +# elements: 1 +# length: 925 + -- Function File: circles2d () + Description of functions operating on circles + + Circles are represented by their center and their radius: C = + [xc yc r]; One sometimes considers orientation of circle, by + adding an extra boolean value in 4-th position, with value TRUE + for direct (i.e. turning Counter-clockwise) circles. + + Circle arcs are represented by their center, their radius, the + starting angle and the angle extent, both in degrees: CA = [xc + yc r theta0 dtheta]; + + Ellipses are represented by their center, their 2 semi-axis + length, and their angle (in degrees) with Ox direction. E = + [xc yc A B theta]; + + See also: ellipses2d, createCircle, createDirectedCircle, + enclosingCircle isPointInCircle, isPointOnCircle + intersectLineCircle, intersectCircles, radicalAxis + circleAsPolygon, circleArcAsCurve drawCircle, drawCircleArc + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Description of functions operating on circles + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +clipEdge + + +# name: +# type: sq_string +# elements: 1 +# length: 408 + -- Function File: EDGE2 = clipEdge (EDGE, BOX) + Clip an edge with a rectangular box. + + EDGE: [x1 y1 x2 y2], BOX : [xmin xmax ; ymin ymax] or [xmin xmax + ymin ymax]; return : EDGE2 = [xc1 yc1 xc2 yc2]; + + If clipping is null, return [0 0 0 0]; + + if EDGE is a [nx4] array, return an [nx4] array, corresponding to + each clipped edge. + + See also: edges2d, boxes2d, clipLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Clip an edge with a rectangular box. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +clipLine + + +# name: +# type: sq_string +# elements: 1 +# length: 910 + -- Function File: EDGE = clipLine (LINE, BOX) + Clip a line with a box. + + LINE is a straight line given as a 4 element row vector: [x0 y0 dx + dy], with (x0 y0) being a point of the line and (dx dy) a + direction vector, BOX is the clipping box, given by its extreme + coordinates: [xmin xmax ymin ymax]. The result is given as an + edge, defined by the coordinates of its 2 extreme points: [x1 y1 + x2 y2]. If line does not intersect the box, [NaN NaN NaN NaN] + is returned. + + Function works also if LINE is a Nx4 array, if BOX is a Nx4 array, + or if both LINE and BOX are Nx4 arrays. In these cases, EDGE is + a Nx4 array. + + Example: + + line = [30 40 10 0]; + box = [0 100 0 100]; + res = clipLine(line, box) + res = + 0 40 100 40 + + See also: lines2d, boxes2d, edges2d, clipEdge, clipRay + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 23 +Clip a line with a box. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +clipPoints + + +# name: +# type: sq_string +# elements: 1 +# length: 218 + -- Function File: POINTS2 = clipPoints (POINTS, BOX) + Clip a set of points by a box. + + Returns the set POINTS2 which are located inside of the box BOX. + + See also: points2d, boxes2d, clipLine, drawPoint + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Clip a set of points by a box. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +clipRay + + +# name: +# type: sq_string +# elements: 1 +# length: 752 + -- Function File: [EDGE INSIDE] = clipRay (RAY, BOX) + Clip a ray with a box. + + RAY is a straight ray given as a 4 element row vector: [x0 y0 dx + dy], with (x0 y0) being the origin of the ray and (dx dy) its + direction vector, BOX is the clipping box, given by its extreme + coordinates: [xmin xmax ymin ymax]. The result is given as an + edge, defined by the coordinates of its 2 extreme points: [x1 y1 + x2 y2]. If the ray does not intersect the box, [NaN NaN NaN + NaN] is returned. + + Function works also if RAY is a Nx4 array, if BOX is a Nx4 array, + or if both RAY and BOX are Nx4 arrays. In these cases, EDGE is a + Nx4 array. + + See also: rays2d, boxes2d, edges2d, clipLine, drawRay + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +Clip a ray with a box. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +closed_path + + +# name: +# type: sq_string +# elements: 1 +# length: 173 + -- Function File: Y = polygon (X) + Returns a simple closed path that passes through all the points in + X. X is a vector containing 2D coordinates of the points. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +Returns a simple closed path that passes through all the points in X. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +cov2ellipse + + +# name: +# type: sq_string +# elements: 1 +# length: 686 + -- Function File: ELLIPSE = cov2ellipse (K) + -- Function File: [RA RB THETA] = cov2ellipse (K) + -- Function File: ... = cov2ellipse (..., `tol',TOL) + Calculates ellipse parameters from covariance matrix. + + K must be symmetric positive (semi)definite. The optional argument + `tol' sets the tolerance for the verification of the + positive-(semi)definiteness of the matrix K (see `isdefinite'). + + If only one output argument is supplied a vector defining a + ellipse is returned as defined in `ellipses2d'. Otherwise the + angle THETA is given in radians. + + Run `demo cov2ellipse' to see an example. + + See also: ellipses2d, cov2ellipse, drawEllipse + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Calculates ellipse parameters from covariance matrix. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +crackPattern + + +# name: +# type: sq_string +# elements: 1 +# length: 909 + -- Function File: E = crackPattern (BOX, POINTS, ALPHA) + Create a (bounded) crack pattern tessellation + + E = crackPattern2(BOX, POINTS, ALPHA) create a crack propagation + pattern wit following parameters : - pattern is bounded by area + BOX which is a polygon. - each crack originates from points + given in POINTS - directions of each crack is given by a [NxM] + array ALPHA, where M is the number of rays emanating from each + seed/ - a crack stop when it reaches another already created + crack. - all cracks stop when they reach the border of the + frame, given by box (a serie of 4 points). The result is a + collection of edges, in the form [x1 y1 x2 y2]. + + E = crackPattern2(BOX, POINTS, ALPHA, SPEED) Also specify speed + of propagation of each crack. + + See the result with : figure; drawEdge(E); + + See also: drawEdge + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Create a (bounded) crack pattern tessellation + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +crackPattern2 + + +# name: +# type: sq_string +# elements: 1 +# length: 910 + -- Function File: E = crackPattern2 (BOX, POINTS, ALPHA) + Create a (bounded) crack pattern tessellation + + E = crackPattern2(BOX, POINTS, ALPHA) create a crack propagation + pattern wit following parameters : - pattern is bounded by area + BOX which is a polygon. - each crack originates from points + given in POINTS - directions of each crack is given by a [NxM] + array ALPHA, where M is the number of rays emanating from each + seed/ - a crack stop when it reaches another already created + crack. - all cracks stop when they reach the border of the + frame, given by box (a serie of 4 points). The result is a + collection of edges, in the form [x1 y1 x2 y2]. + + E = crackPattern2(BOX, POINTS, ALPHA, SPEED) Also specify speed + of propagation of each crack. + + See the result with : figure; drawEdge(E); + + See also: drawEdge + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Create a (bounded) crack pattern tessellation + + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +createBasisTransform + + +# name: +# type: sq_string +# elements: 1 +# length: 1405 + -- Function File: T = createBasisTransfrom (TARGET) + -- Function File: T = createBasisTransfrom (SOURCE, TARGET) + Compute matrix for transforming a basis into another basis + + With only one input arguemnt, assumes the SOURCE is the standard + (Oij) basis, with origin at (0,0), first direction vector equal + to (1,0) and second direction vector equal to (0,1). Otherwise + SOURCE specifies the SOURCE basis. + + Both SOURCE and TARGET represent basis, in the following form: + [x0 y0 ex1 ey1 ex2 ey2] [y0 y0] is the origin of the basis, + [ex1 ey1] is the first direction vector, and [ex2 ey2] is the + second direction vector. + + The result T is a 3-by-3 matrix such that a point expressed with + coordinates of the first basis will be represented by new + coordinates `P2 = transformPoint(P1, T)' in the TARGET basis. + + Example + % standard basis transform + src = [0 0 1 0 0 1]; + % TARGET transform, just a rotation by atan(2/3) followed by a scaling + tgt = [0 0 .75 .5 -.5 .75]; + % compute transform + trans = createBasisTransform(src, tgt); + % transform the point (.25,1.25) into the point (1,1) + p1 = [.25 1.25]; + p2 = transformPoint(p1, trans) + ans = + 1 1 + + See also: transforms2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 +Compute matrix for transforming a basis into another basis + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +createCircle + + +# name: +# type: sq_string +# elements: 1 +# length: 881 + -- Function File: CIRCLE = createCircle (P1, P2, P3) + -- Function File: CIRCLE = createCircle (P1, P2) + Create a circle from 2 or 3 points. + + Creates the circle passing through the 3 given points. C is a + 1x3 array of the form: [XC YX R]. + + When two points are given, creates the circle whith center P1 and + passing throuh the point P2. + + Works also when input are point arrays the same size, in this case + the result has as many lines as the point arrays. + + Example + + % Draw a circle passing through 3 points. + p1 = [10 15]; + p2 = [15 20]; + p3 = [10 25]; + circle = createCircle(p1, p2, p3); + figure; hold on; axis equal; axis([0 50 0 50]); + drawPoint([p1 ; p2; p3]); + drawCircle(circle); + + See also: circles2d, createDirectedCircle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Create a circle from 2 or 3 points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +createDirectedCircle + + +# name: +# type: sq_string +# elements: 1 +# length: 569 + -- Function File: CIRCLE = createDirectedCircle (P1, P2, P3) + -- Function File: CIRCLE = createDirectedCircle (P1, P2) + Create a circle from 2 or 3 points. + + Creates the circle passing through the 3 given points. C is a + 1x4 array of the form: [XC YX R INV]. + + When two points are given, creates the circle whith center P1 and + passing throuh the point P2. + + Works also when input are point arrays the same size, in this case + the result has as many lines as the point arrays. + + Example + + See also: circles2d, createCircle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Create a circle from 2 or 3 points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +createEdge + + +# name: +# type: sq_string +# elements: 1 +# length: 1092 + -- Function File: EDGE = createEdge (P1, P2) + -- Function File: EDGE = createEdge (X0, Y0, DX, DY) + -- Function File: EDGE = createEdge (PARAM) + -- Function File: EDGE = createEdge (LINE, D) + Create an edge between two points, or from a line. + + The internal format for edge representation is given by + coordinates of two points : [x1 y1 x2 y2]. This function can + serve as a line to edge converter. + + Returns the edge between the two given points P1 and P2. + + Returns the edge going through point (X0, Y0) and with direction + vector (DX,DY). + + When PARAM is an array of 4 values, creates the edge going through + the point (param(1) param(2)), and with direction vector given by + (param(3) param(4)). + + When LINE is given, creates the edge contained in LINE, with same + direction and start point, but with length given by D. + + Note: in all cases, parameters can be vertical arrays of the same + dimension. The result is then an array of edges, of dimensions + [N*4]. + + See also: edges2d, lines2d, drawEdge, clipEdge + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Create an edge between two points, or from a line. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +createHomothecy + + +# name: +# type: sq_string +# elements: 1 +# length: 245 + -- Function File: T = createHomothecy (POINT, RATIO) + Create the the 3x3 matrix of an homothetic transform. + + POINT is the center of the homothecy, RATIO is its factor. + + See also: transforms2d, transformPoint, createTranslation + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Create the the 3x3 matrix of an homothetic transform. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +createLine + + +# name: +# type: sq_string +# elements: 1 +# length: 2358 + -- Function File: LINE = createLine(varargin) + Create a straight line from 2 points, or from other inputs + + Line is represented in a parametric form : [x0 y0 dx dy] x = x0 + + t*dx y = y0 + t*dy; + + L = createLine(p1, p2); Returns the line going through the two + given points. + + L = createLine(x0, y0, dx, dy); Returns the line going through + point (x0, y0) and with direction vector(dx, dy). + + L = createLine(LINE); where LINE is an array of 4 values, + creates the line going through the point (LINE(1) LINE(2)), and + with direction given by vector (LINE(3) LINE(4)). + + L = createLine(THETA); Create a polar line originated at (0,0) + and with angle THETA. + + L = createLine(RHO, THETA); Create a polar line with normal + theta, and with min distance to origin equal to rho. rho can be + negative, in this case, the line is the same as with + CREATELINE(-rho, theta+pi), but the orientation is different. + + Note: in all cases, parameters can be vertical arrays of the same + dimension. The result is then an array of lines, of dimensions + [N*4]. + + NOTE : A line can also be represented with a 1*5 array : [x0 y0 + dx dy t]. whith 't' being one of the following : - t=0 : line + is a singleton (x0,y0) - t=1 : line is an edge segment, between + points (x0,y0) and (x0+dx, y0+dy). - t=Inf : line is a Ray, + originated from (x0,y0) and going to infinity in the + direction(dx,dy). - t=-Inf : line is a Ray, originated from + (x0,y0) and going to infinity in the direction(-dx,-dy). - + t=NaN : line is a real straight line, and contains all points + verifying the above equation. This seems us a convenient way to + represent uniformly all kind of lines (including edges, rays, + and even point). + + NOTE2 : Any line object can be represented using a 1x6 array : + [x0 y0 dx dy t0 t1] the first 4 parameters define the supporting + line, t0 represent the position of the first point on the line, + and t1 the position of the last point. * for edges : t0 = 0, + and t1=1 * for straight lines : t0 = -inf, t1=inf * for rays : + t0=0, t1=inf (or t0=-inf,t1=0 for inverted ray). I propose to + call these objects 'lineArc' + + See also: lines2d, createEdge, createRay + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 +Create a straight line from 2 points, or from other inputs + + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +createLineReflection + + +# name: +# type: sq_string +# elements: 1 +# length: 332 + -- Function File: T = function_name (LINE) + Create the the 3x3 matrix of a line reflection. + + Where LINE is given as [x0 y0 dx dy], return the affine tansform + corresponding to the desired line reflection. + + See also: lines2d, transforms2d, transformPoint, + createTranslation, createHomothecy, createScaling + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Create the the 3x3 matrix of a line reflection. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +createRay + + +# name: +# type: sq_string +# elements: 1 +# length: 877 + -- Function File: RAY = createRay (POINT, ANGLE) + -- Function File: RAY = createRay (X0,Y0, ANGLE) + -- Function File: RAY = createRay (P1, P2) + Create a ray (half-line), from various inputs. + + A Ray is represented in a parametric form: [x0 y0 dx dy]. x = + x0 + t*dx y = y0 + t*dy; for all t>0. + + POINT is a Nx2 array giving the starting point of the ray, and + ANGLE is the orientation of the ray respect to the positive + x-axis. The ray origin can be specified with 2 input arguments + X0,Y0. + + If two points P1, P2 are given, creates a ray starting from point + P1 and going in the direction of point P2. + + Example + origin = [3 4]; + theta = pi/6; + ray = createRay(origin, theta); + axis([0 10 0 10]); + drawRay(ray); + + See also: rays2d, createLine, points2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Create a ray (half-line), from various inputs. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +createRotation + + +# name: +# type: sq_string +# elements: 1 +# length: 651 + -- Function File: T = createRotation (THETA) + -- Function File: T = createRotation (POINT, THETA) + -- Function File: T = createRotation (X0, Y0, THETA) + Create the 3*3 matrix of a rotation. + + Returns the rotation corresponding to angle THETA (in radians) + The returned matrix has the form : [cos(theta) -sin(theta) 0] + [sin(theta) cos(theta) 0] [0 0 1] + + POINT or (X0,Y0), specifies origin of rotation. The result is + similar as performing translation(-X0,-Y0), rotation(THETA), and + translation(X0,Y0). + + See also: transforms2d, transformPoint, createTranslation, + createScaling + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Create the 3*3 matrix of a rotation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +createScaling + + +# name: +# type: sq_string +# elements: 1 +# length: 473 + -- Function File: T = createScaling (S) + -- Function File: T = createScaling (SX, SY) + Create the 3x3 matrix of a scaling in 2 dimensions. + + Assume scaling S is equal n all directions unless SX and SY are + given. Returns the matrix corresponding to scaling in the 2 + main directions. The returned matrix has the form: [SX 0 0] + [0 SY 0] [0 0 1] + + See also: transforms2d, transformPoint, createTranslation, + createRotation + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Create the 3x3 matrix of a scaling in 2 dimensions. + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +createTranslation + + +# name: +# type: sq_string +# elements: 1 +# length: 438 + -- Function File: T = createTranslation (VECTOR) + -- Function File: T = createTranslation (DX,DY) + Create the 3*3 matrix of a translation. + + Returns the matrix corresponding to a translation by the vector + [DX DY]. The components can be given as two arguments. The + returned matrix has the form : [1 0 TX] [0 1 TY] [0 0 1] + + See also: transforms2d, transformPoint, createRotation, + createScaling + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 +Create the 3*3 matrix of a translation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +createVector + + +# name: +# type: sq_string +# elements: 1 +# length: 560 + -- Function File: VECT = createVector (P1, P2) + Create a vector from two points. + + V12 = createVector(P1, P2) Creates the vector V12, defined as + the difference between coordinates of points P1 and P2. P1 + and P2 are row vectors with ND elements, ND being the space + dimension. + + If one of the inputs is a N-by-Nd array, the other input is + automatically repeated, and the result is N-by-Nd. + + If both inputs have the same size, the result also have the same + size. + + See also: vectors2d, vectors3d, points2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 +Create a vector from two points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +deg2rad + + +# name: +# type: sq_string +# elements: 1 +# length: 325 + -- Function File: RAD = deg2rad(DEG) + Convert angle from degrees to radians + + Usage: R = deg2rad(D) convert an angle in degrees to an angle + in radians. + + Example deg2rad(180) % gives pi ans = 3.1416 + deg2rad(60) % gives pi/3 ans = 1.0472 + + See also: angles2d, rad2deg + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Convert angle from degrees to radians + + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +distancePointEdge + + +# name: +# type: sq_string +# elements: 1 +# length: 1248 + -- Function File: DIST = distancePointEdge (POINT, EDGE) + -- Function File: DIST = distancePointEdge (..., OPT) + -- Function File: [DIST POS]= distancePointEdge (...) + Minimum distance between a point and an edge + + Return the euclidean distance between edge EDGE and point POINT. + EDGE has the form: [x1 y1 x2 y2], and POINT is [x y]. If EDGE is + Ne-by-4 and POINT is Np-by-2, then DIST is Np-by-Ne, where each + row contains the distance of each point to all the edges. + + If OPT is true (or equivalent), the optput is cmpatible with the + original function: + `1' + If POINT is 1-by-2 array, the result is Ne-by-1 array + computed for each edge. + + `2' + If EDGE is a 1-by-4 array, the result is Np-by-1 computed for + each point. + + `3' + If both POINT and EDGE are array, they must have the same + number of rows, and the result is computed for each couple + `POINT(i,:),EDGE(i,:)'. + + If the the second output argument POS is requested, the function + also returns the position of closest point on the edge. POS is + comprised between 0 (first point) and 1 (last point). + + See also: edges2d, points2d, distancePoints, distancePointLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Minimum distance between a point and an edge + + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +distancePointLine + + +# name: +# type: sq_string +# elements: 1 +# length: 615 + -- Function File: DIST = distancePointLine (POINT, LINE) + Minimum distance between a point and a line + + D = distancePointLine(POINT, LINE) Return the euclidean distance + between line LINE and point POINT. + + LINE has the form : [x0 y0 dx dy], and POINT is [x y]. + + If LINE is N-by-4 array, result is N-by-1 array computes for each + line. + + If POINT is N-by-2, then result is computed for each point. + + If both POINT and LINE are array, result is N-by-1, computed for + each corresponding point and line. + + See also: lines2d, points2d, distancePoints, distancePointEdge + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 +Minimum distance between a point and a line + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +distancePoints + + +# name: +# type: sq_string +# elements: 1 +# length: 826 + -- Function File: D = distancePoints (P1, P2) + -- Function File: D = distancePoints (P1, P2, NORM) + -- Function File: D = distancePoints (..., 'diag') + Compute distance between two points. + + Returns the Euclidean distance between points P1 and P2. If P1 + and P2 are two arrays of points, result is a N1xN2 array + containing distance between each point of P1 and each point of P2. + + Is NORM is given, computes distance using the specified norm. + NORM=2 corresponds to usual euclidean distance, NORM=1 + corresponds to Manhattan distance, NORM=inf is assumed to + correspond to maximum difference in coordinate. Other values + (>0) can be specified. + + When 'diag' is given, computes only distances between P1(i,:) and + P2(i,:). + + See also: points2d, minDistancePoints + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Compute distance between two points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +drawArrow + + +# name: +# type: sq_string +# elements: 1 +# length: 686 + -- Function File: H = drawArrow (X1, Y1, X2, Y2) + -- Function File: H = drawArrow ([ X1 Y1 X2 Y2]) + -- Function File: H = drawArrow (..., L, W) + -- Function File: H = drawArrow (..., L, W,TYPE) + Draw an arrow on the current axis. + + draw an arrow between the points (X1 Y1) and (X2 Y2). The points + can be given as a single array. L, W specify length and width of + the arrow. + + Also specify arrow type. TYPE can be one of the following : 0: + draw only two strokes 1: fill a triangle .5: draw a half arrow + (try it to see ...) + + Arguments can be single values or array of size [N*1]. In this + case, the function draws multiple arrows. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Draw an arrow on the current axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +drawBezierCurve + + +# name: +# type: sq_string +# elements: 1 +# length: 1064 + -- Function File: drawBezierCurve (POINTS) + -- Command: Function File drawBezierCurve (PP) + -- Command: Function File drawBezierCurve (..., PARAM, VALUE, ...) + -- Command: Function File H =drawBezierCurve (...) + Draw a cubic bezier curve defined by the control points POINTS. + + With only one input argument, draws the Bezier curve defined by + the 4 control points stored in POINTS. POINTS is either a 4-by-2 + array (vertical concatenation of point coordinates), or a 1-by-8 + array (horizotnal concatenation of point coordinates). The curve + could be described by its polynomial (output of `cbezier2poly') + PP, which should be a 2-by-4 array. + + The optional PARAM, VALUE pairs specify additional drawing + parameters, see the `plot' function for details. The specific + parameter 'discretization' with an integer associated value + defines the amount of points used to plot the curve. If the output + is requiered, the function returns the handle to the created + graphic object. + + See also: cbezier2poly, plot + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Draw a cubic bezier curve defined by the control points POINTS. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +drawBox + + +# name: +# type: sq_string +# elements: 1 +# length: 388 + -- Function File: H = drawBox (BOX) + -- Function File: H = drawBox (BOX, PARAM, VALUE, ...) + Draw a box defined by coordinate extents + + Draws a box defined by its extent: BOX = [XMIN XMAX YMIN YMAX]. + Addtional arguments are passed to function `plot'. If requested, + it returns the handle to the graphics object created. + + See also: drawOrientedBox, drawRect, plot + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +Draw a box defined by coordinate extents + + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +drawCenteredEdge + + +# name: +# type: sq_string +# elements: 1 +# length: 1333 + -- Function File: H = drawCenteredEdge (CENTER, L, THETA) + -- Function File: H = drawCenteredEdge (EDGE) + -- Function File: H = drawCenteredEdge (..., NAME,VALUE) + Draw an edge centered on a point. + + drawCenteredEdge(CENTER, L, THETA) Draws an edge centered on + point CENTER, with length L, and orientation THETA (given in + degrees). Input arguments can also be arrays, that must all have + the same number odf rows. + + drawCenteredEdge(EDGE) Concatenates edge parameters into a + single N-by-4 array, containing: [XC YV L THETA]. + + drawCenteredEdge(..., NAME, VALUE) Also specifies drawing + options by using one or several parameter name - value pairs + (see doc of plot function for details). + + H = drawCenteredEdge(...) Returns handle(s) to the created + edges(s). + + % Draw an ellipse with its two axes + figure(1); clf; + center = [50 40]; + r1 = 30; r2 = 10; + theta = 20; + elli = [center r1 r2 theta]; + drawEllipse(elli, 'linewidth', 2); + axis([0 100 0 100]); axis equal; + hold on; + edges = [center 2*r1 theta ; center 2*r2 theta+90]; + drawCenteredEdge(edges, 'linewidth', 2, 'color', 'g'); + + See also: edges2d, drawEdge + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Draw an edge centered on a point. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +drawCircle + + +# name: +# type: sq_string +# elements: 1 +# length: 1142 + -- Function File: H = drawCircle (X0, Y0, R) + -- Function File: H = drawCircle (CIRCLE) + -- Function File: H = drawCircle (CENTER, RADIUS) + -- Function File: H = drawCircle (..., NSTEP) + -- Function File: H = drawCircle (..., NAME, VALUE) + Draw a circle on the current axis + + drawCircle(X0, Y0, R); Draw the circle with center (X0,Y0) and + the radius R. If X0, Y0 and R are column vectors of the same + length, draw each circle successively. + + drawCircle(CIRCLE); Concatenate all parameters in a Nx3 array, + where N is the number of circles to draw. + + drawCircle(CENTER, RADIUS); Specify CENTER as Nx2 array, and + radius as a Nx1 array. + + drawCircle(..., NSTEP); Specify the number of edges that will be + used to draw the circle. Default value is 72, creating an + approximation of one point for each 5 degrees. + + drawCircle(..., NAME, VALUE); Specifies plotting options as pair + of parameters name/value. See plot documentation for details. + + H = drawCircle(...); return handles to each created curve. + + See also: circles2d, drawCircleArc, drawEllipse + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Draw a circle on the current axis + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +drawCircleArc + + +# name: +# type: sq_string +# elements: 1 +# length: 1004 + -- Function File: H = drawCircleArc (XC, YC, R, START, END) + -- Function File: H = drawCircleArc (ARC) + -- Function File: H = drawCircleArc (..., PARAM, VALUE) + Draw a circle arc on the current axis + + drawCircleArc(XC, YC, R, START, EXTENT); Draws circle with + center (XC, YC), with radius R, starting from angle START, and + with angular extent given by EXTENT. START and EXTENT angles are + given in degrees. + + drawCircleArc(ARC); Puts all parameters into one single array. + + drawCircleArc(..., PARAM, VALUE); specifies plot properties by + using one or several parameter name-value pairs. + + H = drawCircleArc(...); Returns a handle to the created line + object. + + % Draw a red thick circle arc + arc = [10 20 30 -120 240]; + figure; + axis([-50 100 -50 100]); + hold on + drawCircleArc(arc, 'LineWidth', 3, 'Color', 'r') + + See also: circles2d, drawCircle, drawEllipse + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Draw a circle arc on the current axis + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +drawEdge + + +# name: +# type: sq_string +# elements: 1 +# length: 902 + -- Function File: H = drawEdge (X1, Y1, X2, Y2) + -- Function File: H = drawEdge ([X1 Y1 X2 Y2]) + -- Function File: H = drawEdge ([X1 Y1], [X2 Y2]) + -- Function File: H = drawEdge (X1, Y1, Z1, X2, Y2, Z2) + -- Function File: H = drawEdge ([X1 Y1 Z1 X2 Y2 Z2]) + -- Function File: H = drawEdge ([X1 Y1 Z1], [X2 Y2 Z2]) + -- Function File: H = drawEdge (..., OPT) + Draw an edge given by 2 points. + + Draw an edge between the points (x1 y1) and (x2 y2). Data can be + bundled as an edge. The function supports 3D edges. + Arguments can be single values or array of size [Nx1]. In this + case, the function draws multiple edges. OPT, being a set of + pairwise options, can specify color, line width and so on. These + are passed to function `line'. The function returns handle(s) + to created edges(s). + + See also: edges2d, drawCenteredEdge, drawLine, line + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 +Draw an edge given by 2 points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +drawEllipse + + +# name: +# type: sq_string +# elements: 1 +# length: 1330 + -- Function File: H = drawEllipse (ELLI) + -- Function File: H = drawEllipse (XC, YC, RA, RB) + -- Function File: H = drawEllipse (XC, YC, RA, RB, THETA) + -- Function File: H = drawEllipse (..., PARAM, VALUE) + Draw an ellipse on the current axis. + + drawEllipse(ELLI); Draws the ellipse ELLI in the form [XC YC RA + RB THETA], with center (XC, YC), with main axis of half-length + RA and RB, and orientation THETA in degrees counted + counter-clockwise. Puts all parameters into one single array. + + drawEllipse(XC, YC, RA, RB); drawEllipse(XC, YC, RA, RB, THETA); + Specifies ellipse parameters as separate arguments (old syntax). + + drawEllipse(..., NAME, VALUE); Specifies drawing style of + ellipse, see the help of plot function. + + H = drawEllipse(...); Also returns handles to the created line + objects. + + -> Parameters can also be arrays. In this case, all arrays are + supposed to have the same size. + + Example: + % Draw an ellipse centered in [50 50], with semi major axis length of + % 40, semi minor axis length of 20, and rotated by 30 degrees. + figure(1); clf; hold on; + drawEllipse([50 50 40 20 30]); + axis equal; + + See also: ellipses2d, drawCircle, drawEllipseArc, ellipseAsPolygon + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Draw an ellipse on the current axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +drawEllipseArc + + +# name: +# type: sq_string +# elements: 1 +# length: 1338 + -- Function File: H = drawEllipseArc (ARC) + Draw an ellipse arc on the current axis. + + drawEllipseArc(ARC) draw ellipse arc specified by ARC. ARC has + the format: ARC = [XC YC A B THETA T1 T2] or: ARC = [XC + YC A B T1 T2] (isothetic ellipse) with center (XC, YC), main + axis of half-length A, second axis of half-length B, and ellipse + arc running from t1 to t2 (both in degrees, in Counter-Clockwise + orientation). + + Parameters can also be arrays. In this case, all arrays are + suposed to have the same size... + + % draw an ellipse arc: center = [10 20], radii = 50 and 30, theta = 45 + arc = [10 20 50 30 45 -90 270]; + figure; + axis([-50 100 -50 100]); axis equal; + hold on + drawEllipseArc(arc, 'color', 'r') + + % draw another ellipse arc, between angles -60 and 70 + arc = [10 20 50 30 45 -60 (60+70)]; + figure; + axis([-50 100 -50 100]); axis equal; + hold on + drawEllipseArc(arc, 'LineWidth', 2); + ray1 = createRay([10 20], deg2rad(-60+45)); + drawRay(ray1) + ray2 = createRay([10 20], deg2rad(70+45)); + drawRay(ray2) + + See also: ellipses2d, drawEllipse, drawCircleArc + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Draw an ellipse arc on the current axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +drawLabels + + +# name: +# type: sq_string +# elements: 1 +# length: 673 + -- Function File: drawLabels (X, Y, LBL) + -- Function File: drawLabels (POS, LBL) + -- Function File: drawLabels (..., NUMBERS, FORMAT) + Draw labels at specified positions. + + DRAWLABELS(X, Y, LBL) draw labels LBL at position X and Y. LBL + can be either a string array, or a number array. In this case, + string are created by using sprintf function, with '%.2f' mask. + + DRAWLABELS(POS, LBL) draw labels LBL at position specified by POS, + where POS is a N*2 int array. + + DRAWLABELS(..., NUMBERS, FORMAT) create labels using sprintf + function, with the mask given by FORMAT (e. g. '%03d' or + '5.3f'), and the corresponding values. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Draw labels at specified positions. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +drawLine + + +# name: +# type: sq_string +# elements: 1 +# length: 662 + -- Function File: H = drawLine (LINE) + -- Function File: H = drawLine (LINE, PARAM,VALUE) + Draw the line on the current axis. + + Draws the line LINE on the current axis, by using current axis to + clip the line. Extra PARAM,VALUE pairs are passed to the `line' + function. Returns a handle to the created line object. If + clipped line is not contained in the axis, the function returns + -1. + + Example + + figure; hold on; axis equal; + axis([0 100 0 100]); + drawLine([30 40 10 20]); + drawLine([30 40 20 -10], 'color', 'm', 'linewidth', 2); + + See also: lines2d, createLine, drawEdge + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Draw the line on the current axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +drawOrientedBox + + +# name: +# type: sq_string +# elements: 1 +# length: 819 + -- Function File: HB = drawOrientedBox (BOX) + -- Function File: HB = drawOrientedBox (..., PARAM, VALUE) + Draw centered oriented rectangle. + + Syntax drawOrientedBox(BOX) drawOrientedBox(BOX, + 'PropertyName', propertyvalue, ...) + + Description drawOrientedBox(OBOX) Draws an oriented rectangle + (or bounding box) on the current axis. OBOX is a 1-by-5 row + vector containing box center, dimension (length and width) and + orientation (in degrees): OBOX = [CX CY LENGTH WIDTH THETA]. + + When OBOX is a N-by-5 array, the N boxes are drawn. + + HB = drawOrientedBox(...) Returns a handle to the created + graphic object(s). Object style can be modified using syntaw + like: set(HB, 'color', 'g', 'linewidth', 2); + + See also: drawPolygon, drawRect, drawBox + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Draw centered oriented rectangle. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +drawParabola + + +# name: +# type: sq_string +# elements: 1 +# length: 1510 + -- Function File: H = drawParabola (PARABOLA) + -- Function File: H = drawParabola (PARABOLA, T) + -- Function File: H = drawParabola (..., PARAM, VALUE) + Draw a parabola on the current axis. + + drawParabola(PARABOLA); Draws a vertical parabola, defined by + its vertex and its parameter. Such a parabola admits a vertical + axis of symetry. + + The algebraic equation of parabola is given by: (Y - YV) = A + * (X - VX)^2 Where XV and YV are vertex coordinates and A is + parabola parameter. + + A parametric equation of parabola is given by: x(t) = t + VX; + y(t) = A * t^2 + VY; + + PARABOLA can also be defined by [XV YV A THETA], with theta being + the angle of rotation of the parabola (in degrees and + Counter-Clockwise). + + drawParabola(PARABOLA, T); Specifies which range of 't' are used + for drawing parabola. If T is an array with only two values, the + first and the last values are used as interval bounds, and + several values are distributed within this interval. + + drawParabola(..., NAME, VALUE); Can specify one or several + graphical options using parameter name-value pairs. + + H = drawParabola(...); Returns an handle to the created + graphical object. + + Example: + figure(1); clf; hold on; + drawParabola([50 50 .2 30]); + drawParabola([50 50 .2 30], [-1 1], 'color', 'r', 'linewidth', 2); + axis equal; + + See also: drawCircle, drawEllipse + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Draw a parabola on the current axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +drawPoint + + +# name: +# type: sq_string +# elements: 1 +# length: 429 + -- Function File: H = drawPoint (X, Y) + -- Function File: H = drawPoint (COORD) + -- Function File: H = drawPoint (..., OPT) + Draw the point on the axis. + + Draws points defined by coordinates X and YY. X and Y should be + array the same size. Coordinates can be packed coordinates in a + single [N*2] array COORD. Options OPT are passed to the `plot' + function. + + See also: points2d, clipPoints + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 +Draw the point on the axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +drawRay + + +# name: +# type: sq_string +# elements: 1 +# length: 396 + -- Function File: H = drawRay (RAY) + -- Function File: H = drawRay (RAY, PARAM, VALUE) + Draw a ray on the current axis. + + With RAY having the syntax: [x0 y0 dx dy], draws the ray starting + from point (x0 y0) and going to direction (dx dy), clipped with + the current window axis. PARAM, VALUE pairs are passed to + function `line'. + + See also: rays2d, drawLine, line + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 +Draw a ray on the current axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +drawRect + + +# name: +# type: sq_string +# elements: 1 +# length: 673 + -- Function File: R = drawRect (X, Y, W, H) + -- Function File: R = drawRect (X, Y, W, H, THETA) + -- Function File: R = drawRect (COORD) + Draw rectangle on the current axis. + + r = DRAWRECT(x, y, w, h) draw rectangle with width W and height H, + at position (X, Y). the four corners of rectangle are then : + (X, Y), (X+W, Y), (X, Y+H), (X+W, Y+H). + + r = DRAWRECT(x, y, w, h, theta) also specifies orientation for + rectangle. Theta is given in degrees. + + r = DRAWRECT(coord) is the same as DRAWRECT(X,Y,W,H), but all + parameters are packed into one array, whose dimensions is 4*1 or + 5*1. + + See also: drawBox, drawOrientedBox + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Draw rectangle on the current axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +drawShape + + +# name: +# type: sq_string +# elements: 1 +# length: 823 + -- Function File: drawShape (TYPE, PARAM) + -- Function File: drawShape (..., OPTION) + Draw various types of shapes (circles, polygons...). + + drawShape(TYPE, PARAM) Draw the shape of type TYPE, specified by + given parameter PARAM. TYPE can be one of 'circle', 'ellipse', + 'rect', 'polygon', 'curve' PARAM depend on the type. For + example, if TYPE is 'circle', PARAM will contain [x0 y0 R]. + + Examples : + drawShape('circle', [20 10 30]); + Draw circle centered on [20 10] with radius 10. + drawShape('rect', [20 20 40 10 pi/3]); + Draw rectangle centered on [20 20] with length 40 and width 10, and + oriented pi/3 wrt axis Ox. + + drawShape(..., OPTION) also specifies drawing options. OPTION + can be 'draw' (default) or 'fill'. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Draw various types of shapes (circles, polygons. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +edgeAngle + + +# name: +# type: sq_string +# elements: 1 +# length: 520 + -- Function File: THETA = edgeAngle(EDGE) + Return angle of edge + + A = edgeAngle(EDGE) Returns the angle between horizontal, + right-axis and the edge EDGE. Angle is given in radians, + between 0 and 2*pi, in counter-clockwise direction. Notation + for edge is [x1 y1 x2 y2] (coordinates of starting and ending + points). + + Example p1 = [10 20]; p2 = [30 40]; rad2deg(edgeAngle([p1 + p2])) ans = 45 + + See also: edges2d, angles2d, edgeAngle, lineAngle, edgeLength + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +Return angle of edge + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +edgeLength + + +# name: +# type: sq_string +# elements: 1 +# length: 436 + -- Function File: LEN = edgeLength (EDGE) + Return length of an edge + + L = edgeLength(EDGE); Returns the length of an edge, with + parametric representation: [x1 y1 x2 y2]. + + The function also works for several edges, in this case input is a + [N*4] array, containing parametric representation of each edge, + and output is a [N*1] array containing length of each edge. + + See also: edges2d, edgeAngle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 +Return length of an edge + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +edgePosition + + +# name: +# type: sq_string +# elements: 1 +# length: 1194 + -- Function File: D = edgePosition (POINT, EDGE) + Return position of a point on an edge + + POS = edgePosition(POINT, EDGE); Computes position of point + POINT on the edge EDGE, relative to the position of edge + vertices. EDGE has the form [x1 y1 x2 y2], POINT has the form + [x y], and is assumed to belong to edge. The position POS has + meaning: POS<0: POINT is located before the first vertex + POS=0: POINT is located on the first vertex 0 +# type: sq_string +# elements: 1 +# length: 38 +Return position of a point on an edge + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +edgeToLine + + +# name: +# type: sq_string +# elements: 1 +# length: 392 + -- Function File: LINE = edgeToLine (EDGE) + Convert an edge to a straight line + + LINE = edgeToLine(EDGE); Returns the line containing the edge + EDGE. + + Example edge = [2 3 4 5]; line = edgeToLine(edge); + figure(1); hold on; axis([0 10 0 10]); drawLine(line, + 'color', 'g') drawEdge(edge, 'linewidth', 2) + + See also: edges2d, lines2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Convert an edge to a straight line + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +edges2d + + +# name: +# type: sq_string +# elements: 1 +# length: 492 + -- Function File: edges2d () + Description of functions operating on planar edges + + An edge is represented by the corodinate of its end points: EDGE + = [X1 Y1 X2 Y2]; + + A set of edges is represented by a N*4 array, each row + representing an edge. + + See also: lines2d, rays2d, points2d createEdge, edgeAngle, + edgeLength, edgeToLine, midPoint intersectEdges, + intersectLineEdge, isPointOnEdge clipEdge, transformEdge + drawEdge, drawCenteredEdge + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Description of functions operating on planar edges + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +ellipse2cov + + +# name: +# type: sq_string +# elements: 1 +# length: 672 + -- Function File: K = ellipse2cov (ELLI) + -- Function File: K = ellipse2cov (RA, RB) + -- Function File: K = ellipse2cov (..., THETA) + Calculates covariance matrix from ellipse. + + If only one input is given, ELLI must define an ellipse as + described in `ellipses2d'. If two inputs are given, RA and RB + define the half-lenght of the axes. If a third input is given, + THETA must be the angle of rotation of the ellipse in radians, and + in counter-clockwise direction. + + The output K contains the covariance matrix define by the ellipse. + + Run `demo ellipse2cov' to see an example. + + See also: ellipses2d, cov2ellipse, drawEllipse + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 +Calculates covariance matrix from ellipse. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +ellipseAsPolygon + + +# name: +# type: sq_string +# elements: 1 +# length: 731 + -- Function File: P = ellipseAsPolygon (ELL, N) + Convert an ellipse into a series of points + + P = ellipseAsPolygon(ELL, N); converts ELL given as [x0 y0 a b] + or [x0 y0 a b theta] into a polygon with N edges. The result P + is (N+1)-by-2 array containing coordinates of the N+1 vertices + of the polygon. The resulting polygon is closed, i.e. the last + point is the same as the first one. + + P = ellipseAsPolygon(ELL); Use a default number of edges equal + to 72. This result in one piont for each 5 degrees. + + [X Y] = ellipseAsPolygon(...); Return the coordinates o + fvertices in two separate arrays. + + See also: ellipses2d, circleAsPolygon, rectAsPolygon, drawEllipse + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Convert an ellipse into a series of points + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +ellipses2d + + +# name: +# type: sq_string +# elements: 1 +# length: 377 + -- Function File: ellipses2d () + Description of functions operating on ellipses. + + Ellipses are represented by their center, the length of their 2 + semi-axes length, and their angle from the Ox direction (in + degrees). E = [XC YC A B THETA]; + + See also: circles2d, inertiaEllipse, isPointInEllipse, + ellipseAsPolygon drawEllipse, drawEllipseArc + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Description of functions operating on ellipses. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +enclosingCircle + + +# name: +# type: sq_string +# elements: 1 +# length: 462 + -- Function File: CIRCLE = enclosingCircle (PTS) + Find the minimum circle enclosing a set of points. + + CIRCLE = enclosingCircle(POINTS); compute cirlce CIRCLE=[xc yc + r] which enclose all points POINTS given as an [Nx2] array. + + Rewritten from a file from Yazan Ahed which was + rewritten from a Java applet by Shripad Thite : + `http://heyoka.cs.uiuc.edu/~thite/mincircle/' + + See also: circles2d, points2d, boxes2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Find the minimum circle enclosing a set of points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +fitAffineTransform2d + + +# name: +# type: sq_string +# elements: 1 +# length: 397 + -- Function File: T = fitAffineTransform2d (PTS1, PTS2) + Fit an affine transform using two point sets. + + Example + + N = 10; + pts = rand(N, 2)*10; + trans = createRotation(3, 4, pi/4); + pts2 = transformPoint(pts, trans); + pts3 = pts2 + randn(N, 2)*2; + fitted = fitAffineTransform2d(pts, pts2) + + See also: transforms2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Fit an affine transform using two point sets. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +geom2d_Contents + + +# name: +# type: sq_string +# elements: 1 +# length: 8910 + -- Function File: geom2d_Contents () + Geometry 2D Toolbox Version 1.2.0 21-Oct-2011 . + + Library to handle and visualize geometric primitives such as + points, lines, circles and ellipses, polygons... + + The goal is to provide a low-level library for manipulating + geometrical primitives, making easier the development of more + complex geometric algorithms. + + Most functions works for planar shapes, but some ones have been + extended to 3D or to any dimension. + + Points points2d - Description of functions operating + on points clipPoints - Clip a set of points by a box + centroid - Compute centroid (center of mass) of a set + of points midPoint - Middle point of two points or + of an edge isCounterClockwise - Compute relative orientation + of 3 points polarPoint - Create a point from polar + coordinates (rho + theta) angle2Points - Compute + horizontal angle between 2 points angle3Points - Compute + oriented angle made by 3 points angleSort - Sort + points in the plane according to their angle to origin + distancePoints - Compute distance between two points + minDistancePoints - Minimal distance between several points + transformPoint - Transform a point with an affine transform + drawPoint - Draw the point on the axis. + + Vectors vectors2d - Description of functions + operating on plane vectors createVector - Create a + vector from two points vectorNorm - Compute norm of a + vector, or of a set of vectors vectorAngle - Angle of a + vector, or between 2 vectors normalizeVector - Normalize a + vector to have norm equal to 1 isPerpendicular - Check + orthogonality of two vectors isParallel - Check + parallelism of two vectors transformVector - Transform a + vector with an affine transform rotateVector - Rotate a + vector by a given angle + + Straight lines lines2d - Description of functions + operating on planar lines createLine - Create a + straight line from 2 points, or from other inputs medianLine + - Create a median line between two points cartesianLine + - Create a straight line from cartesian equation coefficients + orthogonalLine - Create a line orthogonal to another one. + parallelLine - Create a line parallel to another one. + intersectLines - Return all intersection points of N lines + in 2D lineAngle - Computes angle between two straight + lines linePosition - Position of a point on a line + lineFit - Fit a straight line to a set of points + clipLine - Clip a line with a box reverseLine + - Return same line but with opposite orientation transformLine + - Transform a line with an affine transform drawLine + - Draw the line on the current axis + + Edges (line segments between 2 points) edges2d - + Description of functions operating on planar edges createEdge + - Create an edge between two points, or from a line + edgeToLine - Convert an edge to a straight line + edgeAngle - Return angle of edge edgeLength + - Return length of an edge midPoint - Middle point + of two points or of an edge edgePosition - Return + position of a point on an edge clipEdge - Clip an + edge with a rectangular box reverseEdge - Intervert the + source and target vertices of edge intersectEdges - Return + all intersections between two set of edges intersectLineEdge + - Return intersection between a line and an edge transformEdge + - Transform an edge with an affine transform drawEdge + - Draw an edge given by 2 points drawCenteredEdge - Draw + an edge centered on a point + + Rays rays2d - Description of functions operating + on planar rays createRay - Create a ray (half-line), + from various inputs bisector - Return the bisector + of two lines, or 3 points clipRay - Clip a ray with + a box drawRay - Draw a ray on the current axis + + Relations between points and lines distancePointEdge - + Minimum distance between a point and an edge distancePointLine + - Minimum distance between a point and a line projPointOnLine + - Project of a point orthogonally onto a line pointOnLine + - Create a point on a line at a given position on the line + isPointOnLine - Test if a point belongs to a line + isPointOnEdge - Test if a point belongs to an edge + isPointOnRay - Test if a point belongs to a ray + isLeftOriented - Test if a point is on the left side of a + line + + Circles circles2d - Description of functions + operating on circles createCircle - Create a circle from + 2 or 3 points createDirectedCircle - Create a directed circle + intersectCircles - Intersection points of two circles + intersectLineCircle - Intersection point(s) of a line and a circle + circleAsPolygon - Convert a circle into a series of points + circleArcAsCurve - Convert a circle arc into a series of points + isPointInCircle - Test if a point is located inside a given + circle isPointOnCircle - Test if a point is located on a + given circle. enclosingCircle - Find the minimum circle + enclosing a set of points. radicalAxis - Compute the + radical axis (or radical line) of 2 circles drawCircle + - Draw a circle on the current axis drawCircleArc - Draw + a circle arc on the current axis + + Ellipses ellipses2d - Description of functions + operating on ellipses inertiaEllipse - Inertia ellipse of + a set of points isPointInEllipse - Check if a point is + located inside a given ellipse ellipseAsPolygon - Convert an + ellipse into a series of points drawEllipse - Draw an + ellipse on the current axis drawEllipseArc - Draw an + ellipse arc on the current axis + + Geometric transforms transforms2d - Description of + functions operating on transforms createTranslation - Create + the 3*3 matrix of a translation createRotation - Create + the 3*3 matrix of a rotation createScaling - Create the + 3*3 matrix of a scaling in 2 dimensions createHomothecy - + Create the the 3x3 matrix of an homothetic transform + createBasisTransform - Compute matrix for transforming a basis + into another basis createLineReflection - Create the the 3x3 + matrix of a line reflection fitAffineTransform2d - Fit an affine + transform using two point sets + + Angles angles2d - Description of functions for + manipulating angles normalizeAngle - Normalize an angle + value within a 2*PI interval angleAbsDiff - Absolute + difference between two angles angleDiff - Difference + between two angles deg2rad - Convert angle from + degrees to radians rad2deg - Convert angle from + radians to degrees + + Boxes boxes2d - Description of functions operating + on bounding boxes intersectBoxes - Intersection of two + bounding boxes mergeBoxes - Merge two boxes, by + computing their greatest extent randomPointInBox - Generate + random point within a box drawBox - Draw a box + defined by coordinate extents + + Various drawing functions drawBezierCurve - Draw a cubic + bezier curve defined by 4 control points drawParabola - + Draw a parabola on the current axis drawOrientedBox - Draw + centered oriented rectangle drawRect - Draw + rectangle on the current axis drawArrow - Draw an + arrow on the current axis drawLabels - Draw labels at + specified positions drawShape - Draw various types of + shapes (circles, polygons...) + + Other shapes squareGrid - Generate equally spaces + points in plane. hexagonalGrid - Generate hexagonal grid + of points in the plane. triangleGrid - Generate + triangular grid of points in the plane. crackPattern - + Create a (bounded) crack pattern tessellation crackPattern2 + - Create a (bounded) crack pattern tessellation + + Credits: * function 'enclosingCircle' rewritten from a file from + Yazan Ahed , available on Matlab File Exchange + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Geometry 2D Toolbox Version 1. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +hexagonalGrid + + +# name: +# type: sq_string +# elements: 1 +# length: 458 + -- Function File: PTS = hexagonalGrid (BOUNDS, ORIGIN, SIZE) + Generate hexagonal grid of points in the plane. + + usage PTS = hexagonalGrid(BOUNDS, ORIGIN, SIZE) generate + points, lying in the window defined by BOUNDS (=[xmin ymin xmax + ymax]), starting from origin with a constant step equal to size. + SIZE is constant and is equals to the length of the sides of each + hexagon. + + TODO: add possibility to use rotated grid + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Generate hexagonal grid of points in the plane. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +inertiaEllipse + + +# name: +# type: sq_string +# elements: 1 +# length: 1098 + -- Function File: ELL = inertiaEllipse (PTS) + Inertia ellipse of a set of points + + ELL = inertiaEllipse(PTS); where PTS is a N*2 array containing + coordinates of N points, computes the inertia ellispe of the set + of points. + + The result has the form: ELL = [XC YC A B THETA], with XC and + YC being the center of mass of the point set, A and B are the + lengths of the inertia ellipse (see below), and THETA is the angle + of the main inertia axis with the horizontal (counted in degrees + between 0 and 180). A and B are the standard deviations of the + point coordinates when ellipse is aligned with the inertia axes. + + pts = randn(100, 2); + pts = transformPoint(pts, createScaling(5, 2)); + pts = transformPoint(pts, createRotation(pi/6)); + pts = transformPoint(pts, createTranslation(3, 4)); + ell = inertiaEllipse(pts); + figure(1); clf; hold on; + drawPoint(pts); + drawEllipse(ell, 'linewidth', 2, 'color', 'r'); + + See also: ellipses2d, drawEllipse + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Inertia ellipse of a set of points + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +intersectBoxes + + +# name: +# type: sq_string +# elements: 1 +# length: 303 + -- Function File: BOX = intersectBoxes (BOX1, BOX2) + Intersection of two bounding boxes. + + Example + + box1 = [5 20 5 30]; + box2 = [0 15 0 15]; + intersectBoxes(box1, box2) + ans = + 5 15 5 15 + + See also: boxes2d, drawBox, mergeBoxes + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Intersection of two bounding boxes. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +intersectCircles + + +# name: +# type: sq_string +# elements: 1 +# length: 1236 + -- Function File: POINTS = intersectCircles (CIRCLE1, CIRCLE2) + Intersection points of two circles. + + POINTS = intersectCircles(CIRCLE1, CIRCLE2) Computes the + intersetion point of the two circles CIRCLE1 and CIRCLE1. Both + circles are given with format: [XC YC R], with (XC,YC) being the + coordinates of the center and R being the radius. POINTS is a + 2-by-2 array, containing coordinate of an intersection point on + each row. In the case of tangent circles, the intersection is + returned twice. It can be simplified by using the 'unique' + function. + + Example % intersection points of two distant circles c1 = + [0 0 10]; c2 = [10 0 10]; pts = intersectCircles(c1, c2) + pts = 5 -8.6603 5 8.6603 + + % intersection points of two tangent circles c1 = [0 0 10]; + c2 = [20 0 10]; pts = intersectCircles(c1, c2) pts = + 10 0 10 0 pts2 = unique(pts, 'rows') pts2 = + 10 0 + + References + http://local.wasp.uwa.edu.au/~pbourke/geometry/2circle/ + http://mathworld.wolfram.com/Circle-CircleIntersection.html + + See also: circles2d, intersectLineCircle, radicalAxis + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Intersection points of two circles. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +intersectEdges + + +# name: +# type: sq_string +# elements: 1 +# length: 739 + -- Function File: POINT = intersectEdges (EDGE1, EDGE2) + Return all intersections between two set of edges + + P = intersectEdges(E1, E2); returns the intersection point of + lines L1 and L2. E1 and E2 are 1-by-4 arrays, containing + parametric representation of each edge (in the form [x1 y1 x2 + y2], see 'createEdge' for details). + + In case of colinear edges, returns [Inf Inf]. In case of + parallel but not colinear edges, returns [NaN NaN]. + + If each input is [N*4] array, the result is a [N*2] array + containing intersections of each couple of edges. If one of + the input has N rows and the other 1 row, the result is a [N*2] + array. + + See also: edges2d, intersectLines + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Return all intersections between two set of edges + + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +intersectLineCircle + + +# name: +# type: sq_string +# elements: 1 +# length: 772 + -- Function File: POINTS = intersectLineCircle (LINE, CIRCLE) + Intersection point(s) of a line and a circle + + INTERS = intersectLineCircle(LINE, CIRCLE); Returns a 2-by-2 + array, containing on each row the coordinates of an intersection + point. If the line and circle do not intersect, the result is + filled with NaN. + + Example % base point center = [10 0]; % create vertical line + l1 = [center 0 1]; % circle c1 = [center 5]; pts = + intersectLineCircle(l1, c1) pts = 10 -5 10 5 + % draw the result figure; clf; hold on; axis([0 20 -10 10]); + drawLine(l1); drawCircle(c1); drawPoint(pts, 'rx'); axis + equal; + + See also: lines2d, circles2d, intersectLines, intersectCircles + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Intersection point(s) of a line and a circle + + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +intersectLineEdge + + +# name: +# type: sq_string +# elements: 1 +# length: 868 + -- Function File: POINT = intersecLineEdge (LINE, EDGE) + Return intersection between a line and an edge. + + Returns the intersection point of lines LINE and edge EDGE. + LINE is a 1x4 array containing parametric representation of the + line (in the form [x0 y0 dx dy], see `createLine' for details). + EDGE is a 1x4 array containing coordinates of first and second + point (in the form [x1 y1 x2 y2], see `createEdge' for details). + + In case of colinear line and edge, returns [Inf Inf]. If line + does not intersect edge, returns [NaN NaN]. + + If each input is [N*4] array, the result is a [N*2] array + containing intersections for each couple of edge and line. If + one of the input has N rows and the other 1 row, the result is a + [N*2] array. + + See also: lines2d, edges2d, intersectEdges, intersectLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Return intersection between a line and an edge. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +intersectLines + + +# name: +# type: sq_string +# elements: 1 +# length: 1143 + -- Function File: POINT = intersectLines (LINE1, LINE2) + -- Function File: POINT = intersectLines (LINE1, LINE2,EPS) + Return all intersection points of N lines in 2D. + + Returns the intersection point of lines LINE1 and LINE2. LINE1 + and LINE2 are [1*4] arrays, containing parametric representation + of each line (in the form [x0 y0 dx dy], see `createLine' for + details). + + In case of colinear lines, returns [Inf Inf]. In case of + parallel but not colinear lines, returns [NaN NaN]. + + If each input is [N*4] array, the result is a [N*2] array + containing intersections of each couple of lines. If one of + the input has N rows and the other 1 row, the result is a [N*2] + array. + + A third input argument specifies the tolerance for detecting + parallel lines. Default is 1e-14. + + Example + + line1 = createLine([0 0], [10 10]); + line2 = createLine([0 10], [10 0]); + point = intersectLines(line1, line2) + point = + 5 5 + + See also: lines2d, edges2d, intersectEdges, intersectLineEdge, + intersectLineCircle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Return all intersection points of N lines in 2D. + + + +# name: +# type: sq_string +# elements: 1 +# length: 18 +isCounterClockwise + + +# name: +# type: sq_string +# elements: 1 +# length: 1212 + -- Function File: CCW = isCounterClockwise (P1, P2, P3) + -- Function File: CCW = isCounterClockwise (P1, P2, P3,TOL) + Compute relative orientation of 3 points + + Computes the orientation of the 3 points. The returns is: +1 if + the path P1-> P2-> P3 turns Counter-Clockwise (i.e., the point P3 + is located "on the left" of the line P1- P2) -1 if the + path turns Clockwise (i.e., the point P3 lies "on the right" + of the line P1- P2) 0 if the point P3 is located on the line + segment [ P1 P2]. + + This function can be used in more complicated algorithms: + detection of line segment intersections, convex hulls, point in + triangle... + + CCW = isCounterClockwise( P1, P2, P3, EPS); Specifies the + threshold used for detecting colinearity of the 3 points. + Default value is 1e-12 (absolute). + + Example + + isCounterClockwise([0 0], [10 0], [10 10]) + ans = + 1 + isCounterClockwise([0 0], [0 10], [10 10]) + ans = + -1 + isCounterClockwise([0 0], [10 0], [5 0]) + ans = + 0 + + See also: points2d, isPointOnLine, isPointInTriangle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +Compute relative orientation of 3 points + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +isLeftOriented + + +# name: +# type: sq_string +# elements: 1 +# length: 343 + -- Function File: B = isLeftOriented (POINT, LINE) + Test if a point is on the left side of a line + + B = isLeftOriented(POINT, LINE); Returns TRUE if the point lies + on the left side of the line with respect to the line direction. + + See also: lines2d, points2d, isCounterClockwise, isPointOnLine, + distancePointLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Test if a point is on the left side of a line + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +isParallel + + +# name: +# type: sq_string +# elements: 1 +# length: 757 + -- Function File: B = isParallel (V1, V2) + -- Function File: B = isParallel (V1, V2,TOL) + Check parallelism of two vectors + + V1 and V2 are 2 row vectors of length Nd, Nd being the dimension, + returns `true' if the vectors are parallel, and `false' otherwise. + + Also works when V1 and V2 are two [NxNd] arrays with same number of + rows. In this case, return a [Nx1] array containing `true' at the + positions of parallel vectors. + + TOL specifies the accuracy of numerical computation. Default value + is 1e-14. + + Example + + isParallel([1 2], [2 4]) + ans = + 1 + isParallel([1 2], [1 3]) + ans = + 0 + + See also: vectors2d, isPerpendicular, lines2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Check parallelism of two vectors + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +isPerpendicular + + +# name: +# type: sq_string +# elements: 1 +# length: 791 + -- Function File: B = isPerpendicular (V1, V2) + -- Function File: B = isPerpendicula (V1, V2,TOL) + heck orthogonality of two vectors. + + V1 and V2 are 2 row vectors of length Nd, Nd being the dimension, + returns `true' if the vectors are perpendicular, and `false' + otherwise. + + Also works when V1 and V2 are two [NxNd] arrays with same number of + rows. In this case, return a [Nx1] array containing `true' at the + positions of parallel vectors. + + TOL specifies the accuracy of numerical computation. Default value + is 1e-14. + + Example + + isPerpendicular([1 2 0], [0 0 2]) + ans = + 1 + isPerpendicular([1 2 1], [1 3 2]) + ans = + 0 + + See also: vectors2d, isParallel, lines2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +heck orthogonality of two vectors. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +isPointInCircle + + +# name: +# type: sq_string +# elements: 1 +# length: 578 + -- Function File: B = isPointInCircle (POINT, CIRCLE) + Test if a point is located inside a given circle + + B = isPointInCircle(POINT, CIRCLE) Returns true if point is + located inside the circle, i.e. if distance to circle center is + lower than the circle radius. + + B = isPointInCircle(POINT, CIRCLE, TOL) Specifies the tolerance + value + + Example: isPointInCircle([1 0], [0 0 1]) isPointInCircle([0 + 0], [0 0 1]) returns true, whereas isPointInCircle([1 1], [0 0 + 1]) return false + + See also: circles2d, isPointOnCircle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Test if a point is located inside a given circle + + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +isPointInEllipse + + +# name: +# type: sq_string +# elements: 1 +# length: 599 + -- Function File: B = isPointInellipse (POINT, ELLIPSE) + Check if a point is located inside a given ellipse + + B = isPointInEllipse(POINT, ELLIPSE) Returns true if point is + located inside the given ellipse. + + B = isPointInEllipse(POINT, ELLIPSE, TOL) Specifies the + tolerance value + + Example: isPointInEllipse([1 0], [0 0 2 1 0]) ans = 1 + isPointInEllipse([0 0], [0 0 2 1 0]) ans = 1 + isPointInEllipse([1 1], [0 0 2 1 0]) ans = 0 + isPointInEllipse([1 1], [0 0 2 1 30]) ans = 1 + + See also: ellipses2d, isPointInCircle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Check if a point is located inside a given ellipse + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +isPointOnCircle + + +# name: +# type: sq_string +# elements: 1 +# length: 548 + -- Function File: B = isPointOnCircle (POINT, CIRCLE) + Test if a point is located on a given circle. + + B = isPointOnCircle(POINT, CIRCLE) return true if point is + located on the circle, i.e. if the distance to the circle center + equals the radius up to an epsilon value. + + B = isPointOnCircle(POINT, CIRCLE, TOL) Specifies the tolerance + value. + + Example: isPointOnCircle([1 0], [0 0 1]) returns true, whereas + isPointOnCircle([1 1], [0 0 1]) return false + + See also: circles2d, isPointInCircle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Test if a point is located on a given circle. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +isPointOnEdge + + +# name: +# type: sq_string +# elements: 1 +# length: 1084 + -- Function File: B = isPointOnEdge (POINT, EDGE) + -- Function File: B = isPointOnEdge (POINT, EDGE, TOL) + -- Function File: B = isPointOnEdge (POINT, EDGEARRAY) + -- Function File: B = isPointOnEdge (POINTARRAY, EDGEARRAY) + Test if a point belongs to an edge. + + with POINT being [xp yp], and EDGE being [x1 y1 x2 y2], returns + TRUE if the point is located on the edge, and FALSE otherwise. + + Specify an optilonal tolerance value TOL. The tolerance is given + as a fraction of the norm of the edge direction vector. Default + is 1e-14. + + When one of the inputs has several rows, return the result of the + test for each element of the array tested against the single + parameter. + + When both POINTARRAY and EDGEARRAY have the same number of rows, + returns a column vector with the same number of rows. When the + number of rows are different and both greater than 1, returns a + Np-by-Ne matrix of booleans, containing the result for each couple + of point and edge. + + See also: edges2d, points2d, isPointOnLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Test if a point belongs to an edge. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +isPointOnLine + + +# name: +# type: sq_string +# elements: 1 +# length: 473 + -- Function File: B = isPointOnLine (POINT, LINE) + Test if a point belongs to a line + + B = isPointOnLine(POINT, LINE) with POINT being [xp yp], and + LINE being [x0 y0 dx dy]. Returns 1 if point lies on the line, + 0 otherwise. + + If POINT is an N*2 array of points, B is a N*1 array of booleans. + + If LINE is a N*4 array of line, B is a 1*N array of booleans. + + See also: lines2d, points2d, isPointOnEdge, isPointOnRay, + angle3Points + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Test if a point belongs to a line + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +isPointOnRay + + +# name: +# type: sq_string +# elements: 1 +# length: 393 + -- Function File: B = isPointOnRay (POINT, RAY) + -- Function File: B = isPointOnRay (POINT, RAY, TOL) + Test if a point belongs to a ray + + B = isPointOnRay(POINT, RAY); Returns `true' if point POINT + belongs to the ray RAY. POINT is given by [x y] and RAY by [x0 + y0 dx dy]. TOL gives the tolerance for the calculations. + + See also: rays2d, points2d, isPointOnLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Test if a point belongs to a ray + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +lineAngle + + +# name: +# type: sq_string +# elements: 1 +# length: 527 + -- Function File: THETA = lineAngle(varargin) + Computes angle between two straight lines + + A = lineAngle(LINE); Returns the angle between horizontal, + right-axis and the given line. Angle is fiven in radians, + between 0 and 2*pi, in counter-clockwise direction. + + A = lineAngle(LINE1, LINE2); Returns the directed angle between + the two lines. Angle is given in radians between 0 and 2*pi, in + counter-clockwise direction. + + See also: lines2d, angles2d, createLine, normalizeAngle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 +Computes angle between two straight lines + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +linePosition + + +# name: +# type: sq_string +# elements: 1 +# length: 890 + -- Function File: POS = linePosition (POINT, LINE) + Position of a point on a line. + + Computes position of point POINT on the line LINE, relative to + origin point and direction vector of the line. LINE has the + form [x0 y0 dx dy], POINT has the form [x y], and is assumed to + belong to line. + + If LINE is an array of NL lines, return NL positions, + corresponding to each line. + + If POINT is an array of NP points, return NP positions, + corresponding to each point. + + If POINT is an array of NP points and LINES is an array of NL + lines, return an array of [NP NL] position, corresponding to + each couple point-line. + + Example + + line = createLine([10 30], [30 90]); + linePosition([20 60], line) + ans = + .5 + + See also: lines2d, createLine, projPointOnLine, isPointOnLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Position of a point on a line. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +lines2d + + +# name: +# type: sq_string +# elements: 1 +# length: 996 + -- Function File: lines2d () + Description of functions operating on planar lines. + + The term 'line' refers to a planar straight line, which is an + unbounded curve. Line segments defined between 2 points, which + are bounded, are called 'edge', and are presented in file + 'edges2d'. + + A straight line is defined by a point (its origin), and a vector + (its direction). The different parameters are bundled into a row + vector: LINE = [x0 y0 dx dy]; + + A line contains all points (x,y) such that: x = x0 + t*dx + y = y0 + t*dy; for all t between -infinity and +infinity. + + See also: points2d, vectors2d, edges2d, rays2d createLine, + cartesianLine, medianLine, edgeToLine orthogonalLine, + parallelLine, bisector, radicalAxis lineAngle, linePosition, + projPointOnLine isPointOnLine, distancePointLine, isLeftOriented + intersectLines, intersectLineEdge, clipLine invertLine, + transformLine, drawLine lineFit + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Description of functions operating on planar lines. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +medianLine + + +# name: +# type: sq_string +# elements: 1 +# length: 1284 + -- Function File: LINE = medianLine (P1, P2) + -- Function File: LINE = medianLine (PTS) + -- Function File: LINE = medianLine (EDGE) + Create a median line between two points. + + Create the median line of points P1 and P2, that is the line + containing all points located at equal distance of P1 and P2. + + Creates the median line of 2 points, given as a 2*2 array PTS. + Array has the form: [ [ x1 y1 ] ; [ x2 y2 ] ] + + Creates the median of the EDGE. EDGE is a 1*4 array, containing + [X1 Y1] coordinates of first point, and [X2 Y2], the coordinates + of the second point. + + Example + + % Draw the median line of two points + P1 = [10 20]; + P2 = [30 50]; + med = medianLine(P1, P2); + figure; axis square; axis([0 100 0 100]); + drawEdge([P1 P2], 'linewidth', 2, 'color', 'k'); + drawLine(med) + + % Draw the median line of an edge + P1 = [50 60]; + P2 = [80 30]; + edge = createEdge(P1, P2); + figure; axis square; axis([0 100 0 100]); + drawEdge(edge, 'linewidth', 2) + med = medianLine(edge); + drawLine(med) + + See also: lines2d, createLine, orthogonalLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Create a median line between two points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +mergeBoxes + + +# name: +# type: sq_string +# elements: 1 +# length: 316 + -- Function File: BOX = mergeBoxes (BOX1, BOX2) + Merge two boxes, by computing their greatest extent. + + Example + + box1 = [5 20 5 30]; + box2 = [0 15 0 15]; + mergeBoxes(box1, box2) + ans = + 0 20 0 30 + + See also: boxes2d, drawBox, intersectBoxes + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +Merge two boxes, by computing their greatest extent. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +midPoint + + +# name: +# type: sq_string +# elements: 1 +# length: 868 + -- Function File: MID = midPoint (P1, P2) + -- Function File: MID = midPoint (EDGE) + -- Function File: [MIDX, MIDY] = midPoint (EDGE) + Middle point of two points or of an edge + + Computes the middle point of the two points P1 and P2. + + If an edge is given, computes the middle point of the edge given + by EDGE. EDGE has the format: [X1 Y1 X2 Y2], and MID has the + format [XMID YMID], with XMID = (X1+X2)/2, and YMID = (Y1+Y2)/2. + + If two output arguments are given, it returns the result as two + separate variables or arrays. + + Works also when EDGE is a N-by-4 array, in this case the result is + a N-by-2 array containing the midpoint of each edge. + + Example + + p1 = [10 20]; + p2 = [30 40]; + midPoint([p1 p2]) + ans = + 20 30 + + See also: edges2d, points2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +Middle point of two points or of an edge + + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +minDistancePoints + + +# name: +# type: sq_string +# elements: 1 +# length: 2407 + -- Function File: DIST = minDistancePoints (PTS) + -- Function File: DIST = minDistancePoints (PTS1,PTS2) + -- Function File: DIST = minDistancePoints (...,NORM) + -- Function File: [DIST I J] = minDistancePoints (PTS1, PTS2, ...) + -- Function File: [DIST J] = minDistancePoints (PTS1, PTS2, ...) + Minimal distance between several points. + + Returns the minimum distance between all couple of points in PTS. + PTS is an array of [NxND] values, N being the number of points + and ND the dimension of the points. + + Computes for each point in PTS1 the minimal distance to every + point of PTS2. PTS1 and PTS2 are [NxD] arrays, where N is the + number of points, and D is the dimension. Dimension must be the + same for both arrays, but number of points can be different. + The result is an array the same length as PTS1. + + When NORM is provided, it uses a user-specified norm. NORM=2 means + euclidean norm (the default), NORM=1 is the Manhattan (or + "taxi-driver") distance. Increasing NORM growing up reduces the + minimal distance, with a limit to the biggest coordinate + difference among dimensions. + + Returns indices I and J of the 2 points which are the closest. DIST + verifies relation: DIST = distancePoints(PTS(I,:), PTS(J,:)); + + If only 2 output arguments are given, it returns the indices of + points which are the closest. J has the same size as DIST. for + each I It verifies the relation : DIST(I) = + distancePoints(PTS1(I,:), PTS2(J,:)); + + Examples: + + % minimal distance between random planar points + points = rand(20,2)*100; + minDist = minDistancePoints(points); + + % minimal distance between random space points + points = rand(30,3)*100; + [minDist ind1 ind2] = minDistancePoints(points); + minDist + distancePoints(points(ind1, :), points(ind2, :)) + % results should be the same + + % minimal distance between 2 sets of points + points1 = rand(30,2)*100; + points2 = rand(30,2)*100; + [minDists inds] = minDistancePoints(points1, points2); + minDists(10) + distancePoints(points1(10, :), points2(inds(10), :)) + % results should be the same + + See also: points2d, distancePoints + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Minimal distance between several points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +normalizeAngle + + +# name: +# type: sq_string +# elements: 1 +# length: 884 + -- Function File: ALPHA2 = normalizeAngle (ALPHA) + -- Function File: ALPHA2 = normalizeAngle (ALPHA, CENTER) + Normalize an angle value within a 2*PI interval + + ALPHA2 = normalizeAngle(ALPHA); ALPHA2 is the same as ALPHA + modulo 2*PI and is positive. + + ALPHA2 = normalizeAngle(ALPHA, CENTER); Specifies the center of + the angle interval. If CENTER==0, the interval is [-pi ; +pi] + If CENTER==PI, the interval is [0 ; 2*pi] (default). + + Example: % normalization between 0 and 2*pi (default) + normalizeAngle(5*pi) ans = 3.1416 + + % normalization between -pi and +pi normalizeAngle(7*pi/2, 0) + ans = -1.5708 + + References Follows the same convention as apache commons + library, see: + http://commons.apache.org/math/api-2.2/org/apache/commons/math/util/MathUtils.html%% + + See also: vectorAngle, lineAngle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Normalize an angle value within a 2*PI interval + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +normalizeVector + + +# name: +# type: sq_string +# elements: 1 +# length: 503 + -- Function File: VN = normalizeVector (V) + Normalize a vector to have norm equal to 1 + + Returns the normalization of vector V, such that ||V|| = 1. V can + be either a row or a column vector. + + When V is a MxN array, normalization is performed for each row of + the array. + + Example: + + vn = normalizeVector([3 4]) + vn = + 0.6000 0.8000 + vectorNorm(vn) + ans = + 1 + + See also: vectors2d, vectorNorm + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Normalize a vector to have norm equal to 1 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +orthogonalLine + + +# name: +# type: sq_string +# elements: 1 +# length: 343 + -- Function File: PERP = orthogonalLine (LINE, POINT) + Create a line orthogonal to another one. + + Returns the line orthogonal to the line LINE and going through the + point given by POINT. Directed angle from LINE to PERP is pi/2. + LINE is given as [x0 y0 dx dy] and POINT is [xp yp]. + + See also: lines2d, parallelLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Create a line orthogonal to another one. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +parallelLine + + +# name: +# type: sq_string +# elements: 1 +# length: 565 + -- Function File: RES = parallelLine (LINE, POINT) + -- Function File: RES = parallelLine (LINE, DIST) + Create a line parallel to another one. + + Returns the line with same direction vector than LINE and going + through the point given by POINT. LINE is given as [x0 y0 dx + dy] and POINT is [xp yp]. + + Uses relative distance to specify position. The new line will be + located at distance DIST, counted positive in the right side of + LINE and negative in the left side. + + See also: lines2d, orthogonalLine, distancePointLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Create a line parallel to another one. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +pointOnLine + + +# name: +# type: sq_string +# elements: 1 +# length: 451 + -- Function File: POINT = pointOnLine (LINE, D) + Create a point on a line at a given position on the line. + + Creates the point belonging to the line LINE, and located at the + distance D from the line origin. LINE has the form [x0 y0 dx + dy]. LINE and D should have the same number N of rows. The + result will have N rows and 2 column (x and y positions). + + See also: lines2d, points2d, onLine, onLine, linePosition + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 +Create a point on a line at a given position on the line. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +points2d + + +# name: +# type: sq_string +# elements: 1 +# length: 591 + -- Function File: points2d () + Description of functions operating on points. + + A point is defined by its two cartesian coordinate, put into a row + vector of 2 elements: P = [x y]; + + Several points are stores in a matrix with two columns, one for the + x-coordinate, one for the y-coordinate. PTS = [x1 y1 ; x2 y2 ; + x3 y3]; + + Example P = [5 6]; + + See also: centroid, midPoint, polarPoint, pointOnLine + isCounterClockwise, angle2Points, angle3Points, angleSort + distancePoints, minDistancePoints transformPoint, clipPoints, + drawPoint + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Description of functions operating on points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +polarPoint + + +# name: +# type: sq_string +# elements: 1 +# length: 760 + -- Function File: POINT = polarPoint (RHO, THETA) + -- Function File: POINT = polarPoint (THETA) + -- Function File: POINT = polarPoint (POINT, RHO, THETA) + -- Function File: POINT = polarPoint (X0, Y0, RHO, THETA) + Create a point from polar coordinates (rho + theta) + + Creates a point using polar coordinate. THETA is angle with + horizontal (counted counter-clockwise, and in radians), and RHO + is the distance to origin. If only angle is given radius RHO is + assumed to be 1. + + If a point is given, adds the coordinate of the point to the + coordinate of the specified point. For example, creating a point + with : P = polarPoint([10 20], 30, pi/2); will give a result + of [40 20]. + + See also: points2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +Create a point from polar coordinates (rho + theta) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +projPointOnLine + + +# name: +# type: sq_string +# elements: 1 +# length: 566 + -- Function File: POINT = projPointOnLine (PT1, LINE) + Project of a point orthogonally onto a line + + Computes the (orthogonal) projection of point PT1 onto the line + LINE. + + Function works also for multiple points and lines. In this case, it + returns multiple points. Point PT1 is a [N*2] array, and LINE + is a [N*4] array (see createLine for details). Result POINT is a + [N*2] array, containing coordinates of orthogonal projections of + PT1 onto lines LINE. + + See also: lines2d, points2d, isPointOnLine, linePosition + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 +Project of a point orthogonally onto a line + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +rad2deg + + +# name: +# type: sq_string +# elements: 1 +# length: 284 + -- Function File: DEG = rad2deg(RAD) + Convert angle from radians to degrees + + Usage: R = rad2deg(D) convert an angle in radians to angle in + degrees + + Example: rad2deg(pi) ans = 180 rad2deg(pi/3) ans = + 60 + + See also: angles2d, deg2rad + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Convert angle from radians to degrees + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +radicalAxis + + +# name: +# type: sq_string +# elements: 1 +# length: 522 + -- Function File: LINE = radicalAxis (CIRCLE1, CIRCLE2) + Compute the radical axis (or radical line) of 2 circles + + L = radicalAxis(C1, C2) Computes the radical axis of 2 circles. + + Example C1 = [10 10 5]; C2 = [60 50 30]; L = radicalAxis(C1, + C2); hold on; axis equal;axis([0 100 0 100]); + drawCircle(C1);drawCircle(C2);drawLine(L); + + Ref: http://mathworld.wolfram.com/RadicalLine.html + http://en.wikipedia.org/wiki/Radical_axis + + See also: lines2d, circles2d, createCircle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 +Compute the radical axis (or radical line) of 2 circles + + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +randomPointInBox + + +# name: +# type: sq_string +# elements: 1 +# length: 658 + -- Function File: POINTS = randomPointInBox (BOX) + -- Function File: POINTS = randomPointInBox (BOX, N) + Generate random points within a box. + + Generate a random point within the box BOX. The result is a 1-by-2 + row vector. If N is given, generates N points. The result is a + N-by-2 array. + + Example + + % draw points within a box + box = [10 80 20 60]; + pts = randomPointInBox(box, 500); + figure(1); clf; hold on; + drawBox(box); + drawPoint(pts, '.'); + axis('equal'); + axis([0 100 0 100]); + + See also: edges2d, boxes2d, clipLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Generate random points within a box. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +rays2d + + +# name: +# type: sq_string +# elements: 1 +# length: 722 + -- Function File: rays2d () + Description of functions operating on planar rays + + A ray is defined by a point (its origin), and a vector (its + direction). The different parameters are bundled into a row vector: + `RAY = [x0 y0 dx dy];' + + The ray contains all the points (x,y) such that: x = x0 + t*dx + y = y0 + t*dy; for all t>0 + + Contrary to a (straight) line, the points located before the + origin do not belong to the ray. However, as rays and lines + have the same representation, some functions working on lines + are also working on rays (like `transformLine'). + + See also: points2d, vectors2d, lines2d, createRay, bisector, + isPointOnRay, clipRay, drawRay + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Description of functions operating on planar rays + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +reverseEdge + + +# name: +# type: sq_string +# elements: 1 +# length: 312 + -- Function File: RES = reverseEdge (EDGE) + Intervert the source and target vertices of edge + + REV = reverseEdge(EDGE); Returns the opposite edge of EDGE. + EDGE has the format [X1 Y1 X2 Y2]. The resulting edge REV has value + [X2 Y2 X1 Y1]; + + See also: edges2d, createEdge, reverseLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Intervert the source and target vertices of edge + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +reverseLine + + +# name: +# type: sq_string +# elements: 1 +# length: 318 + -- Function File: LINE = reverseLine (LINE) + Return same line but with opposite orientation + + INVLINE = reverseLine(LINE); Returns the opposite line of LINE. + LINE has the format [x0 y0 dx dy], then INVLINE will have + following parameters: [x0 y0 -dx -dy]. + + See also: lines2d, createLine + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Return same line but with opposite orientation + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +rotateVector + + +# name: +# type: sq_string +# elements: 1 +# length: 304 + -- Function File: VR = rotateVector (V, THETA) + Rotate a vector by a given angle + + Rotate the vector V by an angle THETA, given in radians. + + Example + + rotateVector([1 0], pi/2) + ans = + 0 1 + + See also: vectors2d, transformVector, createRotation + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Rotate a vector by a given angle + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +squareGrid + + +# name: +# type: sq_string +# elements: 1 +# length: 494 + -- Function File: PTS = squaregrid (BOUNDS, ORIGIN, SIZE) + Generate equally spaces points in plane. + + usage PTS = squareGrid(BOUNDS, ORIGIN, SIZE) generate points, + lying in the window defined by BOUNDS (=[xmin ymin xmax ymax]), + starting from origin with a constant step equal to size. + + Example PTS = squareGrid([0 0 10 10], [3 3], [4 2]) will + return points : [3 1;7 1;3 3;7 3;3 5;7 5;3 7;7 7;3 9;7 9]; + + TODO: add possibility to use rotated grid + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Generate equally spaces points in plane. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +transformEdge + + +# name: +# type: sq_string +# elements: 1 +# length: 587 + -- Function File: EDGE2 = transformEdge (EDGE1, T) + Transform an edge with an affine transform. + + Where EDGE1 has the form [x1 y1 x2 y1], and T is a transformation + matrix, return the edge transformed with affine transform T. + + Format of TRANS can be one of : [a b] , [a b c] , or [a b c] + [d e] [d e f] [d e f] [0 0 + 1] + + Also works when EDGE1 is a [Nx4] array of double. In this case, + EDGE2 has the same size as EDGE1. + + See also: edges2d, transforms2d, transformPoint, translation, + rotation + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Transform an edge with an affine transform. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +transformLine + + +# name: +# type: sq_string +# elements: 1 +# length: 554 + -- Function File: LINE2 = transformLine (LINE1, T) + Transform a line with an affine transform. + + Returns the line LINE1 transformed with affine transform T. + LINE1 has the form [x0 y0 dx dy], and T is a transformation + matrix. + + Format of T can be one of : [a b] , [a b c] , or [a b c] + [d e] [d e f] [d e f] [0 0 1] + + Also works when LINE1 is a [Nx4] array of double. In this case, + LINE2 has the same size as LINE1. + + See also: lines2d, transforms2d, transformPoint + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 +Transform a line with an affine transform. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +transformPoint + + +# name: +# type: sq_string +# elements: 1 +# length: 849 + -- Function File: PT2 = transformPoint (PT1, TRANS) + -- Function File: [PX2 PY2]= transformPoint (PX1, PY1, TRANS) + Transform a point with an affine transform. + + where PT1 has the form [xp yp], and TRANS is a [2x2], [2x3] or + [3x3] matrix, returns the point transformed with affine + transform TRANS. + + Format of TRANS can be one of : [a b] , [a b c] , or [a b c] + [d e] [d e f] [d e f] [0 0 + 1] + + Also works when PT1 is a [Nx2] array of double. In this case, PT2 + has the same size as PT1. + + Also works when PX1 and PY1 are arrays the same size. The function + transform each couple of (PX1, PY1), and return the result in + (PX2, PY2), which is the same size as (PX1 PY1). + + See also: points2d, transforms2d, createTranslation, createRotation + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Transform a point with an affine transform. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +transformVector + + +# name: +# type: sq_string +# elements: 1 +# length: 786 + -- Function File: V2 = transformVector (V, T) + -- Function File: [X2 Y2] = transformVector (X,Y, T) + Transform a vector with an affine transform + + V has the form [xv yv], and T is a [2x2], [2x3] or [3x3] matrix, + returns the vector transformed with affine transform T. + + Format of T can be one of : + [a b] , [a b c] , or [a b c] [d e] [d e f] [d e f] + [0 0 1] + + Also works when V is a [Nx2] array of double. In this case, V2 has + the same size as V. + + Also works when X and Y are arrays the same size. The function + transform each couple of (X, Y), and return the result in (X2, + Y2), which is the same size as (X, Y). + + See also: vectors2d, transforms2d, rotateVector, transformPoint + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 +Transform a vector with an affine transform + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +transforms2d + + +# name: +# type: sq_string +# elements: 1 +# length: 675 + -- Function File: transforms2d () + Description of functions operating on transforms + + By 'transform' we mean an affine transform. A planar affine + transform can be represented by a 3x3 matrix. + + Example + + % create a translation by the vector [10 20]: + T = createTranslation([10 20]) + T = + 1 0 10 + 0 1 20 + 0 0 1 + + See also: createTranslation, createRotation, createScaling, + createBasisTransform, createHomothecy, createLineReflection, + fitAffineTransform2d, transformPoint, transformVector, + transformLine, transformEdge, rotateVector + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Description of functions operating on transforms + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +triangleGrid + + +# name: +# type: sq_string +# elements: 1 +# length: 477 + -- Function File: PTS = triangleGrid (BOUNDS, ORIGIN, SIZE) + Generate triangular grid of points in the plane. + + usage PTS = triangleGrid(BOUNDS, ORIGIN, SIZE) generate + points, lying in the window defined by BOUNDS, given in form + [xmin ymin xmax ymax], starting from origin with a constant step + equal to size. SIZE is constant and is equals to the length + of the sides of each triangles. + + TODO: add possibility to use rotated grid + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Generate triangular grid of points in the plane. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +vectorAngle + + +# name: +# type: sq_string +# elements: 1 +# length: 932 + -- Function File: ALPHA = vectorAngle (V1) + Angle of a vector, or between 2 vectors + + A = vectorAngle(V); Returns angle between Ox axis and vector + direction, in Counter clockwise orientation. The result is + normalised between 0 and 2*PI. + + A = vectorAngle(V1, V2); Returns the angle from vector V1 to + vector V2, in counter-clockwise order, and in radians. + + A = vectorAngle(..., 'cutAngle', CUTANGLE); A = vectorAngle(..., + CUTANGLE); % (deprecated syntax) Specifies convention for angle + interval. CUTANGLE is the center of the 2*PI interval containing + the result. See normalizeAngle for details. + + Example: rad2deg(vectorAngle([2 2])) ans = 45 + rad2deg(vectorAngle([1 sqrt(3)])) ans = 60 + rad2deg(vectorAngle([0 -1])) ans = 270 + + See also: vectors2d, angles2d, normalizeAngle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Angle of a vector, or between 2 vectors + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +vectorNorm + + +# name: +# type: sq_string +# elements: 1 +# length: 751 + -- Function File: NM = vectorNorm (V) + -- Function File: NM = vectorNorm (V,N) + Compute norm of a vector, or of a set of vectors + + Without extra arguments, returns the euclidean norm of vector V. + Optional argument N specifies the norm to use. N can be any value + greater than 0. + `N=1' + City lock norm. + + `N=2' + Euclidean norm. + + `N=inf' + Compute max coord. + + When V is a MxN array, compute norm for each vector of the array. + Vector are given as rows. Result is then a Mx1 array. + + Example + + n1 = vectorNorm([3 4]) + n1 = + 5 + + n2 = vectorNorm([1, 10], inf) + n2 = + 10 + + See also: vectors2d, vectorAngle + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Compute norm of a vector, or of a set of vectors + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +vectors2d + + +# name: +# type: sq_string +# elements: 1 +# length: 502 + -- Function File: vectors2d () + Description of functions operating on plane vectors + + A vector is defined by its two cartesian coordinates, put into a + row vector of 2 elements: `V = [vx vy];' + + Several vectors are stored in a matrix with two columns, one for + the x-coordinate, one for the y-coordinate. `VS = [vx1 vy1 ; + vx2 vy2 ; vx3 vy3];' + + See also: vectorNorm, vectorAngle, isPerpendicular, isParallel, + normalizeVector, transformVector, rotateVector + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +Description of functions operating on plane vectors + + + + + + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawArrow.m b/octave_packages/geometry-1.5.0/geom2d/drawArrow.m new file mode 100644 index 0000000..0fc846c --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawArrow.m @@ -0,0 +1,142 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} = } drawArrow (@var{x1}, @var{y1}, @var{x2}, @var{y2}) +%% @deftypefnx {Function File} {@var{h} = } drawArrow ([@var{ @var{x1}} @var{ @var{y1}} @var{x2} @var{y2}]) +%% @deftypefnx {Function File} {@var{h} = } drawArrow (@dots{}, @var{L}, @var{W}) +%% @deftypefnx {Function File} {@var{h} = } drawArrow (@dots{}, @var{L}, @var{W},@var{TYPE}) +%% Draw an arrow on the current axis. +%% +%% draw an arrow between the points (@var{x1} @var{y1}) and (@var{x2} @var{y2}). +%% The points can be given as a single array. @var{L}, @var{W} specify length +%% and width of the arrow. +%% +%% Also specify arrow type. @var{TYPE} can be one of the following : +%% 0: draw only two strokes +%% 1: fill a triangle +%% .5: draw a half arrow (try it to see ...) +%% +%% Arguments can be single values or array of size [N*1]. In this case, +%% the function draws multiple arrows. +%% +%% @end deftypefn + +function varargout = drawArrow(varargin) + + if isempty(varargin) + error('should specify at least one argument'); + end + + % parse arrow coordinate + var = varargin{1}; + if size(var, 2)==4 + @var{x1} = var(:,1); + @var{y1} = var(:,2); + x2 = var(:,3); + y2 = var(:,4); + varargin = varargin(2:end); + elseif length(varargin)>3 + @var{x1} = varargin{1}; + @var{y1} = varargin{2}; + x2 = varargin{3}; + y2 = varargin{4}; + varargin = varargin(5:end); + else + error('wrong number of arguments, please read the doc'); + end + + l = 10*size(size( @var{x1})); + w = 5*ones(size( @var{x1})); + h = zeros(size( @var{x1})); + + % exctract length of arrow + if ~isempty(varargin) + l = varargin{1}; + if length( @var{x1})>length(l) + l = l(1)*ones(size( @var{x1})); + end + end + + % extract width of arrow + if length(varargin)>1 + w = varargin{2}; + if length( @var{x1})>length(w) + w = w(1)*ones(size( @var{x1})); + end + end + + % extract 'ratio' of arrow + if length(varargin)>2 + h = varargin{3}; + if length( @var{x1})>length(h) + h = h(1)*ones(size( @var{x1})); + end + end + + hold on; + axis equal; + + % angle of the edge + theta = atan2(y2- @var{y1}, x2- @var{x1}); + + % point on the 'left' + xa1 = x2 - l.*cos(theta) - w.*sin(theta)/2; + ya1 = y2 - l.*sin(theta) + w.*cos(theta)/2; + % point on the 'right' + xa2 = x2 - l.*cos(theta) + w.*sin(theta)/2; + ya2 = y2 - l.*sin(theta) - w.*cos(theta)/2; + % point on the middle of the arrow + xa3 = x2 - l.*cos(theta).*h; + ya3 = y2 - l.*sin(theta).*h; + + % draw main edge + line([ @var{x1}'; x2'], [ @var{y1}'; y2'], 'color', [0 0 1]); + + % draw only 2 wings + ind = find(h==0); + line([xa1(ind)'; x2(ind)'], [ya1(ind)'; y2(ind)'], 'color', [0 0 1]); + line([xa2(ind)'; x2(ind)'], [ya2(ind)'; y2(ind)'], 'color', [0 0 1]); + + % draw a full arrow + ind = find(h~=0); + patch([x2(ind) xa1(ind) xa3(ind) xa2(ind) x2(ind)]', ... + [y2(ind) ya1(ind) ya3(ind) ya2(ind) y2(ind)]', [0 0 1]); + + + if nargout>0 + varargout{1}=h; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawBezierCurve.m b/octave_packages/geometry-1.5.0/geom2d/drawBezierCurve.m new file mode 100644 index 0000000..51b5110 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawBezierCurve.m @@ -0,0 +1,107 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} drawBezierCurve (@var{points}) +%% @deftypefnx {Command} {Function File} drawBezierCurve (@var{pp}) +%% @deftypefnx {Command} {Function File} drawBezierCurve (..., @var{param}, @var{value}, ...) +%% @deftypefnx {Command} {Function File} {@var{h} =}drawBezierCurve (...) +%% Draw a cubic bezier curve defined by the control points @var{points}. +%% +%% With only one input argument, draws the Bezier curve defined by the 4 control +%% points stored in @var{points}. @var{points} is either a 4-by-2 array +%% (vertical concatenation of point coordinates), or a 1-by-8 array (horizotnal +%% concatenation of point coordinates). The curve could be described by its +%% polynomial (output of @code{cbezier2poly}) @var{pp}, which should be a 2-by-4 +%% array. +%% +%% The optional @var{param}, @var{value} pairs specify additional drawing +%% parameters, see the @code{plot} function for details. The specific parameter +%% 'discretization' with an integer associated value defines the amount of +%% points used to plot the curve. If the output is requiered, the function +%% returns the handle to the created graphic object. +%% +%% @seealso{cbezier2poly, plot} +%% @end deftypefn + +function varargout = drawBezierCurve(points, varargin) + + % default number of discretization steps + N = 64; + + % check if discretization step is specified + if ~isempty(varargin) + [tf idx] = ismember ({'discretization'},{varargin{1:2:end}}); + if ~isempty(idx) + N = varargin{idx+1}; + varargin(idx:idx+1) = []; + end + end + + % parametrization variable for bezier (use N+1 points to have N edges) + t = linspace(0, 1, N+1); + + if any(size(points) ~= [2 4]) + [x y] = cbezier2poly(points,t); + else + % Got a polynomial description + x = polyval(points(1,:),t); + y = polyval(points(2,:),t); + end + + % draw the curve + h = plot(x, y, varargin{:}); + + % eventually return a handle to the created object + if nargout > 0 + varargout = {h}; + end +endfunction + +%!demo +%! points = [0 0; 3 1; -2 1; 1 0]; +%! drawBezierCurve(points); +%! hold on +%! plot(points([1 4],1),points([1 4],2),'go'); +%! plot(points([2 3],1),points([2 3],2),'rs'); +%! line(points([1 2],1),points([1 2],2),'color','k'); +%! line(points([3 4],1),points([3 4],2),'color','k'); +%! h = drawBezierCurve(points, 'discretization', 6, 'color','r'); +%! hold off + +%!shared p +%! p = [0 0; 3 1; -2 1; 1 0]; +%!error(drawBezier()) +%!error(drawBezier ('discretization')) +%!error(drawBezier (p, 'discretization', 'a')) +%!error(drawBezier (p(:))) diff --git a/octave_packages/geometry-1.5.0/geom2d/drawBox.m b/octave_packages/geometry-1.5.0/geom2d/drawBox.m new file mode 100644 index 0000000..42e6447 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawBox.m @@ -0,0 +1,81 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} =} drawBox (@var{box}) +%% @deftypefnx {Function File} {@var{h} =} drawBox (@var{box}, @var{param}, @var{value}, ...) +%% Draw a box defined by coordinate extents +%% +%% Draws a box defined by its extent: @var{box} = [@var{xmin} @var{xmax} +%% @var{ymin} @var{ymax}]. Addtional +%% arguments are passed to function @code{plot}. If requested, it returns the +%% handle to the graphics object created. +%% +%% @seealso{drawOrientedBox, drawRect, plot} +%% @end deftypefn + +function varargout = drawBox(box, varargin) + + % default values + xmin = box(:,1); + xmax = box(:,2); + ymin = box(:,3); + ymax = box(:,4); + + nBoxes = size(box, 1); + r = zeros(nBoxes, 1); + + % iterate on boxes + for i = 1:nBoxes + % exract min and max values + tx(1) = xmin(i); + ty(1) = ymin(i); + tx(2) = xmax(i); + ty(2) = ymin(i); + tx(3) = xmax(i); + ty(3) = ymax(i); + tx(4) = xmin(i); + ty(4) = ymax(i); + tx(5) = xmin(i); + ty(5) = ymin(i); + + % display polygon + r(i) = plot(tx, ty, varargin{:}); + end + + % format output + if nargout > 0 + varargout = {r}; + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/drawCenteredEdge.m b/octave_packages/geometry-1.5.0/geom2d/drawCenteredEdge.m new file mode 100644 index 0000000..68b5b25 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawCenteredEdge.m @@ -0,0 +1,152 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} =} drawCenteredEdge (@var{center}, @var{L}, @var{theta}) +%% @deftypefnx {Function File} {@var{h} =} drawCenteredEdge (@var{edge}) +%% @deftypefnx {Function File} {@var{h} =} drawCenteredEdge (@dots{}, @var{name},@var{value}) +%% Draw an edge centered on a point. +%% +%% drawCenteredEdge(CENTER, L, THETA) +%% Draws an edge centered on point CENTER, with length L, and orientation +%% THETA (given in degrees). Input arguments can also be arrays, that must +%% all have the same number odf rows. +%% +%% drawCenteredEdge(EDGE) +%% Concatenates edge parameters into a single N-by-4 array, containing: +%% [XC YV L THETA]. +%% +%% drawCenteredEdge(..., NAME, VALUE) +%% Also specifies drawing options by using one or several parameter name - +%% value pairs (see doc of plot function for details). +%% +%% H = drawCenteredEdge(...) +%% Returns handle(s) to the created edges(s). +%% +%% @example +%% % Draw an ellipse with its two axes +%% figure(1); clf; +%% center = [50 40]; +%% r1 = 30; r2 = 10; +%% theta = 20; +%% elli = [center r1 r2 theta]; +%% drawEllipse(elli, 'linewidth', 2); +%% axis([0 100 0 100]); axis equal; +%% hold on; +%% edges = [center 2*r1 theta ; center 2*r2 theta+90]; +%% drawCenteredEdge(edges, 'linewidth', 2, 'color', 'g'); +%% @end example +%% +%% @seealso{edges2d, drawEdge} +%% @end deftypefn + +function varargout = drawCenteredEdge(center, len, theta, varargin) + + %% process input variables + + if size(center, 2) == 4 + % manage edge in single parameter + + varargin = [{len, theta}, varargin]; + + len = center(:, 3); + theta = center(:, 4); + center = center(:, 1:2); + + N = size(center, 1); + + else + % parameters given in different arguments + + % size of data + NP = size(center, 1); + NL = size(len, 1); + ND = size(theta, 1); + N = max([NP NL ND]); + + % ensure all data have same size + if N > 1 + if NP == 1, center = repmat(center, [N 1]); end + if NL == 1, len = repmat(len, [N 1]); end + if ND == 1, theta = repmat(theta, [N 1]); end + end + + end + + % extract drawing options + options = varargin(:); + + + %% Draw edges + + % coordinates of center point + xc = center(:, 1); + yc = center(:, 2); + + % convert angle to radians + theta = theta * pi / 180; + + % computation shortcuts + cot = cos(theta); + sit = sin(theta); + + % compute starting and ending points + x1 = xc - len .* cot / 2; + x2 = xc + len .* cot / 2; + y1 = yc - len .* sit / 2; + y2 = yc + len .* sit / 2; + + + % draw the edges + h = zeros(N, 1); + for i = 1:N + h(i) = plot([x1(i) x2(i)], [y1(i) y2(i)]); + end + + % apply style to edges + if ~isempty(options) > 0 + for i = 1:N + set(h(i), options{:}); + end + end + + + %% Format output + + % process output arguments + if nargout > 0 + varargout = {h}; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawCircle.m b/octave_packages/geometry-1.5.0/geom2d/drawCircle.m new file mode 100644 index 0000000..7563d56 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawCircle.m @@ -0,0 +1,132 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} = } drawCircle (@var{x0}, @var{y0}, @var{r}) +%% @deftypefnx {Function File} {@var{h} = } drawCircle (@var{circle}) +%% @deftypefnx {Function File} {@var{h} = } drawCircle (@var{center}, @var{radius}) +%% @deftypefnx {Function File} {@var{h} = } drawCircle (@dots{}, @var{nstep}) +%% @deftypefnx {Function File} {@var{h} = } drawCircle (@dots{}, @var{name}, @var{value}) +%% Draw a circle on the current axis +%% +%% drawCircle(X0, Y0, R); +%% Draw the circle with center (X0,Y0) and the radius R. If X0, Y0 and R +%% are column vectors of the same length, draw each circle successively. +%% +%% drawCircle(CIRCLE); +%% Concatenate all parameters in a Nx3 array, where N is the number of +%% circles to draw. +%% +%% drawCircle(CENTER, RADIUS); +%% Specify CENTER as Nx2 array, and radius as a Nx1 array. +%% +%% drawCircle(..., NSTEP); +%% Specify the number of edges that will be used to draw the circle. +%% Default value is 72, creating an approximation of one point for each 5 +%% degrees. +%% +%% drawCircle(..., NAME, VALUE); +%% Specifies plotting options as pair of parameters name/value. See plot +%% documentation for details. +%% +%% +%% H = drawCircle(...); +%% return handles to each created curve. +%% +%% @seealso{circles2d, drawCircleArc, drawEllipse} +%% @end deftypefn + +function varargout = drawCircle(varargin) + + % process input parameters + var = varargin{1}; + if size(var, 2) == 1 + x0 = varargin{1}; + y0 = varargin{2}; + r = varargin{3}; + varargin(1:3) = []; + + elseif size(var, 2) == 2 + x0 = var(:,1); + y0 = var(:,2); + r = varargin{2}; + varargin(1:2) = []; + + elseif size(var, 2) == 3 + x0 = var(:,1); + y0 = var(:,2); + r = var(:,3); + varargin(1) = []; + else + error('bad format for input in drawCircle'); + end + + % ensure each parameter is column vector + x0 = x0(:); + y0 = y0(:); + r = r(:); + + % default number of discretization steps + N = 72; + + % check if discretization step is specified + if ~isempty(varargin) + var = varargin{1}; + if length(var)==1 && isnumeric(var) + N = round(var); + varargin(1) = []; + end + end + + % parametrization variable for circle (use N+1 as first point counts twice) + t = linspace(0, 2*pi, N+1); + cot = cos(t); + sit = sin(t); + + % empty array for graphic handles + h = zeros(size(x0)); + + % compute discretization of each circle + for i = 1:length(x0) + xt = x0(i) + r(i) * cot; + yt = y0(i) + r(i) * sit; + + h(i) = plot(xt, yt, varargin{:}); + end + + if nargout > 0 + varargout = {h}; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawCircleArc.m b/octave_packages/geometry-1.5.0/geom2d/drawCircleArc.m new file mode 100644 index 0000000..c2ab370 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawCircleArc.m @@ -0,0 +1,123 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} = } drawCircleArc (@var{xc}, @var{yc}, @var{r}, @var{start}, @var{end}) +%% @deftypefnx {Function File} {@var{h} = } drawCircleArc (@var{arc}) +%% @deftypefnx {Function File} {@var{h} = } drawCircleArc (@dots{}, @var{param}, @var{value}) +%% Draw a circle arc on the current axis +%% +%% drawCircleArc(XC, YC, R, START, EXTENT); +%% Draws circle with center (XC, YC), with radius R, starting from angle +%% START, and with angular extent given by EXTENT. START and EXTENT angles +%% are given in degrees. +%% +%% drawCircleArc(ARC); +%% Puts all parameters into one single array. +%% +%% drawCircleArc(..., PARAM, VALUE); +%% specifies plot properties by using one or several parameter name-value +%% pairs. +%% +%% H = drawCircleArc(...); +%% Returns a handle to the created line object. +%% +%% @example +%% % Draw a red thick circle arc +%% arc = [10 20 30 -120 240]; +%% figure; +%% axis([-50 100 -50 100]); +%% hold on +%% drawCircleArc(arc, 'LineWidth', 3, 'Color', 'r') +%% @end example +%% +%% @seealso{circles2d, drawCircle, drawEllipse} +%% @end deftypefn + +function varargout = drawCircleArc(varargin) + + if nargin == 0 + error('Need to specify circle arc'); + end + + circle = varargin{1}; + if size(circle, 2) == 5 + x0 = circle(:,1); + y0 = circle(:,2); + r = circle(:,3); + start = circle(:,4); + extent = circle(:,5); + varargin(1) = []; + + elseif length(varargin) >= 5 + x0 = varargin{1}; + y0 = varargin{2}; + r = varargin{3}; + start = varargin{4}; + extent = varargin{5}; + varargin(1:5) = []; + + else + error('drawCircleArc: please specify center, radius and angles of circle arc'); + end + + % convert angles in radians + t0 = deg2rad(start); + t1 = t0 + deg2rad(extent); + + % number of line segments + N = 60; + + % initialize handles vector + h = zeros(length(x0), 1); + + % draw each circle arc individually + for i = 1:length(x0) + % compute basis + t = linspace(t0(i), t1(i), N+1)'; + + % compute vertices coordinates + xt = x0(i) + r(i)*cos(t); + yt = y0(i) + r(i)*sin(t); + + % draw the circle arc + h(i) = plot(xt, yt, varargin{:}); + end + + if nargout > 0 + varargout = {h}; + end + + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawEdge.m b/octave_packages/geometry-1.5.0/geom2d/drawEdge.m new file mode 100644 index 0000000..d2196ee --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawEdge.m @@ -0,0 +1,164 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} = } drawEdge (@var{x1}, @var{y1}, @var{x2}, @var{y2}) +%% @deftypefnx {Function File} {@var{h} = } drawEdge ([@var{x1} @var{y1} @var{x2} @var{y2}]) +%% @deftypefnx {Function File} {@var{h} = } drawEdge ([@var{x1} @var{y1}], [@var{x2} @var{y2}]) +%% @deftypefnx {Function File} {@var{h} = } drawEdge (@var{x1}, @var{y1}, @var{z1}, @var{x2}, @var{y2}, @var{z2}) +%% @deftypefnx {Function File} {@var{h} = } drawEdge ([@var{x1} @var{y1} @var{z1} @var{x2} @var{y2} @var{z2}]) +%% @deftypefnx {Function File} {@var{h} = } drawEdge ([@var{x1} @var{y1} @var{z1}], [@var{x2} @var{y2} @var{z2}]) +%% @deftypefnx {Function File} {@var{h} = } drawEdge (@dots{}, @var{opt}) +%% Draw an edge given by 2 points. +%% +%% Draw an edge between the points (x1 y1) and (x2 y2). Data can be bundled as an edge. +%% The function supports 3D edges. +%% Arguments can be single values or array of size [Nx1]. In this case, +%% the function draws multiple edges. +%% @var{opt}, being a set of pairwise options, can +%% specify color, line width and so on. These are passed to function @code{line}. +%% The function returns handle(s) to created edges(s). +%% +%% @seealso{edges2d, drawCenteredEdge, drawLine, line} +%% @end deftypefn + +function varargout = drawEdge(varargin) + + % separate edge and optional arguments + [edge options] = parseInputArguments(varargin{:}); + + % draw the edges + if size(edge, 2)==4 + h = drawEdge_2d(edge, options); + else + h = drawEdge_3d(edge, options); + end + + % eventually return handle to created edges + if nargout>0 + varargout{1}=h; + end + +endfunction + +function h = drawEdge_2d(edge, options) + + h = -1*ones(size(edge, 1), 1); + + for i=1:size(edge, 1) + if isnan(edge(i,1)) + continue; + end + h(i) = line(... + [edge(i, 1) edge(i, 3)], ... + [edge(i, 2) edge(i, 4)], options{:}); + end + +endfunction + +function h = drawEdge_3d(edge, options) + + h = -1*ones(size(edge, 1), 1); + + for i=1:size(edge, 1) + if isnan(edge(i,1)) + continue; + end + h(i) = line( ... + [edge(i, 1) edge(i, 4)], ... + [edge(i, 2) edge(i, 5)], ... + [edge(i, 3) edge(i, 6)], options{:}); + end + +endfunction + +function [edge options] = parseInputArguments(varargin) + + % default values for parameters + edge = []; + + % find the number of arguments defining edges + nbVal=0; + for i=1:nargin + if isnumeric(varargin{i}) + nbVal = nbVal+1; + else + % stop at the first non-numeric value + break; + end + end + + % extract drawing options + options = varargin(nbVal+1:end); + + % ensure drawing options have correct format + if length(options)==1 + options = [{'color'}, options]; + end + + % extract edges characteristics + if nbVal==1 + % all parameters in a single array + edge = varargin{1}; + + elseif nbVal==2 + % parameters are two points, or two arrays of points, of size N*2. + p1 = varargin{1}; + p2 = varargin{2}; + edge = [p1 p2]; + + elseif nbVal==4 + % parameters are 4 parameters of the edge : x1 y1 x2 and y2 + edge = [varargin{1} varargin{2} varargin{3} varargin{4}]; + + elseif nbVal==6 + % parameters are 6 parameters of the edge : x1 y1 z1 x2 y2 and z2 + edge = [varargin{1} varargin{2} varargin{3} varargin{4} varargin{5} varargin{6}]; + end + +endfunction + +%!demo +%! close +%! points = rand(4,4); +%! colorstr = 'rgbm'; +%! for i=1:4 +%! drawEdge (points(i,:),'color',colorstr(i),'linewidth',2); +%! end +%! axis tight; + +%!demo +%! close +%! drawEdge (rand(10,4),'linewidth',2); +%! axis tight; + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawEllipse.m b/octave_packages/geometry-1.5.0/geom2d/drawEllipse.m new file mode 100644 index 0000000..e2eaa20 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawEllipse.m @@ -0,0 +1,141 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} = } drawEllipse (@var{elli}) +%% @deftypefnx {Function File} {@var{h} = } drawEllipse (@var{xc}, @var{yc}, @var{ra}, @var{rb}) +%% @deftypefnx {Function File} {@var{h} = } drawEllipse (@var{xc}, @var{yc}, @var{ra}, @var{rb}, @var{theta}) +%% @deftypefnx {Function File} {@var{h} = } drawEllipse (@dots{}, @var{param}, @var{value}) +%% Draw an ellipse on the current axis. +%% +%% drawEllipse(ELLI); +%% Draws the ellipse ELLI in the form [XC YC RA RB THETA], with center +%% (XC, YC), with main axis of half-length RA and RB, and orientation +%% THETA in degrees counted counter-clockwise. +%% Puts all parameters into one single array. +%% +%% drawEllipse(XC, YC, RA, RB); +%% drawEllipse(XC, YC, RA, RB, THETA); +%% Specifies ellipse parameters as separate arguments (old syntax). +%% +%% drawEllipse(..., NAME, VALUE); +%% Specifies drawing style of ellipse, see the help of plot function. +%% +%% H = drawEllipse(...); +%% Also returns handles to the created line objects. +%% +%% -> Parameters can also be arrays. In this case, all arrays are supposed +%% to have the same size. +%% +%% Example: +%% @example +%% % Draw an ellipse centered in [50 50], with semi major axis length of +%% % 40, semi minor axis length of 20, and rotated by 30 degrees. +%% figure(1); clf; hold on; +%% drawEllipse([50 50 40 20 30]); +%% axis equal; +%% @end example +%% +%% @seealso{ellipses2d, drawCircle, drawEllipseArc, ellipseAsPolygon} +%% @end deftypefn + +function varargout = drawEllipse(varargin) + + % extract dawing style strings + styles = {}; + for i = 1:length(varargin) + if ischar(varargin{i}) + styles = varargin(i:end); + varargin(i:end) = []; + break; + end + end + + % extract ellipse parameters + if length(varargin)==1 + % ellipse is given in a single array + ellipse = varargin{1}; + x0 = ellipse(:, 1); + y0 = ellipse(:, 2); + a = ellipse(:, 3); + b = ellipse(:, 4); + if length(ellipse)>4 + theta = ellipse(:, 5); + else + theta = zeros(size(x0)); + end + + elseif length(varargin)>=4 + % ellipse parameters given as separate arrays + x0 = varargin{1}; + y0 = varargin{2}; + a = varargin{3}; + b = varargin{4}; + if length(varargin)>4 + theta = varargin{5}; + else + theta = zeros(size(x0)); + end + + else + error('drawEllipse: incorrect input arguments'); + end + + + %% Process drawing of a set of ellipses + + % angular positions of vertices + t = linspace(0, 2*pi, 145); + + % compute position of points to draw each ellipse + h = zeros(length(x0), 1); + for i = 1:length(x0) + % pre-compute rotation angles (given in degrees) + cot = cosd(theta(i)); + sit = sind(theta(i)); + + % compute position of points used to draw current ellipse + xt = x0(i) + a(i) * cos(t) * cot - b(i) * sin(t) * sit; + yt = y0(i) + a(i) * cos(t) * sit + b(i) * sin(t) * cot; + + % stores handle to graphic object + h(i) = plot(xt, yt, styles{:}); + end + + % return handles if required + if nargout > 0 + varargout = {h}; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawEllipseArc.m b/octave_packages/geometry-1.5.0/geom2d/drawEllipseArc.m new file mode 100644 index 0000000..bd111e8 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawEllipseArc.m @@ -0,0 +1,161 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} = } drawEllipseArc (@var{arc}) +%% Draw an ellipse arc on the current axis. +%% +%% drawEllipseArc(ARC) +%% draw ellipse arc specified by ARC. ARC has the format: +%% ARC = [XC YC A B THETA T1 T2] +%% or: +%% ARC = [XC YC A B T1 T2] (isothetic ellipse) +%% with center (XC, YC), main axis of half-length A, second axis of +%% half-length B, and ellipse arc running from t1 to t2 (both in degrees, +%% in Counter-Clockwise orientation). +%% +%% Parameters can also be arrays. In this case, all arrays are suposed to +%% have the same size... +%% +%% @example +%% % draw an ellipse arc: center = [10 20], radii = 50 and 30, theta = 45 +%% arc = [10 20 50 30 45 -90 270]; +%% figure; +%% axis([-50 100 -50 100]); axis equal; +%% hold on +%% drawEllipseArc(arc, 'color', 'r') +%% +%% % draw another ellipse arc, between angles -60 and 70 +%% arc = [10 20 50 30 45 -60 (60+70)]; +%% figure; +%% axis([-50 100 -50 100]); axis equal; +%% hold on +%% drawEllipseArc(arc, 'LineWidth', 2); +%% ray1 = createRay([10 20], deg2rad(-60+45)); +%% drawRay(ray1) +%% ray2 = createRay([10 20], deg2rad(70+45)); +%% drawRay(ray2) +%% @end example +%% +%% @seealso{ellipses2d, drawEllipse, drawCircleArc} +%% @end deftypefn + +function varargout = drawEllipseArc(varargin) + + %% Extract input arguments + + % extract dawing style strings + styles = {}; + for i = 1:length(varargin) + if ischar(varargin{i}) + styles = varargin(i:end); + varargin(i:end) = []; + break; + end + end + + if length(varargin)==1 + ellipse = varargin{1}; + x0 = ellipse(1); + y0 = ellipse(2); + a = ellipse(3); + b = ellipse(4); + if size(ellipse, 2)>6 + theta = ellipse(5); + start = ellipse(6); + extent = ellipse(7); + else + theta = zeros(size(x0)); + start = ellipse(5); + extent = ellipse(6); + end + + elseif length(varargin)>=6 + x0 = varargin{1}; + y0 = varargin{2}; + a = varargin{3}; + b = varargin{4}; + if length(varargin)>6 + theta = varargin{5}; + start = varargin{6}; + extent = varargin{7}; + else + theta = zeros(size(x0)); + start = varargin{5}; + extent = varargin{6}; + end + + else + error('drawellipse: please specify center x, center y and radii a and b'); + end + + + %% Drawing + + % allocate memory for handles + h = zeros(size(x0)); + + for i = 1:length(x0) + % start and end angles + t1 = deg2rad(start); + t2 = t1 + deg2rad(extent); + + % vertices of ellipse + t = linspace(t1, t2, 60); + + % convert angles to ellipse parametrisation + sup = cos(t) > 0; + t(sup) = atan(a(i) / b(i) * tan(t(sup))); + t(~sup) = atan2(a(i) / b(i) * tan(2*pi - t(~sup)), -1); + t = mod(t, 2*pi); + + % precompute cos and sin of theta (given in degrees) + cot = cosd(theta(i)); + sit = sind(theta(i)); + + % compute position of points + xt = x0(i) + a(i)*cos(t)*cot - b(i)*sin(t)*sit; + yt = y0(i) + a(i)*cos(t)*sit + b(i)*sin(t)*cot; + + h(i) = plot(xt, yt, styles{:}); + end + + + %% Process output arguments + + if nargout > 0 + varargout = {h}; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawLabels.m b/octave_packages/geometry-1.5.0/geom2d/drawLabels.m new file mode 100644 index 0000000..219625c --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawLabels.m @@ -0,0 +1,108 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} drawLabels (@var{x}, @var{y}, @var{lbl}) +%% @deftypefnx {Function File} drawLabels (@var{pos}, @var{lbl}) +%% @deftypefnx {Function File} drawLabels (@dots{}, @var{numbers}, @var{format}) +%% Draw labels at specified positions. +%% +%% DRAWLABELS(X, Y, LBL) draw labels LBL at position X and Y. +%% LBL can be either a string array, or a number array. In this case, +%% string are created by using sprintf function, with '%.2f' mask. +%% +%% DRAWLABELS(POS, LBL) draw labels LBL at position specified by POS, +%% where POS is a N*2 int array. +%% +%% DRAWLABELS(..., NUMBERS, FORMAT) create labels using sprintf function, +%% with the mask given by FORMAT (e. g. '%03d' or '5.3f'), and the +%% corresponding values. +%% @end deftypefn + +function varargout = drawLabels(varargin) + + % check if enough inputs are given + if isempty(varargin) + error('wrong number of arguments in drawLabels'); + end + + % process input parameters + var = varargin{1}; + if size(var, 2)==1 + if length(varargin)<3 + error('wrong number of arguments in drawLabels'); + end + px = var; + py = varargin{2}; + lbl = varargin{3}; + varargin(1:3) = []; + else + if length(varargin)<2 + error('wrong number of arguments in drawLabels'); + end + px = var(:,1); + py = var(:,2); + lbl = varargin{2}; + varargin(1:2) = []; + end + + format = '%.2f'; + if ~isempty(varargin) + format = varargin{1}; + end + if size(format, 1)==1 && size(px, 1)>1 + format = repmat(format, size(px, 1), 1); + end + + labels = cell(length(px), 1); + if isnumeric(lbl) + for i=1:length(px) + labels{i} = sprintf(format(i,:), lbl(i)); + end + elseif ischar(lbl) + for i=1:length(px) + labels{i} = lbl(i,:); + end + elseif iscell(lbl) + labels = lbl; + end + labels = char(labels); + + h = text(px, py, labels); + + if nargout>0 + varargout{1}=h; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawLine.m b/octave_packages/geometry-1.5.0/geom2d/drawLine.m new file mode 100644 index 0000000..1bb5f05 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawLine.m @@ -0,0 +1,218 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} =} drawLine (@var{line}) +%% @deftypefnx {Function File} {@var{h} =} drawLine (@var{line}, @var{param},@var{value}) +%% Draw the line on the current axis. +%% +%% Draws the line LINE on the current axis, by using current axis to clip +%% the line. Extra @var{param},@var{value} pairs are passed to the @code{line} function. +%% Returns a handle to the created line object. If clipped line is not +%% contained in the axis, the function returns -1. +%% +%% Example +%% +%% @example +%% figure; hold on; axis equal; +%% axis([0 100 0 100]); +%% drawLine([30 40 10 20]); +%% drawLine([30 40 20 -10], 'color', 'm', 'linewidth', 2); +%% @end example +%% +%% @seealso{lines2d, createLine, drawEdge} +%% @end deftypefn + +function varargout = drawLine(lin, varargin) + + % default style for drawing lines + varargin = [{'color', 'b'}, varargin]; + + % extract bounding box of the current axis + xlim = get(gca, 'xlim'); + ylim = get(gca, 'ylim'); + + % clip lines with current axis box + clip = clipLine(lin, [xlim ylim]); + ok = isfinite(clip(:,1)); + + % initialize result array to invalide handles + h = -1*ones(size(lin, 1), 1); + + % draw valid lines + h(ok) = line(clip(ok, [1 3])', clip(ok, [2 4])', varargin{:}); + + % return line handle if needed + if nargout>0 + varargout{1}=h; + end + +endfunction + +%!demo +%! figure; hold on; axis equal; +%! axis([0 100 0 100]); +%! drawLine([30 40 10 20]); +%! drawLine([30 40 20 -10], 'color', 'm', 'linewidth', 2); + +%!shared privpath +%! privpath = [fileparts(which('geom2d_Contents')) filesep() 'private']; + +%!test +%! addpath (privpath,'-end') +%! box = [0 100 0 100]; +%! hf = figure('visible','off'); +%! axis(box); +%! line = [30 40 10 0]; +%! edge = [0 40 100 40]; +%! hl = drawLine(line); +%! assertElementsAlmostEqual(edge([1 3]), get(hl, 'xdata')); +%! assertElementsAlmostEqual(edge([2 4]), get(hl, 'ydata')); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! box = [0 100 0 100]; +%! hf = figure('visible','off'); +%! axis(box); +%! line = [30 40 -10 0]; +%! edge = [100 40 0 40]; +%! hl = drawLine(line); +%! assertElementsAlmostEqual(edge([1 3]), get(hl, 'xdata')); +%! assertElementsAlmostEqual(edge([2 4]), get(hl, 'ydata')); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! box = [0 100 0 100]; +%! hf = figure('visible','off'); +%! axis(box); +%! line = [30 140 10 0]; +%! hl = drawLine(line); +%! assertEqual(-1, hl); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! box = [0 100 0 100]; +%! hf = figure('visible','off'); +%! axis(box); +%! line = [30 40 0 10]; +%! edge = [30 0 30 100]; +%! hl = drawLine(line); +%! assertElementsAlmostEqual(edge([1 3]), get(hl, 'xdata')); +%! assertElementsAlmostEqual(edge([2 4]), get(hl, 'ydata')); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! box = [0 100 0 100]; +%! hf = figure('visible','off'); +%! axis(box); +%! line = [30 40 0 -10]; +%! edge = [30 100 30 0]; +%! hl = drawLine(line); +%! assertElementsAlmostEqual(edge([1 3]), get(hl, 'xdata')); +%! assertElementsAlmostEqual(edge([2 4]), get(hl, 'ydata')); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! box = [0 100 0 100]; +%! hf = figure('visible','off'); +%! axis(box); +%! line = [140 30 0 10]; +%! hl = drawLine(line); +%! assertEqual(-1, hl); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! box = [0 100 0 100]; +%! hf = figure('visible','off'); +%! axis(box); +%! line = [80 30 10 10]; +%! edge = [50 0 100 50]; +%! hl = drawLine(line); +%! assertElementsAlmostEqual(edge([1 3]), get(hl, 'xdata')); +%! assertElementsAlmostEqual(edge([2 4]), get(hl, 'ydata')); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! box = [0 100 0 100]; +%! hf = figure('visible','off'); +%! axis(box); +%! line = [20 70 10 10]; +%! edge = [0 50 50 100]; +%! hl = drawLine(line); +%! assertElementsAlmostEqual(edge([1 3]), get(hl, 'xdata')); +%! assertElementsAlmostEqual(edge([2 4]), get(hl, 'ydata')); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! box = [0 100 0 100]; +%! hf = figure('visible','off'); +%! axis(box); +%! line = [140 -30 10 10]; +%! hl = drawLine(line); +%! assertEqual(-1, hl); +%! line = [-40 130 10 10]; +%! hl = drawLine(line); +%! assertEqual(-1, hl); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! box = [0 100 0 100]; +%! hf = figure('visible','off'); +%! axis(box); +%! line = [... +%! 80 30 10 10; ... +%! 20 70 10 10; ... +%! 140 -30 10 10; ... +%! -40 130 10 10]; +%! edge = [... +%! 50 0 100 50; ... +%! 0 50 50 100]; +%! hl = drawLine(line); +%! assertEqual(4, length(hl)); +%! assertElementsAlmostEqual(edge(1, [1 3]), get(hl(1), 'xdata')); +%! assertElementsAlmostEqual(edge(1, [2 4]), get(hl(1), 'ydata')); +%! assertElementsAlmostEqual(edge(2, [1 3]), get(hl(2), 'xdata')); +%! assertElementsAlmostEqual(edge(2, [2 4]), get(hl(2), 'ydata')); +%! assertEqual(-1, hl(3)); +%! assertEqual(-1, hl(4)); +%! rmpath (privpath); + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawOrientedBox.m b/octave_packages/geometry-1.5.0/geom2d/drawOrientedBox.m new file mode 100644 index 0000000..1ba2d29 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawOrientedBox.m @@ -0,0 +1,113 @@ +%% Copyright (c) 2011, INRA +%% 2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{hb} = } drawOrientedBox (@var{box}) +%% @deftypefnx {Function File} {@var{hb} = } drawOrientedBox (@dots{}, @var{param}, @var{value}) +%% Draw centered oriented rectangle. +%% +%% Syntax +%% drawOrientedBox(BOX) +%% drawOrientedBox(BOX, 'PropertyName', propertyvalue, ...) +%% +%% Description +%% drawOrientedBox(OBOX) +%% Draws an oriented rectangle (or bounding box) on the current axis. +%% OBOX is a 1-by-5 row vector containing box center, dimension (length +%% and width) and orientation (in degrees): +%% OBOX = [CX CY LENGTH WIDTH THETA]. +%% +%% When OBOX is a N-by-5 array, the N boxes are drawn. +%% +%% HB = drawOrientedBox(...) +%% Returns a handle to the created graphic object(s). Object style can be +%% modified using syntaw like: +%% set(HB, 'color', 'g', 'linewidth', 2); +%% +%% @seealso{drawPolygon, drawRect, drawBox} +%% @end deftypefn + +function varargout = drawOrientedBox(box, varargin) + + %% Parses input arguments + + if nargin > 4 && sum(cellfun(@isnumeric, varargin(1:4))) == 4 + cx = box; + cy = varargin{1}; + hl = varargin{2} / 2; + hw = varargin{3} / 2; + theta = varargin{4}; + varargin = varargin(5:end); + else + cx = box(:,1); + cy = box(:,2); + hl = box(:,3) / 2; + hw = box(:,4) / 2; + theta = box(:,5); + end + + + %% Draw each box + + % allocate memory for graphical handle + hr = zeros(length(cx), 1); + + % iterate on oriented boxes + for i = 1:length(cx) + % pre-compute angle data + cot = cosd(theta(i)); + sit = sind(theta(i)); + + % x and y shifts + lc = hl(i) * cot; + ls = hl(i) * sit; + wc = hw(i) * cot; + ws = hw(i) * sit; + + % coordinates of box vertices + vx = cx(i) + [-lc + ws; lc + ws ; lc - ws ; -lc - ws ; -lc + ws]; + vy = cy(i) + [-ls - wc; ls - wc ; ls + wc ; -ls + wc ; -ls - wc]; + + % draw polygons + hr(i) = line(vx, vy, varargin{:}); + end + + + %% Format output + + if nargout > 0 + varargout = {hr}; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawParabola.m b/octave_packages/geometry-1.5.0/geom2d/drawParabola.m new file mode 100644 index 0000000..b826b1e --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawParabola.m @@ -0,0 +1,142 @@ +%% Copyright (c) 2011, INRA +%% 2006-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} = } drawParabola (@var{parabola}) +%% @deftypefnx {Function File} {@var{h} = } drawParabola (@var{parabola}, @var{t}) +%% @deftypefnx {Function File} {@var{h} = } drawParabola (@dots{}, @var{param}, @var{value}) +%% Draw a parabola on the current axis. +%% +%% drawParabola(PARABOLA); +%% Draws a vertical parabola, defined by its vertex and its parameter. +%% Such a parabola admits a vertical axis of symetry. +%% +%% The algebraic equation of parabola is given by: +%% (Y - YV) = A * (X - VX)^2 +%% Where XV and YV are vertex coordinates and A is parabola parameter. +%% +%% A parametric equation of parabola is given by: +%% x(t) = t + VX; +%% y(t) = A * t^2 + VY; +%% +%% PARABOLA can also be defined by [XV YV A THETA], with theta being the +%% angle of rotation of the parabola (in degrees and Counter-Clockwise). +%% +%% drawParabola(PARABOLA, T); +%% Specifies which range of 't' are used for drawing parabola. If T is an +%% array with only two values, the first and the last values are used as +%% interval bounds, and several values are distributed within this +%% interval. +%% +%% drawParabola(..., NAME, VALUE); +%% Can specify one or several graphical options using parameter name-value +%% pairs. +%% +%% H = drawParabola(...); +%% Returns an handle to the created graphical object. +%% +%% +%% Example: +%% @example +%% figure(1); clf; hold on; +%% drawParabola([50 50 .2 30]); +%% drawParabola([50 50 .2 30], [-1 1], 'color', 'r', 'linewidth', 2); +%% axis equal; +%% @end example +%% +%% @seealso{drawCircle, drawEllipse} +%% @end deftypefn + +function varargout = drawParabola(varargin) + + % Extract parabola + if nargin<1 + error('geom2d:IllegalArgument', ... + 'Please specify parabola representation'); + end + + % input parabola is given as a packed array + parabola = varargin{1}; + varargin(1) = []; + x0 = parabola(:,1); + y0 = parabola(:,2); + a = parabola(:,3); + + if size(parabola, 2)>3 + theta = parabola(:, 4); + else + theta = zeros(length(a), 1); + end + + % extract parametrisation bounds + bounds = [-100 100]; + if ~isempty(varargin) + var = varargin{1}; + if isnumeric(var) + bounds = var; + varargin(1) = []; + end + end + + % create parametrisation + if length(bounds)>2 + t = bounds; + else + t = linspace(bounds(1), bounds(end), 100); + end + + % create handle array (in the case of several parabola) + h = zeros(size(x0)); + + % draw each parabola + for i=1:length(x0) + % compute transformation + trans = ... + createTranslation(x0(i), y0(i)) * ... + createRotation(deg2rad(theta(i))) * ... + createScaling(1, a); + + % compute points on the parabola + [xt yt] = transformPoint(t(:), t(:).^2, trans); + + % draw it + h(i) = plot(xt, yt, varargin{:}); + end + + % process output arguments + if nargout>0 + varargout{1}=h; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawPoint.m b/octave_packages/geometry-1.5.0/geom2d/drawPoint.m new file mode 100644 index 0000000..0272ad2 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawPoint.m @@ -0,0 +1,91 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} = } drawPoint (@var{x}, @var{y}) +%% @deftypefnx {Function File} {@var{h} = } drawPoint (@var{coord}) +%% @deftypefnx {Function File} {@var{h} = } drawPoint (@dots{}, @var{opt}) +%% Draw the point on the axis. +% +% Draws points defined by coordinates @var{x} and @var{y}Y. +% @var{x} and @var{y} should be array the same size. Coordinates can be +% packed coordinates in a single [N*2] array @var{coord}. Options @var{opt} +% are passed to the @code{plot} function. +% +% @seealso{points2d, clipPoints} +% +%% @end deftypefn + +function varargout = drawPoint(varargin) + + % process input arguments + var = varargin{1}; + if size(var, 2)==1 + % points stored in separate arrays + px = varargin{1}; + py = varargin{2}; + varargin(1:2) = []; + else + % points packed in one array + px = var(:, 1); + py = var(:, 2); + varargin(1) = []; + end + + % ensure we have column vectors + px = px(:); + py = py(:); + + % default drawing options, but keep specified options if it has the form of + % a bundled string + if length(varargin)~=1 + varargin = [{'linestyle', 'none', 'marker', 'o', 'color', 'b'}, varargin]; + end + + % plot the points, using specified drawing options + h = plot(px(:), py(:), varargin{:}); + + % process output arguments + if nargout>0 + varargout{1}=h; + end + +endfunction + +%!demo +%! drawPoint(10, 10); + +%!demo +%! t = linspace(0, 2*pi, 20)'; +%! drawPoint([5*cos(t)+10 3*sin(t)+10], 'r+'); + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawRay.m b/octave_packages/geometry-1.5.0/geom2d/drawRay.m new file mode 100644 index 0000000..a6c4cd9 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawRay.m @@ -0,0 +1,66 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} = } drawRay (@var{ray}) +%% @deftypefnx {Function File} {@var{h} = } drawRay (@var{ray}, @var{param}, @var{value}) +%% Draw a ray on the current axis. +%% +%% With @var{ray} having the syntax: [x0 y0 dx dy], draws the ray starting from +%% point (x0 y0) and going to direction (dx dy), clipped with the current +%% window axis. @var{param}, @var{value} pairs are passed to function @code{line}. +%% +%% @seealso{rays2d, drawLine, line} +%% @end deftypefn + +function varargout = drawRay(ray, varargin) + + % get bounding box limits + bb = axis(gca); + + % compute clipped shapes + [clipped isInside] = clipRay(ray, bb); + + % allocate memory for handle + h = -ones(size(ray, 1), 1); + + % draw visible rays + h(isInside) = drawEdge(clipped(isInside, :), varargin{:}); + + % process output + if nargout>0 + varargout = {h}; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawRect.m b/octave_packages/geometry-1.5.0/geom2d/drawRect.m new file mode 100644 index 0000000..4a280bf --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawRect.m @@ -0,0 +1,104 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{r} = } drawRect (@var{x}, @var{y}, @var{w}, @var{h}) +%% @deftypefnx {Function File} {@var{r} = } drawRect (@var{x}, @var{y}, @var{w}, @var{h}, @var{theta}) +%% @deftypefnx {Function File} {@var{r} = } drawRect (@var{coord}) +%% Draw rectangle on the current axis. +%% +%% r = DRAWRECT(x, y, w, h) draw rectangle with width W and height H, at +%% position (X, Y). +%% the four corners of rectangle are then : +%% (X, Y), (X+W, Y), (X, Y+H), (X+W, Y+H). +%% +%% r = DRAWRECT(x, y, w, h, theta) also specifies orientation for +%% rectangle. Theta is given in degrees. +%% +%% r = DRAWRECT(coord) is the same as DRAWRECT(X,Y,W,H), but all +%% parameters are packed into one array, whose dimensions is 4*1 or 5*1. +%% +%% +%% @seealso{drawBox, drawOrientedBox} +%% @end deftypefn + +function varargout = drawRect(varargin) + + % default values + theta = 0; + + % get entered values + if length(varargin) > 3 + x = varargin{1}; + y = varargin{2}; + w = varargin{3}; + h = varargin{4}; + if length(varargin)> 4 + theta = varargin{5} * pi / 180; + end + + else + coord = varargin{1}; + x = coord(1); + y = coord(2); + w = coord(3); + h = coord(4); + if length(coord) > 4 + theta = coord(5) * pi / 180; + end + end + + r = zeros(size(x)); + for i = 1:length(x) + tx = zeros(5, 1); + ty = zeros(5, 1); + tx(1) = x(i); + ty(1) = y(i); + tx(2) = x(i) + w(i) * cos(theta(i)); + ty(2) = y(i) + w(i) * sin(theta(i)); + tx(3) = x(i) + w(i) * cos(theta(i)) - h(i) * sin(theta(i)); + ty(3) = y(i) + w(i) * sin(theta(i)) + h(i) * cos(theta(i)); + tx(4) = x(i) - h(i) * sin(theta(i)); + ty(4) = y(i) + h(i) * cos(theta(i)); + tx(5) = x(i); + ty(5) = y(i); + + r(i) = line(tx, ty); + end + + if nargout > 0 + varargout{1} = r; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/drawShape.m b/octave_packages/geometry-1.5.0/geom2d/drawShape.m new file mode 100644 index 0000000..13a42f1 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/drawShape.m @@ -0,0 +1,110 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} drawShape (@var{type}, @var{param}) +%% @deftypefnx {Function File} drawShape (@dots{}, @var{option}) +%% Draw various types of shapes (circles, polygons...). +%% +%% drawShape(TYPE, PARAM) +%% Draw the shape of type TYPE, specified by given parameter PARAM. TYPE +%% can be one of 'circle', 'ellipse', 'rect', 'polygon', 'curve' +%% PARAM depend on the type. For example, if TYPE is 'circle', PARAM will +%% contain [x0 y0 R]. +%% +%% Examples : +%% @example +%% drawShape('circle', [20 10 30]); +%% Draw circle centered on [20 10] with radius 10. +%% drawShape('rect', [20 20 40 10 pi/3]); +%% Draw rectangle centered on [20 20] with length 40 and width 10, and +%% oriented pi/3 wrt axis Ox. +%% @end example +%% +%% drawShape(..., OPTION) +%% also specifies drawing options. OPTION can be 'draw' (default) or +%% 'fill'. +%% @end deftypefn +function varargout = drawShape(type, param, varargin) + + if ~iscell(type) + type = {type}; + end + if ~iscell(param) + tmp = cell(1, size(param, 1)); + for i=1:size(param, 1) + tmp{i} = param(i,:); + end + param = tmp; + end + + option = 'draw'; + if ~isempty(varargin) + var = varargin{1}; + if strcmpi(var, 'fill') + option = 'fill'; + end + end + + + % transform each shape into a polygon + shape = cell(1,length(type)); + for i=1:length(type) + if strcmpi(type{i}, 'circle') + shape{i} = circleAsPolygon(param{i}, 128); + elseif strcmpi(type{i}, 'rect') + shape{i} = rectAsPolygon(param{i}); + elseif strcmpi(type{i}, 'polygon') + shape{i} = param{i}; + end + end + + + hold on; + h = zeros(length(shape), 1); + if strcmp(option, 'draw') + for i=1:length(shape) + h(i) = drawPolygon(shape{i}); + end + else + for i=1:length(shape) + h(i) = fillPolygon(shape{i}); + end + end + + if nargout>0 + varargout{1}=h; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/edgeAngle.m b/octave_packages/geometry-1.5.0/geom2d/edgeAngle.m new file mode 100644 index 0000000..a217b72 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/edgeAngle.m @@ -0,0 +1,61 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{theta} =} edgeAngle(@var{edge}) +%% Return angle of edge +%% +%% A = edgeAngle(EDGE) +%% Returns the angle between horizontal, right-axis and the edge EDGE. +%% Angle is given in radians, between 0 and 2*pi, in counter-clockwise +%% direction. +%% Notation for edge is [x1 y1 x2 y2] (coordinates of starting and ending +%% points). +%% +%% Example +%% p1 = [10 20]; +%% p2 = [30 40]; +%% rad2deg(edgeAngle([p1 p2])) +%% ans = +%% 45 +%% +%% @seealso{edges2d, angles2d, edgeAngle, lineAngle, edgeLength} +%% @end deftypefn + +function theta = edgeAngle(edge) + + line = createLine(edge(:,1:2), edge(:,3:4)); + theta = lineAngle(line); + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/edgeLength.m b/octave_packages/geometry-1.5.0/geom2d/edgeLength.m new file mode 100644 index 0000000..658599c --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/edgeLength.m @@ -0,0 +1,60 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{len} = } edgeLength (@var{edge}) +%% Return length of an edge +%% +%% L = edgeLength(EDGE); +%% Returns the length of an edge, with parametric representation: +%% [x1 y1 x2 y2]. +%% +%% The function also works for several edges, in this case input is a +%% [N*4] array, containing parametric representation of each edge, and +%% output is a [N*1] array containing length of each edge. +%% +%% @seealso{edges2d, edgeAngle} +%% @end deftypefn + +function len = edgeLength(varargin) + + % TODO : specify norm (euclidian, taxi, ...). + + nargs = length(varargin); + if nargs == 1 + edge = varargin{1}; + len = sqrt(power(edge(:,3)-edge(:,1), 2) + power(edge(:,4)-edge(:,2), 2)); + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/edgePosition.m b/octave_packages/geometry-1.5.0/geom2d/edgePosition.m new file mode 100644 index 0000000..fa14cf0 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/edgePosition.m @@ -0,0 +1,91 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{d} = } edgePosition (@var{point}, @var{edge}) +%% Return position of a point on an edge +%% +%% POS = edgePosition(POINT, EDGE); +%% Computes position of point POINT on the edge EDGE, relative to the +%% position of edge vertices. +%% EDGE has the form [x1 y1 x2 y2], +%% POINT has the form [x y], and is assumed to belong to edge. +%% The position POS has meaning: +%% POS<0: POINT is located before the first vertex +%% POS=0: POINT is located on the first vertex +%% 0 +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{line} = } edgeToLine (@var{edge}) +%% Convert an edge to a straight line +%% +%% LINE = edgeToLine(EDGE); +%% Returns the line containing the edge EDGE. +%% +%% Example +%% edge = [2 3 4 5]; +%% line = edgeToLine(edge); +%% figure(1); hold on; axis([0 10 0 10]); +%% drawLine(line, 'color', 'g') +%% drawEdge(edge, 'linewidth', 2) +%% +%% @seealso{edges2d, lines2d} +%% @end deftypefn + +function line = edgeToLine(edge) + + line = [edge(:, 1:2) edge(:, 3:4)-edge(:, 1:2)]; + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/edges2d.m b/octave_packages/geometry-1.5.0/geom2d/edges2d.m new file mode 100644 index 0000000..73a6108 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/edges2d.m @@ -0,0 +1,56 @@ +%% Copyright (c) 2011, INRA +%% 2008-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} edges2d () +%% Description of functions operating on planar edges +% +% An edge is represented by the corodinate of its end points: +% EDGE = [X1 Y1 X2 Y2]; +% +% A set of edges is represented by a N*4 array, each row representing an +% edge. +% +% +% @seealso{lines2d, rays2d, points2d +% createEdge, edgeAngle, edgeLength, edgeToLine, midPoint +% intersectEdges, intersectLineEdge, isPointOnEdge +% clipEdge, transformEdge +% drawEdge, drawCenteredEdge} +%% @end deftypefn +function edges2d(varargin) + + help('edges2d'); + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/ellipse2cov.m b/octave_packages/geometry-1.5.0/geom2d/ellipse2cov.m new file mode 100644 index 0000000..276b411 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/ellipse2cov.m @@ -0,0 +1,92 @@ +## Copyright (c) 2012 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR 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{K} = } ellipse2cov (@var{elli}) +%% @deftypefnx {Function File} {@var{K} = } ellipse2cov (@var{ra}, @var{rb}) +%% @deftypefnx {Function File} {@var{K} = } ellipse2cov (@dots{}, @var{theta}) +%% Calculates covariance matrix from ellipse. +%% +%% If only one input is given, @var{elli} must define an ellipse as described in +%% @command{ellipses2d}. +%% If two inputs are given, @var{ra} and @var{rb} define the half-lenght of the +%% axes. +%% If a third input is given, @var{theta} must be the angle of rotation of the +%% ellipse in radians, and in counter-clockwise direction. +%% +%% The output @var{K} contains the covariance matrix define by the ellipse. +%% +%% Run @code{demo ellipse2cov} to see an example. +%% +%% @seealso{ellipses2d, cov2ellipse, drawEllipse} +%% @end deftypefn + +function K = ellipse2cov (elli, varargin); + + ra = 1; + rb = 1; + theta = 0; + switch numel (varargin) + case 0 + %% ellipse format + if numel (elli) != 5 + print_usage (); + end + ra = elli(1,3); + rb = elli(1,4); + theta = elli(1,5)*pi/180; + + case 2 + %% ra,rb + if numel (elli) != 1 + print_usage (); + end + ra = elli; + rb = varargin{1}; + + case 3 + %% ra,rb, theta + if numel (elli) != 1 + print_usage (); + end + ra = elli; + rb = varargin{1}; + theta = varargin{2}; + + otherwise + print_usage (); + end + + T = createRotation (theta)(1:2,1:2); + K = T*diag([ra rb])*T'; + +endfunction + +%!demo +%! elli = [0 0 1 3 -45]; +%! +%! % Create 2D normal random variables with covarinace defined by elli. +%! K = ellipse2cov (elli) +%! L = chol(K,'lower'); +%! u = randn(1e3,2)*L'; +%! +%! Kn = cov (u) +%! +%! figure(1) +%! plot(u(:,1),u(:,2),'.r'); +%! hold on; +%! drawEllipse(elli,'linewidth',2); +%! hold off +%! axis tight diff --git a/octave_packages/geometry-1.5.0/geom2d/ellipseAsPolygon.m b/octave_packages/geometry-1.5.0/geom2d/ellipseAsPolygon.m new file mode 100644 index 0000000..06bf3c2 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/ellipseAsPolygon.m @@ -0,0 +1,93 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{p} = } ellipseAsPolygon (@var{ell}, @var{n}) +%% Convert an ellipse into a series of points +%% +%% P = ellipseAsPolygon(ELL, N); +%% converts ELL given as [x0 y0 a b] or [x0 y0 a b theta] into a polygon +%% with N edges. The result P is (N+1)-by-2 array containing coordinates +%% of the N+1 vertices of the polygon. +%% The resulting polygon is closed, i.e. the last point is the same as the +%% first one. +%% +%% P = ellipseAsPolygon(ELL); +%% Use a default number of edges equal to 72. This result in one piont for +%% each 5 degrees. +%% +%% [X Y] = ellipseAsPolygon(...); +%% Return the coordinates o fvertices in two separate arrays. +%% +%% @seealso{ellipses2d, circleAsPolygon, rectAsPolygon, drawEllipse} +%% @end deftypefn + +function varargout = ellipseAsPolygon(ellipse, N) + + % default value for N + if nargin < 2 + N = 72; + end + + % angle of ellipse + theta = 0; + if size(ellipse, 2) > 4 + theta = ellipse(:,5); + end + + % get ellipse parameters + xc = ellipse(:,1); + yc = ellipse(:,2); + a = ellipse(:,3); + b = ellipse(:,4); + + % create time basis + t = linspace(0, 2*pi, N+1)'; + + % pre-compute trig functions (angles is in degrees) + cot = cosd(theta); + sit = sind(theta); + + % position of points + x = xc + a * cos(t) * cot - b * sin(t) * sit; + y = yc + a * cos(t) * sit + b * sin(t) * cot; + + % format output depending on number of a param. + if nargout == 1 + varargout = {[x y]}; + elseif nargout == 2 + varargout = {x, y}; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/ellipses2d.m b/octave_packages/geometry-1.5.0/geom2d/ellipses2d.m new file mode 100644 index 0000000..41fcad6 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/ellipses2d.m @@ -0,0 +1,50 @@ +%% Copyright (c) 2011, INRA +%% 2008-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} ellipses2d () +%% Description of functions operating on ellipses. +%% +%% Ellipses are represented by their center, the length of their 2 +%% semi-axes length, and their angle from the Ox direction (in degrees). +%% E = [XC YC A B THETA]; +%% +%% @seealso{circles2d, inertiaEllipse, isPointInEllipse, ellipseAsPolygon +%% drawEllipse, drawEllipseArc} +%% @end deftypefn + +function ellipses2d(varargin) + + help('ellipses2d'); + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/enclosingCircle.m b/octave_packages/geometry-1.5.0/geom2d/enclosingCircle.m new file mode 100644 index 0000000..783fcf3 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/enclosingCircle.m @@ -0,0 +1,98 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{circle} = } enclosingCircle (@var{pts}) +%% Find the minimum circle enclosing a set of points. +%% +%% CIRCLE = enclosingCircle(POINTS); +%% compute cirlce CIRCLE=[xc yc r] which enclose all points POINTS given +%% as an [Nx2] array. +%% +%% +%% Rewritten from a file from +%% Yazan Ahed +%% which was rewritten from a Java applet by Shripad Thite : +%% @url{http://heyoka.cs.uiuc.edu/~thite/mincircle/} +%% +%% @seealso{circles2d, points2d, boxes2d} +%% @end deftypefn + +function circle = enclosingCircle(pts) + + % works on convex hull : it is faster + pts = pts(convhull(pts(:,1), pts(:,2)), :); + + circle = recurseCircle(size(pts, 1), pts, 1, zeros(3, 2)); + +endfunction + +function circ = recurseCircle(n, p, m, b) +% n: number of points given +% m: an argument used by the function. Always use 1 for m. +% bnry: an argument (3x2 array) used by the function to set the points that +% determines the circle boundry. You have to be careful when choosing this +% array's values. I think the values should be somewhere outside your points +% boundary. For my case, for example, I know the (x,y) I have will be something +% in between (-5,-5) and (5,5), so I use bnry as: +% [-10 -10 +% -10 -10 +% -10 -10] + + + if m==4 + circ = createCircle(b(1,:), b(2,:), b(3,:)); + return; + end + + circ = [Inf Inf 0]; + + if m == 2 + circ = [b(1,1:2) 0]; + elseif m == 3 + c = (b(1,:) + b(2,:))/2; + circ = [c distancePoints(b(1,:), c)]; + end + + + for i = 1:n + if distancePoints(p(i,:), circ(1:2)) > circ(3) + if sum(b(:,1)==p(i,1) & b(:,2)==p(i,2)) == 0 + b(m,:) = p(i,:); + circ = recurseCircle(i, p, m+1, b); + end + end + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/fitAffineTransform2d.m b/octave_packages/geometry-1.5.0/geom2d/fitAffineTransform2d.m new file mode 100644 index 0000000..c01fc86 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/fitAffineTransform2d.m @@ -0,0 +1,73 @@ +%% Copyright (c) 2011, INRA +%% 2009-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{T} = } fitAffineTransform2d (@var{pts1}, @var{pts2}) +%% Fit an affine transform using two point sets. +%% +%% Example +%% +%% @example +%% N = 10; +%% pts = rand(N, 2)*10; +%% trans = createRotation(3, 4, pi/4); +%% pts2 = transformPoint(pts, trans); +%% pts3 = pts2 + randn(N, 2)*2; +%% fitted = fitAffineTransform2d(pts, pts2) +%%@end example +%% +%% @seealso{transforms2d} +%% @end deftypefn + +function trans = fitAffineTransform2d(pts1, pts2) + + % number of points + N = size(pts1, 1); + + % main matrix of the problem + A = [... + pts1(:,1) pts1(:,2) ones(N,1) zeros(N, 3) ; ... + zeros(N, 3) pts1(:,1) pts1(:,2) ones(N,1) ]; + + % conditions initialisations + B = [pts2(:,1) ; pts2(:,2)]; + + % compute coefficients using least square + coefs = A\B; + + % format to a matrix + trans = [coefs(1:3)' ; coefs(4:6)'; 0 0 1]; + +endfunction + + diff --git a/octave_packages/geometry-1.5.0/geom2d/geom2d_Contents.m b/octave_packages/geometry-1.5.0/geom2d/geom2d_Contents.m new file mode 100644 index 0000000..98f03ae --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/geom2d_Contents.m @@ -0,0 +1,223 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} geom2d_Contents () +%% Geometry 2D Toolbox +%% Version 1.2.0 21-Oct-2011 . +%% +%% Library to handle and visualize geometric primitives such as points, +%% lines, circles and ellipses, polygons... +%% +%% The goal is to provide a low-level library for manipulating geometrical +%% primitives, making easier the development of more complex geometric +%% algorithms. +%% +%% Most functions works for planar shapes, but some ones have been +%% extended to 3D or to any dimension. +%% +%% Points +%% points2d - Description of functions operating on points +%% clipPoints - Clip a set of points by a box +%% centroid - Compute centroid (center of mass) of a set of points +%% midPoint - Middle point of two points or of an edge +%% isCounterClockwise - Compute relative orientation of 3 points +%% polarPoint - Create a point from polar coordinates (rho + theta) +%% angle2Points - Compute horizontal angle between 2 points +%% angle3Points - Compute oriented angle made by 3 points +%% angleSort - Sort points in the plane according to their angle to origin +%% distancePoints - Compute distance between two points +%% minDistancePoints - Minimal distance between several points +%% transformPoint - Transform a point with an affine transform +%% drawPoint - Draw the point on the axis. +%% +%% Vectors +%% vectors2d - Description of functions operating on plane vectors +%% createVector - Create a vector from two points +%% vectorNorm - Compute norm of a vector, or of a set of vectors +%% vectorAngle - Angle of a vector, or between 2 vectors +%% normalizeVector - Normalize a vector to have norm equal to 1 +%% isPerpendicular - Check orthogonality of two vectors +%% isParallel - Check parallelism of two vectors +%% transformVector - Transform a vector with an affine transform +%% rotateVector - Rotate a vector by a given angle +%% +%% Straight lines +%% lines2d - Description of functions operating on planar lines +%% createLine - Create a straight line from 2 points, or from other inputs +%% medianLine - Create a median line between two points +%% cartesianLine - Create a straight line from cartesian equation coefficients +%% orthogonalLine - Create a line orthogonal to another one. +%% parallelLine - Create a line parallel to another one. +%% intersectLines - Return all intersection points of N lines in 2D +%% lineAngle - Computes angle between two straight lines +%% linePosition - Position of a point on a line +%% lineFit - Fit a straight line to a set of points +%% clipLine - Clip a line with a box +%% reverseLine - Return same line but with opposite orientation +%% transformLine - Transform a line with an affine transform +%% drawLine - Draw the line on the current axis +%% +%% Edges (line segments between 2 points) +%% edges2d - Description of functions operating on planar edges +%% createEdge - Create an edge between two points, or from a line +%% edgeToLine - Convert an edge to a straight line +%% edgeAngle - Return angle of edge +%% edgeLength - Return length of an edge +%% midPoint - Middle point of two points or of an edge +%% edgePosition - Return position of a point on an edge +%% clipEdge - Clip an edge with a rectangular box +%% reverseEdge - Intervert the source and target vertices of edge +%% intersectEdges - Return all intersections between two set of edges +%% intersectLineEdge - Return intersection between a line and an edge +%% transformEdge - Transform an edge with an affine transform +%% drawEdge - Draw an edge given by 2 points +%% drawCenteredEdge - Draw an edge centered on a point +%% +%% Rays +%% rays2d - Description of functions operating on planar rays +%% createRay - Create a ray (half-line), from various inputs +%% bisector - Return the bisector of two lines, or 3 points +%% clipRay - Clip a ray with a box +%% drawRay - Draw a ray on the current axis +%% +%% Relations between points and lines +%% distancePointEdge - Minimum distance between a point and an edge +%% distancePointLine - Minimum distance between a point and a line +%% projPointOnLine - Project of a point orthogonally onto a line +%% pointOnLine - Create a point on a line at a given position on the line +%% isPointOnLine - Test if a point belongs to a line +%% isPointOnEdge - Test if a point belongs to an edge +%% isPointOnRay - Test if a point belongs to a ray +%% isLeftOriented - Test if a point is on the left side of a line +%% +%% Circles +%% circles2d - Description of functions operating on circles +%% createCircle - Create a circle from 2 or 3 points +%% createDirectedCircle - Create a directed circle +%% intersectCircles - Intersection points of two circles +%% intersectLineCircle - Intersection point(s) of a line and a circle +%% circleAsPolygon - Convert a circle into a series of points +%% circleArcAsCurve - Convert a circle arc into a series of points +%% isPointInCircle - Test if a point is located inside a given circle +%% isPointOnCircle - Test if a point is located on a given circle. +%% enclosingCircle - Find the minimum circle enclosing a set of points. +%% radicalAxis - Compute the radical axis (or radical line) of 2 circles +%% drawCircle - Draw a circle on the current axis +%% drawCircleArc - Draw a circle arc on the current axis +%% +%% Ellipses +%% ellipses2d - Description of functions operating on ellipses +%% inertiaEllipse - Inertia ellipse of a set of points +%% isPointInEllipse - Check if a point is located inside a given ellipse +%% ellipseAsPolygon - Convert an ellipse into a series of points +%% drawEllipse - Draw an ellipse on the current axis +%% drawEllipseArc - Draw an ellipse arc on the current axis +%% +%% Geometric transforms +%% transforms2d - Description of functions operating on transforms +%% createTranslation - Create the 3*3 matrix of a translation +%% createRotation - Create the 3*3 matrix of a rotation +%% createScaling - Create the 3*3 matrix of a scaling in 2 dimensions +%% createHomothecy - Create the the 3x3 matrix of an homothetic transform +%% createBasisTransform - Compute matrix for transforming a basis into another basis +%% createLineReflection - Create the the 3x3 matrix of a line reflection +%% fitAffineTransform2d - Fit an affine transform using two point sets +%% +%% Angles +%% angles2d - Description of functions for manipulating angles +%% normalizeAngle - Normalize an angle value within a 2*PI interval +%% angleAbsDiff - Absolute difference between two angles +%% angleDiff - Difference between two angles +%% deg2rad - Convert angle from degrees to radians +%% rad2deg - Convert angle from radians to degrees +%% +%% Boxes +%% boxes2d - Description of functions operating on bounding boxes +%% intersectBoxes - Intersection of two bounding boxes +%% mergeBoxes - Merge two boxes, by computing their greatest extent +%% randomPointInBox - Generate random point within a box +%% drawBox - Draw a box defined by coordinate extents +%% +%% Various drawing functions +%% drawBezierCurve - Draw a cubic bezier curve defined by 4 control points +%% drawParabola - Draw a parabola on the current axis +%% drawOrientedBox - Draw centered oriented rectangle +%% drawRect - Draw rectangle on the current axis +%% drawArrow - Draw an arrow on the current axis +%% drawLabels - Draw labels at specified positions +%% drawShape - Draw various types of shapes (circles, polygons...) +%% +%% Other shapes +%% squareGrid - Generate equally spaces points in plane. +%% hexagonalGrid - Generate hexagonal grid of points in the plane. +%% triangleGrid - Generate triangular grid of points in the plane. +%% crackPattern - Create a (bounded) crack pattern tessellation +%% crackPattern2 - Create a (bounded) crack pattern tessellation +%% +%% +%% Credits: +%% * function 'enclosingCircle' rewritten from a file from Yazan Ahed +%% , available on Matlab File Exchange +%% +%% @end deftypefn + +function geom2d_Contents () + + help('geom2d_Contents'); + + %% Deprecated functions + + % createMedian - create a median line + % minDistance - compute minimum distance between a point and a set of points + % homothecy - create a homothecy as an affine transform + % rotation - return 3*3 matrix of a rotation + % translation - return 3*3 matrix of a translation + % scaling - return 3*3 matrix of a scaling in 2 dimensions + % lineSymmetry - create line symmetry as 2D affine transform + % vecnorm - compute norm of vector or of set of vectors + % normalize - normalize a vector + % onCircle - test if a point is located on a given circle. + % inCircle - test if a point is located inside a given circle. + % onEdge - test if a point belongs to an edge + % onLine - test if a point belongs to a line + % onRay - test if a point belongs to a ray + % invertLine - return same line but with opposite orientation + % clipLineRect - clip a line with a polygon + % formatAngle - Ensure an angle value is comprised between 0 and 2*PI + + + %% Others... + % drawRect2 - Draw centered rectangle on the current axis + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/hexagonalGrid.m b/octave_packages/geometry-1.5.0/geom2d/hexagonalGrid.m new file mode 100644 index 0000000..db89843 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/hexagonalGrid.m @@ -0,0 +1,122 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{pts} = } hexagonalGrid (@var{bounds}, @var{origin}, @var{size}) +%% Generate hexagonal grid of points in the plane. +%% +%% usage +%% PTS = hexagonalGrid(BOUNDS, ORIGIN, SIZE) +%% generate points, lying in the window defined by BOUNDS (=[xmin ymin +%% xmax ymax]), starting from origin with a constant step equal to size. +%% SIZE is constant and is equals to the length of the sides of each +%% hexagon. +%% +%% TODO: add possibility to use rotated grid +%% @end deftypefn + +function varargout = hexagonalGrid(bounds, origin, size, varargin) + + size = size(1); + dx = 3*size; + dy = size*sqrt(3); + + + + % consider two square grids with different centers + pts1 = squareGrid(bounds, origin + [0 0], [dx dy], varargin{:}); + pts2 = squareGrid(bounds, origin + [dx/3 0], [dx dy], varargin{:}); + pts3 = squareGrid(bounds, origin + [dx/2 dy/2], [dx dy], varargin{:}); + pts4 = squareGrid(bounds, origin + [-dx/6 dy/2], [dx dy], varargin{:}); + + % gather points + pts = [pts1;pts2;pts3;pts4]; + + + + + % eventually compute also edges, clipped by bounds + % TODO : manage generation of edges + if nargout>1 + edges = zeros([0 4]); + x0 = origin(1); + y0 = origin(2); + + % find all x coordinate + x1 = bounds(1) + mod(x0-bounds(1), dx); + x2 = bounds(3) - mod(bounds(3)-x0, dx); + lx = (x1:dx:x2)'; + + % horizontal edges : first find y's + y1 = bounds(2) + mod(y0-bounds(2), dy); + y2 = bounds(4) - mod(bounds(4)-y0, dy); + ly = (y1:dy:y2)'; + + % number of points in each coord, and total number of points + ny = length(ly); + nx = length(lx); + + if bounds(1)-x1+dx0 + varargout{1} = pts; + + if nargout>1 + varargout{2} = edges; + end + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/inertiaEllipse.m b/octave_packages/geometry-1.5.0/geom2d/inertiaEllipse.m new file mode 100644 index 0000000..b88ad4e --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/inertiaEllipse.m @@ -0,0 +1,96 @@ +%% Copyright (c) 2011, INRA +%% 2008-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{ell} = } inertiaEllipse (@var{pts}) +%% Inertia ellipse of a set of points +%% +%% ELL = inertiaEllipse(PTS); +%% where PTS is a N*2 array containing coordinates of N points, computes +%% the inertia ellispe of the set of points. +%% +%% The result has the form: +%% ELL = [XC YC A B THETA], +%% with XC and YC being the center of mass of the point set, A and B are +%% the lengths of the inertia ellipse (see below), and THETA is the angle +%% of the main inertia axis with the horizontal (counted in degrees +%% between 0 and 180). +%% A and B are the standard deviations of the point coordinates when +%% ellipse is aligned with the inertia axes. +%% +%% @example +%% pts = randn(100, 2); +%% pts = transformPoint(pts, createScaling(5, 2)); +%% pts = transformPoint(pts, createRotation(pi/6)); +%% pts = transformPoint(pts, createTranslation(3, 4)); +%% ell = inertiaEllipse(pts); +%% figure(1); clf; hold on; +%% drawPoint(pts); +%% drawEllipse(ell, 'linewidth', 2, 'color', 'r'); +%% @end example +%% +%% @seealso{ellipses2d, drawEllipse} +%% @end deftypefn + +function ell = inertiaEllipse(points) + + % ellipse center + xc = mean(points(:,1)); + yc = mean(points(:,2)); + + % recenter points + x = points(:,1) - xc; + y = points(:,2) - yc; + + % number of points + n = size(points, 1); + + % inertia parameters + Ixx = sum(x.^2) / n; + Iyy = sum(y.^2) / n; + Ixy = sum(x.*y) / n; + + % compute ellipse semi-axis lengths + common = sqrt( (Ixx - Iyy)^2 + 4 * Ixy^2); + ra = sqrt(2) * sqrt(Ixx + Iyy + common); + rb = sqrt(2) * sqrt(Ixx + Iyy - common); + + % compute ellipse angle in degrees + theta = atan2(2 * Ixy, Ixx - Iyy) / 2; + theta = rad2deg(theta); + + % create the resulting inertia ellipse + ell = [xc yc ra rb theta]; + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/intersectBoxes.m b/octave_packages/geometry-1.5.0/geom2d/intersectBoxes.m new file mode 100644 index 0000000..e6f6b34 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/intersectBoxes.m @@ -0,0 +1,76 @@ +%% Copyright (c) 2011, INRA +%% 2010-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{box} =} intersectBoxes (@var{box1}, @var{box2}) +%% Intersection of two bounding boxes. +%% +%% Example +%% +%% @example +%% box1 = [5 20 5 30]; +%% box2 = [0 15 0 15]; +%% intersectBoxes(box1, box2) +%% ans = +%% 5 15 5 15 +%% @end example +%% +%% @seealso{boxes2d, drawBox, mergeBoxes} +%% @end deftypefn + +function bb = intersectBoxes(box1, box2) + + % unify sizes of data + if size(box1,1) == 1 + box1 = repmat(box1, size(box2,1), 1); + elseif size(box2, 1) == 1 + box2 = repmat(box2, size(box1,1), 1); + elseif size(box1,1) != size(box2,1) + error('geom2d:Error',"Bad size for inputs.\n"); + end + + % compute extreme coords + mini = min(box1(:,[2 4]), box2(:,[2 4])); + maxi = max(box1(:,[1 3]), box2(:,[1 3])); + + % concatenate result into a new box structure + bb = [maxi(:,1) mini(:,1) maxi(:,2) mini(:,2)]; + +endfunction + +%!test +%! box1 = [5 20 10 25]; +%! box2 = [0 15 15 20]; +%! res = [5 15 15 20]; +%! bb = intersectBoxes(box1, box2); +%! assert (res, bb, 1e-6); diff --git a/octave_packages/geometry-1.5.0/geom2d/intersectCircles.m b/octave_packages/geometry-1.5.0/geom2d/intersectCircles.m new file mode 100644 index 0000000..0004c24 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/intersectCircles.m @@ -0,0 +1,129 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{points} = } intersectCircles (@var{circle1}, @var{circle2}) +%% Intersection points of two circles. +%% +%% POINTS = intersectCircles(CIRCLE1, CIRCLE2) +%% Computes the intersetion point of the two circles CIRCLE1 and CIRCLE1. +%% Both circles are given with format: [XC YC R], with (XC,YC) being the +%% coordinates of the center and R being the radius. +%% POINTS is a 2-by-2 array, containing coordinate of an intersection +%% point on each row. +%% In the case of tangent circles, the intersection is returned twice. It +%% can be simplified by using the 'unique' function. +%% +%% Example +%% % intersection points of two distant circles +%% c1 = [0 0 10]; +%% c2 = [10 0 10]; +%% pts = intersectCircles(c1, c2) +%% pts = +%% 5 -8.6603 +%% 5 8.6603 +%% +%% % intersection points of two tangent circles +%% c1 = [0 0 10]; +%% c2 = [20 0 10]; +%% pts = intersectCircles(c1, c2) +%% pts = +%% 10 0 +%% 10 0 +%% pts2 = unique(pts, 'rows') +%% pts2 = +%% 10 0 +%% +%% References +%% http://local.wasp.uwa.edu.au/~pbourke/geometry/2circle/ +%% http://mathworld.wolfram.com/Circle-CircleIntersection.html +%% +%% @seealso{circles2d, intersectLineCircle, radicalAxis} +%% @end deftypefn + +function points = intersectCircles(circle1, circle2) + + % adapt sizes of inputs + n1 = size(circle1, 1); + n2 = size(circle2, 1); + if n1 ~= n2 + if n1 > 1 && n2 == 1 + circle2 = repmat(circle2, n1, 1); + elseif n2 > 1 && n1 == 1 + circle1 = repmat(circle1, n2, 1); + else + error('Both input should have same number of rows'); + end + end + + % extract center and radius of each circle + center1 = circle1(:, 1:2); + center2 = circle2(:, 1:2); + r1 = circle1(:,3); + r2 = circle2(:,3); + + % allocate memory for result + nPoints = length(r1); + points = NaN * ones(2*nPoints, 2); + + % distance between circle centers + d12 = distancePoints(center1, center2, 'diag'); + + % get indices of circle couples with intersections + inds = d12 >= abs(r1 - r2) & d12 <= (r1 + r2); + + if sum(inds) == 0 + return; + end + + % angle of line from center1 to center2 + angle = angle2Points(center1(inds,:), center2(inds,:)); + + % position of intermediate point, located at the intersection of the + % radical axis with the line joining circle centers + d1m = d12(inds) / 2 + (r1(inds).^2 - r2(inds).^2) ./ (2 * d12(inds)); + tmp = polarPoint(center1(inds, :), d1m, angle); + + % distance between intermediate point and each intersection point + h = sqrt(r1(inds).^2 - d1m.^2); + + % indices of valid intersections + inds2 = find(inds)*2; + inds1 = inds2 - 1; + + % create intersection points + points(inds1, :) = polarPoint(tmp, h, angle - pi/2); + points(inds2, :) = polarPoint(tmp, h, angle + pi/2); + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/intersectEdges.m b/octave_packages/geometry-1.5.0/geom2d/intersectEdges.m new file mode 100644 index 0000000..6a05adc --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/intersectEdges.m @@ -0,0 +1,175 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{point} = } intersectEdges (@var{edge1}, @var{edge2}) +%% Return all intersections between two set of edges +%% +%% P = intersectEdges(E1, E2); +%% returns the intersection point of lines L1 and L2. E1 and E2 are 1-by-4 +%% arrays, containing parametric representation of each edge (in the form +%% [x1 y1 x2 y2], see 'createEdge' for details). +%% +%% In case of colinear edges, returns [Inf Inf]. +%% In case of parallel but not colinear edges, returns [NaN NaN]. +%% +%% If each input is [N*4] array, the result is a [N*2] array containing +%% intersections of each couple of edges. +%% If one of the input has N rows and the other 1 row, the result is a +%% [N*2] array. +%% +%% @seealso{edges2d, intersectLines} +%% @end deftypefn + +function point = intersectEdges(edge1, edge2) + %% Initialisations + + % ensure input arrays are same size + N1 = size(edge1, 1); + N2 = size(edge2, 1); + + % ensure input have same size + if N1~=N2 + if N1==1 + edge1 = repmat(edge1, [N2 1]); + N1 = N2; + elseif N2==1 + edge2 = repmat(edge2, [N1 1]); + end + end + + % tolerance for precision + tol = 1e-14; + + % initialize result array + x0 = zeros(N1, 1); + y0 = zeros(N1, 1); + + + %% Detect parallel and colinear cases + + % indices of parallel edges + %par = abs(dx1.*dy2 - dx1.*dy2) return [NaN NaN] + x0(par & ~col) = NaN; + y0(par & ~col) = NaN; + + + %% Process colinear edges + + % colinear edges may have 0, 1 or infinite intersection + % Discrimnation based on position of edge2 vertices on edge1 + if sum(col)>0 + % array for storing results of colinear edges + resCol = Inf*ones(size(col)); + + % compute position of edge2 vertices wrt edge1 + t1 = edgePosition(edge2(col, 1:2), edge1(col, :)); + t2 = edgePosition(edge2(col, 3:4), edge1(col, :)); + + % control location of vertices: we want t1t2 + tmp = t1; + t1 = t2; + t2 = tmp; + end + + % edge totally before first vertex or totally after last vertex + resCol(col(t2<-eps)) = NaN; + resCol(col(t1>1+eps)) = NaN; + + % set up result into point coordinate + x0(col) = resCol; + y0(col) = resCol; + + % touches on first point of first edge + touch = col(abs(t2)<1e-14); + x0(touch) = edge1(touch, 1); + y0(touch) = edge1(touch, 2); + + % touches on second point of first edge + touch = col(abs(t1-1)<1e-14); + x0(touch) = edge1(touch, 3); + y0(touch) = edge1(touch, 4); + end + + + %% Process non parallel cases + + % process intersecting edges whose interecting lines intersect + i = find(~par); + + % use a test to avoid process empty arrays + if sum(i)>0 + % extract base parameters of supporting lines for non-parallel edges + x1 = edge1(i,1); + y1 = edge1(i,2); + dx1 = edge1(i,3)-x1; + dy1 = edge1(i,4)-y1; + x2 = edge2(i,1); + y2 = edge2(i,2); + dx2 = edge2(i,3)-x2; + dy2 = edge2(i,4)-y2; + + % compute intersection points of supporting lines + delta = (dx2.*dy1-dx1.*dy2); + x0(i) = ((y2-y1).*dx1.*dx2 + x1.*dy1.*dx2 - x2.*dy2.*dx1) ./ delta; + y0(i) = ((x2-x1).*dy1.*dy2 + y1.*dx1.*dy2 - y2.*dx2.*dy1) ./ -delta; + + % compute position of intersection points on each edge + % t1 is position on edge1, t2 is position on edge2 + t1 = ((y0(i)-y1).*dy1 + (x0(i)-x1).*dx1) ./ (dx1.*dx1+dy1.*dy1); + t2 = ((y0(i)-y2).*dy2 + (x0(i)-x2).*dx2) ./ (dx2.*dx2+dy2.*dy2); + + % check position of points on edges. + % it should be comprised between 0 and 1 for both t1 and t2. + % if not, the edges do not intersect + out = t1<-tol | t1>1+tol | t2<-tol | t2>1+tol; + x0(i(out)) = NaN; + y0(i(out)) = NaN; + end + + + %% format output arguments + + point = [x0 y0]; + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/intersectLineCircle.m b/octave_packages/geometry-1.5.0/geom2d/intersectLineCircle.m new file mode 100644 index 0000000..dde01d0 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/intersectLineCircle.m @@ -0,0 +1,106 @@ +%% Copyright (c) 2011, INRA +%% 2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{points} = } intersectLineCircle (@var{line}, @var{circle}) +%% Intersection point(s) of a line and a circle +%% +%% INTERS = intersectLineCircle(LINE, CIRCLE); +%% Returns a 2-by-2 array, containing on each row the coordinates of an +%% intersection point. If the line and circle do not intersect, the result +%% is filled with NaN. +%% +%% Example +%% % base point +%% center = [10 0]; +%% % create vertical line +%% l1 = [center 0 1]; +%% % circle +%% c1 = [center 5]; +%% pts = intersectLineCircle(l1, c1) +%% pts = +%% 10 -5 +%% 10 5 +%% % draw the result +%% figure; clf; hold on; +%% axis([0 20 -10 10]); +%% drawLine(l1); +%% drawCircle(c1); +%% drawPoint(pts, 'rx'); +%% axis equal; +%% +%% @seealso{lines2d, circles2d, intersectLines, intersectCircles} +%% @end deftypefn + +function points = intersectLineCircle(line, circle) + + % local precision + eps = 1e-14; + + % center parameters + center = circle(:, 1:2); + radius = circle(:, 3); + + % line parameters + dp = line(:, 1:2) - center; + vl = line(:, 3:4); + + % coefficient of second order equation + a = sum(line(:, 3:4).^2, 2); + b = 2*sum(dp .* vl, 2); + c = sum(dp.^2, 2) - radius.^2; + + % discriminant + delta = b .^ 2 - 4 * a .* c; + + if delta > eps + % find two roots of second order equation + u1 = (-b - sqrt(delta)) / 2 ./ a; + u2 = (-b + sqrt(delta)) / 2 ./ a; + + % convert into 2D coordinate + points = [line(1:2) + u1 * line(3:4) ; line(1:2) + u2 * line(3:4)]; + + elseif abs(delta) < eps + % find unique root, and convert to 2D coord. + u = -b / 2 ./ a; + points = line(1:2) + u*line(3:4); + + else + % fill with NaN + points = NaN * ones(2, 2); + return; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/intersectLineEdge.m b/octave_packages/geometry-1.5.0/geom2d/intersectLineEdge.m new file mode 100644 index 0000000..2f309cd --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/intersectLineEdge.m @@ -0,0 +1,106 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{point} = } intersecLineEdge (@var{line}, @var{edge}) +%% Return intersection between a line and an edge. +%% +%% Returns the intersection point of lines @var{line} and edge @var{edge}. +%% @var{line} is a 1x4 array containing parametric representation of the line +%% (in the form [x0 y0 dx dy], see @code{createLine} for details). +%% @var{edge} is a 1x4 array containing coordinates of first and second point +%% (in the form [x1 y1 x2 y2], see @code{createEdge} for details). +%% +%% In case of colinear line and edge, returns [Inf Inf]. +%% If line does not intersect edge, returns [NaN NaN]. +%% +%% If each input is [N*4] array, the result is a [N*2] array containing +%% intersections for each couple of edge and line. +%% If one of the input has N rows and the other 1 row, the result is a +%% [N*2] array. +%% +%% @seealso{lines2d, edges2d, intersectEdges, intersectLine} +%% @end deftypefn + +function point = intersectLineEdge(lin, edge) + x0 = lin(:,1); + y0 = lin(:,2); + dx1 = lin(:,3); + dy1 = lin(:,4); + x1 = edge(:,1); + y1 = edge(:,2); + x2 = edge(:,3); + y2 = edge(:,4); + dx2 = x2-x1; + dy2 = y2-y1; + + N1 = length(x0); + N2 = length(x1); + + % indices of parallel lines + par = abs(dx1.*dy2-dx2.*dy1)<1e-14; + + % indices of colinear lines + col = abs((x1-x0).*dy1-(y1-y0).*dx1)<1e-14 & par ; + + xi(col) = Inf; + yi(col) = Inf; + xi(par & ~col) = NaN; + yi(par & ~col) = NaN; + + i = ~par; + + % compute intersection points + if N1==N2 + xi(i) = ((y1(i)-y0(i)).*dx1(i).*dx2(i) + x0(i).*dy1(i).*dx2(i) - x1(i).*dy2(i).*dx1(i)) ./ ... + (dx2(i).*dy1(i)-dx1(i).*dy2(i)) ; + yi(i) = ((x1(i)-x0(i)).*dy1(i).*dy2(i) + y0(i).*dx1(i).*dy2(i) - y1(i).*dx2(i).*dy1(i)) ./ ... + (dx1(i).*dy2(i)-dx2(i).*dy1(i)) ; + elseif N1==1 + xi(i) = ((y1(i)-y0).*dx1.*dx2(i) + x0.*dy1.*dx2(i) - x1(i).*dy2(i).*dx1) ./ ... + (dx2(i).*dy1-dx1.*dy2(i)) ; + yi(i) = ((x1(i)-x0).*dy1.*dy2(i) + y0.*dx1.*dy2(i) - y1(i).*dx2(i).*dy1) ./ ... + (dx1.*dy2(i)-dx2(i).*dy1) ; + elseif N2==1 + xi(i) = ((y1-y0(i)).*dx1(i).*dx2 + x0(i).*dy1(i).*dx2 - x1(i).*dy2.*dx1(i)) ./ ... + (dx2.*dy1(i)-dx1(i).*dy2) ; + yi(i) = ((x1-x0(i)).*dy1(i).*dy2 + y0(i).*dx1(i).*dy2 - y1(i).*dx2.*dy1(i)) ./ ... + (dx1(i).*dy2-dx2.*dy1(i)) ; + end + + point = [xi' yi']; + out = find(~isPointOnEdge(point, edge)); + point(out, :) = repmat([NaN NaN], [length(out) 1]); + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/intersectLines.m b/octave_packages/geometry-1.5.0/geom2d/intersectLines.m new file mode 100644 index 0000000..e953e50 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/intersectLines.m @@ -0,0 +1,178 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{point} =} intersectLines (@var{line1}, @var{line2}) +%% @deftypefnx {Function File} {@var{point} =} intersectLines (@var{line1}, @var{line2},@var{eps}) +%% Return all intersection points of N lines in 2D. +%% +%% Returns the intersection point of lines @var{line1} and @var{line2}. +%% @var{line1} and @var{line2} are [1*4] +%% arrays, containing parametric representation of each line (in the form +%% [x0 y0 dx dy], see @code{createLine} for details). +%% +%% In case of colinear lines, returns [Inf Inf]. +%% In case of parallel but not colinear lines, returns [NaN NaN]. +%% +%% If each input is [N*4] array, the result is a [N*2] array containing +%% intersections of each couple of lines. +%% If one of the input has N rows and the other 1 row, the result is a +%% [N*2] array. +%% +%% A third input argument specifies the tolerance for detecting parallel lines. +%% Default is 1e-14. +%% +%% Example +%% +%% @example +%% line1 = createLine([0 0], [10 10]); +%% line2 = createLine([0 10], [10 0]); +%% point = intersectLines(line1, line2) +%% point = +%% 5 5 +%% @end example +%% +%% @seealso{lines2d, edges2d, intersectEdges, intersectLineEdge, intersectLineCircle} +%% @end deftypefn + +function point = intersectLines(line1, line2, varargin) + + % extreact tolerance + tol = 1e-14; + if !isempty(varargin) + tol = varargin{1}; + end + + x1 = line1(:,1); + y1 = line1(:,2); + dx1 = line1(:,3); + dy1 = line1(:,4); + + x2 = line2(:,1); + y2 = line2(:,2); + dx2 = line2(:,3); + dy2 = line2(:,4); + + N1 = length(x1); + N2 = length(x2); + + % indices of parallel lines + par = abs(dx1.*dy2 - dx2.*dy1) < tol; + + % indices of colinear lines + col = abs((x2-x1) .* dy1 - (y2-y1) .* dx1) < tol & par ; + + x0(col) = Inf; + y0(col) = Inf; + x0(par & !col) = NaN; + y0(par & !col) = NaN; + + i = !par; + + % compute intersection points + if N1==N2 + x0(i) = ((y2(i)-y1(i)).*dx1(i).*dx2(i) + x1(i).*dy1(i).*dx2(i) - x2(i).*dy2(i).*dx1(i)) ./ ... + (dx2(i).*dy1(i)-dx1(i).*dy2(i)) ; + y0(i) = ((x2(i)-x1(i)).*dy1(i).*dy2(i) + y1(i).*dx1(i).*dy2(i) - y2(i).*dx2(i).*dy1(i)) ./ ... + (dx1(i).*dy2(i)-dx2(i).*dy1(i)) ; + + elseif N1==1 + x0(i) = ((y2(i)-y1).*dx1.*dx2(i) + x1.*dy1.*dx2(i) - x2(i).*dy2(i).*dx1) ./ ... + (dx2(i).*dy1-dx1.*dy2(i)) ; + y0(i) = ((x2(i)-x1).*dy1.*dy2(i) + y1.*dx1.*dy2(i) - y2(i).*dx2(i).*dy1) ./ ... + (dx1.*dy2(i)-dx2(i).*dy1) ; + + elseif N2==1 + x0(i) = ((y2-y1(i)).*dx1(i).*dx2 + x1(i).*dy1(i).*dx2 - x2.*dy2.*dx1(i)) ./ ... + (dx2.*dy1(i)-dx1(i).*dy2) ; + y0(i) = ((x2-x1(i)).*dy1(i).*dy2 + y1(i).*dx1(i).*dy2 - y2.*dx2.*dy1(i)) ./ ... + (dx1(i).*dy2-dx2.*dy1(i)) ; + + else + % formattage a rajouter + x0(i) = ((y2(i)-y1(i)).*dx1(i).*dx2(i) + x1(i).*dy1(i).*dx2(i) - x2(i).*dy2(i).*dx1(i)) ./ ... + (dx2(i).*dy1(i)-dx1(i).*dy2(i)) ; + y0(i) = ((x2(i)-x1(i)).*dy1(i).*dy2(i) + y1(i).*dx1(i).*dy2(i) - y2(i).*dx2(i).*dy1(i)) ./ ... + (dx1(i).*dy2(i)-dx2(i).*dy1(i)) ; + end + + % concatenate result + point = [x0' y0']; + +endfunction + +%!test % basic test with two orthogonal lines +%! line1 = [3 1 0 1]; +%! line2 = [1 4 1 0]; +%! assert (intersectLines(line1, line2), [3 4], 1e-6); + +%!test % orthognal diagonal lines +%! line1 = [0 0 3 2]; +%! line2 = [5 -1 4 -6]; +%! assert (intersectLines(line1, line2), [3 2], 1e-6); + +%!test % one diagonal and one horizontal line +%! line1 = [10 2 25 0]; +%! line2 = [5 -1 4 -6]; +%! assert (intersectLines(line1, line2), [3 2], 1e-6); + +%!test % check for dx and dy very big compared to other line +%! line1 = [3 1 0 1000]; +%! line2 = [1 4 -14 0]; +%! assert (intersectLines(line1, line2), [3 4], 1e-6); + +%!test +%! line1 = [2 0 20000 30000]; +%! line2 = [1 6 1 -1]; +%! assert (intersectLines(line1, line2), [4 3], 1e-6); + +%!test +%! line1 = [3 1 0 1]; +%! line2 = repmat([1 4 1 0], 5, 1); +%! res = repmat([3 4], 5, 1); +%! inters = intersectLines(line1, line2); +%! assert (res, inters, 1e-6); + +%!test +%! line1 = repmat([3 1 0 1], 5, 1); +%! line2 = [1 4 1 0]; +%! res = repmat([3 4], 5, 1); +%! inters = intersectLines(line1, line2); +%! assert (res, inters, 1e-6); + +%!test +%! line1 = repmat([3 1 0 1], 5, 1); +%! line2 = repmat([1 4 1 0], 5, 1); +%! res = repmat([3 4], 5, 1); +%! inters = intersectLines(line1, line2); +%! assert (res, inters, 1e-6); diff --git a/octave_packages/geometry-1.5.0/geom2d/isCounterClockwise.m b/octave_packages/geometry-1.5.0/geom2d/isCounterClockwise.m new file mode 100644 index 0000000..01f71e6 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/isCounterClockwise.m @@ -0,0 +1,156 @@ +%% Copyright (c) 2011, INRA +%% 2010-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{ccw} = } isCounterClockwise (@var{p1}, @var{p2}, @var{p3}) +%% @deftypefnx {Function File} {@var{ccw} = } isCounterClockwise (@var{p1}, @var{p2}, @var{p3},@var{tol}) +%% Compute relative orientation of 3 points +%% +%% Computes the orientation of the 3 points. The returns is: +%% +1 if the path @var{p1}-> @var{p2}-> @var{p3} turns Counter-Clockwise (i.e., the point @var{p3} +%% is located "on the left" of the line @var{p1}- @var{p2}) +%% -1 if the path turns Clockwise (i.e., the point @var{p3} lies "on the right" +%% of the line @var{p1}- @var{p2}) +%% 0 if the point @var{p3} is located on the line segment [ @var{p1} @var{p2}]. +%% +%% This function can be used in more complicated algorithms: detection of +%% line segment intersections, convex hulls, point in triangle... +%% +%% @var{ccw} = isCounterClockwise( @var{p1}, @var{p2}, @var{p3}, EPS); +%% Specifies the threshold used for detecting colinearity of the 3 points. +%% Default value is 1e-12 (absolute). +%% +%% Example +%% +%% @example +%% isCounterClockwise([0 0], [10 0], [10 10]) +%% ans = +%% 1 +%% isCounterClockwise([0 0], [0 10], [10 10]) +%% ans = +%% -1 +%% isCounterClockwise([0 0], [10 0], [5 0]) +%% ans = +%% 0 +%% @end example +%% +%% @seealso{points2d, isPointOnLine, isPointInTriangle} +%% @end deftypefn + +function res = isCounterClockwise(p1, p2, p3, varargin) + + % get threshold value + eps = 1e-12; + if ~isempty(varargin) + eps = varargin{1}; + end + + % ensure all data have same size + np = max([size(p1, 1) size(p2, 1) size(p3,1)]); + if np > 1 + if size(p1,1) == 1 + p1 = repmat(p1, np, 1); + end + if size(p2,1) == 1 + p2 = repmat(p2, np, 1); + end + if size(p3,1) == 1 + p3 = repmat(p3, np, 1); + end + end + + % init with 0 + res = zeros(np, 1); + + % extract vector coordinates + x0 = p1(:, 1); + y0 = p1(:, 2); + dx1 = p2(:, 1) - x0; + dy1 = p2(:, 2) - y0; + dx2 = p3(:, 1) - x0; + dy2 = p3(:, 2) - y0; + + % check non colinear cases + res(dx1 .* dy2 > dy1 .* dx2) = 1; + res(dx1 .* dy2 < dy1 .* dx2) = -1; + + % case of colinear points + ind = abs(dx1 .* dy2 - dy1 .* dx2) < eps; + res(ind( (dx1(ind) .* dx2(ind) < 0) | (dy1(ind) .* dy2(ind) < 0) )) = -1; + res(ind( hypot(dx1(ind), dy1(ind)) < hypot(dx2(ind), dy2(ind)) )) = 1; + +endfunction + +%!shared p0,pu,pd,pl,pr +%! p0 = [2, 3]; % center point +%! pu = [2, 4]; % up point +%! pd = [2, 2]; % down point +%! pl = [1, 3]; % left point +%! pr = [3, 3]; % right point + +%!assert (+1, isCounterClockwise(pl, p0, pu)); +%!assert (+1, isCounterClockwise(pd, p0, pl)); +%!assert (+1, isCounterClockwise(pr, p0, pd)); +%!assert (+1, isCounterClockwise(pu, p0, pr)); + +% turn 90° right => return -1 +%!assert (-1, isCounterClockwise(pl, p0, pd)); +%!assert (-1, isCounterClockwise(pd, p0, pr)); +%!assert (-1, isCounterClockwise(pr, p0, pu)); +%!assert (-1, isCounterClockwise(pu, p0, pl)); + +%!test % turn 90° left => return +1 +%! pts1 = [pl;pd;pr;pu;pl;pd;pr;pu]; +%! pts2 = [p0;p0;p0;p0;p0;p0;p0;p0]; +%! pts3 = [pu;pl;pd;pr;pd;pr;pu;pl]; +%! expected = [1;1;1;1;-1;-1;-1;-1]; +%! result = isCounterClockwise(pts1, pts2, pts3); +%! assert (result, expected, 1e-6); + +% aligned with p0-p1-p2 => return +1 +%!assert (+1, isCounterClockwise(pl, p0, pr)); +%!assert (+1, isCounterClockwise(pu, p0, pd)); +%!assert (+1, isCounterClockwise(pr, p0, pl)); +%!assert (+1, isCounterClockwise(pd, p0, pu)); + +% aligned ]ith p0-p2-p1 => return 0 +%!assert (0, isCounterClockwise(pl, pr, p0)); +%!assert (0, isCounterClockwise(pu, pd, p0)); +%!assert (0, isCounterClockwise(pr, pl, p0)); +%!assert (0, isCounterClockwise(pd, pu, p0)); + +% aligned with p1-p0-p2 => return -1 +%!assert (-1, isCounterClockwise(p0, pl, pr)); +%!assert (-1, isCounterClockwise(p0, pu, pd)); +%!assert (-1, isCounterClockwise(p0, pr, pl)); +%!assert (-1, isCounterClockwise(p0, pr, pl)); diff --git a/octave_packages/geometry-1.5.0/geom2d/isLeftOriented.m b/octave_packages/geometry-1.5.0/geom2d/isLeftOriented.m new file mode 100644 index 0000000..a95e1a1 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/isLeftOriented.m @@ -0,0 +1,59 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{b} = } isLeftOriented (@var{point}, @var{line}) +%% Test if a point is on the left side of a line +%% +%% B = isLeftOriented(POINT, LINE); +%% Returns TRUE if the point lies on the left side of the line with +%% respect to the line direction. +%% +%% @seealso{lines2d, points2d, isCounterClockwise, isPointOnLine, distancePointLine} +%% @end deftypefn + +function b = isLeftOriented(point, line) + Nl = size(line, 1); + Np = size(point, 1); + + x0 = repmat(line(:,1)', Np, 1); + y0 = repmat(line(:,2)', Np, 1); + dx = repmat(line(:,3)', Np, 1); + dy = repmat(line(:,4)', Np, 1); + xp = repmat(point(:,1), 1, Nl); + yp = repmat(point(:,2), 1, Nl); + + + b = (xp-x0).*dy-(yp-y0).*dx < 0; + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/isParallel.m b/octave_packages/geometry-1.5.0/geom2d/isParallel.m new file mode 100644 index 0000000..0ee5774 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/isParallel.m @@ -0,0 +1,97 @@ +%% Copyright (c) 2011, INRA +%% 2006-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{b} = } isParallel (@var{v1}, @var{v2}) +%% @deftypefnx {Function File} {@var{b} = } isParallel (@var{v1}, @var{v2},@var{tol}) +%% Check parallelism of two vectors +%% +%% @var{v1} and @var{v2} are 2 row vectors of length Nd, Nd being the dimension, +%% returns @code{true} if the vectors are parallel, and @code{false} otherwise. +%% +%% Also works when @var{v1} and @var{v2} are two [NxNd] arrays with same number of +%% rows. In this case, return a [Nx1] array containing @code{true} at the positions +%% of parallel vectors. +%% +%% @var{tol} specifies the accuracy of numerical computation. Default value is 1e-14. +%% +%% Example +%% +%% @example +%% isParallel([1 2], [2 4]) +%% ans = +%% 1 +%% isParallel([1 2], [1 3]) +%% ans = +%% 0 +%% @end example +%% +%% @seealso{vectors2d, isPerpendicular, lines2d} +%% @end deftypefn + +%% FIXME or erase me +%% Also works when one of @var{v1} or @var{v2} is scalar and the other one is [NxNd] +%% array, in this case return [Nx1] results. + +function b = isParallel(v1, v2, varargin) + + % default accuracy + acc = 1e-14; + if ~isempty(varargin) + acc = abs(varargin{1}); + end + + % adapt size of inputs if needed + n1 = size(v1, 1); + n2 = size(v2, 1); + if n1 ~= n2 + if n1 == 1 + v1 = v1(ones(n2,1), :); + elseif n2 == 1 + v2 = v2(ones(n1,1), :); + end + end + + % performs computation + if size(v1, 2) == 2 + b = abs(v1(:, 1) .* v2(:, 2) - v1(:, 2) .* v2(:, 1)) < acc; + else + % computation in space + b = vectorNorm(cross(v1, v2, 2)) < acc; + end + +endfunction + +%!assert (isParallel ([1 2], [2 4])) +%!assert (!isParallel ([1 2], [1 3])) +%!error (isParallel (3, rand(4,2))) diff --git a/octave_packages/geometry-1.5.0/geom2d/isPerpendicular.m b/octave_packages/geometry-1.5.0/geom2d/isPerpendicular.m new file mode 100644 index 0000000..1056cbd --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/isPerpendicular.m @@ -0,0 +1,95 @@ +%% Copyright (c) 2011, INRA +%% 2006-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{b} = } isPerpendicular (@var{v1}, @var{v2}) +%% @deftypefnx {Function File} {@var{b} = } isPerpendicula (@var{v1}, @var{v2},@var{tol}) +%% heck orthogonality of two vectors. +%% +%% @var{v1} and @var{v2} are 2 row vectors of length Nd, Nd being the dimension, +%% returns @code{true} if the vectors are perpendicular, and @code{false} otherwise. +%% +%% Also works when @var{v1} and @var{v2} are two [NxNd] arrays with same number of +%% rows. In this case, return a [Nx1] array containing @code{true} at the positions +%% of parallel vectors. +%% +%% @var{tol} specifies the accuracy of numerical computation. Default value is 1e-14. +%% +%% Example +%% +%% @example +% isPerpendicular([1 2 0], [0 0 2]) +%% ans = +%% 1 +% isPerpendicular([1 2 1], [1 3 2]) +%% ans = +%% 0 +%% @end example +%% +%% @seealso{vectors2d, isParallel, lines2d} +%% @end deftypefn + +%% FIXME or erase me +%% Also works when one of @var{v1} or @var{v2} is scalar and the other one is [NxNd] +%% array, in this case return [Nx1] results. + +function b = isPerpendicular(v1, v2, varargin) + + % default accuracy + acc = 1e-14; + if ~isempty(varargin) + acc = abs(varargin{1}); + end + + % adapt size of inputs + n1 = size(v1, 1); + n2 = size(v2, 1); + if n1~=n2 + if n1==1 + v1 = v1(ones(n2, 1), :); + elseif n2==1 + v2 = v2(ones(n1, 1), :); + else + error('Inputs must either have same size, or one must be scalar'); + end + end + + % performs test + b = abs(dot(v1, v2, 2)) < acc; + +endfunction + +%!assert (isPerpendicular ([1 2 0], [0 0 2])) +%!assert (!isPerpendicular([1 2 1], [1 3 2])) +%!error (isPerpendicular(1, rand(4,3))) + diff --git a/octave_packages/geometry-1.5.0/geom2d/isPointInCircle.m b/octave_packages/geometry-1.5.0/geom2d/isPointInCircle.m new file mode 100644 index 0000000..44e11d2 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/isPointInCircle.m @@ -0,0 +1,67 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{b} = } isPointInCircle (@var{point}, @var{circle}) +%% Test if a point is located inside a given circle +%% +%% B = isPointInCircle(POINT, CIRCLE) +%% Returns true if point is located inside the circle, i.e. if distance to +%% circle center is lower than the circle radius. +%% +%% B = isPointInCircle(POINT, CIRCLE, TOL) +%% Specifies the tolerance value +%% +%% Example: +%% isPointInCircle([1 0], [0 0 1]) +%% isPointInCircle([0 0], [0 0 1]) +%% returns true, whereas +%% isPointInCircle([1 1], [0 0 1]) +%% return false +%% +%% @seealso{circles2d, isPointOnCircle} +%% @end deftypefn + +function b = isPointInCircle(point, circle, varargin) + + % extract computation tolerance + tol = 1e-14; + if ~isempty(varargin) + tol = varargin{1}; + end + + d = sqrt(sum(power(point - circle(:,1:2), 2), 2)); + b = d-circle(:,3)<=tol; + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/isPointInEllipse.m b/octave_packages/geometry-1.5.0/geom2d/isPointInEllipse.m new file mode 100644 index 0000000..725ad93 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/isPointInEllipse.m @@ -0,0 +1,81 @@ +%% Copyright (c) 2011, INRA +%% 2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{b} = } isPointInellipse (@var{point}, @var{ellipse}) +%% Check if a point is located inside a given ellipse +%% +%% B = isPointInEllipse(POINT, ELLIPSE) +%% Returns true if point is located inside the given ellipse. +%% +%% B = isPointInEllipse(POINT, ELLIPSE, TOL) +%% Specifies the tolerance value +%% +%% Example: +%% isPointInEllipse([1 0], [0 0 2 1 0]) +%% ans = +%% 1 +%% isPointInEllipse([0 0], [0 0 2 1 0]) +%% ans = +%% 1 +%% isPointInEllipse([1 1], [0 0 2 1 0]) +%% ans = +%% 0 +%% isPointInEllipse([1 1], [0 0 2 1 30]) +%% ans = +%% 1 +%% +%% @seealso{ellipses2d, isPointInCircle} +%% @end deftypefn + +function b = isPointInEllipse(point, ellipse, varargin) + + % extract computation tolerance + tol = 1e-14; + if ~isempty(varargin) + tol = varargin{1}; + end + + % compute ellipse to unit circle transform + rot = createRotation(-deg2rad(ellipse(5))); + sca = createScaling(1./ellipse(3:4)); + trans = sca * rot; + + % transform points to unit circle basis + pTrans = bsxfun(@minus, point, ellipse(:,1:2)); + pTrans = transformPoint(pTrans, trans); + + % test if distance to origin smaller than 1 + b = sqrt(sum(power(pTrans, 2), 2)) - 1 <= tol; + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/isPointOnCircle.m b/octave_packages/geometry-1.5.0/geom2d/isPointOnCircle.m new file mode 100644 index 0000000..3eea4bc --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/isPointOnCircle.m @@ -0,0 +1,65 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{b} = } isPointOnCircle (@var{point}, @var{circle}) +%% Test if a point is located on a given circle. +%% +%% B = isPointOnCircle(POINT, CIRCLE) +%% return true if point is located on the circle, i.e. if the distance to +%% the circle center equals the radius up to an epsilon value. +%% +%% B = isPointOnCircle(POINT, CIRCLE, TOL) +%% Specifies the tolerance value. +%% +%% Example: +%% isPointOnCircle([1 0], [0 0 1]) +%% returns true, whereas +%% isPointOnCircle([1 1], [0 0 1]) +%% return false +%% +%% @seealso{circles2d, isPointInCircle} +%% @end deftypefn + +function b = isPointOnCircle(point, circle, varargin) + + tol = 1e-14; + if ~isempty(varargin) + tol = varargin{1}; + end + + d = sqrt(sum(power(point - circle(:,1:2), 2), 2)); + b = abs(d-circle(:,3)) +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{b} = } isPointOnEdge (@var{point}, @var{edge}) +%% @deftypefnx {Function File} {@var{b} = } isPointOnEdge (@var{point}, @var{edge}, @var{tol}) +%% @deftypefnx {Function File} {@var{b} = } isPointOnEdge (@var{point}, @var{edgearray}) +%% @deftypefnx {Function File} {@var{b} = } isPointOnEdge (@var{pointarray}, @var{edgearray}) +%% Test if a point belongs to an edge. +% +% with @var{point} being [xp yp], and @var{edge} being [x1 y1 x2 y2], returns TRUE if +% the point is located on the edge, and FALSE otherwise. +% +% Specify an optilonal tolerance value @var{tol}. The tolerance is given as a +% fraction of the norm of the edge direction vector. Default is 1e-14. +% +% When one of the inputs has several rows, return the result of the test +% for each element of the array tested against the single parameter. +% +% When both @var{pointarray} and @var{edgearray} have the same number of rows, +% returns a column vector with the same number of rows. +% When the number of rows are different and both greater than 1, returns +% a Np-by-Ne matrix of booleans, containing the result for each couple of +% point and edge. +% +% @seealso{edges2d, points2d, isPointOnLine} +%% @end deftypefn + +function b = isPointOnEdge(point, edge, varargin) + + % extract computation tolerance + tol = 1e-14; + if ~isempty(varargin) + tol = varargin{1}; + end + + % number of edges and of points + Np = size(point, 1); + Ne = size(edge, 1); + + % adapt size of inputs if needed, and extract elements for computation + if Np == Ne + % When the number of points and edges is the same, the one-to-one test + % will be computed, so there is no need to repeat matrices + dx = edge(:,3) - edge(:,1); + dy = edge(:,4) - edge(:,2); + lx = point(:,1) - edge(:,1); + ly = point(:,2) - edge(:,2); + + elseif Np == 1 + % one point, several edges + dx = edge(:, 3) - edge(:, 1); + dy = edge(:, 4) - edge(:, 2); + lx = point(ones(Ne, 1), 1) - edge(:, 1); + ly = point(ones(Ne, 1), 2) - edge(:, 2); + + elseif Ne == 1 + % several points, one edge + dx = (edge(3) - edge(1)) * ones(Np, 1); + dy = (edge(4) - edge(2)) * ones(Np, 1); + lx = point(:, 1) - edge(1); + ly = point(:, 2) - edge(2); + + else + % Np points and Ne edges: + % Create an array for each parameter, so that the result will be a + % Np-by-Ne matrix of booleans (requires more memory, and uses repmat) + + x0 = repmat(edge(:, 1)', Np, 1); + y0 = repmat(edge(:, 2)', Np, 1); + dx = repmat(edge(:,3)', Np, 1) - x0; + dy = repmat(edge(:,4)', Np, 1) - y0; + + lx = repmat(point(:, 1), 1, Ne) - x0; + ly = repmat(point(:, 2), 1, Ne) - y0; + end + + % test if point is located on supporting line + b1 = (abs(lx.*dy - ly.*dx) ./ hypot(dx, dy)) < tol; + + % compute position of point with respect to edge bounds + % use different tests depending on line angle + ind = abs(dx) > abs(dy); + t = zeros(size(dx)); + t(ind) = lx( ind) ./ dx( ind); + t(~ind) = ly(~ind) ./ dy(~ind); + + % check if point is located between edge bounds + b = t >- tol & t-1 < tol & b1; + +endfunction + +%!shared points, vertices, edges + +%!demo +%! % create a point array +%! points = [10 10;15 10; 30 10]; +%! % create an edge array +%! vertices = [10 10;20 10;20 20;10 20]; +%! edges = [vertices vertices([2:end 1], :)]; +%! +%! % Test one point and one edge +%! isPointOnEdge(points(1,:), edges(1,:)) +%! isPointOnEdge(points(3,:), edges(1,:)) + +%!demo +%! % create a point array +%! points = [10 10;15 10; 30 10]; +%! % create an edge array +%! vertices = [10 10;20 10;20 20;10 20]; +%! edges = [vertices vertices([2:end 1], :)]; +%! +%! % Test one point and several edges +%! isPointOnEdge(points(1,:), edges)' + +%!demo +%! % create a point array +%! points = [10 10;15 10; 30 10]; +%! % create an edge array +%! vertices = [10 10;20 10;20 20;10 20]; +%! edges = [vertices vertices([2:end 1], :)]; +%! +%! % Test several points and one edge +%! isPointOnEdge(points, edges(1,:))' + +%!demo +%! % create a point array +%! points = [10 10;15 10; 30 10]; +%! % create an edge array +%! vertices = [10 10;20 10;20 20;10 20]; +%! edges = [vertices vertices([2:end 1], :)]; +%! +%! % Test N points and N edges +%! isPointOnEdge(points, edges(1:3,:))' + +%!demo +%! % create a point array +%! points = [10 10;15 10; 30 10]; +%! % create an edge array +%! vertices = [10 10;20 10;20 20;10 20]; +%! edges = [vertices vertices([2:end 1], :)]; +%! +%! % Test NP points and NE edges +%! isPointOnEdge(points, edges) + +%!test +%! p1 = [10 20]; +%! p2 = [80 20]; +%! edge = [p1 p2]; +%! p0 = [10 20]; +%! assert (isPointOnEdge(p0, edge)); +%! p0 = [80 20]; +%! assert (isPointOnEdge(p0, edge)); +%! p0 = [50 20]; +%! assert (isPointOnEdge(p0, edge)); +%! p0 = [9.99 20]; +%! assert (!isPointOnEdge(p0, edge)); +%! p0 = [80.01 20]; +%! assert (!isPointOnEdge(p0, edge)); +%! p0 = [50 21]; +%! assert (!isPointOnEdge(p0, edge)); +%! p0 = [79 19]; +%! assert (!isPointOnEdge(p0, edge)); + +%!test +%! p1 = [20 10]; +%! p2 = [20 80]; +%! edge = [p1 p2]; +%! p0 = [20 10]; +%! assert (isPointOnEdge(p0, edge)); +%! p0 = [20 80]; +%! assert (isPointOnEdge(p0, edge)); +%! p0 = [20 50]; +%! assert (isPointOnEdge(p0, edge)); +%! p0 = [20 9.99]; +%! assert (!isPointOnEdge(p0, edge)); +%! p0 = [20 80.01]; +%! assert (!isPointOnEdge(p0, edge)); +%! p0 = [21 50]; +%! assert (!isPointOnEdge(p0, edge)); +%! p0 = [19 79]; +%! assert (!isPointOnEdge(p0, edge)); + +%!test +%! p1 = [10 20]; +%! p2 = [60 70]; +%! edge = [p1 p2]; +%! assert (isPointOnEdge(p1, edge)); +%! assert (isPointOnEdge(p2, edge)); +%! p0 = [11 21]; +%! assert (isPointOnEdge(p0, edge)); +%! p0 = [59 69]; +%! assert (isPointOnEdge(p0, edge)); +%! p0 = [9.99 19.99]; +%! assert (!isPointOnEdge(p0, edge)); +%! p0 = [60.01 70.01]; +%! assert (!isPointOnEdge(p0, edge)); +%! p0 = [30 50.01]; +%! assert (!isPointOnEdge(p0, edge)); + +%!test +%! edge = [10 20 80 20; 20 10 20 80; 20 10 60 70]; +%! p0 = [20 20]; +%! assert ([true ; true ; false], isPointOnEdge(p0, edge)); + +%!test +%! k = 1e15; +%! p1 = [10 20]*k; +%! p2 = [60 70]*k; +%! edge = [p1 p2]; +%! assert (isPointOnEdge(p1, edge)); +%! assert (isPointOnEdge(p2, edge)); +%! p0 = [11 21]*k; +%! assert (isPointOnEdge(p0, edge)); +%! p0 = [59 69]*k; +%! assert (isPointOnEdge(p0, edge)); +%! p0 = [9.99 19.99]*k; +%! assert (!isPointOnEdge(p0, edge)); +%! p0 = [60.01 70.01]*k; +%! assert (!isPointOnEdge(p0, edge)); +%! p0 = [30 50.01]*k; +%! assert (!isPointOnEdge(p0, edge)); + +%!test +%! k = 1e-10; +%! p1 = [10 20]*k; +%! p2 = [60 70]*k; +%! edge = [p1 p2]; +%! assert (isPointOnEdge(p1, edge)); +%! assert (isPointOnEdge(p2, edge)); +%! p0 = [11 21]*k; +%! assert (isPointOnEdge(p0, edge)); +%! p0 = [59 69]*k; +%! assert (isPointOnEdge(p0, edge)); +%! p0 = [9.99 19.99]*k; +%! assert (!isPointOnEdge(p0, edge)); +%! p0 = [60.01 70.01]*k; +%! assert (!isPointOnEdge(p0, edge)); +%! p0 = [30 50.01]*k; +%! assert (!isPointOnEdge(p0, edge)); + +%!test +%! p1 = [10 20]; +%! p2 = [80 20]; +%! edge = [p1 p2]; +%! p0 = [10 20; 80 20; 50 20;50 21]; +%! exp = [true;true;true;false]; +%! assert (exp, isPointOnEdge(p0, edge)); + +%!test +%! p1 = [10 20]; +%! p2 = [80 20]; +%! edge = [p1 p2]; +%! p0 = [40 20]; +%! exp = [true;true;true;true]; +%! assert (exp, isPointOnEdge(p0, [edge;edge;edge;edge])); + +%!test +%! edge1 = [10 20 80 20]; +%! edge2 = [30 10 30 80]; +%! edges = [edge1; edge2]; +%! p0 = [40 20;30 90]; +%! exp = [true;false]; +%! assert (exp, isPointOnEdge(p0, edges)); diff --git a/octave_packages/geometry-1.5.0/geom2d/isPointOnLine.m b/octave_packages/geometry-1.5.0/geom2d/isPointOnLine.m new file mode 100644 index 0000000..b227cd2 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/isPointOnLine.m @@ -0,0 +1,72 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{b} = } isPointOnLine (@var{point}, @var{line}) +%% Test if a point belongs to a line +%% +%% B = isPointOnLine(POINT, LINE) +%% with POINT being [xp yp], and LINE being [x0 y0 dx dy]. +%% Returns 1 if point lies on the line, 0 otherwise. +%% +%% If POINT is an N*2 array of points, B is a N*1 array of booleans. +%% +%% If LINE is a N*4 array of line, B is a 1*N array of booleans. +%% +%% @seealso {lines2d, points2d, isPointOnEdge, isPointOnRay, angle3Points} +%% @end deftypefn + +function b = isPointOnLine(point, line, varargin) + + % extract computation tolerance + tol = 1e-14; + if ~isempty(varargin) + tol = varargin{1}; + end + + % number of lines and of points + Nl = size(line, 1); + Np = size(point, 1); + + % adapt the size of inputs + x0 = repmat(line(:,1)', Np, 1); + y0 = repmat(line(:,2)', Np, 1); + dx = repmat(line(:,3)', Np, 1); + dy = repmat(line(:,4)', Np, 1); + xp = repmat(point(:,1), 1, Nl); + yp = repmat(point(:,2), 1, Nl); + + % test if lines are colinear + b = abs((xp-x0).*dy-(yp-y0).*dx)./hypot(dx, dy) < tol; + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/isPointOnRay.m b/octave_packages/geometry-1.5.0/geom2d/isPointOnRay.m new file mode 100644 index 0000000..eebc2aa --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/isPointOnRay.m @@ -0,0 +1,94 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{b} = } isPointOnRay (@var{point}, @var{ray}) +%% @deftypefnx {Function File} {@var{b} = } isPointOnRay (@var{point}, @var{ray}, @var{tol}) +%% Test if a point belongs to a ray +%% +%% @var{b} = isPointOnRay(@var{point}, @var{ray}); +%% Returns @code{true} if point @var{point} belongs to the ray @var{ray}. +%% @var{point} is given by [x y] and RAY by [x0 y0 dx dy]. @var{tol} gives the +%% tolerance for the calculations. +%% +%% @seealso{rays2d, points2d, isPointOnLine} +%% @end deftypefn + +function b = isPointOnRay(point, ray, varargin) + + % extract computation tolerance + tol = 1e-14; + if ~isempty(varargin) + tol = varargin{1}; + end + + % number of rays and points + Nr = size(ray, 1); + Np = size(point, 1); + + % if several rays or several points, adapt sizes of arrays + x0 = repmat(ray(:,1)', Np, 1); + y0 = repmat(ray(:,2)', Np, 1); + dx = repmat(ray(:,3)', Np, 1); + dy = repmat(ray(:,4)', Np, 1); + xp = repmat(point(:,1), 1, Nr); + yp = repmat(point(:,2), 1, Nr); + + % test if points belongs to the supporting line + b1 = abs ( (xp-x0).*dy - (yp-y0).*dx ) ./ hypot(dx, dy) < tol; + + % check if points lie the good direction on the rays + ind = abs (dx) > abs (dy); + t = zeros (size (b1)); + t(ind) = (xp(ind)-x0(ind))./dx(ind); + t(~ind) = (yp(~ind)-y0(~ind))./dy(~ind); + + % combine the two tests + b = b1 & (t >= 0); + +endfunction + +%!shared ray +%! p1 = [10 20]; +%! p2 = [80 20]; +%! ray = createRay (p1, p2); + +%!assert (isPointOnRay([10 20], ray)); +%!assert (isPointOnRay([80 20], ray)); +%!assert (isPointOnRay([50 20], ray)); +%!assert (isPointOnRay([50 20+1e-3], ray,1e-2)); +%!assert ( !isPointOnRay([50 20+1e-3], ray,1e-4)); +%!assert ( !isPointOnRay([9.99 20], ray)); +%!assert ( !isPointOnRay([80 20.01], ray)); +%!assert ( !isPointOnRay([50 21], ray)); +%!assert ( !isPointOnRay([79 19], ray)); diff --git a/octave_packages/geometry-1.5.0/geom2d/lineAngle.m b/octave_packages/geometry-1.5.0/geom2d/lineAngle.m new file mode 100644 index 0000000..40c90e8 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/lineAngle.m @@ -0,0 +1,105 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{theta} =} lineAngle(varargin) +%% Computes angle between two straight lines +%% +%% A = lineAngle(LINE); +%% Returns the angle between horizontal, right-axis and the given line. +%% Angle is fiven in radians, between 0 and 2*pi, in counter-clockwise +%% direction. +%% +%% A = lineAngle(LINE1, LINE2); +%% Returns the directed angle between the two lines. Angle is given in +%% radians between 0 and 2*pi, in counter-clockwise direction. +%% +%% @seealso{lines2d, angles2d, createLine, normalizeAngle} +%% @end deftypefn + +function theta = lineAngle(varargin) + + nargs = length(varargin); + if nargs == 1 + % angle of one line with horizontal + line = varargin{1}; + theta = mod(atan2(line(:,4), line(:,3)) + 2*pi, 2*pi); + + elseif nargs==2 + % angle between two lines + theta1 = lineAngle(varargin{1}); + theta2 = lineAngle(varargin{2}); + theta = mod(bsxfun(@minus, theta2, theta1)+2*pi, 2*pi); + end + +endfunction + +% horizontal +%!test +%! line1 = createLine([2 3 1 0]); +%! assert (lineAngle(line1), 0, 1e-6); + +%!test +%! line1 = createLine([2 3 0 1]); +%! assert (lineAngle(line1), pi/2, 1e-6); + +%!test +%! line1 = createLine([2 3 1 1]); +%! assert (lineAngle(line1), pi/4, 1e-6); + +%!test +%! line1 = createLine([2 3 5 -1]); +%! assert (lineAngle(line1), mod(atan2(-1, 5)+2*pi, 2*pi), 1e-6); + +%!test +%! line1 = createLine([2 3 5000 -1000]); +%! assert (lineAngle(line1), mod(atan2(-1, 5)+2*pi, 2*pi), 1e-6); + +%!test +%! line1 = createLine([2 3 -1 0]); +%! assert (lineAngle(line1), pi, 1e-6); + +% test lineAngle with two parameters : angle between 2 lines +% check for 2 orthogonal lines +%!test +%! line1 = createLine([1 3 1 0]); +%! line2 = createLine([-2 -1 0 1]); +%! assert (lineAngle(line1, line2), pi/2, 1e-6); +%! assert (lineAngle(line2, line1), 3*pi/2, 1e-6); + +% check for 2 orthogonal lines, with very different parametrizations +%!test +%! line1 = createLine([1 3 1 1]); +%! line2 = createLine([-2 -1 -1000 1000]); +%! assert (lineAngle(line1, line2), pi/2, 1e-6); +%! assert (lineAngle(line2, line1), 3*pi/2, 1e-6); diff --git a/octave_packages/geometry-1.5.0/geom2d/linePosition.m b/octave_packages/geometry-1.5.0/geom2d/linePosition.m new file mode 100644 index 0000000..2b44a3b --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/linePosition.m @@ -0,0 +1,139 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PUR@var{pos}E +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% @var{pos}SIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{pos} =} linePosition (@var{point}, @var{line}) +%% Position of a point on a line. +%% +%% Computes position of point @var{point} on the line @var{line}, relative to origin +%% point and direction vector of the line. +%% @var{line} has the form [x0 y0 dx dy], +%% @var{point} has the form [x y], and is assumed to belong to line. +%% +%% If @var{line} is an array of NL lines, return NL positions, corresponding to +%% each line. +%% +%% If @var{point} is an array of NP points, return NP positions, corresponding +%% to each point. +%% +%% If @var{point} is an array of NP points and @var{line}S is an array of NL lines, +%% return an array of [NP NL] position, corresponding to each couple +%% point-line. +%% +%% Example +%% +%% @example +%% line = createLine([10 30], [30 90]); +%% linePosition([20 60], line) +%% ans = +%% .5 +%% @end example +%% +%% @seealso{lines2d, createLine, projPointOnLine, isPointOnLine} +%% @end deftypefn + +function d = linePosition(point, lin) + + % number of inputs + Nl = size(lin, 1); + Np = size(point, 1); + + if Np == Nl + % if both inputs have the same size, no problem + dxl = lin(:, 3); + dyl = lin(:, 4); + dxp = point(:, 1) - lin(:, 1); + dyp = point(:, 2) - lin(:, 2); + + elseif Np == 1 + % one point, several lines + dxl = lin(:, 3); + dyl = lin(:, 4); + dxp = point(ones(Nl, 1), 1) - lin(:, 1); + dyp = point(ones(Nl, 1), 2) - lin(:, 2); + + elseif Nl == 1 + % one lin, several points + dxl = lin(ones(Np, 1), 3); + dyl = lin(ones(Np, 1), 4); + dxp = point(:, 1) - lin(1); + dyp = point(:, 2) - lin(2); + + else + % expand one of the array to have the same size + dxl = repmat(lin(:,3)', Np, 1); + dyl = repmat(lin(:,4)', Np, 1); + dxp = repmat(point(:,1), 1, Nl) - repmat(lin(:,1)', Np, 1); + dyp = repmat(point(:,2), 1, Nl) - repmat(lin(:,2)', Np, 1); + end + + % compute position + d = (dxp.*dxl + dyp.*dyl) ./ (dxl.^2 + dyl.^2); + +endfunction + +%!demo +%! point = [20 60;10 30;25 75]; +%! lin = createLine([10 30], [30 90]); +%! pos = linePosition(point, lin) +%! +%! plot(point(:,1),point(:,2),'ok'); +%! hold on +%! drawLine(lin,'color','r'); +%! plot(lin(1)+lin(3)*pos,lin(2)+lin(4)*pos,'xb') +%! hold off + +%!test +%! point = [20 60]; +%! lin = createLine([10 30], [30 90]); +%! res = .5; +%! pos = linePosition(point, lin); +%! assert (res, pos); + +%!test +%! point = [20 60;10 30;25 75]; +%! lin = createLine([10 30], [30 90]); +%! res = [.5; 0; .75]; +%! pos = linePosition(point, lin); +%! assert (res, pos); + +%!test +%! point = [20 60]; +%! lin1 = createLine([10 30], [30 90]); +%! lin2 = createLine([0 0], [20 60]); +%! lin3 = createLine([20 60], [40 120]); +%! lines = [lin1;lin2;lin3]; +%! res = [.5; 1; 0]; +%! pos = linePosition(point, lines); +%! assert (res, pos); + diff --git a/octave_packages/geometry-1.5.0/geom2d/lines2d.m b/octave_packages/geometry-1.5.0/geom2d/lines2d.m new file mode 100644 index 0000000..45215dc --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/lines2d.m @@ -0,0 +1,66 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} lines2d () +%% Description of functions operating on planar lines. +% +% The term 'line' refers to a planar straight line, which is an unbounded +% curve. Line segments defined between 2 points, which are bounded, are +% called 'edge', and are presented in file 'edges2d'. +% +% A straight line is defined by a point (its origin), and a vector (its +% direction). The different parameters are bundled into a row vector: +% LINE = [x0 y0 dx dy]; +% +% A line contains all points (x,y) such that: +% x = x0 + t*dx +% y = y0 + t*dy; +% for all t between -infinity and +infinity. +% +% @seealso{points2d, vectors2d, edges2d, rays2d +% createLine, cartesianLine, medianLine, edgeToLine +% orthogonalLine, parallelLine, bisector, radicalAxis +% lineAngle, linePosition, projPointOnLine +% isPointOnLine, distancePointLine, isLeftOriented +% intersectLines, intersectLineEdge, clipLine +% invertLine, transformLine, drawLine +% lineFit} +%% @end deftypefn + +function lines2d(varargin) + + help('lines2d'); + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/medianLine.m b/octave_packages/geometry-1.5.0/geom2d/medianLine.m new file mode 100644 index 0000000..1f1409b --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/medianLine.m @@ -0,0 +1,146 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{line} = } medianLine (@var{p1}, @var{p2}) +%% @deftypefnx {Function File} {@var{line} = } medianLine (@var{pts}) +%% @deftypefnx {Function File} {@var{line} = } medianLine (@var{edge}) +%% Create a median line between two points. +%% +%% Create the median line of points @var{p1} and @var{p2}, that is the line containing +%% all points located at equal distance of @var{p1} and @var{p2}. +%% +%% Creates the median line of 2 points, given as a 2*2 array @var{pts}. Array has +%% the form: +%% [ [ x1 y1 ] ; [ x2 y2 ] ] +%% +%% Creates the median of the @var{edge}. @var{edge} is a 1*4 array, containing [X1 Y1] +%% coordinates of first point, and [X2 Y2], the coordinates of the second +%% point. +%% +%% Example +%% +%% @example +%% % Draw the median line of two points +%% P1 = [10 20]; +%% P2 = [30 50]; +%% med = medianLine(P1, P2); +%% figure; axis square; axis([0 100 0 100]); +%% drawEdge([P1 P2], 'linewidth', 2, 'color', 'k'); +%% drawLine(med) +%% +%% % Draw the median line of an edge +%% P1 = [50 60]; +%% P2 = [80 30]; +%% edge = createEdge(P1, P2); +%% figure; axis square; axis([0 100 0 100]); +%% drawEdge(edge, 'linewidth', 2) +%% med = medianLine(edge); +%% drawLine(med) +%% @end example +%% +%% @seealso{lines2d, createLine, orthogonalLine} +%% @end deftypefn + +function lin = medianLine(varargin) + + nargs = length(varargin); + x0 = 0; + y0 = 0; + dx = 0; + dy = 0; + + if nargs == 1 + tab = varargin{1}; + if size(tab, 2)==2 + % input is an array of two points + x0 = tab(1,1); + y0 = tab(1,2); + dx = tab(2,1)-x0; + dy = tab(2,2)-y0; + else + % input is an edge + x0 = tab(:, 1); + y0 = tab(:, 2); + dx = tab(:, 3) - tab(:, 1); + dy = tab(:, 4) - tab(:, 2); + end + + elseif nargs==2 + % input is given as two points, or two point arrays + p1 = varargin{1}; + p2 = varargin{2}; + x0 = p1(:, 1); + y0 = p1(:, 2); + dx = bsxfun(@minus, p2(:, 1), x0); + dy = bsxfun(@minus, p2(:, 2), y0); + + else + error('Too many input arguments'); + end + + % compute median using middle point of the edge, and the direction vector + % rotated by 90 degrees counter-clockwise + lin = [bsxfun(@plus, x0, dx/2), bsxfun(@plus, y0, dy/2), -dy, dx]; + +endfunction + +%!shared privpath +%! privpath = [fileparts(which('geom2d_Contents')) filesep() 'private']; + +%!test +%! addpath (privpath,'-end') +%! p1 = [0 0]; +%! p2 = [10 0]; +%! exp = [5 0 0 10]; +%! lin = medianLine(p1, p2); +%! assertElementsAlmostEqual(exp, lin); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! p1 = [0 0]; +%! p2 = [10 0]; +%! exp = [5 0 0 10]; +%! lin = medianLine([p1 p2]); +%! assertElementsAlmostEqual(exp, lin); +%! rmpath (privpath); + +%!test +%! addpath (privpath,'-end') +%! p1 = [0 0; 10 10]; +%! p2 = [10 0;10 20]; +%! exp = [5 0 0 10; 10 15 -10 0]; +%! lin = medianLine(p1, p2); +%! assertElementsAlmostEqual(exp, lin); +%! rmpath (privpath); diff --git a/octave_packages/geometry-1.5.0/geom2d/mergeBoxes.m b/octave_packages/geometry-1.5.0/geom2d/mergeBoxes.m new file mode 100644 index 0000000..edd19f5 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/mergeBoxes.m @@ -0,0 +1,77 @@ +%% Copyright (c) 2011, INRA +%% 2010-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{box} =} mergeBoxes (@var{box1}, @var{box2}) +%% Merge two boxes, by computing their greatest extent. +%% +% Example +%% +%% @example +%% box1 = [5 20 5 30]; +%% box2 = [0 15 0 15]; +%% mergeBoxes(box1, box2) +%% ans = +%% 0 20 0 30 +%% @end example +%% +%% @seealso{boxes2d, drawBox, intersectBoxes} +%% @end deftypefn + +function bb = mergeBoxes(box1, box2) + + % unify sizes of data + if size(box1,1) == 1 + box1 = repmat(box1, size(box2,1), 1); + elseif size(box2, 1) == 1 + box2 = repmat(box2, size(box1,1), 1); + elseif size(box1,1) != size(box2,1) + error('geom2d:Error', 'Bad size for inputs'); + end + + % compute extreme coords + mini = min(box1(:,[1 3]), box2(:,[1 3])); + maxi = max(box1(:,[2 4]), box2(:,[2 4])); + + % concatenate result into a new box structure + bb = [mini(:,1) maxi(:,1) mini(:,2) maxi(:,2)]; + +endfunction + +%!test +%! box1 = [5 20 10 25]; +%! box2 = [0 15 15 20]; +%! res = [0 20 10 25]; +%! bb = mergeBoxes(box1, box2); +%! assert (res, bb, 1e-6); + diff --git a/octave_packages/geometry-1.5.0/geom2d/midPoint.m b/octave_packages/geometry-1.5.0/geom2d/midPoint.m new file mode 100644 index 0000000..570d67a --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/midPoint.m @@ -0,0 +1,170 @@ +%% Copyright (c) 2011, INRA +%% 2010-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{mid} = } midPoint (@var{p1}, @var{p2}) +%% @deftypefnx {Function File} {@var{mid} = } midPoint (@var{edge}) +%% @deftypefnx {Function File} {[@var{midx}, @var{midy}] = } midPoint (@var{edge}) +%% Middle point of two points or of an edge +%% +%% Computes the middle point of the two points @var{p1} and @var{p2}. +%% +%% If an edge is given, computes the middle point of the edge given by @var{edge}. +%% @var{edge} has the format: [X1 Y1 X2 Y2], and @var{mid} has the format [XMID YMID], +%% with XMID = (X1+X2)/2, and YMID = (Y1+Y2)/2. +%% +%% If two output arguments are given, it returns the result as two separate variables or arrays. +%% +%% Works also when @var{edge} is a N-by-4 array, in this case the result is a +%% N-by-2 array containing the midpoint of each edge. +%% +%% Example +%% +%% @example +%% p1 = [10 20]; +%% p2 = [30 40]; +%% midPoint([p1 p2]) +%% ans = +%% 20 30 +%% @end example +%% +%% @seealso{edges2d, points2d} +%% @end deftypefn + +function varargout = midPoint(varargin) + + if nargin == 1 + % input is an edge + edge = varargin{1}; + mid = [mean(edge(:, [1 3]), 2) mean(edge(:, [2 4]), 2)]; + + elseif nargin == 2 + % input are two points + p1 = varargin{1}; + p2 = varargin{2}; + + % assert inputs are equal + n1 = size(p1, 1); + n2 = size(p2, 1); + if n1 != n2 && min(n1, n2)>1 + error('geom2d:midPoint', ... + 'Inputs must have same size, or one must have length 1'); + end + + % compute middle point + mid = bsxfun(@plus, p1, p2) / 2; + end + + % process output arguments + if nargout<=1 + varargout{1} = mid; + else + varargout = {mid(:,1), mid(:,2)}; + end + +endfunction + +%!test +%! p1 = [10 20]; +%! p2 = [30 40]; +%! exp = [20 30]; +%! mid = midPoint(p1, p2); +%! assert (mid, exp); + +%!test +%! p1 = [ ... +%! 10 20 ; ... +%! 30 40 ; ... +%! 50 60 ; ... +%! ]; +%! p2 = [ ... +%! 30 40; ... +%! 50 60; ... +%! 70 80]; +%! exp = [... +%! 20 30; ... +%! 40 50; ... +%! 60 70]; +%! mid = midPoint(p1, p2); +%! assert (mid, exp); + +%!test +%! p1 = [30 40]; +%! p2 = [ ... +%! 30 40; ... +%! 50 60; ... +%! 70 80]; +%! exp = [... +%! 30 40; ... +%! 40 50; ... +%! 50 60]; +%! mid = midPoint(p1, p2); +%! assert (mid, exp); + +%!test +%! p1 = [ ... +%! 10 20 ; ... +%! 30 40 ; ... +%! 50 60 ; ... +%! ]; +%! p2 = [30 40]; +%! exp = [... +%! 20 30; ... +%! 30 40; ... +%! 40 50]; +%! mid = midPoint(p1, p2); +%! assert (mid, exp); + +%!test +%! p1 = [ ... +%! 10 20 ; ... +%! 30 40 ; ... +%! 50 60 ; ... +%! ]; +%! p2 = [30 40]; +%! expX = [20 ; 30 ; 40]; +%! expY = [30 ; 40 ; 50]; +%! [x y] = midPoint(p1, p2); +%! assert (x, expX); +%! assert (y, expY); + +%!test +%! edge = [10 20 30 40]; +%! exp = [20 30]; +%! mid = midPoint(edge); +%! assert (mid, exp); +%! edge = [10 20 30 40; 30 40 50 60; 50 60 70 80]; +%! exp = [20 30;40 50; 60 70]; +%! mid = midPoint(edge); +%! assert (mid, exp); + diff --git a/octave_packages/geometry-1.5.0/geom2d/minDistancePoints.m b/octave_packages/geometry-1.5.0/geom2d/minDistancePoints.m new file mode 100644 index 0000000..b476da3 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/minDistancePoints.m @@ -0,0 +1,280 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{dist} = } minDistancePoints (@var{pts}) +%% @deftypefnx {Function File} {@var{dist} = } minDistancePoints (@var{pts1},@var{pts2}) +%% @deftypefnx {Function File} {@var{dist} = } minDistancePoints (@dots{},@var{norm}) +%% @deftypefnx {Function File} {[@var{dist} @var{i} @var{j}] = } minDistancePoints (@var{pts1}, @var{pts2}, @dots{}) +%% @deftypefnx {Function File} {[@var{dist} @var{j}] = } minDistancePoints (@var{pts1}, @var{pts2}, @dots{}) +%% Minimal distance between several points. +%% +%% Returns the minimum distance between all couple of points in @var{pts}. @var{pts} is +%% an array of [NxND] values, N being the number of points and ND the +%% dimension of the points. +%% +%% Computes for each point in @var{pts1} the minimal distance to every point of +%% @var{pts2}. @var{pts1} and @var{pts2} are [NxD] arrays, where N is the number of points, +%% and D is the dimension. Dimension must be the same for both arrays, but +%% number of points can be different. +%% The result is an array the same length as @var{pts1}. +%% +%% When @var{norm} is provided, it uses a user-specified norm. @var{norm}=2 means euclidean norm (the default), +%% @var{norm}=1 is the Manhattan (or "taxi-driver") distance. +%% Increasing @var{norm} growing up reduces the minimal distance, with a limit +%% to the biggest coordinate difference among dimensions. +%% +%% +%% Returns indices @var{i} and @var{j} of the 2 points which are the closest. @var{dist} +%% verifies relation: +%% @var{dist} = distancePoints(@var{pts}(@var{i},:), @var{pts}(@var{j},:)); +%% +%% If only 2 output arguments are given, it returns the indices of points which are the closest. @var{j} has the +%% same size as @var{dist}. for each I It verifies the relation : +%% @var{dist}(I) = distancePoints(@var{pts1}(I,:), @var{pts2}(@var{J},:)); +%% +%% +%% Examples: +%% +%% @example +%% % minimal distance between random planar points +%% points = rand(20,2)*100; +%% minDist = minDistancePoints(points); +%% +%% % minimal distance between random space points +%% points = rand(30,3)*100; +%% [minDist ind1 ind2] = minDistancePoints(points); +%% minDist +%% distancePoints(points(ind1, :), points(ind2, :)) +%% % results should be the same +%% +%% % minimal distance between 2 sets of points +%% points1 = rand(30,2)*100; +%% points2 = rand(30,2)*100; +%% [minDists inds] = minDistancePoints(points1, points2); +%% minDists(10) +%% distancePoints(points1(10, :), points2(inds(10), :)) +%% % results should be the same +%% @end example +%% +%% @seealso{points2d, distancePoints} +%% @end deftypefn + +function varargout = minDistancePoints(p1, varargin) + + %% Initialisations + + % default norm (euclidean) + n = 2; + + % flag for processing of all points + allPoints = false; + + % process input variables + if isempty(varargin) + % specify only one array of points, not the norm + p2 = p1; + + elseif length(varargin)==1 + var = varargin{1}; + if length(var)>1 + % specify two arrays of points + p2 = var; + allPoints = true; + else + % specify array of points and the norm + n = var; + p2 = p1; + end + + else + % specify two array of points and the norm + p2 = varargin{1}; + n = varargin{2}; + allPoints = true; + end + + + % number of points in each array + n1 = size(p1, 1); + n2 = size(p2, 1); + + % dimension of points + d = size(p1, 2); + + + %% Computation of distances + + % allocate memory + dist = zeros(n1, n2); + + % different behaviour depending on the norm used + if n==2 + % Compute euclidian distance. this is the default case + % Compute difference of coordinate for each pair of point ([n1*n2] array) + % and for each dimension. -> dist is a [n1*n2] array. + % in 2D: dist = dx.*dx + dy.*dy; + for i=1:d + dist = dist + (repmat(p1(:,i), [1 n2])-repmat(p2(:,i)', [n1 1])).^2; + end + + % compute minimal distance: + if ~allPoints + % either on all couple of points + mat = repmat((1:n1)', [1 n1]); + ind = mat < mat'; + [minSqDist ind] = min(dist(ind)); + else + % or for each point of P1 + [minSqDist ind] = min(dist, [], 2); + end + + % convert squared distance to distance + minDist = sqrt(minSqDist); + elseif n==inf + % infinite norm corresponds to maximum absolute value of differences + % in 2D: dist = max(abs(dx) + max(abs(dy)); + for i=1:d + dist = max(dist, abs(p1(:,i)-p2(:,i))); + end + else + % compute distance using the specified norm. + % in 2D: dist = power(abs(dx), n) + power(abs(dy), n); + for i=1:d + dist = dist + power((abs(repmat(p1(:,i), [1 n2])-repmat(p2(:,i)', [n1 1]))), n); + end + + % compute minimal distance + if ~allPoints + % either on all couple of points + mat = repmat((1:n1)', [1 n1]); + ind = mat < mat'; + [minSqDist ind] = min(dist(ind)); + else + % or for each point of P1 + [minSqDist ind] = min(dist, [], 2); + end + + % convert squared distance to distance + minDist = power(minSqDist, 1/n); + end + + + + if ~allPoints + % convert index in array to row ad column subindices. + % This uses the fact that index are sorted in a triangular matrix, + % with the last index of each column being a so-called triangular + % number + ind2 = ceil((-1+sqrt(8*ind+1))/2); + ind1 = ind - ind2*(ind2-1)/2; + ind2 = ind2 + 1; + end + + + %% format output parameters + + % format output depending on number of asked parameters + if nargout<=1 + varargout{1} = minDist; + elseif nargout==2 + % If two arrays are asked, 'ind' is an array of indices, one for each + % point in var{pts}1, corresponding to the result in minDist + varargout{1} = minDist; + varargout{2} = ind; + elseif nargout==3 + % If only one array is asked, minDist is a scalar, ind1 and ind2 are 2 + % indices corresponding to the closest points. + varargout{1} = minDist; + varargout{2} = ind1; + varargout{3} = ind2; + end + +endfunction + +%!test +%! pts = [50 10;40 60;30 30;20 0;10 60;10 30;0 10]; +%! assert (minDistancePoints(pts), 20); + +%!test +%! pts = [10 10;25 5;20 20;30 20;10 30]; +%! [dist ind1 ind2] = minDistancePoints(pts); +%! assert (10, dist, 1e-6); +%! assert (3, ind1, 1e-6); +%! assert (4, ind2, 1e-6); + +%!test +%! pts = [0 80;10 60;20 40;30 20;40 0;0 0;100 0;0 100;0 -10;-10 -20]; +%! assert (minDistancePoints([40 50], pts), 10*sqrt(5), 1e-6); +%! assert (minDistancePoints([25 30], pts), 5*sqrt(5), 1e-6); +%! assert (minDistancePoints([30 40], pts), 10, 1e-6); +%! assert (minDistancePoints([20 40], pts), 0, 1e-6); + +%!test +%! pts1 = [40 50;25 30;40 20]; +%! pts2 = [0 80;10 60;20 40;30 20;40 0;0 0;100 0;0 100;0 -10;-10 -20]; +%! res = [10*sqrt(5);5*sqrt(5);10]; +%! assert (minDistancePoints(pts1, pts2), res, 1e-6); + +%!test +%! pts = [50 10;40 60;40 30;20 0;10 60;10 30;0 10]; +%! assert (minDistancePoints(pts, 1), 30, 1e-6); +%! assert (minDistancePoints(pts, 100), 20, 1e-6); + +%!test +%! pts = [0 80;10 60;20 40;30 20;40 0;0 0;100 0;0 100;0 -10;-10 -20]; +%! assert (minDistancePoints([40 50], pts, 2), 10*sqrt(5), 1e-6); +%! assert (minDistancePoints([25 30], pts, 2), 5*sqrt(5), 1e-6); +%! assert (minDistancePoints([30 40], pts, 2), 10, 1e-6); +%! assert (minDistancePoints([20 40], pts, 2), 0, 1e-6); +%! assert (minDistancePoints([40 50], pts, 1), 30, 1e-6); +%! assert (minDistancePoints([25 30], pts, 1), 15, 1e-6); +%! assert (minDistancePoints([30 40], pts, 1), 10, 1e-6); +%! assert (minDistancePoints([20 40], pts, 1), 0, 1e-6); + +%!test +%! pts1 = [40 50;25 30;40 20]; +%! pts2 = [0 80;10 60;20 40;30 20;40 0;0 0;100 0;0 100;0 -10;-10 -20]; +%! res1 = [10*sqrt(5);5*sqrt(5);10]; +%! assert (minDistancePoints(pts1, pts2, 2), res1, 1e-6); +%! res2 = [30;15;10]; +%! assert (minDistancePoints(pts1, pts2, 1), res2); + +%!test +%! pts1 = [40 50;20 30;40 20]; +%! pts2 = [0 80;10 60;20 40;30 20;40 0;0 0;100 0;0 100;0 -10;-10 -20]; +%! dists0 = [10*sqrt(5);10;10]; +%! inds1 = [3;3;4]; +%! [minDists inds] = minDistancePoints(pts1, pts2); +%! assert (dists0, minDists); +%! assert (inds1, inds); diff --git a/octave_packages/geometry-1.5.0/geom2d/normalizeAngle.m b/octave_packages/geometry-1.5.0/geom2d/normalizeAngle.m new file mode 100644 index 0000000..37d89cb --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/normalizeAngle.m @@ -0,0 +1,96 @@ +%% Copyright (c) 2011, INRA +%% 2008-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{alpha2} =} normalizeAngle (@var{alpha}) +%% @deftypefnx {Function File} {@var{alpha2} =} normalizeAngle (@var{alpha}, @var{center}) +%% Normalize an angle value within a 2*PI interval +%% +%% ALPHA2 = normalizeAngle(ALPHA); +%% ALPHA2 is the same as ALPHA modulo 2*PI and is positive. +%% +%% ALPHA2 = normalizeAngle(ALPHA, CENTER); +%% Specifies the center of the angle interval. +%% If CENTER==0, the interval is [-pi ; +pi] +%% If CENTER==PI, the interval is [0 ; 2*pi] (default). +%% +%% Example: +%% % normalization between 0 and 2*pi (default) +%% normalizeAngle(5*pi) +%% ans = +%% 3.1416 +%% +%% % normalization between -pi and +pi +%% normalizeAngle(7*pi/2, 0) +%% ans = +%% -1.5708 +%% +%% References +%% Follows the same convention as apache commons library, see: +%% http://commons.apache.org/math/api-2.2/org/apache/commons/math/util/MathUtils.html%% +%% +%% @seealso{vectorAngle, lineAngle} +%% @end deftypefn + +function alpha = normalizeAngle(alpha, varargin) + + center = pi; + if ~isempty(varargin) + center = varargin{1}; + end + + alpha = mod(alpha-center+pi, 2*pi) + center-pi; + +endfunction + +%!assert (pi/2, normalizeAngle (pi/2), 1e-6); +%!assert (pi, normalizeAngle (pi), 1e-6); +%!assert (3*pi/2, normalizeAngle (3*pi/2), 1e-6); +%!assert (pi/2, normalizeAngle (pi/2, pi), 1e-6); +%!assert (pi, normalizeAngle (pi, pi), 1e-6); +%!assert (3*pi/2, normalizeAngle (3*pi/2, pi), 1e-6); + +%!test +%! theta = linspace(0, 2*pi-.1, 100); +%! assert(theta, normalizeAngle (theta), 1e-6); + +%!assert (0, normalizeAngle (0, 0), 1e-6); +%!assert (pi/2, normalizeAngle (pi/2, 0), 1e-6); +%!assert (-pi, normalizeAngle (-pi, 0), 1e-6); +%!assert (-pi/2, normalizeAngle (7*pi/2, 0), 1e-6); + +%!test +%! theta = linspace(-pi+.1, pi-.1, 100); +%! assert(theta, normalizeAngle (theta, 0), 1e-6); + + diff --git a/octave_packages/geometry-1.5.0/geom2d/normalizeVector.m b/octave_packages/geometry-1.5.0/geom2d/normalizeVector.m new file mode 100644 index 0000000..4ef77b6 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/normalizeVector.m @@ -0,0 +1,72 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{vn} = } normalizeVector (@var{v}) +%% Normalize a vector to have norm equal to 1 +%% +%% Returns the normalization of vector @var{v}, such that ||@var{v}|| = 1. +%% @var{v} can be either a row or a column vector. +%% +%% When @var{v} is a MxN array, normalization is performed for each row of the +%% array. +%% +%% Example: +%% +%% @example +%% vn = normalizeVector([3 4]) +%% vn = +%% 0.6000 0.8000 +%% vectorNorm(vn) +%% ans = +%% 1 +%% @end example +%% +%% @seealso{vectors2d, vectorNorm} +%% @end deftypefn + +function vn = normalizeVector(v) + + dim = size(v); + + if dim(1)==1 || dim(2)==1 + vn = v / sqrt(sum(v.^2)); + else + %same as: vn = v./repmat(sqrt(sum(v.*v, 2)), [1 dim(2)]); + vn = bsxfun(@rdivide, v, sqrt(sum(v.^2, 2))); + end + +endfunction + +%!assert (1,vectorNorm (normalizeVector ([3 4]))) + diff --git a/octave_packages/geometry-1.5.0/geom2d/orthogonalLine.m b/octave_packages/geometry-1.5.0/geom2d/orthogonalLine.m new file mode 100644 index 0000000..6fcb8c1 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/orthogonalLine.m @@ -0,0 +1,64 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{perp} = } orthogonalLine (@var{line}, @var{point}) +%% Create a line orthogonal to another one. +% +% Returns the line orthogonal to the line @var{line} and going through the +% point given by @var{point}. Directed angle from @var{line} to @var{perp} is pi/2. +% @var{line} is given as [x0 y0 dx dy] and @var{point} is [xp yp]. +% +% @seealso{lines2d, parallelLine} +%% @end deftypefn + +function res = orthogonalLine(line, point) + + N = max(size(point, 1), size(line, 1)); + + if size(point, 1)>1 + res = point; + else + res = ones(N, 1)*point; + end + + if size(line, 1)>1 + res(:,3) = -line(:,4); + res(:,4) = line(:,3); + else + res(:,3) = -ones(N,1)*line(4); + res(:,4) = ones(N,1)*line(3); + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/parallelLine.m b/octave_packages/geometry-1.5.0/geom2d/parallelLine.m new file mode 100644 index 0000000..150545d --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/parallelLine.m @@ -0,0 +1,63 @@ +%% Copyright (c) 2011, INRA +%% 2003-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{res} = } parallelLine (@var{line}, @var{point}) +%% @deftypefnx {Function File} {@var{res} = } parallelLine (@var{line}, @var{dist}) +%% Create a line parallel to another one. +%% +%% Returns the line with same direction vector than @var{line} and going through +%% the point given by @var{point}. +%% @var{line} is given as [x0 y0 dx dy] and @var{point} is [xp yp]. +%% +%% Uses relative distance to specify position. The new line will be +%% located at distance @var{dist}, counted positive in the right side of @var{line} +%% and negative in the left side. +%% +%% @seealso{lines2d, orthogonalLine, distancePointLine} +%% @end deftypefn + +function res = parallelLine(line, point) + + if size(point, 1)==1 + % use a distance. Compute position of point located at distance DIST on + % the line orthogonal to the first one. + point = pointOnLine([line(:,1) line(:,2) line(:,4) -line(:,3)], point); + end + + % normal case: compute line through a point with given direction + res = zeros(1, 4); + res(1:2) = point; + res(3:4) = line(3:4); + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/pointOnLine.m b/octave_packages/geometry-1.5.0/geom2d/pointOnLine.m new file mode 100644 index 0000000..50383d8 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/pointOnLine.m @@ -0,0 +1,53 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{point} = } pointOnLine (@var{line}, @var{d}) +%% Create a point on a line at a given position on the line. +%% +%% Creates the point belonging to the line @var{line}, and located at the +%% distance @var{d} from the line origin. +%% @var{line} has the form [x0 y0 dx dy]. +%% @var{line} and @var{d} should have the same number N of rows. The result will have +%% N rows and 2 column (x and y positions). +%% +%% @seealso{lines2d, points2d, onLine, onLine, linePosition} +%% @end deftypefn + +function point = pointOnLine(lin, pos) + + ang = lineAngle(lin); + point = [lin(:,1) + pos .* cos(ang), lin(:,2) + pos .* sin(ang)]; + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/points2d.m b/octave_packages/geometry-1.5.0/geom2d/points2d.m new file mode 100644 index 0000000..6d73dc4 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/points2d.m @@ -0,0 +1,60 @@ +%% Copyright (c) 2011, INRA +%% 2008-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} points2d () +%% Description of functions operating on points. +%% +%% A point is defined by its two cartesian coordinate, put into a row +%% vector of 2 elements: +%% P = [x y]; +%% +%% Several points are stores in a matrix with two columns, one for the +%% x-coordinate, one for the y-coordinate. +%% PTS = [x1 y1 ; x2 y2 ; x3 y3]; +%% +%% Example +%% P = [5 6]; +%% +%% @seealso{centroid, midPoint, polarPoint, pointOnLine +%% isCounterClockwise, angle2Points, angle3Points, angleSort +%% distancePoints, minDistancePoints +%% transformPoint, clipPoints, drawPoint} +%% @end deftypefn + +function points2d + + help('points2d'); + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/polarPoint.m b/octave_packages/geometry-1.5.0/geom2d/polarPoint.m new file mode 100644 index 0000000..225f637 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/polarPoint.m @@ -0,0 +1,83 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{point} = } polarPoint (@var{rho}, @var{theta}) +%% @deftypefnx {Function File} {@var{point} = } polarPoint (@var{theta}) +%% @deftypefnx {Function File} {@var{point} = } polarPoint (@var{point}, @var{rho}, @var{theta}) +%% @deftypefnx {Function File} {@var{point} = } polarPoint (@var{x0}, @var{y0}, @var{rho}, @var{theta}) +%%Create a point from polar coordinates (rho + theta) +%% +%% Creates a point using polar coordinate. @var{theta} is angle with horizontal +%% (counted counter-clockwise, and in radians), and @var{rho} is the distance to +%% origin. If only angle is given radius @var{rho} is assumed to be 1. +%% +%% If a point is given, adds the coordinate of the point to the coordinate of the specified +%% point. For example, creating a point with : +%% P = polarPoint([10 20], 30, pi/2); +%% will give a result of [40 20]. +%% +%% @seealso{points2d} +%% @end deftypefn + +function point = polarPoint(varargin) + + % default values + x0 = 0; y0=0; + rho = 1; + theta =0; + + % process input parameters + if length(varargin)==1 + theta = varargin{1}; + elseif length(varargin)==2 + rho = varargin{1}; + theta = varargin{2}; + elseif length(varargin)==3 + var = varargin{1}; + x0 = var(:,1); + y0 = var(:,2); + rho = varargin{2}; + theta = varargin{3}; + elseif length(varargin)==4 + x0 = varargin{1}; + y0 = varargin{2}; + rho = varargin{3}; + theta = varargin{4}; + end + + point = [x0 + rho.*cos(theta) , y0+rho.*sin(theta)]; + +endfunction + + diff --git a/octave_packages/geometry-1.5.0/geom2d/private/assertAlmostEqual.m b/octave_packages/geometry-1.5.0/geom2d/private/assertAlmostEqual.m new file mode 100644 index 0000000..1ed9788 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/private/assertAlmostEqual.m @@ -0,0 +1,26 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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} {} assertAlmostEqual () +%% Wrapper. Not documented. +%% +%% @end deftypefn + +function assertAlmostEqual(a,b) + + assert(b,a,1e-6); + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/private/assertElementsAlmostEqual.m b/octave_packages/geometry-1.5.0/geom2d/private/assertElementsAlmostEqual.m new file mode 100644 index 0000000..83dff6d --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/private/assertElementsAlmostEqual.m @@ -0,0 +1,26 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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} {} assertElementsAlmostEqual () +%% Wrapper. Not documented. +%% +%% @end deftypefn + +function assertElementsAlmostEqual(a,b) + + assert(b,a,1e-6); + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/private/assertEqual.m b/octave_packages/geometry-1.5.0/geom2d/private/assertEqual.m new file mode 100644 index 0000000..a14ec83 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/private/assertEqual.m @@ -0,0 +1,26 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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} {} assertEqual () +%% Wrapper. Not documented. +%% +%% @end deftypefn + +function assertEqual(a,b) + + assert(b,a); + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/private/assertFalse.m b/octave_packages/geometry-1.5.0/geom2d/private/assertFalse.m new file mode 100644 index 0000000..cb8a2c8 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/private/assertFalse.m @@ -0,0 +1,26 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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} {} assertFalse () +%% Wrapper. Not documented. +%% +%% @end deftypefn + +function assertFalse(a) + + assert(!a); + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/private/assertTrue.m b/octave_packages/geometry-1.5.0/geom2d/private/assertTrue.m new file mode 100644 index 0000000..e603ab1 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/private/assertTrue.m @@ -0,0 +1,26 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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} {} assertTrue () +%% Wrapper. Not documented. +%% +%% @end deftypefn + +function assertTrue(a) + + assert(a); + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/projPointOnLine.m b/octave_packages/geometry-1.5.0/geom2d/projPointOnLine.m new file mode 100644 index 0000000..42cac6d --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/projPointOnLine.m @@ -0,0 +1,69 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{point} = } projPointOnLine (@var{pt1}, @var{line}) +%% Project of a point orthogonally onto a line +%% +%% Computes the (orthogonal) projection of point @var{pt1} onto the line @var{line}. +%% +%% Function works also for multiple points and lines. In this case, it +%% returns multiple points. +%% Point @var{pt1} is a [N*2] array, and @var{line} is a [N*4] array (see createLine +%% for details). Result @var{point} is a [N*2] array, containing coordinates of +%% orthogonal projections of @var{pt1} onto lines @var{line}. +%% +%% @seealso{lines2d, points2d, isPointOnLine, linePosition} +%% @end deftypefn + +function point = projPointOnLine(point, line) + + % ensure input arguments have same size + if size(line, 1)==1 && size(point, 1)>1 + line = repmat(line, [size(point, 1) 1]); + end + if size(point, 1)==1 && size(line, 1)>1 + point = repmat(point, [size(line, 1) 1]); + end + + % slope of line + dx = line(:, 3); + dy = line(:, 4); + + % first find relative position of projection on the line, + tp = ((point(:, 2) - line(:, 2)).*dy + (point(:, 1) - line(:, 1)).*dx) ./ (dx.*dx+dy.*dy); + + % convert position on line to cartesian coordinate + point = line(:,1:2) + [tp tp].*[dx dy]; + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/rad2deg.m b/octave_packages/geometry-1.5.0/geom2d/rad2deg.m new file mode 100644 index 0000000..2300599 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/rad2deg.m @@ -0,0 +1,58 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{deg} =} rad2deg(@var{rad}) +% Convert angle from radians to degrees +% +% Usage: +% R = rad2deg(D) +% convert an angle in radians to angle in degrees +% +% Example: +% rad2deg(pi) +% ans = +% 180 +% rad2deg(pi/3) +% ans = +% 60 +%% +%% @seealso{angles2d, deg2rad} +%% @end deftypefn + +function deg = rad2deg(rad) + + deg = rad*180/pi; + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/radicalAxis.m b/octave_packages/geometry-1.5.0/geom2d/radicalAxis.m new file mode 100644 index 0000000..c50483b --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/radicalAxis.m @@ -0,0 +1,88 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{line} = } radicalAxis (@var{circle1}, @var{circle2}) +%% Compute the radical axis (or radical line) of 2 circles +%% +%% L = radicalAxis(C1, C2) +%% Computes the radical axis of 2 circles. +%% +%% Example +%% C1 = [10 10 5]; +%% C2 = [60 50 30]; +%% L = radicalAxis(C1, C2); +%% hold on; axis equal;axis([0 100 0 100]); +%% drawCircle(C1);drawCircle(C2);drawLine(L); +%% +%% Ref: +%% http://mathworld.wolfram.com/RadicalLine.html +%% http://en.wikipedia.org/wiki/Radical_axis +%% +%% @seealso{lines2d, circles2d, createCircle} +%% +%% @end deftypefn + +function line = radicalAxis(circle1, circle2) + + % extract circles parameters + x1 = circle1(:,1); + x2 = circle2(:,1); + y1 = circle1(:,2); + y2 = circle2(:,2); + r1 = circle1(:,3); + r2 = circle2(:,3); + + % distance between each couple of centers + dist = sqrt((x2-x1).^2 + (y2-y1).^2); + + % relative position of intersection point of + % the radical line with the line joining circle centers + d = (dist.^2 + r1.^2 - r2.^2) * .5 ./ dist; + + % compute angle of radical axis + angle = lineAngle(createLine([x1 y1], [x2 y2])); + cot = cos(angle); + sit = sin(angle); + + % parameters of the line + x0 = x1 + d*cot; + y0 = y1 + d*sit; + dx = -sit; + dy = cot; + + % concatenate into one structure + line = [x0 y0 dx dy]; + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/randomPointInBox.m b/octave_packages/geometry-1.5.0/geom2d/randomPointInBox.m new file mode 100644 index 0000000..88502a9 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/randomPointInBox.m @@ -0,0 +1,85 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{points} =} randomPointInBox (@var{box}) +%% @deftypefnx {Function File} {@var{points} =} randomPointInBox (@var{box}, @var{n}) +%% Generate random points within a box. +%% +%% Generate a random point within the box @var{box}. The result is a 1-by-2 row +%% vector. If @var{n} is given, generates @var{n} points. The result is a +%% @var{n}-by-2 array. +%% +%% Example +%% +%% @example +%% % draw points within a box +%% box = [10 80 20 60]; +%% pts = randomPointInBox(box, 500); +%% figure(1); clf; hold on; +%% drawBox(box); +%% drawPoint(pts, '.'); +%% axis('equal'); +%% axis([0 100 0 100]); +%% @end example +%% +%% @seealso{edges2d, boxes2d, clipLine} +%% @end deftypefn + +function points = randomPointInBox(box, N=1, varargin) + + % extract box bounds + xmin = box(1); + xmax = box(2); + ymin = box(3); + ymax = box(4); + + % compute size of box + dx = xmax - xmin; + dy = ymax - ymin; + + % compute point coordinates + points = [rand(N, 1)*dx+xmin , rand(N, 1)*dy+ymin]; + +endfunction + +%!demo +%! % draw points within a box +%! bb = [10 80 20 60]; +%! pts = randomPointInBox(bb, 500); +%! figure(1); clf; hold on; +%! drawBox(bb); +%! drawPoint(pts, '.'); +%! axis equal +%! axis([0 100 0 100]); + diff --git a/octave_packages/geometry-1.5.0/geom2d/rays2d.m b/octave_packages/geometry-1.5.0/geom2d/rays2d.m new file mode 100644 index 0000000..e0e425a --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/rays2d.m @@ -0,0 +1,60 @@ +%% Copyright (c) 2011, INRA +%% 2008-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} rays2d () +%% Description of functions operating on planar rays +%% +%% A ray is defined by a point (its origin), and a vector (its +%% direction). The different parameters are bundled into a row vector: +%% @code{RAY = [x0 y0 dx dy];} +%% +%% The ray contains all the points (x,y) such that: +%% x = x0 + t*dx +%% y = y0 + t*dy; +%% for all t>0 +%% +%% Contrary to a (straight) line, the points located before the origin do +%% not belong to the ray. +%% However, as rays and lines have the same representation, some functions +%% working on lines are also working on rays (like @code{transformLine}). +%% +%% @seealso{points2d, vectors2d, lines2d, createRay, bisector, isPointOnRay, +%% clipRay, drawRay} +%% @end deftypefn + +function rays2d(varargin) + + help('rays2d'); + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/readme.txt b/octave_packages/geometry-1.5.0/geom2d/readme.txt new file mode 100644 index 0000000..8492731 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/readme.txt @@ -0,0 +1,68 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + + +Description of the geom2d library. + +The aim of geom2d library is to handle and visualize geometric primitives such +as points, lines, circles and ellipses, polylines and polygons... It provides +low-level functions for manipulating geometrical primitives, making easier the +development of more complex geometric algorithms. + +Some features of the library are: + +- creation of various shapes (points, circles, lines, ellipses, polylines, + polygons...) through an intuitive syntax. + Ex: createCircle(p1, p2, p3) to create a circle through 3 points. + +- derivation of new shapes: intersection between 2 lines, between line and + circle, between polylines... or point on a curve from its parametrisation + +- functions for polylines and polygons: compute centroid and area, expand, + self-intersections, clipping with half-plane... + +- manipulation of planar transformation. Ex.: + ROT = createRotation(CENTER, THETA); + P2 = transformPoint(P1, ROT); + +- direct drawing of shapes with specialized functions. Clipping is performed + automatically for infinite shapes such as lines or rays. Ex: + drawCircle([50 50 25]); % draw circle with radius 25 and center [50 50] + drawLine([X0 Y0 DX DY]); % clip and draw straight line + +- measure distances (between points, a point and a line, a point and a group + of points), angle (of a line, between 3 points), or test geometry (point + on a line, on a circle). + +Additional help is provided in geom/Contents.m file, as well as summary files + like 'points2d.m' or 'lines2d.m'. diff --git a/octave_packages/geometry-1.5.0/geom2d/reverseEdge.m b/octave_packages/geometry-1.5.0/geom2d/reverseEdge.m new file mode 100644 index 0000000..775f544 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/reverseEdge.m @@ -0,0 +1,50 @@ +%% Copyright (c) 2011, INRA +%% 2010-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{res} = } reverseEdge (@var{edge}) +%% Intervert the source and target vertices of edge +%% +%% REV = reverseEdge(EDGE); +%% Returns the opposite edge of EDGE. +%% EDGE has the format [X1 Y1 X2 Y2]. The resulting edge REV has value +%% [X2 Y2 X1 Y1]; +%% +%% @seealso{edges2d, createEdge, reverseLine} +%% @end deftypefn + +function res = reverseEdge(edge) + + res = [edge(:,3:4) edge(:,1:2)]; + +endfunction diff --git a/octave_packages/geometry-1.5.0/geom2d/reverseLine.m b/octave_packages/geometry-1.5.0/geom2d/reverseLine.m new file mode 100644 index 0000000..3a50f20 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/reverseLine.m @@ -0,0 +1,52 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{line} = } reverseLine (@var{line}) +%% Return same line but with opposite orientation +%% +%% INVLINE = reverseLine(LINE); +%% Returns the opposite line of LINE. +%% LINE has the format [x0 y0 dx dy], then INVLINE will have following +%% parameters: [x0 y0 -dx -dy]. +%% +%% @seealso{lines2d, createLine} +%% @end deftypefn + +function line = reverseLine(line) + + line(:, 3:4) = -line(:, 3:4); + +endfunction + + diff --git a/octave_packages/geometry-1.5.0/geom2d/rotateVector.m b/octave_packages/geometry-1.5.0/geom2d/rotateVector.m new file mode 100644 index 0000000..9f1815a --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/rotateVector.m @@ -0,0 +1,64 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{vr} = } rotateVector (@var{v}, @var{theta}) +%% Rotate a vector by a given angle +%% +%% Rotate the vector @var{v} by an angle @var{theta}, given in radians. +%% +%% Example +%% +%% @example +%% rotateVector([1 0], pi/2) +%% ans = +%% 0 1 +%% @end example +%% +%% @seealso{vectors2d, transformVector, createRotation} +%% @end deftypefn + +function vr = rotateVector(v, angle) + + % precomputes angles + cot = cos(angle); + sit = sin(angle); + + % compute rotated coordinates + vr = [cot * v(:,1) - sit * v(:,2) , sit * v(:,1) + cot * v(:,2)]; + +endfunction + +%!assert ([0 1],rotateVector([1 0],pi/2), 1e-6) +%!assert (sqrt([0.5 0.5]),rotateVector([1 0],pi/4), 1e-6) + diff --git a/octave_packages/geometry-1.5.0/geom2d/squareGrid.m b/octave_packages/geometry-1.5.0/geom2d/squareGrid.m new file mode 100644 index 0000000..88dae3a --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/squareGrid.m @@ -0,0 +1,82 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{pts} = } squaregrid (@var{bounds}, @var{origin}, @var{size}) +%% Generate equally spaces points in plane. +%% +%% usage +%% PTS = squareGrid(BOUNDS, ORIGIN, SIZE) +%% generate points, lying in the window defined by BOUNDS (=[xmin ymin +%% xmax ymax]), starting from origin with a constant step equal to size. +%% +%% Example +%% PTS = squareGrid([0 0 10 10], [3 3], [4 2]) +%% will return points : +%% [3 1;7 1;3 3;7 3;3 5;7 5;3 7;7 7;3 9;7 9]; +%% +%% TODO: add possibility to use rotated grid +%% +%% @end deftypefn + +function varargout = squareGrid(bounds, origin, size) + + % find all x coordinate + x1 = bounds(1) + mod(origin(1)-bounds(1), size(1)); + x2 = bounds(3) - mod(bounds(3)-origin(1), size(1)); + lx = (x1:size(1):x2)'; + + % find all y coordinate + y1 = bounds(2) + mod(origin(2)-bounds(2), size(2)); + y2 = bounds(4) - mod(bounds(4)-origin(2), size(2)); + ly = (y1:size(2):y2)'; + + % number of points in each coord, and total number of points + ny = length(ly); + nx = length(lx); + np = nx*ny; + + % create points + pts = zeros(np, 2); + for i=1:ny + pts( (1:nx)'+(i-1)*nx, 1) = lx; + pts( (1:nx)'+(i-1)*nx, 2) = ly(i); + end + + % process output + if nargout>0 + varargout{1} = pts; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/transformEdge.m b/octave_packages/geometry-1.5.0/geom2d/transformEdge.m new file mode 100644 index 0000000..663dbbe --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/transformEdge.m @@ -0,0 +1,71 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{edge2} = } transformEdge (@var{edge1}, @var{T}) +%% Transform an edge with an affine transform. +%% +%% Where @var{edge1} has the form [x1 y1 x2 y1], and @var{T} is a transformation +%% matrix, return the edge transformed with affine transform @var{T}. +%% +%% Format of TRANS can be one of : +%% [a b] , [a b c] , or [a b c] +%% [d e] [d e f] [d e f] +%% [0 0 1] +%% +%% Also works when @var{edge1} is a [Nx4] array of double. In this case, @var{edge2} +%% has the same size as @var{edge1}. +%% +%% @seealso{edges2d, transforms2d, transformPoint, translation, rotation} +%% @end deftypefn + +function dest = transformEdge(edge, trans) + + dest = zeros(size(edge)); + + % compute position + dest(:,1) = edge(:,1)*trans(1,1) + edge(:,2)*trans(1,2); + dest(:,2) = edge(:,1)*trans(2,1) + edge(:,2)*trans(2,2); + dest(:,3) = edge(:,3)*trans(1,1) + edge(:,3)*trans(1,2); + dest(:,4) = edge(:,4)*trans(2,1) + edge(:,4)*trans(2,2); + + % add translation vector, if exist + if size(trans, 2)>2 + dest(:,1) = dest(:,1)+trans(1,3); + dest(:,2) = dest(:,2)+trans(2,3); + dest(:,3) = dest(:,3)+trans(1,3); + dest(:,4) = dest(:,4)+trans(2,3); + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/transformLine.m b/octave_packages/geometry-1.5.0/geom2d/transformLine.m new file mode 100644 index 0000000..e62348c --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/transformLine.m @@ -0,0 +1,66 @@ +%% Copyright (c) 2011, INRA +%% 2004-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{line2} = } transformLine (@var{line1}, @var{T}) +%% Transform a line with an affine transform. +%% +%% Returns the line @var{line1} transformed with affine transform @var{T}. +%% @var{line1} has the form [x0 y0 dx dy], and @var{T} is a transformation +%% matrix. +%% +%% Format of @var{T} can be one of : +%% [a b] , [a b c] , or [a b c] +%% [d e] [d e f] [d e f] +%% [0 0 1] +%% +%% Also works when @var{line1} is a [Nx4] array of double. In this case, @var{line2} +%% has the same size as @var{line1}. +%% +%% @seealso{lines2d, transforms2d, transformPoint} +%% @end deftypefn + +function dest = transformLine(line, trans) + + % isolate points + points1 = line(:, 1:2); + points2 = line(:, 1:2) + line(:, 3:4); + + % transform points + points1 = transformPoint(points1, trans); + points2 = transformPoint(points2, trans); + + dest = createLine(points1, points2); + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/transformPoint.m b/octave_packages/geometry-1.5.0/geom2d/transformPoint.m new file mode 100644 index 0000000..5038fc3 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/transformPoint.m @@ -0,0 +1,92 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{pt2} = } transformPoint (@var{pt1}, @var{Trans}) +%% @deftypefnx {Function File} {[@var{px2} @var{py2}]= } transformPoint (@var{px1}, @var{py1}, @var{Trans}) +%% Transform a point with an affine transform. +%% +%% where @var{pt1} has the form [xp yp], and @var{Trans} is a [2x2], [2x3] or [3x3] +%% matrix, returns the point transformed with affine transform @var{Trans}. +%% +%% Format of @var{Trans} can be one of : +%% [a b] , [a b c] , or [a b c] +%% [d e] [d e f] [d e f] +%% [0 0 1] +%% +%% Also works when @var{pt1} is a [Nx2] array of double. In this case, @var{pt2} has +%% the same size as @var{pt1}. +%% +%% Also works when @var{px1} and @var{py1} are arrays the same size. The function +%% transform each couple of (@var{px1}, @var{py1}), and return the result in +%% (@var{px2}, @var{py2}), which is the same size as (@var{px1} @var{py1}). +%% +%% @seealso{points2d, transforms2d, createTranslation, createRotation} +%% @end deftypefn + +function varargout = transformPoint(varargin) + + if length(varargin)==2 + var = varargin{1}; + px = var(:,1); + py = var(:,2); + trans = varargin{2}; + elseif length(varargin)==3 + px = varargin{1}; + py = varargin{2}; + trans = varargin{3}; + else + error('wrong number of arguments in "transformPoint"'); + end + + + % compute position + px2 = px*trans(1,1) + py*trans(1,2); + py2 = px*trans(2,1) + py*trans(2,2); + + % add translation vector, if exist + if size(trans, 2)>2 + px2 = px2 + trans(1,3); + py2 = py2 + trans(2,3); + end + + + if nargout==0 || nargout==1 + varargout{1} = [px2 py2]; + elseif nargout==2 + varargout{1} = px2; + varargout{2} = py2; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/transformVector.m b/octave_packages/geometry-1.5.0/geom2d/transformVector.m new file mode 100644 index 0000000..8945f6f --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/transformVector.m @@ -0,0 +1,108 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{v2} = } transformVector (@var{v}, @var{T}) +%% @deftypefnx {Function File} {[@var{x2} @var{y2}] = } transformVector (@var{x},@var{y}, @var{T}) +%% Transform a vector with an affine transform +%% +%% @var{v} has the form [xv yv], and @var{T} is a [2x2], [2x3] or [3x3] +%% matrix, returns the vector transformed with affine transform @var{T}. +%% +%% Format of @var{T} can be one of : +%% @group +%% [a b] , [a b c] , or [a b c] +%% [d e] [d e f] [d e f] +%% [0 0 1] +%% @end group +%% +%% Also works when @var{v} is a [Nx2] array of double. In this case, @var{v2} has +%% the same size as @var{v}. +%% +%% Also works when @var{x} and @var{y} are arrays the same size. The function +%% transform each couple of (@var{x}, @var{y}), and return the result in +%% (@var{x2}, @var{y2}), which is the same size as (@var{x}, @var{y}). +%% +%% @seealso{vectors2d, transforms2d, rotateVector, transformPoint} +%% @end deftypefn + +function varargout = transformVector(varargin) + + if length(varargin)==2 + var = varargin{1}; + vx = var(:,1); + vy = var(:,2); + trans = varargin{2}; + elseif length(varargin)==3 + vx = varargin{1}; + vy = varargin{2}; + trans = varargin{3}; + else + error('wrong number of arguments in "transformVector"'); + end + + + % compute new position of vector + vx2 = vx*trans(1,1) + vy*trans(1,2); + vy2 = vx*trans(2,1) + vy*trans(2,2); + + if size(trans, 2) == 3 + vx2 = vx2 + trans(1,3); + vy2 = vy2 + trans(2,3); + end + + % format output + if nargout==0 || nargout==1 + varargout{1} = [vx2 vy2]; + elseif nargout==2 + varargout{1} = vx2; + varargout{2} = vy2; + end + +endfunction + +%!demo +%! t1 = [2 0 0; 0 2 0]; +%! t2 = [1 0 1; 0 1 1]; +%! t3 = [0.5 0 1; 0 0.5 1; 0 0 1]; +%! +%! triangle = [-0.5 -1/3; 0.5 -1/3; 0 2/3; -0.5 -1/3]; +%! tr1 = transformVector(triangle,t1); +%! tr2 = transformVector(triangle,t2); +%! tr3 = transformVector(triangle,t3); +%! +%! plot(triangle(:,1),triangle(:,2),'k-', ... +%! tr1(:,1),tr1(:,2),'g-;scaled up;', ... +%! tr2(:,1),tr2(:,2),'m-;translated;', ... +%! tr3(:,1),tr3(:,2),'b-;scaled down and translated;') + diff --git a/octave_packages/geometry-1.5.0/geom2d/transforms2d.m b/octave_packages/geometry-1.5.0/geom2d/transforms2d.m new file mode 100644 index 0000000..83f1d99 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/transforms2d.m @@ -0,0 +1,63 @@ +%% Copyright (c) 2011, INRA +%% 2008-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} transforms2d () +%% Description of functions operating on transforms +%% +%% By 'transform' we mean an affine transform. A planar affine transform +%% can be represented by a 3x3 matrix. +%% +%% Example +%% +%% @example +%% % create a translation by the vector [10 20]: +%% T = createTranslation([10 20]) +%% T = +%% 1 0 10 +%% 0 1 20 +%% 0 0 1 +%%@end example +%% +%% @seealso{createTranslation, createRotation, createScaling, createBasisTransform, +%% createHomothecy, createLineReflection, fitAffineTransform2d, +%% transformPoint, transformVector, transformLine, transformEdge, +%% rotateVector} +%% @end deftypefn + +function transforms2d(varargin) + + help('transforms2d'); + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/triangleGrid.m b/octave_packages/geometry-1.5.0/geom2d/triangleGrid.m new file mode 100644 index 0000000..8c7f251 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/triangleGrid.m @@ -0,0 +1,69 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{pts} = } triangleGrid (@var{bounds}, @var{origin}, @var{size}) +%% Generate triangular grid of points in the plane. +%% +%% usage +%% PTS = triangleGrid(BOUNDS, ORIGIN, SIZE) +%% generate points, lying in the window defined by BOUNDS, given in form +%% [xmin ymin xmax ymax], starting from origin with a constant step equal +%% to size. +%% SIZE is constant and is equals to the length of the sides of each +%% triangles. +%% +%% TODO: add possibility to use rotated grid +%% +%% @end deftypefn + +function varargout = triangleGrid(bounds, origin, size, varargin) + + dx = size(1); + dy = size(1)*sqrt(3); + + % consider two square grids with different centers + pts1 = squareGrid(bounds, origin, [dx dy], varargin{:}); + pts2 = squareGrid(bounds, origin + [dx dy]/2, [dx dy], varargin{:}); + + % gather points + pts = [pts1;pts2]; + + + % process output + if nargout>0 + varargout{1} = pts; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/geom2d/vectorAngle.m b/octave_packages/geometry-1.5.0/geom2d/vectorAngle.m new file mode 100644 index 0000000..b58cd1b --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/vectorAngle.m @@ -0,0 +1,221 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{alpha} =} vectorAngle (@var{v1}) +%% Angle of a vector, or between 2 vectors +%% +%% A = vectorAngle(V); +%% Returns angle between Ox axis and vector direction, in Counter +%% clockwise orientation. +%% The result is normalised between 0 and 2*PI. +%% +%% A = vectorAngle(V1, V2); +%% Returns the angle from vector V1 to vector V2, in counter-clockwise +%% order, and in radians. +%% +%% A = vectorAngle(..., 'cutAngle', CUTANGLE); +%% A = vectorAngle(..., CUTANGLE); % (deprecated syntax) +%% Specifies convention for angle interval. CUTANGLE is the center of the +%% 2*PI interval containing the result. See normalizeAngle for details. +%% +%% Example: +%% rad2deg(vectorAngle([2 2])) +%% ans = +%% 45 +%% rad2deg(vectorAngle([1 sqrt(3)])) +%% ans = +%% 60 +%% rad2deg(vectorAngle([0 -1])) +%% ans = +%% 270 +%% +%% @seealso{vectors2d, angles2d, normalizeAngle} +%% @end deftypefn + +function alpha = vectorAngle(v1, varargin) + + %% Initializations + + % default values + v2 = []; + cutAngle = pi; + + % process input arguments + while ~isempty(varargin) + var = varargin{1}; + if isnumeric(var) && isscalar(var) + % argument is normalization constant + cutAngle = varargin{1}; + varargin(1) = []; + + elseif isnumeric(var) && size(var, 2) == 2 + % argument is second vector + v2 = varargin{1}; + varargin(1) = []; + + elseif ischar(var) && length(varargin) >= 2 + % argument is option given as string + value + if strcmpi(var, 'cutAngle') + cutAngle = varargin{2}; + varargin(1:2) = []; + + else + error(['Unknown option: ' var]); + end + + else + error('Unable to parse inputs'); + end + end + + + %% Case of one vector + + % If only one vector is provided, computes its angle + if isempty(v2) + % compute angle and format result in a 2*pi interval + alpha = atan2(v1(:,2), v1(:,1)); + + % normalize within a 2*pi interval + alpha = normalizeAngle(alpha + 2*pi, cutAngle); + + return; + end + + + %% Case of two vectors + + % compute angle of each vector + alpha1 = atan2(v1(:,2), v1(:,1)); + alpha2 = atan2(v2(:,2), v2(:,1)); + + % difference + alpha = bsxfun(@minus, alpha2, alpha1); + + % normalize within a 2*pi interval + alpha = normalizeAngle(alpha + 2*pi, cutAngle); + +endfunction + +%!test +%! ang = vectorAngle([1 0]); +%! assert(0, ang, 1e-6); + +%!test +%! ang = vectorAngle([0 1]); +%! assert(pi/2, ang, 1e-6); + +%!test +%! ang = vectorAngle([-1 0]); +%! assert(pi, ang, 1e-6); + +%!test +%! ang = vectorAngle([0 -1]); +%! assert(3*pi/2, ang, 1e-6); + +%!test +%! ang = vectorAngle([-1 1]); +%! assert(3*pi/4, ang, 1e-6); + +%!test +%! ang = vectorAngle([1 0], pi); +%! assert(0, ang, 1e-6); + +%!test +%! ang = vectorAngle([0 1], pi); +%! assert(pi/2, ang, 1e-6); + +%!test +%! ang = vectorAngle([-1 0], pi); +%! assert(pi, ang, 1e-6); + +%!test +%! ang = vectorAngle([0 -1], pi); +%! assert(3*pi/2, ang, 1e-6); + +%!test +%! ang = vectorAngle([-1 1], pi); +%! assert(3*pi/4, ang, 1e-6); + +%!test +%! vecs = [1 0;0 1;-1 0;0 -1;1 1]; +%! angs = [0;pi/2;pi;3*pi/2;pi/4]; +%! assert(angs, vectorAngle(vecs)); +%! assert(angs, vectorAngle(vecs, pi)); + +%!test +%! ang = vectorAngle([1 0], 0); +%! assert(0, ang, 1e-6); + +%!test +%! ang = vectorAngle([0 1], 0); +%! assert(pi/2, ang, 1e-6); + +%!test +%! ang = vectorAngle([0 -1], 0); +%! assert(-pi/2, ang, 1e-6); + +%!test +%! ang = vectorAngle([-1 1], 0); +%! assert(3*pi/4, ang, 1e-6); + +%!test +%! vecs = [1 0;0 1;0 -1;1 1;1 -1]; +%! angs = [0;pi/2;-pi/2;pi/4;-pi/4]; +%! assert(angs, vectorAngle(vecs, 0), 1e-6); + +%!test +%! v1 = [1 0]; +%! v2 = [0 1]; +%! ang = pi /2 ; +%! assert(ang, vectorAngle(v1, v2), 1e-6); + +%!test +%! v1 = [1 0]; +%! v2 = [0 1; 0 1; 1 1; -1 1]; +%! ang = [pi / 2 ;pi / 2 ;pi / 4 ; 3 * pi / 4]; +%! assert(ang, vectorAngle(v1, v2), 1e-6); + +%!test +%! v1 = [0 1; 0 1; 1 1; -1 1]; +%! v2 = [-1 0]; +%! ang = [pi / 2 ;pi / 2 ; 3 * pi / 4 ; pi / 4]; +%! assert(ang, vectorAngle(v1, v2), 1e-6); + +%!test +%! v1 = [1 0; 0 1; 1 1; -1 1]; +%! v2 = [0 1; 1 0; -1 1; -1 0]; +%! ang = [pi / 2 ;3 * pi / 2 ;pi / 2 ; pi / 4]; +%! assert(ang, vectorAngle(v1, v2), 1e-6); diff --git a/octave_packages/geometry-1.5.0/geom2d/vectorNorm.m b/octave_packages/geometry-1.5.0/geom2d/vectorNorm.m new file mode 100644 index 0000000..6ba1c62 --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/vectorNorm.m @@ -0,0 +1,114 @@ +%% Copyright (c) 2011, INRA +%% 2007-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{nm} = } vectorNorm (@var{v}) +%% @deftypefnx {Function File} {@var{nm} = } vectorNorm (@var{v},@var{n}) +%% Compute norm of a vector, or of a set of vectors +%% +%% Without extra arguments, returns the euclidean norm of vector V. +%% Optional argument @var{n} specifies the norm to use. N can be any value +%% greater than 0. +%% @table @samp +%% @item N=1 +%% City lock norm. +%% @item N=2 +%% Euclidean norm. +%% @item N=inf +%% Compute max coord. +%% @end table +%% +%% When @var{v} is a MxN array, compute norm for each vector of the array. +%% Vector are given as rows. Result is then a Mx1 array. +%% +%% Example +%% +%% @example +%% n1 = vectorNorm([3 4]) +%% n1 = +%% 5 +%% +%% n2 = vectorNorm([1, 10], inf) +%% n2 = +%% 10 +%% @end example +%% +%% @seealso{vectors2d, vectorAngle} +%% @end deftypefn + +function n = vectorNorm(v, varargin) + + % size of vector + dim = size(v); + + % extract the type of norm to compute + d = 2; + if ~isempty(varargin) + d = varargin{1}; + end + + if d==2 + % euclidean norm: sum of squared coordinates, and take square root + if dim(1)==1 || dim(2)==1 + n = sqrt(sum(v.*v)); + else + n = sqrt(sum(v.*v, 2)); + end + elseif d==1 + % absolute norm: sum of absolute coordinates + if dim(1)==1 || dim(2)==1 + n = sum(abs(v)); + else + n = sum(abs(v), 2); + end + elseif d==inf + % infinite norm: uses the maximal corodinate + if dim(1)==1 || dim(2)==1 + n = max(v); + else + n = max(v, [], 2); + end + else + % Other norms, use explicit but slower expression + if dim(1)==1 || dim(2)==1 + n = power(sum(power(v, d)), 1/d); + else + n = power(sum(power(v, d), 2), 1/d); + end + end + +endfunction + +%!assert (5, vectorNorm ([3 4])) +%!assert(10, vectorNorm ([1, 10], inf)) + diff --git a/octave_packages/geometry-1.5.0/geom2d/vectors2d.m b/octave_packages/geometry-1.5.0/geom2d/vectors2d.m new file mode 100644 index 0000000..b90673b --- /dev/null +++ b/octave_packages/geometry-1.5.0/geom2d/vectors2d.m @@ -0,0 +1,54 @@ +%% Copyright (c) 2011, INRA +%% 2008-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} vectors2d () +%% Description of functions operating on plane vectors +%% +%% A vector is defined by its two cartesian coordinates, put into a row +%% vector of 2 elements: +%% @code{V = [vx vy];} +%% +%% Several vectors are stored in a matrix with two columns, one for the +%% x-coordinate, one for the y-coordinate. +%% @code{VS = [vx1 vy1 ; vx2 vy2 ; vx3 vy3];} +%% +%% @seealso{vectorNorm, vectorAngle, isPerpendicular, isParallel, +%% normalizeVector, transformVector, rotateVector} +%% @end deftypefn + +function vectors2d + + help('vectors2d'); + +endfunction diff --git a/octave_packages/geometry-1.5.0/graphs/delaunayGraph.m b/octave_packages/geometry-1.5.0/graphs/delaunayGraph.m new file mode 100644 index 0000000..4e6d6f2 --- /dev/null +++ b/octave_packages/geometry-1.5.0/graphs/delaunayGraph.m @@ -0,0 +1,93 @@ +%% Copyright (C) 2011-2012 David Legland +%% All rights reserved. +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1 Redistributions of source code must retain the above copyright notice, +%% this list of conditions and the following disclaimer. +%% 2 Redistributions in binary form must reproduce the above copyright +%% notice, this list of conditions and the following disclaimer in the +%% documentation and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +%% ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +%% SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +%% OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +%% +%% 2012 Adapted to Octave by Juan Pablo Carbajal + +%% -*- texinfo -*- +%% @deftypefn {Function File} {[@var{points} @var{edges}]= } delaunayGraph (@var{points}) +%% Graph associated to Delaunay triangulation of input points +%% +%% Compute the Delaunay triangulation of the set of input points, and +%% convert to a set of edges. The output NODES is the same as the input +%% POINTS. +%% +%% Example +%% @example +%% +%% % Draw a planar graph correpspionding to Delaunay triangulation +%% points = rand(30, 2) * 100; +%% [nodes edges] = delaunayGraph(points); +%% figure; +%% drawGraph(nodes, edges); +%% +%% % Draw a 3Dgraph corresponding to Delaunay tetrahedrisation +%% points = rand(20, 3) * 100; +%% [nodes edges] = delaunayGraph(points); +%% figure; +%% drawGraph(nodes, edges); +%% view(3); +%% +%% @end example +%% +%% @seealso{delaunay, delaunayn} +%% @end deftypefn + +function [points edges] = delaunayGraph(points, varargin) + % compute triangulation + tri = delaunayn(points, varargin{:}); + + % number of simplices (triangles), and of vertices by simplex (3 in 2D) + nt = size(tri, 1); + nv = size(tri, 2); + + % allocate memory + edges = zeros(nt * nv, 2); + + % compute edges of each simplex + for i = 1:nv-1 + edges((1:nt) + (i-1)*nt, :) = sort([tri(:, i) tri(:, i+1)], 2); + end + edges((1:nt) + (nv-1)*nt, :) = sort([tri(:, end) tri(:, 1)], 2); + + % remove multiple edges + edges = unique(edges, 'rows'); + +endfunction + +%!demo +%! % Draw a planar graph correpspionding to Delaunay triangulation +%! points = rand(30, 2) * 100; +%! [nodes edges] = delaunayGraph(points); +%! figure; +%! drawGraph(nodes, edges); +%! axis tight + +%!demo +%! % WARNING 3d pltottig works correctly in Octave >= 3.6 +%! % Draw a 3Dgraph corresponding to Delaunay tetrahedrisation +%! points = rand(20, 3) * 100; +%! [nodes edges] = delaunayGraph(points); +%! figure; +%! drawGraph(nodes, edges); +%! view(3); +%! axis tight diff --git a/octave_packages/geometry-1.5.0/graphs/doc-cache b/octave_packages/geometry-1.5.0/graphs/doc-cache new file mode 100644 index 0000000..434599f --- /dev/null +++ b/octave_packages/geometry-1.5.0/graphs/doc-cache @@ -0,0 +1,190 @@ +# Created by Octave 3.6.2, Sun Jun 10 09:53:43 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 4 +# name: +# type: sq_string +# elements: 1 +# length: 13 +delaunayGraph + + +# name: +# type: sq_string +# elements: 1 +# length: 780 + -- Function File: [POINTS EDGES]= delaunayGraph (POINTS) + Graph associated to Delaunay triangulation of input points + + Compute the Delaunay triangulation of the set of input points, and + convert to a set of edges. The output NODES is the same as the + input POINTS. + + Example + + % Draw a planar graph correpspionding to Delaunay triangulation + points = rand(30, 2) * 100; + [nodes edges] = delaunayGraph(points); + figure; + drawGraph(nodes, edges); + + % Draw a 3Dgraph corresponding to Delaunay tetrahedrisation + points = rand(20, 3) * 100; + [nodes edges] = delaunayGraph(points); + figure; + drawGraph(nodes, edges); + view(3); + + See also: delaunay, delaunayn + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 +Graph associated to Delaunay triangulation of input points + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +drawGraph + + +# name: +# type: sq_string +# elements: 1 +# length: 1735 + -- Function File: drawGraph (NODES, EDGES) + -- Function File: drawGraph (NODES, EDGES, FACES) + -- Function File: drawGraph (GRAPH) + -- Function File: drawGraph (..., SNODES) + -- Function File: drawGraph (..., SNODES, SEDGES) + -- Function File: drawGraph (..., SNODES, SEDGES, SFACES) + -- Function File: H = drawGraph (...) + -- Function File: [H HE] = drawGraph (...) + -- Function File: [H HE HF] = drawGraph (...) + Draw a graph, given as a set of vertices and edges + + DRAWGRAPH(NODES, EDGES) draw a graph specified by a set of nodes + (array N*2 or N*3, corresponding to coordinate of each node), + and a set of edges (an array Ne*2, containing for each edge the + first and the second node). Default drawing is a red circle for + nodes and a blue line for edges. + + DRAWGRAPH(NODES, EDGES, FACES) also draw faces of the graph as + patches. + + DRAWGRAPH(GRAPH) passes argument in a srtucture with at least 2 + fields named 'nodes' and 'edges', and possibly one field + 'faces', corresponding to previously described parameters. + GRAPH can also be a cell array, whose first element is node array, + second element is edges array, and third element, if present, is + faces array. + + DRAWGRAPH(..., SNODES) DRAWGRAPH(..., SNODES, SEDGES) + DRAWGRAPH(..., SNODES, SEDGES, SFACES) specify the draw mode for + each element, as in the classical 'plot' function. To not + display some elements, uses 'none'. + + H = DRAWGRAPH(...) return handle to the set of edges. + + [HN, HE] = DRAWGRAPH(...) return handle to the set of nodes and + to the set of edges. + + [HN, HE, HF] = DRAWGRAPH(...) Also return handle to the set of + faces. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Draw a graph, given as a set of vertices and edges + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +knnGraph + + +# name: +# type: sq_string +# elements: 1 +# length: 254 + -- Function File: EDGES = knnGrpah (NODES) + Create the k-nearest neighbors graph of a set of points + + EDGES = knnGraph(NODES) + + Example + + nodes = rand(10, 2); + edges = knnGraph(nodes); + drawGraph(nodes, edges); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 +Create the k-nearest neighbors graph of a set of points + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +voronoi2d + + +# name: +# type: sq_string +# elements: 1 +# length: 371 + -- Function File: [NODES EDGES FACES] = voronoi2d (GERMS) + Compute a voronoi diagram as a graph structure + + [NODES EDGES FACES] = voronoi2d(GERMS) GERMS an array of points + with dimension 2 NODES, EDGES, FACES: usual graph representation, + FACES as cell array + + Example + + [n e f] = voronoi2d(rand(100, 2)*100); + drawGraph(n, e); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Compute a voronoi diagram as a graph structure + + + + + + diff --git a/octave_packages/geometry-1.5.0/graphs/drawGraph.m b/octave_packages/geometry-1.5.0/graphs/drawGraph.m new file mode 100644 index 0000000..490ef4c --- /dev/null +++ b/octave_packages/geometry-1.5.0/graphs/drawGraph.m @@ -0,0 +1,290 @@ +%% Copyright (C) 2004-2012 David Legland +%% All rights reserved. +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1 Redistributions of source code must retain the above copyright notice, +%% this list of conditions and the following disclaimer. +%% 2 Redistributions in binary form must reproduce the above copyright +%% notice, this list of conditions and the following disclaimer in the +%% documentation and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +%% ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +%% SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +%% OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +%% +%% 2012 Adapted to Octave by Juan Pablo Carbajal + +%% -*- texinfo -*- +%% @deftypefn {Function File} drawGraph (@var{nodes}, @var{edges}) +%% @deftypefnx {Function File} drawGraph (@var{nodes}, @var{edges}, @var{faces}) +%% @deftypefnx {Function File} drawGraph (@var{graph}) +%% @deftypefnx {Function File} drawGraph (@dots{}, @var{snodes}) +%% @deftypefnx {Function File} drawGraph (@dots{}, @var{snodes}, @var{sedges}) +%% @deftypefnx {Function File} drawGraph (@dots{}, @var{snodes}, @var{sedges}, @var{sfaces}) +%% @deftypefnx {Function File} {@var{h} = } drawGraph (@dots{}) +%% @deftypefnx {Function File} {[@var{h} @var{he}] = } drawGraph (@dots{}) +%% @deftypefnx {Function File} {[@var{h} @var{he} @var{hf}] = } drawGraph (@dots{}) +%% Draw a graph, given as a set of vertices and edges +%% +%% DRAWGRAPH(NODES, EDGES) +%% draw a graph specified by a set of nodes (array N*2 or N*3, +%% corresponding to coordinate of each node), and a set of edges (an array +%% Ne*2, containing for each edge the first and the second node). +%% Default drawing is a red circle for nodes and a blue line for edges. +%% +%% DRAWGRAPH(NODES, EDGES, FACES) +%% also draw faces of the graph as patches. +%% +%% DRAWGRAPH(GRAPH) +%% passes argument in a srtucture with at least 2 fields named 'nodes' and +%% 'edges', and possibly one field 'faces', corresponding to previously +%% described parameters. +%% GRAPH can also be a cell array, whose first element is node array, +%% second element is edges array, and third element, if present, is faces +%% array. +%% +%% +%% DRAWGRAPH(..., SNODES) +%% DRAWGRAPH(..., SNODES, SEDGES) +%% DRAWGRAPH(..., SNODES, SEDGES, SFACES) +%% specify the draw mode for each element, as in the classical 'plot' +%% function. To not display some elements, uses 'none'. +%% +%% +%% H = DRAWGRAPH(...) +%% return handle to the set of edges. +%% +%% [HN, HE] = DRAWGRAPH(...) +%% return handle to the set of nodes and to the set of edges. +%% +%% [HN, HE, HF] = DRAWGRAPH(...) +%% Also return handle to the set of faces. +%% +%% @end deftypefn +function varargout = drawGraph(varargin) + + %% initialisations + + % uses empty arrays by default for edges and faces + e = []; + f = []; + + % default styles for nodes, edges, and faces + + % nodes are drawn as red circles + sn = {'linestyle', 'none', 'color', 'r', 'marker', 'o'}; + + % edges are drawn as blue lines + se = {'linestyle', '-', 'color', 'b'}; + + % faces are cyan, their edges are not drawn + sf = {'EdgeColor', 'none', 'Facecolor', 'c'}; + + + %% Process input arguments + + % case of a call without arguments + if nargin==0 + help drawGraph; + return; + end + + % --------------------------------------------------------------- + % First extract the graph structure + + var = varargin{1}; + if iscell(var) + % graph is stored as a cell array: first cell is nodes, second one is + % edges, and third is faces + n = var{1}; + if length(var)>1 + e = var{2}; + end + if length(var)>2 + f = var{3}; + end + varargin(1) = []; + elseif isstruct(var) + % graph is stored as a structure, with fields 'nodes', 'edges', and + % eventually 'faces'. + n = var.nodes; + e = var.edges; + if isfield(var, 'faces') + f = var.faces; + end + varargin(1) = []; + else + % graph is stored as set of variables: nodes, edges, and eventually + % faces + n = varargin{1}; + e = varargin{2}; + varargin(1:2) = []; + + if ~isempty(varargin) + var = varargin{1}; + if isnumeric(var) + % faces are stored in a numeric array of indices + f = var; + varargin(1) = []; + elseif iscell(var) + if ~ischar(var{1}) + % faces are stored in a cell array, each cell containing a + % row vector of indices + f = var; + varargin(1) = []; + end + end + end + end + + % extract drawing style + + if ~isempty(varargin) + sn = concatArguments(sn, varargin{1}); + end + + if length(varargin)>1 + se = concatArguments(se, varargin{2}); + end + + if length(varargin)>2 + sf = concatArguments(sf, varargin{3}); + end + + + + %% main drawing processing + + hold on; + + if size(n, 2)==2 + % Draw a 2 dimensional graph ---------------------- + + % Draw faces of the graph ------------ + if ~strcmp(sf{1}, 'none') && ~isempty(f) + if iscell(f) + % each face is contained in a cell. + hf = zeros(size(f)); + for fi=1:length(f) + hf(fi) = patch('Faces', f{fi}, 'Vertices', n, sf{:}); + end + else + % process faces as an Nf*N array. Nf is the number of faces, + % and all faces have the same number of vertices (nodes). + hf = patch('Faces', f, 'Vertices', n, sf{:}); + end + end + + % Draw 2D Edges ---------------------- + if ~strcmp(se{1}, 'none') && size(e, 1)>0 + he = plot([n(e(:,1),1) n(e(:,2),1)]', [n(e(:,1),2) n(e(:,2),2)]', se{:}); + end + + % Draw 2D nodes ---------------------- + if ~strcmp(sn{1}, 'none') + hn = plot(n(:,1), n(:,2), sn{:}); + end + + + elseif size(n, 2)==3 + % Draw a 3 dimensional graph ---------------------- + + % use a zbuffer to avoid display pbms. + set(gcf, 'renderer', 'zbuffer'); + + % Draw 3D Faces ---------------------- + if ~strcmp(sf{1}, 'none') + if iscell(f) + % each face is contained in a cell. + hf = zeros(size(f)); + for fi=1:length(f) + hf(fi) = patch('Faces', f{fi}, 'Vertices', n, sf{:}); + end + else + % process faces as an Nf*N array. Nf i the number of faces, + % and all faces have the same number of vertices (nodes). + hf = patch('Faces', f, 'Vertices', n, sf{:}); + end + end + + % Draw 3D edges ---------------------- + if ~strcmp(se{1}, 'none') && size(e, 1)>0 + % he = plot3(... + % [n(e(:,1),1) n(e(:,2),1)]', ... + % [n(e(:,1),2) n(e(:,2),2)]', ... + % [n(e(:,1),3) n(e(:,2),3)]', ... + % se{:}); + he = line(... + [n(e(:,1),1) n(e(:,2),1)]', ... + [n(e(:,1),2) n(e(:,2),2)]', ... + [n(e(:,1),3) n(e(:,2),3)]', ... + se{:}); + end + + % Draw 3D nodes ---------------------- + if ~strcmp(sn{1}, 'none'); + hn = plot3(n(:,1), n(:,2), n(:,3), sn{:}); + end + + end + + + %% Format output arguments + + % return handle to edges + if nargout==1 + varargout{1} = he; + end + + % return handle to nodes and edges + if nargout==2 + varargout{1} = hn; + varargout{2} = he; + end + + % return handle to nodes, edges and faces + if nargout==3 + varargout{1} = hn; + varargout{2} = he; + varargout{3} = hf; + end + + + +endfunction + +function res = concatArguments(in1, in2) + % in1 is a cell array already initialized + % in2 is an argument that can be: + % - empty + % - the string 'none' + % - another cell array + + if isempty(in2) + res = in1; + return; + end + + if ischar(in2) + if strcmp('none', in2) + res = {'none'}; + return; + end + end + + if iscell(in1) + res = [in1(:)' in2(:)']; + else + res = [{in1} in2(:)]; + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/graphs/knnGraph.m b/octave_packages/geometry-1.5.0/graphs/knnGraph.m new file mode 100644 index 0000000..9fb923a --- /dev/null +++ b/octave_packages/geometry-1.5.0/graphs/knnGraph.m @@ -0,0 +1,73 @@ +%% Copyright (C) 2008-2012 David Legland +%% All rights reserved. +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1 Redistributions of source code must retain the above copyright notice, +%% this list of conditions and the following disclaimer. +%% 2 Redistributions in binary form must reproduce the above copyright +%% notice, this list of conditions and the following disclaimer in the +%% documentation and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +%% ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +%% SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +%% OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +%% +%% 2012 Adapted to Octave by Juan Pablo Carbajal + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{edges} = } knnGrpah (@var{nodes}) +%% Create the k-nearest neighbors graph of a set of points +%% +%% EDGES = knnGraph(NODES) +%% +%% Example +%% @example +%% +%% nodes = rand(10, 2); +%% edges = knnGraph(nodes); +%% drawGraph(nodes, edges); +%% +%% @end example +%% +%% @end deftypefn + +function edges = knnGraph(nodes, varargin) + + % get number of neighbors for each node + k = 2; + if ~isempty(varargin) + k = varargin{1}; + end + + % init size of arrays + n = size(nodes, 1); + edges = zeros(k*n, 2); + + % iterate on nodes + for i = 1:n + dists = distancePoints(nodes(i,:), nodes); + [dists inds] = sort(dists); %#ok + for j = 1:k + edges(k*(i-1)+j, :) = [i inds(j+1)]; + end + end + + % remove double edges + edges = unique(sort(edges, 2), 'rows'); + +endfunction + +%!demo +%! nodes = rand(10, 2); +%! edges = knnGraph(nodes); +%! drawGraph(nodes, edges); +%! axis tight diff --git a/octave_packages/geometry-1.5.0/graphs/voronoi2d.m b/octave_packages/geometry-1.5.0/graphs/voronoi2d.m new file mode 100644 index 0000000..32b1c97 --- /dev/null +++ b/octave_packages/geometry-1.5.0/graphs/voronoi2d.m @@ -0,0 +1,69 @@ +%% Copyright (C) 2007-2012 David Legland +%% All rights reserved. +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1 Redistributions of source code must retain the above copyright notice, +%% this list of conditions and the following disclaimer. +%% 2 Redistributions in binary form must reproduce the above copyright +%% notice, this list of conditions and the following disclaimer in the +%% documentation and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +%% ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +%% SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +%% OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +%% +%% 2012 Adapted to Octave by Juan Pablo Carbajal + +%% -*- texinfo -*- +%% @deftypefn {Function File} {[@var{nodes} @var{edges} @var{faces}] = } voronoi2d (@var{germs}) +%% Compute a voronoi diagram as a graph structure +%% +%% [NODES EDGES FACES] = voronoi2d(GERMS) +%% GERMS an array of points with dimension 2 +%% NODES, EDGES, FACES: usual graph representation, FACES as cell array +%% +%% Example +%% @example +%% +%% [n e f] = voronoi2d(rand(100, 2)*100); +%% drawGraph(n, e); +%% +%% @end example +%% +%% @end deftypefn + +function [nodes edges faces] = voronoi2d(germs) + [V C] = voronoin(germs); + + nodes = V(2:end, :); + edges = zeros(0, 2); + faces = {}; + + for i=1:length(C) + cell = C{i}; + if ismember(1, cell) + continue; + end + + cell = cell-1; + edges = [edges; sort([cell' cell([2:end 1])'], 2)]; %#ok + faces{length(faces)+1} = cell; %#ok + end + + edges = unique(edges, 'rows'); + +endfunction + +%!demo +%! [n e f] = voronoi2d(rand(100, 2)*100); +%! drawGraph(n, e); +%! axis tight diff --git a/octave_packages/geometry-1.5.0/io/@svg/display.m b/octave_packages/geometry-1.5.0/io/@svg/display.m new file mode 100644 index 0000000..88b88c5 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/display.m @@ -0,0 +1,25 @@ +## Copyright (C) 2011 Carnë Draug +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 . + +function display (obj) + + fields = fieldnames (obj); + for i = 1 : numel(fields) + printf ("%s\n", fields{i}); + obj.(fields{i}) + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/io/@svg/getpath.m b/octave_packages/geometry-1.5.0/io/@svg/getpath.m new file mode 100644 index 0000000..2e7e81a --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/getpath.m @@ -0,0 +1,76 @@ +## Copyright (C) 2011 Carnë Draug +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR 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{paths} = } getpath (@var{ids}) +## Returns paths in @var{ids}. +## +## @end deftypefn + +function paths = getpath(obj, varargin) + + if !isempty(varargin) + + ids = varargin; + if iscell (ids) && numel(ids) == 1 && iscell(ids{1}) % dealing with ids given as cell + ids = ids{1}; + + if !all ( cellfun (@ischar, ids) ) + print_usage + end + + elseif !all ( cellfun (@ischar, ids) ) + print_usage + end + + else + paths = obj.Path; + return + end + + tf = ismember (ids, fieldnames (obj.Path)); + + cellfun (@(s) printf("'%s' is not a valid path id.\n", s) , {ids{!tf}}); + + paths = []; + if any (tf) + stuff = {ids{tf}}; + + for i = 1: numel(stuff) + paths{i} = obj.Path.(ids{i}).data; + endfor + + + % Variation +% paths = cellfun(@(s) obj.Path.(s).data, stuff,'UniformOutput',false); + + % Another variation +% paths = cellfun(@(s) getfield(obj,'Path').(s).data, stuff,'UniformOutput',false); + + % Yet another +% paths = cellfun(@(s) getfield(obj.Path,s).data, stuff,'UniformOutput',false); + + % Yet yet another +% dummy = @(s) obj.Path.(s).data; +% paths = cellfun(dummy, stuff,'UniformOutput',false); + + if numel(paths) == 1 + paths = paths{1}; + end + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/io/@svg/height.m b/octave_packages/geometry-1.5.0/io/@svg/height.m new file mode 100644 index 0000000..227c960 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/height.m @@ -0,0 +1,22 @@ +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} function_name () +## @end deftypefn + +function o = height(obj,varargin) + o = obj.Data.height; +endfunction diff --git a/octave_packages/geometry-1.5.0/io/@svg/inkex.py b/octave_packages/geometry-1.5.0/io/@svg/inkex.py new file mode 100644 index 0000000..49de51e --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/inkex.py @@ -0,0 +1,235 @@ +#!/usr/bin/env python +""" +inkex.py +A helper module for creating Inkscape extensions + +Copyright (C) 2005,2007 Aaron Spike, aaron@ekips.org + +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, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +""" +import sys, copy, optparse, random, re +import gettext +from math import * +_ = gettext.gettext + +#a dictionary of all of the xmlns prefixes in a standard inkscape doc +NSS = { +u'sodipodi' :u'http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd', +u'cc' :u'http://creativecommons.org/ns#', +u'ccOLD' :u'http://web.resource.org/cc/', +u'svg' :u'http://www.w3.org/2000/svg', +u'dc' :u'http://purl.org/dc/elements/1.1/', +u'rdf' :u'http://www.w3.org/1999/02/22-rdf-syntax-ns#', +u'inkscape' :u'http://www.inkscape.org/namespaces/inkscape', +u'xlink' :u'http://www.w3.org/1999/xlink', +u'xml' :u'http://www.w3.org/XML/1998/namespace' +} + +#a dictionary of unit to user unit conversion factors +uuconv = {'in':90.0, 'pt':1.25, 'px':1, 'mm':3.5433070866, 'cm':35.433070866, 'm':3543.3070866, + 'km':3543307.0866, 'pc':15.0, 'yd':3240 , 'ft':1080} +def unittouu(string): + '''Returns userunits given a string representation of units in another system''' + unit = re.compile('(%s)$' % '|'.join(uuconv.keys())) + param = re.compile(r'(([-+]?[0-9]+(\.[0-9]*)?|[-+]?\.[0-9]+)([eE][-+]?[0-9]+)?)') + + p = param.match(string) + u = unit.search(string) + if p: + retval = float(p.string[p.start():p.end()]) + else: + retval = 0.0 + if u: + try: + return retval * uuconv[u.string[u.start():u.end()]] + except KeyError: + pass + return retval + +def uutounit(val, unit): + return val/uuconv[unit] + +try: + from lxml import etree +except: + sys.exit(_('The fantastic lxml wrapper for libxml2 is required by inkex.py and therefore this extension. Please download and install the latest version from http://cheeseshop.python.org/pypi/lxml/, or install it through your package manager by a command like: sudo apt-get install python-lxml')) + +def debug(what): + sys.stderr.write(str(what) + "\n") + return what + +def errormsg(msg): + """Intended for end-user-visible error messages. + + (Currently just writes to stderr with an appended newline, but could do + something better in future: e.g. could add markup to distinguish error + messages from status messages or debugging output.) + + Note that this should always be combined with translation: + + import gettext + _ = gettext.gettext + ... + inkex.errormsg(_("This extension requires two selected paths.")) + """ + sys.stderr.write((unicode(msg) + "\n").encode("UTF-8")) + +def check_inkbool(option, opt, value): + if str(value).capitalize() == 'True': + return True + elif str(value).capitalize() == 'False': + return False + else: + raise optparse.OptionValueError("option %s: invalid inkbool value: %s" % (opt, value)) + +def addNS(tag, ns=None): + val = tag + if ns!=None and len(ns)>0 and NSS.has_key(ns) and len(tag)>0 and tag[0]!='{': + val = "{%s}%s" % (NSS[ns], tag) + return val + +class InkOption(optparse.Option): + TYPES = optparse.Option.TYPES + ("inkbool",) + TYPE_CHECKER = copy.copy(optparse.Option.TYPE_CHECKER) + TYPE_CHECKER["inkbool"] = check_inkbool + +class Effect: + """A class for creating Inkscape SVG Effects""" + + def __init__(self, *args, **kwargs): + self.document=None + self.ctx=None + self.selected={} + self.doc_ids={} + self.options=None + self.args=None + self.OptionParser = optparse.OptionParser(usage="usage: %prog [options] SVGfile",option_class=InkOption) + self.OptionParser.add_option("--id", + action="append", type="string", dest="ids", default=[], + help="id attribute of object to manipulate") + + def effect(self): + pass + + def getoptions(self,args=sys.argv[1:]): + """Collect command line arguments""" + self.options, self.args = self.OptionParser.parse_args(args) + + def parse(self,file=None): + """Parse document in specified file or on stdin""" + try: + try: + stream = open(file,'r') + except: + stream = open(self.svg_file,'r') + except: + stream = sys.stdin + self.document = etree.parse(stream) + stream.close() + + def getposinlayer(self): + #defaults + self.current_layer = self.document.getroot() + self.view_center = (0.0,0.0) + + layerattr = self.document.xpath('//sodipodi:namedview/@inkscape:current-layer', namespaces=NSS) + if layerattr: + layername = layerattr[0] + layer = self.document.xpath('//svg:g[@id="%s"]' % layername, namespaces=NSS) + if layer: + self.current_layer = layer[0] + + xattr = self.document.xpath('//sodipodi:namedview/@inkscape:cx', namespaces=NSS) + yattr = self.document.xpath('//sodipodi:namedview/@inkscape:cy', namespaces=NSS) + doc_height = unittouu(self.document.getroot().get('height')) + if xattr and yattr: + x = xattr[0] + y = yattr[0] + if x and y: + self.view_center = (float(x), doc_height - float(y)) # FIXME: y-coordinate flip, eliminate it when it's gone in Inkscape + + def getselected(self): + """Collect selected nodes""" + for i in self.options.ids: + path = '//*[@id="%s"]' % i + for node in self.document.xpath(path, namespaces=NSS): + self.selected[i] = node + + def getElementById(self, id): + path = '//*[@id="%s"]' % id + el_list = self.document.xpath(path, namespaces=NSS) + if el_list: + return el_list[0] + else: + return None + + def getParentNode(self, node): + for parent in self.document.getiterator(): + if node in parent.getchildren(): + return parent + break + + + def getdocids(self): + docIdNodes = self.document.xpath('//@id', namespaces=NSS) + for m in docIdNodes: + self.doc_ids[m] = 1 + + def getNamedView(self): + return self.document.xpath('//sodipodi:namedview', namespaces=NSS)[0] + + def createGuide(self, posX, posY, angle): + atts = { + 'position': str(posX)+','+str(posY), + 'orientation': str(sin(radians(angle)))+','+str(-cos(radians(angle))) + } + guide = etree.SubElement( + self.getNamedView(), + addNS('guide','sodipodi'), atts ) + return guide + + def output(self): + """Serialize document into XML on stdout""" + self.document.write(sys.stdout) + + def affect(self, args=sys.argv[1:], output=True): + """Affect an SVG document with a callback effect""" + self.svg_file = args[-1] + self.getoptions(args) + self.parse() + self.getposinlayer() + self.getselected() + self.getdocids() + self.effect() + if output: self.output() + + def uniqueId(self, old_id, make_new_id = True): + new_id = old_id + if make_new_id: + while new_id in self.doc_ids: + new_id += random.choice('0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ') + self.doc_ids[new_id] = 1 + return new_id + + def xpathSingle(self, path): + try: + retval = self.document.xpath(path, namespaces=NSS)[0] + except: + errormsg(_("No matching node for expression: %s") % path) + retval = None + return retval + + +# vim: expandtab shiftwidth=4 tabstop=8 softtabstop=4 encoding=utf-8 textwidth=99 diff --git a/octave_packages/geometry-1.5.0/io/@svg/loadpaths.m b/octave_packages/geometry-1.5.0/io/@svg/loadpaths.m new file mode 100644 index 0000000..7b4cf7d --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/loadpaths.m @@ -0,0 +1,97 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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 . + +function Paths = loadpaths (obj, svg, varargin) + + here = which ("@svg/loadpaths"); + here = fileparts (here); + script = fullfile (here, 'parsePath.py'); + + %% Call python script + if exist (svg,'file') + % read from file + [st str]=system (sprintf ('python %s %s', script, svg)); + + else + % inline SVG + [st str]=system (sprintf ('python %s < %s', script, svg)); + end + + %% Parse ouput + strpath = strsplit (str(1:end-1), '$', true); + + npaths = numel (strpath); + + %% Convert path data to polynoms + for ip = 1:npaths + + eval (strpath{ip}); + %% FIXME: intialize struct with cell field + svgpath2.cmd = svgpath(1).cmd; + svgpath2.data = {svgpath.data}; + + nD = length(svgpath2.cmd); + pathdata = cell (nD-1,1); + + point_end=[]; + %% If the path is closed, last command is Z and we set initial point == final + if svgpath2.cmd(end) == 'Z' + nD -= 1; + point_end = svgpath2.data{1}; + svgpath2.data(end) = []; + end + + %% Initial point + points(1,:) = svgpath2.data{1}; + + for jp = 2:nD + switch svgpath2.cmd(jp) + case 'L' + %% Straigth segment to polygon + points(2,:) = svgpath2.data{jp}; + pp = [(points(2,:)-points(1,:))' points(1,:)']; + clear points + points(1,:) = [polyval(pp(1,:),1) polyval(pp(2,:),1)]; + + case 'C' + %% Cubic bezier to polygon + points(2:4,:) = reshape (svgpath2.data{jp}, 2, 3).'; + pp = cbezier2poly (points); + clear points + points(1,:) = [polyval(pp(1,:),1) polyval(pp(2,:),1)]; + end + + pathdata{jp-1} = pp; + end + + if ~isempty(point_end) + %% Straight segment to close the path + points(2,:) = point_end; + pp = [(points(2,:)-points(1,:))' points(1,:)']; + + if all ( abs(pp(:,1)) < sqrt(eps) ) + % Final point of last segment is already initial point + pathdata(end) = []; + else + pathdata{end} = pp; + end + + end + %% TODO + % pathdata = shapetransform(pathdata); + + Paths.(svgpathid).data = pathdata; + end +endfunction diff --git a/octave_packages/geometry-1.5.0/io/@svg/loadsvgdata.m b/octave_packages/geometry-1.5.0/io/@svg/loadsvgdata.m new file mode 100644 index 0000000..df7abf3 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/loadsvgdata.m @@ -0,0 +1,36 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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 . + +function data = loadsvgdata (obj, svg, varargin) + + here = which ("@svg/loadsvgdata"); + here = fileparts (here); + script = fullfile (here, 'parseSVGData.py'); + + %% Call python script + if exist (svg,'file') + % read from file + [st str]=system (sprintf ('python %s %s', script, svg)); + + else + % inline SVG + [st str]=system (sprintf ('python %s < %s', script, svg)); + end + + %% Parse ouput + strdata = strsplit (str(1:end-1), '$', true); + eval (strdata); + +endfunction diff --git a/octave_packages/geometry-1.5.0/io/@svg/normalize.m b/octave_packages/geometry-1.5.0/io/@svg/normalize.m new file mode 100644 index 0000000..61de203 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/normalize.m @@ -0,0 +1,95 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{SVGn} = normalize (@var{SVG}) +%% normalizes and SVG. +%% @end deftypefn + +function [SVGn bb] = normalize (obj) + + SVGn = obj; + bb = []; + if ! obj.Data.normalized + + ids = fieldnames (obj.Path); + npath = numel(ids); + v = zeros(npath,2); + bb = zeros(1,4); + + for ip = 1:npath + v(ip,:) = shapecentroid(obj.Path.(ids{ip}).data); + p = shape2polygon(obj.Path.(ids{ip}).data); + bb = mergeBoxes(bb, [min(p) max(p)]([1 3 2 4])); + end + + if npath > 1 + v = mean(v)(:); + else + v = v.'; + end + + %% check whether document and bounding box agree. + bbHeight = bb(2)-bb(1); + bbWidth = bb(4)-bb(2); + + if obj.Data.height != bbHeight + warning("svg:normalize:Sanitycheck",... + ["Height of SVG %g and height boundingbox %g don't match.\n" ... + "Using bounding box.\n"],obj.Data.height,bbHeight) + end + + if obj.Data.width != bbWidth + warning("svg:normalize:Sanitycheck",... + ["Width of SVG %g and width boundingbox %g don't match.\n" ... + "Using bounding box.\n"],obj.Data.width,bbWidth) + end + + %% Move paths such that center of SVG is at 0,0 + %% Put coordinates in the usual frame + %% Scale such that diagonal of bounding box is 1 + Dnorm = sqrt (bbWidth ^ 2 + bbHeight ^ 2); + S = (1 / Dnorm) * eye (2); + bb = zeros(1,4); + + for ip = 1:npath + SVGn.Path.(ids{ip}).data = shapetransform(obj.Path.(ids{ip}).data,-v); + + % Put to middle + SVGn.Path.(ids{ip}).data = ... + shapetransform(SVGn.Path.(ids{ip}).data,[0; -bbHeight/2]); + % Reflect y + SVGn.Path.(ids{ip}).data = ... + shapetransform(SVGn.Path.(ids{ip}).data,[1 0;0 -1]); + % Put to bottom + SVGn.Path.(ids{ip}).data = ... + shapetransform(SVGn.Path.(ids{ip}).data,[0; bbHeight/2]); + + % Scale + SVGn.Path.(ids{ip}).data = ... + shapetransform(SVGn.Path.(ids{ip}).data,S); + + p = shape2polygon(SVGn.Path.(ids{ip}).data); + bb = mergeBoxes(bb, [min(p) max(p)]([1 3 2 4])); + end + bbHeight = bb(2)-bb(1); + bbWidth = bb(4)-bb(2); + + SVGn.Data.height = bbHeight; + SVGn.Data.width = bbWidth; + SVGn.Data.normalized = true; + end + +end diff --git a/octave_packages/geometry-1.5.0/io/@svg/parsePath.py b/octave_packages/geometry-1.5.0/io/@svg/parsePath.py new file mode 100644 index 0000000..ffa9f55 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/parsePath.py @@ -0,0 +1,79 @@ +#!/usr/bin/env python + +## Copyright (c) 2012 Juan Pablo Carbajal +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## 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 . + +import inkex, simplepath +import sys +#import getopt + +def parsePaths (filen=None): + + svg = inkex.Effect () + svg.parse (filen) + + paths = svg.document.xpath ('//svg:path', namespaces=inkex.NSS) + for path in paths: + D = simplepath.parsePath (path.attrib['d']) + cmdlst = []; + parlst = []; + for cmd,params in D: + cmdlst.append(cmd) + parlst.append(params) + + print 'svgpath = struct("cmd","{0}","data",{{{1}}});' \ + .format(''.join(cmdlst),str(parlst).replace('[[','[').replace(']]',']')) + + print 'svgpathid = "{0}"; $'.format(path.attrib['id']) + + + +# ---------------------------- + +if __name__=="__main__": + ''' + try: + optlist,args = getopt.getopt(sys.argv[1:],"thdp") + except getopt.GetoptError: + usage() + sys.exit(2) + + doHelp = 0 + c = Context() + c.doPrint = 1 + for opt in optlist: + if opt[0] == "-d": c.debug = 1 + if opt[0] == "-p": c.plot = 1 + if opt[0] == "-t": c.triangulate = 1 + if opt[0] == "-h": doHelp = 1 + + if not doHelp: + pts = [] + fp = sys.stdin + if len(args) > 0: + fp = open(args[0],'r') + for line in fp: + fld = line.split() + x = float(fld[0]) + y = float(fld[1]) + pts.append(Site(x,y)) + if len(args) > 0: fp.close() + + if doHelp or len(pts) == 0: + usage() + sys.exit(2) + ''' + svg = sys.argv[1] + parsePaths(svg) diff --git a/octave_packages/geometry-1.5.0/io/@svg/parseSVGData.py b/octave_packages/geometry-1.5.0/io/@svg/parseSVGData.py new file mode 100644 index 0000000..5b23cb9 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/parseSVGData.py @@ -0,0 +1,34 @@ +#!/usr/bin/env python + +## Copyright (c) 2012 Juan Pablo Carbajal +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## 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 . +import inkex +import sys +#import getopt + +def parseSVGData (filen=None): + + svg = inkex.Effect () + svg.parse (filen) + + root = svg.document.xpath ('//svg:svg', namespaces=inkex.NSS) + print 'data = struct("height",{0},"width",{1},"id","{2}");' \ + .format(root[0].attrib['height'],root[0].attrib['width'], + root[0].attrib['id']) +# ---------------------------- + +if __name__=="__main__": + svg = sys.argv[1] + parseSVGData(svg) diff --git a/octave_packages/geometry-1.5.0/io/@svg/path2polygon.m b/octave_packages/geometry-1.5.0/io/@svg/path2polygon.m new file mode 100644 index 0000000..b823674 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/path2polygon.m @@ -0,0 +1,71 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% any later version. +%% +%% This program is distributed in the hope that it will be useful, +%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%% GNU General Public License for more details. +%% +%% You should have received a copy of the GNU General Public License +%% along with this program. If not, see . + +%% -*- texinfo -*- +%% @deftypefn {Function File} @var{P} = path2polygon (@var{id}) +%% Converts the SVG path to an array of polygons. +%% +%% @end deftypefn + +function P = path2polygon (obj,varargin) + + narg = numel(varargin); + + if narg == 1 + + id = varargin{1}; + n = 32; + + elseif narg == 2 + + id = varargin{1}; + n = varargin{2}; + + else + + error("svg:path2polygon:InvalidArgument", "Wrong number of arguments."); + + end + + P = shape2polygon(getpath(obj, id)); + +endfunction + +%{ + pd = obj.Path.(id).data; + P = cellfun(@(x)convertpath(x,n),pd,'UniformOutput',false); + P = cell2mat(P); + +end + +function p = convertpath(x,np) + n = size(x,2); + + switch n + case 2 + p = zeros(2,2); + % Straight segment + p(:,1) = polyval (x(1,:), [0; 1]); + p(:,2) = polyval (x(2,:), [0; 1]); + case 4 + p = zeros(np,2); + % Cubic bezier + t = linspace (0, 1, np).'; + p(:,1) = polyval (x(1,:),t); + p(:,2) = polyval (x(2,:),t); + end + +end +%} diff --git a/octave_packages/geometry-1.5.0/io/@svg/pathid.m b/octave_packages/geometry-1.5.0/io/@svg/pathid.m new file mode 100644 index 0000000..fafde91 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/pathid.m @@ -0,0 +1,22 @@ +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} function_name () +## @end deftypefn + +function ids = pathid(obj,varargin) + ids = fieldnames (obj.Path); +endfunction diff --git a/octave_packages/geometry-1.5.0/io/@svg/plot.m b/octave_packages/geometry-1.5.0/io/@svg/plot.m new file mode 100644 index 0000000..de207c1 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/plot.m @@ -0,0 +1,53 @@ +## Copyright (C) 2011 Carnë Draug +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR 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{h} = } plot () +%% Plots and SVG object. +%% +%% @end deftypefn + +function h = plot(obj, varargin) + + % Get path ids + ids = fieldnames(obj.Path); + npath = numel(ids); + + t = linspace (0, 1, 64); + + args={}; + if !isempty (varargin) + args = varargin; + end + for i = 1:npath + x = []; y = []; + data = obj.Path.(ids(i)).data; + + for j = 1:numel(data) + x = cat (2, x, polyval (data{j}(1,:),t)); + y = cat (2, y, polyval (data{j}(2,:),t)); + end + + h = plot(x,y,args{:}); + if i == 1 + hold on + end + end + hold off + axis tight + axis equal +endfunction + diff --git a/octave_packages/geometry-1.5.0/io/@svg/simplepath.py b/octave_packages/geometry-1.5.0/io/@svg/simplepath.py new file mode 100644 index 0000000..f62b1b4 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/simplepath.py @@ -0,0 +1,212 @@ +#!/usr/bin/env python +""" +simplepath.py +functions for digesting paths into a simple list structure + +Copyright (C) 2005 Aaron Spike, aaron@ekips.org + +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, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +""" +import re, math + +def lexPath(d): + """ + returns and iterator that breaks path data + identifies command and parameter tokens + """ + offset = 0 + length = len(d) + delim = re.compile(r'[ \t\r\n,]+') + command = re.compile(r'[MLHVCSQTAZmlhvcsqtaz]') + parameter = re.compile(r'(([-+]?[0-9]+(\.[0-9]*)?|[-+]?\.[0-9]+)([eE][-+]?[0-9]+)?)') + while 1: + m = delim.match(d, offset) + if m: + offset = m.end() + if offset >= length: + break + m = command.match(d, offset) + if m: + yield [d[offset:m.end()], True] + offset = m.end() + continue + m = parameter.match(d, offset) + if m: + yield [d[offset:m.end()], False] + offset = m.end() + continue + #TODO: create new exception + raise Exception, 'Invalid path data!' +''' +pathdefs = {commandfamily: + [ + implicitnext, + #params, + [casts,cast,cast], + [coord type,x,y,0] + ]} +''' +pathdefs = { + 'M':['L', 2, [float, float], ['x','y']], + 'L':['L', 2, [float, float], ['x','y']], + 'H':['H', 1, [float], ['x']], + 'V':['V', 1, [float], ['y']], + 'C':['C', 6, [float, float, float, float, float, float], ['x','y','x','y','x','y']], + 'S':['S', 4, [float, float, float, float], ['x','y','x','y']], + 'Q':['Q', 4, [float, float, float, float], ['x','y','x','y']], + 'T':['T', 2, [float, float], ['x','y']], + 'A':['A', 7, [float, float, float, int, int, float, float], ['r','r','a',0,'s','x','y']], + 'Z':['L', 0, [], []] + } +def parsePath(d): + """ + Parse SVG path and return an array of segments. + Removes all shorthand notation. + Converts coordinates to absolute. + """ + retval = [] + lexer = lexPath(d) + + pen = (0.0,0.0) + subPathStart = pen + lastControl = pen + lastCommand = '' + + while 1: + try: + token, isCommand = lexer.next() + except StopIteration: + break + params = [] + needParam = True + if isCommand: + if not lastCommand and token.upper() != 'M': + raise Exception, 'Invalid path, must begin with moveto.' + else: + command = token + else: + #command was omited + #use last command's implicit next command + needParam = False + if lastCommand: + if lastCommand.isupper(): + command = pathdefs[lastCommand][0] + else: + command = pathdefs[lastCommand.upper()][0].lower() + else: + raise Exception, 'Invalid path, no initial command.' + numParams = pathdefs[command.upper()][1] + while numParams > 0: + if needParam: + try: + token, isCommand = lexer.next() + if isCommand: + raise Exception, 'Invalid number of parameters' + except StopIteration: + raise Exception, 'Unexpected end of path' + cast = pathdefs[command.upper()][2][-numParams] + param = cast(token) + if command.islower(): + if pathdefs[command.upper()][3][-numParams]=='x': + param += pen[0] + elif pathdefs[command.upper()][3][-numParams]=='y': + param += pen[1] + params.append(param) + needParam = True + numParams -= 1 + #segment is now absolute so + outputCommand = command.upper() + + #Flesh out shortcut notation + if outputCommand in ('H','V'): + if outputCommand == 'H': + params.append(pen[1]) + if outputCommand == 'V': + params.insert(0,pen[0]) + outputCommand = 'L' + if outputCommand in ('S','T'): + params.insert(0,pen[1]+(pen[1]-lastControl[1])) + params.insert(0,pen[0]+(pen[0]-lastControl[0])) + if outputCommand == 'S': + outputCommand = 'C' + if outputCommand == 'T': + outputCommand = 'Q' + + #current values become "last" values + if outputCommand == 'M': + subPathStart = tuple(params[0:2]) + pen = subPathStart + if outputCommand == 'Z': + pen = subPathStart + else: + pen = tuple(params[-2:]) + + if outputCommand in ('Q','C'): + lastControl = tuple(params[-4:-2]) + else: + lastControl = pen + lastCommand = command + + retval.append([outputCommand,params]) + return retval + +def formatPath(a): + """Format SVG path data from an array""" + return "".join([cmd + " ".join([str(p) for p in params]) for cmd, params in a]) + +def translatePath(p, x, y): + for cmd,params in p: + defs = pathdefs[cmd] + for i in range(defs[1]): + if defs[3][i] == 'x': + params[i] += x + elif defs[3][i] == 'y': + params[i] += y + +def scalePath(p, x, y): + for cmd,params in p: + defs = pathdefs[cmd] + for i in range(defs[1]): + if defs[3][i] == 'x': + params[i] *= x + elif defs[3][i] == 'y': + params[i] *= y + elif defs[3][i] == 'r': # radius parameter + params[i] *= x + elif defs[3][i] == 's': # sweep-flag parameter + if x*y < 0: + params[i] = 1 - params[i] + elif defs[3][i] == 'a': # x-axis-rotation angle + if y < 0: + params[i] = - params[i] + +def rotatePath(p, a, cx = 0, cy = 0): + if a == 0: + return p + for cmd,params in p: + defs = pathdefs[cmd] + for i in range(defs[1]): + if defs[3][i] == 'x': + x = params[i] - cx + y = params[i + 1] - cy + r = math.sqrt((x**2) + (y**2)) + if r != 0: + theta = math.atan2(y, x) + a + params[i] = (r * math.cos(theta)) + cx + params[i + 1] = (r * math.sin(theta)) + cy + + +# vim: expandtab shiftwidth=4 tabstop=8 softtabstop=4 encoding=utf-8 textwidth=99 diff --git a/octave_packages/geometry-1.5.0/io/@svg/subsref.m b/octave_packages/geometry-1.5.0/io/@svg/subsref.m new file mode 100644 index 0000000..81bbc13 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/subsref.m @@ -0,0 +1,84 @@ +## Copyright (C) 2011 Carnë Draug +## Copyright (c) 2011 Juan Pablo Carbajal +## Improvement based on John W. Eaton's idea. +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} function_name () +## @end deftypefn + +function varargout = subsref (obj, idx) + + persistent __method__ method4field typeNotImplemented + if isempty(__method__) + + __method__ = struct(); + + __method__.plot = @(o,varargin) plot (o, varargin{:}); + __method__.getpath = @(o,varargin) getpath (o, varargin{:}); + __method__.pathid = @(o,varargin) pathid(o,varargin{:}); + __method__.path2polygon = @(o,varargin) path2polygon (o, varargin{:}); + __method__.normalize = @(o,varargin) normalize (o, varargin{:}); + __method__.height = @(o,varargin) height(o, varargin{:}); + __method__.width = @(o,varargin) width(o,varargin{:}); + + # Error strings + method4field = "Class %s has no field %s. Use %s() for the method."; + typeNotImplemented = "%s no implemented for class %s."; + + end + + if ( !strcmp (class (obj), 'svg') ) + error ("Object must be of the svg class but '%s' was used", class (obj) ); + elseif ( idx(1).type != '.' ) + error ("Invalid index for class %s", class (obj) ); + endif + + method = idx(1).subs; + if ~isfield(__method__, method) + error('Unknown method %s.',method); + else + fhandle = __method__.(method); + end + + if strcmp(method,'normalize') + warning("svg:Devel",["Not returning second output argument of %s" ... + " use method(obj) API to get it"],method); + end + + if numel (idx) == 1 % can't access properties, only methods + + error (method4field, class (obj), method, method); + + end + + if strcmp (idx(2).type, '()') + + args = idx(2).subs; + if isempty(args) + out = fhandle (obj); + else + out = fhandle (obj, args{:}); + end + + varargout{1} = out; + + else + + error (typeNotImplemented,[method idx(2).type], class (obj)); + + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/io/@svg/svg.m b/octave_packages/geometry-1.5.0/io/@svg/svg.m new file mode 100644 index 0000000..c2f5074 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/svg.m @@ -0,0 +1,82 @@ +## Copyright (C) 2011 Carnë Draug +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR 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{obj} =} svg () +## @deftypefnx {Function File} {@var{obj} =} svg (@var{str}) +## Create object of the svg class. +## +## If no input argument is provided the object is empty. @var{str} can be a filename +## or a string defining an inline SVG. +## +## @end deftypefn + +function svg = svg(name='') + + svg = struct; + + ## SVG data. All the attributes of the node. + ## The field unparsed contains all the attributes that are not being parsed. + svg.Data = struct('height',[],'width',[],'id','null','normalized',false); + + ## SVG metadata. All the attributes of the node. + ## The field unparsed contains all the attributes that are not being parsed. + svg.Metadata = struct('unparsed',' '); + + ## SVG paths. It is a vector of path structs. Maybe path can be a object too? + ## Order of Path.Data is important so we store in a cell (could be a matrix padded with zeros). + ## All the paths stored in polyval compatible format. Straigth segments are also stored as a polynomial. + svg.Path = struct(); + + svg = class (svg, 'svg'); + + if !isempty (name) + if exist(name,"file") == 2 + name = file_in_path(path(), name); + else + error("svg:BadArguemnt", "File %s doesn't exist",name); + end + paths = loadpaths(svg, name); + svg.Path = paths; + data = loadsvgdata(svg, name); + svg.Data = data; + svg.Data.normalized = false; + elseif !ischar(name) + print_usage ; + endif + + +endfunction + +%!test +%! dc = svg('drawing5.svg'); +%! dc.getpath(); +%! dc.pathid(); +%! dc.getpath('path3756'); +%! +%! dc = svg('drawing.svg'); +%! ids = dc.pathid(); +%! dc.getpath({ids{[1 3]}}); + +%!test +%! dc = svg('drawing6.svg'); +%! ids = dc.pathid(); +%! P = dc.path2polygon(ids{1}); + +%!test +%! dc = svg('drawing6.svg'); +%! dc.plot(); +%! dc.plot('color','r','linewidth',2); diff --git a/octave_packages/geometry-1.5.0/io/@svg/width.m b/octave_packages/geometry-1.5.0/io/@svg/width.m new file mode 100644 index 0000000..fc2b660 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/@svg/width.m @@ -0,0 +1,22 @@ +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} function_name () +## @end deftypefn + +function o = width(obj,varargin) + o = obj.Data.width; +endfunction diff --git a/octave_packages/geometry-1.5.0/io/data2geo.m b/octave_packages/geometry-1.5.0/io/data2geo.m new file mode 100644 index 0000000..d349a5e --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/data2geo.m @@ -0,0 +1,113 @@ +%% Copyright (c) 2010 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{fileStr} =} data2geo (@var{data}, @var{lc}) +%% @deftypefnx {Function File} {@var{fileStr} =} data2geo (@dots{}, @var{param}, @var{value}) +%% Uses data to build a file compatible with Gmsh. +%% +%% @var{data} is assumed to describe a polygon in @code{polygon2d} format. +%% The argument @var{lc} specifies the edge size. +%% +%% The optional parameters can be 'output' followed with a string specifying a file +%% to write, and 'spherical' followed by a real number @var{r} indicating that the +% polygon describes a spherical surface of radious @var{r}. +%% +%% @seealso{polygon2d, @@svg/path2polygon} +%% @end deftypefn + +function strFile = data2geo(data,lc,varargin) + + nl = @()sprintf('\n'); + + %% Parse options + filegiven = []; + spherical = []; + if nargin > 2 + filegiven = find(cellfun(@(x)strcmpi(x,'output'),varargin)); + spherical = find(cellfun(@(x)strcmpi(x,'spherical'),varargin)); + end + + [n dim] = size(data); + if dim == 2 + data(:,3) = zeros(n,1); + end + + header = ' // File created with Octave'; + strFile = []; + strFile = [strFile header nl()]; + + % Points + strFile = [strFile '// Points' nl()]; + + for i=1:n + strFile = [strFile pointGeo(i,data(i,:),lc)]; + end + + % Lines + strFile = [strFile '// Lines' nl()]; + for i=1:n-1 + strFile = [strFile lineGeo(i,i,i+1)]; + end + strFile = [strFile lineGeo(n,n,1)]; + + % Loop + strFile = [strFile lineLoopGeo(n+1,n,1:n)]; + + % Surface + if spherical + sphr = varargin{spherical+1}; + if dim ==2 + sphr(1,3) = 0; + end + strFile = [strFile pointGeo(n+1,sphr,lc)]; + strFile = [strFile ruledSurfGeo(n+3,1,n+1,n+1)]; + else + strFile = [strFile planeSurfGeo(n+2,1,n+1)]; + end + + if filegiven + outfile = varargin{filegiven+1}; + fid = fopen(outfile,'w'); + fprintf(fid,'%s',strFile); + fclose(fid); + disp(['DATA2GEO: Geometry file saved to ' outfile]) + end +endfunction + +%!demo +%! points = [0 0 0; 0.1 0 0; 0.1 .3 0; 0 0.3 0]; +%! strFile = data2geo(points,0.009); +%! disp(strFile) + +%!demo +%! dc = svg('drawing6.svg'); +%! ids = dc.pathid(); +%! P = dc.path2polygon(ids{1},12)(1:end-1,:); +%! P = bsxfun(@minus, P, centroid(P)); +%! P = simplifypolygon(P,'tol',5e-1); +%! filename = tmpnam (); +%! meshsize = sqrt(mean(sumsq(diff(P,1,1),2)))/2; +%! data2geo (P, meshsize, 'output', [filename '.geo']); +%! +%! pkg load msh fpl +%! T = msh2m_gmsh(filename); +%! pdemesh(T.p,T.e,T.t) +%! +%! % -------------------------------------------------------------------------- +%! % We load the drawing6.svg file into Octave and transform it into a polygon. +%! % Then we create a temporary file where the .geo mesh will be written. +%! % If the packages msh and fpl are available, a mesh is created from the .geo +%! % file. diff --git a/octave_packages/geometry-1.5.0/io/deprecated/doc-cache b/octave_packages/geometry-1.5.0/io/deprecated/doc-cache new file mode 100644 index 0000000..ca6b6f3 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/deprecated/doc-cache @@ -0,0 +1,111 @@ +# Created by Octave 3.6.2, Sun Jun 10 09:53:40 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 3 +# name: +# type: sq_string +# elements: 1 +# length: 7 +svgload + + +# name: +# type: sq_string +# elements: 1 +# length: 405 + -- Function File: SVG = loadSVG (FILENAME) + Reads the plain SVG file FILENAME and returns an SVG structure. + + In the current version only SVG path elements are parsed and + stored in the field path of the SVG structure. The coordinates of + the path are not modified in anyway. This produces the path to be + ploted vertically reflected. + + See also: svgnormalize, svgpath2polygon + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Reads the plain SVG file FILENAME and returns an SVG structure. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +svgnormalize + + +# name: +# type: sq_string +# elements: 1 +# length: 402 + -- Function File: SVGN = loadSVG (SVG) + Scales and reflects the SVG structure and returns a modified SVGN + structure. + + The height and width of the SVG are scaled such that the diagonal + of the bounding box has length 1. Coordinates are trasnfomed such + that a plot of the paths coincides with the visualization of the + original SVG. + + See also: svgload, svgpath2polygon + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 76 +Scales and reflects the SVG structure and returns a modified SVGN +structure. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +svgpath2polygon + + +# name: +# type: sq_string +# elements: 1 +# length: 513 + -- Function File: P = svgpath2polygon (SVGPATH) + Converts the SVG path structure SVGPATH to an array of polygons + compatible with the geometry package and matGeom + (`http://matgeom.sf.net'). + + SVGPATH is a substructure of the SVG structure output by loadSVG. + This function extracts the field named "coord" if there is only + one path. If there are more than oe path it puts the "coord" field + of each path in the same array, separated by nans. + + See also: svgnormalize, svgload + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Converts the SVG path structure SVGPATH to an array of polygons +compatible with + + + + + diff --git a/octave_packages/geometry-1.5.0/io/deprecated/private/SVGstrPath2SVGpath.m b/octave_packages/geometry-1.5.0/io/deprecated/private/SVGstrPath2SVGpath.m new file mode 100644 index 0000000..71c0dea --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/deprecated/private/SVGstrPath2SVGpath.m @@ -0,0 +1,103 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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 . + +function SVGpath = SVGstrPath2SVGpath (SVGstrPath) + + nPaths = numel (SVGstrPath); + SVGpath = repmat (struct('coord', [], 'closed', [], 'id', []), 1, nPaths); + + for ip = 1:nPaths + path = SVGstrPath{ip}; + + % Match data + [s e te m] = regexpi (path, 'd="(?:(?!").)*'); + data=strtrim (m{1}); + % parse data + d = parsePathData (data); + SVGpath(ip).coord = d.coord; + SVGpath(ip).closed = d.closed; + + % Match id + [s e te m] = regexp (path, 'id="(?:(?!").)*'); + if ~isempty (m) + SVGpath(ip).id = strtrim (m{1}(5:end)); + end + end + +end + +function d = parsePathData (data) + + d = struct ('coord', [], 'closed', []); + + [s e te comm] = regexp (data, '[MmLlHhVvCcSsQqTtAaZz]{1}'); + % TODO + % This info could be used to preallocate d + [zcomm zpos] = ismember ({'Z','z'}, comm); + + if any (zcomm) + d.closed = true; + else + d.closed = false; + s(end+1) = length (data); + end + comm(zpos(zcomm)) = []; + ncomm = size (comm, 2); + for ic = 1:ncomm + + switch comm{ic} + case {'M','L'} + [x y] = strread (data(s(ic) + 1 : s(ic + 1) - 1), ... + '%f%f', 'delimiter', ', '); + coord = [x y]; + + case 'm' + [x y] = strread( data(s(ic) + 1 : s(ic + 1) - 1), ... + '%f%f', 'delimiter', ', '); + nc = size (x, 1); + coord = [x y]; + if ic == 1 + % relative moveto at begining of data. + % First coordinates are absolute, the rest are relative. + coord = cumsum (coord); + else + % Relative moveto. + % The coordinates are relative to the last one loaded + coord(1,:) =coord(1,:) + d.coord(end,:); + coord = cumsum(coord); + warning('svg2octWarning',['Relative moveto in path data.'... + ' May mean that the orginal path was not a simple polygon.' ... + ' If that is the case, the path will not display equally.']) + end + + case 'l' + % Relative lineto, coordinates are relative to last point loaded. + [x y] = strread( data(s(ic) + 1 : s(ic + 1) - 1), ... + '%f%f', 'delimiter', ', '); + nc = size (x, 1); + coord = [x y] + coord(1,:) =coord(1,:) + d.coord(end,:); + coord = cumsum(coord); + + otherwise + warning('svg2oct:Warning',... + 'Path data command "%s" not implemented yet.',comm{ic}); + end + + nc = size(coord,1); + d.coord(end+1:end+nc,:) = coord; + + end +end diff --git a/octave_packages/geometry-1.5.0/io/deprecated/private/_parsePath.py b/octave_packages/geometry-1.5.0/io/deprecated/private/_parsePath.py new file mode 100644 index 0000000..a6738ae --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/deprecated/private/_parsePath.py @@ -0,0 +1,64 @@ +#!/usr/bin/env python + +import inkex, simplepath +import sys +#import getopt + +def parsePaths (filen=None): + + svg = inkex.Effect () + svg.parse (filen) + + paths = svg.document.xpath ('//svg:path', namespaces=inkex.NSS) + for path in paths: + D = simplepath.parsePath (path.attrib['d']) + cmdlst = []; + parlst = []; + for cmd,params in D: + cmdlst.append(cmd) + parlst.append(params) + + print 'svgpath = struct("cmd","{0}","data",{{{1}}});' \ + .format(''.join(cmdlst),str(parlst).replace('[[','[').replace(']]',']')) + + print 'svgpathid = "{0}"; $'.format(path.attrib['id']) + + + +# ---------------------------- + +if __name__=="__main__": + ''' + try: + optlist,args = getopt.getopt(sys.argv[1:],"thdp") + except getopt.GetoptError: + usage() + sys.exit(2) + + doHelp = 0 + c = Context() + c.doPrint = 1 + for opt in optlist: + if opt[0] == "-d": c.debug = 1 + if opt[0] == "-p": c.plot = 1 + if opt[0] == "-t": c.triangulate = 1 + if opt[0] == "-h": doHelp = 1 + + if not doHelp: + pts = [] + fp = sys.stdin + if len(args) > 0: + fp = open(args[0],'r') + for line in fp: + fld = line.split() + x = float(fld[0]) + y = float(fld[1]) + pts.append(Site(x,y)) + if len(args) > 0: fp.close() + + if doHelp or len(pts) == 0: + usage() + sys.exit(2) + ''' + svg = sys.argv[1] + parsePaths(svg) diff --git a/octave_packages/geometry-1.5.0/io/deprecated/private/formatSVGstr.m b/octave_packages/geometry-1.5.0/io/deprecated/private/formatSVGstr.m new file mode 100644 index 0000000..a1310e6 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/deprecated/private/formatSVGstr.m @@ -0,0 +1,24 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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 . + +function svgF = formatSVGstr(svg) + + % Remove all newlines and tabs + svgF = strrep(svg,"\n",' '); + svgF = strrep(svgF,"\t",' '); + % Remove consecutive blanks + svgF = regexprep(svgF,' +',' '); + +end diff --git a/octave_packages/geometry-1.5.0/io/deprecated/private/getSVGPaths_py.m b/octave_packages/geometry-1.5.0/io/deprecated/private/getSVGPaths_py.m new file mode 100644 index 0000000..cca08ee --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/deprecated/private/getSVGPaths_py.m @@ -0,0 +1,113 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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 . + +function Paths = getSVGPaths_py (svg, varargin) + + %% Call python script + if exist (svg,'file') + % read from file + [st str]=system (sprintf ('python parsePath.py %s', svg)); + + else + % inline SVG + [st str]=system (sprintf ('python parsePath.py < %s', svg)); + end + + %% Parse ouput + strpath = strsplit (str(1:end-1), '$', true); + + npaths = numel (strpath); + + %% Convert path data to polygons + for ip = 1:npaths + + eval (strpath{ip}); + %% FIXME: intialize struct with cell field + svgpath2.cmd = svgpath(1).cmd; + svgpath2.data = {svgpath.data}; + + nD = length(svgpath2.cmd); + pathdata = cell (nD-1,1); + + point_end=[]; + %% If the path is closed, last command is Z and we set initial point == final + if svgpath2.cmd(end) == 'Z' + nD -= 1; + point_end = svgpath2.data{1}; + end + + %% Initial point + points(1,:) = svgpath2.data{1}; + + for jp = 2:nD + switch svgpath2.cmd(jp) + case 'L' + %% Straigth segment to polygon + points(2,:) = svgpath2.data{jp}; + pp = [(points(2,:)-points(1,:))' points(1,:)']; + clear points + points(1,:) = [polyval(pp(1,:),1) polyval(pp(2,:),1)]; + + case 'C' + %% Cubic bezier to polygon + points(2:4,:) = reshape (svgpath2.data{jp}, 2, 3).'; + pp = cbezier2poly (points); + clear points + points(1,:) = [polyval(pp(1,:),1) polyval(pp(2,:),1)]; + end + + pathdata{jp-1} = pp; + end + + if ~isempty(point_end) + %% Straight segmet to close the path + points(2,:) = point_end; + pp = [(points(2,:)-points(1,:))' points(1,:)']; + + pathdata{end} = pp; + end + + Paths.(svgpathid).data = pathdata; + end +endfunction + +%!test +%! figure(1) +%! hold on +%! paths = getSVGPaths_py ('../drawing.svg'); +%! +%! % Get path ids +%! ids = fieldnames(paths); +%! npath = numel(ids); +%! +%! t = linspace (0, 1, 64); +%! +%! for i = 1:npath +%! x = []; y = []; +%! data = paths.(ids(i)).data; +%! +%! for j = 1:numel(data) +%! x = cat (2, x, polyval (data{j}(1,:),t)); +%! y = cat (2, y, polyval (data{j}(2,:),t)); +%! end +%! +%! plot(x,y,'-'); +%! end +%! axis ij +%! if strcmpi(input('You should see drawing.svg [y/n] ','s'),'n') +%! error ("didn't get what was expected."); +%! end +%! close + diff --git a/octave_packages/geometry-1.5.0/io/deprecated/private/getSVGdata.m b/octave_packages/geometry-1.5.0/io/deprecated/private/getSVGdata.m new file mode 100644 index 0000000..21a1dd8 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/deprecated/private/getSVGdata.m @@ -0,0 +1,33 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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 . + +function svgData = getSVGdata(svg) + + svgData = struct('height',[],'width',[]); + attr = fieldnames(svgData); + nattr = numel(attr); + + [s e te data] = regexpi(svg,'<[ ]*svg(?:(?!>).)*>'); + data=strtrim(data{1}); + + for a = 1:nattr + pattr =sprintf('%s="(?:(?!").)*',attr{a}); + [s e te m] = regexpi(data,pattr); + m=strtrim(m{1}); + [dummy value] = strread(m,'%s%f','delimiter','"'); + svgData.(attr{a}) = value; + end + +end diff --git a/octave_packages/geometry-1.5.0/io/deprecated/private/getSVGstrPath.m b/octave_packages/geometry-1.5.0/io/deprecated/private/getSVGstrPath.m new file mode 100644 index 0000000..ae58654 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/deprecated/private/getSVGstrPath.m @@ -0,0 +1,20 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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 . + +function strPath = getSVGstrPath(svg) + + [s e te strPath] = regexpi(svg,'<[ ]*path(?:(?!/>).)*/>'); + +end diff --git a/octave_packages/geometry-1.5.0/io/deprecated/svgload.m b/octave_packages/geometry-1.5.0/io/deprecated/svgload.m new file mode 100644 index 0000000..a9e9963 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/deprecated/svgload.m @@ -0,0 +1,62 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{SVG} = loadSVG (@var{filename}) +%% Reads the plain SVG file @var{filename} and returns an SVG structure. +%% +%% In the current version only SVG path elements are parsed and stored in the field +%% path of the @var{SVG} structure. +%% The coordinates of the path are not modified in anyway. This produces the path +%% to be ploted vertically reflected. +%% +%% @seealso{svgnormalize, svgpath2polygon} +%% @end deftypefn + + +function SVG = svgload (filename) + + SVG = struct ('height', [], 'width', [], 'path', [], 'normalized', []); + + SVG.normalized = false; + + fid = fopen (filename); + svg = char (fread (fid, "uchar")'); + fclose (fid); + svgF = formatSVGstr (svg); + + % Get SVG Data + data = getSVGdata (svgF); + SVG.height = data.height; + SVG.width = data.width; + + % Get SVG Paths + SVGstrPath = getSVGstrPath (svgF); + SVGpath = SVGstrPath2SVGpath (SVGstrPath); + SVG.path = SVGpath; + +end + +%!demo +%! file = 'tmp__.svg'; +%! fid = fopen (file,'w'); +%! svgfile = ''; +%! fprintf (fid,"%s\n",svgfile); +%! fclose (fid); +%! SVG = svgload (file); +%! SVG +%! plot([SVG.path.coord(:,1); SVG.path.coord(1,1)], ... +%! [SVG.path.coord(:,2); SVG.path.coord(1,2)]); +%! delete (file); diff --git a/octave_packages/geometry-1.5.0/io/deprecated/svgnormalize.m b/octave_packages/geometry-1.5.0/io/deprecated/svgnormalize.m new file mode 100644 index 0000000..381d29a --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/deprecated/svgnormalize.m @@ -0,0 +1,68 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{SVGn} = loadSVG (@var{SVG}) +%% Scales and reflects the @var{SVG} structure and returns a modified @var{SVGn} +%% structure. +%% +%% The height and width of the SVG are scaled such that the diagonal of the +%% bounding box has length 1. Coordinates are trasnfomed such that a plot of the +%% paths coincides with the visualization of the original SVG. +%% +%% @seealso{svgload, svgpath2polygon} +%% @end deftypefn + +function SVGn = svgnormalize (SVG) + + SVGn = SVG; + if ~SVG.normalized + % Translate + TransV = [0, SVG.height/2]; + % Scale + Dnorm = sqrt (SVG.width ^ 2 + SVG.height ^ 2); + S = (1 / Dnorm) * eye (2); + for i = 1:numel (SVG.path) + nc = size (SVG.path(i).coord, 1); + % Translate to middle + T = repmat (TransV,nc, 1); + SVGn.path(i).coord = SVG.path(i).coord - T; + % Reflect + SVGn.path(i).coord(:, 2) = -SVGn.path(i).coord(:,2); + T(:,2) = -T(:,2); + % Translate to bottom + SVGn.path(i).coord = SVGn.path(i).coord - T; + %Scale + SVGn.path(i).coord = SVGn.path(i).coord * S; + end + SVGn.height = SVG.height / Dnorm; + SVGn.width = SVG.width / Dnorm; + SVGn.normalized = true; + end + +end + +%!demo +%! file = 'tmp__.svg'; +%! fid = fopen (file,'w'); +%! svgfile = ''; +%! fprintf (fid,"%s\n",svgfile); +%! fclose (fid); +%! SVG = svgload (file); +%! SVGn = svgnormalize (SVG); +%! SVGn +%! plot([SVGn.path.coord(:,1); SVGn.path.coord(1,1)], ... +%! [SVGn.path.coord(:,2); SVGn.path.coord(1,2)]); +%! delete (file); diff --git a/octave_packages/geometry-1.5.0/io/deprecated/svgpath2polygon.m b/octave_packages/geometry-1.5.0/io/deprecated/svgpath2polygon.m new file mode 100644 index 0000000..e03a78f --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/deprecated/svgpath2polygon.m @@ -0,0 +1,60 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% any later version. +%% +%% This program is distributed in the hope that it will be useful, +%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%% GNU General Public License for more details. +%% +%% You should have received a copy of the GNU General Public License +%% along with this program. If not, see . + +%% -*- texinfo -*- +%% @deftypefn {Function File} @var{P} = svgpath2polygon (@var{SVGpath}) +%% Converts the SVG path structure @var{SVGpath} to an array of polygons +%% compatible with the geometry package and matGeom (@url{http://matgeom.sf.net}). +%% +%% @var{SVGpath} is a substructure of the SVG structure output by loadSVG. This +%% function extracts the field named "coord" if there is only one path. If there +%% are more than oe path it puts the "coord" field of each path in the same +%% array, separated by nans. +%% +%% @seealso{svgnormalize, svgload} +%% @end deftypefn + +function P = svgpath2polygon (SVGpath) + + P = SVGpath(1).coord; + for ip = 2:numel (SVGpath) + P = [P; nan(1,2); SVGpath(ip).coord]; + end + +end + +%!demo +%! file = 'tmp__.svg'; +%! fid = fopen (file,'w'); +%! svgfile = ''; +%! fprintf (fid,"%s\n",svgfile); +%! fclose (fid); +%! SVG = svgload (file); +%! SVG = svgnormalize (SVG); +%! P = svgpath2polygon (SVG.path); +%! plot (P(:,1),P(:,2)); +%! delete (file); + +%!demo +%! file = 'tmp__.svg'; +%! fid = fopen (file,'w'); +%! svgfile = ''; +%! fprintf (fid,"%s\n",svgfile); +%! fclose (fid); +%! SVG = svgload (file); +%! SVG = svgnormalize (SVG); +%! P = svgpath2polygon (SVG.path); +%! plot (P(:,1),P(:,2)); +%! delete (file); diff --git a/octave_packages/geometry-1.5.0/io/doc-cache b/octave_packages/geometry-1.5.0/io/doc-cache new file mode 100644 index 0000000..45b455a --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/doc-cache @@ -0,0 +1,44 @@ +# Created by Octave 3.6.2, Sun Jun 10 09:53:40 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 1 +# name: +# type: sq_string +# elements: 1 +# length: 8 +data2geo + + +# name: +# type: sq_string +# elements: 1 +# length: 550 + -- Function File: FILESTR = data2geo (DATA, LC) + -- Function File: FILESTR = data2geo (..., PARAM, VALUE) + Uses data to build a file compatible with Gmsh. + + DATA is assumed to describe a polygon in `polygon2d' format. The + argument LC specifies the edge size. + + The optional parameters can be 'output' followed with a string + specifying a file to write, and 'spherical' followed by a real + number R indicating that the polygon describes a spherical + surface of radious R. + + See also: polygon2d, @svg/path2polygon + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Uses data to build a file compatible with Gmsh. + + + + + diff --git a/octave_packages/geometry-1.5.0/io/drawing.svg b/octave_packages/geometry-1.5.0/io/drawing.svg new file mode 100644 index 0000000..71f6099 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/drawing.svg @@ -0,0 +1,43 @@ + + + + + + + + + image/svg+xml + + + + + + + + + + + diff --git a/octave_packages/geometry-1.5.0/io/drawing2.svg b/octave_packages/geometry-1.5.0/io/drawing2.svg new file mode 100644 index 0000000..076ee55 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/drawing2.svg @@ -0,0 +1,43 @@ + + + + + + + + + image/svg+xml + + + + + + + + + + + diff --git a/octave_packages/geometry-1.5.0/io/drawing3.svg b/octave_packages/geometry-1.5.0/io/drawing3.svg new file mode 100644 index 0000000..66779f7 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/drawing3.svg @@ -0,0 +1,35 @@ + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/octave_packages/geometry-1.5.0/io/drawing4.svg b/octave_packages/geometry-1.5.0/io/drawing4.svg new file mode 100644 index 0000000..4a0b71f --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/drawing4.svg @@ -0,0 +1,65 @@ + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/octave_packages/geometry-1.5.0/io/drawing5.svg b/octave_packages/geometry-1.5.0/io/drawing5.svg new file mode 100644 index 0000000..2ab3438 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/drawing5.svg @@ -0,0 +1,64 @@ + + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/octave_packages/geometry-1.5.0/io/drawing6.svg b/octave_packages/geometry-1.5.0/io/drawing6.svg new file mode 100644 index 0000000..53c5d78 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/drawing6.svg @@ -0,0 +1,36 @@ + + + + + + + + + image/svg+xml + + + + + + + + + diff --git a/octave_packages/geometry-1.5.0/io/private/inkex.py b/octave_packages/geometry-1.5.0/io/private/inkex.py new file mode 100644 index 0000000..49de51e --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/private/inkex.py @@ -0,0 +1,235 @@ +#!/usr/bin/env python +""" +inkex.py +A helper module for creating Inkscape extensions + +Copyright (C) 2005,2007 Aaron Spike, aaron@ekips.org + +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, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +""" +import sys, copy, optparse, random, re +import gettext +from math import * +_ = gettext.gettext + +#a dictionary of all of the xmlns prefixes in a standard inkscape doc +NSS = { +u'sodipodi' :u'http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd', +u'cc' :u'http://creativecommons.org/ns#', +u'ccOLD' :u'http://web.resource.org/cc/', +u'svg' :u'http://www.w3.org/2000/svg', +u'dc' :u'http://purl.org/dc/elements/1.1/', +u'rdf' :u'http://www.w3.org/1999/02/22-rdf-syntax-ns#', +u'inkscape' :u'http://www.inkscape.org/namespaces/inkscape', +u'xlink' :u'http://www.w3.org/1999/xlink', +u'xml' :u'http://www.w3.org/XML/1998/namespace' +} + +#a dictionary of unit to user unit conversion factors +uuconv = {'in':90.0, 'pt':1.25, 'px':1, 'mm':3.5433070866, 'cm':35.433070866, 'm':3543.3070866, + 'km':3543307.0866, 'pc':15.0, 'yd':3240 , 'ft':1080} +def unittouu(string): + '''Returns userunits given a string representation of units in another system''' + unit = re.compile('(%s)$' % '|'.join(uuconv.keys())) + param = re.compile(r'(([-+]?[0-9]+(\.[0-9]*)?|[-+]?\.[0-9]+)([eE][-+]?[0-9]+)?)') + + p = param.match(string) + u = unit.search(string) + if p: + retval = float(p.string[p.start():p.end()]) + else: + retval = 0.0 + if u: + try: + return retval * uuconv[u.string[u.start():u.end()]] + except KeyError: + pass + return retval + +def uutounit(val, unit): + return val/uuconv[unit] + +try: + from lxml import etree +except: + sys.exit(_('The fantastic lxml wrapper for libxml2 is required by inkex.py and therefore this extension. Please download and install the latest version from http://cheeseshop.python.org/pypi/lxml/, or install it through your package manager by a command like: sudo apt-get install python-lxml')) + +def debug(what): + sys.stderr.write(str(what) + "\n") + return what + +def errormsg(msg): + """Intended for end-user-visible error messages. + + (Currently just writes to stderr with an appended newline, but could do + something better in future: e.g. could add markup to distinguish error + messages from status messages or debugging output.) + + Note that this should always be combined with translation: + + import gettext + _ = gettext.gettext + ... + inkex.errormsg(_("This extension requires two selected paths.")) + """ + sys.stderr.write((unicode(msg) + "\n").encode("UTF-8")) + +def check_inkbool(option, opt, value): + if str(value).capitalize() == 'True': + return True + elif str(value).capitalize() == 'False': + return False + else: + raise optparse.OptionValueError("option %s: invalid inkbool value: %s" % (opt, value)) + +def addNS(tag, ns=None): + val = tag + if ns!=None and len(ns)>0 and NSS.has_key(ns) and len(tag)>0 and tag[0]!='{': + val = "{%s}%s" % (NSS[ns], tag) + return val + +class InkOption(optparse.Option): + TYPES = optparse.Option.TYPES + ("inkbool",) + TYPE_CHECKER = copy.copy(optparse.Option.TYPE_CHECKER) + TYPE_CHECKER["inkbool"] = check_inkbool + +class Effect: + """A class for creating Inkscape SVG Effects""" + + def __init__(self, *args, **kwargs): + self.document=None + self.ctx=None + self.selected={} + self.doc_ids={} + self.options=None + self.args=None + self.OptionParser = optparse.OptionParser(usage="usage: %prog [options] SVGfile",option_class=InkOption) + self.OptionParser.add_option("--id", + action="append", type="string", dest="ids", default=[], + help="id attribute of object to manipulate") + + def effect(self): + pass + + def getoptions(self,args=sys.argv[1:]): + """Collect command line arguments""" + self.options, self.args = self.OptionParser.parse_args(args) + + def parse(self,file=None): + """Parse document in specified file or on stdin""" + try: + try: + stream = open(file,'r') + except: + stream = open(self.svg_file,'r') + except: + stream = sys.stdin + self.document = etree.parse(stream) + stream.close() + + def getposinlayer(self): + #defaults + self.current_layer = self.document.getroot() + self.view_center = (0.0,0.0) + + layerattr = self.document.xpath('//sodipodi:namedview/@inkscape:current-layer', namespaces=NSS) + if layerattr: + layername = layerattr[0] + layer = self.document.xpath('//svg:g[@id="%s"]' % layername, namespaces=NSS) + if layer: + self.current_layer = layer[0] + + xattr = self.document.xpath('//sodipodi:namedview/@inkscape:cx', namespaces=NSS) + yattr = self.document.xpath('//sodipodi:namedview/@inkscape:cy', namespaces=NSS) + doc_height = unittouu(self.document.getroot().get('height')) + if xattr and yattr: + x = xattr[0] + y = yattr[0] + if x and y: + self.view_center = (float(x), doc_height - float(y)) # FIXME: y-coordinate flip, eliminate it when it's gone in Inkscape + + def getselected(self): + """Collect selected nodes""" + for i in self.options.ids: + path = '//*[@id="%s"]' % i + for node in self.document.xpath(path, namespaces=NSS): + self.selected[i] = node + + def getElementById(self, id): + path = '//*[@id="%s"]' % id + el_list = self.document.xpath(path, namespaces=NSS) + if el_list: + return el_list[0] + else: + return None + + def getParentNode(self, node): + for parent in self.document.getiterator(): + if node in parent.getchildren(): + return parent + break + + + def getdocids(self): + docIdNodes = self.document.xpath('//@id', namespaces=NSS) + for m in docIdNodes: + self.doc_ids[m] = 1 + + def getNamedView(self): + return self.document.xpath('//sodipodi:namedview', namespaces=NSS)[0] + + def createGuide(self, posX, posY, angle): + atts = { + 'position': str(posX)+','+str(posY), + 'orientation': str(sin(radians(angle)))+','+str(-cos(radians(angle))) + } + guide = etree.SubElement( + self.getNamedView(), + addNS('guide','sodipodi'), atts ) + return guide + + def output(self): + """Serialize document into XML on stdout""" + self.document.write(sys.stdout) + + def affect(self, args=sys.argv[1:], output=True): + """Affect an SVG document with a callback effect""" + self.svg_file = args[-1] + self.getoptions(args) + self.parse() + self.getposinlayer() + self.getselected() + self.getdocids() + self.effect() + if output: self.output() + + def uniqueId(self, old_id, make_new_id = True): + new_id = old_id + if make_new_id: + while new_id in self.doc_ids: + new_id += random.choice('0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ') + self.doc_ids[new_id] = 1 + return new_id + + def xpathSingle(self, path): + try: + retval = self.document.xpath(path, namespaces=NSS)[0] + except: + errormsg(_("No matching node for expression: %s") % path) + retval = None + return retval + + +# vim: expandtab shiftwidth=4 tabstop=8 softtabstop=4 encoding=utf-8 textwidth=99 diff --git a/octave_packages/geometry-1.5.0/io/private/lineGeo.m b/octave_packages/geometry-1.5.0/io/private/lineGeo.m new file mode 100644 index 0000000..23a2db4 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/private/lineGeo.m @@ -0,0 +1,29 @@ +%% Copyright (c) 2010 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{str} = lineGeo (@var{n}, @var{pi}, @var{pj}) +%% Generates a string for Gmsh Line format. +%% +%% Curves are Gmsh's second type of elementery entities, and, +%% amongst curves, straight lines are the simplest. A straight line is +%% defined by a list of point numbers. The initial point @var{pi}, the final +%% point @var{pj}. @var{n} is an indetifier for the line. +%% +%% @end deftypefn + +function str = lineGeo(n,i,j) + str = sprintf('Line(%d) = {%d,%d};\n',n,i,j); +end diff --git a/octave_packages/geometry-1.5.0/io/private/lineLoopGeo.m b/octave_packages/geometry-1.5.0/io/private/lineLoopGeo.m new file mode 100644 index 0000000..92f5350 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/private/lineLoopGeo.m @@ -0,0 +1,32 @@ +%% Copyright (c) 2010 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{str} = lineLoopGeo (@var{id}, @var{nl}, @var{lns}) +%% Generates a string for Gmsh Line Loop format. +%% +%% The third elementary entity is the surface. In order to define a +%% simple rectangular surface from defined lines, a +%% line loop has first to be defined. A line loop is a list of +%% connected lines, a sign being associated with each line (depending +%% on the orientation of the line). @var{id} is an indentifier for the loop. +%% @var{nl} is the number of lines in the loop. @var{lns} is the list of lines. +%% +%% @end deftypefn + +function str = lineLoopGeo(id,nl,lns) + substr = repmat(',%d',1,nl-1); + str = sprintf(['Line Loop(%d) = {%d' substr '};\n'],id,lns); +end diff --git a/octave_packages/geometry-1.5.0/io/private/planeSurfGeo.m b/octave_packages/geometry-1.5.0/io/private/planeSurfGeo.m new file mode 100644 index 0000000..b6c12e6 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/private/planeSurfGeo.m @@ -0,0 +1,36 @@ +%% Copyright (c) 2010 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{str} = planeSurfGeo (@var{id}, @var{nloop},@var{loops}) +%% Generates a string for Gmsh Plane Surface format. +%% +%% @var{id} is the plane surface's identification number. +%% @var{nloop} is the number of loops defining the surface. +%% @var{loops} contain the identification numbers of all the line loops defining +%% the surface. The first line loop defines the exterior boundary of the surface; +%% all other line loops define holes in the surface. A line loop defining a hole +%% should not have any lines in common with the exterior line loop (in which case +%% it is not a hole, and the two surfaces should be defined separately). +%% Likewise, a line loop defining a hole should not have any lines in common with +%% another line loop defining a hole in the same surface (in which case the two +%% line loops should be combined). +%% +%% @end deftypefn + +function str = planeSurfGeo(id,nloop,loops) + substr = repmat(',%d',1,nloop-1); + str = sprintf(['Plane Surface(%d) = {%d' substr '};\n'],id,loops); +end diff --git a/octave_packages/geometry-1.5.0/io/private/pointGeo.m b/octave_packages/geometry-1.5.0/io/private/pointGeo.m new file mode 100644 index 0000000..6c3d5e9 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/private/pointGeo.m @@ -0,0 +1,32 @@ +%% Copyright (c) 2010 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{str} = poointGeo (@var{n}, @var{xyz}, @var{l}) +%% Generates a string for Gmsh Point format. +%% +%% Gmsh's simplest `elementary entity', a `Point'. A Point is defined by a list +%% of five numbers: @var{n} the identificator, @var{xyz} three coordinates (X, Y +%% and Z), and a characteristic length @var{l} that sets the target element size +%% at the point: +%% The distribution of the mesh element sizes is then obtained by +%% interpolation of these characteristic lengths throughout the +%% geometry. +%% +%% @end deftypefn + +function str = pointGeo(n,xyz,l) + str = sprintf('Point(%d) = {%.16g,%.16g,%.16g,%.16g};\n',n,xyz,l); +end diff --git a/octave_packages/geometry-1.5.0/io/private/ruledSurfGeo.m b/octave_packages/geometry-1.5.0/io/private/ruledSurfGeo.m new file mode 100644 index 0000000..8d8b972 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/private/ruledSurfGeo.m @@ -0,0 +1,39 @@ +%% Copyright (c) 2010 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{str} = ruledSurfGeo (@var{id}, @var{nloop}, @var{loops}, @var{centerid}) +%% Generates a string for Gmsh Ruled Surface format. +%% +%% Creates a ruled surface with identifier @var{id}, i.e., a surface that can be +%% interpolated using transfinite interpolation. @var{nloop} indicates the number +%% of loops that define the surface. @var{loops} should contain the identification +%% number of a line loop composed of either three or four elementary lines. +%% @var{centerid} is the identification number of the center of the sphere, this +%% forces the surface to be a spherical patch. +%% +%% @end deftypefn + +function str = ruledSurfGeo(id,nloop,loops,centerid) + substr = repmat(',%d',1,nloop-1); + + if ~isempty(centerid) + str = sprintf(['Ruled Surface(%d) = {%d' substr '} In Sphere {%d};\n'], ... + id,loops,centerid); + else + error('data2geo:Error',"The id of the centers shouldn't be empty"); + end + +end diff --git a/octave_packages/geometry-1.5.0/io/private/simplepath.py b/octave_packages/geometry-1.5.0/io/private/simplepath.py new file mode 100644 index 0000000..f62b1b4 --- /dev/null +++ b/octave_packages/geometry-1.5.0/io/private/simplepath.py @@ -0,0 +1,212 @@ +#!/usr/bin/env python +""" +simplepath.py +functions for digesting paths into a simple list structure + +Copyright (C) 2005 Aaron Spike, aaron@ekips.org + +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, write to the Free Software +Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +""" +import re, math + +def lexPath(d): + """ + returns and iterator that breaks path data + identifies command and parameter tokens + """ + offset = 0 + length = len(d) + delim = re.compile(r'[ \t\r\n,]+') + command = re.compile(r'[MLHVCSQTAZmlhvcsqtaz]') + parameter = re.compile(r'(([-+]?[0-9]+(\.[0-9]*)?|[-+]?\.[0-9]+)([eE][-+]?[0-9]+)?)') + while 1: + m = delim.match(d, offset) + if m: + offset = m.end() + if offset >= length: + break + m = command.match(d, offset) + if m: + yield [d[offset:m.end()], True] + offset = m.end() + continue + m = parameter.match(d, offset) + if m: + yield [d[offset:m.end()], False] + offset = m.end() + continue + #TODO: create new exception + raise Exception, 'Invalid path data!' +''' +pathdefs = {commandfamily: + [ + implicitnext, + #params, + [casts,cast,cast], + [coord type,x,y,0] + ]} +''' +pathdefs = { + 'M':['L', 2, [float, float], ['x','y']], + 'L':['L', 2, [float, float], ['x','y']], + 'H':['H', 1, [float], ['x']], + 'V':['V', 1, [float], ['y']], + 'C':['C', 6, [float, float, float, float, float, float], ['x','y','x','y','x','y']], + 'S':['S', 4, [float, float, float, float], ['x','y','x','y']], + 'Q':['Q', 4, [float, float, float, float], ['x','y','x','y']], + 'T':['T', 2, [float, float], ['x','y']], + 'A':['A', 7, [float, float, float, int, int, float, float], ['r','r','a',0,'s','x','y']], + 'Z':['L', 0, [], []] + } +def parsePath(d): + """ + Parse SVG path and return an array of segments. + Removes all shorthand notation. + Converts coordinates to absolute. + """ + retval = [] + lexer = lexPath(d) + + pen = (0.0,0.0) + subPathStart = pen + lastControl = pen + lastCommand = '' + + while 1: + try: + token, isCommand = lexer.next() + except StopIteration: + break + params = [] + needParam = True + if isCommand: + if not lastCommand and token.upper() != 'M': + raise Exception, 'Invalid path, must begin with moveto.' + else: + command = token + else: + #command was omited + #use last command's implicit next command + needParam = False + if lastCommand: + if lastCommand.isupper(): + command = pathdefs[lastCommand][0] + else: + command = pathdefs[lastCommand.upper()][0].lower() + else: + raise Exception, 'Invalid path, no initial command.' + numParams = pathdefs[command.upper()][1] + while numParams > 0: + if needParam: + try: + token, isCommand = lexer.next() + if isCommand: + raise Exception, 'Invalid number of parameters' + except StopIteration: + raise Exception, 'Unexpected end of path' + cast = pathdefs[command.upper()][2][-numParams] + param = cast(token) + if command.islower(): + if pathdefs[command.upper()][3][-numParams]=='x': + param += pen[0] + elif pathdefs[command.upper()][3][-numParams]=='y': + param += pen[1] + params.append(param) + needParam = True + numParams -= 1 + #segment is now absolute so + outputCommand = command.upper() + + #Flesh out shortcut notation + if outputCommand in ('H','V'): + if outputCommand == 'H': + params.append(pen[1]) + if outputCommand == 'V': + params.insert(0,pen[0]) + outputCommand = 'L' + if outputCommand in ('S','T'): + params.insert(0,pen[1]+(pen[1]-lastControl[1])) + params.insert(0,pen[0]+(pen[0]-lastControl[0])) + if outputCommand == 'S': + outputCommand = 'C' + if outputCommand == 'T': + outputCommand = 'Q' + + #current values become "last" values + if outputCommand == 'M': + subPathStart = tuple(params[0:2]) + pen = subPathStart + if outputCommand == 'Z': + pen = subPathStart + else: + pen = tuple(params[-2:]) + + if outputCommand in ('Q','C'): + lastControl = tuple(params[-4:-2]) + else: + lastControl = pen + lastCommand = command + + retval.append([outputCommand,params]) + return retval + +def formatPath(a): + """Format SVG path data from an array""" + return "".join([cmd + " ".join([str(p) for p in params]) for cmd, params in a]) + +def translatePath(p, x, y): + for cmd,params in p: + defs = pathdefs[cmd] + for i in range(defs[1]): + if defs[3][i] == 'x': + params[i] += x + elif defs[3][i] == 'y': + params[i] += y + +def scalePath(p, x, y): + for cmd,params in p: + defs = pathdefs[cmd] + for i in range(defs[1]): + if defs[3][i] == 'x': + params[i] *= x + elif defs[3][i] == 'y': + params[i] *= y + elif defs[3][i] == 'r': # radius parameter + params[i] *= x + elif defs[3][i] == 's': # sweep-flag parameter + if x*y < 0: + params[i] = 1 - params[i] + elif defs[3][i] == 'a': # x-axis-rotation angle + if y < 0: + params[i] = - params[i] + +def rotatePath(p, a, cx = 0, cy = 0): + if a == 0: + return p + for cmd,params in p: + defs = pathdefs[cmd] + for i in range(defs[1]): + if defs[3][i] == 'x': + x = params[i] - cx + y = params[i + 1] - cy + r = math.sqrt((x**2) + (y**2)) + if r != 0: + theta = math.atan2(y, x) + a + params[i] = (r * math.cos(theta)) + cx + params[i + 1] = (r * math.sin(theta)) + cy + + +# vim: expandtab shiftwidth=4 tabstop=8 softtabstop=4 encoding=utf-8 textwidth=99 diff --git a/octave_packages/geometry-1.5.0/octclip/doc-cache b/octave_packages/geometry-1.5.0/octclip/doc-cache new file mode 100644 index 0000000..8315818 --- /dev/null +++ b/octave_packages/geometry-1.5.0/octclip/doc-cache @@ -0,0 +1,72 @@ +# Created by Octave 3.6.2, Sun Jun 10 09:53:40 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 1 +# name: +# type: sq_string +# elements: 1 +# length: 11 +oc_polybool + + +# name: +# type: sq_string +# elements: 1 +# length: 1545 + -- Function File: [X,Y,NPOL,NINT,NPERT] = _oc_polybool(SUB,CLIP,OP) + -- Function File: [X,Y,NPOL,NINT,NPERT] = _oc_polybool(SUB,CLIP) + This function performs boolean operations between two polygons + using the Greiner-Hormann algorithm + (http://davis.wpi.edu/~matt/courses/clipping/). + + SUB is a two column matrix containing the X and Y coordinates of + the vertices for the subject polygon. + + CLIP is a two column matrix containing the X and Y coordinates of + the vertices for the clipper polygon. + + OP is a text string containing the operation to perform between + SUB and CLIP. Possible values are: + + * 'AND' Intersection of SUB and CLIP (value by default). + + * 'OR' Union of SUBT and CLIP. + + * 'AB' Operation SUB - CLIP. + + * 'BA' Operation of CLIP - SUB. + + For the matrices SUB and CLIP, the first point is not needed to be + repeated at the end (but is permitted). Pairs of (NaN,NaN) + coordinates in SUB and/or CLIP are omitted. + + X is a column vector containing the X coordinates of the vertices + for. resultant polygon(s). + + Y is a column vector containing the Y coordinates of the vertices + for. resultant polygon(s). + + NPOL is the number of output polygons. + + NINT is the number of intersections between SUB and CLIP. + + NPERT is the number of perturbed points of the CLIP polygon in any + particular case (points in the oborder of the other polygon) + occurs see http://davis.wpi.edu/~matt/courses/clipping/ for + details. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +This function performs boolean operations between two polygons using the +Greiner + + + + + diff --git a/octave_packages/geometry-1.5.0/octclip/oc_polybool.m b/octave_packages/geometry-1.5.0/octclip/oc_polybool.m new file mode 100644 index 0000000..259f057 --- /dev/null +++ b/octave_packages/geometry-1.5.0/octclip/oc_polybool.m @@ -0,0 +1,264 @@ +## Copyright (C) 2011, José Luis García Pallero, +## +## This file is part of OctCLIP. +## +## OctCLIP is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn{Function File}{[@var{X},@var{Y},@var{nPol},@var{nInt},@var{nPert}] =}_oc_polybool(@var{sub},@var{clip},@var{op}) +## @deftypefnx{Function File}{[@var{X},@var{Y},@var{nPol},@var{nInt},@var{nPert}] =}_oc_polybool(@var{sub},@var{clip}) +## +## This function performs boolean operations between two polygons using the +## Greiner-Hormann algorithm (http://davis.wpi.edu/~matt/courses/clipping/). +## +## @var{sub} is a two column matrix containing the X and Y coordinates of the +## vertices for the subject polygon. +## +## @var{clip} is a two column matrix containing the X and Y coordinates of the +## vertices for the clipper polygon. +## +## @var{op} is a text string containing the operation to perform between +## @var{sub} and @var{clip}. Possible values are: +## +## @itemize @bullet +## @item @var{'AND'} +## Intersection of @var{sub} and @var{clip} (value by default). +## @item @var{'OR'} +## Union of @var{subt} and @var{clip}. +## @item @var{'AB'} +## Operation @var{sub} - @var{clip}. +## @item @var{'BA'} +## Operation of @var{clip} - @var{sub}. +## @end itemize +## +## For the matrices @var{sub} and @var{clip}, the first point is not needed to +## be repeated at the end (but is permitted). Pairs of (NaN,NaN) coordinates in +## @var{sub} and/or @var{clip} are omitted. +## +## @var{X} is a column vector containing the X coordinates of the vertices for. +## resultant polygon(s). +## +## @var{Y} is a column vector containing the Y coordinates of the vertices for. +## resultant polygon(s). +## +## @var{nPol} is the number of output polygons. +## +## @var{nInt} is the number of intersections between @var{sub} and @var{clip}. +## +## @var{nPert} is the number of perturbed points of the @var{clip} polygon in +## any particular case (points in the oborder of the other polygon) occurs see +## http://davis.wpi.edu/~matt/courses/clipping/ for details. +## @end deftypefn + + + + +function [X,Y,nPol,nInt,nPert] = oc_polybool(sub,clip,op) + +try + functionName = 'oc_polybool'; + minArg = 2; + maxArg = 3; + +%******************************************************************************* +%NUMBER OF INPUT ARGUMENTS CHECKING +%******************************************************************************* + + %number of input arguments checking + if (narginmaxArg) + error(['Incorrect number of input arguments (%d)\n\t ',... + 'Correct number of input arguments = %d or %d'],... + nargin,minArg,maxArg); + end + %check if we omit the op argument + if nargin==minArg + %by default, use AND + op = 'AND'; + end + +%******************************************************************************* +%INPUT ARGUMENTS CHECKING +%******************************************************************************* + + %checking input arguments + [op] = checkInputArguments(sub,clip,op); +catch + %error message + error('\n\tIn function %s:\n\t -%s ',functionName,lasterr); +end + +%******************************************************************************* +%COMPUTATION +%******************************************************************************* + +try + %calling oct function + [X,Y,nPol,nInt,nPert] = _oc_polybool(sub,clip,op); +catch + %error message + error('\n\tIn function %s:\n\tIn function %s ',functionName,lasterr); +end + + + + +%******************************************************************************* +%AUXILIARY FUNCTION +%******************************************************************************* + + + + +function [outOp] = checkInputArguments(sub,clip,inOp) + +%sub must be matrix type +if ismatrix(sub) + %a dimensions + [rowSub,colSub] = size(sub); +else + error('The first input argument is not numeric'); +end +%clip must be matrix type +if ismatrix(clip) + %b dimensions + [rowClip,colClip] = size(clip); +else + error('The second input argument is not numeric'); +end +%checking dimensions +if (colSub~=2)||(colClip~=2) + error('The columns of input arguments must be 2'); +end +%operation must be a text string +if ~ischar(inOp) + error('The third input argument is not a text string'); +else + %upper case + outOp = toupper(inOp); + %check values + if (~strcmp(outOp,'AND'))&&(~strcmp(outOp,'OR'))&& ... + (~strcmp(outOp,'AB'))&&(~strcmp(outOp,'BA')) + error('The third input argument is not correct'); + end +end + + + + +%*****END OF FUNCIONS***** + + + + +%*****FUNCTION TESTS***** + + + + +%tests for input arguments +%!error(oc_polybool) +%!error(oc_polybool(1,2,3,4)) +%!error(oc_polybool('string',2,3)) +%!error(oc_polybool(1,'string',3)) +%!error(oc_polybool(1,2,3)) +%demo program +%!demo +%! %subject polygon +%! clSub = [9.0 7.5 +%! 9.0 3.0 +%! 2.0 3.0 +%! 2.0 4.0 +%! 8.0 4.0 +%! 8.0 5.0 +%! 2.0 5.0 +%! 2.0 6.0 +%! 8.0 6.0 +%! 8.0 7.0 +%! 2.0 7.0 +%! 2.0 7.5 +%! 9.0 7.5]; +%! %clipper polygon +%! clClip = [2.5 1.0 +%! 7.0 1.0 +%! 7.0 8.0 +%! 6.0 8.0 +%! 6.0 2.0 +%! 5.0 2.0 +%! 5.0 8.0 +%! 4.0 8.0 +%! 4.0 2.0 +%! 3.0 2.0 +%! 3.0 8.0 +%! 2.5 8.0 +%! 2.5 1.0]; +%! %limits for the plots +%! clXLim = [1.5 11.75]; +%! clYLim = [0.5 8.50]; +%! %compute intersection +%! [clXI,clYI] = oc_polybool(clSub,clClip,'and'); +%! %compute union +%! [clXU,clYU] = oc_polybool(clSub,clClip,'or'); +%! %compute A-B +%! [clXA,clYA] = oc_polybool(clSub,clClip,'ab'); +%! %compute B-A +%! [clXB,clYB] = oc_polybool(clSub,clClip,'ba'); +%! %plot window for intersection +%! subplot(2,2,1); +%! plot(clXI,clYI,'r.-','markersize',10,'linewidth',3,clSub(:,1),clSub(:,2),... +%! clClip(:,1),clClip(:,2)); +%! axis('equal'); +%! xlim(clXLim); +%! ylim(clYLim); +%! title('OctCLIP intersection'); +%! legend('Intersection','Subject polygon','Clipper polygon',... +%! 'location','southeast'); +%! %plot window for union +%! subplot(2,2,2); +%! plot(clXU,clYU,'r.-','markersize',10,'linewidth',3,clSub(:,1),clSub(:,2),... +%! clClip(:,1),clClip(:,2)); +%! axis('equal'); +%! xlim(clXLim); +%! ylim(clYLim); +%! title('OctCLIP union'); +%! legend('Union','Subject polygon','Clipper polygon','location','southeast'); +%! %plot window for A-B +%! subplot(2,2,3); +%! plot(clXA,clYA,'r.-','markersize',10,'linewidth',3,clSub(:,1),clSub(:,2),... +%! clClip(:,1),clClip(:,2)); +%! axis('equal'); +%! xlim(clXLim); +%! ylim(clYLim); +%! title('OctCLIP A-B'); +%! legend('A-B','Subject polygon','Clipper polygon','location','southeast'); +%! %plot window for B-A +%! subplot(2,2,4); +%! plot(clXB,clYB,'r.-','markersize',10,'linewidth',3,clSub(:,1),clSub(:,2),... +%! clClip(:,1),clClip(:,2)); +%! axis('equal'); +%! xlim(clXLim); +%! ylim(clYLim); +%! title('OctCLIP B-A'); +%! legend('B-A','Subject polygon','Clipper polygon','location','southeast'); +%! %input message +%! disp('Press ENTER to continue ...'); +%! pause(); +%! %kill and close the plot window +%! clf(); +%! close(); + + + + +%*****END OF TESTS***** diff --git a/octave_packages/geometry-1.5.0/packinfo/.autoload b/octave_packages/geometry-1.5.0/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/geometry-1.5.0/packinfo/DESCRIPTION b/octave_packages/geometry-1.5.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..bfeb0c9 --- /dev/null +++ b/octave_packages/geometry-1.5.0/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: Geometry +Version: 1.5.0 +Date: 2012-06-05 +Author: David Legland , José Luis García Pallero , Juan Pablo Carbajal , Simeon Simeonov +Maintainer: Juan Pablo Carbajal +Title: Computational Geometry +Description: Library for geometric computing extending MatGeom functions. Useful to create, transform, manipulate and display geometric primitives. +Depends: octave (>= 3.4.0), general (>= 1.3.0) +Autoload: yes +License: GPLv3+, FreeBSD +Url: http://octave.sf.net, http://matgeom.sf.net, http://davis.wpi.edu/~matt/courses/clipping/, https://bitbucket.org/jgpallero/octclip diff --git a/octave_packages/geometry-1.5.0/packinfo/INDEX b/octave_packages/geometry-1.5.0/packinfo/INDEX new file mode 100644 index 0000000..34149dd --- /dev/null +++ b/octave_packages/geometry-1.5.0/packinfo/INDEX @@ -0,0 +1,177 @@ +geometry >> Computational Geometry +2D Descriptive + geom2d_Contents + points2d + vectors2d + angles2d + edges2d + rays2d + lines2d + boxes2d + circles2d + ellipses2d + transforms2d + polygons2d +2D Points + centroid + closed_path + distancePoints + drawPoint + isCounterClockwise + isPointOnRay + isPointInCircle + isPointOnCircle + isPointOnLine + isPointInEllipse + midPoint + minDistancePoints + polarPoint +2D Vectors + createVector + vectorNorm + normalizeVector + rotateVector +2D Angles + angle2Points + angle3Points + angleAbsDiff + angleDiff + normalizeAngle + vectorAngle + angleSort + lineAngle + edgeAngle + deg2rad + rad2deg +2D Edges + createEdge + distancePointEdge + drawCenteredEdge + drawEdge + edgeLength + edgePosition + edgeToLine + intersectEdges + intersectLineEdge + reverseEdge + transformEdge + isPointOnEdge +2D Rays + drawRay + createRay +2D Lines + cartesianLine + createLine + distancePointLine + drawLine + intersectLines + isParallel + isPerpendicular + linePosition + medianLine + isLeftOriented + orthogonalLine + parallelLine + pointOnLine + projPointOnLine + reverseLine +2D Boxes + clipEdge + clipLine + clipPoints + clipRay + mergeBoxes + intersectBoxes + drawBox + randomPointInBox + drawRect + drawOrientedBox +2D Circles + createCircle + createDirectedCircle + circleArcAsCurve + circleAsPolygon + drawCircleArc + drawCircle + enclosingCircle + intersectCircles + intersectLineCircle + radicalAxis +2D Ellipses + cov2ellipse + drawEllipseArc + drawEllipse + ellipseAsPolygon + ellipse2cov + inertiaEllipse +2D Transformations + transformLine + transformPoint + transformVector + createBasisTransform + createHomothecy + createLineReflection + createRotation + createScaling + createTranslation + fitAffineTransform2d +2D Cubic Bezier + drawBezierCurve + cbezier2poly +2D Polygons + curvature + distancePolygons + distancePointPolygon + distancePointPolyline + drawPolygon + expandPolygon + medialAxisConvex + oc_polybool + parametrize + polygonLoops + polygonSelfIntersections + polylineSelfIntersections + reversePolyline + reversePolygon + simplifypolygon + simplifypolyline + splitPolygons + supportFunction +2D Piecewise polynomial shapes + polygon2shape + shape2polygon + shapecentroid + shapeplot + shapetransform + curveval + curve2polyline +2D Others + beltproblem + bisector + crackPattern2 + crackPattern + drawArrow + drawLabels + drawParabola + drawShape + hexagonalGrid + squareGrid + triangleGrid +Geometric graphs creation + delaunayGraph.m + knnGraph.m + voronoi2d.m +Geometric graphs visualization + drawGraph.m +Geometric graphs manipulation +Input + @svg/svg + @svg/plot + @svg/getpath + @svg/path2polygon + @svg/normalize + @svg/pathid + @svg/height + @svg/width +Output + data2geo diff --git a/octave_packages/geometry-1.5.0/packinfo/NEWS b/octave_packages/geometry-1.5.0/packinfo/NEWS new file mode 100644 index 0000000..3d3d6b6 --- /dev/null +++ b/octave_packages/geometry-1.5.0/packinfo/NEWS @@ -0,0 +1,262 @@ +Summary of important user-visible changes for releases of the geometry package + +=============================================================================== +geometry-1.5.0 Release Date: 2012-06-05 Release Manager: Juan Pablo Carbajal +=============================================================================== + +* Added functions: + - cov2ellipse.m & ellipse2cov: transform between ellipses and covariances matrices. + + - beltproblem.m : Finds the four lines tangent to two circles with given centers and + radii. This is the solution to the belt problem in 2D. + + - curveval.m: Evaluates a polynomial curve defined as a 2-by-N matrix. + + - curve2polyline.m: Converts a polynomial curve into a polyline by the adaptive + sampling method. + + - simplifypolyline.m: Ramer-Douglas-Peucker algorithm to simplify polylines. + + - parametrize.m: Estimate a parametrization of a polygon/line based on the distance + between the points. + + - curvature.m: Estimation of the curvature of a polygon/line based on polynomial + approximation. + + - reversePolygon.m and reversePolyline.m: reverse the orders of the points in + of polygon/line. + + - supportFunction.m: Compute support function of a polygon. + + - distancePointPolygon.m, distancePointPolyline.m, distancePolygons.m , + expandPolygon.m, medialAxisConvex.m, polygonLoops.m, polygonSelfIntersections.m + polylineSelfIntersections.m, splitPolygons.m + + - close_path.m : given a set of points in the plane calculate a piecewise linear + simple path that passes through all points. + +* Changed functions: + - distancePointEdge.m: Now the function computes the distance between all points + and all edges. A third optional argument provides + backward compatibility. + +* Solved bugs: + - simplifypolygon.m returned empty polygons when points are repeated, i.e when + the polygon is not correctly formed. + - Removed installation warnings. + +=============================================================================== +geometry-1.4.1 Release Date: 2012-03-24 Release Manager: Juan Pablo Carbajal +=============================================================================== + +* Renamed functions + - Contents.m renamed to geom2d_Contents to avoid clashes. + +* Deprecated functions + - svgload, svgnormalize, svgpath2polygon: Use the methods in class svg. + +* Bug fixes + - @svg/path2polygon.m + - Fix addpath/rmpath installation warnings + - Fix octclip/src/Makefile + - Fix shapecentriod.m for piece-wise polynomial shapes. + +* Known issues + - simplifypolygon.m returns empty polygons when points are repeated, i.e when + the polygon is not correctly formed. + + +=============================================================================== +geometry-1.4.0 Release Date: 2012-01-25 Release Manager: Juan Pablo Carbajal +=============================================================================== + +* Added basic geometric graphs creation and manipulation. + + +=============================================================================== +geometry-1.3.0 Release Date: 2011-11-24 Release Manager: Juan Pablo Carbajal +=============================================================================== + +* Geometry merged with octCLIP. +* Geometry autoloads. + +=============================================================================== +geometry-1.2.2 Release Date: 2011-11-04 Release Manager: Juan Pablo Carbajal +=============================================================================== + +* Improved SVG interface. Thanks to jwe and carandraug. +* Adding files to manipulate and convert 2D shapes defined with smooth + polynomials. + + shape2polygon.m + shapearea.m + shapecentroid.m + shapeplot.m + shapetransform.m + +* Inverted the order in the NEWS file. New entries are on top. + +=============================================================================== +geometry-1.2.1 Release Date: 2011-11-02 Release Manager: Juan Pablo Carbajal +=============================================================================== + +* Adding SVG object and demo for data2geom (converting SVG to msh format) + +=============================================================================== +geometry-1.2.0 Release Date: 2011-10-21 Release Manager: Juan Pablo Carbajal +=============================================================================== + +* All geom2d added + createCircle.m + createDirectedCircle.m + createEdge.m + medianLine.m + Contents.m + bisector.m + cartesianLine.m + drawArrow.m + edges2d.m + lines2d.m + orthogonalLine.m + parallelLine.m + projPointOnLine.m + drawCenteredEdge.m + drawCircle.m + drawCircleArc.m + drawEllipse.m + drawEllipseArc.m + drawLabels.m + drawOrientedBox.m + drawParabola.m + drawRect.m + drawShape.m + circles2d.m + ellipses2d.m + createVector.m + inertiaEllipse.m + changelog.txt + readme.txt + hexagonalGrid.m + squareGrid.m + triangleGrid.m + intersectCircles.m + intersectEdges.m + intersectLineCircle.m + isLeftOriented.m + isPointInCircle.m + isPointInEllipse.m + isPointOnCircle.m + isPointOnLine.m + edgeLength.m + edgePosition.m + edgeToLine.m + circleArcAsCurve.m + circleAsPolygon.m + crackPattern.m + crackPattern2.m + distancePointEdge.m + distancePointLine.m + ellipseAsPolygon.m + enclosingCircle.m + radicalAxis.m + reverseEdge.m + reverseLine.m + +=============================================================================== +geometry-1.1.3 Release Date: 2011-10-13 Release Manager: Juan Pablo Carbajal +=============================================================================== + +* Continue to add geom2d from matGeom (transforms and points2d) + createBasisTransform.m + createHomothecy.m + createLineReflection.m + createRotation.m + createScaling.m + createTranslation.m + transformPoint.m + transforms2d.m + fitAffineTransform2d.m + transformEdge.m + transformLine.m + centroid.m + distancePoints.m + midPoint.m + polarPoint.m + drawPoint.m + isCounterClockwise.m + minDistancePoints.m + pointOnLine.m + points2d.m + intersectLineEdge.m + isPointOnEdge.m + +=============================================================================== +geometry-1.1.2 Release Date: 2011-10-09 Release Manager: Juan Pablo Carbajal +=============================================================================== + +* Continue to add geom2d from matGeom (rays and vectors) + createRay.m + drawEdge.m + drawRay.m + isParallel.m + isPerpendicular.m + isPointOnRay.m + normalizeVector.m + rays2d.m + rotateVector.m + transformVector.m + vectorNorm.m + vectors2d.m + +=============================================================================== +geometry-1.1.1 Release Date: 2011-10-06 Release Manager: Juan Pablo Carbajal +=============================================================================== + +* Continue to add geom2d from matGeom (boxes and clips) + cbezier2poly.m + boxes2d.m + clipEdge.m + clipLine.m + clipPoints.m + drawBezierCurve.m + drawBox.m + clipRay.m + intersectBoxes.m + intersectLines.m + linePosition.m + mergeBoxes.m + randomPointInBox.m + drawLine.m + +=============================================================================== +geometry-1.1.0 Release Date: 2011-10-04 Release Manager: Juan Pablo Carbajal +=============================================================================== + +* Starting to add geom2d from matGeom + angle2Points.m + angle3Points.m + angleAbsDiff.m + angleDiff.m + angles2d.m + angleSort.m + createLine.m + deg2rad.m + edgeAngle.m + lineAngle.m + normalizeAngle.m + rad2deg.m + vectorAngle.m + +=============================================================================== +geometry-1.0.1 Release Date: 2011-09-27 Release Manager: Juan Pablo Carbajal +=============================================================================== + +Improvements to the docstrings of all functions. + +=============================================================================== +geometry-1.0.0 Release Date: 2011-09-26 Release Manager: Juan Pablo Carbajal +=============================================================================== + +** First official release. + +=============================================================================== diff --git a/octave_packages/geometry-1.5.0/polygons2d/curvature.m b/octave_packages/geometry-1.5.0/polygons2d/curvature.m new file mode 100644 index 0000000..e14b14c --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/curvature.m @@ -0,0 +1,177 @@ +%% Copyright (C) 2003-2011 David Legland +%% Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +%% All rights reserved. +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1 Redistributions of source code must retain the above copyright notice, +%% this list of conditions and the following disclaimer. +%% 2 Redistributions in binary form must reproduce the above copyright +%% notice, this list of conditions and the following disclaimer in the +%% documentation and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +%% ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +%% SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +%% OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of the copyright holders. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{kappa} = } curvature (@var{t}, @var{px}, @var{py},@var{method},@var{degree}) +%% @deftypefnx {Function File} {@var{kappa} = } curvature (@var{t}, @var{poly},@var{method},@var{degree}) +%% @deftypefnx {Function File} {@var{kappa} = } curvature (@var{px}, @var{py},@var{method},@var{degree}) +%% @deftypefnx {Function File} {@var{kappa} = } curvature (@var{points},@var{method},@var{degree}) +%% @deftypefnx {Function File} {[@var{kappa} @var{poly} @var{t}] = } curvature (@dots{}) +%% Estimate curvature of a polyline defined by points. +%% +%% First compute an approximation of the curve given by PX and PY, with +%% the parametrization @var{t}. Then compute the curvature of approximated curve +%% for each point. +%% @var{method} used for approximation can be only: 'polynom', with specified degree. +%% Further methods will be provided in a future version. +%% @var{t}, @var{px}, and @var{py} are N-by-1 array of the same length. The points +%% can be specified as a single N-by-2 array. +%% +%% If the argument @var{t} is not given, the parametrization is estimated using +%% function @code{parametrize}. +%% +%% If requested, @var{poly} contains the approximating polygon evlauted at the +%% parametrization @var{t}. +%% +%% @seealso{parametrize, polygons2d} +%% @end deftypefn + +function [kappa, varargout] = curvature(varargin) + + % default values + degree = 5; + t=0; % parametrization of curve + tc=0; % indices of points wished for curvature + + + % ================================================================= + + % Extract method and degree ------------------------------ + + nargin = length(varargin); + varN = varargin{nargin}; + varN2 = varargin{nargin-1}; + + if ischar(varN2) + % method and degree are specified + method = varN2; + degree = varN; + varargin = varargin(1:nargin-2); + elseif ischar(varN) + % only method is specified, use degree 6 as default + method = varN; + varargin = varargin{1:nargin-1}; + else + % method and degree are implicit : use 'polynom' and 6 + method = 'polynom'; + end + + % extract input parametrization and curve. ----------------------- + nargin = length(varargin); + if nargin==1 + % parameters are just the points -> compute caracterization. + var = varargin{1}; + px = var(:,1); + py = var(:,2); + elseif nargin==2 + var = varargin{2}; + if size(var, 2)==2 + % parameters are t and POINTS + px = var(:,1); + py = var(:,2); + t = varargin{1}; + else + % parameters are px and py + px = varargin{1}; + py = var; + end + elseif nargin==3 + var = varargin{2}; + if size(var, 2)==2 + % parameters are t, POINTS, and tc + px = var(:,1); + py = var(:,2); + t = varargin{1}; + else + % parameters are t, px and py + t = varargin{1}; + px = var; + py = varargin{3}; + end + elseif nargin==4 + % parameters are t, px, py and tc + t = varargin{1}; + px = varargin{2}; + py = varargin{3}; + tc = varargin{4}; + end + + % compute implicit parameters -------------------------- + + % if t and/or tc are not computed, use implicit definition + if t==0 + t = parametrize(px, py, 'norm'); + end + + % if tc not defined, compute curvature for all points + if tc==0 + tc = t; + else + % else convert from indices to parametrization values + tc = t(tc); + end + + + % ================================================================= + % compute curvature for each point of the curve + + if strcmp(method, 'polynom') + % compute coefficients of interpolation functions + x0 = polyfit(t, px, degree); + y0 = polyfit(t, py, degree); + + % compute coefficients of first and second derivatives. In the case of a + % polynom, it is possible to compute coefficient of derivative by + % multiplying with a matrix. + derive = diag(degree:-1:0); + xp = circshift(x0*derive, [0 1]); + yp = circshift(y0*derive, [0 1]); + xs = circshift(xp*derive, [0 1]); + ys = circshift(yp*derive, [0 1]); + + % compute values of first and second derivatives for needed points + xprime = polyval(xp, tc); + yprime = polyval(yp, tc); + xsec = polyval(xs, tc); + ysec = polyval(ys, tc); + + % compute value of curvature + kappa = (xprime.*ysec - xsec.*yprime)./ ... + power(xprime.*xprime + yprime.*yprime, 3/2); + + if nargout > 1 + varargout{1} = [polyval(x0,tc(:)) polyval(y0,tc(:))]; + if nargout > 2 + varargout{2} = tc; + end + end + else + error('unknown method'); + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/distancePointPolygon.m b/octave_packages/geometry-1.5.0/polygons2d/distancePointPolygon.m new file mode 100644 index 0000000..6290b91 --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/distancePointPolygon.m @@ -0,0 +1,51 @@ +%% Copyright (C) 2003-2011 David Legland +%% Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +%% All rights reserved. +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1 Redistributions of source code must retain the above copyright notice, +%% this list of conditions and the following disclaimer. +%% 2 Redistributions in binary form must reproduce the above copyright +%% notice, this list of conditions and the following disclaimer in the +%% documentation and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +%% ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +%% SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +%% OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of the copyright holders. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{dist} = } distancePointPolygon (@var{point},@var{poly}) +## Compute shortest distance between a point and a polygon +## +## @seealso{polygons2d, points2d, distancePointPolyline, distancePointEdge, projPointOnPolyline} +## @end deftypefn + +function varargout = distancePointPolygon(point, poly) + + % eventually copy first point at the end to ensure closed polygon + if sum(poly(end, :)==poly(1,:))~=2 + poly = [poly; poly(1,:)]; + end + + % call to distancePointPolyline + minDist = distancePointPolyline(point, poly); + + % process output arguments + if nargout<=1 + varargout{1} = minDist; + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/distancePointPolyline.m b/octave_packages/geometry-1.5.0/polygons2d/distancePointPolyline.m new file mode 100644 index 0000000..c4fcd4a --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/distancePointPolyline.m @@ -0,0 +1,71 @@ +## Copyright (C) 2003-2011 David Legland +## Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions are met: +## +## 1 Redistributions of source code must retain the above copyright notice, +## this list of conditions and the following disclaimer. +## 2 Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## +## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +## +## The views and conclusions contained in the software and documentation are +## those of the authors and should not be interpreted as representing official +## policies, either expressed or implied, of the copyright holders. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{dist} = } distancePointPolyline (@var{point},@var{poly}) +## Compute shortest distance between a point and a polyline +## Example: +## @example +## pt1 = [30 20]; +## pt2 = [30 5]; +## poly = [10 10;50 10;50 50;10 50]; +## distancePointPolyline([pt1;pt2], poly) +## ans = +## 10 +## 5 +## @end example +## +## @seealso{polygons2d, points2d,distancePointEdge, projPointOnPolyline} +## @end deftypefn + +function varargout = distancePointPolyline(point, poly, varargin) + + # number of points + Np = size(point, 1); + + # allocate memory for result + minDist = inf * ones(Np, 1); + + # process each point + for p = 1:Np + # construct the set of edges + edges = [poly(1:end-1, :) poly(2:end, :)]; + + # compute distance between current each point and all edges + dist = distancePointEdge(point(p, :), edges); + + # update distance if necessary + minDist(p) = min(dist); + end + + # process output arguments + if nargout<=1 + varargout{1} = minDist; + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/distancePolygons.m b/octave_packages/geometry-1.5.0/polygons2d/distancePolygons.m new file mode 100644 index 0000000..53dfc9b --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/distancePolygons.m @@ -0,0 +1,43 @@ +## Copyright (C) 2003-2011 David Legland +## Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions are met: +## +## 1 Redistributions of source code must retain the above copyright notice, +## this list of conditions and the following disclaimer. +## 2 Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## +## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +## +## The views and conclusions contained in the software and documentation are +## those of the authors and should not be interpreted as representing official +## policies, either expressed or implied, of the copyright holders. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{dist} = } distancePolygons (@var{poly1},@var{poly2}) +## Compute the shortest distance between 2 polygons +## +## @end deftypefn +function dist = distancePolygons(poly1, poly2) + + # compute distance of each vertex of a polygon to the other polygon + dist1 = min(distancePointPolygon(poly1, poly2)); + dist2 = min(distancePointPolygon(poly2, poly1)); + + # keep the minimum of the two distances + dist = min(dist1, dist2); + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/doc-cache b/octave_packages/geometry-1.5.0/polygons2d/doc-cache new file mode 100644 index 0000000..4e97b01 --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/doc-cache @@ -0,0 +1,883 @@ +# Created by Octave 3.6.2, Sun Jun 10 09:53:40 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 19 +# name: +# type: sq_string +# elements: 1 +# length: 9 +curvature + + +# name: +# type: sq_string +# elements: 1 +# length: 1038 + -- Function File: KAPPA = curvature (T, PX, PY,METHOD,DEGREE) + -- Function File: KAPPA = curvature (T, POLY,METHOD,DEGREE) + -- Function File: KAPPA = curvature (PX, PY,METHOD,DEGREE) + -- Function File: KAPPA = curvature (POINTS,METHOD,DEGREE) + -- Function File: [KAPPA POLY T] = curvature (...) + Estimate curvature of a polyline defined by points. + + First compute an approximation of the curve given by PX and PY, + with the parametrization T. Then compute the curvature of + approximated curve for each point. METHOD used for approximation + can be only: 'polynom', with specified degree. Further methods + will be provided in a future version. T, PX, and PY are N-by-1 + array of the same length. The points can be specified as a single + N-by-2 array. + + If the argument T is not given, the parametrization is estimated + using function `parametrize'. + + If requested, POLY contains the approximating polygon evlauted at + the parametrization T. + + See also: parametrize, polygons2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Estimate curvature of a polyline defined by points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +distancePointPolygon + + +# name: +# type: sq_string +# elements: 1 +# length: 229 + -- Function File: DIST = distancePointPolygon (POINT,POLY) + Compute shortest distance between a point and a polygon + + See also: polygons2d, points2d, distancePointPolyline, + distancePointEdge, projPointOnPolyline + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 +Compute shortest distance between a point and a polygon + + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +distancePointPolyline + + +# name: +# type: sq_string +# elements: 1 +# length: 453 + -- Function File: DIST = distancePointPolyline (POINT,POLY) + Compute shortest distance between a point and a polyline Example: + pt1 = [30 20]; + pt2 = [30 5]; + poly = [10 10;50 10;50 50;10 50]; + distancePointPolyline([pt1;pt2], poly) + ans = + 10 + 5 + + See also: polygons2d, points2d, distancePointEdge, + projPointOnPolyline + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute shortest distance between a point and a polyline Example: + p + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +distancePolygons + + +# name: +# type: sq_string +# elements: 1 +# length: 114 + -- Function File: DIST = distancePolygons (POLY1,POLY2) + Compute the shortest distance between 2 polygons + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Compute the shortest distance between 2 polygons + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +drawPolygon + + +# name: +# type: sq_string +# elements: 1 +# length: 589 + -- Function File: H = drawPolygon (COORD) + -- Function File: H = drawPolygon (PX, PY) + -- Function File: H = drawPolygon (POLYS) + Draw a polygon specified by a list of points. + + drawPolygon(COORD); Packs coordinates in a single [N*2] array. + + drawPolygon(PX, PY); Specifies coordinates in separate arrays. + + drawPolygon(POLYS) Packs coordinate of several polygons in a + cell array. Each element of the array is a Ni*2 double array. + + H = drawPolygon(...); Also return a handle to the list of line + objects. + + See also: polygons2d, drawCurve + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Draw a polygon specified by a list of points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +expandPolygon + + +# name: +# type: sq_string +# elements: 1 +# length: 930 + -- Function File: LOOPS = expandPolygon (POLY, DIST) + Expand a polygon by a given (signed) distance + + Associates to each edge of the polygon POLY the parallel line + located at distance DIST from the current edge, and compute + intersections with neighbor parallel lines. The resulting + polygon is simplified to remove inner "loops", and can be + disconnected. The result is a cell array, each cell containing + a simple linear ring. + + This is a kind of dilation, but behaviour on corners is different. + This function keeps angles of polygons, but there is no direct + relation between length of 2 polygons. + + It is also possible to specify negative distance, and get all + points inside the polygon. If the polygon is convex, the result + equals morphological erosion of polygon by a ball with radius + equal to the given distance. + + See also: polygons2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Expand a polygon by a given (signed) distance + + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +medialAxisConvex + + +# name: +# type: sq_string +# elements: 1 +# length: 878 + -- Function File: [N E] = medialAxisConvex (POLYGON) + Compute medial axis of a convex polygon + + POLYGON is given as a set of points [x1 y1;x2 y2 ...], returns + the medial axis of the polygon as a graph. N is a set of nodes. + The first elements of N are the vertices of the original polygon. + E is a set of edges, containing indices of source and target + nodes. Edges are sorted according to order of creation. Index + of first vertex is lower than index of last vertex, i.e. edges + always point to newly created nodes. + + Notes: - Is not fully implemented, need more development + (usually crashes for polygons with more than 6-7 points...) + - Works only for convex polygons. - Complexity is not optimal: + this algorithm is O(n*log n), but linear algorithms exist. + + See also: polygons2d, bisector + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Compute medial axis of a convex polygon + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +parametrize + + +# name: +# type: sq_string +# elements: 1 +# length: 1240 + -- Function File: PAR = parametrize (POLY) + -- Function File: PAR = parametrize (PX,PY) + -- Function File: PAR = parametrize (...,NORMALIZE) + Parametrization of a curve, based on edges length + + Returns a parametrization of the curve defined by the serie of + points, based on euclidean distance between two consecutive points. + POLY is a N-by-2 array, representing coordinates of vertices. The + result PAR is N-by-1, and contains the cumulative length of edges + until corresponding vertex. The function also accepts the polygon + as two inputs PX and PY representinx coordinates x and y + respectively. When optional argument NORMALIZE is non-empty PAR + is rescaled such that the last element equals 1, i.e. + `PAR(end)==1'. + + Example + % Parametrize a circle approximation + poly = circleToPolygon([0 0 1], 200); + p = parametrize(poly); + p(end) + ans = + 6.2829 + p = parametrize(poly,'norm'); + p(end) + ans = + 1 + p = parametrize(poly,true); + p(end) + ans = + 1 + + See also: polygons2d, polylineLength + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Parametrization of a curve, based on edges length + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +polygon2shape + + +# name: +# type: sq_string +# elements: 1 +# length: 544 + -- Function File: SHAPE = polygon2shape (POLYGON) + Converts a polygon to a shape with edges defined by smooth + polynomials. + + POLYGON is a N-by-2 matrix, each row representing a vertex. SHAPE + is a N-by-1 cell, where each element is a pair of polynomials + compatible with polyval. + + In its current state, the shape is formed by polynomials of degree + 1. Therefore the shape representation costs more memory except for + colinear points in the polygon. + + See also: shape2polygon, simplifypolygon, polyval + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +Converts a polygon to a shape with edges defined by smooth polynomials. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +polygonLoops + + +# name: +# type: sq_string +# elements: 1 +# length: 647 + -- Function File: LOOPS = polygonLoops (POLY) + Divide a possibly self-intersecting polygon into a set of simple + loops + + POLY is a polygone defined by a series of vertices, LOOPS is a + cell array of polygons, containing the same vertices of the + original polygon, but no loop self-intersect, and no couple of + loops intersect each other. + + Example: + poly = [0 0;0 10;20 10;20 20;10 20;10 0]; + loops = polygonLoops(poly); + figure(1); hold on; + drawPolygon(loops); + polygonArea(loops) + + See also: polygons2d, polygonSelfIntersections + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +Divide a possibly self-intersecting polygon into a set of simple loops + + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +polygonSelfIntersections + + +# name: +# type: sq_string +# elements: 1 +# length: 675 + -- Function File: PTS = polygonSelfIntersections (POLY) + -- Function File: [PTS POS1 POS2] = polygonSelfIntersections (POLY) + Find-self intersection points of a polygon + + Return the position of self intersection points + + Also return the 2 positions of each intersection point (the + position when meeting point for first time, then position when + meeting point for the second time). + + Example + # use a '8'-shaped polygon + poly = [10 0;0 0;0 10;20 10;20 20;10 20]; + polygonSelfIntersections(poly) + ans = + 10 10 + + See also: polygons2d, polylineSelfIntersections + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Find-self intersection points of a polygon + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +polygons2d + + +# name: +# type: sq_string +# elements: 1 +# length: 7637 + -- Function File: polygons2d () + Description of functions operating on 2D polygons + + The 'polygons' module contains functions operating on shapes + composed of a vertex list, like polygons or polylines. + + We call 'polyline' the curve defined by a series of vertices. A + polyline can be either closed or open, depending on whether the + last vertex is connected to the first one or not. This can be + given as an option is some functions in the module. A + 'polygon' is the planar domain delimited by a closed polyline. We + sometimes want to consider 'complex polygons', whose boundary is + composed of several disjoint domains. The domain defined by a + single closed polyline is called 'simple polygon'. We call + 'curve' a polyline with many vertices, such that the polyline + can be considered as a discrete approximation of a "real" curve. + + A simple polygon or polyline is represented by a N-by-2 array, + each row of the array representing the coordinates of a vertex. + Simple polygons are assumed to be closed, so there is no need to + repeat the first vertex at the end. As both polygons and + polylines can be represented by a list of vertex coordinates, + some functions also consider the vertex list itself. Such + functions are prefixed by 'pointSet'. Also, many functions + prefixed by 'polygon' or 'polyline' works also on the other type + of shape. + + For multiple-connected polygons, the different connected + boundaries are separated by a row [NaN NaN]. + + For some functions, the orientation of the polygon can be + relevant: CCW stands for 'Conter-Clockwise' (positive + orientation), CW stands for 'Clockwise'. + + Polylines are parametrized in the following way: * the i-th + vertex is located at position i-1 * points of the i-th edge have + positions ranging linearly from i-1 to i The parametrization + domain for an open polyline is from 0 to Nv-1, and from 0 to Nv + for a closed polyline (positions 0 and Nv correspond to the same + point). + + Example: % Simple polygon: P1 = [1 1;2 1;2 2;1 2]; + drawPolygon(P1); axis([0 5 0 5]); % Multiple polygon: P2 = + [10 10;40 10;40 40;10 40;NaN NaN;20 20;20 30;30 30;30 20]; + figure;drawPolygon(P2); axis([0 50 0 50]); + + Point Sets pointSetBounds - Bounding box of a set of + points pointSetsAverage - Compute the average of + several point sets minimumCaliperDiameter - Minimum caliper + diameter of a set of points findPoint - Find + index of a point in an set from its coordinates + + Polylines polylinePoint - Extract a point from a + polyline polylineLength - Return length of a polyline + given as a list of points polylineCentroid - Compute + centroid of a curve defined by a series of points + polylineSubcurve - Extract a portion of a polyline + reversePolyline - Reverse a polyline, by iterating + vertices from the end isPointOnPolyline - Test if a + point belongs to a polyline projPointOnPolyline - Compute + position of a point projected on a polyline + distancePointPolyline - Compute shortest distance between a + point and a polyline distancePolylines - Compute the + shortest distance between 2 polylines intersectPolylines + - Find the common points between 2 polylines + polylineSelfIntersections - Find self-intersections points of a + polyline + + Curves (polylines with lot of vertices) parametrize + - Parametrization of a curve, based on edges length curvature + - Estimate curvature of a polyline defined by points + cart2geod - Convert cartesian coordinates to + geodesic coord. geod2cart - Convert geodesic + coordinates to cartesian coord. curveMoment - + Compute inertia moment of a 2D curve curveCMoment - + Compute centered inertia moment of a 2D curve curveCSMoment + - Compute centered scaled moment of a 2D curve + + Polygons polygonPoint - Extract a point from a + polygon polygonSubcurve - Extract a portion of a + polygon reversePolygon - Reverse a polygon, by + iterating vertices from the end projPointOnPolygon - + Compute position of a point projected on a polygon splitPolygons + - Convert a NaN separated polygon list to a cell array + of polygons clipPolygon - Clip a polygon with a + rectangular box clipPolygonHP - Clip a polygon with + a Half-plane defined by a directed line intersectLinePolygon + - Intersection points between a line and a polygon + intersectRayPolygon - Intersection points between a ray and + a polygon polygonSelfIntersections - Find-self intersection + points of a polygon convexHull - Convex hull of a + set of points polygonLoops - Divide a possibly + self-intersecting polygon into a set of simple loops + expandPolygon - Expand a polygon by a given (signed) + distance medialAxisConvex - Compute medial axis of a + convex polygon + + Measures on Polygons isPointInPolygon - Test if a point + is located inside a polygon polygonContains - Test if + a point is contained in a multiply connected polygon + polygonCentroid - Compute the centroid (center of mass) + of a polygon polygonArea - Compute the signed area + of a polygon polygonLength - Perimeter of a polygon + polygonNormalAngle - Compute the normal angle at a vertex + of the polygon polygonBounds - Compute the bounding + box of a polygon distancePointPolygon - Compute shortest + distance between a point and a polygon distancePolygons + - Compute the shortest distance between 2 polygons + + Triangles isPointInTriangle - Test if a point is located + inside a triangle triangleArea - Area of a triangle + + Functions from stochastic geometry steinerPoint - + Compute steiner point (weighted centroid) of a polygon + steinerPolygon - Create a Steiner polygon from a set of + vectors supportFunction - Compute support function of + a polygon convexification - Compute the + convexification of a polygon + + Input, Output and conversions readPolygon - Read a + polygon stored in a file polygonToRow - Convert + polygon coordinates to a row vector rowToPolygon - + Create a polygon from a row vector rectAsPolygon - + Convert a (centered) rectangle into a series of points + + Drawing functions drawPolyline - Draw a polyline + specified by a list of points drawPolygon - Draw a + polygon specified by a list of points fillPolygon + - Fill a polygon specified by a list of points + + Credits: * function intersectPolylines uses the 'interX' + contribution from "NS" (file exchange 22441, called + 'curve-intersections') + + ---- Author: David Legland e-mail: david.legland@grignon.inra.fr + created the 07/11/2005. Homepage: + `http://matgeom.sourceforge.net/' + `http://www.pfl-cepia.inra.fr/index.php?page=geom2d' Copyright + INRA - Cepia Software Platform. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Description of functions operating on 2D polygons + + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 +polylineSelfIntersections + + +# name: +# type: sq_string +# elements: 1 +# length: 830 + -- Function File: PTS = polylineSelfIntersections (POLY) + Find self-intersections points of a polyline + + Return the position of self intersection points + + Also return the 2 positions of each intersection point (the + position when meeting point for first time, then position when + meeting point for the second time). + + Example + # use a gamma-shaped polyline + poly = [0 0;0 10;20 10;20 20;10 20;10 0]; + polylineSelfIntersections(poly) + ans = + 10 10 + + # use a 'S'-shaped polyline + poly = [10 0;0 0;0 10;20 10;20 20;10 20]; + polylineSelfIntersections(poly) + ans = + 10 10 + + See also: polygons2d, intersectPolylines, polygonSelfIntersections + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Find self-intersections points of a polyline + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +reversePolygon + + +# name: +# type: sq_string +# elements: 1 +# length: 300 + -- Function File: POLY2 = reversePolygon (POLY) + Reverse a polygon, by iterating vertices from the end + + POLY2 = reversePolygon(POLY) POLY2 has same vertices as POLY, + but in different order. The first vertex of the polygon is still + the same. + + See also: reversePolyline + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Reverse a polygon, by iterating vertices from the end + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +reversePolyline + + +# name: +# type: sq_string +# elements: 1 +# length: 269 + -- Function File: POLY2 = reversePolyline (POLY) + Reverse a polyline, by iterating vertices from the end + + POLY2 = reversePolyline(POLY) POLY2 has same vertices as POLY, + but POLY2(i,:) is the same as POLY(END-i+1,:). + + See also: reversePolygon + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Reverse a polyline, by iterating vertices from the end + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +simplifypolygon + + +# name: +# type: sq_string +# elements: 1 +# length: 231 + -- Function File: SPOLY = simplifypolygon (POLY) + Simplify a polygon using the Ramer-Douglas-Peucker algorithm. + + POLY is a N-by-2 matrix, each row representing a vertex. + + See also: simplifypolyline, shape2polygon + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +Simplify a polygon using the Ramer-Douglas-Peucker algorithm. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +simplifypolyline + + +# name: +# type: sq_string +# elements: 1 +# length: 909 + -- Function File: [PLINE2 IDX] = simplifypolyline (PLINE) + -- Function File: ... = simplifypolyline (...,PROPERTY,VALUE,...) + Simplify or subsample a polyline using the Ramer-Douglas-Peucker + algorithm, a.k.a. the iterative end-point fit algorithm or the + split-and-merge algorithm. + + The PLINE as a N-by-2 matrix. Rows correspond to the verices + (compatible with `polygons2d'). The vector IDX constains the + indexes on vetices in PLINE that generates PLINE2, i.e. `pline2 = + pline(idx,:)'. + + *Parameters* + `'Nmax'' + Maximum number of vertices. Default value `1e3'. + + `'Tol'' + Tolerance for the error criteria. Default value `1e-4'. + + `'MaxIter'' + Maximum number of iterations. Default value `10'. + + `'Method'' + Not implemented. + + Run `demo simplifypolyline' to see an example. + + See also: curve2polyline, curveval + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 78 +Simplify or subsample a polyline using the Ramer-Douglas-Peucker +algorithm, a. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +splitPolygons + + +# name: +# type: sq_string +# elements: 1 +# length: 348 + -- Function File: POLYGONS = splitPolygons (POLYGON) + Convert a NaN separated polygon list to a cell array of polygons. + + POLYGON is a N-by-2 array of points, with possibly couples of NaN + values. The functions separates each component separated by NaN + values, and returns a cell array of polygons. + + See also: polygons2d + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 +Convert a NaN separated polygon list to a cell array of polygons. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +supportFunction + + +# name: +# type: sq_string +# elements: 1 +# length: 522 + -- Function File: H = suppportFunction (POLYGON) + -- Function File: H = suppportFunction (POLYGON, N) + -- Function File: H = suppportFunction (POLYGON, V) + Compute support function of a polygon + + H = supportFunction(POLYGON, N) uses N points for suport + function approximation + + H = supportFunction(POLYGON) assume 24 points for approximation + + H = supportFunction(POLYGON, V) where V is a vector, uses vector + V of angles to compute support function. + + See also: convexification + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Compute support function of a polygon + + + + + + diff --git a/octave_packages/geometry-1.5.0/polygons2d/drawPolygon.m b/octave_packages/geometry-1.5.0/polygons2d/drawPolygon.m new file mode 100644 index 0000000..77714f5 --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/drawPolygon.m @@ -0,0 +1,144 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} = } drawPolygon (@var{coord}) +%% @deftypefnx {Function File} {@var{h} = } drawPolygon (@var{px}, @var{py}) +%% @deftypefnx {Function File} {@var{h} = } drawPolygon (@var{polys}) +%% Draw a polygon specified by a list of points. +%% +%% drawPolygon(COORD); +%% Packs coordinates in a single [N*2] array. +%% +%% drawPolygon(PX, PY); +%% Specifies coordinates in separate arrays. +%% +%% drawPolygon(POLYS) +%% Packs coordinate of several polygons in a cell array. Each element of +%% the array is a Ni*2 double array. +%% +%% H = drawPolygon(...); +%% Also return a handle to the list of line objects. +%% +%% +%% @seealso{polygons2d, drawCurve} +%% @end deftypefn + +function varargout = drawPolygon(varargin) + + % check input + if isempty(varargin) + error('need to specify a polygon'); + end + + var = varargin{1}; + + %% Manage cell arrays of polygons + + % case of a set of polygons stored in a cell array + if iscell(var) + N = length(var); + h = zeros(N, 1); + for i = 1:N + state = ishold(gca); + hold on; + % check for empty polygons + if ~isempty(var{i}) + h(i) = drawPolygon(var{i}, varargin{2:end}); + end + if ~state + hold off + end + end + + if nargout > 0 + varargout = {h}; + end + + return; + end + + + %% Parse coordinates and options + + % Extract coordinates of polygon vertices + if size(var, 2) > 1 + % first argument is a polygon array + px = var(:, 1); + py = var(:, 2); + varargin(1) = []; + else + % arguments 1 and 2 correspond to x and y coordinate respectively + if length(varargin) < 2 + error('Should specify either a N-by-2 array, or 2 N-by-1 vectors'); + end + + px = varargin{1}; + py = varargin{2}; + varargin(1:2) = []; + end + + % set default line format + if isempty(varargin) + varargin = {'b-'}; + end + + % check case of polygons with holes + if sum(isnan(px(:))) > 0 + polygons = splitPolygons([px py]); + h = drawPolygon(polygons); + + if nargout > 0 + varargout = {h}; + end + + return; + end + + + %% Draw the polygon + + % ensure last point is the same as the first one + px(size(px, 1)+1, :) = px(1,:); + py(size(py, 1)+1, :) = py(1,:); + + % draw the polygon outline + h = plot(px, py, varargin{:}); + + % format output arg + if nargout > 0 + varargout = {h}; + end + +endfunction + diff --git a/octave_packages/geometry-1.5.0/polygons2d/expandPolygon.m b/octave_packages/geometry-1.5.0/polygons2d/expandPolygon.m new file mode 100644 index 0000000..d009454 --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/expandPolygon.m @@ -0,0 +1,85 @@ +## Copyright (C) 2003-2011 David Legland +## Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions are met: +## +## 1 Redistributions of source code must retain the above copyright notice, +## this list of conditions and the following disclaimer. +## 2 Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## +## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +## +## The views and conclusions contained in the software and documentation are +## those of the authors and should not be interpreted as representing official +## policies, either expressed or implied, of the copyright holders. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{loops} = } expandPolygon (@var{poly}, @var{dist}) +## Expand a polygon by a given (signed) distance +## +## Associates to each edge of the polygon @var{poly} the parallel line located +## at distance @var{dist} from the current edge, and compute intersections with +## neighbor parallel lines. The resulting polygon is simplified to remove +## inner "loops", and can be disconnected. +## The result is a cell array, each cell containing a simple linear ring. +## +## This is a kind of dilation, but behaviour on corners is different. +## This function keeps angles of polygons, but there is no direct relation +## between length of 2 polygons. +## +## It is also possible to specify negative distance, and get all points +## inside the polygon. If the polygon is convex, the result equals +## morphological erosion of polygon by a ball with radius equal to the +## given distance. +## +## @seealso{polygons2d} +## @end deftypefn + +function loops = expandPolygon(poly, dist) + + # eventually copy first point at the end to ensure closed polygon + if sum(poly(end, :)==poly(1,:))~=2 + poly = [poly; poly(1,:)]; + end + + # number of vertices of the polygon + N = size(poly, 1)-1; + + # find lines parallel to polygon edges located at distance DIST + lines = zeros(N, 4); + for i=1:N + side = createLine(poly(i,:), poly(i+1,:)); + lines(i, 1:4) = parallelLine(side, dist); + end + + # compute intersection points of consecutive lines + lines = [lines;lines(1,:)]; + poly2 = zeros(N, 2); + for i=1:N + poly2(i,1:2) = intersectLines(lines(i,:), lines(i+1,:)); + end + + # split result polygon into set of loops (simple polygons) + loops = polygonLoops(poly2); + + # keep only loops whose distance to original polygon is correct + distLoop = zeros(length(loops), 1); + for i=1:length(loops) + distLoop(i) = distancePolygons(loops{i}, poly); + end + loops = loops(abs(distLoop-abs(dist)) +## Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions are met: +## +## 1 Redistributions of source code must retain the above copyright notice, +## this list of conditions and the following disclaimer. +## 2 Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## +## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +## +## The views and conclusions contained in the software and documentation are +## those of the authors and should not be interpreted as representing official +## policies, either expressed or implied, of the copyright holders. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{n} @var{e}] = } medialAxisConvex (@var{polygon}) +## Compute medial axis of a convex polygon +## +## @var{polygon} is given as a set of points [x1 y1;x2 y2 ...], returns +## the medial axis of the polygon as a graph. +## @var{n} is a set of nodes. The first elements of @var{n} are the vertices of the +## original polygon. +## @var{e} is a set of edges, containing indices of source and target nodes. +## Edges are sorted according to order of creation. Index of first vertex +## is lower than index of last vertex, i.e. edges always point to newly +## created nodes. +## +## Notes: +## - Is not fully implemented, need more development (usually crashes for +## polygons with more than 6-7 points...) +## - Works only for convex polygons. +## - Complexity is not optimal: this algorithm is O(n*log n), but linear +## algorithms exist. +## +## @seealso{polygons2d, bisector} +## @end deftypefn + +function [nodes, edges] = medialAxisConvex(points) + + # eventually remove the last point if it is the same as the first one + if points(1,:) == points(end, :) + nodes = points(1:end-1, :); + else + nodes = points; + end + + # special case of triangles: + # compute directly the gravity center, and simplify computation. + if size(nodes, 1)==3 + nodes = [nodes; mean(nodes, 1)]; + edges = [1 4;2 4;3 4]; + return + end + + # number of nodes, and also of initial rays + N = size(nodes, 1); + + # create ray of each vertex + rays = zeros(N, 4); + rays(1, 1:4) = bisector(nodes([2 1 N], :)); + rays(N, 1:4) = bisector(nodes([1 N N-1], :)); + for i=2:N-1 + rays(i, 1:4) = bisector(nodes([i+1, i, i-1], :)); + end + + # add indices of edges producing rays (indices of first vertex, second + # vertex is obtained by adding one modulo N). + rayEdges = [[N (1:N-1)]' (1:N)']; + + pint = intersectLines(rays, rays([2:N 1], :)); + #ti = linePosition(pint, rays); + #ti = min(linePosition(pint, rays), linePosition(pint, rays([2:N 1], :))); + ti = distancePointLine(pint, ... + createLine(points([N (1:N-1)]', :), points((1:N)', :))); + + # create list of events. + # terms are : R1 R2 X Y t0 + # R1 and R2 are indices of involved rays + # X and Y is coordinate of intersection point + # t0 is position of point on rays + events = sortrows([ (1:N)' [2:N 1]' pint ti], 5); + + # initialize edges + edges = zeros(0, 2); + + + # ------------------- + # process each event until there is no more + + # start after index of last vertex, and process N-3 intermediate rays + for i=N+1:2*N-3 + # add new node at the rays intersection + nodes(i,:) = events(1, 3:4); + + # add new couple of edges + edges = [edges; events(1,1) i; events(1,2) i]; + + # find the two edges creating the new emanating ray + n1 = rayEdges(events(1, 1), 1); + n2 = rayEdges(events(1, 2), 2); + + # create the new ray + line1 = createLine(nodes(n1, :), nodes(mod(n1,N)+1, :)); + line2 = createLine(nodes(mod(n2,N)+1, :), nodes(n2, :)); + ray0 = bisector(line1, line2); + + # set its origin to emanating point + ray0(1:2) = nodes(i, :); + + # add the new ray to the list + rays = [rays; ray0]; + rayEdges(size(rayEdges, 1)+1, 1:2) = [n1 n2]; + + # find the two neighbour rays + ind = sum(ismember(events(:,1:2), events(1, 1:2)), 2)==0; + ir = unique(events(ind, 1:2)); + ir = ir(~ismember(ir, events(1,1:2))); + + # create new intersections + pint = intersectLines(ray0, rays(ir, :)); + #ti = min(linePosition(pint, ray0), linePosition(pint, rays(ir, :))) + events(1,5); + ti = distancePointLine(pint, line1); + + # remove all events involving old intersected rays + ind = sum(ismember(events(:,1:2), events(1, 1:2)), 2)==0; + events = events(ind, :); + + # add the newly formed events + events = [events; ir(1) i pint(1,:) ti(1); ir(2) i pint(2,:) ti(2)]; + + # and sort them according to 'position' parameter + events = sortrows(events, 5); + end + + # centroid computation for last 3 rays + nodes = [nodes; mean(events(:, 3:4))]; + edges = [edges; [unique(events(:,1:2)) ones(3, 1)*(2*N-2)]]; + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/parametrize.m b/octave_packages/geometry-1.5.0/polygons2d/parametrize.m new file mode 100644 index 0000000..0e36196 --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/parametrize.m @@ -0,0 +1,96 @@ +%% Copyright (C) 2003-2011 David Legland +%% Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +%% All rights reserved. +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1 Redistributions of source code must retain the above copyright notice, +%% this list of conditions and the following disclaimer. +%% 2 Redistributions in binary form must reproduce the above copyright +%% notice, this list of conditions and the following disclaimer in the +%% documentation and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +%% ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +%% SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +%% OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of the copyright holders. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{par} = } parametrize (@var{poly}) +%% @deftypefnx {Function File} {@var{par} = } parametrize (@var{px},@var{py}) +%% @deftypefnx {Function File} {@var{par} = } parametrize (@dots{},@var{normalize}) +%% +%% Parametrization of a curve, based on edges length +%% +%% Returns a parametrization of the curve defined by the serie of points, +%% based on euclidean distance between two consecutive points. +%% POLY is a N-by-2 array, representing coordinates of vertices. The +%% result PAR is N-by-1, and contains the cumulative length of edges until +%% corresponding vertex. The function also accepts the polygon as two inputs +%% @var{px} and @var{py} representinx coordinates x and y respectively. +%% When optional argument @var{normalize} is non-empty @var{par} is rescaled +%% such that the last element equals 1, i.e. @code{@var{par}(end)==1}. +%% +%% Example +%% @example +%% % Parametrize a circle approximation +%% poly = circleToPolygon([0 0 1], 200); +%% p = parametrize(poly); +%% p(end) +%% ans = +%% 6.2829 +%% p = parametrize(poly,'norm'); +%% p(end) +%% ans = +%% 1 +%% p = parametrize(poly,true); +%% p(end) +%% ans = +%% 1 +%% @end example +%% +%% @seealso{polygons2d, polylineLength} +%% @end deftypefn +function par = parametrize(varargin) + %% Process inputs + + % extract vertex coordinates + if size(varargin{1}, 2) > 1 + % vertices in a single array + pts = varargin{1}; + normalize = numel(varargin) > 1; + elseif size(varargin{1}, 2) == 1 && numel(varargin) >= 2 + % points as separate arrays + pts = [varargin{1} varargin{2}]; + normalize = numel(varargin) > 2; + end + + %% Parametrize polyline + + % compute cumulative sum of euclidean distances between consecutive + % vertices, setting distance of first vertex to 0. + if size(pts, 2) == 2 + % process points in 2D + par = [0 ; cumsum(hypot(diff(pts(:,1)), diff(pts(:,2))))]; + else + % process points in arbitrary dimension + par = [0 ; cumsum(sqrt(sum(diff(pts).^2, 2)))]; + end + + % eventually rescale between 0 and 1 + if normalize + par = par / par(end); + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/polygon2shape.m b/octave_packages/geometry-1.5.0/polygons2d/polygon2shape.m new file mode 100644 index 0000000..c9338b3 --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/polygon2shape.m @@ -0,0 +1,54 @@ +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR 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{shape} = } polygon2shape (@var{polygon}) +%% Converts a polygon to a shape with edges defined by smooth polynomials. +%% +%% @var{polygon} is a N-by-2 matrix, each row representing a vertex. +%% @var{shape} is a N-by-1 cell, where each element is a pair of polynomials +%% compatible with polyval. +%% +%% In its current state, the shape is formed by polynomials of degree 1. Therefore +%% the shape representation costs more memory except for colinear points in the +%% polygon. +%% +%% @seealso{shape2polygon, simplifypolygon, polyval} +%% @end deftypefn + +function shape = polygon2shape (polygon) + + # Filter colinear points + polygon = simplifypolygon (polygon); + + np = size(polygon,1); + # polygonal shapes are memory inefficient!! + # TODO filter the regions where edge angles are canging slowly and fit + # polynomial of degree 3; + pp = nan (2*np,2); + + # Transform edges into polynomials of degree 1; + # pp = [(p1-p0) p0]; + pp(:,1) = diff(polygon([1:end 1],:)).'(:); + pp(:,2) = polygon.'(:); + + shape = mat2cell(pp, 2*ones (1,np), 2); + +endfunction + +%!test +%! pp = [0 0; 1 0; 1 1; 0 1]; +%! s = polygon2shape (pp); + diff --git a/octave_packages/geometry-1.5.0/polygons2d/polygonLoops.m b/octave_packages/geometry-1.5.0/polygons2d/polygonLoops.m new file mode 100644 index 0000000..e024f6b --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/polygonLoops.m @@ -0,0 +1,143 @@ +## Copyright (C) 2003-2011 David Legland +## Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions are met: +## +## 1 Redistributions of source code must retain the above copyright notice, +## this list of conditions and the following disclaimer. +## 2 Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## +## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +## +## The views and conclusions contained in the software and documentation are +## those of the authors and should not be interpreted as representing official +## policies, either expressed or implied, of the copyright holders. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{loops} = } polygonLoops (@var{poly}) +## Divide a possibly self-intersecting polygon into a set of simple loops +## +## @var{poly} is a polygone defined by a series of vertices, +## @var{loops} is a cell array of polygons, containing the same vertices of the +## original polygon, but no loop self-intersect, and no couple of loops +## intersect each other. +## +## Example: +## @example +## poly = [0 0;0 10;20 10;20 20;10 20;10 0]; +## loops = polygonLoops(poly); +## figure(1); hold on; +## drawPolygon(loops); +## polygonArea(loops) +## @end example +## +## @seealso{polygons2d, polygonSelfIntersections} +## @end deftypefn + +function loops = polygonLoops(poly) + + ## Initialisations + + # compute intersections + [inters pos1 pos2] = polygonSelfIntersections(poly); + + # case of a polygon without self-intersection + if isempty(inters) + loops = {poly}; + return; + end + + # array for storing loops + loops = cell(0, 1); + + positions = sortrows([pos1 pos2;pos2 pos1]); + + + ## First loop + + pos0 = 0; + loop = polygonSubcurve(poly, pos0, positions(1, 1)); + pos = positions(1, 2); + positions(1, :) = []; + + while true + # index of next intersection point + ind = find(positions(:,1)>pos, 1, 'first'); + + # if not found, break + if isempty(ind) + break; + end + + # add portion of curve + loop = [loop;polygonSubcurve(poly, pos, positions(ind, 1))]; ##ok + + # look for next intersection point + pos = positions(ind, 2); + positions(ind, :) = []; + end + + # add the last portion of curve + loop = [loop;polygonSubcurve(poly, pos, pos0)]; + + # remove redundant vertices + loop(sum(loop(1:end-1,:) == loop(2:end,:) ,2)==2, :) = []; + if sum(diff(loop([1 end], :))==0)==2 + loop(end, :) = []; + end + + # add current loop to the list of loops + loops{1} = loop; + + + ## Other loops + + Nl = 1; + while ~isempty(positions) + + loop = []; + pos0 = positions(1, 2); + pos = positions(1, 2); + + while true + # index of next intersection point + ind = find(positions(:,1)>pos, 1, 'first'); + + # add portion of curve + loop = [loop;polygonSubcurve(poly, pos, positions(ind, 1))]; ##ok + + # look for next intersection point + pos = positions(ind, 2); + positions(ind, :) = []; + + # if not found, break + if pos==pos0 + break; + end + end + + # remove redundant vertices + loop(sum(loop(1:end-1,:) == loop(2:end,:) ,2)==2, :) = []; ##ok + if sum(diff(loop([1 end], :))==0)==2 + loop(end, :) = []; ##ok + end + + # add current loop to the list of loops + Nl = Nl + 1; + loops{Nl} = loop; + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/polygonSelfIntersections.m b/octave_packages/geometry-1.5.0/polygons2d/polygonSelfIntersections.m new file mode 100644 index 0000000..ec5f43f --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/polygonSelfIntersections.m @@ -0,0 +1,87 @@ +## Copyright (C) 2003-2011 David Legland +## Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions are met: +## +## 1 Redistributions of source code must retain the above copyright notice, +## this list of conditions and the following disclaimer. +## 2 Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## +## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +## +## The views and conclusions contained in the software and documentation are +## those of the authors and should not be interpreted as representing official +## policies, either expressed or implied, of the copyright holders. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{pts} = } polygonSelfIntersections (@var{poly}) +## @deftypefnx {Function File} {[@var{pts} @var{pos1} @var{pos2}] = } polygonSelfIntersections (@var{poly}) +## Find-self intersection points of a polygon +## +## Return the position of self intersection points +## +## Also return the 2 positions of each intersection point (the position +## when meeting point for first time, then position when meeting point +## for the second time). +## +## Example +## @example +## # use a '8'-shaped polygon +## poly = [10 0;0 0;0 10;20 10;20 20;10 20]; +## polygonSelfIntersections(poly) +## ans = +## 10 10 +## @end example +## +## @seealso{polygons2d, polylineSelfIntersections} +## @end deftypefn + +function varargout = polygonSelfIntersections(poly, varargin) + + tol = 1e-14; + + # ensure the last point equals the first one + if sum(abs(poly(end, :)-poly(1,:)) < tol) ~= 2 + poly = [poly; poly(1,:)]; + end + + # compute intersections by calling algo for polylines + [points pos1 pos2] = polylineSelfIntersections(poly); + + # It may append that first vertex of polygon is detected as intersection, + # the following tries to detect this + n = size(poly, 1) - 1; + inds = (pos1 == 0 & pos2 == n) | (pos1 == n & pos2 == 0); + points(inds, :) = []; + pos1(inds) = []; + pos2(inds) = []; + + # remove multiple intersections + [points I J] = unique(points, 'rows', 'first'); ##ok + pos1 = pos1(I); + pos2 = pos2(I); + + + ## Post-processing + + # process output arguments + if nargout <= 1 + varargout = {points}; + elseif nargout == 3 + varargout = {points, pos1, pos2}; + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/polygons2d.m b/octave_packages/geometry-1.5.0/polygons2d/polygons2d.m new file mode 100644 index 0000000..c551d45 --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/polygons2d.m @@ -0,0 +1,180 @@ +%% Copyright (c) 2011, INRA +%% 2005-2011, David Legland +%% 2011 Adapted to Octave by Juan Pablo Carbajal +%% +%% All rights reserved. +%% (simplified BSD License) +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1. Redistributions of source code must retain the above copyright notice, this +%% list of conditions and the following disclaimer. +%% +%% 2. Redistributions in binary form must reproduce the above copyright notice, +%% this list of conditions and the following disclaimer in the documentation +%% and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +%% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +%% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +%% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +%% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +%% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +%% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +%% POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of copyright holder. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {} polygons2d () +%% Description of functions operating on 2D polygons +%% +%% The 'polygons' module contains functions operating on shapes composed +%% of a vertex list, like polygons or polylines. +%% +%% We call 'polyline' the curve defined by a series of vertices. +%% A polyline can be either closed or open, depending on whether the last +%% vertex is connected to the first one or not. This can be given as an +%% option is some functions in the module. +%% A 'polygon' is the planar domain delimited by a closed polyline. We +%% sometimes want to consider 'complex polygons', whose boundary is +%% composed of several disjoint domains. The domain defined by a single +%% closed polyline is called 'simple polygon'. +%% We call 'curve' a polyline with many vertices, such that the polyline +%% can be considered as a discrete approximation of a "real" curve. +%% +%% A simple polygon or polyline is represented by a N-by-2 array, each row +%% of the array representing the coordinates of a vertex. +%% Simple polygons are assumed to be closed, so there is no need to repeat +%% the first vertex at the end. +%% As both polygons and polylines can be represented by a list of vertex +%% coordinates, some functions also consider the vertex list itself. Such +%% functions are prefixed by 'pointSet'. Also, many functions prefixed by +%% 'polygon' or 'polyline' works also on the other type of shape. +%% +%% For multiple-connected polygons, the different connected boundaries are +%% separated by a row [NaN NaN]. +%% +%% For some functions, the orientation of the polygon can be relevant: CCW +%% stands for 'Conter-Clockwise' (positive orientation), CW stands for +%% 'Clockwise'. +%% +%% Polylines are parametrized in the following way: +%% * the i-th vertex is located at position i-1 +%% * points of the i-th edge have positions ranging linearly from i-1 to i +%% The parametrization domain for an open polyline is from 0 to Nv-1, and +%% from 0 to Nv for a closed polyline (positions 0 and Nv correspond to +%% the same point). +%% +%% Example: +%% % Simple polygon: +%% P1 = [1 1;2 1;2 2;1 2]; +%% drawPolygon(P1); +%% axis([0 5 0 5]); +%% % Multiple polygon: +%% P2 = [10 10;40 10;40 40;10 40;NaN NaN;20 20;20 30;30 30;30 20]; +%% figure;drawPolygon(P2); axis([0 50 0 50]); +%% +%% +%% Point Sets +%% pointSetBounds - Bounding box of a set of points +%% pointSetsAverage - Compute the average of several point sets +%% minimumCaliperDiameter - Minimum caliper diameter of a set of points +%% findPoint - Find index of a point in an set from its coordinates +%% +%% Polylines +%% polylinePoint - Extract a point from a polyline +%% polylineLength - Return length of a polyline given as a list of points +%% polylineCentroid - Compute centroid of a curve defined by a series of points +%% polylineSubcurve - Extract a portion of a polyline +%% reversePolyline - Reverse a polyline, by iterating vertices from the end +%% isPointOnPolyline - Test if a point belongs to a polyline +%% projPointOnPolyline - Compute position of a point projected on a polyline +%% distancePointPolyline - Compute shortest distance between a point and a polyline +%% distancePolylines - Compute the shortest distance between 2 polylines +%% intersectPolylines - Find the common points between 2 polylines +%% polylineSelfIntersections - Find self-intersections points of a polyline +%% +%% Curves (polylines with lot of vertices) +%% parametrize - Parametrization of a curve, based on edges length +%% curvature - Estimate curvature of a polyline defined by points +%% cart2geod - Convert cartesian coordinates to geodesic coord. +%% geod2cart - Convert geodesic coordinates to cartesian coord. +%% curveMoment - Compute inertia moment of a 2D curve +%% curveCMoment - Compute centered inertia moment of a 2D curve +%% curveCSMoment - Compute centered scaled moment of a 2D curve +%% +%% Polygons +%% polygonPoint - Extract a point from a polygon +%% polygonSubcurve - Extract a portion of a polygon +%% reversePolygon - Reverse a polygon, by iterating vertices from the end +%% projPointOnPolygon - Compute position of a point projected on a polygon +%% splitPolygons - Convert a NaN separated polygon list to a cell array of polygons +%% clipPolygon - Clip a polygon with a rectangular box +%% clipPolygonHP - Clip a polygon with a Half-plane defined by a directed line +%% intersectLinePolygon - Intersection points between a line and a polygon +%% intersectRayPolygon - Intersection points between a ray and a polygon +%% polygonSelfIntersections - Find-self intersection points of a polygon +%% convexHull - Convex hull of a set of points +%% polygonLoops - Divide a possibly self-intersecting polygon into a set of simple loops +%% expandPolygon - Expand a polygon by a given (signed) distance +%% medialAxisConvex - Compute medial axis of a convex polygon +%% +%% Measures on Polygons +%% isPointInPolygon - Test if a point is located inside a polygon +%% polygonContains - Test if a point is contained in a multiply connected polygon +%% polygonCentroid - Compute the centroid (center of mass) of a polygon +%% polygonArea - Compute the signed area of a polygon +%% polygonLength - Perimeter of a polygon +%% polygonNormalAngle - Compute the normal angle at a vertex of the polygon +%% polygonBounds - Compute the bounding box of a polygon +%% distancePointPolygon - Compute shortest distance between a point and a polygon +%% distancePolygons - Compute the shortest distance between 2 polygons +%% +%% Triangles +%% isPointInTriangle - Test if a point is located inside a triangle +%% triangleArea - Area of a triangle +%% +%% Functions from stochastic geometry +%% steinerPoint - Compute steiner point (weighted centroid) of a polygon +%% steinerPolygon - Create a Steiner polygon from a set of vectors +%% supportFunction - Compute support function of a polygon +%% convexification - Compute the convexification of a polygon +%% +%% Input, Output and conversions +%% readPolygon - Read a polygon stored in a file +%% polygonToRow - Convert polygon coordinates to a row vector +%% rowToPolygon - Create a polygon from a row vector +%% rectAsPolygon - Convert a (centered) rectangle into a series of points +%% +%% Drawing functions +%% drawPolyline - Draw a polyline specified by a list of points +%% drawPolygon - Draw a polygon specified by a list of points +%% fillPolygon - Fill a polygon specified by a list of points +%% +%% +%% Credits: +%% * function intersectPolylines uses the 'interX' contribution from "NS" +%% (file exchange 22441, called 'curve-intersections') +%% +%% ----- +%% Author: David Legland +%% e-mail: david.legland@@grignon.inra.fr +%% created the 07/11/2005. +%% Homepage: @url{http://matgeom.sourceforge.net/} +%% @url{http://www.pfl-cepia.inra.fr/index.php?page=geom2d} +%% Copyright INRA - Cepia Software Platform. +%% +%% @end deftypefn + +function polygons2d () + +help('polygons2d'); + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/polylineSelfIntersections.m b/octave_packages/geometry-1.5.0/polygons2d/polylineSelfIntersections.m new file mode 100644 index 0000000..d759be9 --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/polylineSelfIntersections.m @@ -0,0 +1,153 @@ +## Copyright (C) 2003-2011 David Legland +## Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions are met: +## +## 1 Redistributions of source code must retain the above copyright notice, +## this list of conditions and the following disclaimer. +## 2 Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## +## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +## +## The views and conclusions contained in the software and documentation are +## those of the authors and should not be interpreted as representing official +## policies, either expressed or implied, of the copyright holders. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{pts} = } polylineSelfIntersections (@var{poly}) +## Find self-intersections points of a polyline +## +## Return the position of self intersection points +## +## Also return the 2 positions of each intersection point (the position +## when meeting point for first time, then position when meeting point +## for the second time). +## +## Example +## @example +## # use a gamma-shaped polyline +## poly = [0 0;0 10;20 10;20 20;10 20;10 0]; +## polylineSelfIntersections(poly) +## ans = +## 10 10 +## +## # use a 'S'-shaped polyline +## poly = [10 0;0 0;0 10;20 10;20 20;10 20]; +## polylineSelfIntersections(poly) +## ans = +## 10 10 +## @end example +## +## @seealso{polygons2d, intersectPolylines, polygonSelfIntersections} +## @end deftypefn + +function varargout = polylineSelfIntersections(poly, varargin) + + ## Initialisations + + # determine whether the polyline is closed + closed = false; + if ~isempty(varargin) + closed = varargin{1}; + if ischar(closed) + if strcmp(closed, 'closed') + closed = true; + elseif strcmp(closed, 'open') + closed = false; + end + end + end + + # if polyline is closed, ensure the last point equals the first one + if closed + if sum(abs(poly(end, :)-poly(1,:))<1e-14)~=2 + poly = [poly; poly(1,:)]; + end + end + + # arrays for storing results + points = zeros(0, 2); + pos1 = zeros(0, 1); + pos2 = zeros(0, 1); + + # number of vertices + Nv = size(poly, 1); + + + ## Main processing + + # index of current intersection + ip = 0; + + # iterate over each couple of edge ( (N-1)*(N-2)/2 iterations) + for i=1:Nv-2 + # create first edge + edge1 = [poly(i, :) poly(i+1, :)]; + for j=i+2:Nv-1 + # create second edge + edge2 = [poly(j, :) poly(j+1, :)]; + + # check conditions on bounding boxes + if min(edge1([1 3]))>max(edge2([1 3])) + continue; + end + if max(edge1([1 3]))max(edge2([2 4])) + continue; + end + if max(edge1([2 4])) + points(ind,:) = []; + pos1(ind) = []; + pos2(ind) = []; + end + + ## Post-processing + + # process output arguments + if nargout<=1 + varargout{1} = points; + elseif nargout==3 + varargout{1} = points; + varargout{2} = pos1; + varargout{3} = pos2; + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/reversePolygon.m b/octave_packages/geometry-1.5.0/polygons2d/reversePolygon.m new file mode 100644 index 0000000..b0febf2 --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/reversePolygon.m @@ -0,0 +1,44 @@ +%% Copyright (C) 2003-2011 David Legland +%% Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +%% All rights reserved. +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1 Redistributions of source code must retain the above copyright notice, +%% this list of conditions and the following disclaimer. +%% 2 Redistributions in binary form must reproduce the above copyright +%% notice, this list of conditions and the following disclaimer in the +%% documentation and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +%% ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +%% SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +%% OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of the copyright holders. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{poly2} = } reversePolygon (@var{poly}) +%% Reverse a polygon, by iterating vertices from the end +%% +%% POLY2 = reversePolygon(POLY) +%% POLY2 has same vertices as POLY, but in different order. The first +%% vertex of the polygon is still the same. +%% +%% @seealso{reversePolyline} +%% @end deftypefn + +function rev = reversePolygon(poly) + + rev = poly([1 end:-1:2], :); + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/reversePolyline.m b/octave_packages/geometry-1.5.0/polygons2d/reversePolyline.m new file mode 100644 index 0000000..bc16338 --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/reversePolyline.m @@ -0,0 +1,43 @@ +%% Copyright (C) 2003-2011 David Legland +%% Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +%% All rights reserved. +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1 Redistributions of source code must retain the above copyright notice, +%% this list of conditions and the following disclaimer. +%% 2 Redistributions in binary form must reproduce the above copyright +%% notice, this list of conditions and the following disclaimer in the +%% documentation and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +%% ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +%% SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +%% OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of the copyright holders. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{poly2} = } reversePolyline (@var{poly}) +%% Reverse a polyline, by iterating vertices from the end +%% +%% POLY2 = reversePolyline(POLY) +%% POLY2 has same vertices as POLY, but POLY2(i,:) is the same as +%% POLY(END-i+1,:). +%% +%% @seealso{reversePolygon} +%% @end deftypefn +function rev = reversePolyline(poly) + + rev = poly(end:-1:1, :); + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/simplifypolygon.m b/octave_packages/geometry-1.5.0/polygons2d/simplifypolygon.m new file mode 100644 index 0000000..5993cfc --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/simplifypolygon.m @@ -0,0 +1,60 @@ +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR 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{spoly} = } simplifypolygon (@var{poly}) +%% Simplify a polygon using the Ramer-Douglas-Peucker algorithm. +%% +%% @var{poly} is a N-by-2 matrix, each row representing a vertex. +%% +%% @seealso{simplifypolyline, shape2polygon} +%% @end deftypefn + +function polygonsimp = simplifypolygon (polygon, varargin) + + polygonsimp = simplifypolyline (polygon,varargin{:}); + + # Remove parrallel consecutive edges + PL = polygonsimp(1:end-1,:); + PC = polygonsimp(2:end,:); + PR = polygonsimp([3:end 1],:); + a = PL - PC; + b = PR - PC; + tf = find(isParallel(a,b))+1; + polygonsimp (tf,:) = []; + +endfunction + +%!test +%! P = [0 0; 1 0; 0 1]; +%! P2 = [0 0; 0.1 0; 0.2 0; 0.25 0; 1 0; 0 1; 0 0.7; 0 0.6; 0 0.3; 0 0.1]; +%! assert(simplifypolygon (P2),P,min(P2(:))*eps) + +%!demo +%! +%! P = [0 0; 1 0; 0 1]; +%! P2 = [0 0; 0.1 0; 0.2 0; 0.25 0; 1 0; 0 1; 0 0.7; 0 0.6; 0 0.3; 0 0.1]; +%! Pr = simplifypolygon (P2); +%! +%! cla +%! drawPolygon(P,'or;Reference;'); +%! hold on +%! drawPolygon(P2,'x-b;Redundant;'); +%! drawPolygon(Pr,'*g;Simplified;'); +%! hold off +%! +%! % -------------------------------------------------------------------------- +%! % The two polygons describe the same figure, a triangle. Extra points are +%! % removed form the redundant one. diff --git a/octave_packages/geometry-1.5.0/polygons2d/simplifypolyline.m b/octave_packages/geometry-1.5.0/polygons2d/simplifypolyline.m new file mode 100644 index 0000000..0be0efd --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/simplifypolyline.m @@ -0,0 +1,156 @@ +%% Copyright (c) 2012 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{pline2} @var{idx}] = } simplifypolyline (@var{pline}) +%% @deftypefnx {Function File} {@dots{} = } simplifypolyline (@dots{},@var{property},@var{value},@dots{}) +%% Simplify or subsample a polyline using the Ramer-Douglas-Peucker algorithm, +%% a.k.a. the iterative end-point fit algorithm or the split-and-merge algorithm. +%% +%% The @var{pline} as a N-by-2 matrix. Rows correspond to the +%% verices (compatible with @code{polygons2d}). The vector @var{idx} constains +%% the indexes on vetices in @var{pline} that generates @var{pline2}, i.e. +%% @code{pline2 = pline(idx,:)}. +%% +%% @strong{Parameters} +%% @table @samp +%% @item 'Nmax' +%% Maximum number of vertices. Default value @code{1e3}. +%% @item 'Tol' +%% Tolerance for the error criteria. Default value @code{1e-4}. +%% @item 'MaxIter' +%% Maximum number of iterations. Default value @code{10}. +%% @item 'Method' +%% Not implemented. +%% @end table +%% +%% Run @code{demo simplifypolyline} to see an example. +%% +%% @seealso{curve2polyline, curveval} +%% @end deftypefn + +function [pline idx] = simplifypolyline (pline_o, varargin) +%% TODO do not print warnings if user provided Nmax or MaxIter. + + # --- Parse arguments --- # + parser = inputParser (); + parser.FunctionName = "simplifypolyline"; + parser = addParamValue (parser,'Nmax', 1e3, @(x)x>0); + toldef = 1e-4;%max(sumsq(diff(pline_o),2))*2; + parser = addParamValue (parser,'Tol', toldef, @(x)x>0); + parser = addParamValue (parser,'MaxIter', 100, @(x)x>0); + parser = parse(parser,varargin{:}); + + Nmax = parser.Results.Nmax; + tol = parser.Results.Tol; + MaxIter = parser.Results.MaxIter; + + clear parser toldef + msg = ["simplifypolyline: Maximum number of points reached with maximum error %g." ... + " Increase %s if the result is not satisfactory."]; + # ------ # + + [N dim] = size(pline_o); + idx = [1 N]; + + for iter = 1:MaxIter + % Find the point with the maximum distance. + [dist ii] = maxdistance (pline_o, idx); + + tf = dist > tol; + n = sum(tf); + if all(!tf); + break; + end + + idx(end+1:end+n) = ii(tf); + idx = sort(idx); + + if length(idx) >= Nmax + %% TODO remove extra points + warning('geometry:MayBeWrongOutput', sprintf(msg,max(dist),'Nmax')); + break; + end + + end + if iter == MaxIter + warning('geometry:MayBeWrongOutput', sprintf(msg,max(dist),'MaxIter')); + end + + pline = pline_o(idx,:); +endfunction + +function [dist ii] = maxdistance (p, idx) + + %% Separate the groups of points according to the edge they can divide. + func = @(x,y) x:y; + idxc = arrayfun (func, idx(1:end-1), idx(2:end), "UniformOutput",false); + points = cellfun (@(x)p(x,:), idxc, "UniformOutput",false); + + %% Build the edges + edges = [p(idx(1:end-1),:) p(idx(2:end),:)]; + edges = mat2cell (edges, ones(1,size(edges,1)), 4)'; + + %% Calculate distance between the points and the corresponding edge + [dist ii] = cellfun(@dd, points,edges,idxc); + +endfunction + +function [dist ii] = dd (p,e,idx) + [d pos] = distancePointEdge(p,e); + [dist ii] = max(d); + ii = idx(ii); +endfunction + +%!demo +%! t = linspace(0,1,100).'; +%! y = polyval([1 -1.5 0.5 0],t); +%! pline = [t y]; +%! +%! figure(1) +%! clf +%! plot (t,y,'-r;Original;','linewidth',2); +%! hold on +%! +%! tol = [8 2 1 0.5]*1e-2; +%! colors = jet(4); +%! +%! for i=1:4 +%! pline_ = simplifypolyline(pline,'tol',tol(i)); +%! msg = sprintf('-;%g;',tol(i)); +%! h = plot (pline_(:,1),pline_(:,2),msg); +%! set(h,'color',colors(i,:),'linewidth',2,'markersize',4); +%! end +%! hold off +%! +%! % --------------------------------------------------------- +%! % Four approximations of the initial polyline with decreasing tolerances. + +%!demo +%! P = [0 0; 3 1; 3 4; 1 3; 2 2; 1 1]; +%! func = @(x,y) linspace(x,y,5); +%! P2(:,1) = cell2mat( ... +%! arrayfun (func, P(1:end-1,1),P(2:end,1), ... +%! 'uniformoutput',false))'(:); +%! P2(:,2) = cell2mat( ... +%! arrayfun (func, P(1:end-1,2),P(2:end,2), ... +%! 'uniformoutput',false))'(:); +%! +%! P2s = simplifypolyline (P2); +%! +%! plot(P(:,1),P(:,2),'s',P2(:,1),P2(:,2),'o',P2s(:,1),P2s(:,2),'-ok'); +%! +%! % --------------------------------------------------------- +%! % Simplification of a polyline in the plane. diff --git a/octave_packages/geometry-1.5.0/polygons2d/splitPolygons.m b/octave_packages/geometry-1.5.0/polygons2d/splitPolygons.m new file mode 100644 index 0000000..e373668 --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/splitPolygons.m @@ -0,0 +1,64 @@ +## Copyright (C) 2003-2011 David Legland +## Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions are met: +## +## 1 Redistributions of source code must retain the above copyright notice, +## this list of conditions and the following disclaimer. +## 2 Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## +## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +## +## The views and conclusions contained in the software and documentation are +## those of the authors and should not be interpreted as representing official +## policies, either expressed or implied, of the copyright holders. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{polygons} = } splitPolygons (@var{polygon}) +## Convert a NaN separated polygon list to a cell array of polygons. +## +## @var{polygon} is a N-by-2 array of points, with possibly couples of NaN values. +## The functions separates each component separated by NaN values, and +## returns a cell array of polygons. +## +## @seealso{polygons2d} +## @end deftypefn +function polygons = splitPolygons(polygon) + + if iscell(polygon) + # case of a cell array + polygons = polygon; + + elseif sum(isnan(polygon(:)))==0 + # single polygon -> no break + polygons = {polygon}; + + else + # find indices of NaN couples + inds = find(sum(isnan(polygon), 2)>0); + + # number of polygons + N = length(inds)+1; + polygons = cell(N, 1); + + # iterate over NaN-separated regions to create new polygon + inds = [0;inds;size(polygon, 1)+1]; + for i=1:N + polygons{i} = polygon((inds(i)+1):(inds(i+1)-1), :); + end + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/polygons2d/supportFunction.m b/octave_packages/geometry-1.5.0/polygons2d/supportFunction.m new file mode 100644 index 0000000..7936aae --- /dev/null +++ b/octave_packages/geometry-1.5.0/polygons2d/supportFunction.m @@ -0,0 +1,72 @@ +%% Copyright (C) 2003-2011 David Legland +%% Copyright (C) 2012 Adapted to Octave by Juan Pablo Carbajal +%% All rights reserved. +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1 Redistributions of source code must retain the above copyright notice, +%% this list of conditions and the following disclaimer. +%% 2 Redistributions in binary form must reproduce the above copyright +%% notice, this list of conditions and the following disclaimer in the +%% documentation and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +%% ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +%% SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +%% OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +%% +%% The views and conclusions contained in the software and documentation are +%% those of the authors and should not be interpreted as representing official +%% policies, either expressed or implied, of the copyright holders. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{h} = } suppportFunction (@var{polygon}) +%% @deftypefnx {Function File} {@var{h} = } suppportFunction (@var{polygon}, @var{n}) +%% @deftypefnx {Function File} {@var{h} = } suppportFunction (@var{polygon}, @var{v}) +%% Compute support function of a polygon +%% +%% H = supportFunction(POLYGON, N) +%% uses N points for suport function approximation +%% +%% H = supportFunction(POLYGON) +%% assume 24 points for approximation +%% +%% H = supportFunction(POLYGON, V) +%% where V is a vector, uses vector V of angles to compute support +%% function. +%% +%% @seealso{convexification} +%% @end deftypefn + +function h = supportFunction(polygon, varargin) + N = 24; + u = (0:2*pi/N:2*pi*(1-1/N)).'; + + if length(varargin)==1 + var = varargin{1}; + if length(var)==1 + N = var; + u = (0:2*pi/N:2*pi*(1-1/N)).'; + else + u = var(:); + end + end + + + h = zeros(size(u)); + + for i=1:length(u) + + v = repmat([cos(u(i)) sin(u(i))], [size(polygon, 1), 1]); + + h(i) = max(dot(polygon, v, 2)); + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/shape2d/curve2polyline.m b/octave_packages/geometry-1.5.0/shape2d/curve2polyline.m new file mode 100644 index 0000000..389aec0 --- /dev/null +++ b/octave_packages/geometry-1.5.0/shape2d/curve2polyline.m @@ -0,0 +1,141 @@ +%% Copyright (c) 2012 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{polyline} = } curve2polyline (@var{curve}) +%% @deftypefnx {Function File} {@var{polyline} = } curve2polyline (@dots{},@var{property},@var{value},@dots{}) +%% Adaptive sampling of a parametric curve. +%% +%% The @var{curve} is described as a 2-by-N matrix. Rows correspond to the +%% polynomial (compatible with @code{polyval}) describing the respective component +%% of the curve. The curve must be parametrized in the interval [0,1]. +%% The vertices of the polyline are accumulated in regions of the curve where +%% the curvature is higher. +%% +%% @strong{Parameters} +%% @table @samp +%% @item 'Nmax' +%% Maximum number of vertices. Not used. +%% @item 'Tol' +%% Tolerance for the error criteria. Default value @code{1e-4}. +%% @item 'MaxIter' +%% Maximum number of iterations. Default value @code{10}. +%% @item 'Method' +%% Not implemented. +%% @end table +%% +%% @seealso{shape2polygon, curveval} +%% @end deftypefn + +%% This function is based on the algorithm described in +%% L. H. de Figueiredo (1993). "Adaptive Sampling of Parametric Curves". Graphic Gems III. +%% I had to remove the recursion so this version could be improved. +%% Thursday, April 12 2012 -- JuanPi + +function [polyline t bump]= curve2polyline (curve, varargin) +%% TODO make tolerance relative to the "diameter" of the curve. + + # --- Parse arguments --- # + parser = inputParser (); + parser.FunctionName = "curve2polyline"; + parser = addParamValue (parser,'Nmax', 32, @(x)x>0); + parser = addParamValue (parser,'Tol', 1e-4, @(x)x>0); + parser = addParamValue (parser,'MaxIter', 10, @(x)x>0); + parser = parse(parser,varargin{:}); + + Nmax = parser.Results.Nmax; + tol = parser.Results.Tol; + MaxIter = parser.Results.MaxIter; + + clear parser toldef + # ------ # + + t = [0; 1]; + tf = 1; + points = 1; + for iter = 1:MaxIter + % Add parameter values where error is still bigger than tol. + t = interleave(t, tf); + nt = length(t); + + % Update error + polyline = curveval (curve,t); + bump = bumpyness(polyline); + + % Check which intervals must be subdivided + idx = find(bump > tol); + % The position of the bumps mpas into intervals + % 1 -> 1 2 + % 2 -> 3 4 + % 3 -> 5 6 + % and so on + idx = [2*(idx-1)+1; 2*idx](:); + tf = false (nt-1,1); + tf(idx) = true; + + if all (!tf) + break; + end + + end + +endfunction + +function f = bumpyness (p) +%% Check for co-linearity +%% TODO implement various method for this +%% -- Area of the triangle close to zero (used currently). +%% -- Angle close to pi. +%% -- abs(p0-pt) + abs(pt-p1) - abs(p0-p1) almost zero. +%% -- Curve's tange at 0,t,1 are almost parallel. +%% -- pt is in chord p0 -> p1. +%% Do this in isParallel.m and remove this function + + PL = p(1:2:end-2,:); + PC = p(2:2:end-1,:); + PR = p(3:2:end,:); + + a = PL - PC; + b = PR - PC; + + f = (a(:,1).*b(:,2) - a(:,2).*b(:,1)).^2; + +endfunction + +function tt = interleave (t,varargin) + + nt = length(t); + ntt = 2 * nt -1; + tt = zeros(ntt,1); + tt(1:2:ntt) = t; + beta = 0.4 + 0.2*rand(nt-1, 1); + tt(2:2:ntt) = t(1:end-1) + beta.*(t(2:end)-t(1:end-1)); + + if nargin > 1 + tf = true (ntt,1); + tf(2:2:ntt) = varargin{1}; + tt(!tf) = []; + end + +endfunction + +%!demo +%! curve = [0 0 1 0;1 -0.3-1 0.3 0]; +%! polyline = curve2polyline(curve,'tol',1e-8); +%! +%! t = linspace(0,1,100)'; +%! pc = curveval(curve,t); +%! +%! plot(polyline(:,1),polyline(:,2),'-o',pc(:,1),pc(:,2),'-r') diff --git a/octave_packages/geometry-1.5.0/shape2d/curveval.m b/octave_packages/geometry-1.5.0/shape2d/curveval.m new file mode 100644 index 0000000..b47ec77 --- /dev/null +++ b/octave_packages/geometry-1.5.0/shape2d/curveval.m @@ -0,0 +1,30 @@ +%% Copyright (c) 2012 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% any later version. +%% +%% This program is distributed in the hope that it will be useful, +%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%% GNU General Public License for more details. +%% +%% You should have received a copy of the GNU General Public License +%% along with this program. If not, see . + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{p} = } curveval (@var{curve}, @var{t}) +%% Evaluates parametric @var{curve} at @var{t}. +%% +%% @end deftypefn +function p = curveval (curve, t) + + dim = size (curve,1); + p = zeros (length(t), dim); + + for i = 1:dim + p(:,i) = polyval (curve(i,:), t); + end + +endfunction diff --git a/octave_packages/geometry-1.5.0/shape2d/doc-cache b/octave_packages/geometry-1.5.0/shape2d/doc-cache new file mode 100644 index 0000000..f94ad03 --- /dev/null +++ b/octave_packages/geometry-1.5.0/shape2d/doc-cache @@ -0,0 +1,266 @@ +# Created by Octave 3.6.2, Sun Jun 10 09:53:43 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 7 +# name: +# type: sq_string +# elements: 1 +# length: 14 +curve2polyline + + +# name: +# type: sq_string +# elements: 1 +# length: 828 + -- Function File: POLYLINE = curve2polyline (CURVE) + -- Function File: POLYLINE = curve2polyline (...,PROPERTY,VALUE,...) + Adaptive sampling of a parametric curve. + + The CURVE is described as a 2-by-N matrix. Rows correspond to the + polynomial (compatible with `polyval') describing the respective + component of the curve. The curve must be parametrized in the + interval [0,1]. The vertices of the polyline are accumulated in + regions of the curve where the curvature is higher. + + *Parameters* + `'Nmax'' + Maximum number of vertices. Not used. + + `'Tol'' + Tolerance for the error criteria. Default value `1e-4'. + + `'MaxIter'' + Maximum number of iterations. Default value `10'. + + `'Method'' + Not implemented. + + See also: shape2polygon, curveval + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Adaptive sampling of a parametric curve. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +curveval + + +# name: +# type: sq_string +# elements: 1 +# length: 84 + -- Function File: P = curveval (CURVE, T) + Evaluates parametric CURVE at T. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 +Evaluates parametric CURVE at T. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +shape2polygon + + +# name: +# type: sq_string +# elements: 1 +# length: 494 + -- Function File: POLYGON = shape2polygon (SHAPE) + -- Function File: POLYGON = shape2polygon (...,PROPERTY,VALUE,...) + Transforms a 2D shape described by piecewise smooth polynomials + into a polygon. + + SHAPE is a n-by-1 cell where each element is a pair of polynomials + compatible with polyval. POLYGON is a k-by-2 matrix, where each + row represents a vertex. The property-value pairs are passed to + `curve2polyline'. + + See also: polygon2shape, curve2poyline + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 79 +Transforms a 2D shape described by piecewise smooth polynomials into a +polygon. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +shapearea + + +# name: +# type: sq_string +# elements: 1 +# length: 407 + -- Function File: A = shapearea (PP) + Calculate the area of a 2D shape defined with piecewise smooth + polynomials. + + Shape is defined with piecewise smooth polynomials. PP is a cell + where each elements is a 2-by-(poly_degree+1) array containing a + pair of polynomials. + + `px(i,:) = pp{i}(1,:)' and `py(i,:) = pp{i}(2,:)'. + + See also: shapecentroid, shape2polygon, shapeplot + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 +Calculate the area of a 2D shape defined with piecewise smooth +polynomials. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +shapecentroid + + +# name: +# type: sq_string +# elements: 1 +# length: 521 + -- Function File: CM = shapecentroid (PP) + Centroid of a simple plane shape defined with piecewise smooth + polynomials. + + The shape is defined with piecewise smooth polynomials. PP is a + cell where each elements is a 2-by-(poly_degree+1) matrix + containing a pair of polynomials. `px(i,:) = pp{i}(1,:)' and + `py(i,:) = pp{i}(2,:)'. + + The edges of the shape should not self-intersect. This function + does not check for the sanity of the shape. + + See also: shapearea, shape2polygon + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 +Centroid of a simple plane shape defined with piecewise smooth +polynomials. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +shapeplot + + +# name: +# type: sq_string +# elements: 1 +# length: 518 + -- Function File: H = shapeplot (SHAPE) + -- Function File: H = shapeplot (SHAPE, N) + -- Function File: H = shapeplot (..., PARAM, VALUE) + Pots a 2D shape defined by piecewise smooth polynomials in the + current axis. + + PP is a cell where each elements is a 2-by-(poly_degree+1) matrix + containing a pair of polynomials. N is the number of points to be + used in non-straight edges. Additional parameter value pairs are + passed to `drawPolygon'. + + See also: drawPolygon, shape2polygon + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 76 +Pots a 2D shape defined by piecewise smooth polynomials in the current +axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +shapetransform + + +# name: +# type: sq_string +# elements: 1 +# length: 463 + -- Function File: NSHAPE = shapetransform (SHAPE, T) + Applies transformation to a shape defined by piecewise smooth + polynomials. + + SHAPE is a cell where each elements is a 2-by-(poly_degree+1) + matrix containing a pair of polynomials. + + Format of T can be one of : + [c] , [a b] , [a b c] or [a b c] + [f] [d e] [d e f] [d e f] + [0 0 1] + + See also: shape2polygon, shapeplot + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 74 +Applies transformation to a shape defined by piecewise smooth +polynomials. + + + + + diff --git a/octave_packages/geometry-1.5.0/shape2d/shape2polygon.m b/octave_packages/geometry-1.5.0/shape2d/shape2polygon.m new file mode 100644 index 0000000..86fb143 --- /dev/null +++ b/octave_packages/geometry-1.5.0/shape2d/shape2polygon.m @@ -0,0 +1,65 @@ +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR 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{polygon} = } shape2polygon (@var{shape}) +%% @deftypefnx {Function File} {@var{polygon} = } shape2polygon (@dots{},@var{property},@var{value},@dots{}) +%% Transforms a 2D shape described by piecewise smooth polynomials into a polygon. +%% +%% @var{shape} is a n-by-1 cell where each element is a pair of polynomials +%% compatible with polyval. +%% @var{polygon} is a k-by-2 matrix, where each row represents a vertex. +%% The property-value pairs are passed to @code{curve2polyline}. +%% +%% @seealso{polygon2shape, curve2poyline} +%% @end deftypefn + +function polygon = shape2polygon (shape, varargin) + + polygon = cell2mat ( ... + cellfun (@(x) curve2polyline(x,varargin{:}), shape,'UniformOutput',false) ); + polygon = simplifypolygon(polygon); + + if size (polygon, 1) == 1 + polygon(2,1) = polyval (shape{1}(1,:), 1); + polygon(2,2) = polyval (shape{1}(2,:), 1); + end + +endfunction + +%!demo +%! shape = {[-93.172 606.368 -476.054 291.429; ... +%! -431.196 637.253 11.085 163.791]; ... +%! [-75.3626 -253.2337 457.1678 328.5714; ... +%! 438.7659 -653.6278 -7.9953 380.9336]; ... +%! [-89.5841 344.9716 -275.3876 457.1429; ... +%! -170.3613 237.8858 1.0469 158.0765];... +%! [32.900 -298.704 145.804 437.143; ... +%! -243.903 369.597 -34.265 226.648]; ... +%! [-99.081 409.127 -352.903 317.143; ... +%! 55.289 -114.223 -26.781 318.076]; ... +%! [-342.231 191.266 168.108 274.286; ... +%! 58.870 -38.083 -89.358 232.362]}; +%! +%! % Estimate a good tolerance +%! n = cell2mat(cellfun(@(x)curveval(x,rand(1,10)), shape, 'uniformoutput',false)); +%! dr = (max(n(:,1))-min(n(:,1)))*(max(n(:,2))-min(n(:,2)))*40; +%! p = shape2polygon (shape,'tol',dr); +%! +%! figure(1) +%! shapeplot(shape,'-b'); +%! hold on; +%! drawPolygon (p,'-or'); +%! hold off diff --git a/octave_packages/geometry-1.5.0/shape2d/shapearea.m b/octave_packages/geometry-1.5.0/shape2d/shapearea.m new file mode 100644 index 0000000..e6b745d --- /dev/null +++ b/octave_packages/geometry-1.5.0/shape2d/shapearea.m @@ -0,0 +1,77 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software; you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation; either version 3 of the License, or +%% (at your option) any later version. +%% +%% This program is distributed in the hope that it will be useful, +%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR 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{a} =} shapearea (@var{pp}) +%% Calculate the area of a 2D shape defined with piecewise smooth polynomials. +%% +%% Shape is defined with piecewise smooth polynomials. @var{pp} is a +%% cell where each elements is a 2-by-(poly_degree+1) array containing a pair of +%% polynomials. +%% +%% @code{px(i,:) = pp@{i@}(1,:)} and @code{py(i,:) = pp@{i@}(2,:)}. +%% +%% @seealso{shapecentroid, shape2polygon, shapeplot} +%% @end deftypefn + +function [A ccw] = shapearea (shape) + + A = sum(cellfun (@Aint, shape)); + if A < 0 + warning ('geom2d:shapearea:InvalidResult', ... + 'Shape has negative area. Assuming this is due to a clockwise parametrization of the boundary'); + A = -A; + end + +endfunction + +function dA = Aint (x) + + px = x(1,:); + py = x(2,:); + + P = polyint (conv (px, polyder(py))); + + dA = diff(polyval(P,[0 1])); + +end + +%!demo % non-convex piece-wise polynomial shape +%! boomerang = {[ 0 -2 1; ... +%! -4 4 0]; ... +%! [0.25 -1; ... +%! 0 0]; ... +%! [ 0 1.5 -0.75; ... +%! -3 3 0]; +%! [0.25 0.75; ... +%! 0 0]}; +%! A = shapearea (boomerang) + +%!test +%! triangle = {[1 0; 0 0]; [-0.5 1; 1 0]; [-0.5 0.5; -1 1]}; +%! A = shapearea (triangle); +%! assert (0.5, A); + +%!test +%! circle = {[1.715729 -6.715729 0 5; ... +%! -1.715729 -1.568542 8.284271 0]; ... +%! [1.715729 1.568542 -8.284271 0; ... +%! 1.715729 -6.715729 0 5]; ... +%! [-1.715729 6.715729 0 -5; ... +%! 1.715729 1.568542 -8.284271 0]; ... +%! [-1.715729 -1.568542 8.284271 0; ... +%! -1.715729 6.715729 0 -5]}; +%! A = shapearea (circle); +%! assert (pi*5^2, A, 5e-2); diff --git a/octave_packages/geometry-1.5.0/shape2d/shapecentroid.m b/octave_packages/geometry-1.5.0/shape2d/shapecentroid.m new file mode 100644 index 0000000..8094b0b --- /dev/null +++ b/octave_packages/geometry-1.5.0/shape2d/shapecentroid.m @@ -0,0 +1,149 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software; you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation; either version 3 of the License, or +%% (at your option) any later version. +%% +%% This program is distributed in the hope that it will be useful, +%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR 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{cm} =} shapecentroid (@var{pp}) +%% Centroid of a simple plane shape defined with piecewise smooth polynomials. +%% +%% The shape is defined with piecewise smooth polynomials. @var{pp} is a +%% cell where each elements is a 2-by-(poly_degree+1) matrix containing a pair +%% of polynomials. +%% @code{px(i,:) = pp@{i@}(1,:)} and @code{py(i,:) = pp@{i@}(2,:)}. +%% +%% The edges of the shape should not self-intersect. This function does not check for the +%% sanity of the shape. +%% +%% @seealso{shapearea, shape2polygon} +%% @end deftypefn + +function cm = shapecentroid (shape) + + cm = sum( cell2mat ( cellfun (@CMint, shape, 'UniformOutput', false)), 1); + A = shapearea(shape); + cm = cm / A; + + [~,id] = lastwarn ('',''); + if strcmp (id ,'geom2d:shapearea:InvalidResult') + lastwarn('Inverting centroid','geom2d:shapecentroid:InvalidResult'); + cm = -cm; + end + +endfunction + +function dcm = CMint (x) + + px = x(1,:); + py = x(2,:); + Px = polyint (conv(conv (-px , py) , polyder (px))); + Py = polyint (conv(conv (px , py) , polyder (py))); + + dcm = zeros (1,2); + dcm(1) = diff(polyval(Px,[0 1])); + dcm(2) = diff(polyval(Py,[0 1])); + +endfunction + +%!demo % non-convex bezier shape +%! boomerang = {[ 0 -2 1; ... +%! -4 4 0]; ... +%! [0.25 -1; ... +%! 0 0]; ... +%! [ 0 1.5 -0.75; ... +%! -3 3 0]; +%! [0.25 0.75; ... +%! 0 0]}; +%! CoM = shapecentroid (boomerang) +%! Gcentroid = centroid(shape2polygon(boomerang)) +%! figure(1); clf; +%! shapeplot(boomerang,'-o'); +%! hold on +%! drawPoint(CoM,'xk;shape centroid;'); +%! drawPoint(Gcentroid,'xr;point centroid;'); +%! hold off +%! axis equal + +%!demo +%! Lshape = {[0.00000 0.76635; -0.67579 -0.24067]; ... +%! [0.77976 0.76635; 0.00000 -0.91646]; ... +%! [0.00000 1.54611; 0.38614 -0.91646]; ... +%! [-0.43813 1.54611; 0.00000 -0.53032]; ... +%! [0.00000 1.10798; 0.28965 -0.53032]; ... +%! [-0.34163 1.10798; 0.00000 -0.24067]};... +%! CoM = shapecentroid (Lshape) +%! Gcentroid = centroid (shape2polygon (Lshape)) +%! +%! shapeplot(Lshape,'-o'); +%! hold on +%! drawPoint(CoM,'xk;shape centroid;'); +%! drawPoint(Gcentroid,'xr;point centroid;'); +%! hold off +%! axis equal + +%!test +%! square = {[1 -0.5; 0 -0.5]; [0 0.5; 1 -0.5]; [-1 0.5; 0 0.5]; [0 -0.5; -1 0.5]}; +%! CoM = shapecentroid (square); +%! assert (CoM, [0 0], sqrt(eps)); + +%!test +%! square = {[1 -0.5; 0 -0.5]; [0 0.5; 1 -0.5]; [-1 0.5; 0 0.5]; [0 -0.5; -1 0.5]}; +%! square_t = shapetransform (square,[1;1]); +%! CoM = shapecentroid (square_t); +%! assert (CoM, [1 1], sqrt(eps)); + +%!test +%! circle = {[1.715729 -6.715729 0 5; ... +%! -1.715729 -1.568542 8.284271 0]; ... +%! [1.715729 1.568542 -8.284271 0; ... +%! 1.715729 -6.715729 0 5]; ... +%! [-1.715729 6.715729 0 -5; ... +%! 1.715729 1.568542 -8.284271 0]; ... +%! [-1.715729 -1.568542 8.284271 0; ... +%! -1.715729 6.715729 0 -5]}; +%! CoM = shapecentroid (circle); +%! assert (CoM , [0 0], 5e-3); + +%!shared shape +%! shape = {[-93.172 606.368 -476.054 291.429; ... +%! -431.196 637.253 11.085 163.791]; ... +%! [-75.3626 -253.2337 457.1678 328.5714; ... +%! 438.7659 -653.6278 -7.9953 380.9336]; ... +%! [-89.5841 344.9716 -275.3876 457.1429; ... +%! -170.3613 237.8858 1.0469 158.0765];... +%! [32.900 -298.704 145.804 437.143; ... +%! -243.903 369.597 -34.265 226.648]; ... +%! [-99.081 409.127 -352.903 317.143; ... +%! 55.289 -114.223 -26.781 318.076]; ... +%! [-342.231 191.266 168.108 274.286; ... +%! 58.870 -38.083 -89.358 232.362]}; + +%!test % x-Reflection +%! v = shapecentroid (shape)(:); +%! T = createLineReflection([0 0 1 0]); +%! nshape = shapetransform (shape, T); +%! vn = shapecentroid (nshape)(:); +%! assert(vn,T(1:2,1:2)*v); + +%!test % Rotation +%! v = shapecentroid (shape)(:); +%! T = createRotation(v.',pi/2); +%! nshape = shapetransform (shape, T); +%! vn = shapecentroid (nshape)(:); +%! assert(vn,v,1e-2); + +%!test % Translation +%! v = shapecentroid (shape)(:); +%! nshape = shapetransform (shape, -v); +%! vn = shapecentroid (nshape)(:); +%! assert(vn,[0; 0],1e-2); diff --git a/octave_packages/geometry-1.5.0/shape2d/shapeplot.m b/octave_packages/geometry-1.5.0/shape2d/shapeplot.m new file mode 100644 index 0000000..b820464 --- /dev/null +++ b/octave_packages/geometry-1.5.0/shape2d/shapeplot.m @@ -0,0 +1,37 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{h} = } shapeplot (@var{shape}) +%% @deftypefnx {Function File} {@var{h} = } shapeplot (@var{shape}, @var{N}) +%% @deftypefnx {Function File} {@var{h} = } shapeplot (@dots{}, @var{param}, @var{value}) +%% Pots a 2D shape defined by piecewise smooth polynomials in the current axis. +%% +%% @var{pp} is a cell where each elements is a 2-by-(poly_degree+1) matrix +%% containing a pair of polynomials. +%% @var{N} is the number of points to be used in non-straight edges. +%% Additional parameter value pairs are passed to @code{drawPolygon}. +%% +%% @seealso{drawPolygon, shape2polygon} +%% @end deftypefn + +function h = shapeplot(shape, varargin) + + n = cell2mat(cellfun(@(x)curveval(x,rand(1,5)), shape, 'uniformoutput',false)); + dr = (max(n(:,1))-min(n(:,1)))*(max(n(:,2))-min(n(:,2)))/100; + p = shape2polygon(shape,'tol', dr); + h = drawPolygon(p,varargin{:}); + +endfunction diff --git a/octave_packages/geometry-1.5.0/shape2d/shapetransform.m b/octave_packages/geometry-1.5.0/shape2d/shapetransform.m new file mode 100644 index 0000000..ca04f9d --- /dev/null +++ b/octave_packages/geometry-1.5.0/shape2d/shapetransform.m @@ -0,0 +1,109 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{nshape} = } shapetransform (@var{shape}, @var{T}) +%% Applies transformation to a shape defined by piecewise smooth polynomials. +%% +%% @var{shape} is a cell where each elements is a 2-by-(poly_degree+1) matrix +%% containing a pair of polynomials. +%% +%% Format of @var{T} can be one of : +%% @example +%% @group +%% [c] , [a b] , [a b c] or [a b c] +%% [f] [d e] [d e f] [d e f] +%% [0 0 1] +%% @end group +%% @end example +%% +%% @seealso{shape2polygon, shapeplot} +%% @end deftypefn + +function nshape = shapetransform (shape, Trans) + + if size(Trans,1) < 2 + error("geometry:shapetransform:InvalidArgument", ... + "Transformation can be 2x1, 2x2, 2x3 or 3x3. See help."); + end + + if ~iscell(shape) + error("geometry:shapetransform:InvalidArgument", "Shape must be a cell of 2D polynomials."); + end + + A =[]; + v = []; + + switch size(Trans,2) + case 1 + % Just translation + v = Trans; + + case 2 + % Just linear transformation + A = Trans; + + case 3 + % Affine transform + A = Trans(1:2,1:2); + v = Trans(1:2,3); + end + + nshape = cellfun (@(x)polytransform (x,A,v), shape, 'UniformOutput',false); + +endfunction + +function np = polytransform(p,A,v) + + np = p; + if ~isempty (A) + np = A*np; + end + if ~isempty (v) + np(:,end) = np(:,end) + v; + end + +endfunction + +%!demo +%! shape = {[-93.172 606.368 -476.054 291.429; ... +%! -431.196 637.253 11.085 163.791]; ... +%! [-75.3626 -253.2337 457.1678 328.5714; ... +%! 438.7659 -653.6278 -7.9953 380.9336]; ... +%! [-89.5841 344.9716 -275.3876 457.1429; ... +%! -170.3613 237.8858 1.0469 158.0765];... +%! [32.900 -298.704 145.804 437.143; ... +%! -243.903 369.597 -34.265 226.648]; ... +%! [-99.081 409.127 -352.903 317.143; ... +%! 55.289 -114.223 -26.781 318.076]; ... +%! [-342.231 191.266 168.108 274.286; ... +%! 58.870 -38.083 -89.358 232.362]}; +%! +%! A = shapearea (shape); +%! T = eye(2)/sqrt(A); +%! shape = shapetransform (shape,T); +%! T = shapecentroid (shape)(:); +%! shape = shapetransform (shape,-T + [2; 0]); +%! +%! close +%! shapeplot (shape,'-r','linewidth',2); +%! hold on +%! for i = 1:9 +%! T = createRotation (i*pi/5)(1:2,1:2)/exp(0.3*i); +%! shapeplot (shapetransform(shape, T), 'color',rand(1,3),'linewidth',2); +%! end +%! hold off +%! axis tight +%! axis square diff --git a/octave_packages/gsl-1.0.8/doc-cache b/octave_packages/gsl-1.0.8/doc-cache new file mode 100644 index 0000000..ca478f3 --- /dev/null +++ b/octave_packages/gsl-1.0.8/doc-cache @@ -0,0 +1,55 @@ +# Created by Octave 3.6.1, Mon May 28 16:06:53 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 2 +# name: +# type: sq_string +# elements: 1 +# length: 11 +test_ellint + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +file_name=input("file name: ","s") + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +file_name=input("file name: ","s") + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +test_hyperg + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +file_name=input("file name: ","s") + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +file_name=input("file name: ","s") + + + + + + diff --git a/octave_packages/gsl-1.0.8/packinfo/.autoload b/octave_packages/gsl-1.0.8/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/gsl-1.0.8/packinfo/DESCRIPTION b/octave_packages/gsl-1.0.8/packinfo/DESCRIPTION new file mode 100644 index 0000000..1c75670 --- /dev/null +++ b/octave_packages/gsl-1.0.8/packinfo/DESCRIPTION @@ -0,0 +1,13 @@ +Name: GSL +Version: 1.0.8 +Date: 2009-05-03 +Author: Teemu Ikonen +Maintainer: Teemu Ikonen +Title: GNU Scientific Library. +Description: Octave bindings to the GNU Scientific Library +Depends: octave (>= 2.9.7) +Autoload: yes +BuildRequires: gsl-devel +License: GPL version 2 or later +Url: http://octave.sf.net +# Version 1.0.5 -> Version 1.0.6 Ray Rogers rrogers@@plaidheron.com diff --git a/octave_packages/gsl-1.0.8/packinfo/INDEX b/octave_packages/gsl-1.0.8/packinfo/INDEX new file mode 100644 index 0000000..ca87a80 --- /dev/null +++ b/octave_packages/gsl-1.0.8/packinfo/INDEX @@ -0,0 +1,119 @@ +math >> Mathematics +Special functions + Chi + Ci + Shi + Si + airy_Ai + airy_Ai_deriv + airy_Ai_deriv_scaled + airy_Ai_scaled + airy_Bi + airy_Bi_deriv + airy_Bi_deriv_scaled + airy_Bi_scaled + airy_zero_Ai + airy_zero_Ai_deriv + airy_zero_Bi + airy_zero_Bi_deriv + atanint + bessel_In + bessel_In_scaled + bessel_Inu + bessel_Inu_scaled + bessel_Jn + bessel_Jnu + bessel_Kn + bessel_Kn_scaled + bessel_Knu + bessel_Knu_scaled + bessel_Yn + bessel_Ynu + bessel_il_scaled + bessel_jl + bessel_kl_scaled + bessel_lnKnu + bessel_yl + bessel_zero_J0 + bessel_zero_J1 + bessel_zero_Jnu + beta_gsl + clausen + conicalP_0 + conicalP_1 + conicalP_half + conicalP_mhalf + coupling_3j + coupling_6j + coupling_9j + dawson + debye_1 + debye_2 + debye_3 + debye_4 + ellint_Ecomp + ellint_Kcomp + erf_Q + erf_Z + erf_gsl + erfc_gsl + eta + eta_int + exp_mult + expint_3 + expint_E1 + expint_E2 + expint_Ei + expm1 + exprel + exprel_2 + exprel_n + fermi_dirac_3half + fermi_dirac_half + fermi_dirac_inc_0 + fermi_dirac_int + fermi_dirac_mhalf + gamma_gsl + gamma_inc + gamma_inc_P + gamma_inc_Q + gammainv_gsl + gammastar + hazard + hyperg_0F1 + hyperg_1F1 + hyperg_U + hzeta + lambert_W0 + lambert_Wm1 + legendre_Pl + legendre_Plm + legendre_Ql + legendre_sphPlm + legendre_sphPlm_array + lnbeta + lncosh + lngamma_gsl + lnpoch + lnsinh + log_1plusx + log_1plusx_mx + log_erfc + poch + pochrel + psi + psi_1_int + psi_1piy + psi_n + sinc_gsl + synchrotron_1 + synchrotron_2 + taylorcoeff + transport_2 + transport_3 + transport_4 + transport_5 + zeta + zeta_int +Support + gsl_sf diff --git a/octave_packages/gsl-1.0.8/test_ellint.m b/octave_packages/gsl-1.0.8/test_ellint.m new file mode 100644 index 0000000..35eb50b --- /dev/null +++ b/octave_packages/gsl-1.0.8/test_ellint.m @@ -0,0 +1,136 @@ +## Copyright (C) 2008 Raymond E. Rogers +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## 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 . + +# +# +# +# R. Rogers v1, testing gsl_sf_ellint_Kcomp_e, gsl_sf_ellint_Ecomp_e +# implementation in octave as ellint_Kcomp, ellint_Ecomp +# against the gsl tests +# Some array verification is done; since I messed it up once. + + +global GSL_DBL_EPSILON= 2.2204460492503131e-16 +global GSL_SQRT_DBL_EPSILON= 1.4901161193847656e-08 +global TEST_TOL0= (2.0*GSL_DBL_EPSILON) +global TEST_TOL1= (16.0*GSL_DBL_EPSILON) +global TEST_TOL2= (256.0*GSL_DBL_EPSILON) +global TEST_TOL3= (2048.0*GSL_DBL_EPSILON) +global TEST_TOL4= (16384.0*GSL_DBL_EPSILON) +global TEST_TOL5= (131072.0*GSL_DBL_EPSILON) +global TEST_TOL6= (1048576.0*GSL_DBL_EPSILON) +global TEST_SQRT_TOL0= (2.0*GSL_SQRT_DBL_EPSILON) +global TEST_SNGL= (1.0e-06) + +global TEST_SF_INCONS= 1 +global TEST_SF_ERRNEG= 2 +global TEST_SF_TOLBAD= 4 +global TEST_SF_RETBAD= 8 +global TEST_SF_ERRBAD= 16 +global TEST_SF_ERRBIG= 32 +global TEST_SF_EXPBAD= 64 +global TEST_FACTOR= 100 + + +function res=READ_TEST_SF_ellint(input_name) +global GSL_DBL_EPSILON +global GSL_SQRT_DBL_EPSILON +global TEST_TOL0 +global TEST_TOL1 +global TEST_TOL2 +global TEST_TOL3 +global TEST_TOL4 +global TEST_TOL5 +global TEST_TOL6 +global TEST_SQRT_TOL0 +global TEST_SNGL + +global TEST_SF_INCONS +global TEST_SF_ERRNEG +global TEST_SF_TOLBAD +global TEST_SF_RETBAD +global TEST_SF_ERRBAD +global TEST_SF_ERRBIG +global TEST_SF_EXPBAD + +global TEST_FACTOR + [source_id,source_msg]=fopen(input_name,"r","native") + + + while (! feof(source_id)) + do + input_line=fgetl(source_id); + until( index(input_line,"//") == 0); + + str_p=index(input_line,"gsl_sf_ellint_Kcomp_e"); + if (str_p != 0) + # Take it apart + string_split=char(strsplit(input_line,",")); + arg1=str2double(substr(string_split(3,:),3)); + arg2=str2double(string_split(4,:)); + arg3=(string_split(5,:)); + val=str2double(string_split(6,:)); + tol=eval(string_split(7,:)); + [ret,err]=ellint_Kcomp(arg1,arg2); + # This is to prevent extanious stops on some errors + if ret==NaN + ret=Inf + endif + if (abs((ret-val)/val) +#include +#include +#include "test_sf.h" + + +int test_hyperg(void) +{ + gsl_sf_result r; + int s = 0; + + /* 0F1 */ + + TEST_SF(s, gsl_sf_hyperg_0F1_e, (1, 0.5, &r), 1.5660829297563505373, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_0F1_e, (5, 0.5, &r), 1.1042674404828684574, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_0F1_e, (100, 30, &r), 1.3492598639485110176, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_0F1_e, (-0.5, 3, &r), -39.29137997543434276, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_0F1_e, (-100.5, 50, &r), 0.6087930289227538496, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_0F1_e, (1, -5.0, &r), -0.3268752818235339109, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_0F1_e, (-0.5, -5.0, &r),-4.581634759005381184, TEST_TOL1, GSL_SUCCESS); + + + /* 1F1 for integer parameters */ + + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (1, 1, 0.5, &r), 1.6487212707001281468, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (1, 2, 500.0, &r), 2.8071844357056748215e+214, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (1, 2, -500.0, &r), 0.002, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (8, 1, 0.5, &r), 13.108875178030540372, TEST_TOL0, GSL_SUCCESS); + + + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 1, 1.0, &r), 131.63017574352619931, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 1, 10.0, &r), 8.514625476546280796e+09, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 1, 100.0, &r), 1.5671363646800353320e+56, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 20, 1.0, &r), 1.6585618002669675465, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 20, 10.0, &r), 265.26686430340188871, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 20, 100.0, &r), 3.640477355063227129e+34, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 100, 1.0, &r), 1.1056660194025527099, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 100, 10.0, &r), 2.8491063634727594206, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 100, 40.0, &r), 133.85880835831230986, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 100, 80.0, &r), 310361.16228011433406, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 100, 100.0, &r), 8.032171336754168282e+07, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 100, 500.0, &r), 7.633961202528731426e+123, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 1, 1.0, &r), 6.892842729046469965e+07, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 1, 10.0, &r), 2.4175917112200409098e+28, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 1, 100.0, &r), 1.9303216896309102993e+110, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 200, 1.0, &r), 1.6497469106162459226, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 200, 10.0, &r), 157.93286197349321981, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 200, 100.0, &r), 2.1819577501255075240e+24, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 200, 400.0, &r), 3.728975529926573300e+119, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 400, 10.0, &r), 12.473087623658878813, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 400, 100.0, &r), 9.071230376818550241e+11, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 400, 150.0, &r), 7.160949515742170775e+18, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 400, 200.0, &r), 2.7406690412731576823e+26, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 400, 300.0, &r), 6.175110613473276193e+43, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 400, 400.0, &r), 1.1807417662711371440e+64, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 400, 600.0, &r), 2.4076076354888886030e+112, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 1, -1.0, &r), 0.11394854824644542810, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 1, -10.0, &r), 0.0006715506365396127863, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 1, -100.0, &r), -4.208138537480269868e-32, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 50, -1.0, &r), 0.820006196079380, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 100, -10.0, &r), 0.38378859043466243, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 100, -100.0, &r), 0.0008460143401464189061, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 100, -500.0, &r), 1.1090822141973655929e-08, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (10, 100, -10000.0, &r), 5.173783508088272292e-21, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (50, 1, -90.0, &r), -1.6624258547648311554e-21, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (50, 1, -100.0, &r), 4.069661775122048204e-24, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (50, 1, -110.0, &r), 1.0072444993946236025e-25, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 10, -100.0, &r), -2.7819353611733941962e-37, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 1, -90.0, &r), 7.501705041159802854e-22, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 1, -100.0, &r), 6.305128893152291187e-25, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 1, -110.0, &r), -7.007122115422439755e-26, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (100, 10, -100.0, &r), -2.7819353611733941962e-37, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (200, 50, -1.0, &r), 0.016087060191732290813, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (200, 50, -300.0, &r), -4.294975979706421471e-121, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (200, 100, -1.0, &r), 0.13397521083325179687, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (200, 100, -10.0, &r), 5.835134393749807387e-10, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (200, 100, -100.0, &r), 4.888460453078914804e-74, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (200, 100, -500.0, &r), -1.4478509059582015053e-195, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-1, 1, 2.0, &r), -1.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-1, -2, 2.0, &r), 2.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-2, -3, 2.0, &r), 3.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, 1, 1.0, &r), 0.4189459325396825397, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, 1, 10.0, &r), 27.984126984126984127, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, 1, 100.0, &r), 9.051283795429571429e+12, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-100, 20, 1.0, &r), 0.0020203016320697069566, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, -20, 1.0, &r), 1.6379141878548080173, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, -20, 10.0, &r), 78.65202404521289970, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, -20, 100.0, &r), 4.416169713262624315e+08, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, -100, 1.0, &r), 1.1046713999681950919, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, -100, 10.0, &r), 2.6035952191039006838, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, -100, 100.0, &r), 1151.6852040836932392, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-100, -200, 1.0, &r), 1.6476859702535324743, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-100, -200, 10.0, &r), 139.38026829540687270, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-100, -200, 100.0, &r), 1.1669433576237933752e+19, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, -20, -1.0, &r), 0.6025549561148035735, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, -20, -10.0, &r), 0.00357079636732993491, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, -20, -100.0, &r), 1.64284868563391159e-35, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, -100, -1.0, &r), 0.90442397250313899, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, -100, -10.0, &r), 0.35061515251367215, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-10, -100, -100.0, &r), 8.19512187960476424e-09, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-100, -200, -1.0, &r), 0.6061497939628952629, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-100, -200, -10.0, &r), 0.0063278543908877674, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_int_e, (-100, -200, -100.0, &r), 4.34111795007336552e-25, TEST_TOL2, GSL_SUCCESS); + + + /* 1F1 */ + + TEST_SF(s, gsl_sf_hyperg_1F1_e, (1, 1.5, 1, &r), 2.0300784692787049755, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (1, 1.5, 10, &r), 6172.859561078406855, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (1, 1.5, 100, &r), 2.3822817898485692114e+42, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (1, 1.5, 500, &r), 5.562895351723513581e+215, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (1.5, 2.5, 1, &r), 1.8834451238277954398, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (1.5, 2.5, 10, &r), 3128.7352996840916381, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (10, 1.1, 1, &r), 110.17623733873889579, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (10, 1.1, 10, &r), 6.146657975268385438e+09, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (10, 1.1, 100, &r), 9.331833897230312331e+55, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_hyperg_1F1_e, (10, 1.1, 500, &r), 4.519403368795715843e+235, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (10, 50.1, 2, &r), 1.5001295507968071788, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (10, 50.1, 10, &r), 8.713385849265044908, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (10, 50.1, 100, &r), 5.909423932273380330e+18, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (10, 50.1, 500, &r), 9.740060618457198900e+165, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 1.1, 1, &r), 5.183531067116809033e+07, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 1.1, 10, &r), 1.6032649110096979462e+28, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 1.1, 100, &r), 1.1045151213192280064e+110, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 50.1, 1, &r), 7.222953133216603757, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 50.1, 10, &r), 1.0998696410887171538e+08, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 50.1, 100, &r), 7.235304862322283251e+63, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (1, 1.5, -1, &r), 0.5380795069127684191, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (1, 1.5, -10, &r), 0.05303758099290164485, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (1, 1.5, -100, &r), 0.005025384718759852803, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (1, 1.5, -500, &r), 0.0010010030151059555322, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (1, 1.1, -500, &r), 0.00020036137599690208265, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (10, 1.1, -1, &r), 0.07227645648935938168, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (10, 1.1, -10, &r), 0.0003192415409695588126, TEST_TOL1, GSL_SUCCESS); + /* + sensitive to the pair_ratio hack in hyperg_1F1.c + TEST_SF_RLX(s, gsl_sf_hyperg_1F1_e, (10, 1.1, -100, &r), -8.293425316123158950e-16, 50.0*TEST_SNGL, GSL_SUCCESS); + */ + TEST_SF(s, gsl_sf_hyperg_1F1_e, (10, 1.1, -500, &r), -3.400379216707701408e-23, TEST_TOL2, GSL_SUCCESS); + + TEST_SF_RLX(s, gsl_sf_hyperg_1F1_e, (50, 1.1, -90, &r), -7.843129411802921440e-22, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (50, 1.1, -100, &r), 4.632883869540640460e-24, TEST_SQRT_TOL0, GSL_SUCCESS); + + /* FIXME: + tolerance is poor, but is consistent within reported error + */ + TEST_SF(s, gsl_sf_hyperg_1F1_e, (50, 1.1, -110.0, &r), 5.642684651305310023e-26, 0.03, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 1.1, -1, &r), 0.0811637344096042096, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 1.1, -10, &r), 0.00025945610092231574387, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 1.1, -50, &r), 2.4284830988994084452e-13, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 1.1, -90, &r), 2.4468224638378426461e-22, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 1.1, -99, &r), 1.0507096272617608461e-23, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 1.1, -100, &r), 1.8315497474210138602e-24, TEST_TOL2, GSL_SUCCESS); + + /* FIXME: + Reported error is too small. + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 1.1, -101, &r), -2.3916306291344452490e-24, 0.04, GSL_SUCCESS); + */ + + /* FIXME: + Reported error is too small. + // TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 1.1, -110, &r), -4.517581986037732280e-26, TEST_TOL0, GSL_SUCCESS); + */ + + /* FIXME: + Result is terrible, but reported error is very large, so consistent. + // TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, 10.1, -220, &r), -4.296130300021696573e-64, TEST_TOL1, GSL_SUCCESS); + */ + + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-10, -10.1, 10.0, &r), 10959.603204633058116, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-10, -10.1, 1000.0, &r), 2.0942691895502242831e+23, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-10, -100.1, 10.0, &r), 2.6012036337980078062, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-1000, -1000.1, 10.0, &r), 22004.341698908631636, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-1000, -1000.1, 200.0, &r), 7.066514294896245043e+86, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-8.1, -10.1, -10.0, &r), 0.00018469685276347199258, TEST_TOL0, GSL_SUCCESS); + /* TEST_SF(s, gsl_sf_hyperg_1F1_e, (-8.1, -1000.1, -10.0, &r), 0.9218280185080036020, TEST_TOL0, GSL_SUCCESS); */ + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-10, -5.1, 1, &r), 16.936141866089601635, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-10, -5.1, 10, &r), 771534.0349543820541, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-10, -5.1, 100, &r), 2.2733956505084964469e+17, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, -50.1, -1, &r), 0.13854540373629275583, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, -50.1, -10, &r), -9.142260314353376284e+19, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, -50.1, -100, &r), -1.7437371339223929259e+87, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, -50.1, 1, &r), 7.516831748170351173, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, -50.1, 10, &r), 1.0551632286359671976e+11, TEST_SQRT_TOL0, GSL_SUCCESS); + /* + These come out way off. On the other hand, the error estimates + are also very large; so much so that the answers are consistent + within the reported error. Something will need to be done about + this eventually + // TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, -50.1, 50, &r), -7.564755600940346649e+36, TEST_TOL3, GSL_SUCCESS); +// TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, -50.1, 100, &r), 4.218776962675977e+55, TEST_TOL3, GSL_SUCCESS); + */ + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-10.5, -8.1, 0.1, &r), 1.1387201443786421724, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-10.5, -11.1, 1, &r), 2.5682766147138452362, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100.5, -80.1, 10, &r), 355145.4517305220603, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100.5, -102.1, 10, &r), 18678.558725244365016, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100.5, -500.1, 10, &r), 7.342209011101454, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100.5, -500.1, 100, &r), 1.2077443075367177662e+8, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-500.5, -80.1, 2, &r), 774057.8541325341699, TEST_TOL4, GSL_SUCCESS); + /* + UNIMPL + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, -10.1, 1, &r), -2.1213846338338567395e+12, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, -10.1, 10, &r), -6.624849346145112398e+39, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, -10.1, 100, &r), -1.2413466759089171904e+129, TEST_TOL0, GSL_SUCCESS); + */ + /* + UNIMPL + // TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, -10.1, -1, &r), 34456.29405305551691, TEST_TOL0, GSL_SUCCESS); +// TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, -10.1, -10, &r), -7.809224251467710833e+07, TEST_TOL0, GSL_SUCCESS); +// TEST_SF(s, gsl_sf_hyperg_1F1_e, (100, -10.1, -100, &r), -5.214065452753988395e-07, TEST_TOL0, GSL_SUCCESS); + */ + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, 1.1, 1, &r), 0.21519810496314438414, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, 1.1, 10, &r), 8.196123715597869948, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, 1.1, 100, &r), -1.4612966715976530293e+20, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, 20.1, 1, &r), 0.0021267655527278456412, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, 20.1, 10, &r), 2.0908665169032186979e-11, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, 20.1, 100, &r), -0.04159447537001340412, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, 1.1, -1, &r), 2.1214770215694685282e+07, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, 1.1, -10, &r), 1.0258848879387572642e+24, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, 1.1, -100, &r), 1.1811367147091759910e+67, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, 50.1, -1, &r), 6.965259317271427390, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, 50.1, -10, &r), 1.0690052487716998389e+07, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-100, 50.1, -100, &r), 6.889644435777096248e+36, TEST_TOL3, GSL_SUCCESS); + + + /* Bug report from Fernando Pilotto */ + + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-2.05, 1.0, 5.05, &r), 3.79393389516785e+00, TEST_TOL3, GSL_SUCCESS); + + + /* Bug reports from Ivan Liu */ + + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-26, 2.0, 100.0, &r), 1.444786781107436954e+19, TEST_TOL3, GSL_SUCCESS); + +#if 0 + /* This one is computed with a huge error, there is loss of + precision but the error estimate flags the problem (assuming the + user looks at it). We should probably trap any return with + err>|val| and signal loss of precision */ + + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-26.1, 2.0, 100.0, &r), 1.341557199575986995e+19, TEST_TOL3, GSL_SUCCESS); +#endif + + /* Bug report H.Moseby */ + + TEST_SF(s, gsl_sf_hyperg_1F1_e, (1.2, 1.1e-15, 1.5, &r), 8254503159672429.02, TEST_TOL3, GSL_SUCCESS); + +// TEST_SF(s, gsl_sf_hyperg_1F1_e, (1.0, 1000000.5, 0.8e6 + 0.5, &r), 4.999922505099443804e+00, TEST_TOL3, GSL_SUCCESS); + +// TEST_SF(s, gsl_sf_hyperg_1F1_e, (1.0, 1000000.5, 1001000.5, &r), 3480.3699557431856166, TEST_TOL4, GSL_SUCCESS); + +#if 0 /* FIX THESE NEXT RELEASE */ +// TEST_SF(s, gsl_sf_hyperg_1F1_e, (1.1, 1000000.5, 1001000.5, &r), 7304.6126942641350122, TEST_TOL3, GSL_SUCCESS); +// TEST_SF(s, gsl_sf_hyperg_1F1_e, (0.9, 1000000.5, 1001000.5, &r), 1645.4879293475410982, TEST_TOL3, GSL_SUCCESS); +#endif + + TEST_SF(s, gsl_sf_hyperg_1F1_e, (-1.1, 1000000.5, 1001000.5, &r), -5.30066488697455e-04, TEST_TOL3, GSL_SUCCESS); + +// TEST_SF(s, gsl_sf_hyperg_1F1_e, (1.5, 1000000.5, 0.8e6 + 0.5, &r), 11.18001288977894650469927615, TEST_TOL4, GSL_SUCCESS); + + /* U for integer parameters */ + + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 1, 0.0001, &r), 8.634088070212725330, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 1, 0.01, &r), 4.078511443456425847, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 1, 0.5, &r), 0.9229106324837304688, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 1, 2.0, &r), 0.3613286168882225847, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 1, 100, &r), 0.009901942286733018406, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 1, 1000, &r), 0.0009990019940238807150, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 8, 0.01, &r), 7.272361203006010000e+16, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 8, 1, &r), 1957.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 8, 5, &r), 1.042496, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 8, 8, &r), 0.3207168579101562500, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 8, 50, &r), 0.022660399001600000000, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 8, 100, &r), 0.010631236727200000000, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 8, 1000, &r), 0.0010060301203607207200, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 20, 1, &r), 1.7403456103284421000e+16, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 20, 20, &r), 0.22597813610531052969, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 50, 1, &r), 3.374452117521520758e+61, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 50, 50, &r), 0.15394136814987651785, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 100, 0.1, &r), 1.0418325171990852858e+253, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 100, 1, &r), 2.5624945006073464385e+154, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 100, 50, &r), 3.0978624160896431391e+07, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 100, 100, &r), 0.11323192555773717475, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 100, 200, &r), 0.009715680951406713589, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 100, 1000, &r), 0.0011085142546061528661, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, 1000, 2000, &r), 0.0009970168547036318206, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -1, 1, &r), 0.29817368116159703717, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -1, 10, &r), 0.07816669698940409380, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -10, 1, &r), 0.08271753756946041959, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -10, 5, &r), 0.06127757419425055261, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -10, 10, &r), 0.04656199948873187212, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -10, 20, &r), 0.031606421847946077709, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -100, 0.01, &r), 0.009900000099999796950, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -100, 1, &r), 0.009802970197050404429, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -100, 10, &r), 0.009001648897173103447, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -100, 20, &r), 0.008253126487166557546, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -100, 50, &r), 0.006607993916432051008, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -100, 90, &r), 0.005222713769726871937, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -100, 110, &r), 0.004727658137692606210, TEST_TOL2, GSL_SUCCESS); + TEST_SF_RLX(s, gsl_sf_hyperg_U_int_e, (1, -1000, 1, &r), 0.0009980029970019970050, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (1, -1000, 1010, &r), 0.0004971408839859245170, TEST_TOL4, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (8, 1, 0.001, &r), 0.0007505359326875706975, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (8, 1, 0.5, &r), 6.449509938973479986e-06, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (8, 1, 8, &r), 6.190694573035761284e-10, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (8, 1, 20, &r), 3.647213845460374016e-12, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (8, 8, 1, &r), 0.12289755012652317578, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (8, 8, 10, &r), 5.687710359507564272e-09, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (8, 8, 20, &r), 2.8175404594901039724e-11, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (100, 100, 0.01, &r), 1.0099979491941914867e+196, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (100, 100, 0.1, &r), 1.0090713562719862833e+97, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (100, 100, 1, &r), 0.009998990209084729106, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (100, 100, 20, &r), 1.3239363905866130603e-131, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-10, 1, 0.01, &r), 3.274012540759009536e+06, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-10, 1, 1, &r), 1.5202710000000000000e+06, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-10, 1, 10, &r), 1.0154880000000000000e+08, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-10, 1, 100, &r), 3.284529863685482880e+19, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-10, 10, 1, &r), 1.1043089864100000000e+11, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-10, 100, 1, &r), 1.3991152402448957897e+20, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-10, 100, 10, &r), 5.364469916567136000e+19, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-10, 100, 100, &r), 3.909797568000000000e+12, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-10, 100, 500, &r), 8.082625576697984130e+25, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-50, 1, 0.01, &r), 1.6973422555823855798e+64, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-50, 1, 1, &r), 7.086160198304780325e+63, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-50, 1, 10, &r), 5.332862895528712200e+65, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-50, 10, 1, &r), -7.106713471565790573e+71, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-50, 100, 1, &r), 2.4661377199407186476e+104, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-50, 10, 10, &r), 5.687538583671241287e+68, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-50, 100, 10, &r), 1.7880761664553373445e+102, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-90, 1, 0.01, &r), 4.185245354032917715e+137, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-90, 1, 0.1, &r), 2.4234043408007841358e+137, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-90, 1, 10, &r), -1.8987677149221888807e+139, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-90, 10, 10, &r), -5.682999988842066677e+143, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-90, 100, 10, &r), 2.3410029853990624280e+189, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-90, 1000, 10, &r), 1.9799451517572225316e+271, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-50, -1, 10, &r), -9.083195466262584149e+64, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-50, -10, 10, &r), -1.4418257327071634407e+62, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-50, -100, 0.01, &r), 3.0838993811468983931e+93, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-50, -100, 10, &r), 4.014552630378340665e+95, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-100, -100, 10, &r), 2.0556466922347982030e+162, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-100, -200, 10, &r), 1.1778399522973555582e+219, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_int_e, (-100, -200, 100, &r), 9.861313408898201873e+235, TEST_TOL3, GSL_SUCCESS); + + + /* U */ + + TEST_SF(s, gsl_sf_hyperg_U_e, (0.0001, 0.0001, 0.0001, &r), 1.0000576350699863577, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (0.0001, 0.0001, 1.0, &r), 0.9999403679233247536, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (0.0001, 0.0001, 100.0, &r), 0.9995385992657260887, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (0.0001, 1, 0.0001, &r), 1.0009210608660065989, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (0.0001, 1.0, 1.0, &r), 0.9999999925484179084, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (0.0001, 10, 1, &r), 13.567851006281412726, TEST_TOL3, GSL_SUCCESS); + TEST_SF_RLX(s, gsl_sf_hyperg_U_e, (0.0001, 10, 5, &r), 1.0006265020064596364, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (0.0001, 10, 10, &r), 0.9999244381454633265, TEST_TOL0, GSL_SUCCESS); + TEST_SF_RLX(s, gsl_sf_hyperg_U_e, (0.0001, 100, 1, &r), 2.5890615708804247881e+150, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF_RLX(s, gsl_sf_hyperg_U_e, (0.0001, 100, 10, &r), 2.3127845417739661466e+55, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF_RLX(s, gsl_sf_hyperg_U_e, (0.0001, 100, 50, &r), 6402.818715083582554, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (0.0001, 100, 98, &r), 0.9998517867411840044, TEST_TOL2, GSL_SUCCESS); + TEST_SF_RLX(s, gsl_sf_hyperg_U_e, (0.0001, 1000, 300, &r), 2.5389557274938010716e+213, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (0.0001, 1000, 999, &r), 0.9997195294193261604, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (0.0001, 1000, 1100, &r), 0.9995342990014584713, TEST_TOL1, GSL_SUCCESS); + TEST_SF_RLX(s, gsl_sf_hyperg_U_e, (0.5, 1000, 300, &r), 1.1977955438214207486e+217, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (0.5, 1000, 800, &r), 9.103916020464797207e+08, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (0.5, 1000, 998, &r), 0.21970269691801966806, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (0.5, 0.5, 1.0, &r), 0.7578721561413121060, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (1, 0.0001, 0.0001, &r), 0.9992361337764090785, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (1, 0.0001, 1, &r), 0.4036664068111504538, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (1, 0.0001, 100, &r), 0.009805780851264329587, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (1, 1.2, 2.0, &r), 0.3835044780075602550, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (1, -0.0001, 1, &r), 0.4036388693605999482, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (8, 10.5, 1, &r), 27.981926466707438538, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (8, 10.5, 10, &r), 2.4370135607662056809e-8, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (8, 10.5, 100, &r), 1.1226567526311488330e-16, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (10, -2.5, 10, &r), 6.734690720346560349e-14, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (10, 2.5, 10, &r), 6.787780794037971638e-13, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (10, 2.5, 50, &r), 2.4098720076596087125e-18, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 1.1, 1, &r), -3.990841457734147e+6, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 1.1, 10, &r), 1.307472052129343e+8, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 1.1, 50, &r), 3.661978424114088e+16, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 1.1, 90, &r), 8.09469542130868e+19, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 1.1, 99, &r), 2.546328328942063e+20, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 1.1, 100, &r), 2.870463201832814e+20, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 1.1, 200, &r), 8.05143453769373e+23, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 10.1, 0.1, &r), -3.043016255306515e+20, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 10.1, 1, &r), -3.194745265896115e+12, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 10.1, 4, &r), -6.764203430361954e+07, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 10.1, 10, &r), -2.067399425480545e+09, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 10.1, 50, &r), 4.661837330822824e+14, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 100.4, 10, &r), -6.805460513724838e+66, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 100.4, 50, &r), -2.081052558162805e+18, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 100.4, 80, &r), 2.034113191014443e+14, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 100.4, 100, &r), 6.85047268436107e+13, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-10.5, 100.4, 200, &r), 1.430815706105649e+20, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-19.5, 82.1, 10, &r), 5.464313196201917432e+60, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-50.5, 100.1, 10, &r), -5.5740216266953e+126, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-50.5, 100.1, 40, &r), 5.937463786613894e+91, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-50.5, 100.1, 50, &r), -1.631898534447233e+89, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-50.5, 100.1, 70, &r), 3.249026971618851e+84, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_U_e, (-50.5, 100.1, 100, &r), 1.003401902126641e+85, TEST_TOL1, GSL_SUCCESS); + + + /* 2F1 */ + + TEST_SF(s, gsl_sf_hyperg_2F1_e, (1, 1, 1, 0.5, &r), 2.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (8, 8, 1, 0.5, &r), 12451584.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (8, -8, 1, 0.5, &r), 0.13671875, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (8, -8.1, 1, 0.5, &r), 0.14147385378899930422, TEST_TOL4, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (8, -8, 1, -0.5, &r), 4945.136718750000000, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (8, -8, -5.5, 0.5, &r), -906.6363636363636364, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (8, -8, -5.5, -0.5, &r), 24565.363636363636364, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (8, 8, 1, -0.5, &r), -0.006476312098196747669, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (8, 8, 5, 0.5, &r), 4205.714285714285714, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (8, 8, 5, -0.5, &r), 0.0028489656290296436616, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (9, 9, 1, 0.99, &r), 1.2363536673577259280e+38 , TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (9, 9, -1.5, 0.99, &r), 3.796186436458346579e+46, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (9, 9, -1.5, -0.99, &r), 0.14733409946001025146, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (9, 9, -8.5, 0.99, &r), -1.1301780432998743440e+65, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (9, 9, -8.5, -0.99, &r), -8.856462606575344483, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (9, 9, -21.5, 0.99, &r), 2.0712920991876073253e+95, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (9, 9, -21.5, -0.99, &r), -74.30517015382249216, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (9, 9, -100.5, 0.99, &r), -3.186778061428268980e+262, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (9, 9, -100.5, -0.99, &r), 2.4454358338375677520, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (25, 25, 1, -0.5, &r), -2.9995530823639545027e-06, TEST_SQRT_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_hyperg_2F1_e, (1.5, 0.5, 2.0, 1.0-1.0/64.0, &r), 3.17175539044729373926, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (1.5, 0.5, 2.0, 1.0-1.0/128.0, &r), 3.59937243502024563424, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (1.5, 0.5, 2.0, 1.0-1.0/256.0, &r), 4.03259299524392504369, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (1.5, 0.5, 2.0, 1.0-1.0/1024.0, &r), 4.90784159359675398250, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (1.5, 0.5, 2.0, 1.0-1.0/65536.0, &r), 7.552266033399683914, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (1.5, 0.5, 2.0, 1.0-1.0/16777216.0, &r), 11.08235454026043830363, TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_hyperg_2F1_e, (1.5, 0.5, 2.0, -1.0+1.0/1024.0, &r), 0.762910940909954974527, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (1.5, 0.5, 2.0, -1.0+1.0/65536.0, &r), 0.762762124908845424449, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (1.5, 0.5, 2.0, -1.0+1.0/1048576.0, &r), 0.762759911089064738044, TEST_TOL0, GSL_SUCCESS); + + /* added special handling with x == 1.0 , Richard J. Mathar, 2008-01-09 */ + + TEST_SF(s, gsl_sf_hyperg_2F1_e, (1.5, 0.5, 3.0, 1.0, &r), 1.6976527263135502482014268 , TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (1.5, -4.2, 3.0, 1.0, &r), .15583601560025710649555254 , TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (-7.4, 0.7, -1.5, 1.0, &r), -.34478866959246584996859 , TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_e, (0.1, -2.7, -1.5, 1.0, &r), 1.059766766063610122925 , TEST_TOL0, GSL_SUCCESS); + + /* 2F1 conj */ + + TEST_SF(s, gsl_sf_hyperg_2F1_conj_e, (1, 1, 1, 0.5, &r), 3.352857095662929028, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_conj_e, (8, 8, 1, 0.5, &r), 1.7078067538891293983e+09, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_conj_e, (8, 8, 5, 0.5, &r), 285767.15696901140627, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_conj_e, (8, 8, 1, -0.5, &r), 0.007248196261471276276, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_conj_e, (8, 8, 5, -0.5, &r), 0.00023301916814505902809, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_conj_e, (25, 25, 1, -0.5, &r), 5.1696944096e-06, TEST_SQRT_TOL0, GSL_SUCCESS); + + /* updated correct values, testing enabled, Richard J. Mathar, 2008-01-09 */ + + TEST_SF(s, gsl_sf_hyperg_2F0_e, (0.01, 1.0, -0.02, &r), .99980388665511730901180717 , TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F0_e, (0.1, 0.5, -0.02, &r), .99901595171179281891589794 , TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F0_e, (1, 1, -0.02, &r), .98075549650574351826538049000 , TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F0_e, (8, 8, -0.02, &r), .32990592849626965538692141 , TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F0_e, (50, 50, -0.02, &r), .2688995263772964415245902e-12 , TEST_TOL0, GSL_SUCCESS); + + + /* 2F1 renorm */ + + TEST_SF(s, gsl_sf_hyperg_2F1_renorm_e, (1, 1, 1, 0.5, &r), 2.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_renorm_e, (8, 8, 1, 0.5, &r), 12451584.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_renorm_e, (8, -8, 1, 0.5, &r), 0.13671875, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_renorm_e, (8, -8, 1, -0.5, &r), 4945.13671875, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_renorm_e, (8, -8, -5.5, 0.5, &r), -83081.19167659493609, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_renorm_e, (8, -8, -5.5, -0.5, &r), 2.2510895952730178518e+06, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_renorm_e, (8, 8, 5, 0.5, &r), 175.2380952380952381, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_renorm_e, (9, 9, -1.5, 0.99, &r), 1.6063266334913066551e+46, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_renorm_e, (9, 9, -1.5, -0.99, &r), 0.06234327316254516616, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_renorm_e, (5, 5, -1, 0.5, &r), 4949760.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_renorm_e, (5, 5, -10, 0.5, &r), 139408493229637632000.0, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_renorm_e, (5, 5, -100, 0.5, &r), 3.0200107544594411315e+206, TEST_TOL3, GSL_SUCCESS); + + /* 2F1 conj renorm */ + + TEST_SF(s, gsl_sf_hyperg_2F1_conj_renorm_e, (9, 9, -1.5, 0.99, &r), 5.912269095984229412e+49, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_conj_renorm_e, (9, 9, -1.5, -0.99, &r), 0.10834020229476124874, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_conj_renorm_e, (5, 5, -1, 0.5, &r), 1.4885106335357933625e+08, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_conj_renorm_e, (5, 5, -10, 0.5, &r), 7.968479361426355095e+21, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hyperg_2F1_conj_renorm_e, (5, 5, -100, 0.5, &r), 3.1113180227052313057e+208, TEST_TOL3, GSL_SUCCESS); + + + return s; +} diff --git a/octave_packages/gsl-1.0.8/test_sf.c b/octave_packages/gsl-1.0.8/test_sf.c new file mode 100644 index 0000000..4a9d028 --- /dev/null +++ b/octave_packages/gsl-1.0.8/test_sf.c @@ -0,0 +1,2719 @@ +/* specfunc/test_sf.c + * + * Copyright (C) 2007 Brian Gough + * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004 Gerard Jungman + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 3 of the License, or (at + * your option) any later version. + * + * This program is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + */ + +/* Author: G. Jungman */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include "test_sf.h" + + +double +test_sf_frac_diff(double x1, double x2) +{ + if(x1 == 0.0 && x2 == 0.0) { + return 0.0; + } + else if (x1 == 0.0) { + return fabs(x2); + } else if(x1 <= DBL_MAX && x2 <= DBL_MAX && (x1 + x2 != 0.0)) { + return fabs((x1-x2)/(x1+x2)); + } + else { + return 1.0; + } +} + + +/* Check a result against a given value and tolerance. + */ +int +test_sf_check_result(char * message_buff, gsl_sf_result r, double val, double tol) +{ + int s = 0; + double f = 0, d = 0; + + if (gsl_isnan(r.val) || gsl_isnan(val)) + { + s = (gsl_isnan(r.val) != gsl_isnan(val)) ? TEST_SF_INCONS : s; + } + else if (gsl_isinf(r.val) || gsl_isinf(val)) + { + s = (gsl_isinf(r.val) != gsl_isinf(val)) ? TEST_SF_INCONS : s; + } + else + { + f = test_sf_frac_diff(val, r.val); + d = fabs(val - r.val); + + if(d > 2.0 * TEST_SIGMA * r.err) s |= TEST_SF_INCONS; + if(r.err < 0.0) s |= TEST_SF_ERRNEG; + if(gsl_isinf(r.err)) s |= TEST_SF_ERRBAD; +#if TEST_EXCESSIVE_ERROR + if(d > 0 && r.err > 1e4 * fabs(val)*tol) s |= TEST_SF_ERRBIG; +#endif + if(f > TEST_FACTOR * tol) s |= TEST_SF_TOLBAD; + } + + if(s != 0) { + char buff[2048]; + sprintf(buff, " expected: %20.16e\n", val); + strcat(message_buff, buff); + sprintf(buff, " obtained: %20.16e +/- %.16e (rel=%g)\n", r.val, r.err, r.err/(fabs(r.val) + r.err)); + strcat(message_buff, buff); + sprintf(buff, " fracdiff: %20.16e\n", f); + strcat(message_buff, buff); + sprintf(buff, " tolerance: %20.16e\n", tol); + strcat(message_buff, buff); + } + + if(s & TEST_SF_INCONS) { + strcat(message_buff, " value/expected not consistent within reported error\n"); + } + if(s & TEST_SF_ERRNEG) { + strcat(message_buff, " reported error negative\n"); + } + if(s & TEST_SF_ERRBAD) { + strcat(message_buff, " reported error is bad\n"); + } + if(s & TEST_SF_ERRBIG) { + strcat(message_buff, " reported error is much too big\n"); + } + if(s & TEST_SF_TOLBAD) { + strcat(message_buff, " value not within tolerance of expected value\n"); + } + + return s; +} + +/* Check a result against a given value and tolerance. + */ +int +test_sf_check_e10(char * message_buff, int e10, int e10_in) +{ + int s = 0; + + if (e10 != e10_in) + { + s = TEST_SF_EXPBAD; + } + + if(s != 0) { + char buff[2048]; + sprintf(buff, " expected exponent: 10^%d\n", e10_in); + strcat(message_buff, buff); + sprintf(buff, " obtained exponent: 10^%d", e10); + strcat(message_buff, buff); + } + + if(s & TEST_SF_EXPBAD) { + strcat(message_buff, " exponent is incorrect\n"); + } + + return s; +} + +int +test_sf_check_val(char * message_buff, double rval, double val, double tol) +{ + int s = 0; + double f = test_sf_frac_diff(val, rval); + + if(f > TEST_FACTOR * tol) s |= TEST_SF_TOLBAD; + + if(s != 0) { + char buff[2048]; + sprintf(buff, " expected: %20.16e\n", val); + strcat(message_buff, buff); + sprintf(buff, " obtained: %20.16e\n", rval); + strcat(message_buff, buff); + sprintf(buff, " fracdiff: %20.16e\n", f); + strcat(message_buff, buff); + } + + if(s & TEST_SF_TOLBAD) { + strcat(message_buff, " value not within tolerance of expected value\n"); + } + + return s; +} + + +/* Relax the condition on the agreement and on the usefulness + * of the error estimate. + */ +int +test_sf_check_result_relax(char * message_buff, gsl_sf_result r, double val, double tol) +{ + int s = 0; + double f = test_sf_frac_diff(val, r.val); + + if(f > GSL_MAX_DBL(TEST_SNGL, TEST_FACTOR * tol)) s |= TEST_SF_INCONS; + if(r.err < 0.0) s |= TEST_SF_ERRNEG; + if(gsl_isinf(r.err)) s |= TEST_SF_ERRBAD; + if(f > TEST_FACTOR * tol) s |= TEST_SF_TOLBAD; + + if(s != 0) { + char buff[2048]; + sprintf(buff, " expected: %20.16e\n", val); + strcat(message_buff, buff); + sprintf(buff, " obtained: %20.16e +/- %.16e (rel=%g)\n", r.val, r.err, r.err/(fabs(r.val) + r.err)); + strcat(message_buff, buff); + sprintf(buff, " fracdiff: %20.16e\n", f); + strcat(message_buff, buff); + } + + if(s & TEST_SF_INCONS) { + strcat(message_buff, " value/expected not consistent MAX(tol,SINGLE_PREC)\n"); + } + if(s & TEST_SF_ERRNEG) { + strcat(message_buff, " reported error negative\n"); + } + if(s & TEST_SF_ERRBAD) { + strcat(message_buff, " reported error is bad\n"); + } + if(s & TEST_SF_TOLBAD) { + strcat(message_buff, " value not within tolerance of expected value\n"); + } + + return s; +} + + +/* Check a return value. + */ +int +test_sf_check_return(char * message_buff, int val_return, int expected_return) +{ + if(val_return != expected_return) { + char buff[256]; + sprintf(buff, " unexpected return code: %d\n", val_return); + strcat(message_buff, buff); + return TEST_SF_RETBAD; + } + else { + return 0; + } +} + + +int +test_sf (gsl_sf_result r, double val_in, double tol, int status, + int expect_return, const char * desc) +{ + char message_buff[4096]; + int local_s = 0; + + message_buff[0] = '\0'; + + local_s |= test_sf_check_result(message_buff, r, val_in, tol); + local_s |= test_sf_check_return(message_buff, status, expect_return); + + gsl_test(local_s, desc); + if(local_s != 0) { + /* printf(" %s %d\n", __FILE__, __LINE__); */ + printf("%s", message_buff); + printf(" %22.18e %22.18e\n", r.val, r.err); + } + return local_s; +} + +int +test_sf_e10 (gsl_sf_result_e10 re, double val_in, int e10_in, double tol, int status, + int expect_return, const char * desc) +{ + char message_buff[4096]; + int local_s = 0; + gsl_sf_result r; + r.val = re.val; r.err = re.err; + + message_buff[0] = '\0'; + + local_s |= test_sf_check_result(message_buff, r, val_in, tol); + local_s |= test_sf_check_e10(message_buff, re.e10, e10_in); + local_s |= test_sf_check_return(message_buff, status, expect_return); + + gsl_test(local_s, desc); + if(local_s != 0) { + /* printf(" %s %d\n", __FILE__, __LINE__); */ + printf("%s", message_buff); + printf(" %22.18e %22.18e 10^%d\n", re.val, re.err, re.e10); + } + return local_s; +} + + +int +test_sf_val (double val, double val_in, double tol, const char * desc) +{ + char message_buff[4096]; + int local_s = 0; + + message_buff[0] = '\0'; + + local_s |= test_sf_check_val(message_buff, val, val_in, tol); + + gsl_test(local_s, desc); + if(local_s != 0) { + /* printf(" %s %d\n", __FILE__, __LINE__); */ + printf("%s", message_buff); + printf(" %22.18e\n", val); + } + return local_s; +} + + +int +test_sf_rlx (gsl_sf_result r, double val_in, double tol, int status, + int expect_return, const char * desc) +{ + char message_buff[4096]; + int local_s = 0; + + message_buff[0] = '\0'; + + local_s |= test_sf_check_result_relax(message_buff, r, val_in, tol); + local_s |= test_sf_check_return(message_buff, status, expect_return); + + gsl_test(local_s, desc); + if(local_s != 0) { + /* printf(" %s %d\n", __FILE__, __LINE__); */ + printf("%s", message_buff); + printf(" %22.18e %22.18e\n", r.val, r.err); + } + return local_s; +} + + +int +test_sf_2 (gsl_sf_result r1, double val1, double tol1, + gsl_sf_result r2, double val2, double tol2, + int status, int expect_return, const char * desc) +{ + char message_buff[4096]; + int local_s = 0; + + message_buff[0] = '\0'; + + local_s |= test_sf_check_result(message_buff, r1, val1, tol1); + local_s |= test_sf_check_result(message_buff, r2, val2, tol2); + local_s |= test_sf_check_return(message_buff, status, expect_return); + + gsl_test(local_s, desc); + if(local_s != 0) { + /* printf(" %s %d\n", __FILE__, __LINE__); */ + printf("%s", message_buff); + printf(" %22.18e %22.18e\n", r1.val, r1.err); + printf(" %22.18e %22.18e\n", r2.val, r2.err); + } + return local_s; +} + +int +test_sf_sgn (gsl_sf_result r, double sgn, double val_in, double tol, double expect_sgn, int status, + int expect_return, const char * desc) +{ + char message_buff[4096]; + gsl_sf_result local_r; + int local_s = 0; + + message_buff[0] = '\0'; + + local_r.val = sgn; + local_r.err = 0.0; + local_s |= test_sf_check_result(message_buff, r, val_in, tol); + local_s |= test_sf_check_result(message_buff, local_r, expect_sgn, 0.0); + local_s |= test_sf_check_return(message_buff, status, expect_return); + + gsl_test(local_s, desc); + if(local_s != 0) { + /* printf(" %s %d\n", __FILE__, __LINE__); */ + printf("%s", message_buff); + printf(" %22.18e %22.18e\n", r.val, r.err); + } + return local_s; +} + +int test_clausen(void) +{ + gsl_sf_result r; + int s = 0; + + TEST_SF(s, gsl_sf_clausen_e, (M_PI/20.0, &r), 0.4478882448133546, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_clausen_e, (M_PI/6.0, &r), 0.8643791310538927, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_clausen_e, (M_PI/3.0, &r), 1.0149416064096535, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_clausen_e, ( 2.0*M_PI + M_PI/3.0, &r), 1.0149416064096535, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_clausen_e, (100.0*M_PI + M_PI/3.0, &r), 1.0149416064096535, TEST_TOL0, GSL_SUCCESS); + + return s; +} + + +int test_coupling(void) +{ + gsl_sf_result r; + int s = 0; + + /* Test 3j */ + + TEST_SF(s, gsl_sf_coupling_3j_e, (0, 1, 1, 0, 1, -1, &r), sqrt(1.0/2.0), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_3j_e, (1, 1, 2, 1, -1, 0, &r), sqrt(1.0/6.0), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_3j_e, (2, 4, 6, 0, 2, -2, &r), sqrt(8.0/105.0), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_3j_e, (4, 4, 8, 0, 0, 0, &r), sqrt(2.0/35.0), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_3j_e, (4, 4, 8, 2, -2, 0, &r), 2.0/3.0*sqrt(2.0/35.0), TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_3j_e, (4, 4, 8, 4, -4, 0, &r), 1.0/(3.0*sqrt(70.0)), TEST_TOL2, GSL_SUCCESS); + + /* Test 3j error checking */ + + TEST_SF(s, gsl_sf_coupling_3j_e, (-1, 1, 2, 1, -1, 0, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_3j_e, (1, -1, 2, 1, -1, 0, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_3j_e, (1, 1, -2, 1, -1, 0, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + + /* Test |m_i|<=j_i */ + + TEST_SF(s, gsl_sf_coupling_3j_e, (1, 1, 2, 2, -1, 0, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_3j_e, (1, 1, 2, 1, -2, 0, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_3j_e, (1, 1, 2, 1, -1, 3, &r), 0, 0, GSL_SUCCESS); + + /* Test triangle condition j1 + j2 >= j, j >= j2 - j1, j>= j1 - j2 */ + + TEST_SF(s, gsl_sf_coupling_3j_e, (1, 1, 3, 1, -1, 0, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_3j_e, (1, 4, 2, 1, -1, 0, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_3j_e, (4, 1, 2, 1, -1, 0, &r), 0, 0, GSL_SUCCESS); + + /* Test 6j */ + + TEST_SF(s, gsl_sf_coupling_6j_e, (2, 2, 4, 2, 2, 2, &r), 1.0/6.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_6j_e, (4, 4, 2, 4, 4, 4, &r), -1.0/10.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_6j_e, (4, 4, 2, 4, 4, 2, &r), 1.0/6.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_6j_e, (4, 4, 2, 2, 2, 2, &r), -0.5/sqrt(5.0), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_6j_e, (4, 4, 4, 2, 2, 2, &r), sqrt(7.0/3.0)/10.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_6j_e, (6, 6, 6, 4, 4, 4, &r), -sqrt(3.0/5.0)/14.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_6j_e, (6, 6, 6, 4, 4, 2, &r), -sqrt(3.0/5.0)/7.0, TEST_TOL0, GSL_SUCCESS); + + /* Test 6j error checking */ + + TEST_SF(s, gsl_sf_coupling_6j_e, (-2, 2, 4, 2, 2, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_6j_e, (2, -2, 4, 2, 2, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_6j_e, (2, 2, -4, 2, 2, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_6j_e, (2, 2, 4, -2, 2, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_6j_e, (2, 2, 4, 2, -2, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_6j_e, (2, 2, 4, 2, 2, -2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + + /* Test 6j triangle conditions */ + + TEST_SF(s, gsl_sf_coupling_6j_e, (2, 2, 4, 2, 2, 7, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_6j_e, (2, 2, 4, 2, 7, 2, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_6j_e, (2, 2, 4, 7, 2, 2, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_6j_e, (2, 2, 7, 2, 2, 2, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_6j_e, (2, 7, 4, 2, 2, 2, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_6j_e, (7, 2, 4, 2, 2, 2, &r), 0, 0, GSL_SUCCESS); + + /* Test 9j */ + + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, 3, 3, 2, 1, 1, 2, &r), -sqrt(1.0/6.0)/10.0, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_9j_e, (8, 4, 10, 7, 3, 8, 1, 1, 2, &r), sqrt(7.0/3.0)/60.0, TEST_TOL2, GSL_SUCCESS); + + /* Test 9j error checking */ + + TEST_SF(s, gsl_sf_coupling_9j_e, (-4, 2, 4, 3, 3, 2, 1, 1, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, -2, 4, 3, 3, 2, 1, 1, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, -4, 3, 3, 2, 1, 1, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, -3, 3, 2, 1, 1, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, 3, -3, 2, 1, 1, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, 3, 3, -2, 1, 1, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, 3, 3, 2, -1, 1, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, 3, 3, 2, 1, -1, 2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, 3, 3, 2, 1, 1, -2, &r), GSL_NAN, GSL_NAN, GSL_EDOM); + + TEST_SF(s, gsl_sf_coupling_9j_e, (10, 2, 4, 3, 3, 2, 1, 1, 2, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 10, 4, 3, 3, 2, 1, 1, 2, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 10, 3, 3, 2, 1, 1, 2, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, 10, 3, 2, 1, 1, 2, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, 3, 10, 2, 1, 1, 2, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, 3, 3, 10, 1, 1, 2, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, 3, 3, 2, 10, 1, 2, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, 3, 3, 2, 1, 10, 2, &r), 0, 0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_coupling_9j_e, (4, 2, 4, 3, 3, 2, 1, 1, 10, &r), 0, 0, GSL_SUCCESS); + return s; +} + +int test_dawson(void) +{ + gsl_sf_result r; + int s = 0; + + TEST_SF(s, gsl_sf_dawson_e, (1.0e-15, &r), 1.0e-15, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_dawson_e, (0.5, &r), 0.4244363835020222959, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_dawson_e, (2.0, &r), 0.30134038892379196603, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_dawson_e, (1000.0, &r), 0.0005000002500003750009, TEST_TOL0, GSL_SUCCESS); + + return s; +} + +int test_debye(void) +{ + gsl_sf_result r; + int s = 0; + + TEST_SF(s, gsl_sf_debye_1_e, (0.1, &r), 0.975277750004723276, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_debye_1_e, (1.0, &r), 0.777504634112248239, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_debye_1_e, (10.0, &r), 0.164443465679946027, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_debye_2_e, (0.1, &r), 0.967083287045302664, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_debye_2_e, (1.0, &r), 0.70787847562782924, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_debye_2_e, (10.0, &r), 0.0479714980201218708, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_debye_3_e, (0.1, &r), 0.962999940487211048, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_debye_3_e, (1.0, &r), 0.674415564077814667, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_debye_3_e, (10.0, &r), 0.0192957656903454886, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_debye_4_e, (0.1, &r), 0.960555486124335944, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_debye_4_e, (1.0, &r), 0.654874068886737049, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_debye_4_e, (10.0, &r), 0.00967367556027115896, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_debye_5_e, (0.1, &r), 0.95892849428310568745, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_debye_5_e, (1.0, &r), 0.6421002580217790246, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_debye_5_e, (10.0, &r), 0.005701535852992908538, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_debye_6_e, (0.1, &r), 0.95776777382605465878, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_debye_6_e, (1.0, &r), 0.63311142583495107588, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_debye_6_e, (10.0, &r), 3.7938493294615955279e-3, TEST_TOL0, GSL_SUCCESS); + + return s; +} + + +int test_elementary(void) +{ + gsl_sf_result r; + double x = 0.2*DBL_MAX; + int s = 0; + + TEST_SF(s, gsl_sf_multiply_e, (-3.0,2.0, &r), -6.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_multiply_e, (x, 1.0/x, &r), 1.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_multiply_e, (x, 0.2, &r), 0.04*DBL_MAX, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_multiply_e, (x, 4.0, &r), 0.8*DBL_MAX, TEST_TOL1, GSL_SUCCESS); + s += ( gsl_sf_multiply_e(DBL_MAX, 1.1, &r) != GSL_EOVRFLW); + s += ( gsl_sf_multiply_e(DBL_MIN, DBL_MIN, &r) != GSL_EUNDRFLW); + s += ( gsl_sf_multiply_e(DBL_MIN, -DBL_MIN, &r) != GSL_EUNDRFLW); + + return s; +} + + +int test_ellint(void) +{ + gsl_sf_result r; + gsl_mode_t mode = GSL_MODE_DEFAULT; + int s = 0; + + TEST_SF(s, gsl_sf_ellint_Kcomp_e, ( 0.99, mode, &r), 3.3566005233611923760, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_Kcomp_e, ( 0.50, mode, &r), 1.6857503548125960429, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_Kcomp_e, (0.010, mode, &r), 1.5708355989121522360, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_Ecomp_e, (0.99, mode, &r), 1.0284758090288040010, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_Ecomp_e, (0.50, mode, &r), 1.4674622093394271555, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_Ecomp_e, (0.01, mode, &r), 1.5707570561503852873, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_Pcomp_e, (0.99, 0.1, mode, &r), 3.13792612351836506315593, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_Pcomp_e, (0.50, 0.1, mode, &r), 1.60455249360848890075108, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_Pcomp_e, (0.01, 0.1, mode, &r), 1.49773208536003801277453, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_Dcomp_e, (0.99, mode, &r), 2.375395076351788975665323192, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_Dcomp_e, (0.50, mode, &r), 0.8731525818926755496456335628, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_Dcomp_e, (0.01, mode, &r), 0.7854276176694868932799393751, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (M_PI/3.0, 0.99, mode, &r), 1.3065333392738766762, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (M_PI/3.0, 0.50, mode, &r), 1.0895506700518854093, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (M_PI/3.0, 0.01, mode, &r), 1.0472129063770918952, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (M_PI/3.0, 0.99, mode, &r), 0.8704819220377943536, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (M_PI/3.0, 0.50, mode, &r), 1.0075555551444720293, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (M_PI/3.0, 0.01, mode, &r), 1.0471821963889481104, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (M_PI/3.0, 0.99, 0.5, mode, &r), 1.1288726598764099882, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (M_PI/3.0, 0.50, 0.5, mode, &r), 0.9570574331323584890, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (M_PI/3.0, 0.01, 0.5, mode, &r), 0.9228868127118118465, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_RF_e, (5.0e-11, 1.0e-10, 1.0, mode, &r), 12.36441982979439, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_RF_e, (1.0, 2.0, 3.0, mode, &r), 0.7269459354689082, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_RD_e, (5.0e-11, 1.0e-10, 1.0, mode, &r), 34.0932594919337362, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_RD_e, (1.0, 2.0, 3.0, mode, &r), 0.2904602810289906, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_RC_e, (1.0, 2.0, mode, &r), 0.7853981633974482, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_RJ_e, (2.0, 3.0, 4.0, 5.0, mode, &r), 0.1429757966715675, TEST_TOL0, GSL_SUCCESS); + + /* E, argument phi > pi/2 */ + + TEST_SF(s, gsl_sf_ellint_E_e, (M_PI/2.0, 0.99, mode, &r), 1.02847580902880400098389, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (M_PI/2.0, 0.50, mode, &r), 1.46746220933942715545980, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (M_PI/2.0, 0.01, mode, &r), 1.57075705615038528733708, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (2*M_PI/3.0, 0.99, mode, &r), 1.18646969601981364833972, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (2*M_PI/3.0, 0.50, mode, &r), 1.92736886353438228163734, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (2*M_PI/3.0, 0.01, mode, &r), 2.09433191591182246425715, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (M_PI, 0.99, mode, &r), 2.05695161805760800196777, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (M_PI, 0.50, mode, &r), 2.93492441867885431091959, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (M_PI, 0.01, mode, &r), 3.14151411230077057467416, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (4*M_PI/3, 0.99, mode, &r), 2.92743354009540235559582, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (4*M_PI/3, 0.50, mode, &r), 3.94247997382332634020184, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (4*M_PI/3, 0.01, mode, &r), 4.18869630868971868509117, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (3*M_PI/2.0, 0.99, mode, &r), 3.08542742708641200295166, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (3*M_PI/2.0, 0.50, mode, &r), 4.40238662801828146637939, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (3*M_PI/2.0, 0.01, mode, &r), 4.71227116845115586201123, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (5*M_PI/3, 0.99, mode, &r), 3.24342131407742165030750, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (5*M_PI/3, 0.50, mode, &r), 4.86229328221323659255693, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (5*M_PI/3, 0.01, mode, &r), 5.23584602821259303893130, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (2*M_PI, 0.99, mode, &r), 4.11390323611521600393555, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (2*M_PI, 0.50, mode, &r), 5.86984883735770862183918, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (2*M_PI, 0.01, mode, &r), 6.28302822460154114934831, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (7*M_PI/3.0, 0.99, mode, &r), 4.98438515815301035756360, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (7*M_PI/3.0, 0.50, mode, &r), 6.87740439250218065112143, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (7*M_PI/3.0, 0.01, mode, &r), 7.33021042099048925976532, TEST_TOL0, GSL_SUCCESS); + + /* Test some negative arguments, phi < 0 */ + + TEST_SF(s, gsl_sf_ellint_E_e, (-M_PI/2.0, 0.99, mode, &r), -1.02847580902880400098389, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-M_PI/2.0, 0.50, mode, &r), -1.46746220933942715545980, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-M_PI/2.0, 0.01, mode, &r), -1.57075705615038528733708, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (-2*M_PI/3.0, 0.99, mode, &r), -1.18646969601981364833972, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-2*M_PI/3.0, 0.50, mode, &r), -1.92736886353438228163734, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-2*M_PI/3.0, 0.01, mode, &r), -2.09433191591182246425715, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (-M_PI, 0.99, mode, &r), -2.05695161805760800196777, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-M_PI, 0.50, mode, &r), -2.93492441867885431091959, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-M_PI, 0.01, mode, &r), -3.14151411230077057467416, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (-4*M_PI/3, 0.99, mode, &r), -2.92743354009540235559582, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-4*M_PI/3, 0.50, mode, &r), -3.94247997382332634020184, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-4*M_PI/3, 0.01, mode, &r), -4.18869630868971868509117, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (-3*M_PI/2.0, 0.99, mode, &r), -3.08542742708641200295166, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-3*M_PI/2.0, 0.50, mode, &r), -4.40238662801828146637939, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-3*M_PI/2.0, 0.01, mode, &r), -4.71227116845115586201123, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (-5*M_PI/3, 0.99, mode, &r), -3.24342131407742165030750, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-5*M_PI/3, 0.50, mode, &r), -4.86229328221323659255693, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-5*M_PI/3, 0.01, mode, &r), -5.23584602821259303893130, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (-2*M_PI, 0.99, mode, &r), -4.11390323611521600393555, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-2*M_PI, 0.50, mode, &r), -5.86984883735770862183918, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-2*M_PI, 0.01, mode, &r), -6.28302822460154114934831, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_E_e, (-7*M_PI/3.0, 0.99, mode, &r), -4.98438515815301035756360, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-7*M_PI/3.0, 0.50, mode, &r), -6.87740439250218065112143, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_E_e, (-7*M_PI/3.0, 0.01, mode, &r), -7.33021042099048925976532, TEST_TOL0, GSL_SUCCESS); + + + /* F, argument phi > pi/2 */ + + TEST_SF(s, gsl_sf_ellint_F_e, (M_PI/2.0, 0.99, mode, &r), 3.35660052336119237603347, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (M_PI/2.0, 0.50, mode, &r), 1.68575035481259604287120, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (M_PI/2.0, 0.01, mode, &r), 1.57083559891215223602641, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (2*M_PI/3.0, 0.99, mode, &r), 5.40666770744850807588478, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (2*M_PI/3.0, 0.50, mode, &r), 2.28195003957330667648585, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (2*M_PI/3.0, 0.01, mode, &r), 2.09445829144721257687207, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (M_PI, 0.99, mode, &r), 6.71320104672238475206694, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (M_PI, 0.50, mode, &r), 3.37150070962519208574241, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (M_PI, 0.01, mode, &r), 3.14167119782430447205281, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (4*M_PI/3, 0.99, mode, &r), 8.01973438599626142824910, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (4*M_PI/3, 0.50, mode, &r), 4.46105137967707749499897, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (4*M_PI/3, 0.01, mode, &r), 4.18888410420139636723356, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (3*M_PI/2.0, 0.99, mode, &r), 10.0698015700835771281004, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (3*M_PI/2.0, 0.50, mode, &r), 5.05725106443778812861361, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (3*M_PI/2.0, 0.01, mode, &r), 4.71250679673645670807922, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (5*M_PI/3, 0.99, mode, &r), 12.1198687541708928279517, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (5*M_PI/3, 0.50, mode, &r), 5.65345074919849876222825, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (5*M_PI/3, 0.01, mode, &r), 5.23612948927151704892488, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (2*M_PI, 0.99, mode, &r), 13.4264020934447695041339, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (2*M_PI, 0.50, mode, &r), 6.74300141925038417148481, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (2*M_PI, 0.01, mode, &r), 6.28334239564860894410562, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (7*M_PI/3.0, 0.99, mode, &r), 14.7329354327186461803160, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (7*M_PI/3.0, 0.50, mode, &r), 7.83255208930226958074138, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (7*M_PI/3.0, 0.01, mode, &r), 7.33055530202570083928637, TEST_TOL0, GSL_SUCCESS); + + /* F, negative argument phi < 0 */ + + TEST_SF(s, gsl_sf_ellint_F_e, (-M_PI/2.0, 0.99, mode, &r), -3.35660052336119237603347, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-M_PI/2.0, 0.50, mode, &r), -1.68575035481259604287120, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-M_PI/2.0, 0.01, mode, &r), -1.57083559891215223602641, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (-2*M_PI/3.0, 0.99, mode, &r), -5.40666770744850807588478, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-2*M_PI/3.0, 0.50, mode, &r), -2.28195003957330667648585, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-2*M_PI/3.0, 0.01, mode, &r), -2.09445829144721257687207, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (-M_PI, 0.99, mode, &r), -6.71320104672238475206694, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-M_PI, 0.50, mode, &r), -3.37150070962519208574241, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-M_PI, 0.01, mode, &r), -3.14167119782430447205281, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (-4*M_PI/3, 0.99, mode, &r), -8.01973438599626142824910, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-4*M_PI/3, 0.50, mode, &r), -4.46105137967707749499897, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-4*M_PI/3, 0.01, mode, &r), -4.18888410420139636723356, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (-3*M_PI/2.0, 0.99, mode, &r), -10.0698015700835771281004, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-3*M_PI/2.0, 0.50, mode, &r), -5.05725106443778812861361, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-3*M_PI/2.0, 0.01, mode, &r), -4.71250679673645670807922, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (-5*M_PI/3, 0.99, mode, &r), -12.1198687541708928279517, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-5*M_PI/3, 0.50, mode, &r), -5.65345074919849876222825, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-5*M_PI/3, 0.01, mode, &r), -5.23612948927151704892488, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (-2*M_PI, 0.99, mode, &r), -13.4264020934447695041339, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-2*M_PI, 0.50, mode, &r), -6.74300141925038417148481, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-2*M_PI, 0.01, mode, &r), -6.28334239564860894410562, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_F_e, (-7*M_PI/3.0, 0.99, mode, &r), -14.7329354327186461803160, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-7*M_PI/3.0, 0.50, mode, &r), -7.83255208930226958074138, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_F_e, (-7*M_PI/3.0, 0.01, mode, &r), -7.33055530202570083928637, TEST_TOL0, GSL_SUCCESS); + + /* P, argument phi > pi/2 */ + + TEST_SF(s, gsl_sf_ellint_P_e, (M_PI/2.0, 0.99, -0.1, mode, &r), 3.61678162163246646783050, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (M_PI/2.0, 0.50, -0.1, mode, &r), 1.78030349465454812629168, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (M_PI/2.0, 0.01, -0.1, mode, &r), 1.65580719756898353270922, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (2*M_PI/3.0, 0.99, -0.1, mode, &r), 5.88008918207571119911983, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (2*M_PI/3.0, 0.50, -0.1, mode, &r), 2.43655207300356008717867, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (2*M_PI/3.0, 0.01, -0.1, mode, &r), 2.23211110528200554950903, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (M_PI, 0.99, -0.1, mode, &r), 7.23356324326493293566099, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (M_PI, 0.50, -0.1, mode, &r), 3.56060698930909625258336, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (M_PI, 0.01, -0.1, mode, &r), 3.31161439513796706541844, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (4*M_PI/3, 0.99, -0.1, mode, &r), 8.58703730445415467220216, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (4*M_PI/3, 0.50, -0.1, mode, &r), 4.68466190561463241798805, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (4*M_PI/3, 0.01, -0.1, mode, &r), 4.39111768499392858132786, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (3*M_PI/2.0, 0.99, -0.1, mode, &r), 10.8503448648973994034915, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (3*M_PI/2.0, 0.50, -0.1, mode, &r), 5.34091048396364437887504, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (3*M_PI/2.0, 0.01, -0.1, mode, &r), 4.96742159270695059812767, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (5*M_PI/3, 0.99, -0.1, mode, &r), 13.1136524253406441347808, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (5*M_PI/3, 0.50, -0.1, mode, &r), 5.99715906231265633976204, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (5*M_PI/3, 0.01, -0.1, mode, &r), 5.54372550041997261492747, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (2*M_PI, 0.99, -0.1, mode, &r), 14.4671264865298658713220, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (2*M_PI, 0.50, -0.1, mode, &r), 7.12121397861819250516672, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (2*M_PI, 0.01, -0.1, mode, &r), 6.62322879027593413083689, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (7*M_PI/3.0, 0.99, -0.1, mode, &r), 15.8206005477190876078631, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (7*M_PI/3.0, 0.50, -0.1, mode, &r), 8.24526889492372867057141, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (7*M_PI/3.0, 0.01, -0.1, mode, &r), 7.70273208013189564674630, TEST_TOL0, GSL_SUCCESS); + + /* P, negative argument phi < 0 */ + + TEST_SF(s, gsl_sf_ellint_P_e, (-M_PI/2.0, 0.99, -0.1, mode, &r), -3.61678162163246646783050, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-M_PI/2.0, 0.50, -0.1, mode, &r), -1.78030349465454812629168, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-M_PI/2.0, 0.01, -0.1, mode, &r), -1.65580719756898353270922, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (-2*M_PI/3.0, 0.99, -0.1, mode, &r), -5.88008918207571119911983, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-2*M_PI/3.0, 0.50, -0.1, mode, &r), -2.43655207300356008717867, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-2*M_PI/3.0, 0.01, -0.1, mode, &r), -2.23211110528200554950903, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (-M_PI, 0.99, -0.1, mode, &r), -7.23356324326493293566099, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-M_PI, 0.50, -0.1, mode, &r), -3.56060698930909625258336, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-M_PI, 0.01, -0.1, mode, &r), -3.31161439513796706541844, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (-4*M_PI/3, 0.99, -0.1, mode, &r), -8.58703730445415467220216, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-4*M_PI/3, 0.50, -0.1, mode, &r), -4.68466190561463241798805, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-4*M_PI/3, 0.01, -0.1, mode, &r), -4.39111768499392858132786, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (-3*M_PI/2.0, 0.99, -0.1, mode, &r), -10.8503448648973994034915, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-3*M_PI/2.0, 0.50, -0.1, mode, &r), -5.34091048396364437887504, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-3*M_PI/2.0, 0.01, -0.1, mode, &r), -4.96742159270695059812767, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (-5*M_PI/3, 0.99, -0.1, mode, &r), -13.1136524253406441347808, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-5*M_PI/3, 0.50, -0.1, mode, &r), -5.99715906231265633976204, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-5*M_PI/3, 0.01, -0.1, mode, &r), -5.54372550041997261492747, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (-2*M_PI, 0.99, -0.1, mode, &r), -14.4671264865298658713220, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-2*M_PI, 0.50, -0.1, mode, &r), -7.12121397861819250516672, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-2*M_PI, 0.01, -0.1, mode, &r), -6.62322879027593413083689, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_P_e, (-7*M_PI/3.0, 0.99, -0.1, mode, &r), -15.8206005477190876078631, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-7*M_PI/3.0, 0.50, -0.1, mode, &r), -8.24526889492372867057141, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_P_e, (-7*M_PI/3.0, 0.01, -0.1, mode, &r), -7.70273208013189564674630, TEST_TOL0, GSL_SUCCESS); + + /* D, argument phi > pi/2 */ + + TEST_SF(s, gsl_sf_ellint_D_e, (M_PI/2.0, 0.99, 0, mode, &r), 2.375395076351788975665323192, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (M_PI/2.0, 0.50, 0, mode, &r), 0.8731525818926755496456335628, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (M_PI/2.0, 0.01, 0, mode, &r), 0.7854276176694868932799393751, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (2*M_PI/3.0, 0.99, 0, mode, &r), 4.305885125424644860264320635, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (2*M_PI/3.0, 0.50, 0, mode, &r), 1.418324704155697579394036402, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (2*M_PI/3.0, 0.01, 0, mode, &r), 1.263755353901126149206022061, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (M_PI, 0.99, 0, mode, &r), 4.750790152703577951330646444, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (M_PI, 0.50, 0, mode, &r), 1.746305163785351099291267125, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (M_PI, 0.01, 0, mode, &r), 1.570855235338973786559878750, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (4*M_PI/3, 0.99, 0, mode, &r), 5.195695179982511042396972113, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (4*M_PI/3, 0.50, 0, mode, &r), 2.074285623415004619188497818, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (4*M_PI/3, 0.01, 0, mode, &r), 1.877955116776821423913735408, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (3*M_PI/2.0, 0.99, 0, mode, &r), 7.126185229055366926995969476, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (3*M_PI/2.0, 0.50, 0, mode, &r), 2.619457745678026648936900687, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (3*M_PI/2.0, 0.01, 0, mode, &r), 2.356282853008460679839818125, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (5*M_PI/3, 0.99, 0, mode, &r), 9.056675278128222811594967044, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (5*M_PI/3, 0.50, 0, mode, &r), 3.164629867941048678685303509, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (5*M_PI/3, 0.01, 0, mode, &r), 2.834610589240099935765900794, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (2*M_PI, 0.99, 0, mode, &r), 9.501580305407155902661292832, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (2*M_PI, 0.50, 0, mode, &r), 3.492610327570702198582534249, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (2*M_PI, 0.01, 0, mode, &r), 3.141710470677947573119757500, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (7*M_PI/3.0, 0.99, 0, mode, &r), 9.946485332686088993727618315, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (7*M_PI/3.0, 0.50, 0, mode, &r), 3.820590787200355718479764901, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (7*M_PI/3.0, 0.01, 0, mode, &r), 3.448810352115795210473614120, TEST_TOL0, GSL_SUCCESS); + + /* P, negative argument phi < 0 */ + + TEST_SF(s, gsl_sf_ellint_D_e, (-M_PI/2.0, 0.99, 0, mode, &r), -2.375395076351788975665323192, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-M_PI/2.0, 0.50, 0, mode, &r), -0.8731525818926755496456335628, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-M_PI/2.0, 0.01, 0, mode, &r), -0.7854276176694868932799393751, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (-2*M_PI/3.0, 0.99, 0, mode, &r), -4.305885125424644860264320635, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-2*M_PI/3.0, 0.50, 0, mode, &r), -1.418324704155697579394036402, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-2*M_PI/3.0, 0.01, 0, mode, &r), -1.263755353901126149206022061, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (-M_PI, 0.99, 0, mode, &r), -4.750790152703577951330646444, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-M_PI, 0.50, 0, mode, &r), -1.746305163785351099291267125, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-M_PI, 0.01, 0, mode, &r), -1.570855235338973786559878750, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (-4*M_PI/3, 0.99, 0, mode, &r), -5.195695179982511042396972113, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-4*M_PI/3, 0.50, 0, mode, &r), -2.074285623415004619188497818, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-4*M_PI/3, 0.01, 0, mode, &r), -1.877955116776821423913735408, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (-3*M_PI/2.0, 0.99, 0, mode, &r), -7.126185229055366926995969476, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-3*M_PI/2.0, 0.50, 0, mode, &r), -2.619457745678026648936900687, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-3*M_PI/2.0, 0.01, 0, mode, &r), -2.356282853008460679839818125, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (-5*M_PI/3, 0.99, 0, mode, &r), -9.056675278128222811594967044, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-5*M_PI/3, 0.50, 0, mode, &r), -3.164629867941048678685303509, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-5*M_PI/3, 0.01, 0, mode, &r), -2.834610589240099935765900794, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (-2*M_PI, 0.99, 0, mode, &r), -9.501580305407155902661292832, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-2*M_PI, 0.50, 0, mode, &r), -3.492610327570702198582534249, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-2*M_PI, 0.01, 0, mode, &r), -3.141710470677947573119757500, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_ellint_D_e, (-7*M_PI/3.0, 0.99, 0, mode, &r), -9.946485332686088993727618315, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-7*M_PI/3.0, 0.50, 0, mode, &r), -3.820590787200355718479764901, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_ellint_D_e, (-7*M_PI/3.0, 0.01, 0, mode, &r), -3.448810352115795210473614120, TEST_TOL0, GSL_SUCCESS); + + return s; +} + + +int test_erf(void) +{ + gsl_sf_result r; + int s = 0; + + TEST_SF(s, gsl_sf_erfc_e, (-10.0, &r), 2.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_erfc_e, (-5.0000002, &r), 1.9999999999984625433, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_erfc_e, (-5.0, &r), 1.9999999999984625402, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_erfc_e, (-1.0, &r), 1.8427007929497148693, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_erfc_e, (-0.5, &r), 1.5204998778130465377, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_erfc_e, (1.0, &r), 0.15729920705028513066, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_erfc_e, (3.0, &r), 0.000022090496998585441373, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_erfc_e, (7.0, &r), 4.183825607779414399e-23, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_erfc_e, (10.0, &r), 2.0884875837625447570e-45, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_log_erfc_e, (-1.0, &r), log(1.842700792949714869), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_erfc_e, (-0.1, &r), 0.106576400586522485015, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_erfc_e, (-1e-10, &r), 1.1283791670318505967e-10, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_erfc_e, (0.0, &r), log(1.0), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_erfc_e, (1e-10, &r), -1.128379167159174551e-10, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_erfc_e, (0.001, &r), -0.0011290158896213548027, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_erfc_e, (0.1, &r), -0.119304973737395598329, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_erfc_e, (1.0, &r), log(0.15729920705028513066), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_erfc_e, (10.0, &r), log(2.0884875837625447570e-45), TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_erf_e, (-10.0, &r), -1.0000000000000000000, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_erf_e, (0.5, &r), 0.5204998778130465377, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_erf_e, (1.0, &r), 0.8427007929497148693, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_erf_e, (10.0, &r), 1.0000000000000000000, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_erf_Z_e, (1.0, &r), 0.24197072451914334980, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_erf_Q_e, (10.0, &r), 7.619853024160526066e-24, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_hazard_e, (-20.0, &r), 5.5209483621597631896e-88, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, (-10.0, &r), 7.6945986267064193463e-23, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, (-1.0, &r), 0.28759997093917836123, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, ( 0.0, &r), 0.79788456080286535588, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, ( 1.0, &r), 1.5251352761609812091, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, (10.0, &r), 10.098093233962511963, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, (20.0, &r), 20.049753068527850542, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, (30.0, &r), 30.033259667433677037, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, (50.0, &r), 50.019984031905639809, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, (80.0, &r), 80.012496096798234468, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, (150.0, &r), 150.00666607420571802, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, (300.0, &r), 300.00333325926337415, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, (900.0, &r), 900.00111110836764382, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, (1001.0, &r), 1001.0009989990049990, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hazard_e, (2000.0, &r), 2000.0004999997500003, TEST_TOL0, GSL_SUCCESS); + + return s; +} + + +int test_exp(void) +{ + gsl_sf_result r; + gsl_sf_result_e10 re; + double x; + int sa; + int s = 0; + + TEST_SF(s, gsl_sf_exp_e, (-10.0, &r), exp(-10.0), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_e, ( 10.0, &r), exp( 10.0), TEST_TOL0, GSL_SUCCESS); + + sa = 0; + sa += gsl_sf_exp_e10_e(1.0, &re); + sa += ( test_sf_frac_diff(re.val, M_E ) > TEST_TOL0 ); + sa += ( re.err > TEST_TOL1 ); + sa += ( re.e10 != 0 ); + gsl_test(sa, " gsl_sf_exp_e10_e(1.0, &re)"); + + sa = 0; + sa += gsl_sf_exp_e10_e(2000.0, &re); + sa += ( test_sf_frac_diff(re.val, 3.88118019428363725 ) > TEST_TOL3 ); + sa += ( re.err > TEST_TOL5 ); + sa += ( re.e10 != 868 ); + gsl_test(sa, " gsl_sf_exp_e10_e(2000.0, &re)"); + + + TEST_SF(s, gsl_sf_exp_err_e, (-10.0, TEST_TOL1, &r), exp(-10.0), TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_err_e, ( 10.0, TEST_TOL1, &r), exp( 10.0), TEST_TOL1, GSL_SUCCESS); + + sa = 0; + sa += gsl_sf_exp_err_e10_e(1.0, TEST_SQRT_TOL0, &re); + sa += ( test_sf_frac_diff(re.val, M_E ) > TEST_TOL1 ); + sa += ( re.err > 32.0 * TEST_SQRT_TOL0 ); + sa += ( re.e10 != 0 ); + gsl_test(sa, " gsl_sf_exp_err_e10_e(1.0, TEST_SQRT_TOL0, &re)"); + + sa = 0; + sa += gsl_sf_exp_err_e10_e(2000.0, 1.0e-10, &re); + sa += ( test_sf_frac_diff(re.val, 3.88118019428363725 ) > TEST_TOL3 ); + sa += ( re.err > 1.0e-07 ); + sa += ( re.e10 != 868 ); + gsl_test(sa, " gsl_sf_exp_err_e10_e(2000.0, 1.0e-10, &re)"); + + + x = 0.8*GSL_LOG_DBL_MAX; + TEST_SF(s, gsl_sf_exp_mult_e, (-10.0, 1.0e-06, &r), 1.0e-06*exp(-10.0), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_mult_e, (-10.0, 2.0, &r), 2.0*exp(-10.0), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_mult_e, (-10.0, -2.0, &r), -2.0*exp(-10.0), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_mult_e, ( 10.0, 1.0e-06, &r), 1.0e-06*exp( 10.0), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_mult_e, ( 10.0, -2.0, &r), -2.0*exp( 10.0), TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_mult_e, (x, 1.00001, &r), 1.00001*exp(x), TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_mult_e, (x, 1.000001, &r), 1.000001*exp(x), TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_mult_e, (x, 1.000000001, &r), 1.000000001*exp(x), TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_mult_e, (x, 100.0, &r), 100.0*exp(x), TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_mult_e, (x, 1.0e+20, &r), 1.0e+20*exp(x), TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_mult_e, (x, exp(-x)*exp(M_LN2), &r), 2.0, TEST_TOL4, GSL_SUCCESS ); + + TEST_SF(s, gsl_sf_exp_mult_err_e, (-10.0, TEST_SQRT_TOL0, 2.0, TEST_SQRT_TOL0, &r), 2.0*exp(-10.0), TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exp_mult_err_e, (x, TEST_SQRT_TOL0*x, exp(-x)*exp(M_LN2), TEST_SQRT_TOL0*exp(-x)*exp(M_LN2), &r), 2.0, TEST_SQRT_TOL0, GSL_SUCCESS ); + + sa = 0; + sa += gsl_sf_exp_mult_e10_e(1.0, 1.0, &re); + sa += ( test_sf_frac_diff(re.val, M_E ) > TEST_TOL0 ); + sa += ( re.err > TEST_TOL2 ); + sa += ( re.e10 != 0 ); + gsl_test(sa, "gsl_sf_exp_mult_e10_e(1.0, 1.0, &re)"); + TEST_SF_E10(s, gsl_sf_exp_mult_e10_e, (1.0, 1.0, &re), M_E, 0, TEST_TOL0, GSL_SUCCESS); + + sa = 0; + sa += gsl_sf_exp_mult_e10_e(1000.0, 1.0e+200, &re); + sa += ( test_sf_frac_diff(re.val, 1.970071114017046993888879352) > TEST_TOL3 ); + sa += ( re.err > 1.0e-11 ); + sa += ( re.e10 != 634 ); + gsl_test(sa, "gsl_sf_exp_mult_e10_e(1000.0, 1.0e+200, &re)"); + TEST_SF_E10(s, gsl_sf_exp_mult_e10_e, (1000.0, 1.0e+200, &re), 1.970071114017046993888879352, 634, TEST_TOL3, GSL_SUCCESS); + + sa = 0; + sa += gsl_sf_exp_mult_err_e10_e(1.0, TEST_TOL0, 1.0, TEST_TOL0, &re); + sa += ( test_sf_frac_diff(re.val, M_E ) > TEST_TOL0 ); + sa += ( re.err > TEST_TOL2 ); + sa += ( re.e10 != 0 ); + gsl_test(sa, "gsl_sf_exp_mult_err_e10_e(1.0, TEST_TOL0, 1.0, TEST_TOL0, &re)"); + TEST_SF_E10(s, gsl_sf_exp_mult_err_e10_e, (1.0, TEST_TOL0, 1.0, TEST_TOL0, &re), M_E, 0, TEST_TOL0, GSL_SUCCESS); + + sa = 0; + sa += gsl_sf_exp_mult_err_e10_e(1000.0, 1.0e-12, 1.0e+200, 1.0e+190, &re); + sa += ( test_sf_frac_diff(re.val, 1.9700711140165661 ) > TEST_TOL3 ); + sa += ( re.err > 1.0e-09 ); + sa += ( re.e10 != 634 ); + gsl_test(sa, "gsl_sf_exp_mult_err_e10_e(1.0e-12, 1.0e+200, &re)"); + TEST_SF_E10(s, gsl_sf_exp_mult_err_e10_e, (1000.0, 1.0e-12, 1.0e+200, 1.0e+190, &re), 1.9700711140165661,634, TEST_TOL3, GSL_SUCCESS); + + /* Test cases from Szymon Jaroszewicz */ + + TEST_SF_E10(s, gsl_sf_exp_mult_e10_e, (10000.0, 1.0, &re), 8.806818225662921587261496007, 4342, TEST_TOL5, GSL_SUCCESS); + TEST_SF_E10(s, gsl_sf_exp_mult_e10_e, (100.0, 1.0, &re), 2.688117141816135448412625551e43, 0, TEST_TOL1, GSL_SUCCESS); + TEST_SF_E10(s, gsl_sf_exp_e10_e, (100.0, &re), 2.688117141816135448412625551e43, 0, TEST_TOL1, GSL_SUCCESS); + TEST_SF_E10(s, gsl_sf_exp_e10_e, (1000.0, &re), 1.970071114017046993888879352, 434, TEST_TOL1, GSL_SUCCESS); + TEST_SF_E10(s, gsl_sf_exp_e10_e, (-100.0, &re), 3.720075976020835962959695803e-44, 0, TEST_TOL1, GSL_SUCCESS); + TEST_SF_E10(s, gsl_sf_exp_e10_e, (-1000.0, &re), 5.075958897549456765291809479, -435, TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_expm1_e, (-10.0, &r), exp(-10.0)-1.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expm1_e, (-0.001, &r), -0.00099950016662500845, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expm1_e, (-1.0e-8, &r), -1.0e-08 + 0.5e-16, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expm1_e, ( 1.0e-8, &r), 1.0e-08 + 0.5e-16, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expm1_e, ( 0.001, &r), 0.0010005001667083417, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expm1_e, ( 10.0, &r), exp(10.0)-1.0, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_exprel_e, (-10.0, &r), 0.0999954600070237515, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_e, (-0.001, &r), 0.9995001666250084, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_e, (-1.0e-8, &r), 1.0 - 0.5e-08, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_e, ( 1.0e-8, &r), 1.0 + 0.5e-08, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_e, ( 0.001, &r), 1.0005001667083417, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_e, ( 10.0, &r), 2202.5465794806716517, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_exprel_2_e, (-10.0, &r), 0.18000090799859524970, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_2_e, (-0.001, &r), 0.9996667499833361107, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_2_e, (-1.0e-8, &r), 0.9999999966666666750, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_2_e, ( 1.0e-8, &r), 1.0000000033333333417, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_2_e, ( 0.001, &r), 1.0003334166833361115, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_2_e, ( 10.0, &r), 440.3093158961343303, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_exprel_n_e, (3, -1000.0, &r), 0.00299400600000000000, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (3, -100.0, &r), 0.02940600000000000000, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (3, -10.0, &r), 0.24599972760042142509, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (3, -3.0, &r), 0.5444917625849191238, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (3, -0.001, &r), 0.9997500499916678570, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (3, -1.0e-8, &r), 0.9999999975000000050, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (3, 1.0e-8, &r), 1.0000000025000000050, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (3, 0.001, &r), 1.0002500500083345240, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (3, 3.0, &r), 2.5745637607083706091, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (3, 3.1, &r), 2.6772417068460206247, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (3, 10.0, &r), 131.79279476884029910, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (3, 100.0, &r), 1.6128702850896812690e+38, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_exprel_n_e, (50, -1000.0, &r), 0.04766231609253975959, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (50, -100.0, &r), 0.3348247572345889317, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (50, -10.0, &r), 0.8356287051853286482, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (50, -3.0, &r), 0.9443881609152163615, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (50, -1.0, &r), 0.980762245565660617, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (50, -1.0e-8, &r), 1.0 -1.0e-8/51.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (50, 1.0e-8, &r), 1.0 +1.0e-8/51.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (50, 1.0, &r), 1.01999216583666790, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (50, 3.0, &r), 1.0624205757460368307, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (50, 48.0, &r), 7.499573876877194416, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (50, 50.1, &r), 9.311803306230992272, TEST_TOL4, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (50, 100.0, &r), 8.175664432485807634e+07, TEST_TOL4, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (50, 500.0, &r), 4.806352370663185330e+146, TEST_TOL3, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_exprel_n_e, (500, -1000.0, &r), 0.3334815803127619256, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, -100.0, &r), 0.8335646217536183909, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, -10.0, &r), 0.9804297803131823066, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, -3.0, &r), 0.9940475488850672997, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, -1.0, &r), 0.9980079602383488808, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, -1.0e-8, &r), 1.0 -1.0e-8/501.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, 1.0e-8, &r), 1.0 +1.0e-8/501.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, 1.0, &r), 1.0019999920160634252, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, 3.0, &r), 1.0060240236632444934, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, 48.0, &r), 1.1059355517981272174, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, 100.0, &r), 1.2492221464878287204, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, 500.0, &r), 28.363019877927630858, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, 1000.0, &r), 2.4037563160335300322e+68, TEST_TOL4, GSL_SUCCESS); + TEST_SF(s, gsl_sf_exprel_n_e, (500, 1600.0, &r), 7.899293535320607403e+226, TEST_TOL4, GSL_SUCCESS); + + return s; +} + + +int test_expint(void) +{ + gsl_sf_result r; + int s = 0; + + TEST_SF(s, gsl_sf_expint_E1_e, (-1.0, &r), -1.8951178163559367555, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_e, (1.0e-10, &r), 22.448635265138923980, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_e, (1.0e-05, &r), 10.935719800043695615, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_e, (0.1, &r), 1.82292395841939066610, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_e, (1.0, &r), 0.21938393439552027368, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_e, (10.0, &r), 4.156968929685324277e-06, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_e, (50.0, &r), 3.783264029550459019e-24, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_e, (300.0, &r), 1.710384276804510115e-133, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_expint_E2_e, (-1.0, &r), 0.8231640121031084799, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_e, (0.0, &r), 1.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_e, (1.0/4294967296.0, &r), 0.9999999947372139168, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_e, (1.0/65536.0, &r), 0.9998243233207178845, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_e, (0.1, &r), 0.7225450221940205066, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_e, (1.0, &r), 0.14849550677592204792, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_e, (10.0, &r), 3.830240465631608762e-06, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_e, (50.0, &r), 3.711783318868827367e-24, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_e, (300.0, &r), 1.7047391998483433998e-133, TEST_TOL2, GSL_SUCCESS); + + /* Tests for E_n(x) */ + + TEST_SF(s, gsl_sf_expint_En_e, (1,-1.0, &r), -1.8951178163559367555, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (1,1.0e-10, &r), 22.448635265138923980, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (1,1.0e-05, &r), 10.935719800043695615, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (1,0.1, &r), 1.82292395841939066610, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (1,1.0, &r), 0.21938393439552027368, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (1,10.0, &r), 4.156968929685324277e-06, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (1,50.0, &r), 3.783264029550459019e-24, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (1,300.0, &r), 1.710384276804510115e-133, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_expint_En_e, (2,-1.0, &r), 0.8231640121031084799, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (2,0.0, &r), 1.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (2,1.0/4294967296.0, &r), 0.9999999947372139168, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (2,1.0/65536.0, &r), 0.9998243233207178845, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (2,0.1, &r), 0.7225450221940205066, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (2,1.0, &r), 0.14849550677592204792, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (2,10.0, &r), 3.830240465631608762e-06, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (2,50.0, &r), 3.711783318868827367e-24, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (2,300.0, &r), 1.7047391998483433998e-133, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_expint_En_e, (3,0.0, &r), 0.5, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (3,1.0/4294967296.0, &r), 0.499999999767169356972, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (3,1.0/65536.0, &r), 0.4999847426094515610, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (3,0.1, &r), 0.4162914579082787612543, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (3,1.0, &r), 0.10969196719776013683858, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (3,10.0, &r),0.000003548762553084381959981, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (3,50.0, &r), 3.6429094264752049812e-24, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (3,300.0, &r),1.699131143349179084e-133, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_expint_En_e, (10,0.0, &r), 0.111111111111111111, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (10,1.0/4294967296.0, &r), 0.111111111082007280658, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (10,1.0/65536.0, &r), 0.11110920377910896018606, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (10,0.1, &r), 0.099298432000896813567905, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (10,1.0, &r), 0.036393994031416401634164534, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (10,10.0, &r), 0.00000232530265702821081778968, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (10,50.0, &r), 3.223296586749110919572e-24, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_e, (10,300.0, &r), 1.6608815083360041367294736e-133, TEST_TOL2, GSL_SUCCESS); + + /* Tests for Ei(x) */ + + TEST_SF(s, gsl_sf_expint_Ei_e, (-1.0, &r), -0.21938393439552027368, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_Ei_e, (1.0/4294967296.0, &r), -21.603494112783886397, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_Ei_e, (1.0, &r), 1.8951178163559367555, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (-10000.0, &r), -0.00010001000200060024012, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (-1000.0, &r), -0.0010010020060241207251, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (-10.0, &r), -0.11314702047341077803, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (-1.0, &r), -0.69717488323506606877, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (1.0e-10, &r), 22.448635267383787506, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (1.0e-05, &r), 10.935829157788483865, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (0.1, &r), 2.0146425447084516791, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (1.0, &r), 0.59634736232319407434, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (10.0, &r), 0.091563333939788081876, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (50.0, &r), 0.019615109930114870365, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (300.0, &r), 0.0033222955652707070644, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (1000.0, &r), 0.00099900199402388071500, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E1_scaled_e, (10000.0, &r), 0.000099990001999400239880, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (-10000.0, &r), -0.00010002000600240120072, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (-1000.0, &r), -0.0010020060241207250807, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (-10.0, &r), -0.13147020473410778034, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (-1.0, &r), 0.30282511676493393123, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (0.0, &r), 1.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (1.0/4294967296.0, &r), 0.99999999497004455927, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (1.0/65536.0, &r), 0.99983957954556245453, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (0.1, &r), 0.79853574552915483209, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (1.0, &r), 0.40365263767680592566, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (10.0, &r), 0.084366660602119181239, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (50.0, &r), 0.019244503494256481735, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (300.0, &r), 0.0033113304187878806691, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (1000.0, &r), 0.00099800597611928500004, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_E2_scaled_e, (10000.0, &r), 0.000099980005997601199281, TEST_TOL0, GSL_SUCCESS); + + /* Tests for E_n(x) */ + + + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,-10000.0, &r), -0.00010001000200060024012, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,-1000.0, &r), -0.0010010020060241207251, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,-10.0, &r), -0.11314702047341077803, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,-1.0, &r), -0.69717488323506606877, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,1.0e-10, &r), 22.448635267383787506, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,1.0e-05, &r), 10.935829157788483865, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,0.1, &r), 2.0146425447084516791, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,1.0, &r), 0.59634736232319407434, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,10.0, &r), 0.091563333939788081876, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,50.0, &r), 0.019615109930114870365, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,300.0, &r), 0.0033222955652707070644, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,1000.0, &r), 0.00099900199402388071500, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (1,10000.0, &r), 0.000099990001999400239880, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,-10000.0, &r), -0.00010002000600240120072, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,-1000.0, &r), -0.0010020060241207250807, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,-10.0, &r), -0.13147020473410778034, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,-1.0, &r), 0.30282511676493393123, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,0.0, &r), 1.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,1.0/4294967296.0, &r), 0.99999999497004455927, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,1.0/65536.0, &r), 0.99983957954556245453, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,0.1, &r), 0.79853574552915483209, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,1.0, &r), 0.40365263767680592566, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,10.0, &r), 0.084366660602119181239, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,50.0, &r), 0.019244503494256481735, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,300.0, &r), 0.0033113304187878806691, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,1000.0, &r), 0.00099800597611928500004, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (2,10000.0, &r), 0.000099980005997601199281, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_expint_En_scaled_e, (3,0.0, &r), 0.5, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (3,1.0/4294967296.0, &r), 0.4999999998835846787586, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (3,1.0/65536.0, &r), 0.4999923718293796877864492, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (3,0.1, &r), 0.4600732127235422583955, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (3,1.0, &r), 0.298173681161597037170539, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (3,10.0, &r), 0.07816669698940409380349, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (3,50.0, &r), 0.0188874126435879566345, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (3,300.0, &r), 0.00330043718181789963028657675, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_expint_En_scaled_e, (10,0.0, &r), 0.111111111111111111, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (10,1.0/4294967296.0, &r), 0.11111111110787735217158, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (10,1.0/65536.0, &r), 0.1111108991839472074435, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (10,0.1, &r), 0.1097417392579033988025, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (10,1.0, &r), 0.09892913264064615521915, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (10,10.0, &r), 0.0512181994376050593314159875, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (10,50.0, &r), 0.0167118436335939556034579, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_En_scaled_e, (10,300.0, &r), 0.0032261400811599644878615, TEST_TOL2, GSL_SUCCESS); + + + TEST_SF(s, gsl_sf_expint_Ei_scaled_e, (-1000.0, &r), -0.00099900199402388071500, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_Ei_scaled_e, (-1.0, &r), -0.59634736232319407434, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_Ei_scaled_e, (1.0/4294967296.0, &r), -21.603494107753930958, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_Ei_scaled_e, (1.0, &r), 0.69717488323506606877, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_Ei_scaled_e, (1000.0, &r), 0.0010010020060241207251, TEST_TOL0, GSL_SUCCESS); + + + TEST_SF(s, gsl_sf_Shi_e, (-1.0, &r), -1.0572508753757285146, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Shi_e, (1.0/4294967296.0, &r), 2.3283064365386962891e-10, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Shi_e, (1.0/65536.0, &r), 0.00001525878906269737298, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Shi_e, (0.1, &r), 0.1000555722250569955, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Shi_e, (1.0, &r), 1.0572508753757285146, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Shi_e, (10.0, &r), 1246.1144901994233444, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Shi_e, (50.0, &r), 5.292818448565845482e+19, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Shi_e, (300.0, &r), 3.248241254044332895e+127, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_Chi_e, (-1.0, &r), 0.8378669409802082409, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Chi_e, (1.0/4294967296.0, &r), -21.603494113016717041, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Chi_e, (1.0/65536.0, &r), -10.513139223999384429, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Chi_e, (1.0/8.0, &r), -1.4983170827635760646, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Chi_e, (1.0, &r), 0.8378669409802082409, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Chi_e, (10.0, &r), 1246.1144860424544147, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Chi_e, (50.0, &r), 5.292818448565845482e+19, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Chi_e, (300.0, &r), 3.248241254044332895e+127, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_expint_3_e, (1.0e-10, &r), 1.0e-10, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_3_e, (1.0e-05, &r), 9.9999999999999975e-06, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_3_e, (0.1, &r), 0.09997500714119079665122, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_3_e, (0.5, &r), 0.48491714311363971332427, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_3_e, (1.0, &r), 0.80751118213967145285833, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_3_e, (2.0, &r), 0.89295351429387631138208, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_3_e, (5.0, &r), 0.89297951156924921121856, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_3_e, (10.0, &r), 0.89297951156924921121856, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_expint_3_e, (100.0, &r), 0.89297951156924921121856, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_Si_e, (-1.0, &r), -0.9460830703671830149, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Si_e, (1.0e-10, &r), 1.0e-10, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Si_e, (1.0e-05, &r), 9.999999999944444444e-06, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Si_e, (0.1, &r), 0.09994446110827695016, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Si_e, (1.0, &r), 0.9460830703671830149, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Si_e, (10.0, &r), 1.6583475942188740493, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Si_e, (50.0, &r), 1.5516170724859358947, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Si_e, (300.0, &r), 1.5708810882137495193, TEST_TOL0, GSL_SUCCESS); + /* + TEST_SF(s, gsl_sf_Si_e, (1.0e+20, &r), 1.5707963267948966192, TEST_TOL0, GSL_SUCCESS); + */ + + TEST_SF(s, gsl_sf_Ci_e, (1.0/4294967296.0, &r), -21.603494113016717041, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Ci_e, (1.0/65536.0, &r), -10.513139224115799751, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Ci_e, (1.0/8.0, &r), -1.5061295845296396649, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Ci_e, (1.0, &r), 0.3374039229009681347, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Ci_e, (10.0, &r), -0.04545643300445537263, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Ci_e, (50.0, &r), -0.005628386324116305440, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Ci_e, (300.0, &r), -0.003332199918592111780, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Ci_e, (65536.0, &r), 0.000010560248837656279453, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Ci_e, (4294967296.0, &r), -1.0756463261957757485e-10, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_Ci_e, (1099511627776.0, &r), -3.689865584710764214e-13, 1024.0*TEST_SQRT_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_atanint_e, (1.0e-10, &r), 1.0e-10, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_atanint_e, (1.0e-05, &r), 9.99999999988888888889e-06, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_atanint_e, (0.1, &r), 0.09988928686033618404, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_atanint_e, (1.0, &r), 0.91596559417721901505, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_atanint_e, (2.0, &r), 1.57601540344632342236, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_atanint_e, (10.0, &r), 3.71678149306806859029, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_atanint_e, (50.0, &r), 6.16499047850274874222, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_atanint_e, (300.0, &r), 8.96281388924518959990, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_atanint_e, (1.0e+5, &r), 18.084471031038661920, TEST_TOL0, GSL_SUCCESS); + + return s; +} + + +int test_fermidirac(void) +{ + gsl_sf_result r; + int s = 0; + + TEST_SF(s, gsl_sf_fermi_dirac_m1_e, (-10.0, &r), 0.00004539786870243439450, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_m1_e, ( -1.0, &r), 0.26894142136999512075, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_m1_e, ( 1.0, &r), 0.7310585786300048793, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_m1_e, ( 10.0, &r), 0.9999546021312975656, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_0_e, (-10.0, &r), 0.00004539889921686464677, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_0_e, ( -1.0, &r), 0.31326168751822283405, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_0_e, ( 1.0, &r), 1.3132616875182228340, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_0_e, ( 10.0, &r), 10.000045398899216865, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_1_e, (-10.0, &r), 0.00004539941448447633524, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_1_e, ( -2.0, &r), 0.13101248471442377127, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_1_e, ( -1.0, &r), 0.3386479964034521798, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_1_e, ( -0.4, &r), 0.5825520806897909028, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_1_e, ( 0.4, &r), 1.1423819861584355337, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_1_e, ( 1.0, &r), 1.8062860704447742567, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_1_e, ( 1.5, &r), 2.5581520872227806402, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_1_e, ( 2.5, &r), 4.689474797599761667, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_1_e, ( 10.0, &r), 51.64488866743374196, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_1_e, ( 12.0, &r), 73.64492792264531092, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_1_e, ( 20.0, &r), 201.64493406478707282, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_1_e, ( 50.0, &r), 1251.6449340668482264, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_2_e, (-10.0, &r), 0.00004539967212174776662, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_2_e, ( -2.0, &r), 0.13313272938565030508, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_2_e, ( -1.0, &r), 0.3525648792978077590, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_2_e, ( -0.4, &r), 0.6229402647001272120, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_2_e, ( 0.4, &r), 1.2915805581060844533, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_2_e, ( 1.0, &r), 2.1641656128127008622, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_2_e, ( 1.5, &r), 3.247184513920792475, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_2_e, ( 2.5, &r), 6.797764392735056317, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_2_e, ( 10.0, &r), 183.11605273482105278, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_2_e, ( 12.0, &r), 307.73921494638635166, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_2_e, ( 20.0, &r), 1366.2320146723590157, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_2_e, ( 50.0, &r), 20915.580036675744655, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_2_e, (200.0, &r), 1.3336623201467029786e+06, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_mhalf_e, (-10.0, &r), 0.00004539847236080549532, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_mhalf_e, ( -2.0, &r), 0.12366562180120994266, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_mhalf_e, ( -1.0, &r), 0.29402761761145122022, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_mhalf_e, ( -0.4, &r), 0.4631755336886027800, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_mhalf_e, ( 0.4, &r), 0.7654084737661656915, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_mhalf_e, ( 1.0, &r), 1.0270571254743506890, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_mhalf_e, ( 1.5, &r), 1.2493233478527122008, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_mhalf_e, ( 2.5, &r), 1.6663128834358313625, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_mhalf_e, ( 10.0, &r), 3.552779239536617160, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_mhalf_e, ( 12.0, &r), 3.897268231925439359, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_mhalf_e, ( 20.0, &r), 5.041018507535328603, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_mhalf_e, ( 50.0, &r), 7.977530858581869960, TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_half_e, (-10.0, &r), 0.00004539920105264132755, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_half_e, ( -2.0, &r), 0.12929851332007559106, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_half_e, ( -1.0, &r), 0.3277951592607115477, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_half_e, ( -0.4, &r), 0.5522452153690688947, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_half_e, ( 0.4, &r), 1.0386797503389389277, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_half_e, ( 1.0, &r), 1.5756407761513002308, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_half_e, ( 1.5, &r), 2.1448608775831140360, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_half_e, ( 2.5, &r), 3.606975377950373251, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_half_e, ( 10.0, &r), 24.084656964637653615, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_half_e, ( 12.0, &r), 31.540203287044242593, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_half_e, ( 20.0, &r), 67.49151222165892049, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_half_e, ( 50.0, &r), 266.09281252136259343, TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_3half_e, (-10.0, &r), 0.00004539956540456176333, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_3half_e, ( -2.0, &r), 0.13224678225177236685, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_3half_e, ( -1.0, &r), 0.3466747947990574170, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_3half_e, ( -0.4, &r), 0.6056120213305040910, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_3half_e, ( 0.4, &r), 1.2258236403963668282, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_3half_e, ( 1.0, &r), 2.0022581487784644573, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_3half_e, ( 1.5, &r), 2.9277494127932173068, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_3half_e, ( 2.5, &r), 5.768879312210516582, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_3half_e, ( 10.0, &r), 101.00510084332600020, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_3half_e, ( 12.0, &r), 156.51518642795728036, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_3half_e, ( 20.0, &r), 546.5630100657601959, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_3half_e, ( 50.0, &r), 5332.353566687145552, TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (3, -2.0, &r), 0.1342199155038680215, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (3, 0.0, &r), 0.9470328294972459176, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (3, 0.1, &r), 1.0414170610956165759, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (3, 1.0, &r), 2.3982260822489407070, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (3, 3.0, &r), 12.621635313399690724, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (3, 100.0, &r), 4.174893231066566793e+06, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (3, 500.0, &r), 2.604372285319088354e+09, TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (5, -2.0, &r), 0.13505242246823676478, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (5, 0.0, &r), 0.9855510912974351041, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (5, 0.1, &r), 1.0876519750101492782, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (5, 1.0, &r), 2.6222337848692390539, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (5, 3.0, &r), 17.008801618012113022, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (5, 100.0, &r), 1.3957522531334869874e+09, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (5, 500.0, &r), 2.1705672808114817955e+13, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (7, -2.0, &r), 0.1352641105671255851, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (7, 0.0, &r), 0.9962330018526478992, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (7, 0.1, &r), 1.1005861815180315485, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (7, 1.0, &r), 2.6918878172003129203, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (7, 3.0, &r), 19.033338976999367642, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (7, 10.0, &r), 5654.530932873610014, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (7, 50.0, &r), 1.005005069985066278e+09, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (7, 500.0, &r), 9.691690268341569514e+16, TEST_TOL3, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (9, -2.0, &r), 0.1353174385330242691, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (9, 0.0, &r), 0.9990395075982715656, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (9, 0.1, &r), 1.1039997234712941212, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (9, 1.0, &r), 2.7113648898129249947, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (9, 3.0, &r), 19.768544008138602223, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (9, 10.0, &r), 10388.990167312912478, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (9, 50.0, &r), 2.85466960802601649e+10, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (9, 500.0, &r), 2.69273849842695876e+20, 2*TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (10, -2.0, &r), 0.13532635396712288092, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (10, 0.0, &r), 0.9995171434980607541, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (10, 0.1, &r), 1.1045818238852612296, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (10, 1.0, &r), 2.7147765350346120647, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (10, 3.0, &r), 19.917151938411675171, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (10, 10.0, &r), 12790.918595516495955, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (10, 50.0, &r), 1.3147703201869657654e+11, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (10, 500.0, &r), 1.2241331244469204398e+22, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (11, -2.0, &r), 0.1353308162894847149, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (11, 0.0, &r), 0.9997576851438581909, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (11, 0.1, &r), 1.1048751811565850418, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (11, 1.0, &r), 2.7165128749007313436, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (11, 3.0, &r), 19.997483022044603065, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (11, 10.0, &r), 14987.996005901818036, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (11, 50.0, &r), 5.558322924078990628e+11, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (11, 500.0, &r), 5.101293089606198280e+23, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (20, -2.0, &r), 0.13533527450327238373, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (20, 0.0, &r), 0.9999995232582155428, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (20, 0.1, &r), 1.1051703357941368203, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (20, 1.0, &r), 2.7182783069905721654, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (20, 3.0, &r), 20.085345296028242734, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (20, 10.0, &r), 21898.072920149606475, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (20, 50.0, &r), 1.236873256595717618e+16, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_fermi_dirac_int_e, (20, 500.0, &r), 9.358938204369557277e+36, TEST_TOL2, GSL_SUCCESS); + + + return s; +} + + +int test_gegen(void) +{ + gsl_sf_result r; + double ga[100]; + int s = 0; + int sa; + + TEST_SF(s, gsl_sf_gegenpoly_1_e, (-0.2, 1.0, &r), -0.4, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_1_e, ( 0.0, 1.0, &r), 2.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_1_e, ( 1.0, 1.0, &r), 2.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_1_e, ( 1.0, 0.5, &r), 1.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_1_e, ( 5.0, 1.0, &r), 10.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_1_e, ( 100.0, 0.5, &r), 100.0, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_gegenpoly_2_e, (-0.2, 0.5, &r), 0.12, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_2_e, ( 0.0, 1.0, &r), 1.00, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_2_e, ( 1.0, 1.0, &r), 3.00, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_2_e, ( 1.0, 0.1, &r), -0.96, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_2_e, ( 5.0, 1.0, &r), 55.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_2_e, ( 100.0, 0.5, &r), 4950.0, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_gegenpoly_3_e, (-0.2, 0.5, &r), 0.112, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_3_e, ( 0.0, 1.0, &r), -2.0/3.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_3_e, ( 1.0, 1.0, &r), 4.000, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_3_e, ( 1.0, 0.1, &r), -0.392, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_3_e, ( 5.0, 1.0, &r), 220.000, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_3_e, ( 100.0, 0.5, &r), 161600.000, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_gegenpoly_n_e, (1, 1.0, 1.0, &r), 2.000 , TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_n_e, (10, 1.0, 1.0, &r), 11.000 , TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_n_e, (10, 1.0, 0.1, &r), -0.4542309376 , TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_n_e, (10, 5.0, 1.0, &r), 9.23780e+4 , TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_n_e, (10, 100.0, 0.5, &r), 1.5729338392690000e+13, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_n_e, (1000, 100.0, 1.0, &r), 3.3353666135627322e+232, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_n_e, (100, 2000.0, 1.0, &r), 5.8753432034937579e+202, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_n_e, (103, 207.0, 2.0, &r), 1.4210272202235983e+145, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_gegenpoly_n_e, (103, -0.4, 0.3, &r), -1.64527498094522e-04, TEST_TOL1, GSL_SUCCESS); + + sa = 0; + gsl_sf_gegenpoly_array(99, 5.0, 1.0, ga); + sa += ( test_sf_frac_diff( ga[1], 10.0 ) > TEST_TOL0 ); + sa += ( test_sf_frac_diff( ga[10], 9.23780e+4 ) > TEST_TOL0 ); + gsl_test(sa, " gsl_sf_gegenpoly_array"); + s += sa; + + return s; +} + + +int test_jac(void) +{ + double u, m; + double sn, cn, dn; + int stat_ej; + int s = 0; + int sa; + + u = 0.5; + m = 0.5; + sa = 0; + stat_ej = gsl_sf_elljac_e(u, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 0.4707504736556572833, TEST_TOL0, "gsl_sf_elljac_e(0.5|0.5) sn"); + sa += test_sf_val(cn, 0.8822663948904402865, TEST_TOL0, "gsl_sf_elljac_e(0.5|0.5) cn"); + sa += test_sf_val(dn, 0.9429724257773856873, TEST_TOL0, "gsl_sf_elljac_e(0.5|0.5) dn"); + gsl_test(s, " gsl_sf_elljac_e(0.5|0.5)"); + s += sa; + + u = 1.0; + m = 0.3; + sa = 0; + stat_ej = gsl_sf_elljac_e(u, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 0.8187707145344889190, TEST_TOL0, "gsl_sf_elljac_e(1.0|0.3) sn"); + sa += test_sf_val(cn, 0.5741206467465548795, TEST_TOL0, "gsl_sf_elljac_e(1.0|0.3) cn"); + sa += test_sf_val(dn, 0.8938033089590823040, TEST_TOL0, "gsl_sf_elljac_e(1.0|0.3) dn"); + gsl_test(sa, " gsl_sf_elljac_e(1.0|0.3)"); + s += sa; + + u = 1.0; + m = 0.6; + sa = 0; + stat_ej = gsl_sf_elljac_e(u, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 0.7949388393365780943, TEST_TOL0, "gsl_sf_elljac_e(1.0|0.6) sn"); + sa += test_sf_val(cn, 0.6066895760718277578, TEST_TOL0, "gsl_sf_elljac_e(1.0|0.6) cn"); + sa += test_sf_val(dn, 0.7879361300438814425, TEST_TOL0, "gsl_sf_elljac_e(1.0|0.6) dn"); + gsl_test(sa, " gsl_sf_elljac_e(1.0|0.6)"); + s += sa; + + u = 3.0; + m = 0.6; + sa = 0; + stat_ej = gsl_sf_elljac_e(u, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 0.7432676860864044186, TEST_TOL0, " gsl_sf_elljac_e(3.0|0.6) sn"); + sa += test_sf_val(cn, -0.6689941306317733154, TEST_TOL0, " gsl_sf_elljac_e(3.0|0.6) cn"); + sa += test_sf_val(dn, 0.8176379933025723259, TEST_TOL0, " gsl_sf_elljac_e(3.0|0.6) dn"); + gsl_test(sa, " gsl_sf_elljac_e(3.0|0.6)"); + s += sa; + + u = 2.0; + m = 0.999999; + sa = 0; + stat_ej = gsl_sf_elljac_e(u, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 0.96402778575700186570, TEST_TOL1, "gsl_sf_elljac_e(2.0|0.999999) sn"); + sa += test_sf_val(cn, 0.26580148285600686381, TEST_TOL1, "gsl_sf_elljac_e(2.0|0.999999) cn"); + sa += test_sf_val(dn, 0.26580323105264131136, TEST_TOL1, "gsl_sf_elljac_e(2.0|0.999999) dn"); + gsl_test(sa, " gsl_sf_elljac_e(2.0|0.999999)"); + s += sa; + + /* test supplied by Ivan Panchenko */ + u = 1.69695970624443; + m = 0.270378013104138; + sa = 0; + stat_ej = gsl_sf_elljac_e(u, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 1.0, TEST_TOL0, "gsl_sf_elljac_e(1.69..|0.27..) sn"); + sa += test_sf_val(cn, 0.0, TEST_TOL1, "gsl_sf_elljac_e(1.69..|0.27..) cn"); + sa += test_sf_val(dn, 0.8541791304497336, TEST_TOL1, "gsl_sf_elljac_e(1.69..|0.27..) dn"); + gsl_test(sa, " gsl_sf_elljac_e(1.69695970624443|0.270378013104138)"); + s += sa; + + + + /* Check known values from Abramowitz & Stegun, Table 16.5 */ + u = 0; + m = 0.1; + + { + double mc = 1 - m; + /* quarter period K is (pi/2)/agm(1,mc) */ + double K = (M_PI_2)/ 0.9741726903999478375938128316; + + double A = 1.0 / sqrt(1+sqrt(mc)); + double B = pow(mc, 0.25) / sqrt(1+sqrt(mc)); + double C = pow(mc, 0.25); + double C2 = sqrt(mc); + + double eps = 1e-10; + + sa = 0; + stat_ej = gsl_sf_elljac_e(0.0, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 0.0, TEST_TOL0, "gsl_sf_elljac_e(0|0.1) sn"); + sa += test_sf_val(cn, 1.0, TEST_TOL0, "gsl_sf_elljac_e(0|0.1) cn"); + sa += test_sf_val(dn, 1.0, TEST_TOL0, "gsl_sf_elljac_e(0|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(0|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(-eps, m, &sn, &cn, &dn); + sa += test_sf_val(sn, -eps, TEST_TOL0, "gsl_sf_elljac_e(-1e-10|0.1) sn"); + sa += test_sf_val(cn, 1.0, TEST_TOL0, "gsl_sf_elljac_e(-1e-10|0.1) cn"); + sa += test_sf_val(dn, 1.0, TEST_TOL0, "gsl_sf_elljac_e(-1e-10|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(-1e-10|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(eps, m, &sn, &cn, &dn); + sa += test_sf_val(sn, eps, TEST_TOL0, "gsl_sf_elljac_e(1e-10|0.1) sn"); + sa += test_sf_val(cn, 1.0, TEST_TOL0, "gsl_sf_elljac_e(1e-10|0.1) cn"); + sa += test_sf_val(dn, 1.0, TEST_TOL0, "gsl_sf_elljac_e(1e-10|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(1e-10|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(1e-30, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 1e-30, TEST_TOL0, "gsl_sf_elljac_e(1e-30|0.1) sn"); + sa += test_sf_val(cn, 1.0, TEST_TOL0, "gsl_sf_elljac_e(1e-30|0.1) cn"); + sa += test_sf_val(dn, 1.0, TEST_TOL0, "gsl_sf_elljac_e(1e-30|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(1e-30|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(K / 2.0 - eps, m, &sn, &cn, &dn); + sa += test_sf_val(sn, A - eps*B*C, TEST_TOL2, "gsl_sf_elljac_e(K/2-1e-10|0.1) sn"); + sa += test_sf_val(cn, B + eps*A*C, TEST_TOL2, "gsl_sf_elljac_e(K/2-1e-10|0.1) cn"); + sa += test_sf_val(dn, C + m*eps*A*B, TEST_TOL2, "gsl_sf_elljac_e(K/2-1e-10|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(K/2-1e-10|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(K / 2.0, m, &sn, &cn, &dn); + sa += test_sf_val(sn, A, TEST_TOL2, "gsl_sf_elljac_e(K/2|0.1) sn"); + sa += test_sf_val(cn, B, TEST_TOL2, "gsl_sf_elljac_e(K/2|0.1) cn"); + sa += test_sf_val(dn, C, TEST_TOL2, "gsl_sf_elljac_e(K/2|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(K/2|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(K / 2.0 + eps, m, &sn, &cn, &dn); + sa += test_sf_val(sn, A + eps*B*C, TEST_TOL2, "gsl_sf_elljac_e(K/2+1e-10|0.1) sn"); + sa += test_sf_val(cn, B - eps*A*C, TEST_TOL2, "gsl_sf_elljac_e(K/2+1e-10|0.1) cn"); + sa += test_sf_val(dn, C - m*eps*A*B, TEST_TOL2, "gsl_sf_elljac_e(K/2+1e-10|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(K/2+1e-10|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(K - eps, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(K-1e-10|0.1) sn"); + sa += test_sf_val(cn, eps*C2, 10*TEST_SNGL, "gsl_sf_elljac_e(K-1e-10|0.1) cn"); + sa += test_sf_val(dn, C2, TEST_TOL2, "gsl_sf_elljac_e(K-1e-10|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(K-1e-10|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(K, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(K|0.1) sn"); + sa += test_sf_val(cn, 0.0, TEST_TOL1, "gsl_sf_elljac_e(K|0.1) cn"); + sa += test_sf_val(dn, C2, TEST_TOL2, "gsl_sf_elljac_e(K|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(K|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(K + eps, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(K+1e-10|0.1) sn"); + sa += test_sf_val(cn, -eps*C2, 10*TEST_SNGL, "gsl_sf_elljac_e(K+1e-10|0.1) cn"); + sa += test_sf_val(dn, C2, TEST_TOL2, "gsl_sf_elljac_e(K+1e-10|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(K+1e-10|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(3.0*K / 2.0, m, &sn, &cn, &dn); + sa += test_sf_val(sn, A, TEST_TOL2, "gsl_sf_elljac_e(3K/2|0.1) sn"); + sa += test_sf_val(cn, -B, TEST_TOL2, "gsl_sf_elljac_e(3K/2|0.1) cn"); + sa += test_sf_val(dn, C, TEST_TOL2, "gsl_sf_elljac_e(3K/2|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(3K/2|0.1)"); + s += sa; + + + sa = 0; + stat_ej = gsl_sf_elljac_e(2.0*K - eps, m, &sn, &cn, &dn); + sa += test_sf_val(sn, eps, 10*TEST_SNGL, "gsl_sf_elljac_e(2K-1e-10|0.1) sn"); + sa += test_sf_val(cn, -1.0, TEST_TOL1, "gsl_sf_elljac_e(2K-1e-10|0.1) cn"); + sa += test_sf_val(dn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(2K-1e-10|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(2K-1e-10|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(2.0*K, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 0.0, TEST_TOL1, "gsl_sf_elljac_e(2K|0.1) sn"); + sa += test_sf_val(cn, -1.0, TEST_TOL1, "gsl_sf_elljac_e(2K|0.1) cn"); + sa += test_sf_val(dn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(2K|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(2K|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(2.0*K + eps, m, &sn, &cn, &dn); + sa += test_sf_val(sn, -eps, 10*TEST_SNGL, "gsl_sf_elljac_e(2K+1e-10|0.1) sn"); + sa += test_sf_val(cn, -1.0, TEST_TOL1, "gsl_sf_elljac_e(2K+1e-10|0.1) cn"); + sa += test_sf_val(dn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(2K+1e-10|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(2K+1e-10|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(5.0*K / 2.0, m, &sn, &cn, &dn); + sa += test_sf_val(sn, -A, TEST_TOL2, "gsl_sf_elljac_e(5K/2|0.1) sn"); + sa += test_sf_val(cn, -B, TEST_TOL2, "gsl_sf_elljac_e(5K/2|0.1) cn"); + sa += test_sf_val(dn, C, TEST_TOL2, "gsl_sf_elljac_e(5K/2|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(5K/2|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(3.0*K - eps, m, &sn, &cn, &dn); + sa += test_sf_val(sn, -1.0, TEST_TOL1, "gsl_sf_elljac_e(3K-1e-10|0.1) sn"); + sa += test_sf_val(cn, -C2 * eps, 10*TEST_SNGL, "gsl_sf_elljac_e(3K-1e-10|0.1) cn"); + sa += test_sf_val(dn, C2, TEST_TOL2, "gsl_sf_elljac_e(3K-1e-10|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(3K-1e-10|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(3.0*K, m, &sn, &cn, &dn); + sa += test_sf_val(sn, -1.0, TEST_TOL1, "gsl_sf_elljac_e(3K|0.1) sn"); + sa += test_sf_val(cn, 0.0, TEST_TOL1, "gsl_sf_elljac_e(3K|0.1) cn"); + sa += test_sf_val(dn, C2, TEST_TOL2, "gsl_sf_elljac_e(3K|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(3K|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(3.0*K + eps, m, &sn, &cn, &dn); + sa += test_sf_val(sn, -1.0, TEST_TOL1, "gsl_sf_elljac_e(3K+1e-10|0.1) sn"); + sa += test_sf_val(cn, +C2 * eps, 10*TEST_SNGL, "gsl_sf_elljac_e(3K+1e-10|0.1) cn"); + sa += test_sf_val(dn, C2, TEST_TOL2, "gsl_sf_elljac_e(3K+1e-10|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(3K+1e-10|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(7.0*K / 2.0, m, &sn, &cn, &dn); + sa += test_sf_val(sn, -A, TEST_TOL2, "gsl_sf_elljac_e(7K/2|0.1) sn"); + sa += test_sf_val(cn, B, TEST_TOL2, "gsl_sf_elljac_e(7K/2|0.1) cn"); + sa += test_sf_val(dn, C, TEST_TOL2, "gsl_sf_elljac_e(7K/2|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(7K/2|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(4.0*K - eps, m, &sn, &cn, &dn); + sa += test_sf_val(sn, -eps, 10*TEST_SNGL, "gsl_sf_elljac_e(4K-1e-10|0.1) sn"); + sa += test_sf_val(cn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(4K-1e-10|0.1) cn"); + sa += test_sf_val(dn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(4K-1e-10|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(4K-1e-10|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(4.0*K, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 0.0, TEST_TOL1, "gsl_sf_elljac_e(4K|0.1) sn"); + sa += test_sf_val(cn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(4K|0.1) cn"); + sa += test_sf_val(dn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(4K|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(4K|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(9.0 * K / 2.0, m, &sn, &cn, &dn); + sa += test_sf_val(sn, A, TEST_TOL2, "gsl_sf_elljac_e(9K/2|0.1) sn"); + sa += test_sf_val(cn, B, TEST_TOL2, "gsl_sf_elljac_e(9K/2|0.1) cn"); + sa += test_sf_val(dn, C, TEST_TOL2, "gsl_sf_elljac_e(9K/2|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(9K/2|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(-K / 2.0, m, &sn, &cn, &dn); + sa += test_sf_val(sn, -A, TEST_TOL2, "gsl_sf_elljac_e(-K/2|0.1) sn"); + sa += test_sf_val(cn, B, TEST_TOL2, "gsl_sf_elljac_e(-K/2|0.1) cn"); + sa += test_sf_val(dn, C, TEST_TOL2, "gsl_sf_elljac_e(-K/2|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(-K/2|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(-K, m, &sn, &cn, &dn); + sa += test_sf_val(sn, -1.0, TEST_TOL1, "gsl_sf_elljac_e(-K|0.1) sn"); + sa += test_sf_val(cn, 0.0, TEST_TOL1, "gsl_sf_elljac_e(-K|0.1) cn"); + sa += test_sf_val(dn, C2, TEST_TOL2, "gsl_sf_elljac_e(-K|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(-K|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(-3.0*K / 2.0, m, &sn, &cn, &dn); + sa += test_sf_val(sn, -A, TEST_TOL2, "gsl_sf_elljac_e(-3K/2|0.1) sn"); + sa += test_sf_val(cn, -B, TEST_TOL2, "gsl_sf_elljac_e(-3K/2|0.1) cn"); + sa += test_sf_val(dn, C, TEST_TOL2, "gsl_sf_elljac_e(-3K/2|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(-3K/2|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(-2.0*K, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 0.0, TEST_TOL1, "gsl_sf_elljac_e(-2K|0.1) sn"); + sa += test_sf_val(cn, -1.0, TEST_TOL1, "gsl_sf_elljac_e(-2K|0.1) cn"); + sa += test_sf_val(dn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(-2K|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(-2K|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(-5.0*K / 2.0, m, &sn, &cn, &dn); + sa += test_sf_val(sn, A, TEST_TOL2, "gsl_sf_elljac_e(-5K/2|0.1) sn"); + sa += test_sf_val(cn, -B, TEST_TOL2, "gsl_sf_elljac_e(-5K/2|0.1) cn"); + sa += test_sf_val(dn, C, TEST_TOL2, "gsl_sf_elljac_e(-5K/2|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(-5K/2|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(-3.0*K, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(-3K|0.1) sn"); + sa += test_sf_val(cn, 0.0, TEST_TOL1, "gsl_sf_elljac_e(-3K|0.1) cn"); + sa += test_sf_val(dn, C2, TEST_TOL2, "gsl_sf_elljac_e(-3K|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(-3K|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(-7.0*K / 2.0, m, &sn, &cn, &dn); + sa += test_sf_val(sn, A, TEST_TOL2, "gsl_sf_elljac_e(-7K/2|0.1) sn"); + sa += test_sf_val(cn, B, TEST_TOL2, "gsl_sf_elljac_e(-7K/2|0.1) cn"); + sa += test_sf_val(dn, C, TEST_TOL2, "gsl_sf_elljac_e(-7K/2|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(-7K/2|0.1)"); + s += sa; + + sa = 0; + stat_ej = gsl_sf_elljac_e(-4.0*K, m, &sn, &cn, &dn); + sa += test_sf_val(sn, 0.0, TEST_TOL1, "gsl_sf_elljac_e(-4K|0.1) sn"); + sa += test_sf_val(cn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(-4K|0.1) cn"); + sa += test_sf_val(dn, 1.0, TEST_TOL1, "gsl_sf_elljac_e(-4K|0.1) dn"); + gsl_test(sa, " gsl_sf_elljac_e(-4K|0.1)"); + s += sa; + } + + + return s; +} + + +int test_laguerre(void) +{ + gsl_sf_result r; + int s = 0; + + TEST_SF(s, gsl_sf_laguerre_1_e, (0.5, -1.0, &r), 2.5, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_1_e, (0.5, 1.0, &r), 0.5, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_1_e, (1.0, 1.0, &r), 1.0, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_laguerre_2_e, ( 0.5, -1.0, &r), 4.875, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_2_e, ( 0.5, 1.0, &r), -0.125, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_2_e, ( 1.0, 1.0, &r), 0.5, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_2_e, (-1.0, 1.0, &r), -0.5, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_2_e, (-2.0, 1.0, &r), 0.5, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_2_e, (-3.0, 1.0, &r), 2.5, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_laguerre_3_e, (0.5, -1.0, &r), 8.479166666666666667, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_3_e, (0.5, 1.0, &r), -0.6041666666666666667, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_3_e, (1.0, 1.0, &r), -0.16666666666666666667, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_3_e, ( 2.0, 1.0, &r), 2.3333333333333333333, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_3_e, (-2.0, 1.0, &r), 1.0/3.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_3_e, (-3.0, 1.0, &r), -1.0/6.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_3_e, (-4.0, 1.0, &r), -8.0/3.0, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_laguerre_n_e, (1, 0.5, 1.0, &r), 0.5, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (2, 1.0, 1.0, &r), 0.5, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (3, 2.0, 1.0, &r), 2.3333333333333333333, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (4, 2.0, 0.5, &r), 6.752604166666666667, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (90, 2.0, 0.5, &r), -48.79047157201507897, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (90, 2.0, -100.0, &r), 2.5295879275042410902e+63, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (90, 2.0, 100.0, &r), -2.0929042259546928670e+20, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, 2.0, -0.5, &r), 2.2521795545919391405e+07, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, 2.0, 0.5, &r), -28.764832945909097418, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (1000, 2.0, -0.5, &r), 2.4399915170947549589e+21, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (1000, 2.0, 0.5, &r), -306.77440254315317525, TEST_TOL2, GSL_SUCCESS); /**/ + TEST_SF(s, gsl_sf_laguerre_n_e, (100000, 2.0, 1.0, &r), 5107.73491348319, TEST_TOL4, GSL_SUCCESS); + + /* Compute these with the recurrence + * L(0,alpha,x)=1; + * L(1,alpha,x)=1+alpha-x; + * L(n,alpha,x)=((2*n-1+alpha-x)*L(n-1,alpha,x)-(n+alpha-1)*L(n-2,alpha,x))/k + */ + + TEST_SF(s, gsl_sf_laguerre_n_e, (1e5, 2.5, 2.5, &r), -0.41491680394598644969113795e5, TEST_TOL4, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (1e5+1, 2.5, 2.5, &r), -0.41629446949552321027514888e5, TEST_TOL4, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (1e6+1, 2.5, 2.5, &r), -0.48017961545391273151977118e6, TEST_TOL4, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (5e6+1, 2.5, 2.5, &r), -0.15174037401611122446089494e7, TEST_TOL6, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (8e6+1, 2.5, 2.5, &r), 0.63251509472091810994286362e6, TEST_SNGL, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (1e7+1, 2.5, 2.5, &r), 0.15299484685632983178033887e7, TEST_SNGL, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (1e8+1, 2.5, 2.5, &r), 0.23645341644922756725290777e8, TEST_SNGL, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (1e9+1, 2.5, 2.5, &r), -0.17731002248958790286185878e8, 100*TEST_SNGL, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_laguerre_n_e, (1, -2.0, 1.0, &r), -2.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (2, -2.0, 1.0, &r), 0.5, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (3, -2.0, 1.0, &r), 1.0/3.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (10, -2.0, 1.0, &r), -0.04654954805996472663, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (10, -5.0, 1.0, &r), -0.0031385030864197530864, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (10, -9.0, 1.0, &r), -2.480158730158730159e-06, TEST_TOL5, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (10, -11.0, 1.0, &r), 2.7182818011463844797, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (10, -11.0, -1.0, &r), 0.3678794642857142857, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -2.0, 1.0, &r), -0.0027339992019526273866, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -2.0, -1.0, &r), 229923.09193402028290, TEST_TOL5, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -10.0, 1.0, &r), 3.25966665871244092e-11, TEST_TOL6, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -10.0, -1.0, &r), 0.00016484365618205810025, TEST_TOL6, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -20.0, 1.0, &r), 5.09567630343671251e-21, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -30.0, 1.0, &r), 3.46063150272466192e-34, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -50.0, 1.0, &r), 1.20981872933162889e-65, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -50.0, -1.0, &r), 8.60763477742332922e-65, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -50.5, 1.0, &r), 4.84021010426688393e-31, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -50.5, -1.0, &r), 8.49861345212160618e-33, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -101.0, 1.0, &r), 2.7182818284590452354, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -101.0, -1.0, &r), 0.3678794411714423216, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -102.0, 1.0, &r), 271.8281828459045235, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -102.0, -1.0, &r), 37.52370299948711680, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -110.0, 1.0, &r), 1.0666955248998831554e+13, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -110.0, -1.0, &r), 1.7028306108058225871e+12, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -200.0, 1.0, &r), 7.47851889721356628e+58, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -200.0, -1.0, &r), 2.73740299754732273e+58, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -50.0, 10.0, &r), 4.504712811317745591e-21, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, -50.0, -10.0, &r), 1.475165520610679937e-11, TEST_TOL1, GSL_SUCCESS); + + /* test cases for Ed Smith-Rowland */ + + TEST_SF(s, gsl_sf_laguerre_n_e, (100, 0.0, 0.5, &r), 0.18682260367692278801, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, 0.0, 10.5, &r), 9.1796907354050059874, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, 0.0, -10.5, &r), 5.6329215744170606488e24, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, 0.0, 100.5, &r), -3.9844782875811907525e20, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_laguerre_n_e, (100, 0.0, 150, &r), -1.4463204337261709595e31, TEST_TOL2, GSL_SUCCESS); + + return s; +} + + +int test_lambert(void) +{ + gsl_sf_result r; + int s = 0; + + TEST_SF(s, gsl_sf_lambert_W0_e, (0.0, &r), 0.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_W0_e, (1.0, &r), 0.567143290409783872999969, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_W0_e, (2.0, &r), 0.852605502013725491346472, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_W0_e, (20.0, &r), 2.205003278024059970493066, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_W0_e, (1000.0, &r), 5.24960285240159622712606, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_W0_e, (1.0e+6, &r), 11.38335808614005262200016, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_W0_e, (1.0e+12, &r), 24.43500440493491313826305, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_W0_e, (1.0e+308, &r), 702.641362034106812081125, TEST_TOL0, GSL_SUCCESS); + + /* Test case from Katrin Wolff fails under + double-precision */ + + TEST_SF(s, gsl_sf_lambert_W0_e, (1.6849341956993852953416990, &r), 0.775706963944252869680440, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_lambert_W0_e, (-1.0/M_E - GSL_DBL_EPSILON, &r), -1.0, TEST_TOL0, GSL_EDOM); + TEST_SF(s, gsl_sf_lambert_W0_e, (-1.0/M_E + 1.0/(1024.0*1024.0*1024.0), &r), -0.999928845560308370714970, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_W0_e, (-1.0/M_E + 1.0/(1024.0*1024.0), &r), -0.997724730359774141620354, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_W0_e, (-1.0/M_E + 1.0/512.0, &r), -0.900335676696088773044678, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_W0_e, (-1.0/M_E + 0.25, &r), -0.1349044682661213545487599, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_lambert_Wm1_e, (0.0, &r), 0.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_Wm1_e, (1.0, &r), 0.567143290409783872999969, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_Wm1_e, (2.0, &r), 0.852605502013725491346472, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_Wm1_e, (20.0, &r), 2.205003278024059970493066, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_lambert_Wm1_e, (-1.0/M_E - GSL_DBL_EPSILON, &r), -1.0, TEST_TOL0, GSL_EDOM); + TEST_SF(s, gsl_sf_lambert_Wm1_e, (-1.0/M_E + 1.0/(1024.0*1024.0*1024.0), &r), -1.000071157815154608049055, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_Wm1_e, (-1.0/M_E + 1.0/(1024.0*1024.0), &r), -1.002278726118593023934693, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_Wm1_e, (-1.0/M_E + 1.0/512.0, &r), -1.106761200865743124599130, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_Wm1_e, (-1.0/M_E + 1.0/64.0, &r), -1.324240940341812125489772, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lambert_Wm1_e, (-1.0/M_E + 0.25, &r), -3.345798131120112, TEST_TOL1, GSL_SUCCESS); + + return s; +} + + +int test_log(void) +{ + gsl_sf_result r; + gsl_sf_result r1, r2; + int s = 0; + + TEST_SF(s, gsl_sf_log_e, (0.1, &r), -2.3025850929940456840, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_e, (1.1, &r), 0.09531017980432486004, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_e, (1000.0, &r), 6.907755278982137052, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_log_abs_e, (-0.1, &r), -2.3025850929940456840, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_abs_e, (-1.1, &r), 0.09531017980432486004, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_abs_e, (-1000.0, &r), 6.907755278982137052, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_abs_e, (0.1, &r), -2.3025850929940456840, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_abs_e, (1.1, &r), 0.09531017980432486004, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_abs_e, (1000.0, &r), 6.907755278982137052, TEST_TOL0, GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_log_e, (1.0, 1.0, &r1, &r2), + 0.3465735902799726547, TEST_TOL0, + 0.7853981633974483096, TEST_TOL0, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_log_e, (1.0, -1.0, &r1, &r2), + 0.3465735902799726547, TEST_TOL0, + -0.7853981633974483096, TEST_TOL0, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_log_e, (1.0, 100.0, &r1, &r2), + 4.605220183488258022, TEST_TOL0, + 1.560796660108231381, TEST_TOL0, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_log_e, (-1000.0, -1.0, &r1, &r2), + 6.907755778981887052, TEST_TOL0, + -3.1405926539231263718, TEST_TOL0, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_log_e, (-1.0, 0.0, &r1, &r2), + 0.0, TEST_TOL0, + 3.1415926535897932385, TEST_TOL0, + GSL_SUCCESS); + + + TEST_SF(s, gsl_sf_log_1plusx_e, (1.0e-10, &r), 9.999999999500000000e-11, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_1plusx_e, (1.0e-8, &r), 9.999999950000000333e-09, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_1plusx_e, (1.0e-4, &r), 0.00009999500033330833533, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_1plusx_e, (0.1, &r), 0.09531017980432486004, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_1plusx_e, (0.49, &r), 0.3987761199573677730, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_log_1plusx_e, (-0.49, &r), -0.6733445532637655964, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_1plusx_e, (1.0, &r), M_LN2, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_1plusx_e, (-0.99, &r), -4.605170185988091368, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_log_1plusx_mx_e, (1.0e-10, &r), -4.999999999666666667e-21, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_1plusx_mx_e, (1.0e-8, &r), -4.999999966666666917e-17, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_1plusx_mx_e, (1.0e-4, &r), -4.999666691664666833e-09, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_1plusx_mx_e, (0.1, &r), -0.004689820195675139956, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_1plusx_mx_e, (0.49, &r), -0.09122388004263222704, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_log_1plusx_mx_e, (-0.49, &r), -0.18334455326376559639, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_1plusx_mx_e, (1.0, &r), M_LN2-1.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_log_1plusx_mx_e, (-0.99, &r), -3.615170185988091368, TEST_TOL0, GSL_SUCCESS); + + return s; +} + + +int test_pow_int(void) +{ + gsl_sf_result r; + int status = 0; + int s = 0; + + TEST_SF(s, gsl_sf_pow_int_e, (2.0, 3, &r), 8.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_pow_int_e, (-2.0, 3, &r), -8.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_pow_int_e, (2.0, -3, &r), 1.0/8.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_pow_int_e, (-2.0, -3, &r), -1.0/8.0, TEST_TOL0, GSL_SUCCESS); + + + TEST_SF(s, gsl_sf_pow_int_e, (10.0, 4, &r), 1.0e+4, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_pow_int_e, (10.0, -4, &r), 1.0e-4, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_pow_int_e, (-10.0, 4, &r), 1.0e+4, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_pow_int_e, (-10.0, -4, &r), 1.0e-4, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_pow_int_e, (10.0, 40, &r), 1.0e+40, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_pow_int_e, (8.0, -40, &r), 7.523163845262640051e-37, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_pow_int_e, (-10.0, 40, &r), 1.0e+40, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_pow_int_e, (-8.0, -40, &r), 7.523163845262640051e-37, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_pow_int_e, (10.0, 41, &r), 1.0e+41, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_pow_int_e, (8.0, -41, &r), 9.403954806578300064e-38, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_pow_int_e, (-10.0, 41, &r), -1.0e+41, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_pow_int_e, (-8.0, -41, &r), -9.403954806578300064e-38, TEST_TOL0, GSL_SUCCESS); + + return status; +} + +int test_psi(void) +{ + gsl_sf_result r; + int s = 0; + + /* Test values taken 1-4 from gp-pari */ + + TEST_SF(s, gsl_sf_psi_int_e, (1, &r), -0.57721566490153286060, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_int_e, (2, &r), 0.42278433509846713939, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_int_e, (3, &r), 0.92278433509846713939, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_int_e, (4, &r), 1.2561176684318004727, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_psi_int_e, (5, &r), 1.5061176684318004727, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_int_e, (100, &r), 4.600161852738087400, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_int_e, (110, &r), 4.695928024251535633, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_int_e, (5000, &r), 8.517093188082904107, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_psi_e, (5000.0, &r), 8.517093188082904107, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_e, (5.0, &r), 1.5061176684318004727, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_e, (-10.5, &r), 2.3982391295357816134, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_e, (-100.5, &r), 4.615124601338064117, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_e, (-1.0e+5-0.5, &r), 11.512935464924395337, 4.0*TEST_TOL4, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_e, (-262144.0-0.5, &r), 12.476653064769611581, 4.0*TEST_TOL4, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_psi_1piy_e, (0.8, &r), -0.07088340212750589223, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1piy_e, (1.0, &r), 0.09465032062247697727, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1piy_e, (5.0, &r), 1.6127848446157465854, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1piy_e, (100.0, &r), 4.605178519404762003, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1piy_e, (2000.0, &r), 7.600902480375416216, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_psi_1piy_e, (-0.8, &r), -0.07088340212750589223, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1piy_e, (-1.0, &r), 0.09465032062247697727, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1piy_e, (-5.0, &r), 1.6127848446157465854, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1piy_e, (-100.0, &r), 4.605178519404762003, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1piy_e, (-2000.0, &r), 7.600902480375416216, TEST_TOL0, GSL_SUCCESS); + + /* Additional test values 1-4 computed using gp-pari and + Abramowitz & Stegun 6.4.6 */ + + TEST_SF(s, gsl_sf_psi_1_int_e, (1, &r), 1.6449340668482264364, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_int_e, (2, &r), 0.64493406684822643647, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_int_e, (3, &r), 0.39493406684822643647, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_int_e, (4, &r), 0.28382295573711532536, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_psi_1_int_e, (1, &r), 1.6449340668482264365, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_int_e, (5, &r), 0.22132295573711532536, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_int_e, (100, &r), 0.010050166663333571395, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_int_e, (110, &r), 0.009132356622022545705, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_int_e, (500, &r), 0.0020020013333322666697, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_psi_1_e, (1.0/32.0, &r), 1025.5728544782377089, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_e, (1.0, &r), 1.6449340668482264365, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_e, (5.0, &r), 0.22132295573711532536, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_e, (100.0, &r), 0.010050166663333571395, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_e, (110.0, &r), 0.009132356622022545705, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_e, (500.0, &r), 0.0020020013333322666697, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_psi_1_e, (-1.0 - 1.0/128.0, &r), 16386.648472598746587, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_e, (-1.50, &r), 9.3792466449891237539, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_e, (-10.5, &r), 9.7787577398148123845, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_e, (-15.5, &r), 9.8071247184113896201, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_e, (-50.5, &r), 9.8499971860824842274, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_1_e, (-1000.5, &r), 9.8686054001734414233, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_psi_n_e, (1, 1, &r), 1.6449340668482264364, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_n_e, (1, 2, &r), 0.64493406684822643647, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_n_e, (1, 3, &r), 0.39493406684822643647, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_n_e, (1, 4, &r), 0.28382295573711532536, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_psi_n_e, (1, 5, &r), 0.22132295573711532536, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_n_e, (1, 100, &r), 0.010050166663333571395, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_n_e, (1, 110, &r), 0.009132356622022545705, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_n_e, (1, 500, &r), 0.0020020013333322666697, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_psi_n_e, (3, 5.0, &r), 0.021427828192755075022, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_n_e, (3, 500.0, &r), 1.6048063999872000683e-08, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_n_e, (10, 5.0, &r), -0.08675107579196581317, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_n_e, (10, 50.0, &r), -4.101091112731268288e-12, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_psi_n_e, (0, -1.5, &r), 0.70315664064524318723, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_psi_n_e, (1, -1.5, &r), 9.3792466449891237539, TEST_TOL0, GSL_SUCCESS); + + return s; +} + + +int test_psi_complex(void) +{ + gsl_sf_result r1; + gsl_sf_result r2; + int s = 0; + + TEST_SF_2(s, gsl_sf_complex_psi_e, (1.0e+07, 1.0e+06, &r1, &r2), + 16.1230707668799525, TEST_TOL0, + 0.09966865744165720, TEST_TOL0, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_psi_e, (10.0, 50.0, &r1, &r2), + 3.92973987174863660, TEST_TOL0, + 1.38302847985210276, TEST_TOL0, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_psi_e, (2.0, 21.0, &r1, &r2), + 3.04697388853248195, TEST_TOL0, + 1.49947549076817824, TEST_TOL0, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_psi_e, (1.5, 0.0, &r1, &r2), + 0.0364899739785765206, TEST_TOL2, + 0.0, TEST_TOL1, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_psi_e, (1.0, 5.0, &r1, &r2), + 1.612784844615747, TEST_TOL1, + 1.470796326794968, TEST_TOL1, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_psi_e, (-1.5, 5.0, &r1, &r2), + 1.68260717336484070, TEST_TOL0, + 1.95230236730713338, TEST_TOL0, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_psi_e, (-20.5, -20.5, &r1, &r2), + 3.37919358657933066, TEST_TOL0, + -2.36829046481731091, TEST_TOL0, + GSL_SUCCESS); + + return s; +} + + + + +int test_synch(void) +{ + gsl_sf_result r; + int s = 0; + + TEST_SF(s, gsl_sf_synchrotron_1_e, (0.01, &r), 0.444972504114210632, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_synchrotron_1_e, (1.0, &r), 0.651422815355364504, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_synchrotron_1_e, (10.0, &r), 0.000192238264300868882, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_synchrotron_1_e, (100.0, &r), 4.69759366592220221e-43, TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_synchrotron_2_e, (0.01, &r), 0.23098077342226277732, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_synchrotron_2_e, (1.0, &r), 0.4944750621042082670, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_synchrotron_2_e, (10.0, &r), 0.00018161187569530204281, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_synchrotron_2_e, (256.0, &r), 1.3272635474353774058e-110, TEST_TOL4, GSL_SUCCESS); /* exp()... not my fault */ + + return s; +} + + +int test_transport(void) +{ + gsl_sf_result r; + int s = 0; + + TEST_SF(s, gsl_sf_transport_2_e, (1.0e-10, &r), 9.9999999999999999999e-11, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_2_e, (1.0, &r), 0.97303256135517012845, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_2_e, (3.0, &r), 2.41105004901695346199, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_2_e, (10.0, &r), 3.28432911449795173575, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_2_e, (100.0, &r), 3.28986813369645287294, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_2_e, (1.0e+05, &r), 3.28986813369645287294, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_transport_3_e, (1.0e-10, &r), 4.999999999999999999997e-21, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_3_e, (1.0, &r), 0.479841006572417499939, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_3_e, (3.0, &r), 3.210604662942246772338, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_3_e, (5.0, &r), 5.614386613842273228585, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_3_e, (10.0, &r), 7.150322712008592975030, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_3_e, (30.0, &r), 7.212341416160946511930, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_3_e, (100.0, &r), 7.212341418957565712398, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_3_e, (1.0e+05, &r), 7.212341418957565712398, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_transport_4_e, (1.0e-10, &r), 3.33333333333333333333e-31, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_4_e, (1.0e-07, &r), 3.33333333333333166666e-22, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_4_e, (1.0e-04, &r), 3.33333333166666666726e-13, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_4_e, (0.1, &r), 0.000333166726172109903824, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_4_e, (1.0, &r), 0.31724404523442648241, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_4_e, (3.0, &r), 5.96482239737147652446, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_4_e, (5.0, &r), 15.3597843168821829816, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_4_e, (10.0, &r), 25.2736676770304417334, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_4_e, (30.0, &r), 25.9757575220840937469, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_4_e, (100.0, &r), 25.9757576090673165963, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_4_e, (1.0e+05, &r), 25.9757576090673165963, TEST_TOL2, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_transport_5_e, (1.0e-10, &r), 2.49999999999999999999e-41, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_5_e, (1.0e-07, &r), 2.49999999999999861111e-29, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_5_e, (1.0e-04, &r), 2.49999999861111111163e-17, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_5_e, (0.1, &r), 0.000024986116317791487410, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_5_e, (1.0, &r), 0.236615879239094789259153, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_5_e, (3.0, &r), 12.77055769104415951115760, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_5_e, (5.0, &r), 50.26309221817518778543615, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_5_e, (10.0, &r), 116.3807454024207107698556, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_5_e, (30.0, &r), 124.4313279083858954839911, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_5_e, (100.0, &r), 124.4313306172043911597639, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_transport_5_e, (1.0e+05, &r), 124.43133061720439115976, TEST_TOL0, GSL_SUCCESS); + + return s; +} + + +int test_trig(void) +{ + gsl_sf_result r; + gsl_sf_result r1, r2; + double theta; + int s = 0; + int sa; + + TEST_SF(s, gsl_sf_sin_e, (-10.0, &r), 0.5440211108893698134, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sin_e, (1.0, &r), 0.8414709848078965067, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sin_e, (1000.0, &r), 0.8268795405320025603, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sin_e, (1048576.75, &r), 0.8851545351115651914, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sin_e, (62831853.75, &r), 0.6273955953485000827, TEST_TOL3, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sin_e, (1073741822.5, &r), -0.8284043541754465988, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sin_e, (1073741824.0, &r), -0.6173264150460421708, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sin_e, (1073741825.5, &r), 0.7410684679436226926, TEST_SQRT_TOL0, GSL_SUCCESS); + /* + TEST_SF(s, gsl_sf_sin_e, (1099511627776.0, &r), -0.4057050115328287198, 32.0*TEST_SQRT_TOL0, GSL_SUCCESS); + */ + + TEST_SF(s, gsl_sf_cos_e, (-10.0, &r), -0.8390715290764524523, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_cos_e, (1.0, &r), 0.5403023058681397174, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_cos_e, (1000.0, &r), 0.5623790762907029911, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_cos_e, (1048576.75, &r), 0.4652971620066351799, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_cos_e, (62831853.75, &r), 0.7787006914966116436, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_cos_e, (1073741822.5, &r), -0.5601305436977716102, TEST_SQRT_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_cos_e, (1073741824.0, &r), 0.7867071229411881196, TEST_SQRT_TOL0, GSL_SUCCESS); + /* + TEST_SF(s, gsl_sf_cos_e, (1099511627776.0, &r), -0.9140040719915570023, 128.0*TEST_SQRT_TOL0, GSL_SUCCESS); + */ + + TEST_SF(s, gsl_sf_sinc_e, (1.0/1024.0, &r), 0.9999984312693665404, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sinc_e, (1.0/2.0, &r), 2.0/M_PI, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sinc_e, (80.5, &r), 0.0039541600768172754, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sinc_e, (100.5, &r), 0.0031672625490924445, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sinc_e, (1.0e+06 + 0.5, &r), 3.18309727028927157e-07, TEST_TOL0, GSL_SUCCESS); + + /* + TEST_SF(s, gsl_sf_sin_pi_x_e, (1000.5, &r), 1.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sin_pi_x_e, (10000.0 + 1.0/65536.0, &r), 0.00004793689960306688455, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_sin_pi_x_e, (1099511627776.0 + 1 + 0.125, &r), -0.3826834323650897717, TEST_TOL0, GSL_SUCCESS); + */ + + TEST_SF_2(s, gsl_sf_complex_sin_e, (1.0, 5.0, &r1, &r2), + 62.44551846769653403, TEST_TOL0, + 40.09216577799840254, TEST_TOL0, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_cos_e, (1.0, 5.0, &r1, &r2), + 40.09580630629882573, TEST_TOL0, + -62.43984868079963017, TEST_TOL0, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_logsin_e, (1.0, 100.0, &r1, &r2), + 99.3068528194400546900, TEST_TOL0, + 0.5707963267948966192, TEST_TOL0, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_logsin_e, (1.0, -100.0, &r1, &r2), + 99.3068528194400546900, TEST_TOL1, + -0.5707963267948966192, TEST_TOL1, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_complex_logsin_e, (5.0, 5.0, &r1, &r2), + 4.3068909128079757420, TEST_TOL0, + 2.8540063315538773952, TEST_TOL0, + GSL_SUCCESS); + + TEST_SF(s, gsl_sf_lnsinh_e, (0.1, &r), -2.3009189815304652235, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lnsinh_e, (1.0, &r), 0.16143936157119563361, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lnsinh_e, (5.0, &r), 4.306807418479684201, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lnsinh_e, (100.0, &r), 99.30685281944005469, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_lncosh_e, (0.125, &r), 0.007792239318898252791, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lncosh_e, (1.0, &r), 0.4337808304830271870, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lncosh_e, (5.0, &r), 4.306898218339271555, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_lncosh_e, (100.0, &r), 99.30685281944005469, TEST_TOL0, GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_polar_to_rect, (10.0, M_PI/6.0, &r1, &r2), + (10.0 * sqrt(3) / 2.0), TEST_TOL0, + (10.0 * 0.5), TEST_TOL0, + GSL_SUCCESS); + + TEST_SF_2(s, gsl_sf_polar_to_rect, (10.0, -2.0/3.0*M_PI, &r1, &r2), + (10.0 * (-0.5)), TEST_TOL1, + (10.0 * (-sqrt(3.0)/2.0)), TEST_TOL1, + GSL_SUCCESS); + + /* In double precision M_PI = \pi - 1.2246467991473531772e-16, + i.e. the nearest machine number is slightly below the exact value + of \pi. The true value of \pi satisfies + + M_PI < \pi < nextafter(M_PI,+Inf) + + where nextafter(M_PI,+Inf) = M_PI + 2*DBL_EPSILON + + This also means that 2*M_PI is less than \pi by 2.449e-16. The + true value of 2\pi satisfies + + 2*M_PI < 2\pi < nextafter(2*M_PI,+Inf) + + where nextafter(2*M_PI,+Inf) = 2*M_PI + 4*DBL_EPSILON + + BJG 25/9/06 + */ + +#define DELTA (1.2246467991473531772e-16) + + TEST_SF_THETA(s, gsl_sf_angle_restrict_pos_e, (2.0*M_PI), 2*M_PI, TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_pos_e, (-2.0*M_PI), 2*DELTA, TEST_TOL1); + + TEST_SF_THETA(s, gsl_sf_angle_restrict_pos_e, (2.0*M_PI+4*GSL_DBL_EPSILON), 4*GSL_DBL_EPSILON-2*DELTA, TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_pos_e, (-2.0*M_PI-4*GSL_DBL_EPSILON), 2*M_PI-4*GSL_DBL_EPSILON+2*DELTA, TEST_TOL1); + + TEST_SF_THETA(s, gsl_sf_angle_restrict_pos_e, (4.0*M_PI+8*GSL_DBL_EPSILON), 8*GSL_DBL_EPSILON-4*DELTA, TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_pos_e, (-4.0*M_PI-8*GSL_DBL_EPSILON), 2*M_PI-8*GSL_DBL_EPSILON+4*DELTA, TEST_TOL1); + + TEST_SF_THETA(s, gsl_sf_angle_restrict_pos_e, (1e9), 0.5773954235013851694, TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_pos_e, (1e12), 5.625560548042800009446, TEST_SNGL); + + TEST_SF_THETA(s, gsl_sf_angle_restrict_pos_e, (-1e9), 5.7057898836782013075, TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_pos_e, (-1e12), 0.6576247591367864674792517289, 100*TEST_SNGL); + +#ifdef EXTENDED + TEST_SF_THETA(s, gsl_sf_angle_restrict_pos_e, (1e15), 2.1096981170701125979, TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_pos_e, (-1e15), 4.1734871901094738790, TEST_TOL1); +#endif + + TEST_SF(s, gsl_sf_angle_restrict_pos_err_e, (2.0*M_PI, &r), 2*M_PI, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_angle_restrict_pos_err_e, (-2.0*M_PI, &r), 2*DELTA, TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_angle_restrict_pos_err_e, (1e9, &r), 0.5773954235013851694, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_angle_restrict_pos_err_e, (1e12, &r), 5.625560548042800009446, TEST_SNGL, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_angle_restrict_pos_err_e, (-1e9, &r), 5.7057898836782013075, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_angle_restrict_pos_err_e, (-1e12, &r), 0.6576247591367864674792517289, 100*TEST_SNGL, GSL_SUCCESS); + + TEST_SF (s, gsl_sf_angle_restrict_pos_err_e, (1e15, &r), GSL_NAN, TEST_TOL1, GSL_ELOSS); + TEST_SF (s, gsl_sf_angle_restrict_pos_err_e, (-1e15, &r), GSL_NAN, TEST_TOL1, GSL_ELOSS); + + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (2.0*M_PI), -2*DELTA, TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (-2.0*M_PI), 2*DELTA, TEST_TOL1); + + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (M_PI), M_PI, TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (-M_PI), -M_PI, TEST_TOL1); + + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (M_PI+2*GSL_DBL_EPSILON), -M_PI+2*(GSL_DBL_EPSILON-DELTA), TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (-M_PI-2*GSL_DBL_EPSILON), M_PI-2*(GSL_DBL_EPSILON-DELTA), TEST_TOL1); + + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (3*M_PI+6*GSL_DBL_EPSILON), -M_PI+6*GSL_DBL_EPSILON-4*DELTA, TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (-3*M_PI-6*GSL_DBL_EPSILON), M_PI-6*GSL_DBL_EPSILON+4*DELTA, TEST_TOL1); + + + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (1e9), 0.5773954235013851694, TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (1e12), -0.6576247591367864674792517289, 100*TEST_SNGL); + + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (-1e9), -0.5773954235013851694, TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (-1e12), 0.6576247591367864674792517289, 100*TEST_SNGL); + +#ifdef EXTENDED + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (1e15), 2.1096981170701125979, TEST_TOL1); + TEST_SF_THETA(s, gsl_sf_angle_restrict_symm_e, (-1e15), -2.1096981170701125979, TEST_TOL1); +#endif + + TEST_SF (s, gsl_sf_angle_restrict_symm_err_e, (2.0*M_PI, &r), -2*DELTA, TEST_TOL1, GSL_SUCCESS); + TEST_SF (s, gsl_sf_angle_restrict_symm_err_e, (-2.0*M_PI, &r), 2*DELTA, TEST_TOL1, GSL_SUCCESS); + + + TEST_SF(s, gsl_sf_angle_restrict_symm_err_e, (1e9, &r), 0.5773954235013851694, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_angle_restrict_symm_err_e, (1e12, &r), -0.6576247591367864674792517289, 100*TEST_SNGL, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_angle_restrict_symm_err_e, (-1e9, &r), -0.5773954235013851694, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_angle_restrict_symm_err_e, (-1e12, &r), 0.6576247591367864674792517289, 100*TEST_SNGL, GSL_SUCCESS); + + TEST_SF (s, gsl_sf_angle_restrict_symm_err_e, (1e15, &r), GSL_NAN, TEST_TOL1, GSL_ELOSS); + TEST_SF (s, gsl_sf_angle_restrict_symm_err_e, (-1e15, &r), GSL_NAN, TEST_TOL1, GSL_ELOSS); + + theta = 5.0*M_PI + 5*DELTA + M_PI/2.0; + gsl_sf_angle_restrict_pos_e(&theta); + sa = 0; + sa += ( test_sf_frac_diff( theta, 3.0/2.0*M_PI ) > TEST_TOL0 ); + gsl_test(sa, " gsl_angle_restrict_pos_e: theta = 11/2 Pi"); + s += sa; + + theta = -5.0*M_PI - 5*DELTA - M_PI/2.0; + gsl_sf_angle_restrict_pos_e(&theta); + sa = 0; + sa += ( test_sf_frac_diff( theta, M_PI/2.0 ) > 2.0*TEST_TOL0 ); + gsl_test(sa, " gsl_angle_restrict_pos_e: theta = -11/2 Pi"); + s += sa; + + theta = 50000.0 + 1.0/65536.0; + gsl_sf_angle_restrict_pos_e(&theta); + sa = 0; + sa += ( test_sf_frac_diff( theta, 4.6945260308194656055 ) > TEST_TOL0 ); + gsl_test(sa, " gsl_angle_restrict_pos_e: theta = 50000.0 + 1.0/65536.0"); + s += sa; + + theta = 5000000.0 + 1.0/65536.0; + gsl_sf_angle_restrict_pos_e(&theta); + sa = 0; + sa += ( test_sf_frac_diff( theta, 4.49537973053997376 ) > TEST_TOL0 ); + gsl_test(sa, " gsl_angle_restrict_pos_e: theta = 5000000.0 + 1.0/65536.0"); + s += sa; + + /* + theta = 140737488355328.0; + gsl_sf_angle_restrict_pos_e(&theta); + sa = 0; + sa += ( test_sf_frac_diff( theta, 3.20652300406795792638 ) > TEST_TOL0 ); + gsl_test(sa, " gsl_angle_restrict_pos_e: theta = 2^47"); + s += sa; + */ + + theta = 5.0*M_PI + (5.5*DELTA + M_PI/2.0); + gsl_sf_angle_restrict_symm_e(&theta); + sa = 0; + sa += ( test_sf_frac_diff( theta, -M_PI/2.0 ) > 2.0*TEST_TOL0 ); + gsl_test(sa, " gsl_angle_restrict_symm_e: theta = 11/2 Pi"); + s += sa; + + theta = -5.0*M_PI - (5.5*DELTA + M_PI/2.0); + gsl_sf_angle_restrict_symm_e(&theta); + sa = 0; + sa += ( test_sf_frac_diff( theta, M_PI/2.0 ) > 2.0*TEST_TOL0 ); + gsl_test(sa, " gsl_angle_restrict_symm_e: theta = -11/2 Pi"); + s += sa; + + theta = 5.0*M_PI + 5*DELTA - M_PI/2.0; + gsl_sf_angle_restrict_symm_e(&theta); + sa = 0; + sa += ( test_sf_frac_diff( theta, M_PI/2.0 ) > TEST_TOL0 ); + gsl_test(sa, " gsl_angle_restrict_symm_e: theta = -9/2 Pi"); + s += sa; + + theta = 3.0/2.0*M_PI + 3.0/2.0*DELTA; + gsl_sf_angle_restrict_symm_e(&theta); + sa = 0; + sa += ( test_sf_frac_diff( theta, -M_PI/2.0 ) > TEST_TOL0 ); + gsl_test(sa, " gsl_angle_restrict_symm_e: theta = 3/2 Pi"); + s += sa; + + theta = -3.0/2.0*M_PI; + gsl_sf_angle_restrict_symm_e(&theta); + sa = 0; + sa += ( test_sf_frac_diff( theta, M_PI/2.0 ) > TEST_TOL0 ); + gsl_test(sa, " gsl_angle_restrict_symm_e: theta = -3/2 Pi"); + s += sa; + + theta = 50000.0 + 1.0/65536.0; + gsl_sf_angle_restrict_symm_e(&theta); + sa = 0; + sa += ( test_sf_frac_diff( theta, -1.5886592763601208714 ) > TEST_TOL0 ); + gsl_test(sa, " gsl_angle_restrict_symm_e: theta = 50000.0 + 1.0/65536.0"); + s += sa; + + return s; +} + + +/* I computed the values of zeta for s = -1e-10, 0, 1e-10 using the + Jensen formula, + + zeta(s) = -1/2 + 1/(1-s) + + integ(sin(s arctan(t))/((1+t^2)^(s/2)(exp(2pi*t)-1)), t, 0, inf) + + transforming the integral from a semi-infinite range to the range + [0,pi/2] using the substitution t = tan(u). After Taylor expansion + in s and numerical evaluation of the integrals this gave, + + zeta(s) = 1/2 + 1/(1-s) + + (0.0810614667944862 +/- 2e-16) s + + (-3.17822795429232e-3 +/- 2e-17) s^2 + + .... + + for an expansion about s = 0 [BJG 7/01] +*/ + +int test_zeta(void) +{ + gsl_sf_result r; + int s = 0; + + TEST_SF(s, gsl_sf_zeta_int_e, (-61.0, &r), -3.30660898765775767257e+34, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zeta_int_e, (-8, &r), 0.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_int_e, (-6, &r), 0.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_int_e, (-5.0, &r), -0.003968253968253968253968, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zeta_int_e, (-4, &r), 0.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_int_e, (-3, &r), 1.0/120.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_int_e, (-2, &r), 0.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_int_e, (-1, &r), -1.0/12.0, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zeta_int_e, ( 5.0, &r), 1.0369277551433699263313655, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_int_e, (31.0, &r), 1.0000000004656629065033784, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zetam1_int_e, (-61.0, &r), -3.30660898765775767257e+34, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_int_e, (-5.0, &r), -1.003968253968253968253968, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zetam1_int_e, (-8, &r), -1.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_int_e, (-6, &r), -1.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_int_e, (-4, &r), -1.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_int_e, (-3, &r), -119.0/120.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_int_e, (-2, &r), -1.0, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_int_e, (-1, &r), -13.0/12.0, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zetam1_int_e, ( 5.0, &r), 0.0369277551433699263313655, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_int_e, (31.0, &r), 0.0000000004656629065033784, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zeta_e, (-151, &r), 8.195215221831378294e+143, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (-51, &r), 9.68995788746359406565e+24, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (-5, &r), -0.003968253968253968253968, TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zeta_e, (-8, &r), 0.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (-6, &r), 0.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (-4, &r), 0.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (-3, &r), 1.0/120.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (-2, &r), 0.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (-1, &r), -1.0/12.0, TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zeta_e, (-0.5, &r), -0.207886224977354566017307, TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zeta_e, (-1e-10, &r), -0.49999999990810614668948, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (0.0, &r), -0.5, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (1e-10, &r), -0.50000000009189385333058, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zeta_e, (0.5, &r), -1.460354508809586812889499, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (1.0-1.0/1024.0, &r), -1023.4228554489429787, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (1.0+1.0/1048576, &r), 1.0485765772157343441e+06, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (5.0, &r), 1.036927755143369926331365, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zeta_e, (25.5, &r), 1.000000021074106110269959, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zetam1_e, (-8, &r), -1.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (-6, &r), -1.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (-4, &r), -1.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (-3, &r), -119.0/120.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (-2, &r), -1.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (-1, &r), -13.0/12.0, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (-0.5, &r), -1.207886224977354566017307, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (-1e-10, &r), -1.49999999990810614668948, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (0.0, &r), -1.5, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (1e-10, &r), -1.50000000009189385333058, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_zetam1_e, (0.5, &r), -2.460354508809586812889499, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (2.0, &r), 0.64493406684822643647, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (3.0, &r), 0.20205690315959428540, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (5.0, &r), 0.0369277551433699263314, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (9.5, &r), 0.0014125906121736622712, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (10.5, &r), 0.000700842641736155219500, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (12.5, &r), 0.000173751733643178193390, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (13.5, &r), 0.000086686727462338155188, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (15.5, &r), 0.000021619904246069108133, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (16.5, &r), 0.000010803124900178547671, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_zetam1_e, (25.5, &r), 0.000000021074106110269959, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_hzeta_e, (2, 1.0, &r), 1.6449340668482264365, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hzeta_e, (2, 10.0, &r), 0.1051663356816857461, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hzeta_e, (5, 1.0, &r), 1.0369277551433699263, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hzeta_e, (5, 10.0, &r), 0.000030413798676470276, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hzeta_e, (9, 0.1, &r), 1.0000000004253980e+09, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hzeta_e, (30, 0.5, &r), 1.0737418240000053e+09, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hzeta_e, (30, 0.9, &r), 2.3589824880264765e+01, TEST_TOL1, GSL_SUCCESS); + TEST_SF(s, gsl_sf_hzeta_e, (75, 0.25, &r), 1.4272476927059599e+45, TEST_TOL1, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_eta_int_e, (-91, &r), -4.945598888750002040e+94, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_int_e, (-51, &r), -4.363969073121683116e+40, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_int_e, (-5, &r), 0.25, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_int_e, (-1, &r), 0.25, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_int_e, ( 0, &r), 0.5, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_int_e, ( 5, &r), 0.9721197704469093059, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_int_e, ( 6, &r), 0.9855510912974351041, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_int_e, ( 20, &r), 0.9999990466115815221, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_int_e, ( 1000, &r), 1.0, TEST_TOL0, GSL_SUCCESS); + + TEST_SF(s, gsl_sf_eta_e, (-51.5, &r), -1.2524184036924703656e+41, TEST_TOL2, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_e, (-5, &r), 0.25, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_e, (0.5, &r), 0.6048986434216303702, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_e, (0.999, &r), 0.6929872789683383574, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_e, (1.0, &r), 0.6931471805599453094, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_e, (1.0+1.0e-10, &r), 0.6931471805759321998, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_e, ( 5, &r), 0.9721197704469093059, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_e, ( 5.2, &r), 0.9755278712546684682, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_e, ( 6, &r), 0.9855510912974351041, TEST_TOL0, GSL_SUCCESS); + TEST_SF(s, gsl_sf_eta_e, ( 20, &r), 0.9999990466115815221, TEST_TOL0, GSL_SUCCESS); + + return s; +} + +int test_results(void) +{ + int s = 0; + + gsl_sf_result_e10 re; + gsl_sf_result r; + + re.val = -1.0; + re.err = 0.5; + re.e10 = 0; + gsl_sf_result_smash_e(&re, &r); + s += ( test_sf_frac_diff(r.val, -1.0) > TEST_TOL0 ); + s += ( test_sf_frac_diff(r.err, 0.5) > TEST_TOL0 ); + + re.val = -1.0; + re.err = 0.5; + re.e10 = 10; + gsl_sf_result_smash_e(&re, &r); + s += ( test_sf_frac_diff(r.val, -1.0e+10) > TEST_TOL1 ); + s += ( test_sf_frac_diff(r.err, 0.5e+10) > TEST_TOL1 ); + + re.val = 1.0; + re.err = 0.5; + re.e10 = 10000; + s += ( gsl_sf_result_smash_e(&re, &r) != GSL_EOVRFLW ); + + re.val = 1.0; + re.err = 0.5; + re.e10 = -10000; + s += ( gsl_sf_result_smash_e(&re, &r) != GSL_EUNDRFLW ); + + return s; +} + + +int main(int argc, char * argv[]) +{ + gsl_ieee_env_setup (); + gsl_set_error_handler_off (); + + gsl_test(test_airy(), "Airy Functions"); + gsl_test(test_bessel(), "Bessel Functions"); + gsl_test(test_clausen(), "Clausen Integral"); + gsl_test(test_coulomb(), "Coulomb Wave Functions"); + gsl_test(test_coupling(), "Coupling Coefficients"); + gsl_test(test_dawson(), "Dawson Integral"); + gsl_test(test_debye(), "Debye Functions"); + gsl_test(test_dilog(), "Dilogarithm"); + gsl_test(test_elementary(), "Elementary Functions (Misc)"); + gsl_test(test_ellint(), "Elliptic Integrals"); + gsl_test(test_jac(), "Elliptic Functions (Jacobi)"); + gsl_test(test_erf(), "Error Functions"); + gsl_test(test_exp(), "Exponential Functions"); + gsl_test(test_expint(), "Exponential/Sine/Cosine Integrals"); + gsl_test(test_fermidirac(), "Fermi-Dirac Functions"); + gsl_test(test_gamma(), "Gamma Functions"); + gsl_test(test_gegen(), "Gegenbauer Polynomials"); + gsl_test(test_hyperg(), "Hypergeometric Functions"); + gsl_test(test_laguerre(), "Laguerre Polynomials"); + gsl_test(test_lambert(), "Lambert W Functions"); + gsl_test(test_legendre(), "Legendre Functions"); + gsl_test(test_log(), "Logarithm"); + gsl_test(test_mathieu(), "Mathieu Functions"); + gsl_test(test_pow_int(), "Integer Powers"); + gsl_test(test_psi(), "Psi Functions"); + gsl_test(test_psi_complex(), "Psi Function for complex argument"); + gsl_test(test_synch(), "Synchrotron Functions"); + gsl_test(test_transport(), "Transport Functions"); + gsl_test(test_trig(), "Trigonometric and Related Functions"); + gsl_test(test_zeta(), "Zeta Functions"); + + gsl_test(test_results(), "Result Methods"); + + exit (gsl_test_summary()); +} diff --git a/octave_packages/image-1.0.15/applylut.m b/octave_packages/image-1.0.15/applylut.m new file mode 100644 index 0000000..66da7bc --- /dev/null +++ b/octave_packages/image-1.0.15/applylut.m @@ -0,0 +1,62 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{A} = } applylut (@var{BW},@var{LUT}) +## Uses lookup tables to perform a neighbour operation on binary images. +## +## A = applylut(BW,LUT) returns the result of a neighbour operation +## using the lookup table @var{LUT} which can be created by makelut. +## +## It first computes a matrix with the index of each element in the +## lookup table. To do this, it convolves the original matrix with a +## matrix which assigns each of the neighbours a bit in the resulting +## index. Then @var{LUT} is accessed to compute the result. +## +## @seealso{makelut} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function A = applylut(BW, LUT) + if (nargin != 2) + usage ("A = applylut(BW, LUT)"); + endif + + nq=log2(length(LUT)); + n=sqrt(nq); + if (floor(n)!=n) + error ("applylut: LUT length is not as expected. Use makelut to create it."); + endif + w=reshape(2.^[nq-1:-1:0],n,n); + A=LUT(filter2(w,BW)+1); +endfunction + +%!demo +%! lut = makelut (inline ('sum (x (:)) >= 3', 'x'), 3); +%! S = applylut (eye (5), lut); +%! disp (S) +%! ## Everything should be 0 despite a diagonal which +%! ## doesn't reach borders. + + +%!assert(prod(applylut(eye(3),makelut(inline('x(1,1)==1','x'),2))==eye(3))==1); % 2-by-2 test +%!assert(prod(applylut(eye(3),makelut(inline('x(2,2)==1','x'),3))==eye(3))==1); % 3-by-3 test +%!assert(prod(applylut(eye(3),makelut(inline('x(3,3)==1','x'),3))== \ +%! applylut(eye(3),makelut(inline('x(2,2)==1','x'),2)))==1); + + + + diff --git a/octave_packages/image-1.0.15/bestblk.m b/octave_packages/image-1.0.15/bestblk.m new file mode 100644 index 0000000..abe29f8 --- /dev/null +++ b/octave_packages/image-1.0.15/bestblk.m @@ -0,0 +1,118 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{siz} = } bestblk ([@var{m} @var{n}], @var{k}) +## @deftypefnx {Function File} {[@var{mb} @var{nb}] = } bestblk ([@var{m} @var{n}], @var{k}) +## Calculates the best size of block for block processing. +## +## @code{siz=bestblk([m,n],k)} calculates the optimal block size for block +## processing for a @var{m}-by-@var{n} image. @var{k} is the maximum +## side dimension of the block. Its default value is 100. @var{siz} is a +## row vector which contains row and column dimensions for the block. +## +## @code{[mb,nb]=bestblk([m,n],k)} behaves as described above but +## returns block dimensions to @var{mb} and @var{nb}. +## +## @strong{Algorithm:} +## +## For each dimension (@var{m} and @var{n}), it follows this algorithm: +## +## 1.- If dimension is less or equal than @var{k}, it returns the +## dimension value. +## +## 2.- If not then returns the value between +## @code{round(min(dimension/10,k/2))} which minimizes padding. +## +## +## @seealso{blkproc} +## @end deftypefn + + +## Author: Josep Mones i Teixidor + +function [varargout] = bestblk(ims,k) + if(nargin<1 || nargin>2) + usage("siz=bestblk([m,n],k), [mb,nb]=bestblk([m,n],k)"); + endif + if(nargout>2) + usage("siz=bestblk([m,n],k), [mb,nb]=bestblk([m,n],k)"); + endif + if(nargin<2) + k=100; + endif + if(!isvector(ims)) + error("bestblk: first parameter is not a vector."); + endif + ims=ims(:); + if(length(ims)!=2) + error("bestblk: length of first parameter is not 2."); + endif + + mb=mi=ims(1); + p=mi; + if(mi>k) + for i=round(min(mi/10,k/2)):k + pt=rem(mi,i); + if(ptk) + for i=round(min(ni/10,k/2)):k + pt=rem(ni,i); + if(pt. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{B} = } blkproc (@var{A}, [@var{m},@var{n}], @var{fun}) +## @deftypefnx {Function File} {@var{B} = } blkproc (@var{A}, [@var{m},@var{n}], @var{fun}, ...) +## @deftypefnx {Function File} {@var{B} = } blkproc (@var{A}, [@var{m},@var{n}], [@var{mborder},@var{nborder}], @var{fun}, @var{...}) +## @deftypefnx {Function File} {@var{B} = } blkproc (@var{A}, 'indexed', ...) +## Processes image in blocks using user-supplied function. +## +## @code{B=blkproc(A,[m,n],fun)} divides image @var{A} in +## @var{m}-by-@var{n} blocks, and passes them to user-supplied function +## @var{fun}, which result is concatenated to build returning matrix +## @var{B}. If padding is needed to build @var{m}-by-@var{n}, it is added +## at the bottom and right borders of the image. 0 is used as a padding +## value. +## +## @code{B=blkproc(A,[m,n],fun,...)} behaves as described above but +## passes extra parameters to function @var{fun}. +## +## @code{B=blkproc(A,[m,n],[mborder,nborder],fun,...)} behaves as +## described but uses blocks which overlap with neighbour blocks. +## Overlapping dimensions are @var{mborder} vertically and @var{nborder} +## horizontally. This doesn't change the number of blocks in an image +## (which depends only on size(@var{A}) and [@var{m},@var{n}]). Adding a +## border requires extra padding on all edges of the image. 0 is used as +## a padding value. +## +## @code{B=blkproc(A,'indexed',...)} assumes that @var{A} is an indexed +## image, so it pads the image using proper value: 0 for uint8 and +## uint16 images and 1 for double images. Keep in mind that if 'indexed' +## is not specified padding is always done using 0. +## +## @seealso{colfilt,inline,bestblk} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function B = blkproc(A, varargin) + if(nargin<3) + error("blkproc: invalid number of parameters."); + endif + + ## check 'indexed' presence + indexed=false; + p=1; + if(ischar(varargin{1}) && strcmp(varargin{1}, "indexed")) + indexed=true; + p+=1; + if(isa(A,"uint8") || isa(A,"uint16")) + padval=0; + else + padval=1; + endif + else + padval=0; + endif + + ## check [m,n] + if(!isvector(varargin{p})) + error("blkproc: expected [m,n] but param is not a vector."); + endif + if(length(varargin{p})!=2) + error("blkproc: expected [m,n] but param has wrong length."); + endif + sblk=varargin{p}(:); + p+=1; + + ## check [mborder,nborder] + if(nargin ischar +% +% Revision 1.4 2004/11/15 16:04:20 pkienzle +% Fix tests for functions which return boolean matrices +% +% Revision 1.3 2004/09/03 17:49:37 jmones +% Improved uint8 and uint16 padding expections +% +% Revision 1.2 2004/09/03 13:40:13 jmones +% Check result has same class as function result, and improved fun param checking +% +% Revision 1.1 2004/08/15 19:27:46 jmones +% blkproc: block process an image using user-supplied function +% +% diff --git a/octave_packages/image-1.0.15/bmpwrite.m b/octave_packages/image-1.0.15/bmpwrite.m new file mode 100644 index 0000000..9c034c6 --- /dev/null +++ b/octave_packages/image-1.0.15/bmpwrite.m @@ -0,0 +1,99 @@ +## -*- texinfo -*- +## @deftypefn {Function File} bmpwrite (@var{X}, @var{map}, @var{file}) +## Write the bitmap @var{X} into @var{file} (8-bit indexed uncompressed). +## The values in @var{X} are indices into the given RGB colour @var{map}. +## @deftypefnx{Function File} bmpwrite (@var{X}, @var{file}) +## Write the bitmap @var{X} into @var{file} (24-bit truecolor uncompressed). +## @var{X} is an m x n x 3 array of R,G,B integer values in the range 0 to 255. +## @end deftypefn + +## This code is in the public domain. +## Author: Paul Kienzle + + +function bmpwrite(x,colormap_or_file,file) + if nargin==2 + bmpwrite_truecolor(x(:,:,1),x(:,:,2),x(:,:,3),colormap_or_file); + else + bmpwrite_indexed(x,colormap_or_file,file); + endif +endfunction + +function bmpwrite_truecolor(R,G,B,file) + h = rows(R); w = columns(R); + padw = ceil(3*w/4)*4-3*w; + header = 14+40; + filesize = header+h*(3*w+padw); + arch = "ieee-le"; + file = fopen(file, "wb"); + fwrite(file,toascii("BM"),"uchar",0,arch); # file tag + fwrite(file,filesize,"long",0,arch); # length of file + fwrite(file,0,"long",0,arch); # reserved + fwrite(file,header,"long",0,arch); # offset of raster data in file + + fwrite(file,40,"long",0,arch); # header size + fwrite(file,w,"long",0,arch); # image width + fwrite(file,h,"long",0,arch); # image height + fwrite(file,1,"short",0,arch); # number of planes + fwrite(file,24,"short",0,arch); # pixels per plane + fwrite(file,0,"long",0,arch); # compression (none) + fwrite(file,0,"long",0,arch); # compressed size of image + resolution = 72/2.54*100; # 72 dpi / 2.54 cm/in * 100 cm/m + fwrite(file,resolution,"long",0,arch); # horizontal resolution + fwrite(file,resolution,"long",0,arch); # vertical resolution + fwrite(file,0,"long",0,arch); # number of colours used + fwrite(file,0,"long",0,arch); # number of "important" colors + + ## raster image, lines written bottom to top. + R = R(end:-1:1,:)'; + G = G(end:-1:1,:)'; + B = B(end:-1:1,:)'; + RGB=[B(:),G(:),R(:)]'; # Now [[B;G;R],[B;G;R],...,[B;G;R]] + RGB=reshape(RGB,3*w,h); # Now [[B;G;R;...;B;G;R],...,[B;G;R;...;B;G;R]] + fwrite(file,[RGB;zeros(padw,h)],"uchar",0,arch); + fclose(file); +endfunction + +function bmpwrite_indexed(x,map,file) + + if rows(map) > 256, + bmpwrite_truecolor(reshape(map(x,1),size(x))*255, + reshape(map(x,2),size(x))*255, + reshape(map(x,3),size(x))*255, + file); + return; + endif + [h,w] = size(x); + padw = ceil(w/4)*4-w; + header = 14+40+4*rows(map); + filesize = header+(w+padw)*h; + arch = "ieee-le"; + file = fopen(file, "wb"); + fwrite(file,toascii("BM"),"uchar",0,arch); # file tag + fwrite(file,filesize,"long",0,arch); # length of file + fwrite(file,0,"long",0,arch); # reserved + fwrite(file,header,"long",0,arch); # offset of raster data in file + + fwrite(file,40,"long",0,arch); # header size + fwrite(file,w,"long",0,arch); # image width + fwrite(file,h,"long",0,arch); # image height + fwrite(file,1,"short",0,arch); # number of planes + fwrite(file,8,"short",0,arch); # pixels per plane + fwrite(file,0,"long",0,arch); # compression (none) + fwrite(file,0,"long",0,arch); # compressed size of image + resolution = 72/2.54*100; # 72 dpi / 2.54 cm/in * 100 cm/m + fwrite(file,resolution,"long",0,arch); # horizontal resolution + fwrite(file,resolution,"long",0,arch); # vertical resolution + fwrite(file,rows(map),"long",0,arch); # number of colours used + fwrite(file,0,"long",0,arch); # number of "important" colors + + ## colormap BGR0BGR0BGR0BGR0... + map=[round(map*255), zeros(rows(map),1)]; + map=map(:,[3,2,1,4]); + fwrite(file,map',"uchar",0,arch); + + ## raster image, each line on a 32-bit boundary, padded with zeros + ## lines written bottom to top. + fwrite(file,[flipud(x-1)';zeros(padw,h)],"uchar",0,arch); + fclose(file); +endfunction diff --git a/octave_packages/image-1.0.15/bwarea.m b/octave_packages/image-1.0.15/bwarea.m new file mode 100644 index 0000000..ff5aa89 --- /dev/null +++ b/octave_packages/image-1.0.15/bwarea.m @@ -0,0 +1,56 @@ +## Copyright (C) 2005 Søren Hauberg +## +## 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{total}= bwarea(@var{bw}) +## Estimates the area of the "on" pixels of @var{bw}. +## If @var{bw} is a binary image "on" pixels are defined as pixels +## valued 1. If @var{bw} is a grayscale image "on" pixels is defined +## as pixels with values larger than zero. +## This algorithm is not the same as counting the number of "on" +## pixels as it tries to estimate the area of the original object +## and not the image object. +## @end deftypefn + +## Author: Søren Hauberg +## +## 2005-06-05 Søren Hauberg +## * Initial revision + + +function total = bwarea(bw) + if (isgray(bw)) + bw = (bw > 0); + endif + + if (!isbw(bw)) + error("input image muste be either binary or gray scale.\n"); + endif + + four = ones(2); + two = diag([1 1]); + + fours = conv2(bw, four); + twos = conv2(bw, two); + + nQ1 = sum(fours(:) == 1); + nQ3 = sum(fours(:) == 3); + nQ4 = sum(fours(:) == 4); + nQD = sum(fours(:) == 2 & twos(:) != 1); + nQ2 = sum(fours(:) == 2 & twos(:) == 1); + + total = 0.25*nQ1 + 0.5*nQ2 + 0.875*nQ3 + nQ4 + 0.75*nQD; + +endfunction diff --git a/octave_packages/image-1.0.15/bwborder.m b/octave_packages/image-1.0.15/bwborder.m new file mode 100644 index 0000000..3553348 --- /dev/null +++ b/octave_packages/image-1.0.15/bwborder.m @@ -0,0 +1,37 @@ +## Copyright (C) 2000 Etienne Grossmann +## +## 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{b} = } bwborder (@var{im}) +## Finds the borders of foreground objects in a binary image. +## +## @var{b} is the borders in the 0-1 matrix @var{im}. 4-neighborhood is considered. +## +## A pixel is on the border if it is set in @var{im}, and it has at least one +## neighbor that is not set. +## @end deftypefn + +## Author: Etienne Grossmann +## Last modified: January 2000 + +function b = bwborder(im) + +[R,C]=size(im); + +b = im & ... + !([im(2:R,:) ; zeros(1,C) ] & ... + [zeros(1,C); im(1:R-1,:) ] & ... + [im(:,2:C) , zeros(R,1) ] & ... + [zeros(R,1), im(:,1:C-1)] ) ; diff --git a/octave_packages/image-1.0.15/bwboundaries.m b/octave_packages/image-1.0.15/bwboundaries.m new file mode 100644 index 0000000..fed081b --- /dev/null +++ b/octave_packages/image-1.0.15/bwboundaries.m @@ -0,0 +1,95 @@ +## Copyright (C) 2010 Soren Hauberg +## Modified December 2010 by Andrew Kelly, IPS Radio & Space Services +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{boundaries} = } bwboundaries(@var{BW}) +## @deftypefnx {Function File} {@var{boundaries} = } bwboundaries(@var{BW}, @var{conn}) +## @deftypefnx {Function File} {@var{boundaries} = } bwboundaries(@var{BW}, @var{conn}, @var{holes}) +## @deftypefnx {Function File} {[@var{boundaries}, @var{labels}] = } bwboundaries(@dots{}) +## @deftypefnx {Function File} {[@var{boundaries}, @var{labels}, @var{num_labels}] = } bwboundaries(@dots{}) +## Trace the boundaries of the objects in a binary image. +## +## @var{boundaries} is a cell array in which each element is the boundary of an +## object in the binary image @var{BW}. The clockwise boundary of each object is +## computed by the @code{boundary} function. +## +## By default the boundaries are computed using 8-connectivity. This can be +## changed to 4-connectivity by setting @var{conn} to 4. +## +## By default @code{bwboundaries} computes all boundaries in the image, i.e. +## both interior and exterior object boundaries. This behaviour can be changed +## through the @var{holes} input argument. If this is @t{'holes'}, +## both boundary types are considered. If it is instead @t{'noholes'}, only exterior +## boundaries will be traced. +## +## If two or more output arguments are requested, the algorithm also returns +## the labelled image computed by @code{bwlabel} in @var{labels}. The number +## of labels in this image is optionally returned in @var{num_labels}. +## @seealso{boundary, bwlabel} +## @end deftypefn + +function [bound, labels, num_labels] = bwboundaries (bw, conn=8, holes="holes") + # check arguments + if (nargin < 1) + error ("bwboundaries: not enough input arguments"); + endif + if (!ismatrix (bw) || ndims (bw) != 2) + error ("bwboundaries: first input argument must be a NxM matrix"); + endif + if (!isscalar (conn) || (conn != 4 && conn != 8)) + error ("bwboundaries: second input argument must be 4 or 8"); + endif + if (!ischar (holes) || !any (strcmpi (holes, {'holes', 'noholes'}))) + error ("bwboundaries: third input must be either \'holes\' or \'noholes\'"); + endif + + bw = logical (bw); + + # process each connected region separately + [labels, num_labels] = bwlabel (bw, conn); + bound = cell (num_labels, 1); + for k = 1:num_labels + bound {k} = __boundary__ ((labels == k), conn); + endfor + + # compute internal boundaries as well? + if (strcmpi (holes, "holes")) + filled = bwfill (bw, "holes", conn); + holes = (filled & !bw); + [intBounds, intLabels, numIntLabels] = bwboundaries (holes, conn, "noholes"); + + bound (end+1 : end+numIntLabels, 1) = intBounds; + intLabels (intLabels != 0) += num_labels; + labels += intLabels; + endif +endfunction + +%!demo +%! ## Generate a simple image +%! bw = false (100); +%! bw (10:30, 40:80) = true; +%! bw (40:45, 40:80) = true; +%! +%! ## Find boundaries +%! bounds = bwboundaries (bw); +%! +%! ## Plot result +%! imshow (bw); +%! hold on +%! for k = 1:numel (bounds) +%! plot (bounds {k} (:, 2), bounds {k} (:, 1), 'r', 'linewidth', 2); +%! endfor +%! hold off diff --git a/octave_packages/image-1.0.15/bwconncomp.m b/octave_packages/image-1.0.15/bwconncomp.m new file mode 100644 index 0000000..72ed94d --- /dev/null +++ b/octave_packages/image-1.0.15/bwconncomp.m @@ -0,0 +1,67 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{cc} = } bwconncomp (@var{BW}) +## @deftypefnx {Function File} {@var{cc} = } bwconncomp (@var{BW}, @var{connectivity}) +## Trace the boundaries of objects in a binary image. +## +## @code{bwconncomp} traces the boundaries of objects in a binary image @var{BW} +## and returns information about them in a structure with the following fields. +## +## @table @t +## @item Connectivity +## The connectivity used in the boundary tracing. +## @item ImageSize +## The size of the image @var{BW}. +## @item NumObjects +## The number of objects in the image @var{BW}. +## @item PixelIdxList +## A cell array containing where each element corresponds to an object in @var{BW}. +## Each element is represented as a vector of linear indices of the boundary of +## the given object. +## @end table +## +## The connectivity used in the tracing is by default 4, but can be changed +## by setting the @var{connectivity} input parameter to 8. Sadly, this is not +## yet implemented. +## @seealso{bwlabel, bwboundaries, ind2sub} +## @end deftypefn + +function CC = bwconncomp (bw, N = 4) + ## Check input + if (nargin < 1) + error ("bwconncomp: not enough input arguments"); + endif + if (!ismatrix (bw) || ndims (bw) != 2) + error ("bwconncomp: first input argument must be a NxM matrix"); + endif + if (!isscalar (N) || !any (N == [4])) #, 8])) + error ("bwconncomp: second input argument must be 4"); + endif + + ## Trace boundaries + B = bwboundaries (bw, N); + + ## Convert from (x, y) index to linear indexing + P = cell (numel (B), 1); + for k = 1:numel (B) + P {k} = sub2ind (size (bw), B {k} (:, 2), B {k} (:, 1)); + endfor + + ## Return result + CC = struct ("Connectivity", N, "ImageSize", size (bw), "NumObjects", numel (B)); + CC.PixelIdxList = P; +endfunction diff --git a/octave_packages/image-1.0.15/bwdist.m b/octave_packages/image-1.0.15/bwdist.m new file mode 100644 index 0000000..8b264f9 --- /dev/null +++ b/octave_packages/image-1.0.15/bwdist.m @@ -0,0 +1,61 @@ +## Copyright (C) 2006 Stefan Gustavson +## +## 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, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{D} =} bwdist(@var{bw}) +## +## Computes the distance transform of the image @var{bw}. +## @var{bw} should be a binary 2D array, either a Boolean array or a +## numeric array containing only the values 0 and 1. +## The return value @var{D} is a double matrix of the same size as @var{bw}. +## Elements with value 0 are considered background pixels, elements +## with value 1 are considered object pixels. The return value +## for each background pixel is the distance (according to the chosen +## metric) to the closest object pixel. For each object pixel the +## return value is 0. +## +## @deftypefnx{Function File} {@var{D} =} bwdist(@var{bw}, @var{method}) +## +## @var{method} is a string to choose the distance metric. Currently +## available metrics are 'euclidean', 'chessboard', 'cityblock' and +## 'quasi-euclidean', which may each be abbreviated to any string +## starting with 'e', 'ch', 'ci' and 'q', respectively. +## If @var{method} is not specified, 'euclidean' is the default. +## +## @deftypefnx {Function File} {[@var{D},@var{C}] =} bwdist(@var{bw}, @var{method}) +## +## If a second output argument is given, the linear index for the +## closest object pixel is returned for each pixel. (For object +## pixels, the index points to the pixel itself.) The return value +## @var{C} is a matrix the same size as @var{bw}. +## @end deftypefn + +# This M wrapper is an almost direct pass-through to an oct function, +# but it might prove useful for a future extension to handle N-D data. +# The algorithm implemented by __bwdist() is 2D-only. + +function [D, C] = bwdist(bw, method = "euclidean") + + if (!ischar(method)) + error("bwdist: method name must be a string"); + endif + + if (nargout < 2) + D = __bwdist(bw, method); + else + [D, C] = __bwdist(bw, method); + endif + +endfunction diff --git a/octave_packages/image-1.0.15/bweuler.m b/octave_packages/image-1.0.15/bweuler.m new file mode 100644 index 0000000..b488aa3 --- /dev/null +++ b/octave_packages/image-1.0.15/bweuler.m @@ -0,0 +1,107 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{eul} = } bweuler (@var{BW},@var{n}) +## Calculates the Euler number of a binary image. +## +## @var{eul}=bweuler(@var{BW}, @var{n}) calculates the Euler number @var{eul} of a binary +## image @var{BW}, which is a scalar whose value is the total number of +## objects in an image minus the number of holes. +## +## @var{n} can have the values: +## @table @code +## @item 4 +## bweuler will use 4-connected neighbourhood definition. +## @item 8 +## bweuler will use 8-connected neighbourhood definition. This is the +## default value. +## @end table +## +## This function uses Bit Quads as described in "Digital Image +## Processing" to calculate euler number. +## +## References: +## W. K. Pratt, "Digital Image Processing", 3rd Edition, pp 593-595 +## +## @seealso{qtgetblk} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function eul = bweuler(BW, n) + if(nargin<1 || nargin>2) + usage("eul=bweuler(BW,n)"); + endif + if(nargin<2) + n=8; + endif + + ## q1lut=makelut(inline("sum(x(:))==1","x"),2); + ## q3lut=makelut(inline("sum(x(:))==3","x"),2); + ## qdlut=makelut(inline("all((x==eye(2))(:))||all((x==fliplr(eye(2)))(:))","x"),2); + ## lut_4=(q1lut-q3lut+2*qdlut)/4; # everything in one lut will be quicker + ## lut_8=(q1lut-q3lut-2*qdlut)/4; + ## we precalculate this... + if(n==8) + lut=[0;.25;.25;0;.25;0;-.5;-.25;.25;-.5;0;-.25;0;-.25;-.25;0]; + elseif(n==4) + lut=[0;.25;.25;0;.25;0;.5;-.25;.25;.5;0;-.25;0;-.25;-.25;0]; + else + error("bweuler: n can only be 4 or 8."); + endif + + eul=sum(applylut(BW,lut)(:)); +endfunction + +%!demo +%! A=zeros(9,10); +%! A([2,5,8],2:9)=1; +%! A(2:8,[2,9])=1 +%! bweuler(A) +%! # Euler number (objects minus holes) is 1-2=-1 in an 8-like object + +%!test +%! A=zeros(10,10); +%! A(2:9,3:8)=1; +%! A(4,4)=0; +%! A(8,8)=0; # not a hole +%! A(6,6)=0; +%! assert(bweuler(A),-1); + +%!# This will test if n=4 and n=8 behave differently +%!test +%! A=zeros(10,10); +%! A(2:4,2:4)=1; +%! A(5:8,5:8)=1; +%! assert(bweuler(A,4),2); +%! assert(bweuler(A,8),1); +%! assert(bweuler(A),1); + +% $Log$ +% Revision 1.3 2007/03/23 16:14:36 adb014 +% Update the FSF address +% +% Revision 1.2 2007/01/04 23:41:47 hauberg +% Minor changes in help text +% +% Revision 1.1 2006/08/20 12:59:31 hauberg +% Changed the structure to match the package system +% +% Revision 1.2 2005/07/03 01:10:19 pkienzle +% Try to correct for missing newline at the end of the file +% +% Revision 1.1 2004/08/15 19:33:20 jmones +% bweuler: Calculates the Euler number of a binary image diff --git a/octave_packages/image-1.0.15/bwhitmiss.m b/octave_packages/image-1.0.15/bwhitmiss.m new file mode 100644 index 0000000..ef4eef0 --- /dev/null +++ b/octave_packages/image-1.0.15/bwhitmiss.m @@ -0,0 +1,64 @@ +## Copyright (C) 2008 Soren Hauberg +## +## 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. + +## -*- texinfo -*- +## @deftypefn {Function File} @var{bw2} = bwhitmiss (@var{bw1}, @var{se1}, @var{se1}) +## @deftypefnx{Function File} @var{bw2} = bwhitmiss (@var{bw1}, @var{interval}) +## Perform the binary hit-miss operation. +## +## If two structuring elements @var{se1} and @var{se1} are given, the hit-miss +## operation is defined as +## @example +## bw2 = erode(bw1, se1) & erode(!bw1, se2); +## @end example +## If instead an 'interval' array is given, two structuring elements are computed +## as +## @example +## se1 = (interval == 1) +## se2 = (interval == -1) +## @end example +## and then the operation is defined as previously. +## @seealso{bwmorph} +## @end deftypefn + +function bw = bwhitmiss(im, varargin) + ## Checkinput + if (nargin != 2 && nargin != 3) + print_usage(); + endif + if (!ismatrix(im) || !isreal(im)) + error("bwhitmiss: first input argument must be a real matrix"); + endif + + ## Get structuring elements + if (nargin == 2) # bwhitmiss (im, interval) + interval = varargin{1}; + if (!isreal(interval)) + error("bwhitmiss: second input argument must be a real matrix"); + endif + if (!all( (interval(:) == 1) | (interval(:) == 0) | (interval(:) == -1) )) + error("bwhitmiss: second input argument can only contain the values -1, 0, and 1"); + endif + se1 = (interval == 1); + se2 = (interval == -1); + else # bwhitmiss (im, se1, se2) + se1 = varargin{1}; + se2 = varargin{2}; + if (!all((se1(:) == 1) | (se1(:) == 0)) || !all((se2(:) == 1) | (se2(:) == 0))) + error("bwhitmiss: structuring elements can only contain zeros and ones."); + endif + endif + + ## Perform filtering + bw = erode(im, se1) & erode(!im, se2); + +endfunction diff --git a/octave_packages/image-1.0.15/bwmorph.m b/octave_packages/image-1.0.15/bwmorph.m new file mode 100644 index 0000000..f7ef70c --- /dev/null +++ b/octave_packages/image-1.0.15/bwmorph.m @@ -0,0 +1,624 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{BW2} = } bwmorph (@var{BW},@var{operation}) +## @deftypefnx {Function File} {@var{BW2} = } bwmorph (@var{BW},@var{operation},@var{n}) +## Perform a morphological operation on a binary image. +## +## BW2=bwmorph(BW,operation) performs a morphological operation +## specified by @var{operation} on binary image @var{BW}. All possible +## operations and their meaning are specified in a table below. +## +## BW2=bwmorph(BW,operation,n) performs a morphological operation +## @var{n} times. Keep in mind that it has no sense to apply some +## operations more than once, since some of them return the same result +## regardless how many iterations we request. Those return a warning if +## are called with n>1 and they compute the result for n=1. +## +## @var{n}>1 is actually used for the following operations: diag, +## dilate, erode, majority, shrink, skel, spur, thicken and thin. +## +## @table @code +## @item 'bothat' +## Performs a bottom hat operation, a closing operation (which is a +## dilation followed by an erosion) and finally substracts the original +## image. +## +## @item 'bridge' +## Performs a bridge operation. Sets a pixel to 1 if it has two nonzero +## neighbours which are not connected, so it "bridges" them. There are +## 119 3-by-3 patterns which trigger setting a pixel to 1. +## +## @item 'clean' +## Performs an isolated pixel remove operation. Sets a pixel to 0 if all +## of its eight-connected neighbours are 0. +## +## @item 'close' +## Performs closing operation, which is a dilation followed by erosion. +## It uses a ones(3) matrix as structuring element for both operations. +## +## @item 'diag' +## Performs a diagonal fill operation. Sets a pixel to 1 if that +## eliminates eight-connectivity of the background. +## +## @item 'dilate' +## Performs a dilation operation. It uses ones(3) as structuring element. +## +## @item 'erode' +## Performs an erosion operation. It uses ones(3) as structuring element. +## +## @item 'fill' +## Performs a interior fill operation. Sets a pixel to 1 if all +## four-connected pixels are 1. +## +## @item 'hbreak' +## Performs a H-break operation. Breaks (sets to 0) pixels that are +## H-connected. +## +## @item 'majority' +## Performs a majority black operation. Sets a pixel to 1 if five +## or more pixels in a 3-by-3 window are 1. If not it is set to 0. +## +## @item 'open' +## Performs an opening operation, which is an erosion followed by a +## dilation. It uses ones(3) as structuring element. +## +## @item 'remove' +## Performs a iterior pixel remove operation. Sets a pixel to 0 if +## all of its four-connected neighbours are 1. +## +## @item 'shrink' +## Performs a shrink operation. Sets pixels to 0 such that an object +## without holes erodes to a single pixel (set to 1) at or near its +## center of mass. An object with holes erodes to a connected ring lying +## midway between each hole and its nearest outer boundary. It preserves +## Euler number. +## +## @item 'skel' +## Performs a skeletonization operation. It calculates a "median axis +## skeleton" so that points of this skeleton are at the same distance of +## its nearby borders. It preserver Euler number. Please read +## compatibility notes for more info. +## +## It uses the same algorithm as skel-pratt but this could change for +## compatibility in the future. +## +## @item 'skel-lantuejol' +## Performs a skeletonization operation as described in Gonzalez & Woods +## "Digital Image Processing" pp 538-540. The text references Lantuejoul +## as authour of this algorithm. +## +## It has the beauty of being a clean and simple approach, but skeletons +## are thicker than they need to and, in addition, not guaranteed to be +## connected. +## +## This algorithm is iterative. It will be applied the minimum value of +## @var{n} times or number of iterations specified in algorithm +## description. It's most useful to run this algorithm with @code{n=Inf}. +## +## @item 'skel-pratt' +## Performs a skeletonization operation as described by William K. Pratt +## in "Digital Image Processing". +## +## @item 'spur' +## Performs a remove spur operation. It sets pixel to 0 if it has only +## one eight-connected pixel in its neighbourhood. +## +## @item 'thicken' +## Performs a thickening operation. This operation "thickens" objects +## avoiding their fusion. Its implemented as a thinning of the +## background. That is, thinning on negated image. Finally a diagonal +## fill operation is performed to avoid "eight-connecting" objects. +## +## @item 'thin' +## Performs a thinning operation. When n=Inf, thinning sets pixels to 0 +## such that an object without holes is converted to a stroke +## equidistant from its nearest outer boundaries. If the object has +## holes it creates a ring midway between each hole and its near outer +## boundary. This differ from shrink in that shrink converts objects +## without holes to a single pixels and thin to a stroke. It preserves +## Euler number. +## +## @item 'tophat' +## Performs a top hat operation, a opening operation (which is an +## erosion followed by a dilation) and finally substracts the original +## image. +## @end table +## +## Some useful concepts to understant operators: +## +## Operations are defined on 3-by-3 blocks of data, where the pixel in +## the center of the block. Those pixels are numerated as follows: +## +## @multitable @columnfractions 0.05 0.05 0.05 +## @item X3 @tab X2 @tab X1 +## @item X4 @tab X @tab X0 +## @item X5 @tab X6 @tab X7 +## @end multitable +## +## @strong{Neighbourhood definitions used in operation descriptions:} +## @table @code +## @item 'four-connected' +## It refers to pixels which are connected horizontally or vertically to +## X: X1, X3, X5 and X7. +## @item 'eight-connected' +## It refers to all pixels which are connected to X: X0, X1, X2, X3, X4, +## X5, X6 and X7. +## @end table +## +## @strong{Compatibility notes:} +## @table @code +## @item 'fill' +## Checking MATLAB behaviour is needed because its documentation doesn't +## make clear if it creates a black pixel if all eight-connected pixels +## are black or if four-connected suffice (as we do currently following +## Pratt's book). +## @item 'skel' +## Algorithm used here is described in Pratt's book. When applying it to +## the "circles" image in MATLAB documentation, results are not the +## same. Perhaps MATLAB uses Blum's algoritm (for further info please +## read comments in code). +## @item 'skel-pratt' +## This option is not available in MATLAB. +## @item 'skel-lantuejoul' +## This option is not available in MATLAB. +## @item 'thicken' +## This implementation also thickens image borders. This can easily be +## avoided i necessary. MATLAB documentation doesn't state how it behaves. +## @end table +## +## References: +## W. K. Pratt, "Digital Image Processing" +## Gonzalez and Woods, "Digital Image Processing" +## +## @seealso{dilate, erode, makelut, applylut} +## @end deftypefn + + +## TODO: As soon as Octave doesn't segfault when assigning values to a +## TODO: bool matrix, remove all conversions from lut to logical and +## TODO: just create it as a logical from the beginning. + +## TODO: n behaviour should be tested in all cases for compatibility. + +## Author: Josep Mones i Teixidor + +function BW2 = bwmorph(BW, operation, n) + if(nargin<2 || nargin>3) + usage("BW2=bwmorph(BW, operation [,n])"); + endif + if(nargin<3) + n=1; + endif + if(n<0) + error("bwmorph: n should be > 0"); + elseif(n==0) ## we'll just return the same matrix (check this!) + BW2=BW; + endif + + ## post processing command + postcmd=""; + + switch(operation) + case('bothat') + se=ones(3); + BW2=erode(dilate(BW, se), se)-BW; + if(n>1) + ## TODO: check if ignoring n>1 is ok. Should I just ignore it + ## TODO: without a warning? + disp("WARNING: n>1 has no sense here. Using n=1. Please fill a bug if you think this behaviour is not correct"); + endif + return; + + case('bridge') + ## see __bridge_lut_fun__ for rules + ## lut=makelut("__bridge_lut_fun__",3); + lut=logical([0;0;0;0;0;0;0;0;0;0;0;0;1;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;0;0;0;1;0;0;1;1;0;0;1;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;1;1;1;1;1;1;0;0;0;0;1;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;0;0;1;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;1;1;1;1;1;1;0;0;0;0;1;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;0;0;0;1;0;0;0;0;0;0;0;0;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;1;1;1;1;1;1;0;0;0;0;1;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;0;0;0;1;0;0;0;0;0;0;0;0;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;1;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;0;0;0;1;0;0;1;1;0;0;1;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;0;0;1;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;1;1;1;1;1;1;0;0;0;0;1;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;0;0;0;1;0;0;0;0;0;0;0;0;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;1;1;1;1;1;1;0;0;0;0;1;1;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;0;0;0;1;0;0;0;0;0;0;0;0;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1]); + BW2=applylut(BW, lut); + if(n>1) + ## TODO: check if ignoring n>1 is ok. + disp("WARNING: n>1 has no sense here. Using n=1. Please fill a bug if you think this behaviour is not correct"); + endif + return; + + case('clean') + ## BW(j,k)=X&&(X0||X1||...||X7) + ## lut=makelut(inline("x(2,2)&&any((x.*[1,1,1;1,0,1;1,1,1])(:))","x"),3); + ## which is the same as... + lut=repmat([zeros(16,1);ones(16,1)],16,1); ## identity + lut(17)=0; ## isolated to 0 + ## I'd prefer to create lut directly as a logical, but assigning a + ## value to a logical segfaults 2.1.57. We'll change it as soon as + ## it works. + BW2=applylut(BW, logical(lut)); + if(n>1) + ## TODO: check if ignoring n>1 is ok. + disp("WARNING: n>1 has no sense here. Using n=1. Please fill a bug if you think this behaviour is not correct"); + endif + return; + + case('close') + se=ones(3); + BW2=erode(dilate(BW, se), se); + if(n>1) + ## TODO: check if ignoring n>1 is ok. + disp("WARNING: n>1 has no sense here. Using n=1. Please fill a bug if you think this behaviour is not correct"); + endif + return; + + case('diag') + ## see __diagonal_fill_lut_fun__ for rules + ## lut=makelut("__diagonal_fill_lut_fun__",3); + lut=logical([0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;1;1;0;0;0;0;0;0;1;1;0;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;1;1;0;0;0;0;0;0;1;1;0;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;0;0;0;0;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;1;1;0;0;0;0;0;0;1;1;0;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;1;1;0;0;0;0;0;0;1;1;0;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;0;0;0;0;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;1;1;0;0;0;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;1;1;0;0;0;0;0;0;1;1;0;0;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1]); + cmd="BW2=applylut(BW, lut);"; + + + case('dilate') + cmd="BW2=dilate(BW, ones(3));"; + + case('erode') + cmd="BW2=erode(BW, ones(3));"; + + case('fill') + ## lut=makelut(inline("x(2,2)||(sum((x&[0,1,0;1,0,1;0,1,0])(:))==4)","x"),3); + ## which is the same as... + lut=repmat([zeros(16,1);ones(16,1)],16,1); ## identity + ## 16 exceptions + lut([171,172,175,176,235,236,239,240,427,428,431,432,491,492,495,496])=1; + BW2=applylut(BW, logical(lut)); + if(n>1) + ## TODO: check if ignoring n>1 is ok. + disp("WARNING: n>1 has no sense here. Using n=1. Please fill a bug if you think this behaviour is not correct"); + endif + return; + + + case('hbreak') + ## lut=makelut(inline("x(2,2)&&!(all(x==[1,1,1;0,1,0;1,1,1])||all(x==[1,0,1;1,1,1;1,0,1]))","x"),3); + ## which is the same as + lut=repmat([zeros(16,1);ones(16,1)],16,1); ## identity + lut([382,472])=0; ## the 2 exceptions + BW2=applylut(BW, logical(lut)); + if(n>1) + ## TODO: check if ignoring n>1 is ok. + disp("WARNING: n>1 has no sense here. Using n=1. Please fill a bug if you think this behaviour is not correct"); + endif + return; + + case('majority') + ## lut=makelut(inline("sum((x&ones(3,3))(:))>=5"),3); + lut=logical([0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1; + 0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;0;0;0;1;0;1;1;1;0;1;1;1;1;1;1;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1; + 0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;0;0;0;1;0;1;1;1;0;1;1;1;1;1;1;1; + 0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;0;0;0;1;0;1;1;1;0;1;1;1;1;1;1;1; + 0;0;0;1;0;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1; + 0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;0;0;0;1;0;1;1;1;0;1;1;1;1;1;1;1; + 0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;0;0;0;1;0;1;1;1;0;1;1;1;1;1;1;1; + 0;0;0;1;0;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;0;0;0;1;0;1;1;1;0;1;1;1;1;1;1;1; + 0;0;0;1;0;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;0;0;1;0;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1]); + cmd="BW2=applylut(BW, lut);"; + + case('open') + se=ones(3); + BW2=dilate(erode(BW, se), se); + if(n>1) + ## TODO: check if ignoring n>1 is ok. + disp("WARNING: n>1 has no sense here. Using n=1. Please fill a bug if you think this behaviour is not correct"); + endif + return; + + case('remove') + ## lut=makelut(inline("x(2,2)&&!(sum((x&[0,1,0;1,1,1;0,1,0])(:))==5)","x"),3); + lut=repmat([zeros(16,1);ones(16,1)],16,1); ## identity + ## 16 qualifying patterns + lut([187,188,191,192,251,252,255,256,443,444,447,448,507,508,511,512])=0; + BW2=applylut(BW, logical(lut)); + if(n>1) + ## TODO: check if ignoring n>1 is ok. + disp("WARNING: n>1 has no sense here. Using n=1. Please fill a bug if you think this behaviour is not correct"); + endif + return; + + case('shrink') + ## lut1=makelut("__conditional_mark_patterns_lut_fun__",3,"S"); + lut1=logical([0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;1;1;1;0;1;1;1;1;0;1;0;0;1;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;1;1;0;1;1;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;1;0;1;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;1;0;1;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;1;1;1;0;1;1;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;1;0;1;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;1;0;0;1;1;0;0]); + ## lut2=makelut(inline("!m(2,2)||__unconditional_mark_patterns_lut_fun__(m,'S')","m"),3); + lut2=logical([1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;1;0;1;0;0;0;1;0;0;0;0;0;1;0; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;1;0;0;0;0;0;0;1;1;0;0;1;0; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;0;0;1;1;1;0;0;0;0;1;1;0;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;0;1;0;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;0;0;1;0;1;0;0;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;1;1;0;0;1;1;0;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;0;1;1;0;1;0;0;1;0;1;1;0;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;0;1;0;1;1;1;0;1;0;1;0;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;1;0;1;0;1;0;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;0;0;1;0;1;0;0;1;0;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;0;0;0;1;0;1;0;0;1;0;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1]); + cmd="BW2=BW&applylut(applylut(BW, lut1), lut2);"; + + case({'skel','skel-pratt'}) + ## WARNING: Result doesn't look as MATLAB's sample. It has been + ## WARNING: coded following Pratt's guidelines for what he calls + ## WARNING: is a "reasonably close approximation". I couldn't find + ## WARNING: any bug. + ## WARNING: Perhaps MATLAB uses Blum's algorithm (which Pratt + ## WARNING: refers to) in: H. Blum, "A Transformation for + ## WARNING: Extracting New Descriptors of Shape", Symposium Models + ## WARNING: for Perception of Speech and Visual Form, W. + ## WARNING: Whaten-Dunn, Ed. MIT Press, Cambridge, MA, 1967. + + ## lut1=makelut("__conditional_mark_patterns_lut_fun__",3,"K"); + lut1=logical([0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;1;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;1;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;1;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;1;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;1;1;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;1;0;1;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;1;0;1;1;1;1;0]); + + ## lut2=makelut(inline("!m(2,2)||__unconditional_mark_patterns_lut_fun__(m,'K')","m"),3); + lut2=logical([1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;0;1;0;0;0;1;0;1;1;0;0;0;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;0;0;0;1;1;0;0;1;1;0;0;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;0;1;0;1;0;0;0;1;0;1;0;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;0;1;1;1;0;1;1;1;0;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;0;1;0;1;1;0;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;1;1;1;1;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;0;0;1;0;1;1;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;0;1;1;1;1;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;0;1;0;1;0;0;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;0;0;1;1;1;0;0;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;0;0;1;0;1;0;0;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1]); + cmd="BW2=BW&applylut(applylut(BW, lut1), lut2);"; + postcmd="BW2=bwmorph(BW2,'bridge');"; + + case('skel-lantuejoul') + ## init values + se=ones(3,3); ## structuring element used everywhere + BW2=zeros(size(BW)); ## skeleton result + eBW=BW; ## eBW will hold k-times eroded BW + i=1; + while i<=n + if(!any(eBW)) ## if erosion result is 0-matrix then + break; ## we are over + endif + BW2|=eBW-dilate(erode(eBW, se), se); ## eBW - opening operation on eBW + ## contributes to skeleton + eBW=erode(eBW,se); + i++; + endwhile + return; ## no general loop in this case + + case('spur') + ## lut=makelut(inline("xor(x(2,2),(sum((x&[0,1,0;1,0,1;0,1,0])(:))==0)&&(sum((x&[1,0,1;0,0,0;1,0,1])(:))==1)&&x(2,2))","x"),3); + ## which is the same as + lut=repmat([zeros(16,1);ones(16,1)],16,1); ## identity + lut([18,21,81,273])=0; ## 4 qualifying patterns + lut=logical(lut); + cmd="BW2=applylut(BW, lut);"; + + case('thicken') + ## This implementation also "thickens" the border. To avoid this, + ## a simple solution could be to add a border of 1 to the reversed + ## image. + BW2=bwmorph(!BW,'thin',n); + BW2=bwmorph(BW2,'diag'); + return; + + case('thin') + ## lut1=makelut("__conditional_mark_patterns_lut_fun__",3,"T"); + lut1=logical([0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;1;1;0;0;1;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;1;0;0;1;1;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;1;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;1;0;1;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;1;1;0;1;1;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;0;0;0;0;0;0;0;0; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;0;0;0;0;1;1;0;1;0;0;0;1; + 0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;1;0;0;0;1;0;1;1;1;1;0;0;1;1;0;0]); + ## lut2=makelut(inline("!m(2,2)||__unconditional_mark_patterns_lut_fun__(m,'T')","m"),3); + lut2=logical([1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;1;1;1;0;1;0;1;1;0;0;0;0;1;0; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;1;1;0;0;0;0;0;1;1;0;0;1;0; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;0;0;1;1;1;1;0;0;0;1;1;0;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;0;1;0;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;0;0;1;0;1;0;0;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;1;1;0;0;1;1;0;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;1;1;0;1;0;0;1;0;1;1;0;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;0;1;0;1;1;1;0;1;0;1;0;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;1;0;1;0;1;0;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;1;0;1;0;0;1;0;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;0;0;1;0;1;0;0;1;0;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1;0;1;1;1;1;1;1;1; + 1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1;1]); + cmd="BW2=BW&applylut(applylut(BW, lut1), lut2);"; + + + case('tophat') + se=ones(3); + BW2=BW-dilate(erode(BW, se), se); + if(n>1) + ## TODO: check if ignoring n>1 is ok. + disp("WARNING: n>1 has no sense here. Using n=1. Please fill a bug if you think this behaviour is not correct"); + endif + return; + + + otherwise + error("bwmorph: unknown operation type requested."); + endswitch + + ## we use this assignment because of the swap operation inside the + ## while. + BW2=BW; + + ## if it doesn't change we don't need to process it further + i=1; + while(i<=n) ## for wouldn't work because n can be Inf + [BW,BW2]=swap(BW,BW2); + eval(cmd); + if(all((BW2==BW)(:))) + break + endif + i+=1; + endwhile + + ## process post processing commands if needed + if (isempty (postcmd)) + eval(postcmd); + endif + +endfunction + +function [b, a] = swap (a, b) +endfunction + +%!demo +%! bwmorph(ones(11),'shrink', Inf) +%! # Should return 0 matrix with 1 pixel set to 1 at (6,6) + +## TODO: code tests + + +## Test skel-lantuejoul using Gozalez&Woods example (fig 8.39) +%!shared slBW, rslBW +%! uint8(0); # fail for 2.1.57 or less instead of crashing later +%! slBW=logical(zeros(12,7)); +%! slBW(2,2)=true; +%! slBW(3:4,3:4)=true; +%! rslBW=slBW; +%! slBW(5:6,3:5)=true; +%! slBW(7:11,2:6)=true; +%! rslBW([6,7,9],4)=true; + +%!assert(bwmorph(slBW,'skel-lantuejoul',1),[rslBW(1:5,:);logical(zeros(7,7))]); +%!assert(bwmorph(slBW,'skel-lantuejoul',2),[rslBW(1:8,:);logical(zeros(4,7))]); +%!assert(bwmorph(slBW,'skel-lantuejoul',3),rslBW); +%!assert(bwmorph(slBW,'skel-lantuejoul',Inf),rslBW); + + +% +% $Log$ +% Revision 1.4 2007/03/23 16:14:36 adb014 +% Update the FSF address +% +% Revision 1.3 2007/01/04 23:41:47 hauberg +% Minor changes in help text +% +% Revision 1.2 2006/10/15 08:04:55 hauberg +% Fixed texinfo in bwmorph +% +% Revision 1.1 2006/08/20 12:59:32 hauberg +% Changed the structure to match the package system +% +% Revision 1.6 2004/09/16 02:14:40 pkienzle +% Use frivolous uint8() call to block tests for version 2.1.57 and earlier +% +% Revision 1.5 2004/09/15 20:36:57 jmones +% logical(1) => true +% +% Revision 1.4 2004/09/15 20:00:00 jmones +% Updated tests to match Gonzalez&Woods example +% +% Revision 1.3 2004/09/15 13:51:10 pkienzle +% Use logical in tests; reduce number of shared variables in tests. +% +% Revision 1.2 2004/09/01 22:35:47 jmones +% Added Lantuejoul skeletonizing algorithm from Gonzalez&Woods +% +% Revision 1.1 2004/08/15 19:47:04 jmones +% bwmorph added: Perform a morphological operation on a binary image +% +% diff --git a/octave_packages/image-1.0.15/bwperim.m b/octave_packages/image-1.0.15/bwperim.m new file mode 100644 index 0000000..7a6058a --- /dev/null +++ b/octave_packages/image-1.0.15/bwperim.m @@ -0,0 +1,70 @@ +## Copyright (C) 2006 Søren Hauberg +## +## 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, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{BW2} = bwperim(@var{BW1}) +## @deftypefnx{Function File} @var{BW2} = bwperim(@var{BW1}, @var{n}) +## Find the perimeter of objects in binary images. +## +## A pixel is part of an object perimeter if its value is one and there +## is at least one zero-valued pixel in its neighborhood. +## +## By default the neighborhood of a pixel is 4 nearest pixels, but +## if @var{n} is set to 8 the 8 nearest pixels will be considered. +## @end deftypefn + +function out = bwperim(bw, n=4) + ## Input checking + if (nargin < 1) + print_usage(); + endif + if (!isbw(bw) || ndims(bw)!=2) + error("bwperim: first input argument must be a 2-dimensional binary image"); + endif + if (!isscalar(n) || (n!=4 && n!=8)) + error("bwperim: second argument must be 4 or 8"); + endif + + ## Make sure bw is logical; + bw = logical (bw); + + ## Translate image by one pixel in all directions + [rows, cols] = size(bw); + north = [bw(2:end, :); zeros(1, cols, "logical")]; + south = [zeros(1, cols, "logical"); bw(1:end-1, :)]; + west = [bw(:, 2:end), zeros(rows, 1, "logical")]; + east = [zeros(rows, 1, "logical"), bw(:, 1:end-1)]; + if (n == 8) + north_east = north_west = south_east = south_west = zeros (rows, cols, "logical"); + north_east (1:end-1, 2:end) = bw (2:end, 1:end-1); + north_west (1:end-1, 1:end-1) = bw (2:end, 2:end); + south_east (2:end, 2:end) = bw (1:end-1, 1:end-1); + south_west (2:end, 1:end-1) = bw (1:end-1, 2:end); + endif + + ## Do the comparing + if (n == 4) + out = bw; + idx = (north == bw) & (south == bw) & (west == bw) & (east == bw); + out(idx) = false; + else # n == 8 + out = bw; + idx = (north == bw) & (north_east == bw) & ... + (east == bw) & (south_east == bw) & ... + (south == bw) & (south_west == bw) & ... + (west == bw) & (north_west == bw); + out (idx) = false; + endif +endfunction diff --git a/octave_packages/image-1.0.15/bwselect.m b/octave_packages/image-1.0.15/bwselect.m new file mode 100644 index 0000000..066ecc4 --- /dev/null +++ b/octave_packages/image-1.0.15/bwselect.m @@ -0,0 +1,55 @@ +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{imout}, @var{idx}] =} bwselect(@var{im}, @var{cols}, @var{rows}, @var{connect}) +## Select connected regions in a binary image. +## +## @table @code +## @item @var{im} +## binary input image +## @item [@var{cols}, @var{rows}] +## vectors of starting points (x,y) +## @item @var{connect} +## connectedness 4 or 8. default is 8 +## @item @var{imout} +## the image of all objects in image im that overlap +## pixels in (cols,rows) +## @item @var{idx} +## index of pixels in imout +## @end table +## @end deftypefn + +# Copyright (C) 1999 Andy Adler +# This code has no warrany whatsoever. +# Do what you like with this code as long as you +# leave this copyright in place. +# +# $Id: bwselect.m 3011 2007-01-04 23:46:17Z hauberg $ +function [imout, idx] = bwselect( im, cols, rows, connect ) + +if nargin<4 + connect= 8; +end + +[jnk,idx]= bwfill( ~im, cols,rows, connect ); + +imout= zeros( size(jnk) ); +imout( idx ) = 1; + +# +# $Log$ +# Revision 1.3 2007/01/04 23:41:47 hauberg +# Minor changes in help text +# +# Revision 1.2 2007/01/02 21:58:38 hauberg +# Documentation is now in Texinfo (looks better on the website) +# +# Revision 1.1 2006/08/20 12:59:32 hauberg +# Changed the structure to match the package system +# +# Revision 1.1 2002/03/17 02:38:52 aadler +# fill and edge detection operators +# +# Revision 1.1 1999/06/08 17:06:01 aadler +# Initial revision +# +# + diff --git a/octave_packages/image-1.0.15/cmpermute.m b/octave_packages/image-1.0.15/cmpermute.m new file mode 100644 index 0000000..29404b9 --- /dev/null +++ b/octave_packages/image-1.0.15/cmpermute.m @@ -0,0 +1,132 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{Y}, @var{newmap}] = } cmpermute (@var{X},@var{map}) +## @deftypefnx {Function File} {[@var{Y}, @var{newmap}] = } cmpermute (@var{X},@var{map},@var{index}) +## Reorders colors in a colormap. +## +## @code{[Y,newmap]=cmpermute(X,map)} rearranges colormap @var{map} +## randomly returning colormap @var{newmap} and generates indexed image +## @var{Y} so that it mantains correspondence between indices and the +## colormap from original indexed image @var{X} (both image and colormap +## pairs produce the same result). +## +## @code{[Y,newmap]=cmpermute(X,map,index)} behaves as described above +## but instead of sorting colors randomly, it uses @var{index} to define +## the order of the colors in the new colormap. +## +## @strong{Note:} @code{index} shouldn't have repeated elements, this +## function won't explicitly check this, but it will fail if it has. +## +## @end deftypefn + + +## Author: Josep Mones i Teixidor + +function [Y, newmap] = cmpermute(X, map, index) + switch(nargin) + case(2) + index=randperm(rows(map)); + case(3) + if(!isvector(index) || length(index)!=rows(map)) + error("cmpermute: invalid parameter index."); + endif + otherwise + usage("[Y, newmap] = cmpermute(X, map [, index])"); + endswitch + + ## new colormap + newmap=map(index,:); + + ## build reverse index + rindex = zeros(size(index)); + rindex(index) = 1:length(index); + + ## readapt indices + if(isa(X,"uint8")) + rindex=uint8(rindex-1); + ## 0-based indices + Y=rindex(double(X)+1); + else + Y=rindex(X); + endif +endfunction + + +%!demo +%! [Y,newmap]=cmpermute([1:4],hot(4),4:-1:1) +%! # colormap will be arranged in reverse order (so will image) + +%!shared X,map +%! X=magic(16); +%! [X,map]=cmunique(X); + +%!test # random permutation, 0-based index +%! [Y,newmap]=cmpermute(X,map); +%! # test we didn't lose colors +%! assert(sort(map),sortrows(newmap)); +%! # test if images are equal +%! assert(map(double(X)+1),newmap(double(Y)+1)); + +%!test # reverse map, 0-based index +%! [Y,newmap]=cmpermute(X,map,rows(map):-1:1); +%! # we expect a reversed colormap +%! assert(newmap(rows(newmap):-1:1,:),map); +%! # we expect reversed indices in image +%! assert(X,max(Y(:))-Y); + +%!shared X,map +%! X=magic(20); +%! [X,map]=cmunique(X); + +%!test # random permutation, 1-based index +%! [Y,newmap]=cmpermute(X,map); +%! # test we didn't lose colors +%! assert(sort(map),sortrows(newmap)); +%! # test if images are equal +%! assert(map(X),newmap(Y)); + +%!test # reverse map, 1-based index +%! [Y,newmap]=cmpermute(X,map,rows(map):-1:1); +%! # we expect a reversed colormap +%! assert(newmap(rows(newmap):-1:1,:),map); +%! # we expect reversed indices in image +%! assert(X,max(Y(:))+1-Y); + +% +% $Log$ +% Revision 1.3 2007/03/23 16:14:36 adb014 +% Update the FSF address +% +% Revision 1.2 2007/01/04 23:44:22 hauberg +% Minor changes in help text +% +% Revision 1.1 2006/08/20 12:59:32 hauberg +% Changed the structure to match the package system +% +% Revision 1.4 2004/09/08 15:01:28 pkienzle +% Redo tests: reduce # of shared variables; force full range of uint8 +% +% Revision 1.3 2004/09/08 14:13:08 jmones +% Synchronized with cmunique. uint8 support added. Tests working for 2.1.58 +% +% Revision 1.2 2004/08/18 14:57:42 jmones +% speed improvement suggested by Paul Kienzle +% +% Revision 1.1 2004/08/17 19:18:42 jmones +% cmpermute added: Reorders colors in a colormap +% +% diff --git a/octave_packages/image-1.0.15/cmunique.m b/octave_packages/image-1.0.15/cmunique.m new file mode 100644 index 0000000..5b5caf4 --- /dev/null +++ b/octave_packages/image-1.0.15/cmunique.m @@ -0,0 +1,211 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{Y}, @var{newmap}] = } cmunique (@var{X},@var{map}) +## @deftypefnx {Function File} {[@var{Y}, @var{newmap}] = } cmunique (@var{RGB}) +## @deftypefnx {Function File} {[@var{Y}, @var{newmap}] = } cmunique (@var{I}) +## Finds colormap with unique colors and corresponding image. +## +## @code{[Y,newmap]=cmunique(X,map)} returns an indexed image @var{y} +## along with its associated colormap @var{newmap} equivalent (which +## produce the same image) to supplied @var{X} and its colormap +## @var{map}; but eliminating any repeated rows in colormap colors and +## adjusting indices in the image matrix as needed. +## +## @code{[Y,newmap]=cmunique(RGB)} returns an indexed image @var{y} +## along with its associated colormap @var{newmap} computed from a +## true-color image @var{RGB} (a m-by-n-by-3 array), where @var{newmap} +## is the smallest colormap possible (alhough it could be as long as +## number of pixels in image). +## +## @code{[Y,newmap]=cmunique(I)} returns an indexed image @var{y} +## along with its associated colormap @var{newmap} computed from a +## intensity image @var{I}, where @var{newmap} is the smallest +## colormap possible (alhough it could be as long as number of pixels +## in image). +## +## @strong{Notes:} +## +## @var{newmap} is always a @var{m}-by-3 matrix, even if input image is +## a intensity grey-scale image @var{I} (all three RGB planes are +## assigned the same value). +## +## @var{newmap} is always of class double. If we use a RGB or intensity +## image of class uint8 or uint16, the colors in the colormap will be of +## class double in the range [0,1] (they are divided by intmax("uint8") +## and intmax("uint16") respectively. +## +## @end deftypefn + + +## Author: Josep Mones i Teixidor + +function [Y, newmap] = cmunique(P1, P2) + if (nargin<1 || nargin>2) + usage("[Y, newmap] = cmunique(X, map), [Y, newmap] = cmunique(RGB), [Y, newmap] = cmunique(I)"); + endif + + + if(nargin==2) + ## (X, map) case + [newmap,i,j]=unique(P2,'rows'); ## calculate unique colormap + if(isa(P1,"double")) + Y=j(P1); ## find new indices + else + Y=j(double(P1)+1); ## find new indices + endif + else + switch(size(P1,3)) + case(1) + ## I case + [newmap,i,j]=unique(P1); ## calculate unique colormap + newmap=repmat(newmap,1,3); ## get a RGB colormap + Y=reshape(j,rows(P1),columns(P1)); ## Y is j reshaped + case(3) + ## RGB case + map=[P1(:,:,1)(:), P1(:,:,2)(:), P1(:,:,3)(:)]; ## build a map with all values + [newmap,i,j]=unique(map, 'rows'); ## calculate unique colormap + Y=reshape(j,rows(P1),columns(P1)); ## Y is j reshaped + otherwise + error("cmunique: first parameter is invalid."); + endswitch + + ## if image was uint8 or uint16 we have to convert newmap to [0,1] range + if(!isa(P1,"double")) + newmap=double(newmap)/double(intmax(class(P1))); + endif + endif + + if(rows(newmap)<=256) + ## convert Y to uint8 (0-based indices then) + Y=uint8(Y-1); + endif + + +endfunction + + +%!demo +%! [Y,newmap]=cmunique([1:4;5:8],[hot(4);hot(4)]) +%! # Both rows are equal since map maps colors to the same value +%! # cmunique will give the same indices to both + + +%!# This triggers invalid first parameter +%!error(cmunique(zeros(3,3,2))); + +%!# Check that output is uint8 in short colormaps +%!test +%! [Y,newmap]=cmunique([1:4;5:8], [hot(4);hot(4)]); +%! assert(Y,uint8([0:3;0:3])); +%! assert(newmap,hot(4)); + +%!# Check that output is double in bigger +%!test +%! [Y,newmap]=cmunique([1:300;301:600], [hot(300);hot(300)]); +%! assert(Y,[1:300;1:300]); +%! assert(newmap,hot(300)); + +%!# Check boundary case 256 +%!test +%! [Y,newmap]=cmunique([1:256;257:512], [hot(256);hot(256)]); +%! assert(Y,uint8([0:255;0:255])); +%! assert(newmap,hot(256)); + +%!# Check boundary case 257 +%!test +%! [Y,newmap]=cmunique([1:257;258:514], [hot(257);hot(257)]); +%! assert(Y,[1:257;1:257]); +%! assert(newmap,hot(257)); + +%!# Random RGB image +%!test +%! RGB=rand(10,10,3); +%! [Y,newmap]=cmunique(RGB); +%! assert(RGB(:,:,1),newmap(:,1)(Y+1)); +%! assert(RGB(:,:,2),newmap(:,2)(Y+1)); +%! assert(RGB(:,:,3),newmap(:,3)(Y+1)); + +%!# Random uint8 RGB image +%!test +%! RGB=uint8(rand(10,10,3)*255); +%! RGBd=double(RGB)/255; +%! [Y,newmap]=cmunique(RGB); +%! assert(RGBd(:,:,1),newmap(:,1)(Y+1)); +%! assert(RGBd(:,:,2),newmap(:,2)(Y+1)); +%! assert(RGBd(:,:,3),newmap(:,3)(Y+1)); + +%!# Random uint16 RGB image +%!test +%! RGB=uint16(rand(10,10,3)*65535); +%! RGBd=double(RGB)/65535; +%! [Y,newmap]=cmunique(RGB); +%! assert(RGBd(:,:,1),newmap(:,1)(Y+1)); +%! assert(RGBd(:,:,2),newmap(:,2)(Y+1)); +%! assert(RGBd(:,:,3),newmap(:,3)(Y+1)); + +%!# Random I image +%!test +%! I=rand(10,10); +%! [Y,newmap]=cmunique(I); +%! assert(I,newmap(:,1)(Y+1)); +%! assert(I,newmap(:,2)(Y+1)); +%! assert(I,newmap(:,3)(Y+1)); + +%!# Random uint8 I image +%!test +%! I=uint8(rand(10,10)*256); +%! Id=double(I)/255; +%! [Y,newmap]=cmunique(I); +%! assert(Id,newmap(:,1)(Y+1)); +%! assert(Id,newmap(:,2)(Y+1)); +%! assert(Id,newmap(:,3)(Y+1)); + +%!# Random uint16 I image +%!test +%! I=uint16(rand(10,10)*65535); +%! Id=double(I)/65535; +%! [Y,newmap]=cmunique(I); +%! assert(Id,newmap(:,1)(Y+1)); +%! assert(Id,newmap(:,2)(Y+1)); +%! assert(Id,newmap(:,3)(Y+1)); + +% +% $Log$ +% Revision 1.3 2007/03/23 16:14:36 adb014 +% Update the FSF address +% +% Revision 1.2 2007/01/04 23:44:22 hauberg +% Minor changes in help text +% +% Revision 1.1 2006/08/20 12:59:32 hauberg +% Changed the structure to match the package system +% +% Revision 1.4 2004/09/08 16:06:31 jmones +% Solved problem with uint8 indexing and reduced tests on types (suggested by P. Kienzle) +% +% Revision 1.3 2004/09/03 17:07:26 jmones +% Support for uint8 and uint16 types added. +% +% Revision 1.2 2004/08/17 15:48:03 jmones +% Clarified expected data for RGB images in doc +% +% Revision 1.1 2004/08/17 15:45:40 jmones +% cmunique: Finds colormap with unique colors and corresponding image +% +% + + diff --git a/octave_packages/image-1.0.15/col2im.m b/octave_packages/image-1.0.15/col2im.m new file mode 100644 index 0000000..6998fa3 --- /dev/null +++ b/octave_packages/image-1.0.15/col2im.m @@ -0,0 +1,180 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{A} = } col2im (@var{B}, [@var{m},@var{n}], [@var{mm},@var{nn}], @var{block_type}) +## @deftypefnx {Function File} {@var{A} = } col2im (@var{B}, [@var{m},@var{n}], [@var{mm},@var{nn}]) +## Rearranges matrix columns into blocks. +## +## @code{A=col2im(B,[m,n],[mm,nn],block_type)} rearranges columns of +## matrix @var{B} intro blocks in a way controlled by @var{block_type} +## param, which can take the following values: +## +## @table @code +## @item distinct +## It uses @var{m}-by-@var{n} distinct blocks (which are not +## overlapped), and are rearranged to form a @var{mm}-by-@var{nn} matrix +## @var{A}. @var{B}'s height must be @var{m}*@var{n} and @code{col2im} +## rearranges each column to a @var{m}-by-@var{n} block and uses them to +## fill the whole matrix in left-to-right and then up-to-down order. +## @item sliding +## Is uses @var{m}-by-@var{n} sliding blocks. It rearranges row vector +## @var{B} to a (@var{mm}-@var{m}+1)-by-(@var{nn}-@var{n}+1) matrix +## @var{A}. @var{B} must be a +## 1-by-(@var{mm}-@var{m}+1)*(@var{nn}-@var{n}+1). +## @end table +## +## @code{A=col2im(B,[m,n],[mm,nn])} takes @code{distinct} as a default +## value for @var{block_type}. +## +## @seealso{im2col} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function A = col2im(B, sblock, sb, block_type) + if(nargin<3 || nargin>4) + usage("A=col2im(B, [m,n], [mm,nn] [, block_type])"); + endif + + if(nargin!=4) + block_type='sliding'; + endif + + ## common checks + if(!ismatrix(B)) + error("col2im: B should be a matrix (or vector)."); + endif + if(!isvector(sblock) || length(sblock)!=2) + error("col2im: expected [m,n] as second parameter."); + endif + if(!isvector(sb) || length(sb)!=2) + error("col2im: expected [mm,nn] as third parameter."); + endif + + m=sblock(1); + n=sblock(2); + mm=sb(1); + nn=sb(2); + + switch(block_type) + case('distinct') + if(rows(B)!=m*n) + error("col2im: B height must be m*n for 'distinct' block_type."); + endif + if(rem(mm,m)!=0) + error("col2im: mm should be multiple of m"); + endif + if(rem(nn,n)!=0) + error("col2im: nn should be multiple of n"); + endif + mt=mm/m; + nt=nn/n; + if(columns(B) 2.1.58 in order to deuglify this! + r=reshape(B(:,c),m,n); + c+=1; + for j=2:nt + r=horzcat(r, reshape(B(:,c),m,n)); + c+=1; + endfor + if(i==1) ## this workarrounds a bug in ver<=2.1.57 cat implementation + A=r; + else + A=vertcat(A,r); + endif + endfor + + case('sliding') + if(!all(size(B)==[1,(mm-m+1)*(nn-n+1)])) + error("col2im: wrong B size. Should be 1-by-(mm-m+1)*(nn-n+1)."); + endif + A=reshape(B, mm-m+1, nn-n+1); + + otherwise + error("col2im: invalid block_type."); + endswitch + +endfunction + +%!demo +%! A=[1:10;11:20;21:30;31:40] +%! B=im2col(A,[2,5],'distinct') +%! C=col2im(B,[2,5],[4,10],'distinct') +%! # Divide A using distinct blocks and reverse operation + + +%!shared B, Ad +%! v=[1:10]'; +%! r=reshape(v,2,5); +%! B=[v, v+10, v+20, v+30, v+40, v+50]; +%! Ad=[r, r+10; r+20, r+30; r+40, r+50]; + +%!# bad m +%!error(col2im(B,[3,5],[6,10],'distinct')); + +%!# bad n +%!error(col2im(B,[2,3],[6,10],'distinct')); + +%!# bad mm +%!error(col2im(B,[2,5],[7,10],'distinct')); + +%!# bad nn +%!error(col2im(B,[2,5],[6,11],'distinct')); + +%!# bad block_type +%!error(col2im(B,[2,5],[6,10],'wrong_block_type')); + +%!# this should be ok +%!assert(col2im(B,[2,5],[6,10],'distinct'), Ad); + +%!# now sliding +%!assert(col2im(ones(1,(10-2+1)*(7-3+1)),[2,3],[10,7]), ones((10-2+1),(7-3+1))); +%!assert(col2im(ones(1,(10-2+1)*(7-3+1)),[2,3],[10,7],'sliding'), ones((10-2+1),(7-3+1))); + + +%!# disctint on uint8 +%!assert(col2im(uint8(B),[2,5],[6,10],'distinct'), uint8(Ad)); + +%!# now sliding on uint8 +%!assert(col2im(ones(1,(10-2+1)*(7-3+1),"uint8"),[2,3],[10,7]), ones((10-2+1),(7-3+1),"uint8")); + + +% +% $Log$ +% Revision 1.4 2007/03/23 16:14:36 adb014 +% Update the FSF address +% +% Revision 1.3 2007/01/04 23:46:17 hauberg +% Minor changes in help text +% +% Revision 1.2 2007/01/04 23:37:54 hauberg +% Minor changes in help text +% +% Revision 1.1 2006/08/20 12:59:32 hauberg +% Changed the structure to match the package system +% +% Revision 1.2 2004/09/03 17:57:42 jmones +% Added support for int* and uint* types +% +% Revision 1.1 2004/08/18 14:39:07 jmones +% im2col and col2im added +% +% diff --git a/octave_packages/image-1.0.15/colfilt.m b/octave_packages/image-1.0.15/colfilt.m new file mode 100644 index 0000000..9887ebc --- /dev/null +++ b/octave_packages/image-1.0.15/colfilt.m @@ -0,0 +1,116 @@ +## -*- texinfo -*- +## @deftypefn {Function File} colfilt(@var{A}, [@var{r}, @var{c}], [@var{m}, @var{n}], 'sliding', @var{f},...) +## Apply filter to matrix blocks +## +## For each @var{r} x @var{c} overlapping subblock of @var{A}, add a column in matrix @var{C} +## @var{f}(@var{C},...) should return a row vector which is then reshaped into a +## a matrix of size @var{A} and returned. @var{A} is processed in chunks of size @var{m} x @var{n}. +## @deftypefnx{Function File} colfilt(@var{A}, [@var{r}, @var{c}], [@var{m}, @var{n}], 'distinct', @var{f},...) +## For each @var{r} x @var{c} non-overlapping subblock of @var{A}, add a column in matrix @var{C} +## @var{f}(@var{C},...) should return a matrix of size @var{C} each column of which is +## placed back into the subblock from whence it came. @var{A} is processed +## in chunks of size @var{m} x @var{n}. +## +## The present version requires that [@var{m}, @var{n}] divide size(@var{A}), but for +## compatibility it should work even if [@var{m}, @var{n}] does not divide @var{A}. Use +## the following instead: +## @example +## [r, c] = size(A); +## padA = zeros (m*ceil(r/m),n*ceil(c/n)); +## padA(1:r,1:c) = A; +## B = colfilt(padA,...); +## B = B(1:r,1:c); +## @end example +## +## The present version does not handle 'distinct' +## @end deftypefn + +## This software is granted to the public domain +## Author: Paul Kienzle + +function B = colfilt(A,filtsize,blksize,blktype,f,varargin) + ## Input checking + real_nargin = nargin - length(varargin); + if (real_nargin < 4) + error("colfilt: not enough input arguments"); + endif + if (ischar(blksize)) + varargin = {f, varargin{:}}; + f = blktype; + blktype = blksize; + blksize = size(A); + elseif (real_nargin < 5) + error("colfilt: not enough input arguments"); + endif + if (!ismatrix(A) || ndims(A) != 2) + error("colfilt: first input argument must be a matrix"); + endif + if (!isvector(filtsize) || numel(filtsize) != 2) + error("colfilt: second input argument must be a 2-vector"); + endif + + ## Compute! + [m,n] = size(A); + r = filtsize(1); + c = filtsize(2); + mblock = blksize(1); + nblock = blksize(2); + + switch blktype + case 'sliding' + # pad with zeros + padm = (m+r-1); + padn = (n+c-1); + padA = zeros(padm, padn); + padA([1:m]+floor((r-1)/2),[1:n]+floor((c-1)/2)) = A; + padA = padA(:); + + # throw away old A to save memory. + B=A; clear A; + + # build the index vector + colidx = [0:r-1]'*ones(1,c) + padm*ones(r,1)*[0:c-1]; + offset = [1:mblock]'*ones(1,nblock) + padm*ones(mblock,1)*[0:nblock-1]; + idx = colidx(:)*ones(1,mblock*nblock) + ones(r*c,1)*offset(:)'; + clear colidx offset; + + # process the matrix, one block at a time + idxA = zeros(r*c,mblock*nblock); + tmp = zeros(mblock,nblock); + for i = 0:m/mblock-1 + for j = 0:n/nblock-1 + idxA(:) = padA(idx + (i*mblock + padm*j*nblock)); + tmp(:) = feval(f,idxA,varargin{:}); + B(1+i*mblock:(i+1)*mblock, 1+j*nblock:(j+1)*nblock) = tmp; + end + end + + case 'old-sliding' # processes the whole matrix at a time + padA = zeros(m+r-1,n+c-1); + padA([1:m]+floor(r/2),[1:n]+floor(c/2)) = A; + [padm,padn] = size(padA); + colidx = [0:r-1]'*ones(1,c) + padm*ones(r,1)*[0:c-1]; + offset = [1:m]'*ones(1,n) + padm*ones(m,1)*[0:n-1]; + idx = colidx(:)*ones(1,m*n) + ones(r*c,1)*offset(:)'; + idxA = zeros(r*c,m*n); + idxA(:) = padA(:)(idx); + B = zeros(size(A)); + B(:) = feval(f,idxA,varargin{:}); + case 'old-distinct' # processes the whole matrix at a time + if (r*floor(m/r) != m || c*floor(n/c) != n) + error("colfilt expected blocks to exactly fill A"); + endif + colidx = [0:r-1]'*ones(1,c) + m*ones(r,1)*[0:c-1]; + offset = [1:r:m]'*ones(1,n/c) + m*ones(m/r,1)*[0:c:n-1]; + idx =colidx(:)*ones(1,m*n/r/c) + ones(r*c,1)*offset(:)'; + idxA = zeros(r*c,m*n/r/c); + idxA(:) = A(:)(idx); + B = zeros(prod(size(A)),1); + B(idx) = feval(f,idxA,varargin{:}); + B = reshape(B,size(A)); + endswitch +endfunction + +%!test +%! A = reshape(1:36,6,6); +%! assert(colfilt(A,[2,2],[3,3],'sliding','sum'), conv2(A,ones(2),'same')); diff --git a/octave_packages/image-1.0.15/colorgradient.m b/octave_packages/image-1.0.15/colorgradient.m new file mode 100644 index 0000000..e03a99a --- /dev/null +++ b/octave_packages/image-1.0.15/colorgradient.m @@ -0,0 +1,56 @@ +## -*- texinfo -*- +## @deftypefn {Function File} @var{M} = colorgradient(@var{C}, @var{w}, @var{n}) +## Define a colour map which smoothly traverses the given colors. +## @var{C} contains the colours, one row per r,g,b value. +## @var{w}(i) is the relative length of the transition from colour i to colour i+1 +## in the entire gradient. The default is ones(rows(C)-1,1). +## n is the length of the colour map. The default is rows(colormap). +## +## E.g., +## @example +## colorgradient([0,0,1; 1,1,0; 1,0,0]) # blue -> yellow -> red +## x = linspace(0,1,200); +## imagesc(x(:,ones(30,1)))'; +## @end example +## @end deftypefn + +## This program is granted to the public domain. +## Author: Paul Kienzle + +function ret = colorgradient(C,w,n) + if nargin < 1 || nargin > 3 + usage("M = colorgradient(C,w,n)") + endif + + if nargin == 1 + n = rows(colormap); + w = ones(length(C)-1,1); + elseif nargin == 2 + if (length(w) == 1) + n = w; + w = ones(rows(C)-1,1); + else + n = rows(colormap); + endif + endif + + if (length(w)+1 != rows(C)) + error("must have one weight for each color interval"); + endif + + w = 1+round((n-1)*cumsum([0;w(:)])/sum(w)); + map = zeros(n,3); + for i=1:length(w)-1 + if (w(i) != w(i+1)) + map(w(i):w(i+1),1) = linspace(C(i,1),C(i+1,1),w(i+1)-w(i)+1)'; + map(w(i):w(i+1),2) = linspace(C(i,2),C(i+1,2),w(i+1)-w(i)+1)'; + map(w(i):w(i+1),3) = linspace(C(i,3),C(i+1,3),w(i+1)-w(i)+1)'; + endif + endfor + + if nargout == 0 + colormap(map); + else + ret = map; + endif +endfunction diff --git a/octave_packages/image-1.0.15/conndef.m b/octave_packages/image-1.0.15/conndef.m new file mode 100644 index 0000000..c53723b --- /dev/null +++ b/octave_packages/image-1.0.15/conndef.m @@ -0,0 +1,114 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{conn} = } conndef (@var{num_dims}, @var{type}) +## Creates a connectivity array. +## +## @code{conn=conndef(num_dims,type)} creates a connectivity array +## (@var{CONN}) of @var{num_dims} dimensions and which type is defined +## by @var{type} as follows: +## @table @code +## @item minimal +## Neighbours touch the central element on a (@var{num_dims}-1)-dimensional +## surface. +## @item maximal +## Neighbours touch the central element in any way. Equivalent to +## @code{ones(repmat(3,1,@var{num_dims}))}. +## @end table +## +## @end deftypefn + + + +## Author: Josep Mones i Teixidor + +function conn = conndef(num_dims,conntype) + if(nargin!=2) + usage("conn=conndef(num_dims, type)"); + endif + if(num_dims<=0) + error("conndef: num_dims must be > 0"); + endif + + if(strcmp(conntype,"minimal")) + if(num_dims==1) + conn=[1;1;1]; + elseif(num_dims==2) + conn=[0,1,0;1,1,1;0,1,0]; + else + conn=zeros(repmat(3,1,num_dims)); + idx={}; + idx{1}=1:3; + for i=2:num_dims + idx{i}=2; + endfor + conn(idx{:})=1; + for i=2:num_dims + idx{i-1}=2; + idx{i}=1:3; + conn(idx{:})=1; + endfor + endif + + elseif(strcmp(conntype,"maximal")) + if(num_dims==1) + conn=[1;1;1]; + else + conn=ones(repmat(3,1,num_dims)); + endif + else + error("conndef: invalid type parameter."); + endif + +endfunction + +%!demo +%! conndef(2,'minimal') +%! % Create a 2-D minimal connectivity array + +%!assert(conndef(1,'minimal'), [1;1;1]); + +%!assert(conndef(2,'minimal'), [0,1,0;1,1,1;0,1,0]); + +%!test +%! C=zeros(3,3); +%! C(2,2,1)=1; +%! C(2,2,3)=1; +%! C(:,:,2)=[0,1,0;1,1,1;0,1,0]; +%! assert(conndef(3,'minimal'), C); + +%!assert(conndef(1,'maximal'), ones(3,1)); +%!assert(conndef(2,'maximal'), ones(3,3)); +%!assert(conndef(3,'maximal'), ones(3,3,3)); +%!assert(conndef(4,'maximal'), ones(3,3,3,3)); + + + +% $Log$ +% Revision 1.3 2007/03/23 16:14:36 adb014 +% Update the FSF address +% +% Revision 1.2 2007/01/04 23:41:47 hauberg +% Minor changes in help text +% +% Revision 1.1 2006/08/20 12:59:32 hauberg +% Changed the structure to match the package system +% +% Revision 1.2 2005/07/03 01:10:19 pkienzle +% Try to correct for missing newline at the end of the file +% +% Revision 1.1 2004/08/15 19:38:44 jmones +% conndef added: Creates a connectivity array diff --git a/octave_packages/image-1.0.15/corr2.m b/octave_packages/image-1.0.15/corr2.m new file mode 100644 index 0000000..fe360bb --- /dev/null +++ b/octave_packages/image-1.0.15/corr2.m @@ -0,0 +1,44 @@ +## Copyright (C) 2000 Kai Habel +## +## 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{r} = corr2 (@var{I},@var{J}) +## Returns the correlation coefficient between @var{I} and @var{j}. +## @var{I}, @var{J} must be real type matrices or vectors of same size. +## @seealso{cov, std2} +## +## @end deftypefn + + +## Author: Kai Habel +## Date: 01/08/2000 + +function r = corr2 (I, J) + + if (nargin != 2) + print_usage (); + endif + + if (!(ismatrix (I) && isreal (I) && ismatrix (J) && isreal (J))) + error ("corr2: argument must be a real type matrix"); + endif + + if (!size_equal (I, J)) + error ("corr2: arguments must be of same size") + endif + + r = cov (I (:), J (:)) / (std2 (I) * std2 (J)); +endfunction + diff --git a/octave_packages/image-1.0.15/dilate.m b/octave_packages/image-1.0.15/dilate.m new file mode 100644 index 0000000..ba5dcea --- /dev/null +++ b/octave_packages/image-1.0.15/dilate.m @@ -0,0 +1,90 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{BW2} = } dilate (@var{BW1},@var{SE}) +## @deftypefnx {Function File} {@var{BW2} = } dilate (@var{BW1},@var{SE},@var{alg}) +## @deftypefnx {Function File} {@var{BW2} = } dilate (@var{BW1},@var{SE},...,@var{n}) +## Perform a dilation morphological operation on a binary image. +## +## BW2 = dilate(BW1, SE) returns a binary image with the result of a dilation +## operation on @var{BW1} using neighbour mask @var{SE}. +## +## For each point in @var{BW1}, dilate search its neighbours (which are +## defined by setting to 1 their in @var{SE}). If any of its neighbours +## is on (1), then pixel is set to 1. If all are off (0) then it is set to 0. +## +## Center of @var{SE} is calculated using floor((size(@var{SE})+1)/2). +## +## Pixels outside the image are considered to be 0. +## +## BW2 = dilate(BW1, SE, alg) returns the result of a dilation operation +## using algorithm @var{alg}. Only 'spatial' is implemented at the moment. +## +## BW2 = dilate(BW1, SE, ..., n) returns the result of @var{n} dilation +## operations on @var{BW1}. +## +## @seealso{erode} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function BW2 = dilate(BW1, SE, a, b) + alg='spatial'; + n=1; + if (nargin < 1 || nargin > 4) + usage ("BW2 = dilate(BW1, SE [, alg] [, n])"); + endif + if nargin == 4 + alg=a; + n=b; + elseif nargin == 3 + if ischar(a) + alg=a; + else + n=a; + endif + endif + + if !strcmp(alg, 'spatial') + error("dilate: alg not implemented."); + endif + + # "Binarize" BW1, just in case image is not [1,0] + BW1=BW1!=0; + + ## Filtering must be done with the reflection of the structuring element (they + ## are not always symmetrical) + SE = imrotate(SE, 180); + + for i=1:n + # create result matrix + BW1=filter2(SE,BW1)>0; + endfor + + BW2=BW1; +endfunction + +%!demo +%! dilate(eye(5),ones(2,2)) +%! % returns a thick diagonal. + + + +%!assert(dilate(eye(3),[1])==eye(3)); # using [1] as a mask returns the same value +%!assert(dilate(eye(3),[1,0,0])==[0,0,0;1,0,0;0,1,0]); # check if it works with non-symmetric SE +## TODO the next assertion is commented since we do not know how the right answer for the calculation +%!##assert(dilate(eye(3),[1,0,0,0])==XXX); # test if center is correctly calculated on even masks + diff --git a/octave_packages/image-1.0.15/doc-cache b/octave_packages/image-1.0.15/doc-cache new file mode 100644 index 0000000..36ddfc9 --- /dev/null +++ b/octave_packages/image-1.0.15/doc-cache @@ -0,0 +1,4747 @@ +# Created by Octave 3.6.1, Mon Mar 12 21:54:04 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 95 +# name: +# type: sq_string +# elements: 1 +# length: 8 +applylut + + +# name: +# type: sq_string +# elements: 1 +# length: 554 + -- Function File: A = applylut (BW,LUT) + Uses lookup tables to perform a neighbour operation on binary + images. + + A = applylut(BW,LUT) returns the result of a neighbour operation + using the lookup table LUT which can be created by makelut. + + It first computes a matrix with the index of each element in the + lookup table. To do this, it convolves the original matrix with a + matrix which assigns each of the neighbours a bit in the resulting + index. Then LUT is accessed to compute the result. + + See also: makelut + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +Uses lookup tables to perform a neighbour operation on binary images. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +bestblk + + +# name: +# type: sq_string +# elements: 1 +# length: 832 + -- Function File: SIZ = bestblk ([M N], K) + -- Function File: [MB NB] = bestblk ([M N], K) + Calculates the best size of block for block processing. + + `siz=bestblk([m,n],k)' calculates the optimal block size for block + processing for a M-by-N image. K is the maximum side dimension of + the block. Its default value is 100. SIZ is a row vector which + contains row and column dimensions for the block. + + `[mb,nb]=bestblk([m,n],k)' behaves as described above but returns + block dimensions to MB and NB. + + *Algorithm:* + + For each dimension (M and N), it follows this algorithm: + + 1.- If dimension is less or equal than K, it returns the dimension + value. + + 2.- If not then returns the value between + `round(min(dimension/10,k/2))' which minimizes padding. + + See also: blkproc + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Calculates the best size of block for block processing. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +blkproc + + +# name: +# type: sq_string +# elements: 1 +# length: 1441 + -- Function File: B = blkproc (A, [M,N], FUN) + -- Function File: B = blkproc (A, [M,N], FUN, ...) + -- Function File: B = blkproc (A, [M,N], [MBORDER,NBORDER], FUN, ...) + -- Function File: B = blkproc (A, 'indexed', ...) + Processes image in blocks using user-supplied function. + + `B=blkproc(A,[m,n],fun)' divides image A in M-by-N blocks, and + passes them to user-supplied function FUN, which result is + concatenated to build returning matrix B. If padding is needed to + build M-by-N, it is added at the bottom and right borders of the + image. 0 is used as a padding value. + + `B=blkproc(A,[m,n],fun,...)' behaves as described above but passes + extra parameters to function FUN. + + `B=blkproc(A,[m,n],[mborder,nborder],fun,...)' behaves as + described but uses blocks which overlap with neighbour blocks. + Overlapping dimensions are MBORDER vertically and NBORDER + horizontally. This doesn't change the number of blocks in an image + (which depends only on size(A) and [M,N]). Adding a border + requires extra padding on all edges of the image. 0 is used as a + padding value. + + `B=blkproc(A,'indexed',...)' assumes that A is an indexed image, + so it pads the image using proper value: 0 for uint8 and uint16 + images and 1 for double images. Keep in mind that if 'indexed' is + not specified padding is always done using 0. + + See also: colfilt, inline, bestblk + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Processes image in blocks using user-supplied function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +bmpwrite + + +# name: +# type: sq_string +# elements: 1 +# length: 361 + -- Function File: bmpwrite (X, MAP, FILE) + Write the bitmap X into FILE (8-bit indexed uncompressed). The + values in X are indices into the given RGB colour MAP. + + -- Function File: bmpwrite (X, FILE) + Write the bitmap X into FILE (24-bit truecolor uncompressed). X + is an m x n x 3 array of R,G,B integer values in the range 0 to + 255. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Write the bitmap X into FILE (8-bit indexed uncompressed). + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +bwarea + + +# name: +# type: sq_string +# elements: 1 +# length: 425 + -- Function File: TOTAL = bwarea(BW) + Estimates the area of the "on" pixels of BW. If BW is a binary + image "on" pixels are defined as pixels valued 1. If BW is a + grayscale image "on" pixels is defined as pixels with values + larger than zero. This algorithm is not the same as counting the + number of "on" pixels as it tries to estimate the area of the + original object and not the image object. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 +Estimates the area of the "on" pixels of BW. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +bwborder + + +# name: +# type: sq_string +# elements: 1 +# length: 289 + -- Function File: B = bwborder (IM) + Finds the borders of foreground objects in a binary image. + + B is the borders in the 0-1 matrix IM. 4-neighborhood is + considered. + + A pixel is on the border if it is set in IM, and it has at least + one neighbor that is not set. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Finds the borders of foreground objects in a binary image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +bwboundaries + + +# name: +# type: sq_string +# elements: 1 +# length: 1278 + -- Function File: BOUNDARIES = bwboundaries(BW) + -- Function File: BOUNDARIES = bwboundaries(BW, CONN) + -- Function File: BOUNDARIES = bwboundaries(BW, CONN, HOLES) + -- Function File: [BOUNDARIES, LABELS] = bwboundaries(...) + -- Function File: [BOUNDARIES, LABELS, NUM_LABELS] = bwboundaries(...) + Trace the boundaries of the objects in a binary image. + + BOUNDARIES is a cell array in which each element is the boundary + of an object in the binary image BW. The clockwise boundary of + each object is computed by the `boundary' function. + + By default the boundaries are computed using 8-connectivity. This + can be changed to 4-connectivity by setting CONN to 4. + + By default `bwboundaries' computes all boundaries in the image, + i.e. both interior and exterior object boundaries. This behaviour + can be changed through the HOLES input argument. If this is + 'holes', both boundary types are considered. If it is instead + 'noholes', only exterior boundaries will be traced. + + If two or more output arguments are requested, the algorithm also + returns the labelled image computed by `bwlabel' in LABELS. The + number of labels in this image is optionally returned in + NUM_LABELS. + + See also: boundary, bwlabel + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Trace the boundaries of the objects in a binary image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +bwconncomp + + +# name: +# type: sq_string +# elements: 1 +# length: 946 + -- Function File: CC = bwconncomp (BW) + -- Function File: CC = bwconncomp (BW, CONNECTIVITY) + Trace the boundaries of objects in a binary image. + + `bwconncomp' traces the boundaries of objects in a binary image BW + and returns information about them in a structure with the + following fields. + + Connectivity + The connectivity used in the boundary tracing. + + ImageSize + The size of the image BW. + + NumObjects + The number of objects in the image BW. + + PixelIdxList + A cell array containing where each element corresponds to an + object in BW. Each element is represented as a vector of + linear indices of the boundary of the given object. + + The connectivity used in the tracing is by default 4, but can be + changed by setting the CONNECTIVITY input parameter to 8. Sadly, + this is not yet implemented. + + See also: bwlabel, bwboundaries, ind2sub + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Trace the boundaries of objects in a binary image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +bwdist + + +# name: +# type: sq_string +# elements: 1 +# length: 1229 + -- Function File: D = bwdist(BW) + Computes the distance transform of the image BW. BW should be a + binary 2D array, either a Boolean array or a numeric array + containing only the values 0 and 1. The return value D is a + double matrix of the same size as BW. Elements with value 0 are + considered background pixels, elements with value 1 are considered + object pixels. The return value for each background pixel is the + distance (according to the chosen metric) to the closest object + pixel. For each object pixel the return value is 0. + + -- Function File: D = bwdist(BW, METHOD) + METHOD is a string to choose the distance metric. Currently + available metrics are 'euclidean', 'chessboard', 'cityblock' and + 'quasi-euclidean', which may each be abbreviated to any string + starting with 'e', 'ch', 'ci' and 'q', respectively. If METHOD is + not specified, 'euclidean' is the default. + + -- Function File: [D,C] = bwdist(BW, METHOD) + If a second output argument is given, the linear index for the + closest object pixel is returned for each pixel. (For object + pixels, the index points to the pixel itself.) The return value C + is a matrix the same size as BW. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Computes the distance transform of the image BW. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +bweuler + + +# name: +# type: sq_string +# elements: 1 +# length: 720 + -- Function File: EUL = bweuler (BW,N) + Calculates the Euler number of a binary image. + + EUL=bweuler(BW, N) calculates the Euler number EUL of a binary + image BW, which is a scalar whose value is the total number of + objects in an image minus the number of holes. + + N can have the values: + `4' + bweuler will use 4-connected neighbourhood definition. + + `8' + bweuler will use 8-connected neighbourhood definition. This + is the default value. + + This function uses Bit Quads as described in "Digital Image + Processing" to calculate euler number. + + References: W. K. Pratt, "Digital Image Processing", 3rd Edition, + pp 593-595 + + See also: qtgetblk + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Calculates the Euler number of a binary image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +bwhitmiss + + +# name: +# type: sq_string +# elements: 1 +# length: 535 + -- Function File: BW2 = bwhitmiss (BW1, SE1, SE1) + -- Function File: BW2 = bwhitmiss (BW1, INTERVAL) + Perform the binary hit-miss operation. + + If two structuring elements SE1 and SE1 are given, the hit-miss + operation is defined as + bw2 = erode(bw1, se1) & erode(!bw1, se2); + If instead an 'interval' array is given, two structuring elements + are computed as + se1 = (interval == 1) + se2 = (interval == -1) + and then the operation is defined as previously. + + See also: bwmorph + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Perform the binary hit-miss operation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +bwmorph + + +# name: +# type: sq_string +# elements: 1 +# length: 6990 + -- Function File: BW2 = bwmorph (BW,OPERATION) + -- Function File: BW2 = bwmorph (BW,OPERATION,N) + Perform a morphological operation on a binary image. + + BW2=bwmorph(BW,operation) performs a morphological operation + specified by OPERATION on binary image BW. All possible operations + and their meaning are specified in a table below. + + BW2=bwmorph(BW,operation,n) performs a morphological operation N + times. Keep in mind that it has no sense to apply some operations + more than once, since some of them return the same result + regardless how many iterations we request. Those return a warning + if are called with n>1 and they compute the result for n=1. + + N>1 is actually used for the following operations: diag, dilate, + erode, majority, shrink, skel, spur, thicken and thin. + + `'bothat'' + Performs a bottom hat operation, a closing operation (which + is a dilation followed by an erosion) and finally substracts + the original image. + + `'bridge'' + Performs a bridge operation. Sets a pixel to 1 if it has two + nonzero neighbours which are not connected, so it "bridges" + them. There are 119 3-by-3 patterns which trigger setting a + pixel to 1. + + `'clean'' + Performs an isolated pixel remove operation. Sets a pixel to + 0 if all of its eight-connected neighbours are 0. + + `'close'' + Performs closing operation, which is a dilation followed by + erosion. It uses a ones(3) matrix as structuring element for + both operations. + + `'diag'' + Performs a diagonal fill operation. Sets a pixel to 1 if that + eliminates eight-connectivity of the background. + + `'dilate'' + Performs a dilation operation. It uses ones(3) as structuring + element. + + `'erode'' + Performs an erosion operation. It uses ones(3) as structuring + element. + + `'fill'' + Performs a interior fill operation. Sets a pixel to 1 if all + four-connected pixels are 1. + + `'hbreak'' + Performs a H-break operation. Breaks (sets to 0) pixels that + are H-connected. + + `'majority'' + Performs a majority black operation. Sets a pixel to 1 if five + or more pixels in a 3-by-3 window are 1. If not it is set to + 0. + + `'open'' + Performs an opening operation, which is an erosion followed + by a dilation. It uses ones(3) as structuring element. + + `'remove'' + Performs a iterior pixel remove operation. Sets a pixel to 0 + if all of its four-connected neighbours are 1. + + `'shrink'' + Performs a shrink operation. Sets pixels to 0 such that an + object without holes erodes to a single pixel (set to 1) at + or near its center of mass. An object with holes erodes to a + connected ring lying midway between each hole and its nearest + outer boundary. It preserves Euler number. + + `'skel'' + Performs a skeletonization operation. It calculates a "median + axis skeleton" so that points of this skeleton are at the + same distance of its nearby borders. It preserver Euler + number. Please read compatibility notes for more info. + + It uses the same algorithm as skel-pratt but this could + change for compatibility in the future. + + `'skel-lantuejol'' + Performs a skeletonization operation as described in Gonzalez + & Woods "Digital Image Processing" pp 538-540. The text + references Lantuejoul as authour of this algorithm. + + It has the beauty of being a clean and simple approach, but + skeletons are thicker than they need to and, in addition, not + guaranteed to be connected. + + This algorithm is iterative. It will be applied the minimum + value of N times or number of iterations specified in + algorithm description. It's most useful to run this algorithm + with `n=Inf'. + + `'skel-pratt'' + Performs a skeletonization operation as described by William + K. Pratt in "Digital Image Processing". + + `'spur'' + Performs a remove spur operation. It sets pixel to 0 if it + has only one eight-connected pixel in its neighbourhood. + + `'thicken'' + Performs a thickening operation. This operation "thickens" + objects avoiding their fusion. Its implemented as a thinning + of the background. That is, thinning on negated image. + Finally a diagonal fill operation is performed to avoid + "eight-connecting" objects. + + `'thin'' + Performs a thinning operation. When n=Inf, thinning sets + pixels to 0 such that an object without holes is converted to + a stroke equidistant from its nearest outer boundaries. If + the object has holes it creates a ring midway between each + hole and its near outer boundary. This differ from shrink in + that shrink converts objects without holes to a single pixels + and thin to a stroke. It preserves Euler number. + + `'tophat'' + Performs a top hat operation, a opening operation (which is an + erosion followed by a dilation) and finally substracts the + original image. + + Some useful concepts to understant operators: + + Operations are defined on 3-by-3 blocks of data, where the pixel in + the center of the block. Those pixels are numerated as follows: + + X3 X2 X1 + X4 X X0 + X5 X6 X7 + + *Neighbourhood definitions used in operation descriptions:* + `'four-connected'' + It refers to pixels which are connected horizontally or + vertically to X: X1, X3, X5 and X7. + + `'eight-connected'' + It refers to all pixels which are connected to X: X0, X1, X2, + X3, X4, X5, X6 and X7. + + *Compatibility notes:* + `'fill'' + Checking MATLAB behaviour is needed because its documentation + doesn't make clear if it creates a black pixel if all + eight-connected pixels are black or if four-connected suffice + (as we do currently following Pratt's book). + + `'skel'' + Algorithm used here is described in Pratt's book. When + applying it to the "circles" image in MATLAB documentation, + results are not the same. Perhaps MATLAB uses Blum's algoritm + (for further info please read comments in code). + + `'skel-pratt'' + This option is not available in MATLAB. + + `'skel-lantuejoul'' + This option is not available in MATLAB. + + `'thicken'' + This implementation also thickens image borders. This can + easily be avoided i necessary. MATLAB documentation doesn't + state how it behaves. + + References: W. K. Pratt, "Digital Image Processing" Gonzalez and + Woods, "Digital Image Processing" + + See also: dilate, erode, makelut, applylut + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +Perform a morphological operation on a binary image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +bwperim + + +# name: +# type: sq_string +# elements: 1 +# length: 401 + -- Function File: BW2 = bwperim(BW1) + -- Function File: BW2 = bwperim(BW1, N) + Find the perimeter of objects in binary images. + + A pixel is part of an object perimeter if its value is one and + there is at least one zero-valued pixel in its neighborhood. + + By default the neighborhood of a pixel is 4 nearest pixels, but if + N is set to 8 the 8 nearest pixels will be considered. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Find the perimeter of objects in binary images. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +bwselect + + +# name: +# type: sq_string +# elements: 1 +# length: 431 + -- Function File: [IMOUT, IDX] = bwselect(IM, COLS, ROWS, CONNECT) + Select connected regions in a binary image. + + `IM' + binary input image + + `[COLS, ROWS]' + vectors of starting points (x,y) + + `CONNECT' + connectedness 4 or 8. default is 8 + + `IMOUT' + the image of all objects in image im that overlap pixels in + (cols,rows) + + `IDX' + index of pixels in imout + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Select connected regions in a binary image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +cmpermute + + +# name: +# type: sq_string +# elements: 1 +# length: 768 + -- Function File: [Y, NEWMAP] = cmpermute (X,MAP) + -- Function File: [Y, NEWMAP] = cmpermute (X,MAP,INDEX) + Reorders colors in a colormap. + + `[Y,newmap]=cmpermute(X,map)' rearranges colormap MAP randomly + returning colormap NEWMAP and generates indexed image Y so that it + mantains correspondence between indices and the colormap from + original indexed image X (both image and colormap pairs produce + the same result). + + `[Y,newmap]=cmpermute(X,map,index)' behaves as described above but + instead of sorting colors randomly, it uses INDEX to define the + order of the colors in the new colormap. + + *Note:* `index' shouldn't have repeated elements, this function + won't explicitly check this, but it will fail if it has. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Reorders colors in a colormap. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +cmunique + + +# name: +# type: sq_string +# elements: 1 +# length: 1496 + -- Function File: [Y, NEWMAP] = cmunique (X,MAP) + -- Function File: [Y, NEWMAP] = cmunique (RGB) + -- Function File: [Y, NEWMAP] = cmunique (I) + Finds colormap with unique colors and corresponding image. + + `[Y,newmap]=cmunique(X,map)' returns an indexed image Y along with + its associated colormap NEWMAP equivalent (which produce the same + image) to supplied X and its colormap MAP; but eliminating any + repeated rows in colormap colors and adjusting indices in the + image matrix as needed. + + `[Y,newmap]=cmunique(RGB)' returns an indexed image Y along with + its associated colormap NEWMAP computed from a true-color image + RGB (a m-by-n-by-3 array), where NEWMAP is the smallest colormap + possible (alhough it could be as long as number of pixels in + image). + + `[Y,newmap]=cmunique(I)' returns an indexed image Y along with its + associated colormap NEWMAP computed from a intensity image I, + where NEWMAP is the smallest colormap possible (alhough it could + be as long as number of pixels in image). + + *Notes:* + + NEWMAP is always a M-by-3 matrix, even if input image is a + intensity grey-scale image I (all three RGB planes are assigned + the same value). + + NEWMAP is always of class double. If we use a RGB or intensity + image of class uint8 or uint16, the colors in the colormap will be + of class double in the range [0,1] (they are divided by + intmax("uint8") and intmax("uint16") respectively. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Finds colormap with unique colors and corresponding image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +col2im + + +# name: +# type: sq_string +# elements: 1 +# length: 959 + -- Function File: A = col2im (B, [M,N], [MM,NN], BLOCK_TYPE) + -- Function File: A = col2im (B, [M,N], [MM,NN]) + Rearranges matrix columns into blocks. + + `A=col2im(B,[m,n],[mm,nn],block_type)' rearranges columns of + matrix B intro blocks in a way controlled by BLOCK_TYPE param, + which can take the following values: + + `distinct' + It uses M-by-N distinct blocks (which are not overlapped), + and are rearranged to form a MM-by-NN matrix A. B's height + must be M*N and `col2im' rearranges each column to a M-by-N + block and uses them to fill the whole matrix in left-to-right + and then up-to-down order. + + `sliding' + Is uses M-by-N sliding blocks. It rearranges row vector B to + a (MM-M+1)-by-(NN-N+1) matrix A. B must be a + 1-by-(MM-M+1)*(NN-N+1). + + `A=col2im(B,[m,n],[mm,nn])' takes `distinct' as a default value + for BLOCK_TYPE. + + See also: im2col + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Rearranges matrix columns into blocks. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +colfilt + + +# name: +# type: sq_string +# elements: 1 +# length: 1041 + -- Function File: colfilt (A, [R, C], [M, N], 'sliding', F,...) + Apply filter to matrix blocks + + For each R x C overlapping subblock of A, add a column in matrix C + F(C,...) should return a row vector which is then reshaped into a + a matrix of size A and returned. A is processed in chunks of size + M x N. + + -- Function File: colfilt (A, [R, C], [M, N], 'distinct', F,...) + For each R x C non-overlapping subblock of A, add a column in + matrix C F(C,...) should return a matrix of size C each column + of which is placed back into the subblock from whence it came. A + is processed in chunks of size M x N. + + The present version requires that [M, N] divide size(A), but for + compatibility it should work even if [M, N] does not divide A. Use + the following instead: + [r, c] = size(A); + padA = zeros (m*ceil(r/m),n*ceil(c/n)); + padA(1:r,1:c) = A; + B = colfilt(padA,...); + B = B(1:r,1:c); + + The present version does not handle 'distinct' + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Apply filter to matrix blocks + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +colorgradient + + +# name: +# type: sq_string +# elements: 1 +# length: 541 + -- Function File: M = colorgradient(C, W, N) + Define a colour map which smoothly traverses the given colors. C + contains the colours, one row per r,g,b value. W(i) is the + relative length of the transition from colour i to colour i+1 in + the entire gradient. The default is ones(rows(C)-1,1). n is the + length of the colour map. The default is rows(colormap). + + E.g., + colorgradient([0,0,1; 1,1,0; 1,0,0]) # blue -> yellow -> red + x = linspace(0,1,200); + imagesc(x(:,ones(30,1)))'; + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +Define a colour map which smoothly traverses the given colors. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +conndef + + +# name: +# type: sq_string +# elements: 1 +# length: 478 + -- Function File: CONN = conndef (NUM_DIMS, TYPE) + Creates a connectivity array. + + `conn=conndef(num_dims,type)' creates a connectivity array (CONN) + of NUM_DIMS dimensions and which type is defined by TYPE as + follows: + `minimal' + Neighbours touch the central element on a + (NUM_DIMS-1)-dimensional surface. + + `maximal' + Neighbours touch the central element in any way. Equivalent to + `ones(repmat(3,1,NUM_DIMS))'. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 29 +Creates a connectivity array. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +corr2 + + +# name: +# type: sq_string +# elements: 1 +# length: 184 + -- Function File: R = corr2 (I,J) + Returns the correlation coefficient between I and J. I, J must be + real type matrices or vectors of same size. + + See also: cov, std2 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +Returns the correlation coefficient between I and J. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +dilate + + +# name: +# type: sq_string +# elements: 1 +# length: 939 + -- Function File: BW2 = dilate (BW1,SE) + -- Function File: BW2 = dilate (BW1,SE,ALG) + -- Function File: BW2 = dilate (BW1,SE,...,N) + Perform a dilation morphological operation on a binary image. + + BW2 = dilate(BW1, SE) returns a binary image with the result of a + dilation operation on BW1 using neighbour mask SE. + + For each point in BW1, dilate search its neighbours (which are + defined by setting to 1 their in SE). If any of its neighbours is + on (1), then pixel is set to 1. If all are off (0) then it is set + to 0. + + Center of SE is calculated using floor((size(SE)+1)/2). + + Pixels outside the image are considered to be 0. + + BW2 = dilate(BW1, SE, alg) returns the result of a dilation + operation using algorithm ALG. Only 'spatial' is implemented at + the moment. + + BW2 = dilate(BW1, SE, ..., n) returns the result of N dilation + operations on BW1. + + See also: erode + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +Perform a dilation morphological operation on a binary image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +edge + + +# name: +# type: sq_string +# elements: 1 +# length: 6148 + -- Function File: BW = edge (IM, METHOD) + -- Function File: BW = edge (IM, METHOD, ARG1, ARG2) + -- Function File: [BW, THRESH] = edge (...) + Detect edges in the given image using various methods. The first + input IM is the gray scale image in which edges are to be + detected. The second argument controls which method is used for + detecting the edges. The rest of the input arguments depend on the + selected method. The first output BW is a `logical' image + containing the edges. Most methods also returns an automatically + computed threshold as the second output. + + The METHOD input argument can any of the following strings (the + default value is "Sobel") + + "Sobel" + Finds the edges in IM using the Sobel approximation to the + derivatives. Edge points are defined as points where the + length of the gradient exceeds a threshold and is larger than + it's neighbours in either the horizontal or vertical + direction. The threshold is passed to the method in the third + input argument ARG1. If one is not given, a threshold is + automatically computed as 4*M, where M is the mean of the + gradient of the entire image. The optional 4th input argument + controls the direction in which the gradient is approximated. + It can be either "horizontal", "vertical", or "both" + (default). + + "Prewitt" + Finds the edges in IM using the Prewitt approximation to the + derivatives. This method works just like "Sobel" except a + different aproximation the gradient is used. + + "Roberts" + Finds the edges in IM using the Roberts approximation to the + derivatives. Edge points are defined as points where the + length of the gradient exceeds a threshold and is larger than + it's neighbours in either the horizontal or vertical + direction. The threshold is passed to the method in the third + input argument ARG1. If one is not given, a threshold is + automatically computed as 6*M, where M is the mean of the + gradient of the entire image. The optional 4th input argument + can be either "thinning" (default) or "nothinning". If it is + "thinning" a simple thinning procedure is applied to the edge + image such that the edges are only one pixel wide. If ARG2 is + "nothinning", this procedure is not applied. + + "Kirsch" + Finds the edges in IM using the Kirsch approximation to the + derivatives. Edge points are defined as points where the + length of the gradient exceeds a threshold and is larger than + it's neighbours in either the horizontal or vertical + direction. The threshold is passed to the method in the third + input argument ARG1. If one is not given, a threshold is + automatically computed as M, where M is the mean of the + gradient of the entire image. The optional 4th input argument + controls the direction in which the gradient is approximated. + It can be either "horizontal", "vertical", or "both" + (default). + + "LoG" + Finds edges in IM by convolving with the Laplacian of + Gaussian (LoG) filter, and finding zero crossings. Only zero + crossings where the filter response is larger than an + automatically computed threshold are retained. The threshold + is passed to the method in the third input argument ARG1. If + one is not given, a threshold is automatically computed as + 0.75*M, where M is the mean of absolute value of LoG filter + response. The optional 4th input argument sets the spread of + the LoG filter. By default this value is 2. + + "Zerocross" + Finds edges in the image IM by convolving it with the + user-supplied filter ARG2 and finding zero crossings larger + than the threshold ARG1. If ARG1 is [] a threshold is + computed as the mean value of the absolute filter response. + + "Canny" + Finds edges using the Canny edge detector. The optional third + input argument ARG1 sets the thresholds used in the + hysteresis thresholding. If ARG1 is a two dimensional vector + it's first element is used as the lower threshold, while the + second element is used as the high threshold. If, on the + other hand, ARG1 is a single scalar it is used as the high + threshold, while the lower threshold is 0.4*ARG1. The + optional 4th input argument ARG2 is the spread of the + low-pass Gaussian filter that is used to smooth the input + image prior to estimating gradients. By default this scale + parameter is 2. + + "Lindeberg" + Finds edges using in IM using the differential geometric + single-scale edge detector given by Tony Lindeberg. The + optional third input argument ARG1 is the scale (spread of + Gaussian filter) at which the edges are computed. By default + this 2. + + "Andy" + A.Adler's idea (c) 1999. Somewhat based on the canny method. + The steps are + 1. Do a Sobel edge detection and to generate an image at a + high and low threshold. + + 2. Edge extend all edges in the LT image by several pixels, + in the vertical, horizontal, and 45 degree directions. + Combine these into edge extended (EE) image. + + 3. Dilate the EE image by 1 step. + + 4. Select all EE features that are connected to features in + the HT image. + + The parameters for the method is given in a vector: + params(1)==0 or 4 or 8 + Perform x connected dilatation (step 3). + + params(2) + Dilatation coeficient (threshold) in step 3. + + params(3) + Length of edge extention convolution (step 2). + + params(4) + Coeficient of extention convolution in step 2. + defaults = [8, 1, 3, 3] + + + See also: fspecial, nonmax_supress + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Detect edges in the given image using various methods. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +entropy + + +# name: +# type: sq_string +# elements: 1 +# length: 582 + -- Function File: E = entropy (IM) + -- Function File: E = entropy (IM, NBINS) + Computes the entropy of an image. + + The entropy of the elements of the image IM is computed as + + E = -sum (P .* log2 (P) + + where P is the distribution of the elements of IM. The distribution + is approximated using a histogram with NBINS cells. If IM is + `logical' then two cells are used by default. For other classes + 256 cells are used by default. + + When the entropy is computed, zero-valued cells of the histogram + are ignored. + + See also: entropyfilt + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Computes the entropy of an image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +entropyfilt + + +# name: +# type: sq_string +# elements: 1 +# length: 1194 + -- Function File: E = entropyfilt (IM) + -- Function File: E = entropyfilt (IM, DOMAIN) + -- Function File: E = entropyfilt (IM, DOMAIN, PADDING, ...) + Computes the local entropy in a neighbourhood around each pixel in + an image. + + The entropy of the elements of the neighbourhood is computed as + + E = -sum (P .* log2 (P) + + where P is the distribution of the elements of IM. The distribution + is approximated using a histogram with NBINS cells. If IM is + `logical' then two cells are used. For other classes 256 cells are + used. + + When the entropy is computed, zero-valued cells of the histogram + are ignored. + + The neighbourhood is defined by the DOMAIN binary mask. Elements + of the mask with a non-zero value are considered part of the + neighbourhood. By default a 9 by 9 matrix containing only non-zero + values is used. + + At the border of the image, extrapolation is used. By default + symmetric extrapolation is used, but any method supported by the + `padarray' function can be used. Since extrapolation is used, one + can expect a lower entropy near the image border. + + See also: entropy, paddarray, stdfilt + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 76 +Computes the local entropy in a neighbourhood around each pixel in an +image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +erode + + +# name: +# type: sq_string +# elements: 1 +# length: 919 + -- Function File: BW2 = erode (BW1,SE) + -- Function File: BW2 = erode (BW1,SE,ALG) + -- Function File: BW2 = erode (BW1,SE,...,N) + Perform an erosion morphological operation on a binary image. + + BW2 = erosion(BW1, SE) returns a binary image with the result of + an erosion operation on BW1 using neighbour mask SE. + + For each point in BW1, erode searchs its neighbours (which are + defined by setting to 1 their in SE). If all neighbours are on + (1), then pixel is set to 1. If any is off (0) then it is set to 0. + + Center of SE is calculated using floor((size(SE)+1)/2). + + Pixels outside the image are considered to be 0. + + BW2 = erode(BW1, SE, alg) returns the result of a erosion operation + using algorithm ALG. Only 'spatial' is implemented at the moment. + + BW2 = erosion(BW1, SE, ..., n) returns the result of N erosion + operations on BW1. + + See also: dilate + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +Perform an erosion morphological operation on a binary image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +fchcode + + +# name: +# type: sq_string +# elements: 1 +# length: 778 + -- Function File: FCC = fchcode (BOUND) + Determine the Freeman chain code for a boundary. + + `fchcode' computes the Freeman chain code for the N-connected + boundary BOUND. N must be either 8 or 4. + + BOUND is a K-by-2 matrix containing the row/column coordinates of + points on the boundary. Optionally, the first point can be + repeated as the last point, resulting in a (K+1)-by-2 matrix. + + FCC is a structure containing the following elements. + + x0y0 = Row/column coordinates where the code starts (1-by-2) + fcc = Freeman chain code (1-by-K) + diff = First difference of fcc (1-by-K) + + The code uses the following directions. + + 3 2 1 + 4 . 0 + 5 6 7 + + See also: bwboundaries + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Determine the Freeman chain code for a boundary. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +fftconv2 + + +# name: +# type: sq_string +# elements: 1 +# length: 353 + -- Function File: fftconv2 (A, B, SHAPE) + -- Function File: fftconv2 (V1, V2, A, SHAPE) + Convolve 2 dimensional signals using the FFT. + + This method is faster but less accurate than CONV2 for large A and + B. It also uses more memory. A small complex component will be + introduced even if both A and B are real. + + See also: conv2 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Convolve 2 dimensional signals using the FFT. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +fspecial + + +# name: +# type: sq_string +# elements: 1 +# length: 3242 + -- Function File: FILTER = fspecial(TYPE, ARG1, ARG2) + Create spatial filters for image processing. + + TYPE determines the shape of the filter and can be + "average" + Rectangular averaging filter. The optional argument ARG1 + controls the size of the filter. If ARG1 is an integer N, a N + by N filter is created. If it is a two-vector with elements N + and M, the resulting filter will be N by M. By default a 3 by + 3 filter is created. + + "disk" + Circular averaging filter. The optional argument ARG1 + controls the radius of the filter. If ARG1 is an integer N, a + 2 N + 1 filter is created. By default a radius of 5 is used. + + "gaussian" + Gaussian filter. The optional argument ARG1 controls the size + of the filter. If ARG1 is an integer N, a N by N filter is + created. If it is a two-vector with elements N and M, the + resulting filter will be N by M. By default a 3 by 3 filter is + created. The optional argument ARG2 sets spread of the + filter. By default a spread of 0.5 is used. + + "log" + Laplacian of Gaussian. The optional argument ARG1 controls + the size of the filter. If ARG1 is an integer N, a N by N + filter is created. If it is a two-vector with elements N and + M, the resulting filter will be N by M. By default a 5 by 5 + filter is created. The optional argument ARG2 sets spread of + the filter. By default a spread of 0.5 is used. + + "laplacian" + 3x3 approximation of the laplacian. The filter is + approximated as + (4/(ALPHA+1))*[ALPHA/4, (1-ALPHA)/4, ALPHA/4; ... + (1-ALPHA)/4, -1, (1-ALPHA)/4; ... + ALPHA/4, (1-ALPHA)/4, ALPHA/4]; + where ALPHA is a number between 0 and 1. This number can be + controlled via the optional input argument ARG1. By default + it is 0.2. + + "unsharp" + Sharpening filter. The following filter is returned + (1/(ALPHA+1))*[-ALPHA, ALPHA-1, -ALPHA; ... + ALPHA-1, ALPHA+5, ALPHA-1; ... + -ALPHA, ALPHA-1, -ALPHA]; + where ALPHA is a number between 0 and 1. This number can be + controlled via the optional input argument ARG1. By default + it is 0.2. + + "motion" + Moion blur filter of width 1 pixel. The optional input + argument ARG1 controls the length of the filter, which by + default is 9. The argument ARG2 controls the angle of the + filter, which by default is 0 degrees. + + "sobel" + Horizontal Sobel edge filter. The following filter is returned + [ 1, 2, 1; + 0, 0, 0; + -1, -2, -1 ] + + "prewitt" + Horizontal Prewitt edge filter. The following filter is + returned + [ 1, 1, 1; + 0, 0, 0; + -1, -1, -1 ] + + "kirsch" + Horizontal Kirsch edge filter. The following filter is + returned + [ 3, 3, 3; + 3, 0, 3; + -5, -5, -5 ] + + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 +Create spatial filters for image processing. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +grayslice + + +# name: +# type: sq_string +# elements: 1 +# length: 504 + -- Function File: X = grayslice (I,N) + -- Function File: X = grayslice (I,V) + creates an indexed image X from an intensitiy image I using + multiple threshold levels. A scalar integer value N sets the + levels to + + 1 2 n-1 + -, -, ..., --- + n n n + + X = grayslice(I,5); + + For irregular threshold values a real vector V can be used. The + values must be in the range [0,1]. + + X = grayslice(I,[0.1,0.33,0.75,0.9]) + + See also: im2bw + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +creates an indexed image X from an intensitiy image I using multiple +threshold l + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +graythresh + + +# name: +# type: sq_string +# elements: 1 +# length: 542 + -- Function File: LEVEL= graythresh (I) + Compute global image threshold using Otsu's method. + + The output LEVEL is a global threshold (level) that can be used to + convert an intensity image to a binary image with `im2bw'. LEVEL + is a normalized intensity value that lies in the range [0, 1]. + + The function uses Otsu's method, which chooses the threshold to + minimize the intraclass variance of the black and white pixels. + + Color images are converted grayscale before LEVEL is computed. + + See also: im2bw + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Compute global image threshold using Otsu's method. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +histeq + + +# name: +# type: sq_string +# elements: 1 +# length: 282 + -- Function File: J = histeq (I, N) + Histogram equalization of a gray-scale image. The histogram + contains N bins, which defaults to 64. + + I: Image in double format, with values from 0.0 to 1.0 + + J: Returned image, in double format as well + + See also: imhist + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Histogram equalization of a gray-scale image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +hough_circle + + +# name: +# type: sq_string +# elements: 1 +# length: 776 + -- Function File: ACCUM = hough_circle (BW, R) + Perform the Hough transform for circles with radius R on the + black-and-white image BW. + + As an example, the following shows how to compute the Hough + transform for circles with radius 3 or 7 in the image IM + bw = edge(im); + accum = hough_circle(bw, [3, 7]); + If IM is an NxM image ACCUM will be an NxMx2 array, where + ACCUM(:,:,1) will contain the Hough transform for circles with + radius 3, and ACCUM(:,:,2) for radius 7. To find good circles you + now need to find local maximas in ACCUM, which can be a hard + problem. If you find a local maxima in ACCUM(row, col, 1) it + means that a good circle exists with center (row,col) and radius 3. + + See also: houghtf + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Perform the Hough transform for circles with radius R on the +black-and-white ima + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +houghtf + + +# name: +# type: sq_string +# elements: 1 +# length: 2203 + -- Function File: H = houghtf (BW) + -- Function File: H = houghtf (BW, METHOD) + -- Function File: H = houghtf (BW, METHOD, ARG) + Perform the Hough transform for lines or circles. + + The METHOD argument chooses between the Hough transform for lines + and circles. It can be either "line" (default) or "circle". + + *Line Detection* + + If METHOD is "line", the function will compute the Hough transform + for lines. A line is parametrised in R and THETA as + R = x*cos(THETA) + y*sin(THETA), + where R is distance between the line and the origin, while THETA + is the angle of the vector from the origin to this closest point. + The result H is an N by M matrix containing the Hough transform. + Here, N is the number different values of R that has been + attempted. This is computed as `2*diag_length - 1', where + `diag_length' is the length of the diagonal of the input image. M + is the number of different values of THETA. These can be set + through the third input argument ARG. This must be a vector of + real numbers, and is by default `pi*(-90:90)/180'. + + *Circle Detection* + + If METHOD is "circle" the function will compute the Hough + transform for circles. The circles are parametrised in R which + denotes the radius of the circle. The third input argument ARG + must be a real vector containing the possible values of R. If the + input image is N by M, then the result H will be an N by M by K + array, where K denotes the number of different values of R. + + As an example, the following shows how to compute the Hough + transform for circles with radius 3 or 7 in the image IM + bw = edge(im); + H = houghtf(bw, "circle", [3, 7]); + Here H will be an NxMx2 array, where H(:,:,1) will contain the + Hough transform for circles with radius 3, and H(:,:,2) for radius + 7. To find good circles you now need to find local maximas in H. + If you find a local maxima in H(row, col, 1) it means that a good + circle exists with center (row,col) and radius 3. One way to + locate maximas is to use the `immaximas' function. + + See also: hough_line, hough_circle, immaximas + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Perform the Hough transform for lines or circles. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +im2bw + + +# name: +# type: sq_string +# elements: 1 +# length: 213 + -- Function File: BW = im2bw (I,threshold) + -- Function File: BW = im2bw (X,CMAP,threshold) + Converts image data types to a black-white (binary) image. The + treshold value should be in the range [0,1]. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Converts image data types to a black-white (binary) image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +im2col + + +# name: +# type: sq_string +# elements: 1 +# length: 1681 + -- Function File: B = im2col (A, [M,N], BLOCK_TYPE) + -- Function File: B = im2col (A, [M,N]) + -- Function File: B = im2col (A, 'indexed', ...) + Rearranges image blocks into columns. + + `B=im2col(A, [m, n], blocktype)' rearranges blocks in A into + columns in a way that's determined by BLOCK_TYPE, which can take + the following values: + + `distinct' + Rearranges each distinct M-by-N block in image A into a + column of B. Blocks are scanned from left to right and the up + to bottom in A, and columns are added to B from left to + right. If A's size is not multiple M-by-N it is padded. + + `sliding' + Rearranges any M-by-N sliding block of A in a column of B, + without any padding, so only sliding blocks which can be + built using a full M-by-N neighbourhood are taken. In + consequence, B has M*N rows and (MM-M+1)*(NN-N+1) columns + (where MM and NN are the size of A). + + This case is thought to be used applying operations on + columns of B (for instance using sum(:)), so that result is a + 1-by-(MM-M+1)*(NN-N+1) vector, that is what the complementary + function `col2im' expects. + + `B=im2col(A,[m,n])' takes `distinct' as a default value for + BLOCK_TYPE. + + `B=im2col(A,'indexed',...)' will treat A as an indexed image, so + it will pad using 1 if A is double. All other cases (incluing + indexed matrices with uint8 and uint16 types and non-indexed + images) will use 0 as padding value. + + Any padding needed in 'distinct' processing will be added at right + and bottom edges of the image. + + See also: col2im + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 +Rearranges image blocks into columns. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +im2double + + +# name: +# type: sq_string +# elements: 1 +# length: 417 + -- Function File: IM2 = im2double(IM1) + Converts the input image to an image of class double. + + If the input image is of class double the output is unchanged. If + the input is of class uint8 the result will be converted to doubles + and divided by 255, and if the input is of class uint16 the image + will be converted to doubles and divided by 65535. + + See also: im2bw, im2uint16, im2uint8 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Converts the input image to an image of class double. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +im2uint16 + + +# name: +# type: sq_string +# elements: 1 +# length: 421 + -- Function File: IM2 = im2uint16(IM1) + Converts the input image to an image of class uint16. + + If the input image is of class uint16 the output is unchanged. If + the input is of class uint8 the result will be converted to uint16 + and multiplied by 257, and if the input is of class double the + image will be multiplied by 65535 and converted to uint16. + + See also: im2bw, im2double, im2uint8 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Converts the input image to an image of class uint16. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +im2uint8 + + +# name: +# type: sq_string +# elements: 1 +# length: 413 + -- Function File: IM2 = im2uint8(IM1) + Converts the input image to an image of class uint8. + + If the input image is of class uint8 the output is unchanged. If + the input is of class double the result will be multiplied by 255 + and converted to uint8, and if the input is of class uint16 the + image will be divided by 257 and converted to uint8. + + See also: im2bw, im2uint16, im2double + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +Converts the input image to an image of class uint8. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +imadjust + + +# name: +# type: sq_string +# elements: 1 +# length: 3594 + -- Function File: J = imadjust (I) + -- Function File: J = imadjust (I,[LOW_IN;HIGH_IN]) + -- Function File: J = imadjust (I,[LOW_IN;HIGH_IN],[LOW_OUT;HIGH_OUT]) + -- Function File: J = imadjust (..., GAMMA) + -- Function File: NEWMAP = imadjust (MAP, ...) + -- Function File: RGB_OUT = imadjust (RGB, ...) + Adjust image or colormap values to a specified range. + + `J=imadjust(I)' adjusts intensity image I values so that 1% of + data on lower and higher values (2% in total) of the image is + saturated; choosing for that the corresponding lower and higher + bounds (using `stretchlim') and mapping them to 0 and 1. J is an + image of the same size as I which contains mapped values. This is + equivalent to `imadjust(I,stretchlim(I))'. + + `J=imadjust(I,[low_in;high_in])' behaves as described but uses + LOW_IN and HIGH_IN values instead of calculating them. It maps + those values to 0 and 1; saturates values lower than first limit + to 0 and values higher than second to 1; and finally maps all + values between limits linearly to a value between 0 and 1. If `[]' + is passes as `[low_in;high_in]' value, then `[0;1]' is taken as a + default value. + + `J=imadjust(I,[low_in;high_in],[low_out;high_out])' behaves as + described but maps output values between LOW_OUT and HIGH_OUT + instead of 0 and 1. A default value `[]' can also be used for this + parameter, which is taken as `[0;1]'. + + `J=imadjust(...,gamma)' takes, in addition of 3 parameters + explained above, an extra parameter GAMMA, which specifies the + shape of the mapping curve between input elements and output + elements, which is linear (as taken if this parameter is omitted). + If GAMMA is above 1, then function is weighted towards lower + values, and if below 1, towards higher values. + + `newmap=imadjust(map,...)' applies a transformation to a colormap + MAP, which output is NEWMAP. This transformation is the same as + explained above, just using a map instead of an image. LOW_IN, + HIGH_IN, LOW_OUT, HIGH_OUT and GAMMA can be scalars, in which case + the same values are applied for all three color components of a + map; or it can be 1-by-3 vectors, to define unique mappings for + each component. + + `RGB_out=imadjust(RGB,...)' adjust RGB image RGB (a M-by-N-by-3 + array) the same way as specified in images and colormaps. Here + too LOW_IN, HIGH_IN, LOW_OUT, HIGH_OUT and GAMMA can be scalars or + 1-by-3 matrices, to specify the same mapping for all planes, or + unique mappings for each. + + The formula used to realize the mapping (if we omit saturation) is: + + `J = low_out + (high_out - low_out) .* ((I - low_in) / (high_in - + low_in)) .^ gamma;' + + *Compatibility notes:* + + * Prior versions of imadjust allowed `[low_in; high_in]' and + `[low_out; high_out]' to be row vectors. Compatibility with + this behaviour has been keeped, although preferred form is + vertical vector (since it extends nicely to 2-by-3 matrices + for RGB images and colormaps). + + * Previous version of imadjust, if `low_in>high_in' it + "negated" output. Now it is negated if `low_out>high_out', + for compatibility with MATLAB. + + * Class of I is not considered, so limit values are not + modified depending on class of the image, just treated "as + is". When Octave 2.1.58 is out, limits will be multiplied by + 255 for uint8 images and by 65535 for uint16 as in MATLAB. + + See also: stretchlim, brighten + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Adjust image or colormap values to a specified range. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +imclose + + +# name: +# type: sq_string +# elements: 1 +# length: 370 + -- Function File: B = imclose (A, SE) + Perform morphological closing on a given image. The image A must + be a grayscale or binary image, and SE must be a structuring + element. + + The closing corresponds to a dilation followed by an erosion of + the image, i.e. + B = imerode(imdilate(A, se), se); + + See also: imdilate, imerode, imclose + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Perform morphological closing on a given image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +imcomplement + + +# name: +# type: sq_string +# elements: 1 +# length: 344 + -- Function File: B = imcomplement(A) + Computes the complement image. Intuitively this corresponds to the + intensity of bright and dark regions being reversed. + + For binary images, the complement is computed as `!A', for floating + point images it is computed as `1 - A', and for integer images as + `intmax(class(A)) - A'. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Computes the complement image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +imdilate + + +# name: +# type: sq_string +# elements: 1 +# length: 328 + -- Function File: B = imdilate (A, SE) + Perform morphological dilation on a given image. + + The image A must be a grayscale or binary image, and SE must be a + structuring element. Both must have the same class, e.g., if A is a + logical matrix, SE must also be logical. + + See also: imerode, imopen, imclose + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Perform morphological dilation on a given image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +imdither + + +# name: +# type: sq_string +# elements: 1 +# length: 1030 + -- Function File: [Y, NEWMAP] = imdither (IMG) + -- Function File: [Y, NEWMAP] = imdither (IMG, COLORS) + -- Function File: [Y, NEWMAP] = imdither (IMG, COLORS, DITHTYPE) + -- Function File: [Y, NEWMAP] = imdither (IMG, MAP) + -- Function File: [Y, NEWMAP] = imdither (IMG, MAP, COLORS) + -- Function File: [Y, NEWMAP] = imdither(IMG, MAP, COLORS, DITHTYPE) + Reduce the number a colors of rgb or indexed image. + + Note: this requires the ImageMagick "convert" utility. get this + from www.imagemagick.org if required additional documentation of + options is available from the convert man page. + + where DITHTYPE is a value from list: + + * "None" + + * "FloydSteinberg" (default) + + * "Riemersma" + + COLORS is a maximum number of colors in result map + + TODO: Add facility to use already created colormap over "-remap" + option + + BUGS: This function return a 0-based indexed images when colormap + size is lower or equals to 256 like at cmunique code + + See also: cmunique + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Reduce the number a colors of rgb or indexed image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +imerode + + +# name: +# type: sq_string +# elements: 1 +# length: 327 + -- Function File: B = imerode (A, SE) + Perform morphological erosion on a given image. + + The image A must be a grayscale or binary image, and SE must be a + structuring element. Both must have the same class, e.g., if A is a + logical matrix, SE must also be logical. + + See also: imdilate, imopen, imclose + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Perform morphological erosion on a given image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +imfilter + + +# name: +# type: sq_string +# elements: 1 +# length: 1460 + -- Function File: J = imfilter(I, F) + -- Function File: J = imfilter(I, F, OPTIONS, ...) + Computes the linear filtering of the image I and the filter F. + The computation is performed using double precision floating point + numbers, but the class of the input image is preserved as the + following example shows. + I = 255*ones(100, 100, "uint8"); + f = fspecial("average", 3); + J = imfilter(I, f); + class(J) + => ans = uint8 + + The function also accepts a number of optional arguments that + control the details of the filtering. The following options is + currently accepted + `S' + If a scalar input argument is given, the image is padded with + this scalar as part of the filtering. The default value is 0. + + `"symmetric"' + The image is padded symmetrically. + + `"replicate"' + The image is padded using the border of the image. + + `"circular"' + The image is padded by circular repeating of the image + elements. + + `"same"' + The size of the output image is the same as the input image. + This is the default behaviour. + + `"full"' + Returns the full filtering result. + + `"corr"' + The filtering is performed using correlation. This is the + default behaviour. + + `"conv"' + The filtering is performed using convolution. + + See also: conv2, filter2, fspecial, padarray + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +Computes the linear filtering of the image I and the filter F. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +imginfo + + +# name: +# type: sq_string +# elements: 1 +# length: 376 + -- Function File: HW = imginfo (FILENAME) + -- Function File: [H, W] = imginfo (FILENAME) + Get image size from file FILENAME. + + The output is the size of the image + `H' + Height of image, in pixels. + + `W' + Width of image, in pixels. + + `HW = [H, W]' + Height and width of image. + + NOTE : imginfo relies on the 'convert' program. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Get image size from file FILENAME. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +imhist + + +# name: +# type: sq_string +# elements: 1 +# length: 213 + -- Function File: imhist (I,N) + -- Function File: imhist (I) + -- Function File: imhist (X,CMAP) + -- Function File: [N,X] = imhist (...) + Shows the histogram of an image using hist. + + See also: hist + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Shows the histogram of an image using hist. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +immaximas + + +# name: +# type: sq_string +# elements: 1 +# length: 1102 + -- Function File: [R, C] = immaximas (IM, RADIUS) + -- Function File: [R, C] = immaximas (IM, RADIUS, THRESH) + -- Function File: [R, C, ...] = immaximas (...) + -- Function File: [..., VAL] = immaximas (...) + Finds local spatial maximas of the given image. A local spatial + maxima is defined as an image point with a value that is larger + than all neighbouring values in a square region of width + 2*RADIUS+1. By default RADIUS is 1, such that a 3 by 3 + neighbourhood is searched. If the THRESH input argument is + supplied, only local maximas with a value greater than THRESH are + retained. + + The output vectors R and C contain the row-column coordinates of + the local maximas. The actual values are computed to sub-pixel + precision by fitting a parabola to the data around the pixel. If + IM is N-dimensional, then N vectors will be returned. + + If IM is N-dimensional, and N+1 outputs are requested, then the + last output will contain the image values at the maximas. Currently + this value is not interpolated. + + See also: ordfilt2, ordfiltn + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Finds local spatial maximas of the given image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +imnoise + + +# name: +# type: sq_string +# elements: 1 +# length: 490 + -- Function File: B = imnoise (A, TYPE) + Adds noise to image in A. + + `imnoise (A, 'gaussian' [, mean [, var]])' + additive gaussian noise: B = A + noise defaults to mean=0, + var=0.01 + + `imnoise (A, 'salt & pepper' [, density])' + lost pixels: A = 0 or 1 for density*100% of the pixels + defaults to density=0.05, or 5% + + `imnoise (A, 'speckle' [, var])' + multiplicative gaussian noise: B = A + A*noise defaults to + var=0.04 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 +Adds noise to image in A. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +imopen + + +# name: +# type: sq_string +# elements: 1 +# length: 369 + -- Function File: B = imopen (A, SE) + Perform morphological opening on a given image. The image A must + be a grayscale or binary image, and SE must be a structuring + element. + + The opening corresponds to an erosion followed by a dilation of + the image, i.e. + B = imdilate(imerode(A, se), se); + + See also: imdilate, imerode, imclose + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Perform morphological opening on a given image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +impad + + +# name: +# type: sq_string +# elements: 1 +# length: 986 + -- Function File: impad(A, XPAD, YPAD, [PADDING, [CONST]]) + Pad (augment) a matrix for application of image processing + algorithms. + + Pads the input image A with XPAD(1) elements from left, XPAD(2), + elements from right, YPAD(1) elements from above and YPAD(2) + elements from below. Values of padding elements are determined + from the optional arguments PADDING and CONST. PADDING is one of + + `"zeros"' + pad with zeros (default) + + `"ones"' + pad with ones + + `"constant"' + pad with a value obtained from the optional fifth argument + const + + `"symmetric"' + pad with values obtained from A so that the padded image + mirrors A starting from edges of A + + `"reflect"' + same as symmetric, but the edge rows and columns are not used + in the padding + + `"replicate"' + pad with values obtained from A so that the padded image + repeates itself in two dimensions + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +Pad (augment) a matrix for application of image processing algorithms. + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +imperspectivewarp + + +# name: +# type: sq_string +# elements: 1 +# length: 1744 + -- Function File: WARPED = imperspectivewarp(IM, P, INTERP, BBOX, + EXTRAPVAL) + -- Function File: [ WARPED, VALID] = imperspectivewarp(...) + Applies the spatial perspective homogeneous transformation P to + the image IM. The transformation matrix P must be a 3x3 + homogeneous matrix, or 2x2 or 2x3 affine transformation matrix. + + The resulting image WARPED is computed using an interpolation + method that can be selected through the INTERP argument. This must + be one of the following strings + `"nearest"' + Nearest neighbor interpolation. + + `"linear"' + `"bilinear"' + Bilinear interpolation. This is the default behavior. + + `"cubic"' + `"bicubic"' + Bicubic interpolation. + + By default the resulting image contains the entire warped image. + In some situation you only parts of the warped image. The argument + BBOX controls this, and can be one of the following strings + `"loose"' + The entire warped result is returned. This is the default + behavior. + + `"crop"' + The central part of the image of the same size as the input + image is returned. + + `"same"' + The size and coordinate system of the input image is keept. + + All values of the result that fall outside the original image will + be set to EXTRAPVAL. For images of class `double' EXTRAPVAL + defaults to `NA' and for other classes it defaults to 0. + + The optional output VALID is a matrix of the same size as WARPED + that contains the value 1 in pixels where WARPED contains an + interpolated value, and 0 in pixels where WARPED contains an + extrapolated value. + + See also: imremap, imrotate, imresize, imshear, interp2 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 77 +Applies the spatial perspective homogeneous transformation P to the +image IM. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +imremap + + +# name: +# type: sq_string +# elements: 1 +# length: 1386 + -- Function File: WARPED = imremap(IM, XI, YI) + -- Function File: WARPED = imremap(IM, XI, YI, INTERP, EXTRAPVAL) + -- Function File: [ WARPED, VALID ] = imremap(...) + Applies any geometric transformation to the image IM. + + The arguments XI and YI are lookup tables that define the resulting + image + WARPED(y,x) = IM(YI(y,x), XI(y,x)) + where IM is assumed to be a continuous function, which is achieved + by interpolation. Note that the image IM is expressed in a (X, + Y)-coordinate system and not a (row, column) system. + + The argument INTERP selects the used interpolation method, and + most be one of the following strings + `"nearest"' + Nearest neighbor interpolation. + + `"linear"' + `"bilinear"' + Bilinear interpolation. This is the default behavior. + + `"cubic"' + `"bicubic"' + Bicubic interpolation. + + All values of the result that fall outside the original image will + be set to EXTRAPVAL. For images of class `double' EXTRAPVAL + defaults to `NA' and for other classes it defaults to 0. + + The optional output VALID is a matrix of the same size as WARPED + that contains the value 1 in pixels where WARPED contains an + interpolated value, and 0 in pixels where WARPED contains an + extrapolated value. + + See also: imperspectivewarp, imrotate, imresize, imshear, interp2 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Applies any geometric transformation to the image IM. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +imresize + + +# name: +# type: sq_string +# elements: 1 +# length: 821 + -- Function File: B = imresize (A, M) + Scales the image A by a factor M using bicubic neighbour + interpolation. If M is less than 1 the image size will be reduced, + and if M is greater than 1 the image will be enlarged. + + -- Function File: B = imresize (A, M, INTERP) + Same as above except INTERP interpolation is performed instead of + using nearest neighbour. INTERP can be any interpolation method + supported by interp2. By default, bicubic interpolation is used. + + -- Function File: B = imresize (A, [MROW MCOL]) + Scales the image A to be of size MROWxMCOL. + + -- Function File: B = imresize (A, [MROW MCOL], INTERP) + Same as above except INTERP interpolation is performed. INTERP can + be any interpolation method supported by interp2. + + See also: imremap, imrotate, interp2 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +Scales the image A by a factor M using bicubic neighbour interpolation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +imrotate + + +# name: +# type: sq_string +# elements: 1 +# length: 2137 + -- Function File: imrotate(IMGPRE, THETA, METHOD, BBOX, EXTRAPVAL) + Rotation of a 2D matrix about its center. + + Input parameters: + + IMGPRE a gray-level image matrix + + THETA the rotation angle in degrees counterclockwise + + METHOD + "nearest" neighbor: fast, but produces aliasing effects + (default). + + "bilinear" interpolation: does anti-aliasing, but is slightly + slower. + + "bicubic" interpolation: does anti-aliasing, preserves edges + better than bilinear interpolation, but gray levels may + slightly overshoot at sharp edges. This is probably the best + method for most purposes, but also the slowest. + + "Fourier" uses Fourier interpolation, decomposing the + rotation matrix into 3 shears. This method often results in + different artifacts than homography-based methods. Instead + of slightly blurry edges, this method can result in ringing + artifacts (little waves near high-contrast edges). However, + Fourier interpolation is better at maintaining the image + information, so that unrotating will result in an image + closer to the original than the other methods. + + BBOX + "loose" grows the image to accommodate the rotated image + (default). + + "crop" rotates the image about its center, clipping any part + of the image that is moved outside its boundaries. + + EXTRAPVAL sets the value used for extrapolation. The default value + is `NA' for images represented using doubles, and 0 otherwise. + This argument is ignored of Fourier interpolation is used. + + Output parameters: + + IMGPOST the rotated image matrix + + H the homography mapping original to rotated pixel + coordinates. To map a coordinate vector c = [x;y] to its + rotated location, compute round((H * [c; 1])(1:2)). + + VALID a binary matrix describing which pixels are valid, + and which pixels are extrapolated. This output is + not available if Fourier interpolation is used. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +Rotation of a 2D matrix about its center. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +imrotate_Fourier + + +# name: +# type: sq_string +# elements: 1 +# length: 579 + -- Function File: imrotate(M, THETA, METHOD, BBOX) + Rotation of a 2D matrix. + + Applies a rotation of THETA degrees to matrix M. + + The METHOD argument is not implemented, and is only included for + compatibility with Matlab. This function uses Fourier + interpolation, decomposing the rotation matrix into 3 shears. + + BBOX can be either 'loose' or 'crop'. 'loose' allows the image to + grow to accomodate the rotated image. 'crop' keeps the same size + as the original, clipping any part of the image that is moved + outside the bounding box. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +Rotation of a 2D matrix. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +imshear + + +# name: +# type: sq_string +# elements: 1 +# length: 1176 + -- Function File: imshear (M, AXIS, ALPHA, BBOX) + Applies a shear to the image M. + + The argument M is either a matrix or an RGB image. + + AXIS is the axis along which the shear is to be applied, and can + be either 'x' or 'y'. For example, to shear sideways is to shear + along the 'x' axis. Choosing 'y' causes an up/down shearing. + + ALPHA is the slope of the shear. For an 'x' shear, it is the + horizontal shift (in pixels) applied to the pixel above the + center. For a 'y' shear, it is the vertical shift (in pixels) + applied to the pixel just to the right of the center pixel. + + NOTE: ALPHA does NOT need to be an integer. + + BBOX can be one of 'loose', 'crop' or 'wrap'. 'loose' allows the + image to grow to accomodate the new transformed image. 'crop' + keeps the same size as the original, clipping any part of the image + that is moved outside the bounding box. 'wrap' keeps the same + size as the original, but does not clip the part of the image that + is outside the bounding box. Instead, it wraps it back into the + image. + + If called with only 3 arguments, BBOX is set to 'loose' by default. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 +Applies a shear to the image M. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +imsmooth + + +# name: +# type: sq_string +# elements: 1 +# length: 7353 + -- Function File: J = imsmooth(I, NAME, OPTIONS) + Smooth the given image using several different algorithms. + + The first input argument I is the image to be smoothed. If it is + an RGB image, each color plane is treated separately. The + variable NAME must be a string that determines which algorithm will + be used in the smoothing. It can be any of the following strings + + "Gaussian" + Isotropic Gaussian smoothing. This is the default. + + "Average" + Smoothing using a rectangular averaging linear filter. + + "Disk" + Smoothing using a circular averaging linear filter. + + "Median" + Median filtering. + + "Bilateral" + Gaussian bilateral filtering. + + "Perona & Malik" + "Perona and Malik" + "P&M" + Smoothing using nonlinear isotropic diffusion as described by + Perona and Malik. + + "Custom Gaussian" + Gaussian smoothing with a spatially varying covariance matrix. + + In all algorithms the computation is done in double precision + floating point numbers, but the result has the same type as the + input. Also, the size of the smoothed image is the same as the + input image. + + *Isotropic Gaussian smoothing* + + The image is convolved with a Gaussian filter with spread SIGMA. + By default SIGMA is 0.5, but this can be changed. If the third + input argument is a scalar it is used as the filter spread. + + The image is extrapolated symmetrically before the convolution + operation. + + *Rectangular averaging linear filter* + + The image is convolved with N by M rectangular averaging filter. + By default a 3 by 3 filter is used, but this can e changed. If the + third input argument is a scalar N a N by N filter is used. If the + third input argument is a two-vector `[N, M]' a N by M filter is + used. + + The image is extrapolated symmetrically before the convolution + operation. + + *Circular averaging linear filter* + + The image is convolved with circular averaging filter. By default + the filter has a radius of 5, but this can e changed. If the third + input argument is a scalar R the radius will be R. + + The image is extrapolated symmetrically before the convolution + operation. + + *Median filtering* + + Each pixel is replaced with the median of the pixels in the local + area. By default, this area is 3 by 3, but this can be changed. If + the third input argument is a scalar N the area will be N by N, + and if it's a two-vector [N, M] the area will be N by M. + + The image is extrapolated symmetrically before the filtering is + performed. + + *Gaussian bilateral filtering* + + The image is smoothed using Gaussian bilateral filtering as + described by Tomasi and Manduchi [2]. The filtering result is + computed as + J(x0, y0) = k * SUM SUM I(x,y) * w(x, y, x0, y0, I(x0,y0), I(x,y)) + x y + where `k' a normalisation variable, and + w(x, y, x0, y0, I(x0,y0), I(x,y)) + = exp(-0.5*d([x0,y0],[x,y])^2/SIGMA_D^2) + * exp(-0.5*d(I(x0,y0),I(x,y))^2/SIGMA_R^2), + with `d' being the Euclidian distance function. The two paramteres + SIGMA_D and SIGMA_R control the amount of smoothing. SIGMA_D is + the size of the spatial smoothing filter, while SIGMA_R is the size + of the range filter. When SIGMA_R is large the filter behaves + almost like the isotropic Gaussian filter with spread SIGMA_D, and + when it is small edges are preserved better. By default SIGMA_D is + 2, and SIGMA_R is 10/255 for floating points images (with integer + images this is multiplied with the maximal possible value + representable by the integer class). + + The image is extrapolated symmetrically before the filtering is + performed. + + *Perona and Malik* + + The image is smoothed using nonlinear isotropic diffusion as + described by Perona and Malik [1]. The algorithm iteratively + updates the image using + + I += lambda * (g(dN).*dN + g(dS).*dS + g(dE).*dE + g(dW).*dW) + + where `dN' is the spatial derivative of the image in the North + direction, and so forth. The function G determines the behaviour + of the diffusion. If g(x) = 1 this is standard isotropic + diffusion. + + The above update equation is repeated ITER times, which by default + is 10 times. If the third input argument is a positive scalar, + that number of updates will be performed. + + The update parameter LAMBDA affects how much smoothing happens in + each iteration. The algorithm can only be proved stable is LAMBDA + is between 0 and 0.25, and by default it is 0.25. If the fourth + input argument is given this parameter can be changed. + + The function G in the update equation determines the type of the + result. By default `G(D) = exp(-(D./K).^2)' where K = 25. This + choice gives privileges to high-contrast edges over low-contrast + ones. An alternative is to set `G(D) = 1./(1 + (D./K).^2)', which + gives privileges to wide regions over smaller ones. The choice of G + can be controlled through the fifth input argument. If it is the + string `"method1"', the first mentioned function is used, and if + it is "METHOD2" the second one is used. The argument can also be a + function handle, in which case the given function is used. It + should be noted that for stability reasons, G should return values + between 0 and 1. + + The following example shows how to set `G(D) = exp(-(D./K).^2)' + where K = 50. The update will be repeated 25 times, with LAMBDA = + 0.25. + + G = @(D) exp(-(D./50).^2); + J = imsmooth(I, "p&m", 25, 0.25, G); + + *Custom Gaussian Smoothing* + + The image is smoothed using a Gaussian filter with a spatially + varying covariance matrix. The third and fourth input arguments + contain the Eigenvalues of the covariance matrix, while the fifth + contains the rotation of the Gaussian. These arguments can be + matrices of the same size as the input image, or scalars. In the + last case the scalar is used in all pixels. If the rotation is not + given it defaults to zero. + + The following example shows how to increase the size of an Gaussian + filter, such that it is small near the upper right corner of the + image, and large near the lower left corner. + + [LAMBDA1, LAMBDA2] = meshgrid (linspace (0, 25, columns (I)), linspace (0, 25, rows (I))); + J = imsmooth (I, "Custom Gaussian", LAMBDA1, LAMBDA2); + + The implementation uses an elliptic filter, where only + neighbouring pixels with a Mahalanobis' distance to the current + pixel that is less than 3 are used to compute the response. The + response is computed using double precision floating points, but + the result is of the same class as the input image. + + *References* + + [1] P. Perona and J. Malik, "Scale-space and edge detection using + anisotropic diffusion", IEEE Transactions on Pattern Analysis and + Machine Intelligence, 12(7):629-639, 1990. + + [2] C. Tomasi and R. Manduchi, "Bilateral Filtering for Gray and + Color Images", Proceedings of the 1998 IEEE International + Conference on Computer Vision, Bombay, India. + + See also: imfilter, fspecial + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Smooth the given image using several different algorithms. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +imtophat + + +# name: +# type: sq_string +# elements: 1 +# length: 695 + -- Function File: B = imtophat (A, SE) + -- Function File: B = imtophat (A, SE, TYPE) + Perform morphological top hat filtering. + + The image A must be a grayscale or binary image, and SE must be a + structuring element. Both must have the same class, e.g., if A is a + logical matrix, SE must also be logical. + + TYPE defines the type of top hat transform. To perform a white, or + opening, top-hat transform its value must be `open' or `white'. To + perform a black, or closing, top-hat transform its value must be + `close' or `black'. If TYPE is not specified, it performs a white + top-hat transform. + + See also: imerode, imdilate, imopen, imclose, mmgradm + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Perform morphological top hat filtering. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +imtranslate + + +# name: +# type: sq_string +# elements: 1 +# length: 273 + -- Function File: Y = imtranslate (M, X, Y [, BBOX]) + Translate a 2D image by (x,y) using Fourier interpolation. + + M is a matrix, and is translated to the right by X pixels and + translated up by Y pixels. + + BBOX can be either 'crop' or 'wrap' (default). + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Translate a 2D image by (x,y) using Fourier interpolation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +iradon + + +# name: +# type: sq_string +# elements: 1 +# length: 2228 + -- Function: RECON = iradon (PROJ, THETA, INTERP, FILTER, SCALING, + OUTPUT_SIZE) + Performs filtered back-projection on the projections in PROJ to + reconstruct an approximation of the original image. + + PROJ should be a matrix whose columns are projections of an image + (or slice). Each element of THETA is used as the angle (in + degrees) that the corresponding column of PROJ was projected at. + If THETA is omitted, it is assumed that projections were taken at + evenly spaced angles between 0 and 180 degrees. THETA can also be + a scalar, in which case it is taken as the angle between + projections if more than one projection is provided. + + INTERP determines the type of interpolation that is used in the + back-projection. It must be one of the types accepted by + `interp1', and defaults to 'Linear' if it is omitted. + + FILTER and SCALING determine the type of rho filter to apply. See + the help for `rho_filter' for their use. + + OUTPUT_SIZE sets the edge length of the output image (it is always + square). This argument does not scale the image. If it is + omitted, the length is taken to be + 2 * floor (size (proj, 1) / (2 * sqrt (2))). + + If PROJ was obtained using `radon', there is no guarantee that the + reconstructed image will be exactly the same size as the original. + + -- Function: [RECON, FILT] = iradon (...) + This form also returns the filter frequency response in the vector + FILT. + + Performs filtered back-projection in order to reconstruct an image +based on its projections. + + Filtered back-projection is the most common means of reconstructing +images from CT scans. It is a two step process: First, each of the +projections is filtered with a `rho filter', so named due to its +frequency domain definition, which is simply |rho|, where rho is the +radial axis in a polar coordinate system. Second, the filtered +projections are each `smeared' across the image space. This is the +back-projection part. + + Usage example: + P = phantom (); + projections = radon (P, 1:179); + reconstruction = iradon (filtered_projections, 1:179, 'Spline', 'Hann'); + figure, imshow (reconstruction, []) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Performs filtered back-projection on the projections in PROJ to +reconstruct an a + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +isbw + + +# name: +# type: sq_string +# elements: 1 +# length: 128 + -- Function File: BOOL = isbw (BW) + Returns true for a black-white (binary) image. All values must be + either 0 or 1 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Returns true for a black-white (binary) image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +isgray + + +# name: +# type: sq_string +# elements: 1 +# length: 277 + -- Function File: BOOL = isgray (I) + Returns true for an gray-scale intensity image. An variable is a + gray scale image if it is 2-dimensional matrix, and + * is of class double and all values are in the range [0, 1], or + + * is of class uint8 or uint16. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Returns true for an gray-scale intensity image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +isind + + +# name: +# type: sq_string +# elements: 1 +# length: 148 + -- Function File: BOOL = isind (X) + Returns true for an index image. All index values must be + intergers and greater than or equal to 1. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 +Returns true for an index image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +isrgb + + +# name: +# type: sq_string +# elements: 1 +# length: 607 + -- Function File: FLAG = isrgb (A) + Returns true if parameter is a RGB image. + + `flag=isrgb(A)' returns 1 if A is a RGB image and 0 if not. + + To the decide `isrgb' uses the follow algorithm: + * If A is of class double then it checks if all values are + between 0 and 1, and if size is m-by-n-by-3. + + * If A is of class uint16, uint8 or logical then it checks is + m-by-n-by-3. + + *Compatibility notes:* + + Information needed on whether MATLAB accepts logical arrays as RGB + images (now this functions accepts them if they are m-by-n-by-3 + arrays. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +Returns true if parameter is a RGB image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +label2rgb + + +# name: +# type: sq_string +# elements: 1 +# length: 1740 + -- Function File: RGB = label2rgb(L) + -- Function File: RGB = label2rgb(L, MAP) + -- Function File: RGB = label2rgb(L, MAP, BACKGROUND) + -- Function File: RGB = label2rgb(L, MAP, BACKGROUND, ORDER) + Converts a labeled image to an RGB image. + + label2rgb(L) returns a color image, where the background color + (the background is the zero-labeled pixels) is white, and all other + colors come from the `jet' colormap. + + label2rgb(L, MAP) uses colors from the given colormap. MAP can be + * A string containing the name of a function to be called to + produce a colormap. The default value is "jet". + + * A handle to a function to be called to produce a colormap. + + * A N-by-3 colormap matrix. + + label2rgb(L, MAP, BACKGROUND) sets the background color. + BACKGROUND can be a 3-vector corresponding to the wanted RGB + color, or one of the following strings + `"b"' + The background color will be blue. + + `"c"' + The background color will be cyan. + + `"g"' + The background color will be green. + + `"k"' + The background color will be black. + + `"m"' + The background color will be magenta. + + `"r"' + The background color will be red. + + `"w"' + The background color will be white. This is the default + behavior. + + `"y"' + The background color will be yellow. + + label2rgb(L, MAP, BACKGROUND, ORDER) allows for random + permutations of the colormap. ORDER must be one of the following + strings + `"noshuffle"' + The colormap is not permuted in any ways. This is the default. + + `"shuffle"' + The used colormap is permuted randomly. + + See also: bwlabel, ind2rgb + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +Converts a labeled image to an RGB image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +makelut + + +# name: +# type: sq_string +# elements: 1 +# length: 819 + -- Function File: LUT = makelut (FUN,N) + -- Function File: LUT = makelut (FUN,N,P1,P2,...) + Create a lookup table which can be used by applylut. + + lut = makelut(fun,n) returns a vector which can be used by applylut + as a lookup table. + + FUN can be a function object as created by inline, or simply a + string which contains the name of a function. FUN should accept a + N-by-N matrix whose elements are binary (0 or 1) and returns an + scalar (actually anything suitable to be included in a vector). + + makelut calls FUN with all possible matrices and builds a vector + with its result, suitable to be used by applylut. The length of + this vector is 2^(N^2), so 16 for 2-by-2 and 512 for 3-by-3. + + makelut also passes parameters P1, P2, .... to FUN. + + See also: applylut + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +Create a lookup table which can be used by applylut. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +mat2gray + + +# name: +# type: sq_string +# elements: 1 +# length: 92 + -- Function File: I = mat2gray (M,[min max]) + Converts a matrix to a intensity image. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 +Converts a matrix to a intensity image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +mean2 + + +# name: +# type: sq_string +# elements: 1 +# length: 141 + -- Function File: M = mean2 (I) + Returns the mean value for a 2d real type matrix. Uses + `mean(I(:))' + + See also: std2, mean + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Returns the mean value for a 2d real type matrix. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +medfilt2 + + +# name: +# type: sq_string +# elements: 1 +# length: 533 + -- Function File: medfilt2(A, [DOMAIN, PADDING]) + Two dimensional median filtering. + + Replaces elements of A with the median of their neighbours defined + by true elements of logical matrix DOMAIN. The default DOMAIN is a + 3 by 3 matrix with all elements equal to 1. If DOMAIN is 1 by 2 + row vector, the domain matrix will be logical(ones(DOMAIN(2), + DOMAIN(1))). + + Optional variable PADDING defines the padding used in augmenting + the borders of A. See impad for details. + + See also: ordfilt2 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Two dimensional median filtering. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +mmgradm + + +# name: +# type: sq_string +# elements: 1 +# length: 598 + -- Function File: GRAD = mmgradm(A, SE) + -- Function File: GRAD = mmgradm(A, SE_DIL, SE_ERO) + Calculates the morphological gradient GRAD of a given image A. + + In the first form, the same structuring element SE is used for + dilation and erosion. In the second form, SE_DIL and SE_ERO are the + corresponding structuring elements used for dilation and erosion + + The image A must be a grayscale or a binary image. + + The morphological gradient of a image corresponds to its erosion + subtracted to its dilation. + + See also: imerode, imdilate, imopen, imclose, imtophat + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +Calculates the morphological gradient GRAD of a given image A. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +nlfilter + + +# name: +# type: sq_string +# elements: 1 +# length: 1004 + -- Function File: B = nlfilter (A, [M,N], FUN) + -- Function File: B = nlfilter (A, [M,N], FUN, ...) + -- Function File: B = nlfilter (A,'indexed', ...) + Processes image in sliding blocks using user-supplied function. + + `B=nlfilter(A,[m,n],fun)' passes sliding M-by-N blocks to + user-supplied function FUN. A block is build for every pixel in A, + such as it is centered within the block. FUN must return a + scalar, and it is used to create matrix B. NLFILTER pads the + M-by-N block at the edges if necessary. + + Center of block is taken at ceil([M,N]/2). + + `B=nlfilter(A,[m,n],fun,...)' behaves as described above but + passes extra parameters to function FUN. + + `B=nlfilter(A,'indexed',...)' assumes that A is an indexed image, + so it pads the image using proper value: 0 for uint8 and uint16 + images and 1 for double images. Keep in mind that if 'indexed' is + not specified padding is always done using 0. + + See also: colfilt, blkproc, inline + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Processes image in sliding blocks using user-supplied function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +ordfilt2 + + +# name: +# type: sq_string +# elements: 1 +# length: 690 + -- Function File: ordfilt2(A, NTH, DOMAIN, [S, PADDING]) + Two dimensional ordered filtering. + + Ordered filter replaces an element of A with the NTH element of + the sorted set of neighbours defined by the logical (boolean) + matrix DOMAIN. Neighbour elements are selected to the sort if the + corresponding element in the DOMAIN matrix is true. + + The optional variable S is a matrix of size(DOMAIN). Values of S + corresponding to nonzero values of domain are added to values + obtained from A when doing the sorting. + + Optional variable PADDING determines how the matrix A is padded + from the edges. See impad for details. + + See also: medfilt2 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Two dimensional ordered filtering. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +ordfiltn + + +# name: +# type: sq_string +# elements: 1 +# length: 705 + -- Function File: ordfiltn(A, NTH, DOMAIN, [S, PADDING]) + Two dimensional ordered filtering. + + Ordered filter replaces an element of A with the NTH element of + the sorted set of neighbours defined by the logical (boolean) + matrix DOMAIN. Neighbour elements are selected to the sort if the + corresponding element in the DOMAIN matrix is true. + + The optional variable S is a matrix of size(DOMAIN). Values of S + corresponding to nonzero values of domain are added to values + obtained from A when doing the sorting. + + Optional variable PADDING determines how the matrix A is padded + from the edges. See `padarray' for details. + + See also: ordfilt2, padarray + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Two dimensional ordered filtering. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +padarray + + +# name: +# type: sq_string +# elements: 1 +# length: 1878 + -- Function File: B = padarray (A,PADSIZE) + -- Function File: B = padarray (A,PADSIZE,PADVAL) + -- Function File: B = padarray (A,PADSIZE,PADVAL,DIRECTION) + Pads an array in a configurable way. + + B = padarray(A,padsize) pads an array A with zeros, where PADSIZE + defines the amount of padding to add in each dimension (it must be + a vector of positive integers). + + Each component of PADSIZE defines the number of elements of + padding that will be added in the corresponding dimension. For + instance, [4,5] adds 4 elements of padding in first dimension + (vertical) and 5 in second dimension (horizontal). + + B = padarray(A,padsize,padval) pads A using the value specified by + PADVAL. PADVAL can be a scalar or a string. Possible values are: + + 0 + Pads with 0 as described above. This is the default behaviour. + + Scalar + Pads using PADVAL as a padding value. + + "Circular" + Pads with a circular repetition of elements in A (similar to + tiling A). + + "Replicate" + Pads replicating values of A which are at the border of the + array. + + "Symmetric" + Pads with a mirror reflection of A. + + "Reflect" + Same as "symmetric", but the borders are not used in the + padding. + + B = padarray(A,padsize,padval,direction) pads A defining the + direction of the pad. Possible values are: + + "Both" + For each dimension it pads before the first element the number + of elements defined by PADSIZE and the same number again after + the last element. This is the default value. + + "Pre" + For each dimension it pads before the first element the + number of elements defined by PADSIZE. + + "Post" + For each dimension it pads after the last element the number + of elements defined by PADSIZE. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Pads an array in a configurable way. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +phantom + + +# name: +# type: sq_string +# elements: 1 +# length: 2255 + -- Function: P = phantom ('Shepp-Logan', N) + Produces the Shepp-Logan phantom, with size N x N. If N is + omitted, 256 is used. + + -- Function: P = phantom ('Modified Shepp-Logan', N) + Produces a modified version of the Shepp-Logan phantom which has + higher contrast than the original, with size N x N. If N is + omitted, 256 is used. + + -- Function: P = phantom (ELLIPSES, N) + Produces a custom phantom using the ellipses described in ELLIPSES. + Each row of ELLIPSES describes one ellipse, and must have 6 + columns: {I, a, b, x0, y0, phi}: + I + is the additive intensity of the ellipse + + a + is the length of the major axis + + b + is the length of the minor axis + + x0 + is the horizontal offset of the centre of the ellipse + + y0 + is the vercal offset of the centre of the ellipse + + phi + is the counterclockwise rotation of the ellipse in degrees, + measured as the angle between the x axis and the ellipse + major axis. + + + The image bounding box in the algorithm is {[-1, -1], [1, 1]}, so + the values of a, b, x0, y0 should all be specified with this in + mind. If N is omitted, 256 is used. + + -- Function: P = phantom (N) + Creates a modified Shepp-Logan phantom with size N x N. + + -- Function: P = phantom () + Creates a modified Shepp-Logan phantom with size 256 x 256. + + Create a Shepp-Logan or modified Shepp-Logan phantom. + + A phantom is a known object (either real or purely mathematical) that +is used for testing image reconstruction algorithms. The Shepp-Logan +phantom is a popular mathematical model of a cranial slice, made up of +a set of ellipses. This allows rigorous testing of computed tomography +(CT) algorithms as it can be analytically transformed with the radon +transform (see the function `radon'). + + Example: + + P = phantom (512); + imshow (P, []); + + References: + + Shepp, L. A.; Logan, B. F.; Reconstructing Interior Head Tissue +from X-Ray Transmissions, IEEE Transactions on Nuclear Science, Feb. +1974, p. 232. + + Toft, P.; "The Radon Transform - Theory and Implementation", Ph.D. +thesis, Department of Mathematical Modelling, Technical University of +Denmark, June 1996. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Produces the Shepp-Logan phantom, with size N x N. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +poly2mask + + +# name: +# type: sq_string +# elements: 1 +# length: 1182 + -- Function File: BW = poly2mask (X,Y,M,N) + Convert a polygon to a region mask. + + BW=poly2mask(x,y,m,n) converts a polygon, specified by a list of + vertices in X and Y and returns in a M-by-N logical mask BW the + filled polygon. Region inside the polygon is set to 1, values + outside the shape are set to 0. + + X and Y should always represent a closed polygon, first and last + points should be coincident. If they are not poly2mask will close + it for you. If X or Y are fractional they are nearest integer. + + If all the polygon or part of it falls outside the masking area + (1:m,1:n), it is discarded or clipped. + + This function uses scan-line polygon filling algorithm as described + in http://www.cs.rit.edu/~icss571/filling/ with some minor + modifications: capability of clipping and scan order, which can + affect the results of the algorithm (algorithm is described not to + reach ymax, xmax border when filling to avoid enlarging shapes). In + this function we scan the image backwards (we begin at ymax and end + at ymin), and we don't reach ymin, xmin, which we believe should be + compatible with MATLAB. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Convert a polygon to a region mask. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +qtdecomp + + +# name: +# type: sq_string +# elements: 1 +# length: 2390 + -- Function File: S = qtdecomp (I) + -- Function File: S = qtdecomp (I,THRESHOLD) + -- Function File: S = qtdecomp (I,THRESHOLD,MINDIM) + -- Function File: S = qtdecomp (I,THRESHOLD,[MINDIM MAXDIM]) + -- Function File: S = qtdecomp (I,FUN) + -- Function File: S = qtdecomp (I,FUN,P1,P2,...) + Performs quadtree decomposition. + + qtdecomp decomposes a square image I into four equal-sized blocks. + Then it performs some kind of test on each block to decide if it + should decompose them further. This process is repeated + iteratively until there's no block left to be decomposed. + + Note that blocks are not decomposed if their dimensions are not + even. + + The output is a sparse matrix whose non-zero elements determine the + position of the block (the element is at top-left position in the + block) and size of each block (the value of the element determines + length of a side of the square-shaped block). + + S = qtdecomp(I) decomposes an intensity image I as described + above. By default it doesn't split a block if all elements are + equal. + + S = qtdecomp(I, threshold) decomposes an image as decribed, but + only splits a block if the maximum value in the block minus the + minimum value is greater than THRESHOLD, which is a value between + 0 and 1. If I is of class uint8, THRESHOLD is multiplied by 255 + before use. Also, ifI is of class uint16, THRESHOLD is multiplied + by 65535. + + S = qtdecomp(I, threshold, mindim) decomposes an image using the + THRESHOLD as just described, but doesn't produce blocks smaller + than mindim. + + S = qtdecomp(I, threshold, [mindim maxdim]) decomposes an image as + described, but produces blocks that can't be bigger than maxdim. It + decomposes to maxdim even if it isn't needed if only THRESHOLD was + considered. + + S = qtdecomp(I, fun) decomposes an image I and uses function FUN + to decide if a block should be splitted or not. FUN is called with + a m-by-m-by-k array of m-by-m blocks to be considered, and should + return a vector of size k, whose elements represent each block in + the stacked array. FUN sets the corresponding value to 1 if the + block should be split, and 0 otherwise. + + S = qtdecomp(I, fun, ...) behaves as qtdecomp(I, fun) but passes + extra parameters to FUN. + + See also: qtgetblk, qtsetblk + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 +Performs quadtree decomposition. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +qtgetblk + + +# name: +# type: sq_string +# elements: 1 +# length: 904 + -- Function File: [VALS] = qtgetblk (I,S,DIM) + -- Function File: [VALS,IDX] = qtgetblk (I,S,DIM) + -- Function File: [VALS,R,C] = qtgetblk (I,S,DIM) + Obtain block values from a quadtree decomposition. + + [vals]=qtgetblk(I,S,dim) returns a dim-by-dim-by-k array in VALS + which contains the dim-by-dim blocks in the quadtree decomposition + (S, which is returned by qtdecomp) of I. If there are no blocks, + an empty matrix is returned. + + [vals,idx]=qtgetblk(I,S,dim) returns VALS as described above. In + addition, it returns IDX, a vector which contains the linear + indices of the upper left corner of each block returned (the same + result as find(full(S)==dim)). + + [vals,r,c]=qtgetblk(I,S,dim) returns VALS as described, and two + vectors, R and C, which contain the row and column coordinates of + the blocks returned. + + See also: qtdecomp, qtsetblk + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Obtain block values from a quadtree decomposition. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +qtsetblk + + +# name: +# type: sq_string +# elements: 1 +# length: 412 + -- Function File: J = qtsetblk (I,S,DIM,VALS) + Set block values in a quadtree decomposition. + + J=qtsetblk(I,S,dim,vals) sets all the DIM-by-DIM blocks in the + quadtree decomposition (S returned by qtdecomp) of I to DIM-by-DIM + blocks in VALS, which is itself a DIM-by-DIM-by-k array. k is the + number of DIM-by-DIM blocks in the quadtree decomposition. + + See also: qtdecomp, qtgetblk + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Set block values in a quadtree decomposition. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +radon + + +# name: +# type: sq_string +# elements: 1 +# length: 346 + -- Function File: [RT,XP] = radon(I, THETA) + -- Function File: [RT,XP] = radon(I) + Calculates the 2D-Radon transform of the matrix I at angles given + in THETA. To each element of THETA corresponds a column in RT. + The variable XP represents the x-axis of the rotated coordinate. + If THETA is not defined, then 0:179 is assumed. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 +Calculates the 2D-Radon transform of the matrix I at angles given in +THETA. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +rangefilt + + +# name: +# type: sq_string +# elements: 1 +# length: 865 + -- Function File: R = rangefilt (IM) + -- Function File: R = rangefilt (IM, DOMAIN) + -- Function File: R = rangefilt (IM, DOMAIN, PADDING, ...) + Computes the local intensity range in a neighbourhood around each + pixel in an image. + + The intensity range of the pixels of a neighbourhood is computed as + + R = max (X) - min (X) + + where X is the value of the pixels in the neighbourhood, + + The neighbourhood is defined by the DOMAIN binary mask. Elements + of the mask with a non-zero value are considered part of the + neighbourhood. By default a 3 by 3 matrix containing only non-zero + values is used. + + At the border of the image, extrapolation is used. By default + symmetric extrapolation is used, but any method supported by the + `padarray' function can be used. + + See also: paddarray, entropyfilt, stdfilt + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Computes the local intensity range in a neighbourhood around each pixel +in an im + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +readexif + + +# name: +# type: sq_string +# elements: 1 +# length: 672 + -- Function File: EXIF = readexif(FILENAME, THUMBNAIL) + Read EXIF information from JPEG image data. + + The exif tag information are returned in the EXIF data structure. + Integer ratios are expressed as column vector. For example, a + focal number of 2.8 is expressed as FNumber=[28; 10]. Otherwise + all data are returned by the type as specified in the IFD + structures. + + The filename for the thumbnail image is optional. If given, the + thumbnail jpeg image will be stored to file THUMBNAIL. + + Reference: JEITA CP-3451, Exchangeable image file format for + digital still cameras: Exif Version 2.2 + + See also: imwrite, imfinfo + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Read EXIF information from JPEG image data. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +regionprops + + +# name: +# type: sq_string +# elements: 1 +# length: 2719 + -- Function File: PROPS = regionprops (BW) + -- Function File: PROPS = regionprops (BW, PROPERTIES, ...) + Compute object properties in a binary image. + + `regionprops' computes various properties of the individual + objects (as identified by `bwlabel') in the binary image BW. The + result is a structure array containing an entry per property per + object. + + The following properties can be computed. + + "Area" + The number of pixels in the object. + + "EulerNumber" + "euler_number" + The Euler number of the object (see `bweuler' for details). + + "BoundingBox" + "bounding_box" + The bounding box of the object. This is represented as a + 4-vector where the first two entries are the x and y + coordinates of the upper left corner of the bounding box, and + the two last entries are the width and the height of the box. + + "Extent" + The area of the object divided by the area of the bounding + box. + + "Perimeter" + The length of the boundary of the object. + + "Centroid" + The center coordinate of the object. + + "PixelIdxList" + "pixel_idx_list" + The indices of the pixels in the object. + + "FilledArea" + "filled_area" + The area of the object including possible holes. + + "PixelList" + "pixel_list" + The actual pixel values inside the object. This is only + useful for grey scale images. + + "FilledImage" + "filled_image" + A binary image with the same size as the object's bounding + box that contains the object with all holes removed. + + "Image" + An image with the same size as the bounding box that contains + the original pixels. + + "MaxIntensity" + "max_intensity" + The maximum intensity inside the object. + + "MinIntensity" + "min_intensity" + The minimum intensity inside the object. + + "WeightedCentroid" + "weighted_centroid" + The centroid of the object where pixel values are used as + weights. + + "MeanIntensity" + "mean_intensity" + The mean intensity inside the object. + + "PixelValues" + "pixel_values" + The pixel values inside the object represented as a vector. + + The requested properties can either be specified as several input + arguments or as a cell array of strings. As a short-hand it is + also possible to give the following strings as arguments. + + "basic" + The following properties are computed: "Area", "Centroid" and + "BoundingBox". + + "all" + All properties are computed. + + If no properties are given, basic is assumed. + + See also: bwlabel, bwperim, bweuler + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 +Compute object properties in a binary image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +rgb2gray + + +# name: +# type: sq_string +# elements: 1 +# length: 415 + -- Function File: GRAY = rgb2gray (RGB) + Converts an RGB image to a gray scale image, or a color map to a + gray map. + + If the input is an RGB image, the conversion to a gray image is + computed as the mean value of the color channels. + + If the input is a color map it is converted into the YIQ space of + ntsc. The luminance value (Y) is taken to create a gray color map. + R = G = B = Y + + + + +# name: +# type: sq_string +# elements: 1 +# length: 74 +Converts an RGB image to a gray scale image, or a color map to a gray +map. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +rgb2ycbcr + + +# name: +# type: sq_string +# elements: 1 +# length: 398 + -- Function File: B = rgb2ycbcr(A) + Perform colour convertion from RGB to YCbCr on a given image. + + The image A must be a NxMx3 image. The conversion The convertion + changes the image from the RGB color model to YCbCr e.g. + imOut = rgb2ycbcr(imIn); + Currently this function only works with `uint8' and will always + return an `uint8' matrix. + + See also: cmunique + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +Perform colour convertion from RGB to YCbCr on a given image. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +rgbplot + + +# name: +# type: sq_string +# elements: 1 +# length: 316 + -- Function File: rgbplot (MAP) + -- Function File: H = rgbplot (MAP) + Plot a given color map. The matrix MAP must be a M by 3 matrix. + The three columns of the colormap matrix are plotted in red, + green, and blue lines. + + If an output is requested, a graphics handle to the plot is + returned. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 23 +Plot a given color map. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +rho_filter + + +# name: +# type: sq_string +# elements: 1 +# length: 2383 + -- Function: FILTERED = rho_filter (PROJ, TYPE, SCALING) + Filters the parallel ray projections in the columns of PROJ, + according to the filter type chosen by TYPE. TYPE can be chosen + from + * 'none' + + * 'Ram-Lak' (default) + + * 'Shepp-Logan' + + * 'Cosine' + + * 'Hann' + + * 'Hamming' + + If given, SCALING determines the proportion of frequencies below + the nyquist frequency that should be passed by the filter. The + window function is compressed accordingly, to avoid an abrupt + truncation of the frequency response. + + -- Function: [FILTERED, FILTER] = rho_filter (...) + This form also returns the frequency response of the filter in the + vector FILTER. + + + Performs rho filtering on the parallel ray projections provided. + + Rho filtering is performed as part of the filtered back-projection +method of CT image reconstruction. It is the filtered part of the name. +The simplest rho filter is the Ramachadran-Lakshminarayanan (Ram-Lak), +which is simply |rho|, where rho is the radial component of spatial +frequency. However, this can cause unwanted amplification of noise, +which is what the other types attempt to minimise, by introducing +roll-off into the response. The Hann and Hamming filters multiply the +standard response by a Hann or Hamming window, respectively. The +cosine filter is the standard response multiplied by a cosine shape, +and the Shepp-Logan filter multiplies the response with a sinc shape. +The 'none' filter performs no filtering, and is included for +completeness and to enable incorporating this function easily into +scripts or functions that may offer the ability to choose to apply no +filtering. + + This function is designed to be used by the function `iradon', but +has been exposed to facilitate custom inverse radon transforms and to +more clearly break down the process for educational purposes. The +operations + filtered = rho_filter (proj); + reconstruction = iradon (filtered, 1, 'linear', 'none'); + are exactly equivalent to + reconstruction = iradon (proj, 1, 'linear', 'Ram-Lak'); + + Usage example: + P = phantom (); + projections = radon (P); + filtered_projections = rho_filter (projections, 'Hamming'); + reconstruction = iradon (filtered_projections, 1, 'linear', 'none'); + figure, imshow (reconstruction, []) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Filters the parallel ray projections in the columns of PROJ, according +to the fi + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +roicolor + + +# name: +# type: sq_string +# elements: 1 +# length: 551 + -- Function File: BW = roicolor (A,LOW,HIGH) + -- Function File: BW = roicolor (A,V) + Select a Region Of Interest of an image based on color. + + BW = roicolor(A,low,high) selects a region of interest (ROI) of an + image A returning a black and white image in a logical array (1 for + pixels inside ROI and 0 outside ROI), which is formed by all pixels + whose values lie within the colormap range specified by [LOW HIGH]. + + BW = roicolor(A,v) selects a region of interest (ROI) formed by all + pixels that match values in V. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Select a Region Of Interest of an image based on color. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +std2 + + +# name: +# type: sq_string +# elements: 1 +# length: 148 + -- Function File: S = std2 (I) + Returns the standard deviation for a 2d real type matrix. Uses + `std (I(:))' + + See also: mean2, std + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 +Returns the standard deviation for a 2d real type matrix. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +stdfilt + + +# name: +# type: sq_string +# elements: 1 +# length: 1069 + -- Function File: S = stdfilt (IM) + -- Function File: S = stdfilt (IM, DOMAIN) + -- Function File: S = stdfilt (IM, DOMAIN, PADDING, ...) + Computes the local standard deviation in a neighbourhood around + each pixel in an image. + + The standard deviation of the pixels of a neighbourhood is + computed as + + S = sqrt ((sum (X - MU).^2)/(N-1)) + + where MU is the mean value of the pixels in the neighbourhood, N + is the number of pixels in the neighbourhood. So, an unbiased + estimator is used. + + The neighbourhood is defined by the DOMAIN binary mask. Elements + of the mask with a non-zero value are considered part of the + neighbourhood. By default a 3 by 3 matrix containing only non-zero + values is used. + + At the border of the image, extrapolation is used. By default + symmetric extrapolation is used, but any method supported by the + `padarray' function can be used. Since extrapolation is used, one + can expect a lower deviation near the image border. + + See also: std2, paddarray, entropyfilt + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Computes the local standard deviation in a neighbourhood around each +pixel in an + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +stretchlim + + +# name: +# type: sq_string +# elements: 1 +# length: 1940 + -- Function File: LOW_HIGH = stretchlim (I,TOL) + -- Function File: LOW_HIGH = stretchlim (I) + -- Function File: LOW_HIGH = stretchlim (RGB,TOL) + -- Function File: LOW_HIGH = stretchlim (RGB) + Finds limits to contrast stretch an image + + `LOW_HIGH=stretchlim(I,TOL)' returns a vector LOW_HIGH which + contains a pair of intensities which can be used in `imadjust' to + stretch the contrast of an image, first of them will be lower + value (`imadjust' would assign 0 to it) and second is the upper + bound. TOL specifies the fraction of the image to saturate at + lower and upper limits. It can be a vector of length 2: + `[LOW_FRACT, HIGH_FRACT]', or it can be a scalar, in that case + `[LOW_FRACT, HIGH_FRACT]=[TOL, 1-TOL]'. + + TOL can't be larger than 0.50 and for TOL=0 then + `LOW_HIGH=[min(I(:)), max(I(:))]'. + + `LOW_HIGH=stretchlim(I)' behaves as described but defaults TOL to + `[0.01, 0.99]'. + + `LOW_HIGH=stretchlim(RGB,TOL)' returns a 2-by-3 matrix in LOW_HIGH + of lower and upper values to saturate for each plane of the RGB + image in M-by-N-by-3 array RGB. TOL is a vector or a scalar, as + described above, and the same fractions are applied for each plane. + + `LOW_HIGH=stretchlim(RGB)' uses `[0.01, 0.99]' as default value + for TOL. + + *Notes:* + + Values in LOW_HIGH are of type double and comprised between 0 and + 1 regardless class of input image. + + *Compatibility notes:* + + * int* and uint* types are still not implemented (waiting for + support in Octave 2.1.58). + + * This function tries to find limits that are nearer to saturate + requested interval. So, for instance, if you requested a 5% + and it has to choose between discarding a 1% and a 7%, it + will choose the later despite being more than requested. This + should be test against MATLAB behaviour. + + See also: imadjust + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 +Finds limits to contrast stretch an image + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +tiff_tag_read + + +# name: +# type: sq_string +# elements: 1 +# length: 441 + -- Function File: [ VALUE, OFFSET] = tiff_tag_read (FILE, TAG, IFD) + Reads the values of TIFF file tags. + + FILE is a TIFF file and TAG is the tag number to read. If IFD is + given, only the tag value from that IFD (Image File Directory) + will be read. By default, reads only the first IFD. + + VALUE is the read value from TAG. OFFSET will be `1' if VALUE is a + file offset. + + See also: imread, imfinfo, readexif + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Reads the values of TIFF file tags. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +uintlut + + +# name: +# type: sq_string +# elements: 1 +# length: 250 + -- Function File: B = uintlut (A,LUT) + Computes matrix B by using A as an index to lookup table LUT. + + B = uintlut(A, LUT) calculates a matrix B by using LUT as a lookup + table indexed by values in A. + + B class is the same as LUT. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +Computes matrix B by using A as an index to lookup table LUT. + + + + + diff --git a/octave_packages/image-1.0.15/edge.m b/octave_packages/image-1.0.15/edge.m new file mode 100644 index 0000000..9ba0213 --- /dev/null +++ b/octave_packages/image-1.0.15/edge.m @@ -0,0 +1,545 @@ +## Copyright (C) 2008 Søren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +## +## Note: The implementation and help text for the 'andy' edge detector came with +## the following notice: +## Copyright (C) 1999 Andy Adler +## This code has no warrany whatsoever. +## Do what you like with this code as long as you +## leave this copyright in place. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{bw} =} edge (@var{im}, @var{method}) +## @deftypefnx{Function File} {@var{bw} =} edge (@var{im}, @var{method}, @var{arg1}, @var{arg2}) +## @deftypefnx{Function File} {[@var{bw}, @var{thresh}] =} edge (...) +## Detect edges in the given image using various methods. The first input @var{im} +## is the gray scale image in which edges are to be detected. The second argument +## controls which method is used for detecting the edges. The rest of the input +## arguments depend on the selected method. The first output @var{bw} is a +## @code{logical} image containing the edges. Most methods also returns an automatically +## computed threshold as the second output. +## +## The @var{method} input argument can any of the following strings (the default +## value is "Sobel") +## +## @table @asis +## @item "Sobel" +## Finds the edges in @var{im} using the Sobel approximation to the +## derivatives. Edge points are defined as points where the length of +## the gradient exceeds a threshold and is larger than it's neighbours +## in either the horizontal or vertical direction. The threshold is passed to +## the method in the third input argument @var{arg1}. If one is not given, a +## threshold is automatically computed as 4*@math{M}, where @math{M} is the mean +## of the gradient of the entire image. The optional 4th input argument controls +## the direction in which the gradient is approximated. It can be either +## "horizontal", "vertical", or "both" (default). +## +## @item "Prewitt" +## Finds the edges in @var{im} using the Prewitt approximation to the +## derivatives. This method works just like "Sobel" except a different aproximation +## the gradient is used. +## +## @item "Roberts" +## Finds the edges in @var{im} using the Roberts approximation to the +## derivatives. Edge points are defined as points where the length of +## the gradient exceeds a threshold and is larger than it's neighbours +## in either the horizontal or vertical direction. The threshold is passed to +## the method in the third input argument @var{arg1}. If one is not given, a +## threshold is automatically computed as 6*@math{M}, where @math{M} is the mean +## of the gradient of the entire image. The optional 4th input argument can be +## either "thinning" (default) or "nothinning". If it is "thinning" a simple +## thinning procedure is applied to the edge image such that the edges are only +## one pixel wide. If @var{arg2} is "nothinning", this procedure is not applied. +## +## @item "Kirsch" +## Finds the edges in @var{im} using the Kirsch approximation to the +## derivatives. Edge points are defined as points where the length of +## the gradient exceeds a threshold and is larger than it's neighbours +## in either the horizontal or vertical direction. The threshold is passed to +## the method in the third input argument @var{arg1}. If one is not given, a +## threshold is automatically computed as @math{M}, where @math{M} is the mean +## of the gradient of the entire image. The optional 4th input argument controls +## the direction in which the gradient is approximated. It can be either +## "horizontal", "vertical", or "both" (default). +## +## @item "LoG" +## Finds edges in @var{im} by convolving with the Laplacian of Gaussian (LoG) +## filter, and finding zero crossings. Only zero crossings where the +## filter response is larger than an automatically computed threshold are retained. +## The threshold is passed to the method in the third input argument @var{arg1}. +## If one is not given, a threshold is automatically computed as 0.75*@math{M}, +## where @math{M} is the mean of absolute value of LoG filter response. The +## optional 4th input argument sets the spread of the LoG filter. By default +## this value is 2. +## +## @item "Zerocross" +## Finds edges in the image @var{im} by convolving it with the user-supplied filter +## @var{arg2} and finding zero crossings larger than the threshold @var{arg1}. If +## @var{arg1} is [] a threshold is computed as the mean value of the absolute +## filter response. +## +## @item "Canny" +## Finds edges using the Canny edge detector. The optional third input argument +## @var{arg1} sets the thresholds used in the hysteresis thresholding. If +## @var{arg1} is a two dimensional vector it's first element is used as the lower +## threshold, while the second element is used as the high threshold. If, on the +## other hand, @var{arg1} is a single scalar it is used as the high threshold, +## while the lower threshold is 0.4*@var{arg1}. The optional 4th input argument +## @var{arg2} is the spread of the low-pass Gaussian filter that is used to smooth +## the input image prior to estimating gradients. By default this scale parameter +## is 2. +## +## @item "Lindeberg" +## Finds edges using in @var{im} using the differential geometric single-scale edge +## detector given by Tony Lindeberg. The optional third input argument @var{arg1} +## is the scale (spread of Gaussian filter) at which the edges are computed. By +## default this 2. +## +## @item "Andy" +## A.Adler's idea (c) 1999. Somewhat based on the canny method. The steps are +## @enumerate +## @item +## Do a Sobel edge detection and to generate an image at +## a high and low threshold. +## @item +## Edge extend all edges in the LT image by several pixels, +## in the vertical, horizontal, and 45 degree directions. +## Combine these into edge extended (EE) image. +## @item +## Dilate the EE image by 1 step. +## @item +## Select all EE features that are connected to features in +## the HT image. +## @end enumerate +## +## The parameters for the method is given in a vector: +## @table @asis +## @item params(1)==0 or 4 or 8 +## Perform x connected dilatation (step 3). +## @item params(2) +## Dilatation coeficient (threshold) in step 3. +## @item params(3) +## Length of edge extention convolution (step 2). +## @item params(4) +## Coeficient of extention convolution in step 2. +## @end table +## defaults = [8, 1, 3, 3] +## +## @end table +## +## @seealso{fspecial, nonmax_supress} +## @end deftypefn + +function [bw, out_threshold, g45_out, g135_out] = edge (im, method, varargin) + ## Get the image + if (nargin == 0) + error("edge: not enough input arguments"); + endif + if ( !isgray(im) ) + error("edge: first input must be a gray-scale image"); + endif + + ## Get the method + if (nargin == 1) + method = "Sobel"; + endif + if (!ischar(method)) + error("edge: second argument must be a string"); + endif + method = lower(method); + + ## Perform the actual edge detection + switch (method) + ##################################### + ## S O B E L + ##################################### + case "sobel" + ## Get the direction argument + direction = get_direction(varargin{:}); + ## Create filters; + h1 = fspecial("sobel"); # horizontal + h3 = h1'; # vertical + ## Compute edge strength + switch(direction) + case "horizontal" + strength = abs( conv2(im, h1, "same") ); + case "vertical" + strength = abs( conv2(im, h3, "same") ); + case "both" + strength = sqrt( conv2(im, h1, "same").^2 + ... + conv2(im, h3, "same").^2 ); + endswitch + ## Get threshold + if (nargin > 2 && isscalar(varargin{1})) + thresh = varargin{1}; + else + thresh = 2*mean(strength(:)); + endif + ## Perform thresholding and simple thinning + strength(strength<=thresh) = 0; + bw = simple_thinning(strength); + + ##################################### + ## P R E W I T T + ##################################### + case "prewitt" + ## Get the direction argument + direction = get_direction(varargin{:}); + ## Create filters; + h1 = fspecial("prewitt"); # vertical + h3 = h1'; # horizontal + ## Compute edge strength + switch(direction) + case "vertical" + strength = abs( conv2(im, h1, "same") ); + case "horizontal" + strength = abs( conv2(im, h3, "same") ); + case "both" + strength = sqrt( conv2(im, h1, "same").^2 + ... + conv2(im, h3, "same").^2 ); + endswitch + ## Get threshold + if (nargin > 2 && isscalar(varargin{1})) + thresh = varargin{1}; + else + thresh = 4*mean(strength(:)); + endif + ## Perform thresholding and simple thinning + strength(strength<=thresh) = 0; + bw = simple_thinning(strength); + + ##################################### + ## K I R S C H + ##################################### + case "kirsch" + ## Get the direction argument + direction = get_direction(varargin{:}); + ## Create filters; + h1 = fspecial("kirsch"); # vertical + h3 = h1'; # horizontal + ## Compute edge strength + switch(direction) + case "vertical" + strength = abs( conv2(im, h1, "same") ); + case "horizontal" + strength = abs( conv2(im, h3, "same") ); + case "both" + strength = sqrt( conv2(im, h1, "same").^2 + ... + conv2(im, h3, "same").^2 ); + endswitch + ## Get threshold + if nargin > 2 && isscalar(varargin{1}) + thresh = varargin{1}; + else + thresh = mean(strength(:)); + endif + ## Perform thresholding and simple thinning + strength(strength<=thresh) = 0; + bw = simple_thinning(strength); + + ##################################### + ## R O B E R T S + ##################################### + case "roberts" + ## Get the thinning argument (option) + if (nargin == 4) + option = varargin{2}; + if (!ischar(option)) + error("edge: 'option' must be a string"); + endif + option = lower(option); + if (!any(strcmp(option, {"thinning", "nothinning"}))) + error("edge: 'option' must be either 'thinning', or 'nothinning'"); + endif + else + option = "thinning"; + endif + ## Create filters; + h1 = [1 0; 0 -1]; + h2 = [0 1; -1 0]; + ## Compute edge strength + g45 = conv2(im, h1, "same"); + g135 = conv2(im, h2, "same"); + strength = abs( g45 ) + abs( g135 ); + ## Get threshold + if (nargin > 2 && isscalar(varargin{1})) + thresh = varargin{1}; + else + thresh = 6*mean(strength(:)); + endif + ## Perform thresholding and simple thinning + strength(strength<=thresh) = 0; + if (strcmp(option, "thinning")) + bw = simple_thinning(strength); + else + bw = (strength > 0); + endif + ## Check if g45 and g135 should be returned + if (nargout == 4) + g45_out = g45; + g135_out = g135; + endif + + ##################################### + ## L A P L A C I A N O F G A U S S I A N + ##################################### + case "log" + ## Get sigma + if (nargin == 4 && isscalar(varargin{2})) + sigma = varargin{2}; + else + sigma = 2; + endif + ## Create the filter + s = ceil(3*sigma); + %[x y] = meshgrid(-s:s); + %f = (x.^2 + y.^2 - sigma^2) .* exp(-(x.^2 + y.^2)/(2*sigma^2)); + %f = f/sum(f(:)); + f = fspecial("log", 2*s+1, sigma); + ## Perform convolution with the filter f + g = conv2(im, f, "same"); + ## Get threshold + if (nargin > 2 && isscalar(varargin{1})) + thresh = varargin{1}; + else + thresh = 0.75*mean(abs(g(:))); + endif + ## Find zero crossings + zc = zerocrossings(g); + bw = (abs(g) >= thresh) & zc; + + ##################################### + ## Z E R O C R O S S I N G + ##################################### + case "zerocross" + ## Get the filter + if (nargin == 4 && ismatrix(varargin{2})) + f = varargin{2}; + else + error("edge: a filter must be given as the fourth argument when 'zerocross' is used"); + endif + ## Perform convolution with the filter f + g = conv2(im, f, "same"); + ## Get threshold + if (nargin > 2 && isscalar(varargin{1})) + thresh = varargin{1}; + else + thresh = mean(abs(g(:))); + endif + ## Find zero crossings + zc = zerocrossings(g); + bw = (abs(g) >= thresh) & zc; + + ##################################### + ## C A N N Y + ##################################### + case "canny" + ## Get sigma + if (nargin == 4 && isscalar(varargin{2})) + sigma = varargin{2}; + else + sigma = 2; + endif + + ## Change scale + J = imsmooth(double(im), "Gaussian", sigma); + + ## Canny enhancer + p = [1 0 -1]/2; + Jx = conv2(J, p, "same"); + Jy = conv2(J, p', "same"); + Es = sqrt( Jx.^2 + Jy.^2 ); + Eo = pi - mod (atan2 (Jy, Jx) - pi, pi); + + ## Get thresholds + if (nargin > 2 && isscalar(varargin{1})) + thresh = [0.4*varargin{1}, varargin{1}]; + elseif (nargin > 2 && ismatrix (varargin{1}) && length (varargin{1}(:)) == 2) + thresh = varargin{1}(:); + else + tmp = mean(abs(Es(:))); + thresh = [0.4*tmp, tmp]; + endif + bw = nonmax_supress(Es, Eo, thresh(1), thresh(2)); + + ##################################### + ## L I N D E B E R G + ##################################### + case "lindeberg" + ## In case the user asks for more then 1 output argument + ## we define thresh to be -1. + thresh = -1; + ## Get sigma + if (nargin > 2 && isscalar(varargin{1})) + sigma = varargin{1}; + else + sigma = 2; + endif + ## Filters for computing the derivatives + Px = [-1 0 1; -1 0 1; -1 0 1]; + Py = [1 1 1; 0 0 0; -1 -1 -1]; + Pxx = conv2(Px, Px, "full"); + Pyy = conv2(Py, Py, "full"); + Pxy = conv2(Px, Py, "full"); + Pxxx = conv2(Pxx, Px, "full"); + Pyyy = conv2(Pyy, Py, "full"); + Pxxy = conv2(Pxx, Py, "full"); + Pxyy = conv2(Pyy, Px, "full"); + ## Change scale + L = imsmooth(double(im), "Gaussian", sigma); + ## Compute derivatives + Lx = conv2(L, Px, "same"); + Ly = conv2(L, Py, "same"); + Lxx = conv2(L, Pxx, "same"); + Lyy = conv2(L, Pyy, "same"); + Lxy = conv2(L, Pxy, "same"); + Lxxx = conv2(L, Pxxx, "same"); + Lyyy = conv2(L, Pyyy, "same"); + Lxxy = conv2(L, Pxxy, "same"); + Lxyy = conv2(L, Pxyy, "same"); + ## Compute directional derivatives + Lvv = Lx.^2.*Lxx + 2.*Lx.*Ly.*Lxy + Ly.^2.*Lyy; + Lvvv = Lx.^3.*Lxxx + 3.*Lx.^2.*Ly.*Lxxy ... + + 3.*Lx.*Ly.^2.*Lxyy + 3.*Ly.^3.*Lyyy; + ## Perform edge detection + bw = zerocrossings(Lvv) & Lvvv < 0; + + ##################################### + ## A N D Y + ##################################### + case "andy" + [bw, out_threshold] = andy (im, method, varargin{:}); + + otherwise + error("edge: unsupported edge detector: %s", method); + endswitch + + if (nargout > 1) + out_threshold = thresh; + endif +endfunction + +## An auxilary function that parses the 'direction' argument from 'varargin' +function direction = get_direction(varargin) + if (nargin >= 2) + direction = varargin{2}; + if (!ischar(direction)) + error("edge: direction must be a string"); + endif + direction = lower(direction); + if (!any(strcmp(direction, {"horizontal", "vertical", "both"}))) + error("edge :direction must be either 'horizontal', 'vertical', or 'both'"); + endif + else + direction = "both"; + endif +endfunction + +## An auxilary function that performs a very simple thinning. +## Strength is an image containing the edge strength. +## bw contains a 1 in (r,c) if +## 1) strength(r,c) is greater than both neighbours in the +## vertical direction, OR +## 2) strength(r,c) is greater than both neighbours in the +## horizontal direction. +## Note the use of OR. +function bw = simple_thinning(strength) + [r c] = size(strength); + x = ( strength > [ zeros(r,1) strength(:,1:end-1) ] & ... + strength > [ strength(:,2:end) zeros(r,1) ] ); + y = ( strength > [ zeros(1,c); strength(1:end-1,:) ] & ... + strength > [ strength(2:end,:); zeros(1,c) ] ); + bw = x | y; +endfunction + +## Auxilary function. Finds the zero crossings of the +## 2-dimensional function f. (By Etienne Grossmann) +function z = zerocrossings(f) + z0 = f<0; ## Negative + [R,C] = size(f); + z = zeros(R,C); + z(1:R-1,:) |= z0(2:R,:); ## Grow + z(2:R,:) |= z0(1:R-1,:); + z(:,1:C-1) |= z0(:,2:C); + z(:,2:C) |= z0(:,1:C-1); + + z &= !z0; ## "Positive zero-crossings"? +endfunction + +## The 'andy' edge detector that was present in older versions of 'edge'. +## The function body has simply been copied from the old implementation. +## -- Soren Hauberg, march 11th, 2008 +function [imout, thresh] = andy(im, method, thresh, param2) + [n,m]= size(im); + xx= 2:m-1; + yy= 2:n-1; + + filt= [1 2 1;0 0 0; -1 -2 -1]/8; tv= 2; + imo= conv2(im, rot90(filt), 'same').^2 + conv2(im, filt, 'same').^2; + if nargin<3 || thresh==[]; + thresh= sqrt( tv* mean(mean( imo(yy,xx) )) ); + end +# sum( imo(:)>thresh ) / prod(size(imo)) + dilate= [1 1 1;1 1 1;1 1 1]; tt= 1; sz=3; dt=3; + if nargin>=4 + # 0 or 4 or 8 connected dilation + if length(param2) > 0 + if param2(1)==4 ; dilate= [0 1 0;1 1 1;0 1 0]; + elseif param2(1)==0 ; dilate= 1; + end + end + # dilation threshold + if length(param2) > 2; tt= param2(2); end + # edge extention length + if length(param2) > 2; sz= param2(3); end + # edge extention threshold + if length(param2) > 3; dt= param2(4); end + + end + fobliq= [0 0 0 0 1;0 0 0 .5 .5;0 0 0 1 0;0 0 .5 .5 0;0 0 1 0 0; + 0 .5 .5 0 0;0 1 0 0 0;.5 .5 0 0 0;1 0 0 0 0]; + fobliq= fobliq( 5-sz:5+sz, 3-ceil(sz/2):3+ceil(sz/2) ); + + xpeak= imo(yy,xx-1) <= imo(yy,xx) & imo(yy,xx) > imo(yy,xx+1) ; + ypeak= imo(yy-1,xx) <= imo(yy,xx) & imo(yy,xx) > imo(yy+1,xx) ; + + imht= ( imo >= thresh^2 * 2); # high threshold image + imht(yy,xx)= imht(yy,xx) & ( xpeak | ypeak ); + imht([1,n],:)=0; imht(:,[1,m])=0; + +% imlt= ( imo >= thresh^2 / 2); # low threshold image + imlt= ( imo >= thresh^2 / 1); # low threshold image + imlt(yy,xx)= imlt(yy,xx) & ( xpeak | ypeak ); + imlt([1,n],:)=0; imlt(:,[1,m])=0; + +# now we edge extend the low thresh image in 4 directions + + imee= ( conv2( imlt, ones(2*sz+1,1) , 'same') > tt ) | ... + ( conv2( imlt, ones(1,2*sz+1) , 'same') > tt ) | ... + ( conv2( imlt, eye(2*sz+1) , 'same') > tt ) | ... + ( conv2( imlt, rot90(eye(2*sz+1)), 'same') > tt ) | ... + ( conv2( imlt, fobliq , 'same') > tt ) | ... + ( conv2( imlt, fobliq' , 'same') > tt ) | ... + ( conv2( imlt, rot90(fobliq) , 'same') > tt ) | ... + ( conv2( imlt, flipud(fobliq) , 'same') > tt ); +# imee(yy,xx)= conv2(imee(yy,xx),ones(3),'same') & ( xpeak | ypeak ); + imee= conv2(imee,dilate,'same') > dt; # + +% ff= find( imht==1 ); +% imout = bwselect( imee, rem(ff-1, n)+1, ceil(ff/n), 8); + imout = imee; + +endfunction diff --git a/octave_packages/image-1.0.15/entropy.m b/octave_packages/image-1.0.15/entropy.m new file mode 100644 index 0000000..cba3177 --- /dev/null +++ b/octave_packages/image-1.0.15/entropy.m @@ -0,0 +1,67 @@ +## Copyright (C) 2008 Søren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{E} =} entropy (@var{im}) +## @deftypefnx{Function File} {@var{E} =} entropy (@var{im}, @var{nbins}) +## Computes the entropy of an image. +## +## The entropy of the elements of the image @var{im} is computed as +## +## @example +## @var{E} = -sum (@var{P} .* log2 (@var{P}) +## @end example +## +## where @var{P} is the distribution of the elements of @var{im}. The distribution +## is approximated using a histogram with @var{nbins} cells. If @var{im} is +## @code{logical} then two cells are used by default. For other classes 256 cells +## are used by default. +## +## When the entropy is computed, zero-valued cells of the histogram are ignored. +## +## @seealso{entropyfilt} +## @end deftypefn + +function retval = entropy (I, nbins = 0) + ## Check input + if (nargin == 0) + error ("entropy: not enough input arguments"); + endif + + if (!ismatrix (I)) + error ("entropy: first input must be a matrix"); + endif + + if (!isscalar (nbins)) + error ("entropy: second input argument must be a scalar"); + endif + + ## Get number of histogram bins + if (nbins <= 0) + if (islogical (I)) + nbins = 2; + else + nbins = 256; + endif + endif + + ## Compute histogram + P = hist (I (:), nbins, true); + + ## Compute entropy (ignoring zero-entries of the histogram) + P += (P == 0); + retval = -sum (P .* log2 (P)); +endfunction diff --git a/octave_packages/image-1.0.15/entropyfilt.m b/octave_packages/image-1.0.15/entropyfilt.m new file mode 100644 index 0000000..6b4461a --- /dev/null +++ b/octave_packages/image-1.0.15/entropyfilt.m @@ -0,0 +1,100 @@ +## Copyright (C) 2008 Søren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{E} =} entropyfilt (@var{im}) +## @deftypefnx{Function File} {@var{E} =} entropyfilt (@var{im}, @var{domain}) +## @deftypefnx{Function File} {@var{E} =} entropyfilt (@var{im}, @var{domain}, @var{padding}, ...) +## Computes the local entropy in a neighbourhood around each pixel in an image. +## +## The entropy of the elements of the neighbourhood is computed as +## +## @example +## @var{E} = -sum (@var{P} .* log2 (@var{P}) +## @end example +## +## where @var{P} is the distribution of the elements of @var{im}. The distribution +## is approximated using a histogram with @var{nbins} cells. If @var{im} is +## @code{logical} then two cells are used. For other classes 256 cells +## are used. +## +## When the entropy is computed, zero-valued cells of the histogram are ignored. +## +## The neighbourhood is defined by the @var{domain} binary mask. Elements of the +## mask with a non-zero value are considered part of the neighbourhood. By default +## a 9 by 9 matrix containing only non-zero values is used. +## +## At the border of the image, extrapolation is used. By default symmetric +## extrapolation is used, but any method supported by the @code{padarray} function +## can be used. Since extrapolation is used, one can expect a lower entropy near +## the image border. +## +## @seealso{entropy, paddarray, stdfilt} +## @end deftypefn + +function retval = entropyfilt (I, domain = true (9), padding = "symmetric", varargin) + ## Check input + if (nargin == 0) + error ("entropyfilt: not enough input arguments"); + endif + + if (!ismatrix (I)) + error ("entropyfilt: first input must be a matrix"); + endif + + if (!ismatrix (domain)) + error ("entropyfilt: second input argument must be a logical matrix"); + endif + domain = (domain > 0); + + ## Get number of histogram bins + if (islogical (I)) + nbins = 2; + else + nbins = 256; + endif + + ## Convert to 8 or 16 bit integers if needed + switch (class (I)) + case {"double", "single", "int16", "int32", "int64", "uint16", "uint32", "uint64"} + min_val = double (min (I (:))); + max_val = double (max (I (:))); + if (min_val == max_val) + retval = zeros (size (I)); + return; + endif + I = (double (I) - min_val)./(max_val - min_val); + I = uint8 (255 * I); + case {"logical", "int8", "uint8"} + ## Do nothing + otherwise + error ("entropyfilt: cannot handle images of class '%s'", class (I)); + endswitch + size (I) + ## Pad image + pad = floor (size (domain)/2); + I = padarray (I, pad, padding, varargin {:}); + even = (round (size (domain)/2) == size (domain)/2); + idx = cell (1, ndims (I)); + for k = 1:ndims (I) + idx {k} = (even (k)+1):size (I, k); + endfor + I = I (idx {:}); + size (I) + ## Perform filtering + retval = __spatial_filtering__ (I, domain, "entropy", I, nbins); + +endfunction diff --git a/octave_packages/image-1.0.15/erode.m b/octave_packages/image-1.0.15/erode.m new file mode 100644 index 0000000..67b4b53 --- /dev/null +++ b/octave_packages/image-1.0.15/erode.m @@ -0,0 +1,88 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{BW2} = } erode (@var{BW1},@var{SE}) +## @deftypefnx {Function File} {@var{BW2} = } erode (@var{BW1},@var{SE},@var{alg}) +## @deftypefnx {Function File} {@var{BW2} = } erode (@var{BW1},@var{SE},...,@var{n}) +## Perform an erosion morphological operation on a binary image. +## +## BW2 = erosion(BW1, SE) returns a binary image with the result of an erosion +## operation on @var{BW1} using neighbour mask @var{SE}. +## +## For each point in @var{BW1}, erode searchs its neighbours (which are +## defined by setting to 1 their in @var{SE}). If all neighbours +## are on (1), then pixel is set to 1. If any is off (0) then it is set to 0. +## +## Center of @var{SE} is calculated using floor((size(@var{SE})+1)/2). +## +## Pixels outside the image are considered to be 0. +## +## BW2 = erode(BW1, SE, alg) returns the result of a erosion operation +## using algorithm @var{alg}. Only 'spatial' is implemented at the moment. +## +## BW2 = erosion(BW1, SE, ..., n) returns the result of @var{n} erosion +## operations on @var{BW1}. +## +## @seealso{dilate} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function BW2 = erode(BW1, SE, a, b) + alg='spatial'; + n=1; + if (nargin < 1 || nargin > 4) + usage ("BW2 = erode(BW1, SE [, alg] [, n])"); + endif + if nargin == 4 + alg=a; + n=b; + elseif nargin == 3 + if ischar(a) + alg=a; + else + n=a; + endif + endif + + if !strcmp(alg, 'spatial') + error("erode: alg not implemented."); + endif + + # count ones in mask + thr=sum(SE(:)); + + # "Binarize" BW1, just in case image is not [1,0] + BW1=BW1!=0; + + for i=1:n + # create result matrix + BW1=filter2(SE,BW1) == thr; + endfor + + BW2=BW1; +endfunction + +%!demo +%! erode(ones(5,5),ones(3,3)) +%! % creates a zeros border around ones. + + + +%!assert(erode([0,1,0;1,1,1;0,1,0],[0,0,0;0,0,1;0,1,1])==[1,0,0;0,0,0;0,0,0]); +%!assert(erode([0,1,0;1,1,1;0,1,0],[0,1;1,1])==[1,0,0;0,0,0;0,0,0]); + + diff --git a/octave_packages/image-1.0.15/fchcode.m b/octave_packages/image-1.0.15/fchcode.m new file mode 100644 index 0000000..33e9a5b --- /dev/null +++ b/octave_packages/image-1.0.15/fchcode.m @@ -0,0 +1,88 @@ +## Copyright (C) 2010 Andrew Kelly, IPS Radio & Space Services +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{fcc} = } fchcode (@var{bound}) +## Determine the Freeman chain code for a boundary. +## +## @code{fchcode} computes the Freeman chain code for the @var{n}-connected +## boundary @var{bound}. @var{n} must be either 8 or 4. +## +## @var{bound} is a K-by-2 matrix containing the row/column coordinates of points +## on the boundary. Optionally, the first point can be repeated as the last point, +## resulting in a (K+1)-by-2 matrix. +## +## @var{fcc} is a structure containing the following elements. +## +## @example +## x0y0 = Row/column coordinates where the code starts (1-by-2) +## fcc = Freeman chain code (1-by-K) +## diff = First difference of fcc (1-by-K) +## @end example +## +## The code uses the following directions. +## +## @example +## 3 2 1 +## 4 . 0 +## 5 6 7 +## @end example +## +## @seealso{bwboundaries} +## @end deftypefn + +function fcc = fchcode (bound) + + # ensure the boundary start and end points are the same + if (!isempty (bound) && !isequal (bound (1, :), bound (end, :))) + bound = [bound; bound(1, :)]; + endif + + # number of boundary points + n = max (0, rows (bound)-1); + + # structure in which to return results + fcc = struct (\ + 'x0y0', zeros (1, n), \ + 'fcc', zeros (1, n), \ + 'diff', zeros (1, n) \ + ); + + # an empty boundary? + if (isempty (bound)) + return; + endif + + # direction map + dir = [3, 2, 1; \ + 4, NaN, 0; \ + 5, 6, 7]; + + # coordinates + ROW = 1; + COL = 2; + + # direction changes as row/column indexes into DIR + ch = 2 + diff (bound, 1, ROW); + + # starting point + fcc.x0y0 = bound (1, :); + + # chain code + fcc.fcc = dir (sub2ind (size (dir), ch (:, ROW), ch (:, COL)))'; + + # chain code difference + fcc.diff = mod (diff ([fcc.fcc, fcc.fcc(1)]), 8); +endfunction diff --git a/octave_packages/image-1.0.15/fftconv2.m b/octave_packages/image-1.0.15/fftconv2.m new file mode 100644 index 0000000..15703ad --- /dev/null +++ b/octave_packages/image-1.0.15/fftconv2.m @@ -0,0 +1,134 @@ +## Copyright (C) 2004 Stefan van der Walt +## +## This program is free software; redistribution and use in source and +## binary forms, with or without modification, are permitted provided that +## the following conditions are met: +## +## 1. Redistributions of source code must retain the above copyright +## notice, this list of conditions and the following disclaimer. +## 2. Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## +## THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND +## ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE +## FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +## OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +## LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +## OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +## SUCH DAMAGE. + +## -*- texinfo -*- +## @deftypefn {Function File} fftconv2 (@var{a}, @var{b}, @var{shape}) +## @deftypefnx{Function File} fftconv2 (@var{v1}, @var{v2}, @var{a}, @var{shape}) +## Convolve 2 dimensional signals using the FFT. +## +## This method is faster but less accurate than @var{conv2} for large @var{a} and @var{b}. +## It also uses more memory. A small complex component will be +## introduced even if both @var{a} and @var{b} are real. +## @seealso{conv2} +## @end deftypefn + +## Author: Stefan van der Walt +## Date: 2004 + +function X = fftconv2(varargin) + if (nargin < 2) + usage("fftconv2(a,b[,shape]) or fftconv2(v1, v2, a, shape)") + endif + + shape = "full"; + rowcolumn = 0; + + if ((nargin > 2) && ismatrix(varargin{3}) && !ischar(varargin{3})) + ## usage: fftconv2(v1, v2, a[, shape]) + + rowcolumn = 1; + v1 = varargin{1}(:)'; + v2 = varargin{2}(:); + orig_a = varargin{3}; + + if (nargin == 4) shape = varargin{4}; endif + else + ## usage: fftconv2(a, b[, shape]) + + a = varargin{1}; + b = varargin{2}; + if (nargin == 3) shape = varargin{3}; endif + + endif + + if (rowcolumn) + a = fftconv2(orig_a, v2); + b = v1; + endif + + ra = rows(a); + ca = columns(a); + rb = rows(b); + cb = columns(b); + + A = fft2(impad(a, [0 cb-1], [0 rb-1])); + B = fft2(impad(b, [0 ca-1], [0 ra-1])); + + X = ifft2(A.*B); + + if (rowcolumn) + rb = rows(v2); + ra = rows(orig_a); + cb = columns(v1); + ca = columns(orig_a); + endif + + if strcmp(shape,"same") + r_top = ceil((rb + 1) / 2); + c_top = ceil((cb + 1) / 2); + X = X(r_top:r_top + ra - 1, c_top:c_top + ca - 1); + elseif strcmp(shape, "valid") + X = X(rb:ra, cb:ca); + endif +endfunction + +%!# usage: fftconv2(a,b,[, shape]) +%!shared a,b +%! a = repmat(1:10, 5); +%! b = repmat(10:-1:3, 7); +%!assert(norm(fftconv2(a,b)-conv2(a,b)), 0, 1e6*eps) +%!assert(norm(fftconv2(b,a)-conv2(b,a)), 0, 1e6*eps) +%!assert(norm(fftconv2(a,b,'full')-conv2(a,b,'full')), 0, 1e6*eps) +%!assert(norm(fftconv2(b,a,'full')-conv2(b,a,'full')), 0, 1e6*eps) +%!assert(norm(fftconv2(a,b,'same')-conv2(a,b,'same')), 0, 1e6*eps) +%!assert(norm(fftconv2(b,a,'same')-conv2(b,a,'same')), 0, 1e6*eps) +%!assert(isempty(fftconv2(a,b,'valid'))); +%!assert(norm(fftconv2(b,a,'valid')-conv2(b,a,'valid')), 0, 1e6*eps) + +%!# usage: fftconv2(v1, v2, a[, shape]) +%!shared x,y,a +%! x = 1:4; y = 4:-1:1; a = repmat(1:10, 5); +%!assert(norm(fftconv2(x,y,a)-conv2(x,y,a)), 0, 1e6*eps) +%!assert(norm(fftconv2(x,y,a,'full')-conv2(x,y,a,'full')), 0, 1e6*eps) +%!assert(norm(fftconv2(x,y,a,'same')-conv2(x,y,a,'same')), 0, 1e6*eps) +%!assert(norm(fftconv2(x,y,a,'valid')-conv2(x,y,a,'valid')), 0, 1e6*eps) + +%!demo +%! ## Draw a cross +%! N = 100; +%! [x,y] = meshgrid(-N:N, -N:N); +%! z = 0*x; +%! z(N,1:2*N+1) = 1; z(1:2*N+1, N) = 1; +%! imshow(z); +%! +%! ## Draw a sinc blob +%! n = floor(N/10); +%! [x,y] = meshgrid(-n:n, -n:n); +%! b = x.^2 + y.^2; b = max(b(:)) - b; b = b / max(b(:)); +%! imshow(b); +%! +%! ## Convolve the cross with the blob +%! imshow(real(fftconv2(z, b, 'same')*N)) + + diff --git a/octave_packages/image-1.0.15/fspecial.m b/octave_packages/image-1.0.15/fspecial.m new file mode 100644 index 0000000..540bb59 --- /dev/null +++ b/octave_packages/image-1.0.15/fspecial.m @@ -0,0 +1,252 @@ +## Copyright (C) 2005 Søren Hauberg +## +## 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{filter} = } fspecial(@var{type}, @var{arg1}, @var{arg2}) +## Create spatial filters for image processing. +## +## @var{type} determines the shape of the filter and can be +## @table @t +## @item "average" +## Rectangular averaging filter. The optional argument @var{arg1} controls the +## size of the filter. If @var{arg1} is an integer @var{N}, a @var{N} by @var{N} +## filter is created. If it is a two-vector with elements @var{N} and @var{M}, the +## resulting filter will be @var{N} by @var{M}. By default a 3 by 3 filter is +## created. +## @item "disk" +## Circular averaging filter. The optional argument @var{arg1} controls the +## radius of the filter. If @var{arg1} is an integer @var{N}, a 2 @var{N} + 1 +## filter is created. By default a radius of 5 is used. +## @item "gaussian" +## Gaussian filter. The optional argument @var{arg1} controls the size of the +## filter. If @var{arg1} is an integer @var{N}, a @var{N} by @var{N} +## filter is created. If it is a two-vector with elements @var{N} and @var{M}, the +## resulting filter will be @var{N} by @var{M}. By default a 3 by 3 filter is +## created. The optional argument @var{arg2} sets spread of the filter. By default +## a spread of @math{0.5} is used. +## @item "log" +## Laplacian of Gaussian. The optional argument @var{arg1} controls the size of the +## filter. If @var{arg1} is an integer @var{N}, a @var{N} by @var{N} +## filter is created. If it is a two-vector with elements @var{N} and @var{M}, the +## resulting filter will be @var{N} by @var{M}. By default a 5 by 5 filter is +## created. The optional argument @var{arg2} sets spread of the filter. By default +## a spread of @math{0.5} is used. +## @item "laplacian" +## 3x3 approximation of the laplacian. The filter is approximated as +## @example +## (4/(@var{alpha}+1))*[@var{alpha}/4, (1-@var{alpha})/4, @var{alpha}/4; ... +## (1-@var{alpha})/4, -1, (1-@var{alpha})/4; ... +## @var{alpha}/4, (1-@var{alpha})/4, @var{alpha}/4]; +## @end example +## where @var{alpha} is a number between 0 and 1. This number can be controlled +## via the optional input argument @var{arg1}. By default it is @math{0.2}. +## @item "unsharp" +## Sharpening filter. The following filter is returned +## @example +## (1/(@var{alpha}+1))*[-@var{alpha}, @var{alpha}-1, -@var{alpha}; ... +## @var{alpha}-1, @var{alpha}+5, @var{alpha}-1; ... +## -@var{alpha}, @var{alpha}-1, -@var{alpha}]; +## @end example +## where @var{alpha} is a number between 0 and 1. This number can be controlled +## via the optional input argument @var{arg1}. By default it is @math{0.2}. +## @item "motion" +## Moion blur filter of width 1 pixel. The optional input argument @var{arg1} +## controls the length of the filter, which by default is 9. The argument @var{arg2} +## controls the angle of the filter, which by default is 0 degrees. +## @item "sobel" +## Horizontal Sobel edge filter. The following filter is returned +## @example +## [ 1, 2, 1; +## 0, 0, 0; +## -1, -2, -1 ] +## @end example +## @item "prewitt" +## Horizontal Prewitt edge filter. The following filter is returned +## @example +## [ 1, 1, 1; +## 0, 0, 0; +## -1, -1, -1 ] +## @end example +## @item "kirsch" +## Horizontal Kirsch edge filter. The following filter is returned +## @example +## [ 3, 3, 3; +## 3, 0, 3; +## -5, -5, -5 ] +## @end example +## @end table +## @end deftypefn + +## Remarks by Søren Hauberg (jan. 2nd 2007) +## The motion filter and most of the documentation was taken from Peter Kovesi's +## GPL'ed implementation of fspecial from +## http://www.csse.uwa.edu.au/~pk/research/matlabfns/OctaveCode/fspecial.m + +function f = fspecial (type, arg1, arg2) + if (!ischar (type)) + error ("fspecial: first argument must be a string"); + endif + + switch lower(type) + case "average" + ## Get filtersize + if (nargin > 1 && isreal (arg1) && length (arg1 (:)) <= 2) + fsize = arg1 (:); + else + fsize = 3; + endif + ## Create the filter + f = ones (fsize); + ## Normalize the filter to integral 1 + f = f / sum (f (:)); + + case "disk" + ## Get the radius + if (nargin > 1 && isreal (arg1) && length (arg1 (:)) == 1) + radius = arg1; + else + radius = 5; + endif + ## Create the filter + [x, y] = meshgrid (-radius:radius, -radius:radius); + r = sqrt (x.^2 + y.^2); + f = (r <= radius); + ## Normalize the filter to integral 1 + f = f / sum (f (:)); + + case "gaussian" + ## Get hsize + if (nargin > 1 && isreal (arg1)) + if (length (arg1 (:)) == 1) + hsize = [arg1, arg1]; + elseif (length (arg1 (:)) == 2) + hsize = arg1; + else + error ("fspecial: second argument must be a scalar or a vector of two scalars"); + endif + else + hsize = [3, 3]; + endif + ## Get sigma + if (nargin > 2 && isreal (arg2) && length (arg2 (:)) == 1) + sigma = arg2; + else + sigma = 0.5; + endif + h1 = hsize (1)-1; h2 = hsize (2)-1; + [x, y] = meshgrid(0:h2, 0:h1); + x = x-h2/2; y = y-h1/2; + gauss = exp( -( x.^2 + y.^2 ) / (2*sigma^2) ); + f = gauss / sum (gauss (:)); + + case "laplacian" + ## Get alpha + if (nargin > 1 && isscalar (arg1)) + alpha = arg1; + if (alpha < 0 || alpha > 1) + error ("fspecial: second argument must be between 0 and 1"); + endif + else + alpha = 0.2; + endif + ## Compute filter + f = (4/(alpha+1))*[alpha/4, (1-alpha)/4, alpha/4; ... + (1-alpha)/4, -1, (1-alpha)/4; ... + alpha/4, (1-alpha)/4, alpha/4]; + case "log" + ## Get hsize + if (nargin > 1 && isreal (arg1)) + if (length (arg1 (:)) == 1) + hsize = [arg1, arg1]; + elseif (length (arg1 (:)) == 2) + hsize = arg1; + else + error ("fspecial: second argument must be a scalar or a vector of two scalars"); + endif + else + hsize = [5, 5]; + endif + ## Get sigma + if (nargin > 2 && isreal (arg2) && length (arg2 (:)) == 1) + sigma = arg2; + else + sigma = 0.5; + endif + ## Compute the filter + h1 = hsize (1)-1; h2 = hsize (2)-1; + [x, y] = meshgrid(0:h2, 0:h1); + x = x-h2/2; y = y = y-h1/2; + gauss = exp( -( x.^2 + y.^2 ) / (2*sigma^2) ); + f = ( (x.^2 + y.^2 - 2*sigma^2).*gauss )/( 2*pi*sigma^6*sum(gauss(:)) ); + + case "motion" + ## Taken (with some changes) from Peter Kovesis implementation + ## (http://www.csse.uwa.edu.au/~pk/research/matlabfns/OctaveCode/fspecial.m) + ## FIXME: The implementation is not quite matlab compatible. + if (nargin > 1 && isreal (arg1)) + len = arg1; + else + len = 9; + endif + if (mod (len, 2) == 1) + sze = [len, len]; + else + sze = [len+1, len+1]; + end + if (nargin > 2 && isreal (arg2)) + angle = arg2; + else + angle = 0; + endif + + ## First generate a horizontal line across the middle + f = zeros (sze); + f (floor (len/2)+1, 1:len) = 1; + + # Then rotate to specified angle + f = imrotate (f, angle, "bilinear", "loose"); + f = f / sum (f (:)); + + case "prewitt" + ## The filter + f = [1, 1, 1; 0, 0, 0; -1, -1, -1]; + + case "sobel" + ## The filter + f = [1, 2, 1; 0, 0, 0; -1, -2, -1]; + + case "kirsch" + ## The filter + f = [3, 3, 3; 3, 0, 3; -5, -5, -5]; + + case "unsharp" + ## Get alpha + if (nargin > 1 && isscalar (arg1)) + alpha = arg1; + if (alpha < 0 || alpha > 1) + error ("fspecial: second argument must be between 0 and 1"); + endif + else + alpha = 0.2; + endif + ## Compute filter + f = (1/(alpha+1))*[-alpha, alpha-1, -alpha; ... + alpha-1, alpha+5, alpha-1; ... + -alpha, alpha-1, -alpha]; + + otherwise + error ("fspecial: filter type '%s' is not supported", type); + endswitch +endfunction diff --git a/octave_packages/image-1.0.15/grayslice.m b/octave_packages/image-1.0.15/grayslice.m new file mode 100644 index 0000000..4a6f6eb --- /dev/null +++ b/octave_packages/image-1.0.15/grayslice.m @@ -0,0 +1,77 @@ +## Copyright (C) 2000 Kai Habel +## +## 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} =} grayslice (@var{I},@var{n}) +## @deftypefnx {Function File} {@var{X} =} grayslice (@var{I},@var{v}) +## creates an indexed image @var{X} from an intensitiy image @var{I} +## using multiple threshold levels. +## A scalar integer value @var{n} sets the levels to +## @example +## +## @group +## 1 2 n-1 +## -, -, ..., --- +## n n n +## @end group +## @end example +## +## X = grayslice(I,5); +## +## For irregular threshold values a real vector @var{v} can be used. +## The values must be in the range [0,1]. +## +## @group +## X = grayslice(I,[0.1,0.33,0.75,0.9]) +## @end group +## +## @seealso{im2bw} +## @end deftypefn + +## Author: Kai Habel +## Date: 03. August 2000 + +function X = grayslice (I, v) + + if (nargin != 2) + usage ("grayslice(...) number of arguments must be 1 or 2"); + endif + + if (is_scalar(v) && (fix(v) == v)) + + v = (1:v - 1) / v; + + elseif (isvector(v)) + + if (any (v < 0) || (any (v > 1))) + error ("slice vector must be in range [0,1]") + endif + v = [0,v,1]; + else + + usage("second argument"); + + endif + + [r, c] = size (I); + [m, n] = sort ([v(:); I(:)]); + lx = length (v); + o = cumsum (n <= lx); + idx = o (find(n>lx)); + [m, n] = sort (I(:)); + [m, n] = sort (n); + X = reshape (idx(n), r, c); + +endfunction diff --git a/octave_packages/image-1.0.15/graythresh.m b/octave_packages/image-1.0.15/graythresh.m new file mode 100644 index 0000000..b680f2a --- /dev/null +++ b/octave_packages/image-1.0.15/graythresh.m @@ -0,0 +1,84 @@ +## Copyright (C) 2005 Barre-Piquot +## +## 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. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{level}=} graythresh (@var{I}) +## Compute global image threshold using Otsu's method. +## +## The output @var{level} is a global threshold (level) that can be used to convert +## an intensity image to a binary image with @code{im2bw}. +## @var{level} is a normalized intensity value that lies in the range [0, 1]. +## +## The function uses Otsu's method, which chooses the threshold to +## minimize the intraclass variance of the black and white pixels. +## +## Color images are converted grayscale before @var{level} is computed. +## @seealso{im2bw} +## @end deftypefn + +## Note: +## This function is taken from +## http://www.irit.fr/recherches/SAMOVA/MEMBERS/JOLY/Homepage_files/IRR05/Barre-Piquot/graythresh.m +## I added texinfo documentation, error checking and sanitised the code. +## -- Søren Hauberg + +function level = graythresh (I) + ## Input checking + if (nargin != 1) + print_usage(); + endif + if (!isgray(I) && !isrgb(I)) + error("graythresh: input must be an image"); + endif + + ## If the image is RGB convert it to grayscale + if (isrgb(I)) + I = rgb2gray(I); + endif + + ## Calculation of the normalized histogram + n = 256; + h = hist(I(:), 1:n); + h = h/(length(I(:))+1); + + ## Calculation of the cumulated histogram and the mean values + w = cumsum(h); + mu = zeros(n, 1); mu(1) = h(1); + for i=2:n + mu(i) = mu(i-1) + i*h(i); + end + + ## Initialisation of the values used for the threshold calculation + level = find (h > 0, 1); + w0 = w(level); + w1 = 1-w0; + mu0 = mu(level)/w0; + mu1 = (mu(end)-mu(level))/w1; + max = w0*w1*(mu1-mu0)*(mu1-mu0); + + ## For each step of the histogram, calculation of the threshold and storing of the maximum + for i = find (h > 0) + w0 = w(i); + w1 = 1-w0; + mu0 = mu(i)/w0; + mu1 = (mu(end)-mu(i))/w1; + s = w0*w1*(mu1-mu0)*(mu1-mu0); + if (s > max) + max = s; + level = i; + endif + endfor + + ## Normalisation of the threshold + level /= n; +endfunction + diff --git a/octave_packages/image-1.0.15/histeq.m b/octave_packages/image-1.0.15/histeq.m new file mode 100644 index 0000000..e6d7e1b --- /dev/null +++ b/octave_packages/image-1.0.15/histeq.m @@ -0,0 +1,47 @@ +## Copyright (C) 2000 Kai Habel +## +## 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{J} = histeq (@var{I}, @var{n}) +## Histogram equalization of a gray-scale image. The histogram contains +## @var{n} bins, which defaults to 64. +## +## @var{I}: Image in double format, with values from 0.0 to 1.0 +## +## @var{J}: Returned image, in double format as well +## @seealso{imhist} +## @end deftypefn + +## Author: Kai Habel +## Date: 08. August 2000 +## Modified-by: Jonas Wagner +## Date: 11. February 2008 + +function J = histeq (I, n) + if (nargin == 0) + print_usage(); + elseif (nargin == 1) + n = 64; + endif + + [r,c] = size(I); + I = mat2gray(I); + [X,map] = gray2ind(I, n); + [nn,xx] = imhist(I, n); + Icdf = 1 / prod(size(I)) * cumsum(nn); + J = reshape(Icdf(X),r,c); + plot(Icdf,'b'); + legend( 'Image Cumulative Density Function'); +endfunction diff --git a/octave_packages/image-1.0.15/hough_circle.m b/octave_packages/image-1.0.15/hough_circle.m new file mode 100644 index 0000000..17d6be3 --- /dev/null +++ b/octave_packages/image-1.0.15/hough_circle.m @@ -0,0 +1,94 @@ +## Copyright (C) 2008 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +## -*- texinfo -*- +## @deftypefn {Function File} @var{accum}= hough_circle (@var{bw}, @var{r}) +## Perform the Hough transform for circles with radius @var{r} on the +## black-and-white image @var{bw}. +## +## As an example, the following shows how to compute the Hough transform for circles +## with radius 3 or 7 in the image @var{im} +## @example +## bw = edge(im); +## accum = hough_circle(bw, [3, 7]); +## @end example +## If @var{im} is an NxM image @var{accum} will be an NxMx2 array, where +## @var{accum}(:,:,1) will contain the Hough transform for circles with +## radius 3, and @var{accum}(:,:,2) for radius 7. To find good circles you +## now need to find local maximas in @var{accum}, which can be a hard problem. +## If you find a local maxima in @var{accum}(row, col, 1) it means that a +## good circle exists with center (row,col) and radius 3. +## +## @seealso{houghtf} +## @end deftypefn + +function accum = hough_circle(bw, r) + ## Check input arguments + if (nargin != 2) + error("hough_circle: wrong number of input arguments"); + endif + + if (!ismatrix(bw) || ndims(bw) != 2) + error("hough_circle: first arguments must be a 2-dimensional matrix"); + endif + + if (!isvector(r) || !isreal(r) || any(r<0)) + error("hough_circle: radius arguments must be a positive vector or scalar"); + endif + + ## Create the accumulator array. + accum = zeros(size(bw,1), size(bw,2), length(r)); + + ## Find the pixels we need to look at + [R, C] = find(bw); + + ## Iterate over different radius + for j = 1:length(r) + rad = r(j); + + ## Compute a filter containing the circle we're looking for. + circ = circle(rad); + + ## Iterate over all interesting image points + for i =1:length(R) + row = R(i); + col = C(i); + + ## Compute indices for the accumulator array + a_rows = max(row-rad,1) : min(row+rad, size(accum,1)); + a_cols = max(col-rad,1) : min(col+rad, size(accum,2)); + + ## Compute indices for the circle array (the filter) + c_rows = max(rad-row+2,1) : min(rad-row+1+size(accum,1), size(circ,1)); + c_cols = max(rad-col+2,1) : min(rad-col+1+size(accum,2), size(circ,2)); + + ## Update the accumulator array + accum( a_rows, a_cols, j ) += circ ( c_rows, c_cols ); + endfor + endfor +endfunction + +## Small auxilary function that creates an (2r+1)x(2r+1) image containing +## a circle with radius r and center (r+1, r+1). +function circ = circle(r) + circ = zeros(round(2*r+1)); + col = 1:size(circ,2); + for row=1:size(circ,1) + tmp = (row-(r+1)).^2 + (col-(r+1)).^2; + circ(row,col) = (tmp <= r^2); + endfor + circ = bwmorph(circ, 'remove'); +endfunction diff --git a/octave_packages/image-1.0.15/houghtf.m b/octave_packages/image-1.0.15/houghtf.m new file mode 100644 index 0000000..a6cffa9 --- /dev/null +++ b/octave_packages/image-1.0.15/houghtf.m @@ -0,0 +1,102 @@ +## Copyright (C) 2008 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +## -*- texinfo -*- +## @deftypefn {Function File} @var{H} = houghtf (@var{bw}) +## @deftypefnx{Function File} @var{H} = houghtf (@var{bw}, @var{method}) +## @deftypefnx{Function File} @var{H} = houghtf (@var{bw}, @var{method}, @var{arg}) +## Perform the Hough transform for lines or circles. +## +## The @var{method} argument chooses between the Hough transform for lines and +## circles. It can be either "line" (default) or "circle". +## +## @strong{Line Detection} +## +## If @var{method} is "line", the function will compute the Hough transform for +## lines. A line is parametrised in @var{r} and @var{theta} as +## @example +## @var{r} = x*cos(@var{theta}) + y*sin(@var{theta}), +## @end example +## where @var{r} is distance between the line and the origin, while @var{theta} +## is the angle of the vector from the origin to this closest point. The result +## @var{H} is an @var{N} by @var{M} matrix containing the Hough transform. Here, +## @var{N} is the number different values of @var{r} that has been attempted. +## This is computed as @code{2*diag_length - 1}, where @code{diag_length} is +## the length of the diagonal of the input image. @var{M} is the number of +## different values of @var{theta}. These can be set through the third input +## argument @var{arg}. This must be a vector of real numbers, and is by default +## @code{pi*(-90:90)/180}. +## +## @strong{Circle Detection} +## +## If @var{method} is "circle" the function will compute the Hough transform for +## circles. The circles are parametrised in @var{r} which denotes the radius of +## the circle. The third input argument @var{arg} must be a real vector containing +## the possible values of @var{r}. +## If the input image is @var{N} by @var{M}, then the result @var{H} will be an +## @var{N} by @var{M} by @var{K} array, where @var{K} denotes the number of +## different values of @var{r}. +## +## As an example, the following shows how to compute the Hough transform for circles +## with radius 3 or 7 in the image @var{im} +## @example +## bw = edge(im); +## H = houghtf(bw, "circle", [3, 7]); +## @end example +## Here @var{H} will be an NxMx2 array, where @var{H}(:,:,1) will contain the +## Hough transform for circles with radius 3, and @var{H}(:,:,2) for radius 7. +## To find good circles you now need to find local maximas in @var{H}. If you +## find a local maxima in @var{H}(row, col, 1) it means that a good circle exists +## with center (row,col) and radius 3. One way to locate maximas is to use the +## @code{immaximas} function. +## +## @seealso{hough_line, hough_circle, immaximas} +## @end deftypefn + +function [accum, R] = houghtf(bw, varargin) + ## Default arguments + method = "line"; + args = {}; + + ## Check input arguments + if (nargin == 0) + error("houghtf: not enough input arguments"); + endif + + if (!ismatrix(bw) || ndims(bw) != 2) + error("houghtf: first arguments must be a 2-dimensional matrix"); + endif + + if (nargin > 1) + if (ischar(varargin{1})) + method = varargin{1}; + args = varargin(2:end); + else + args = varargin; + endif + endif + + ## Choose method + switch (lower(method)) + case "line" + [accum, R] = hough_line(bw, args{:}); + case "circle" + accum = hough_circle(bw, args{:}); + otherwise + error("houghtf: unsupported method '%s'", method); + endswitch + +endfunction diff --git a/octave_packages/image-1.0.15/im2bw.m b/octave_packages/image-1.0.15/im2bw.m new file mode 100644 index 0000000..fd96d16 --- /dev/null +++ b/octave_packages/image-1.0.15/im2bw.m @@ -0,0 +1,72 @@ +## Copyright (C) 2000 Kai Habel +## +## 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{BW}= im2bw (@var{I},threshold) +## @deftypefnx {Function File} @var{BW}= im2bw (@var{X},@var{cmap},threshold) +## Converts image data types to a black-white (binary) image. +## The treshold value should be in the range [0,1]. +## @end deftypefn + +## Author: Kai Habel +## Date: 19. March 2000 + +function BW = im2bw (img, a, b) + if (nargin < 2 || nargin > 3) + usage("im2bw: number of arguments must be 2 or 3"); + endif + + ## Convert img to gray scale + if (isrgb(img)) + img = rgb2gray(img); + if (nargin != 2) + error("im2bw: two input arguments must be given when the image is a color image"); + endif + t = a; + elseif (isind (img) && ismatrix(a) && columns (a) == 3) + img = ind2gray (img, a); + if (nargin != 3) + error("im2bw: three input arguments must be given when the image is indexed"); + endif + t = b; + elseif (isgray(img)) + if (nargin != 2) + error("im2bw: two input arguments must be given when the image is gray scale"); + endif + t = a; + else + error ("im2bw: first input argument must be an image"); + endif + + ## Do the thresholding + if (isscalar (t)) + if (t < 0 || t > 1) + error("im2bw: threshold must be in the interval [0, 1]"); + endif + switch (class(img)) + case {"double", "single"} + BW = (img >= t); + case {"uint8"} + BW = (img >= 255*t); + case {"uint16"} + BW = (img >= 65535*t); + otherwise + error("im2bw: unsupport image class"); + endswitch + else + error ("im2bw: threshold value must be scalar"); + endif + +endfunction diff --git a/octave_packages/image-1.0.15/im2col.m b/octave_packages/image-1.0.15/im2col.m new file mode 100644 index 0000000..0a76fc3 --- /dev/null +++ b/octave_packages/image-1.0.15/im2col.m @@ -0,0 +1,245 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{B} = } im2col (@var{A}, [@var{m},@var{n}], @var{block_type}) +## @deftypefnx {Function File} {@var{B} = } im2col (@var{A}, [@var{m},@var{n}]) +## @deftypefnx {Function File} {@var{B} = } im2col (@var{A}, 'indexed', ...) +## Rearranges image blocks into columns. +## +## @code{B=im2col(A, [m, n], blocktype)} rearranges blocks in @var{A} +## into columns in a way that's determined by @var{block_type}, which +## can take the following values: +## +## @table @code +## @item distinct +## Rearranges each distinct @var{m}-by-@var{n} block in image @var{A} +## into a column of @var{B}. Blocks are scanned from left to right and +## the up to bottom in @var{A}, and columns are added to @var{B} from +## left to right. If @var{A}'s size is not multiple @var{m}-by-@var{n} +## it is padded. +## @item sliding +## Rearranges any @var{m}-by-@var{n} sliding block of @var{A} in a +## column of @var{B}, without any padding, so only sliding blocks which +## can be built using a full @var{m}-by-@var{n} neighbourhood are taken. +## In consequence, @var{B} has @var{m}*@var{n} rows and +## (@var{mm}-@var{m}+1)*(@var{nn}-@var{n}+1) columns (where @var{mm} and +## @var{nn} are the size of @var{A}). +## +## This case is thought to be used applying operations on columns of +## @var{B} (for instance using sum(:)), so that result is a +## 1-by-(@var{mm}-@var{m}+1)*(@var{nn}-@var{n}+1) vector, that is what +## the complementary function @code{col2im} expects. +## @end table +## +## @code{B=im2col(A,[m,n])} takes @code{distinct} as a default value for +## @var{block_type}. +## +## @code{B=im2col(A,'indexed',...)} will treat @var{A} as an indexed +## image, so it will pad using 1 if @var{A} is double. All other cases +## (incluing indexed matrices with uint8 and uint16 types and +## non-indexed images) will use 0 as padding value. +## +## Any padding needed in 'distinct' processing will be added at right +## and bottom edges of the image. +## +## @seealso{col2im} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function B = im2col(A, varargin) + if(nargin<2 || nargin>4) + usage("B=im2col(B [, 'indexed'], [m,n] [, block_type])"); + endif + + ## check 'indexed' presence + indexed=false; + p=1; + if(ischar(varargin{1}) && strcmp(varargin{1}, "indexed")) + if(nargin<3) + usage("B=im2col(B [, 'indexed'], [m,n] [, block_type])"); + endif + indexed=true; + p+=1; + if(isa(A,"uint8") || isa(A,"uint16")) + padval=0; + else + padval=1; + endif + else + padval=0; + endif + + ## check [m,n] + if(!isvector(varargin{p})) + error("im2col: expected [m,n] but param is not a vector."); + endif + if(length(varargin{p})!=2) + error("im2col: expected [m,n] but param has wrong length."); + endif + m=varargin{p}(1); + n=varargin{p}(2); + p+=1; + + block_type='sliding'; + if(nargin>p) + ## we have block_type param + if(!ischar(varargin{p})) + error("im2col: invalid parameter block_type."); + endif + block_type=varargin{p}; + p+=1; + endif + + ## if we didn't have 'indexed' but had 4 parameters there's an error + if(nargin>p) + usage("B=im2col(B [, 'indexed'], [m,n] [, block_type])"); + endif + + + ## common checks + if(!ismatrix(A)) + error("im2col: A should be a matrix (or vector)."); + endif + + switch(block_type) + case('distinct') + ## calc needed padding + sp=mod(-size(A)',[m;n]); + + if(any(sp)) + A=padarray(A,sp,padval,'post'); + endif + + ## iterate through all blocks + B=[]; + for i=1:m:size(A,1) ## up to bottom + for j=1:n:size(A,2) ## left to right + ## TODO: check if we can horzcat([],uint8([10;11])) in a + ## future Octave version > 2.1.58 + if(isempty(B)) + B=A(i:i+m-1,j:j+n-1)(:); + else + B=horzcat(B, A(i:i+m-1,j:j+n-1)(:)); + endif + endfor + endfor + + case('sliding') + if(indexed) + disp("WARNING: 'indexed' has no sense when using sliding."); + endif + if(m>size(A,1) || n>size(A,2)) + error("im2col: block size can't be greater than image size in sliding"); + endif + ## TODO: check if matlab uses top-down and left-right order + B=[]; + for j=1:1:size(A,2)-n+1 ## left to right + for i=1:1:size(A,1)-m+1 ## up to bottom + ## TODO: check if we can horzcat([],uint8([10;11])) in a + ## future Octave version > 2.1.58 + if(isempty(B)) + B=A(i:i+m-1,j:j+n-1)(:); + else + B=horzcat(B, A(i:i+m-1,j:j+n-1)(:)); + endif + endfor + endfor + + otherwise + error("im2col: invalid block_type."); + endswitch + +endfunction + +%!demo +%! A=[1:10;11:20;21:30;31:40] +%! B=im2col(A,[2,5],'distinct') +%! C=col2im(B,[2,5],[4,10],'distinct') +%! # Divide A using distinct blocks and reverse operation + +%!shared B, A, Bs, As, Ap, Bp0, Bp1 +%! v=[1:10]'; +%! r=reshape(v,2,5); +%! B=[v, v+10, v+20, v+30, v+40, v+50]; +%! A=[r, r+10; r+20, r+30; r+40, r+50]; +%! As=[1,2,3,4,5;6,7,8,9,10;11,12,13,14,15]; +%! b1=As(1:2,1:4)(:); +%! b2=As(2:3,1:4)(:); +%! b3=As(1:2,2:5)(:); +%! b4=As(2:3,2:5)(:); +%! Bs=[b1,b2,b3,b4]; +%! Ap=A(:,1:9); +%! Bp1=Bp0=B; +%! Bp0([9:10],[2,4,6])=0; +%! Bp1([9:10],[2,4,6])=1; + +%!# bad block_type +%!error(im2col(A,[2,5],'wrong_block_type')); + +%!# distinct +%!assert(im2col(A,[2,5],'distinct'), B); + +%!# padding +%!assert(im2col(Ap,[2,5],'distinct'), Bp0); +%!assert(im2col(Ap,'indexed',[2,5],'distinct'), Bp1); + +%!# now sliding +%!assert(im2col(As,[2,4]), Bs); +%!assert(im2col(As,[2,4],'sliding'), Bs); +%!assert(im2col(As,[3,5],'sliding'), As(:)); + +%!# disctint uint8 & uint16 +%!assert(im2col(uint8(A),[2,5],'distinct'), uint8(B)); +%!assert(im2col(uint16(A),[2,5],'distinct'), uint16(B)); + +%!# padding uint8 & uint16 (to 0 even in indexed case) +%!assert(im2col(uint8(Ap),[2,5],'distinct'), uint8(Bp0)); +%!assert(im2col(uint8(Ap),'indexed',[2,5],'distinct'), uint8(Bp0)); +%!assert(im2col(uint16(Ap),[2,5],'distinct'), uint16(Bp0)); +%!assert(im2col(uint16(Ap),'indexed',[2,5],'distinct'), uint16(Bp0)); + +%!# now sliding uint8 & uint16 +%!assert(im2col(uint8(As),[2,4],'sliding'), uint8(Bs)); +%!assert(im2col(uint16(As),[2,4],'sliding'), uint16(Bs)); + + + + +% +% $Log$ +% Revision 1.4 2007/03/23 16:14:36 adb014 +% Update the FSF address +% +% Revision 1.3 2007/01/04 23:47:43 hauberg +% Put seealso before end deftypefn +% +% Revision 1.2 2007/01/04 23:37:54 hauberg +% Minor changes in help text +% +% Revision 1.1 2006/08/20 12:59:33 hauberg +% Changed the structure to match the package system +% +% Revision 1.3 2005/09/08 02:00:17 pkienzle +% [for Bill Denney] isstr -> ischar +% +% Revision 1.2 2004/09/03 17:37:08 jmones +% Added support for int* and uint* types +% +% Revision 1.1 2004/08/18 14:39:07 jmones +% im2col and col2im added +% +% diff --git a/octave_packages/image-1.0.15/im2double.m b/octave_packages/image-1.0.15/im2double.m new file mode 100644 index 0000000..c85d6c9 --- /dev/null +++ b/octave_packages/image-1.0.15/im2double.m @@ -0,0 +1,47 @@ +## Copyright (C) 2007 Søren Hauberg +## +## 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, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{im2} = im2double(@var{im1}) +## Converts the input image to an image of class double. +## +## If the input image is of class double the output is unchanged. +## If the input is of class uint8 the result will be converted to doubles +## and divided by 255, and if the input is of class uint16 the image will +## be converted to doubles and divided by 65535. +## @seealso{im2bw, im2uint16, im2uint8} +## @end deftypefn + +function im2 = im2double(im1) + ## Input checking + if (nargin < 1) + print_usage(); + endif + if (!isgray(im1) && !isrgb(im1)) + error("im2double: input must be an image"); + endif + + ## Take action depending on the class of the data + switch (class(im1)) + case "double" + im2 = im1; + case "uint8" + im2 = double(im1) / 255; + case "uint16" + im2 = double(im1) / (pow2(16)-1); + otherwise + error("im2double: unsupported image class"); + endswitch +endfunction diff --git a/octave_packages/image-1.0.15/im2uint16.m b/octave_packages/image-1.0.15/im2uint16.m new file mode 100644 index 0000000..26763ea --- /dev/null +++ b/octave_packages/image-1.0.15/im2uint16.m @@ -0,0 +1,47 @@ +## Copyright (C) 2007 Søren Hauberg +## +## 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, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{im2} = im2uint16(@var{im1}) +## Converts the input image to an image of class uint16. +## +## If the input image is of class uint16 the output is unchanged. +## If the input is of class uint8 the result will be converted to uint16 +## and multiplied by 257, and if the input is of class double the image will +## be multiplied by 65535 and converted to uint16. +## @seealso{im2bw, im2double, im2uint8} +## @end deftypefn + +function im2 = im2uint16(im1) + ## Input checking + if (nargin < 1) + print_usage(); + endif + if (!isgray(im1) && !isrgb(im1)) + error("im2uint16: input must be an image"); + endif + + ## Take action depending on the class of the data + switch (class(im1)) + case "double" + im2 = uint16(65535*im1); + case "uint8" + im2 = 257*uint16(im1); + case "uint16" + im2 = im1; + otherwise + error("im2uint16: unsupported image class"); + endswitch +endfunction diff --git a/octave_packages/image-1.0.15/im2uint8.m b/octave_packages/image-1.0.15/im2uint8.m new file mode 100644 index 0000000..f751dcf --- /dev/null +++ b/octave_packages/image-1.0.15/im2uint8.m @@ -0,0 +1,47 @@ +## Copyright (C) 2007 Søren Hauberg +## +## 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, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{im2} = im2uint8(@var{im1}) +## Converts the input image to an image of class uint8. +## +## If the input image is of class uint8 the output is unchanged. +## If the input is of class double the result will be multiplied +## by 255 and converted to uint8, and if the input is of class uint16 the +## image will be divided by 257 and converted to uint8. +## @seealso{im2bw, im2uint16, im2double} +## @end deftypefn + +function im2 = im2uint8(im1) + ## Input checking + if (nargin < 1) + print_usage(); + endif + if (!isgray(im1) && !isrgb(im1)) + error("im2uint8: input must be an image"); + endif + + ## Take action depending on the class of the data + switch (class(im1)) + case "double" + im2 = uint8(255*im1); + case "uint8" + im2 = im1; + case "uint16" + im2 = uint8(im1/257); + otherwise + error("im2uint8: unsupported image class"); + endswitch +endfunction diff --git a/octave_packages/image-1.0.15/imadjust.m b/octave_packages/image-1.0.15/imadjust.m new file mode 100644 index 0000000..f4b7d3a --- /dev/null +++ b/octave_packages/image-1.0.15/imadjust.m @@ -0,0 +1,361 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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 . +## +## +## Based on old imadjust.m (GPL): +## Copyright (C) 1999,2000 Kai Habel + + +## -*- texinfo -*- +## @deftypefn {Function File} @var{J}= imadjust (@var{I}) +## @deftypefnx {Function File} @var{J}= imadjust (@var{I},[@var{low_in};@var{high_in}]) +## @deftypefnx {Function File} @var{J}= imadjust (@var{I},[@var{low_in};@var{high_in}],[@var{low_out};@var{high_out}]) +## @deftypefnx {Function File} @var{J}= imadjust (..., @var{gamma}) +## @deftypefnx {Function File} @var{newmap}= imadjust (@var{map}, ...) +## @deftypefnx {Function File} @var{RGB_out}= imadjust (@var{RGB}, ...) +## Adjust image or colormap values to a specified range. +## +## @code{J=imadjust(I)} adjusts intensity image @var{I} values so that +## 1% of data on lower and higher values (2% in total) of the image is +## saturated; choosing for that the corresponding lower and higher +## bounds (using @code{stretchlim}) and mapping them to 0 and 1. @var{J} +## is an image of the same size as @var{I} which contains mapped values. +## This is equivalent to @code{imadjust(I,stretchlim(I))}. +## +## @code{J=imadjust(I,[low_in;high_in])} behaves as described but uses +## @var{low_in} and @var{high_in} values instead of calculating them. It +## maps those values to 0 and 1; saturates values lower than first limit +## to 0 and values higher than second to 1; and finally maps all values +## between limits linearly to a value between 0 and 1. If @code{[]} is +## passes as @code{[low_in;high_in]} value, then @code{[0;1]} is taken +## as a default value. +## +## @code{J=imadjust(I,[low_in;high_in],[low_out;high_out])} behaves as +## described but maps output values between @var{low_out} and +## @var{high_out} instead of 0 and 1. A default value @code{[]} can also +## be used for this parameter, which is taken as @code{[0;1]}. +## +## @code{J=imadjust(...,gamma)} takes, in addition of 3 parameters +## explained above, an extra parameter @var{gamma}, which specifies the +## shape of the mapping curve between input elements and output +## elements, which is linear (as taken if this parameter is omitted). If +## @var{gamma} is above 1, then function is weighted towards lower +## values, and if below 1, towards higher values. +## +## @code{newmap=imadjust(map,...)} applies a transformation to a +## colormap @var{map}, which output is @var{newmap}. This transformation +## is the same as explained above, just using a map instead of an image. +## @var{low_in}, @var{high_in}, @var{low_out}, @var{high_out} and +## @var{gamma} can be scalars, in which case the same values are applied +## for all three color components of a map; or it can be 1-by-3 +## vectors, to define unique mappings for each component. +## +## @code{RGB_out=imadjust(RGB,...)} adjust RGB image @var{RGB} (a +## M-by-N-by-3 array) the same way as specified in images and colormaps. +## Here too @var{low_in}, @var{high_in}, @var{low_out}, @var{high_out} and +## @var{gamma} can be scalars or 1-by-3 matrices, to specify the same +## mapping for all planes, or unique mappings for each. +## +## The formula used to realize the mapping (if we omit saturation) is: +## +## @code{J = low_out + (high_out - low_out) .* ((I - low_in) / (high_in - low_in)) .^ gamma;} +## +## @strong{Compatibility notes:} +## +## @itemize @bullet +## @item +## Prior versions of imadjust allowed @code{[low_in; high_in]} and +## @code{[low_out; high_out]} to be row vectors. Compatibility with this +## behaviour has been keeped, although preferred form is vertical vector +## (since it extends nicely to 2-by-3 matrices for RGB images and +## colormaps). +## @item +## Previous version of imadjust, if @code{low_in>high_in} it "negated" output. +## Now it is negated if @code{low_out>high_out}, for compatibility with +## MATLAB. +## @item +## Class of @var{I} is not considered, so limit values are not +## modified depending on class of the image, just treated "as is". When +## Octave 2.1.58 is out, limits will be multiplied by 255 for uint8 +## images and by 65535 for uint16 as in MATLAB. +## @end itemize +## +## @seealso{stretchlim, brighten} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +## TODO: When Octave 2.1.58 is out multiply indices if input argument is +## TODO: of class int* or uint*. + +function ret = imadjust (image, in, out, gamma) + + if (nargin < 1 || nargin > 4) + usage ("imadjust(...) number of arguments must be between 1 and 4"); + endif + + if (nargin < 4) + gamma = 1; ## default gamma + endif + + if !(ismatrix(image)) + error ("imadjust(image,...) first parameter must be a image matrix or colormap"); + endif + + if (nargin==1) + in=stretchlim(image); ## this saturates 1% on lower and 1% on + out=[0;1]; ## higher values + endif + + if (nargin==2) + out=[0;1]; ## default out + endif + + if !((ismatrix(in) || isempty(in)) && (ismatrix(out) || isempty(out)) ) + usage("imadjust(image,[low high],[bottom top],gamma)"); + endif + + if (isempty(in)) + in=[0;1]; ## default in + endif + + if (isempty(out)) + out=[0;1]; ## default out + endif + + simage=size(image); + if (length(simage)==3 && simage(3)==3) + ## image is rgb + [in, out, gamma]=__imadjust_check_3d_args__(in, out, gamma); + + ## make room + ret=zeros(size(image)); + + ## process each plane + for i=1:3 + ret(:,:,i)=__imadjust_plane__(image(:,:,i),in(1,i),in(2,i),out(1,i),out(2,i),gamma(1,i)); + endfor + + elseif (length(simage)==2) + if(simage(2)==3 && \ + (size(in)==[2,3] || size(out)==[2,3] || size(gamma)==[1,3]) ) + ## image is a colormap + [in, out, gamma]=__imadjust_check_3d_args__(in, out, gamma); + + ret=[]; + ## process each color + for i=1:3 + ret=horzcat(ret,__imadjust_plane__(image(:,i),in(1,i),in(2,i),out(1,i),out(2,i),gamma(i))); + endfor + + else + ## image is a intensity image + if( !isvector(in) || length(in)!=2 || !isvector(out) || length(out)!=2 || !isscalar(gamma) || (gamma<0) || (gamma==Inf) ) + error("imadjust: on an intensity image, in and out must be 2-by-1 and gamma a positive scalar."); + endif + ret=__imadjust_plane__(image,in(1),in(2),out(1),out(2),gamma); + endif + + else + error("imadjust: first parameter must be a colormap, an intensity image or a RGB image"); + endif +endfunction + + +## This does all the work. I has a plane; li and hi input low and high +## values; and lo and ho, output bottom and top values. +## Image negative is computed if ho= li & I < hi) .* (lo + (ho - lo) .* ((I - li) / (hi - li)) .^ gamma); + ret = ret + (I >= hi) .* ho; +endfunction + + +## Checks in, out and gamma to see if they are ok for colormap and RGB +## cases. +function [in, out, gamma]=__imadjust_check_3d_args__(in, out, gamma) + switch(size(in)) + case([2,3]) + ## ok! + case([2,1]) + in=repmat(in,1,3); + case([1,2]) ## Compatibility behaviour! + in=repmat(in',1,3); + otherwise + error("imadjust: in must be 2-by-3 or 2-by-1."); + endswitch + + switch(size(out)) + case([2,3]) + ## ok! + case([2,1]) + out=repmat(out,1,3); + case([1,2]) ## Compatibility behaviour! + out=repmat(out',1,3); + otherwise + error("imadjust: out must be 2-by-3 or 2-by-1."); + endswitch + + switch(size(gamma)) + case([1,3]) + ## ok! + case([1,1]) + gamma=repmat(gamma,1,3); + otherwise + error("imadjust: gamma must be a scalar or a 1-by-3 matrix."); + endswitch + + ## check gamma allowed range + if(!all((gamma>=0)&(gamma. + +## -*- texinfo -*- +## @deftypefn {Function File} @var{B} = imcomplement(@var{A}) +## Computes the complement image. Intuitively this corresponds to the intensity +## of bright and dark regions being reversed. +## +## For binary images, the complement is computed as @code{!@var{A}}, for floating +## point images it is computed as @code{1 - @var{A}}, and for integer images as +## @code{intmax(class(@var{A})) - @var{A}}. +## @end deftypefn + +function B = imcomplement(A) + ## Check input + if (nargin != 1) + error("imcomplement: not enough input arguments"); + endif + if (!ismatrix(A)) + error("imcomplement: input must be an array"); + endif + + ## Take action depending on the class of A + if (isa(A, "double") || isa(A, "single")) + B = 1 - A; + elseif (islogical(A)) + B = !A; + elseif (isinteger(A)) + B = intmax(class(A)) - A; + else + error("imcomplement: unsupported input class: '%s'", class(A)); + endif +endfunction diff --git a/octave_packages/image-1.0.15/imdilate.m b/octave_packages/image-1.0.15/imdilate.m new file mode 100644 index 0000000..fd597da --- /dev/null +++ b/octave_packages/image-1.0.15/imdilate.m @@ -0,0 +1,51 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## Copyright (C) 2008 Soren Hauberg +## Copyright (C) 2010 Carnë Draug +## +## This program is free software; you can redistribute it and/or +## modify it under the terms of the GNU General Public License +## as published by the Free Software Foundation; either version 3 +## of the License, or (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. + +## -*- texinfo -*- +## @deftypefn {Function File} @var{B} = imdilate (@var{A}, @var{se}) +## Perform morphological dilation on a given image. +## +## The image @var{A} must be a grayscale or binary image, and @var{se} must be a +## structuring element. Both must have the same class, e.g., if @var{A} is a +## logical matrix, @var{se} must also be logical. +## +## @seealso{imerode, imopen, imclose} +## @end deftypefn + +function retval = imdilate(im, se) + ## Checkinput + if (nargin != 2) + print_usage(); + endif + if (!ismatrix(im) || !isreal(im)) + error("imdilate: first input argument must be a real matrix"); + elseif (!ismatrix(se) || !isreal(se)) + error("imdilate: second input argument must be a real matrix"); + elseif ( !strcmp(class(im), class(se)) ) + error("imdilate: image and structuring element must have the same class"); + endif + + ## Perform filtering + ## Filtering must be done with the reflection of the structuring element (they + ## are not always symmetrical) + se = imrotate(se, 180); + + ## If image is binary/logical, try to use filter2 (much faster) + if (islogical(im)) + retval = filter2(se,im)>0; + else + retval = ordfiltn(im, sum(se(:)!=0), se, 0); + endif + +endfunction diff --git a/octave_packages/image-1.0.15/imdither.m b/octave_packages/image-1.0.15/imdither.m new file mode 100644 index 0000000..64b849d --- /dev/null +++ b/octave_packages/image-1.0.15/imdither.m @@ -0,0 +1,103 @@ +## Copyright (C) 2009 Sergey Kirgizov +## +## This program is free software; you can redistribute it and/or +## modify it under the terms of the GNU General Public License +## as published by the Free Software Foundation; either version 3 +## of the License, or (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{Y}, @var{newmap}] = } imdither (@var{img}) +## @deftypefnx {Function File} {[@var{Y}, @var{newmap}] = } imdither (@var{img}, @ +## @var{colors}) +## @deftypefnx {Function File} {[@var{Y}, @var{newmap}] = } imdither (@var{img}, @ +## @var{colors}, @var{dithtype}) +## @deftypefnx {Function File} {[@var{Y}, @var{newmap}] = } imdither (@var{img}, @ +## @var{map}) +## @deftypefnx {Function File} {[@var{Y}, @var{newmap}] = } imdither (@var{img}, @ +## @var{map}, @var{colors}) +## @deftypefnx {Function File} {[@var{Y}, @var{newmap}] = } imdither(@var{img}, @ +## @var{map}, @var{colors}, @var{dithtype}) +## Reduce the number a colors of rgb or indexed image. +## +## Note: this requires the ImageMagick "convert" utility. +## get this from www.imagemagick.org if required +## additional documentation of options is available from the +## convert man page. +## +## where +## @var{dithtype} is a value from list: +## +## @itemize @bullet +## @item "None" +## @item "FloydSteinberg" (default) +## @item "Riemersma" +## @end itemize +## +## @var{colors} is a maximum number of colors in result map +## +## TODO: Add facility to use already created colormap over "-remap" option +## +## BUGS: This function return a 0-based indexed images +## when colormap size is lower or equals to 256 like at cmunique code +## @seealso{cmunique} +## +## @end deftypefn + +function [Y,newmap] = imdither(im,p1,p2,p3) + + colors="256"; + dithtype="FloydSteinberg"; + if ( nargin < 1 ) + usage([ ... + "imdither( rgb )\n", ... + "imdither( rgb,colors )\n", ... + "imdither( rgb,colors,dithtype )\n", ... + "imdither( img,map )\n", ... + "imdither( img,map,colors )\n", ... + "imdither( img,map,colors,dithtype )\n" + ]); + endif + + fname = [tmpnam(),".ppm"]; + if (nargin == 1 || isscalar(p1)) + # rgb + if (nargin >= 2) + colors=sprintf("%d",p1); + if (nargin >= 3) + dithtype=p2; + endif + endif + opts=["-colors ",colors;"-dither ",dithtype]; + imwrite(fname,im(:,:,1),im(:,:,2),im(:,:,3),opts); + [Y,newmap]=cmunique(imread(fname)); + delete(fname); + else + if (nargin <= 1) + usage([ ... + "imdither( rgb )\n", ... + "imdither( rgb,colors )\n", ... + "imdither( rgb,colors,dithtype )\n", ... + "imdither( img,map )\n", ... + "imdither( img,map,colors )\n", ... + "imdither( img,map,colors,dithtype )\n" + ]); + endif + # indexed + if (nargin >= 3) + colors=sprintf("%d",p2); + if (nargin >= 4) + dithtype=p3; + endif + endif + opts=["-colors ",colors;"-dither ",dithtype]; + im (rows(p1)<=256) + imwrite(fname,im,(p1+1),opts); + [Y,newmap]=cmunique(imread(fname)); + delete(fname); + endif +endfunction diff --git a/octave_packages/image-1.0.15/imerode.m b/octave_packages/image-1.0.15/imerode.m new file mode 100644 index 0000000..97b4be4 --- /dev/null +++ b/octave_packages/image-1.0.15/imerode.m @@ -0,0 +1,48 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## Copyright (C) 2008 Soren Hauberg +## Copyright (C) 2011 Carnë Draug +## +## This program is free software; you can redistribute it and/or +## modify it under the terms of the GNU General Public License +## as published by the Free Software Foundation; either version 3 +## of the License, or (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. + +## -*- texinfo -*- +## @deftypefn {Function File} @var{B} = imerode (@var{A}, @var{se}) +## Perform morphological erosion on a given image. +## +## The image @var{A} must be a grayscale or binary image, and @var{se} must be a +## structuring element. Both must have the same class, e.g., if @var{A} is a +## logical matrix, @var{se} must also be logical. +## +## @seealso{imdilate, imopen, imclose} +## @end deftypefn + +function retval = imerode(im, se) + ## Checkinput + if (nargin != 2) + print_usage(); + endif + if (!ismatrix(im) || !isreal(im)) + error("imerode: first input argument must be a real matrix"); + elseif (!ismatrix(se) || !isreal(se)) + error("imerode: second input argument must be a real matrix"); + elseif ( !strcmp(class(im), class(se)) ) + error("imerode: image and structuring element must have the same class"); + endif + + ## Perform filtering + ## If image is binary/logical, try to use filter2 (much faster) + if (islogical(im)) + thr = sum(se(:)); + retval = filter2(se,im) == thr; + else + retval = ordfiltn(im, 1, se, 0); + endif + +endfunction diff --git a/octave_packages/image-1.0.15/imfilter.m b/octave_packages/image-1.0.15/imfilter.m new file mode 100644 index 0000000..bd4ca49 --- /dev/null +++ b/octave_packages/image-1.0.15/imfilter.m @@ -0,0 +1,129 @@ +## Copyright (C) 2007 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{J} = imfilter(@var{I}, @var{f}) +## @deftypefnx{Function File} @var{J} = imfilter(@var{I}, @var{f}, @var{options}, ...) +## Computes the linear filtering of the image @var{I} and the filter @var{f}. +## The computation is performed using double precision floating point numbers, +## but the class of the input image is preserved as the following example shows. +## @example +## I = 255*ones(100, 100, "uint8"); +## f = fspecial("average", 3); +## J = imfilter(I, f); +## class(J) +## @result{} ans = uint8 +## @end example +## +## The function also accepts a number of optional arguments that control the +## details of the filtering. The following options is currently accepted +## @table @samp +## @item S +## If a scalar input argument is given, the image is padded with this scalar +## as part of the filtering. The default value is 0. +## @item "symmetric" +## The image is padded symmetrically. +## @item "replicate" +## The image is padded using the border of the image. +## @item "circular" +## The image is padded by circular repeating of the image elements. +## @item "same" +## The size of the output image is the same as the input image. This is the default +## behaviour. +## @item "full" +## Returns the full filtering result. +## @item "corr" +## The filtering is performed using correlation. This is the default behaviour. +## @item "conv" +## The filtering is performed using convolution. +## @end table +## @seealso{conv2, filter2, fspecial, padarray} +## @end deftypefn + +function retval = imfilter(im, f, varargin) + ## Check number of input arguments + if (nargin < 2) + print_usage(); + endif + + ## Check image + if (!ismatrix(im)) + error("imfilter: first input argument must be an image"); + endif + [imrows, imcols, imchannels, tmp] = size(im); + if (tmp != 1 || (imchannels != 1 && imchannels != 3)) + error("imfilter: first input argument must be an image"); + endif + C = class(im); + + ## Check filter (XXX: matlab support 3D filter, but I have no idea what they do with them) + if (!ismatrix(f)) + error("imfilter: second input argument must be a matrix"); + endif + [frows, fcols, tmp] = size(f); + if (tmp != 1) + error("imfilter: second argument must be a 2-dimensional matrix"); + endif + + ## Parse options + res_size = "same"; + res_size_options = {"same", "full"}; + pad = 0; + pad_options = {"symmetric", "replicate", "circular"}; + ftype = "corr"; + ftype_options = {"corr", "conv"}; + for i = 1:length(varargin) + v = varargin{i}; + if (any(strcmpi(v, pad_options)) || isscalar(v)) + pad = v; + elseif (any(strcmpi(v, res_size_options))) + res_size = v; + elseif (any(strcmpi(v, ftype_options))) + ftype = v; + else + warning("imfilter: cannot handle input argument number %d", i+2); + endif + endfor + + ## Pad the image + im = padarray(im, floor([frows/2, fcols/2]), pad); + if (mod(frows,2) == 0) + im = im(1:end-1, :, :); + endif + if (mod(fcols,2) == 0) + im = im(:, 1:end-1, :); + endif + + ## Do the filtering + if (strcmpi(res_size, "same")) + res_size = "valid"; + else # res_size == "full" + res_size = "same"; + endif + if (strcmpi(ftype, "corr")) + for i = imchannels:-1:1 + retval(:,:,i) = filter2(f, im(:,:,i), res_size); + endfor + else + for i = imchannels:-1:1 + retval(:,:,i) = conv2(im(:,:,i), f, res_size); + endfor + endif + + ## Change the class of the output to the class of the input + ## (the filtering functions returns doubles) + retval = cast(retval, C); + +endfunction diff --git a/octave_packages/image-1.0.15/imginfo.m b/octave_packages/image-1.0.15/imginfo.m new file mode 100644 index 0000000..b2118a4 --- /dev/null +++ b/octave_packages/image-1.0.15/imginfo.m @@ -0,0 +1,60 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## 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, or (at your option) any +## later version. +## +## This is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +## for more details. +## + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{hw} =} imginfo (@var{filename}) +## @deftypefnx{Function File} {[@var{h}, @var{w}] =} imginfo (@var{filename}) +## Get image size from file @var{filename}. +## +## The output is the size of the image +## @table @code +## @item @var{h} +## Height of image, in pixels. +## @item @var{w} +## Width of image, in pixels. +## @item @var{hw} = [@var{h}, @var{w}] +## Height and width of image. +## @end table +## +## NOTE : imginfo relies on the 'convert' program. +## @end deftypefn + +## Author: Etienne Grossmann +## Last modified: Setembro 2002 + +function [h,w] = imginfo (fn) + +warning ("'imginfo' has been deprecated in favor of 'imfinfo'. This function will be removed from future versions of the 'image' package"); + +[status, res] = system(sprintf("convert -verbose '%s' /dev/null",fn),1); + +if status, + error (["imginfo : 'convert' exited with status %i ",\ + "and produced\n%s\n"],\ + status, res); +end + +res = res(index(res," ")+1:length(res)); + +i = index (res,"x"); +if ! i, error ("imginfo : Can't interpret string (i)\n%s\n", res); end + +j = index (res(i-1:-1:1)," "); +if j<2, error ("imginfo : Can't interpret string (j)\n%s\n", res); end +w = str2num (res(i-j:i-1)); + +k = index (res(i+1:length(res))," "); +if k<2, error ("imginfo : Can't interpret string (k)\n%s\n", res); end +h = str2num (res(i+1:i+k)); + +if nargout<2, h = [h,w]; end diff --git a/octave_packages/image-1.0.15/imhist.m b/octave_packages/image-1.0.15/imhist.m new file mode 100644 index 0000000..768d3c7 --- /dev/null +++ b/octave_packages/image-1.0.15/imhist.m @@ -0,0 +1,71 @@ +## Copyright (C) 1999,2000 Kai Habel +## +## 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} {} imhist (@var{I},@var{n}) +## @deftypefnx {Function File} {} imhist (@var{I}) +## @deftypefnx {Function File} {} imhist (@var{X},@var{cmap}) +## @deftypefnx {Function File} {[@var{n,x}] = } imhist (...) +## Shows the histogram of an image using hist. +## @seealso{hist} +## @end deftypefn + +## Author: Kai Habel +## July 2000 : Paul Kienzle code simplification for hist() call. + +function [varargout] = imhist (I, b) + + if (nargin < 1 || nargin > 2) + print_usage(); + endif + + b_is_colormap = 0; + + if (nargin == 2) + if (ismatrix (b)) + b_is_colormap = (columns (b) == 3); + endif + endif + + if (b_is_colormap) + ## assuming I is an indexed image + ## b is colormap + max_idx = max (max (I)); + bins = rows (b); + if (max_idx > bins) + warning ("largest index exceedes length of colormap"); + endif + else + ## assuming I is an intensity image + ## b is number of bins + if (nargin == 1) + bins = 256; + else + bins = b; + endif + + ## scale image to range [0,1] + I = mat2gray (I); + endif + + if (nargout == 2) + [nn,xx] = hist (I(:), bins); + vr_val_cnt = 1; varargout{vr_val_cnt++} = nn; + varargout{vr_val_cnt++} = xx; + else + hist (I(:), bins); + endif + +endfunction diff --git a/octave_packages/image-1.0.15/immaximas.m b/octave_packages/image-1.0.15/immaximas.m new file mode 100644 index 0000000..0103e25 --- /dev/null +++ b/octave_packages/image-1.0.15/immaximas.m @@ -0,0 +1,108 @@ +## Copyright (c) 2003-2005 Peter Kovesi +## School of Computer Science & Software Engineering +## The University of Western Australia +## http://www.csse.uwa.edu.au/ +## +## Permission is hereby granted, free of charge, to any person obtaining a copy +## of this software and associated documentation files (the "Software"), to deal +## in the Software without restriction, subject to the following conditions: +## +## The above copyright notice and this permission notice shall be included in all +## copies or substantial portions of the Software. +## +## The Software is provided "as is", without warranty of any kind. +## +## I've made minor changes compared to the original 'nonmaxsuppts' function developed +## by Peter Kovesi. The original is available at +## http://www.csse.uwa.edu.au/~pk/research/matlabfns/Spatial/nonmaxsuppts.m +## -- Søren Hauberg, 2008 + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{r}, @var{c}] =} immaximas (@var{im}, @var{radius}) +## @deftypefnx{Function File} {[@var{r}, @var{c}] =} immaximas (@var{im}, @var{radius}, @var{thresh}) +## @deftypefnx{Function File} {[@var{r}, @var{c}, ...] =} immaximas (...) +## @deftypefnx{Function File} {[..., @var{val}] =} immaximas (...) +## Finds local spatial maximas of the given image. A local spatial maxima is +## defined as an image point with a value that is larger than all neighbouring +## values in a square region of width 2*@var{radius}+1. By default @var{radius} +## is 1, such that a 3 by 3 neighbourhood is searched. If the @var{thresh} input +## argument is supplied, only local maximas with a value greater than @var{thresh} +## are retained. +## +## The output vectors @var{r} and @var{c} contain the row-column coordinates +## of the local maximas. The actual values are computed to sub-pixel precision +## by fitting a parabola to the data around the pixel. If @var{im} is +## @math{N}-dimensional, then @math{N} vectors will be returned. +## +## If @var{im} is @math{N}-dimensional, and @math{N}+1 outputs are requested, +## then the last output will contain the image values at the maximas. Currently +## this value is not interpolated. +## +## @seealso{ordfilt2, ordfiltn} +## @end deftypefn + +function varargout = immaximas(im, radius, thresh) + ## Check input + if (nargin == 0) + error("immaximas: not enough input arguments"); + endif + if (nargin <= 1 || isempty(radius)) + radius = 1; + endif + if (nargin <= 2) + thresh = []; + endif + if (!ismatrix(im)) + error("immaximas: first input argument must be an array"); + endif + if (!isscalar(radius)) + error("immaximas: second input argument must be a scalar or an empty matrix"); + endif + if (!isscalar(thresh) && !isempty(thresh)) + error("immaximas: third input argument must be a scalar or an empty matrix"); + endif + + ## Find local maximas + nd = ndims(im); + s = size(im); + sze = 2*radius+1; + mx = ordfiltn(im, sze^nd, ones(repmat(sze,1, nd), "logical"), "reflect"); + mx2 = ordfiltn(im, sze^nd-1, ones(repmat(sze,1, nd), "logical"), "reflect"); + + # Find maxima, threshold + immx = (im == mx) & (im != mx2); + if (!isempty(thresh)) + immx &= (im>thresh); + endif + + ## Find local maximas and fit parabolas locally + ind = find(immx); + [sub{1:nd}] = ind2sub(s, ind); + if (!isempty(ind)) + w = 1; # Width that we look out on each side of the feature point to fit a local parabola + ws = w*cumprod([1; s(:)]); + + ## We fit a parabola to the points in each dimension + for d = 1:nd + ## Indices of points above, below, left and right of feature point + indminus1 = max(ind-ws(d), 1); + indplus1 = min(ind+ws(d), numel(immx)); + + ## Solve quadratic + c = im(ind); + a = (im(indminus1) + im(indplus1))/2 - c; + b = a + c - im(indminus1); + shift = -w*b./(2*a); # Maxima of quadradic + + ## Move point + sub{d} += shift; + endfor + endif + + ## Output + varargout(1:nd) = sub(1:nd); + if (nargout > nd) + varargout{nd+1} = im(ind); + endif +endfunction + diff --git a/octave_packages/image-1.0.15/imnoise.m b/octave_packages/image-1.0.15/imnoise.m new file mode 100644 index 0000000..0cd92b8 --- /dev/null +++ b/octave_packages/image-1.0.15/imnoise.m @@ -0,0 +1,72 @@ +## Copyright (C) 2000 Paul Kienzle +## +## 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{B} =} imnoise (@var{A}, @var{type}) +## Adds noise to image in @var{A}. +## +## @table @code +## @item imnoise (A, 'gaussian' [, mean [, var]]) +## additive gaussian noise: @var{B} = @var{A} + noise +## defaults to mean=0, var=0.01 +## @item imnoise (A, 'salt & pepper' [, density]) +## lost pixels: A = 0 or 1 for density*100% of the pixels +## defaults to density=0.05, or 5% +## @item imnoise (A, 'speckle' [, var]) +## multiplicative gaussian noise: @var{B} = @var{A} + @var{A}*noise +## defaults to var=0.04 +## @end table +## @end deftypefn + +## Modified: Stefan van der Walt , 2004-02-24 + +function A = imnoise(A, stype, a, b) + + if (nargin < 2 || nargin > 4 || !ismatrix(A) || !ischar(stype)) + usage("B = imnoise(A, type, parameters, ...)"); + endif + + valid = (min(A(:)) >= 0 && max(A(:)) <= 1); + + stype = tolower(stype); + if (strcmp(stype, 'gaussian')) + if (nargin < 3), a = 0.0; endif + if (nargin < 4), b = 0.01; endif + A = A + (a + randn(size(A)) * sqrt(b)); + ## Variance of Gaussian data with mean 0 is E[X^2] + elseif (strcmp(stype, 'salt & pepper')) + if (nargin < 3), a = 0.05; endif + noise = rand(size(A)); + A(noise <= a/2) = 0; + A(noise >= 1-a/2) = 1; + elseif (strcmp(stype, 'speckle')) + if (nargin < 3), a = 0.04; endif + A = A .* (1 + randn(size(A))*sqrt(a)); + else + error("imnoise: use type 'gaussian', 'salt & pepper', or 'speckle'"); + endif + + if valid + A(A>1) = 1; + A(A<0) = 0; + else + warning("Image should be in [0,1]"); + endif + +endfunction + +%!assert(var(imnoise(ones(10)/2,'gaussian')(:)),0.01,0.005) # probabilistic +%!assert(length(find(imnoise(ones(10)/2,'salt & pepper')~=0.5)),5,10) # probabilistic +%!assert(var(imnoise(ones(10)/2,'speckle')(:)),0.01,0.005) # probabilistic diff --git a/octave_packages/image-1.0.15/imopen.m b/octave_packages/image-1.0.15/imopen.m new file mode 100644 index 0000000..d5c814d --- /dev/null +++ b/octave_packages/image-1.0.15/imopen.m @@ -0,0 +1,41 @@ +## Copyright (C) 2008 Soren Hauberg +## +## 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. + +## -*- texinfo -*- +## @deftypefn {Function File} @var{B} = imopen (@var{A}, @var{se}) +## Perform morphological opening on a given image. +## The image @var{A} must be a grayscale or binary image, and @var{se} must be a +## structuring element. +## +## The opening corresponds to an erosion followed by a dilation of the image, i.e. +## @example +## B = imdilate(imerode(A, se), se); +## @end example +## @seealso{imdilate, imerode, imclose} +## @end deftypefn + +function retval = imopen(im, se) + ## Checkinput + if (nargin != 2) + print_usage(); + endif + if (!ismatrix(im) || !isreal(im)) + error("imopen: first input argument must be a real matrix"); + endif + if (!ismatrix(se) || !isreal(se)) + error("imopen: second input argument must be a real matrix"); + endif + + ## Perform filtering + retval = imdilate(imerode(im, se), se); + +endfunction diff --git a/octave_packages/image-1.0.15/impad.m b/octave_packages/image-1.0.15/impad.m new file mode 100644 index 0000000..d8151f9 --- /dev/null +++ b/octave_packages/image-1.0.15/impad.m @@ -0,0 +1,142 @@ +## Copyright (C) 2000 Teemu Ikonen +## +## 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} {} impad(@var{A}, @var{xpad}, @var{ypad}, [@var{padding}, [@var{const}]]) +## Pad (augment) a matrix for application of image processing algorithms. +## +## Pads the input image @var{A} with @var{xpad}(1) elements from left, +## @var{xpad}(2), elements from right, @var{ypad}(1) elements from above +## and @var{ypad}(2) elements from below. +## Values of padding elements are determined from the optional arguments +## @var{padding} and @var{const}. @var{padding} is one of +## +## @table @samp +## @item "zeros" +## pad with zeros (default) +## +## @item "ones" +## pad with ones +## +## @item "constant" +## pad with a value obtained from the optional fifth argument const +## +## @item "symmetric" +## pad with values obtained from @var{A} so that the padded image mirrors +## @var{A} starting from edges of @var{A} +## +## @item "reflect" +## same as symmetric, but the edge rows and columns are not used in the padding +## +## @item "replicate" +## pad with values obtained from A so that the padded image +## repeates itself in two dimensions +## +## @end table +## @end deftypefn + +## Author: Teemu Ikonen +## Created: 5.5.2000 +## Keywords: padding image processing + +## A nice test matrix for padding: +## A = 10*[1:5]' * ones(1,5) + ones(5,1)*[1:5] + +function retim = impad(im, xpad, ypad, padding = "zeros", const = 1) + ## Input checking + if (!ismatrix(im) || ndims(im) < 2 || ndims(im) > 3) + error("impad: first input argument must be an image"); + endif + if (isscalar(xpad) && xpad >= 0) + xpad(2) = xpad; + elseif (!isreal(xpad) || numel(xpad) != 2 || any(xpad < 0)) + error("impad: xpad must be a positive scalar or 2-vector"); + endif + if (isscalar(ypad) && ypad >= 0) + ypad(2) = ypad; + elseif (!isreal(ypad) || numel(ypad) != 2 || any(ypad < 0)) + error("impad: ypad must be a positive scalar or 2-vector"); + endif + if (!isscalar(const)) + error("impad: fifth input argument must be a scalar"); + endif + + origx = size(im,2); + origy = size(im,1); + retx = origx + xpad(1) + xpad(2); + rety = origy + ypad(1) + ypad(2); + cl = class(im); + + for iter = size(im,3):-1:1 + A = im(:,:,iter); + switch (lower(padding)) + case "zeros" + retval = zeros(rety, retx, cl); + retval(ypad(1)+1 : ypad(1)+origy, xpad(1)+1 : xpad(1)+origx) = A; + case "ones" + retval = ones(rety, retx, cl); + retval(ypad(1)+1 : ypad(1)+origy, xpad(1)+1 : xpad(1)+origx) = A; + case "constant" + retval = const.*ones(rety, retx, cl); + retval(ypad(1)+1 : ypad(1)+origy, xpad(1)+1 : xpad(1)+origx) = A; + case "replicate" + y1 = origy-ypad(1)+1; + x1 = origx-xpad(1)+1; + if (y1 < 1 || x1 < 1 || ypad(2) > origy || xpad(2) > origx) + error("impad: too large padding for this padding type"); + else + yrange1 = y1:origy; + yrange2 = 1:ypad(2); + xrange1 = x1:origx; + xrange2 = 1:xpad(2); + retval = [ A(yrange1, xrange1), A(yrange1, :), A(yrange1, xrange2); + A(:, xrange1), A, A(:, xrange2); + A(yrange2, xrange1), A(yrange2, :), A(yrange2, xrange2) ]; + endif + case "symmetric" + y2 = origy-ypad(2)+1; + x2 = origx-xpad(2)+1; + if (ypad(1) > origy || xpad(1) > origx || y2 < 1 || x2 < 1) + error("impad: too large padding for this padding type"); + else + yrange1 = 1 : ypad(1); + yrange2 = y2 : origy; + xrange1 = 1 : xpad(1); + xrange2 = x2 : origx; + retval = [ fliplr(flipud(A(yrange1, xrange1))), flipud(A(yrange1, :)), fliplr(flipud(A(yrange1, xrange2))); + fliplr(A(:, xrange1)), A, fliplr(A(:, xrange2)); + fliplr(flipud(A(yrange2, xrange1))), flipud(A(yrange2, :)), fliplr(flipud(A(yrange2, xrange2))) ]; + endif + case "reflect" + y2 = origy-ypad(2); + x2 = origx-xpad(2); + if (ypad(1)+1 > origy || xpad(1)+1 > origx || y2 < 1 || x2 < 1) + error("impad: too large padding for this padding type"); + else + yrange1 = 2 : ypad(1)+1; + yrange2 = y2 : origy-1; + xrange1 = 2 : xpad(1)+1; + xrange2 = x2 : origx-1; + retval = [ fliplr(flipud(A(yrange1, xrange1))), flipud(A(yrange1, :)), fliplr(flipud(A(yrange1, xrange2))); + fliplr(A(:, xrange1)), A, fliplr(A(:, xrange2)); + fliplr(flipud(A(yrange2, xrange1))), flipud(A(yrange2, :)), fliplr(flipud(A(yrange2, xrange2))) ]; + endif + otherwise + error("impad: unknown padding type"); + endswitch + + retim(:,:,iter) = retval; + endfor +endfunction diff --git a/octave_packages/image-1.0.15/imperspectivewarp.m b/octave_packages/image-1.0.15/imperspectivewarp.m new file mode 100644 index 0000000..deeff60 --- /dev/null +++ b/octave_packages/image-1.0.15/imperspectivewarp.m @@ -0,0 +1,168 @@ +## Copyright (C) 2006 Søren Hauberg +## +## 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, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{warped} = imperspectivewarp(@var{im}, @var{P}, @var{interp}, @var{bbox}, @var{extrapval}) +## @deftypefnx{Function File} [@var{warped}, @var{valid}] = imperspectivewarp(...) +## Applies the spatial perspective homogeneous transformation @var{P} to the image @var{im}. +## The transformation matrix @var{P} must be a 3x3 homogeneous matrix, or 2x2 or 2x3 +## affine transformation matrix. +## +## The resulting image @var{warped} is computed using an interpolation method that +## can be selected through the @var{interp} argument. This must be one +## of the following strings +## @table @code +## @item "nearest" +## Nearest neighbor interpolation. +## @item "linear" +## @itemx "bilinear" +## Bilinear interpolation. This is the default behavior. +## @item "cubic" +## @itemx "bicubic" +## Bicubic interpolation. +## @end table +## +## By default the resulting image contains the entire warped image. In some situation +## you only parts of the warped image. The argument @var{bbox} controls this, and can +## be one of the following strings +## @table @code +## @item "loose" +## The entire warped result is returned. This is the default behavior. +## @item "crop" +## The central part of the image of the same size as the input image is returned. +## @item "same" +## The size and coordinate system of the input image is keept. +## @end table +## +## All values of the result that fall outside the original image will +## be set to @var{extrapval}. For images of class @code{double} @var{extrapval} +## defaults to @code{NA} and for other classes it defaults to 0. +## +## The optional output @var{valid} is a matrix of the same size as @var{warped} +## that contains the value 1 in pixels where @var{warped} contains an interpolated +## value, and 0 in pixels where @var{warped} contains an extrapolated value. +## @seealso{imremap, imrotate, imresize, imshear, interp2} +## @end deftypefn + +function [warped, valid] = imperspectivewarp(im, P, interp = "bilinear", bbox = "loose", extrapolation_value = NA) + ## Check input + if (nargin < 2) + print_usage(); + endif + + [imrows, imcols, imchannels, tmp] = size(im); + if (tmp != 1 || (imchannels != 1 && imchannels != 3)) + error("imperspectivewarp: first input argument must be an image"); + endif + + if (ismatrix(P) && ndims(P) == 2) + if (issquare(P) && rows(P) == 3) # 3x3 matrix + if (P(3,3) != 0) + P /= P(3,3); + else + error("imperspectivewarp: P(3,3) must be non-zero"); + endif + elseif (rows(P) == 2 && (columns(P) == 2 || columns(P) == 3)) # 2x2 or 2x3 matrix + P(3,3) = 1; + else # unsupported matrix size + error("imperspectivewarp: transformation matrix must be 2x2, 2x3, or 3x3"); + endif + else + error("imperspectivewarp: transformation matrix not valid"); + endif + + if (!any(strcmpi(interp, {"nearest", "linear", "bilinear", "cubic", "bicubic"}))) + error("imperspectivewarp: unsupported interpolation method"); + endif + if (any(strcmpi(interp, {"bilinear", "bicubic"}))) + interp = interp(3:end); # Remove "bi" + endif + interp = lower(interp); + + if (!any(strcmpi(bbox, {"loose", "crop", "same"}))) + error("imperspectivewarp: bounding box must be either 'loose', 'crop', or 'same'"); + endif + + if (!isscalar(extrapolation_value)) + error("imperspective: extrapolation value must be a scalar"); + endif + + ## Do the transformation + [y, x, tmp] = size(im); + ## Transform corners + corners = [1, 1, 1; + 1, y, 1; + x, 1, 1; + x, y, 1]'; + Tcorners = P*corners; + Tx = Tcorners(1,:)./Tcorners(3,:); + Ty = Tcorners(2,:)./Tcorners(3,:); + + ## Do cropping? + x1 = round(min(Tx)); x2 = round(max(Tx)); + y1 = round(min(Ty)); y2 = round(max(Ty)); + # FIXME: This seems to work fine for rotations, but + # somebody who knows computational geometry should + # be able to come up with a better algorithm. + if (strcmpi(bbox, "crop")) + xl = x2 - x1 + 1; + yl = y2 - y1 + 1; + xd = (xl - x)/2; + yd = (yl - y)/2; + x1 += xd; x2 -= xd; + y1 += yd; y2 -= yd; + elseif (strcmpi(bbox, "same")) + x1 = 1; x2 = x; + y1 = 1; y2 = y; + endif + + ## Transform coordinates + [X, Y] = meshgrid(x1:x2, y1:y2); + [sy, sx] = size(X); + D = [X(:), Y(:), ones(sx*sy, 1)]'; + PD = inv(P)*D; + XI = PD(1,:)./PD(3,:); + YI = PD(2,:)./PD(3,:); + XI = reshape(XI, sy, sx); + YI = reshape(YI, sy, sx); + + clear X Y D PD; + + ## Interpolate + [warped, valid] = imremap(im, XI, YI, interp, extrapolation_value); + +endfunction + +%!demo +%! ## Generate a synthetic image and show it +%! I = tril(ones(100)) + abs(rand(100)); I(I>1) = 1; +%! I(20:30, 20:30) = !I(20:30, 20:30); +%! I(70:80, 70:80) = !I(70:80, 70:80); +%! figure(), imshow(I); +%! ## Resize the image to the double size and show it +%! P = diag([1, 1, 0.5]); +%! warped = imperspectivewarp(I, P); +%! figure(), imshow(warped); + +%!demo +%! ## Generate a synthetic image and show it +%! I = tril(ones(100)) + abs(rand(100)); I(I>1) = 1; +%! I(20:30, 20:30) = !I(20:30, 20:30); +%! I(70:80, 70:80) = !I(70:80, 70:80); +%! figure(), imshow(I); +%! ## Rotate the image around (0, 0) by -0.4 radians and show it +%! R = [cos(-0.4) sin(-0.4); -sin(-0.4) cos(-0.4)]; +%! warped = imperspectivewarp(I, R, :, :, 0); +%! figure(), imshow(warped); diff --git a/octave_packages/image-1.0.15/imremap.m b/octave_packages/image-1.0.15/imremap.m new file mode 100644 index 0000000..8675461 --- /dev/null +++ b/octave_packages/image-1.0.15/imremap.m @@ -0,0 +1,229 @@ +## Copyright (C) 2006 Søren Hauberg +## +## 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, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{warped} = imremap(@var{im}, @var{XI}, @var{YI}) +## @deftypefnx{Function File} @var{warped} = imremap(@var{im}, @var{XI}, @var{YI}, @var{interp}, @var{extrapval}) +## @deftypefnx{Function File} [@var{warped}, @var{valid} ] = imremap(...) +## Applies any geometric transformation to the image @var{im}. +## +## The arguments @var{XI} and @var{YI} are lookup tables that define the resulting +## image +## @example +## @var{warped}(y,x) = @var{im}(@var{YI}(y,x), @var{XI}(y,x)) +## @end example +## where @var{im} is assumed to be a continuous function, which is achieved +## by interpolation. Note that the image @var{im} is expressed in a (X, Y)-coordinate +## system and not a (row, column) system. +## +## The argument @var{interp} selects the used interpolation method, and most be one +## of the following strings +## @table @code +## @item "nearest" +## Nearest neighbor interpolation. +## @item "linear" +## @itemx "bilinear" +## Bilinear interpolation. This is the default behavior. +## @item "cubic" +## @itemx "bicubic" +## Bicubic interpolation. +## @end table +## +## All values of the result that fall outside the original image will +## be set to @var{extrapval}. For images of class @code{double} @var{extrapval} +## defaults to @code{NA} and for other classes it defaults to 0. +## +## The optional output @var{valid} is a matrix of the same size as @var{warped} +## that contains the value 1 in pixels where @var{warped} contains an interpolated +## value, and 0 in pixels where @var{warped} contains an extrapolated value. +## @seealso{imperspectivewarp, imrotate, imresize, imshear, interp2} +## @end deftypefn + +function [warped, valid] = imremap(im, XI, YI, interp = "bilinear", extrapval = NA) + ## Check input + if (nargin < 3) + print_usage(); + endif + + [imrows, imcols, imchannels, tmp] = size(im); + if (tmp != 1 || (imchannels != 1 && imchannels != 3)) + error("imremap: first input argument must be an image"); + endif + + if (!size_equal(XI, YI) || !ismatrix(XI) || ndims(XI) != 2) + error("imremap: XI and YI must be matrices of the same size"); + endif + + if (!any(strcmpi(interp, {"nearest", "linear", "bilinear", "cubic", "bicubic", "spline"}))) + error("imremap: unsupported interpolation method"); + endif + if (any(strcmpi(interp, {"bilinear", "bicubic"}))) + interp = interp(3:end); # Remove "bi" + endif + interp = lower(interp); + + if (!isscalar(extrapval)) + error("imremap: extrapolation value must be a scalar"); + endif + + ## Interpolate + if (imchannels == 1) # Gray + warped = grayinterp(im, XI, YI, interp, NA); + else # rgb image + for i = 3:-1:1 + warped(:,:,i) = grayinterp(im(:,:,i), XI, YI, interp, NA); + endfor + endif + valid = !isna(warped); + warped(!valid) = extrapval; + + ## Change the class of the results according to the class of the image + c = class(im); + if (strcmpi(c, "uint8")) + warped = uint8(warped); + elseif (strcmpi(c, "uint16")) + warped = uint16(warped); + endif + +endfunction + +function [warped, valid] = grayinterp(im, XI, YI, interp, extrapval) + if (strcmp(interp, "cubic")) + warped = graybicubic(double(im), XI, YI, NA); + else + warped = interp2(double(im), XI, YI, interp, NA); + endif + valid = !isna(warped); + warped(!valid) = extrapval; +endfunction + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{zi}=} bicubic (@var{x}, @var{y}, @var{z}, @var{xi}, @var{yi}) +## Reference: +## Image Processing, Analysis, and Machine Vision, 2nd Ed. +## Sonka et.al. +## Brooks/Cole Publishing Company +## ISBN: 0-534-95393-X +## @seealso{interp2} +## @end deftypefn + +function ZI = graybicubic (Z, XI, YI, extrapval = NA) + + ## Allocate output + [X, Y] = meshgrid(1:columns(Z), 1:rows(Z)); + [Zr, Zc] = size(XI); + ZI = zeros(Zr, Zc); + + ## Find inliers + inside = !( XI < X(1) | XI > X(end) | YI < Y(1) | YI > Y(end) ); + + ## Scale XI and YI to match indices of Z (not needed when interpolating images) + #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(inside) = AY_2 .* AX_2 .* Z(sym_sub2ind(sz, L+2, K+2)) ... + 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; + +endfunction + +## Checks if data is meshgrided +function b = isgriddata(X) + D = X - repmat(X(1,:), rows(X), 1); + b = all(D(:) == 0); +endfunction + +## Checks if data is equally spaced (assumes data is meshgrided) +function b = isequallyspaced(X) + Dx = gradient(X(1,:)); + b = all(Dx == Dx(1)); +endfunction + +## Computes the 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 +%! ## Generate a synthetic image and show it +%! I = tril(ones(100)) + abs(rand(100)); I(I>1) = 1; +%! I(20:30, 20:30) = !I(20:30, 20:30); +%! I(70:80, 70:80) = !I(70:80, 70:80); +%! figure, imshow(I); +%! ## Resize the image to the double size and show it +%! [XI, YI] = meshgrid(linspace(1, 100, 200)); +%! warped = imremap(I, XI, YI); +%! figure, imshow(warped); + +%!demo +%! ## Generate a synthetic image and show it +%! I = tril(ones(100)) + abs(rand(100)); I(I>1) = 1; +%! I(20:30, 20:30) = !I(20:30, 20:30); +%! I(70:80, 70:80) = !I(70:80, 70:80); +%! figure, imshow(I); +%! ## Rotate the image around (0, 0) by -0.4 radians and show it +%! [XI, YI] = meshgrid(1:100); +%! R = [cos(-0.4) sin(-0.4); -sin(-0.4) cos(-0.4)]; +%! RXY = [XI(:), YI(:)] * R; +%! XI = reshape(RXY(:,1), [100, 100]); YI = reshape(RXY(:,2), [100, 100]); +%! warped = imremap(I, XI, YI); +%! figure, imshow(warped); diff --git a/octave_packages/image-1.0.15/imresize.m b/octave_packages/image-1.0.15/imresize.m new file mode 100644 index 0000000..84d40d9 --- /dev/null +++ b/octave_packages/image-1.0.15/imresize.m @@ -0,0 +1,67 @@ +## Copyright (C) 2005 Søren Hauberg +## +## 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{B}= imresize (@var{A}, @var{m}) +## Scales the image @var{A} by a factor @var{m} using bicubic neighbour +## interpolation. If @var{m} is less than 1 the image size will be reduced, +## and if @var{m} is greater than 1 the image will be enlarged. +## +## @deftypefnx {Function File} @var{B}= imresize (@var{A}, @var{m}, @var{interp}) +## Same as above except @var{interp} interpolation is performed instead of +## using nearest neighbour. @var{interp} can be any interpolation method supported by interp2. +## By default, bicubic interpolation is used. +## +## @deftypefnx {Function File} @var{B}= imresize (@var{A}, [@var{mrow} @var{mcol}]) +## Scales the image @var{A} to be of size @var{mrow}x@var{mcol}. +## +## @deftypefnx {Function File} @var{B}= imresize (@var{A}, [@var{mrow} @var{mcol}], @var{interp}) +## Same as above except @var{interp} interpolation is performed. @var{interp} can +## be any interpolation method supported by interp2. +## @seealso{imremap, imrotate, interp2} +## @end deftypefn + +function ret = imresize(im, m, interp = "bicubic") + if (nargin < 2) + error ("imresize: not enough input arguments"); + endif + + [row, col, num_planes, tmp] = size (im); + if (tmp != 1 || (num_planes != 1 && num_planes != 3)) + error ("imresize: the first argument has must be an image"); + endif + + ## Handle the argument that describes the size of the result + if (length (m) == 1) + new_row = round (row*m); + new_col = round (col*m); + elseif (length (m) == 2) + new_row = m (1); + new_col = m (2); + m = min (new_row/row, new_col/col); + else + error ("imresize: second argument mest be a scalar or a 2-vector"); + end + + ## Handle the method argument + if (!any (strcmpi (interp, {"nearest", "linear", "bilinear", "cubic", "bicubic", "pchip"}))) + error ("imresize: unsupported interpolation method"); + endif + + + ## Perform the actual resizing + [XI, YI] = meshgrid (linspace (1,col, new_col), linspace (1, row, new_row) ); + ret = imremap (im, XI, YI, interp); +endfunction diff --git a/octave_packages/image-1.0.15/imrotate.m b/octave_packages/image-1.0.15/imrotate.m new file mode 100644 index 0000000..f4ab66d --- /dev/null +++ b/octave_packages/image-1.0.15/imrotate.m @@ -0,0 +1,235 @@ +## Copyright (C) 2004-2005 Justus H. Piater +## +## 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} {} imrotate(@var{imgPre}, @var{theta}, @var{method}, @var{bbox}, @var{extrapval}) +## Rotation of a 2D matrix about its center. +## +## Input parameters: +## +## @var{imgPre} a gray-level image matrix +## +## @var{theta} the rotation angle in degrees counterclockwise +## +## @var{method} +## @itemize @w +## @item "nearest" neighbor: fast, but produces aliasing effects (default). +## @item "bilinear" interpolation: does anti-aliasing, but is slightly slower. +## @item "bicubic" interpolation: does anti-aliasing, preserves edges better than bilinear interpolation, but gray levels may slightly overshoot at sharp edges. This is probably the best method for most purposes, but also the slowest. +## @item "Fourier" uses Fourier interpolation, decomposing the rotation matrix into 3 shears. This method often results in different artifacts than homography-based methods. Instead of slightly blurry edges, this method can result in ringing artifacts (little waves near high-contrast edges). However, Fourier interpolation is better at maintaining the image information, so that unrotating will result in an image closer to the original than the other methods. +## @end itemize +## +## @var{bbox} +## @itemize @w +## @item "loose" grows the image to accommodate the rotated image (default). +## @item "crop" rotates the image about its center, clipping any part of the image that is moved outside its boundaries. +## @end itemize +## +## @var{extrapval} sets the value used for extrapolation. The default value +## is @code{NA} for images represented using doubles, and 0 otherwise. +## This argument is ignored of Fourier interpolation is used. +## +## Output parameters: +## +## @var{imgPost} the rotated image matrix +## +## @var{H} the homography mapping original to rotated pixel +## coordinates. To map a coordinate vector c = [x;y] to its +## rotated location, compute round((@var{H} * [c; 1])(1:2)). +## +## @var{valid} a binary matrix describing which pixels are valid, +## and which pixels are extrapolated. This output is +## not available if Fourier interpolation is used. +## @end deftypefn + +## Author: Justus H. Piater +## Created: 2004-10-18 +## Version: 0.7 + +function [imgPost, H, valid] = imrotate(imgPre, thetaDeg, interp="nearest", bbox="loose", extrapval=NA) + ## Check input + if (nargin < 2) + error("imrotate: not enough input arguments"); + endif + [imrows, imcols, imchannels, tmp] = size(imgPre); + if (tmp != 1 || (imchannels != 1 && imchannels != 3)) + error("imrotate: first input argument must be an image"); + endif + if (!isscalar(thetaDeg)) + error("imrotate: the angle must be given as a scalar"); + endif + if (!any(strcmpi(interp, {"nearest", "linear", "bilinear", "cubic", "bicubic", "Fourier"}))) + error("imrotate: unsupported interpolation method"); + endif + if (any(strcmpi(interp, {"bilinear", "bicubic"}))) + interp = interp(3:end); # Remove "bi" + endif + if (!any(strcmpi(bbox, {"loose", "crop"}))) + error("imrotate: bounding box must be either 'loose' or 'crop'"); + endif + if (!isscalar(extrapval)) + error("imrotate: extrapolation value must be a scalar"); + endif + + ## Input checking done. Start working + thetaDeg = mod(thetaDeg, 360); # some code below relies on positive angles + theta = thetaDeg * pi/180; + + sizePre = size(imgPre); + + ## We think in x,y coordinates here (rather than row,column), except + ## for size... variables that follow the usual size() convention. The + ## coordinate system is aligned with the pixel centers. + + R = [cos(theta) sin(theta); -sin(theta) cos(theta)]; + + if (nargin >= 4 && strcmp(bbox, "crop")) + sizePost = sizePre; + else + ## Compute new size by projecting zero-base image corner pixel + ## coordinates through the rotation: + corners = [0, 0; + (R * [sizePre(2) - 1; 0 ])'; + (R * [sizePre(2) - 1; sizePre(1) - 1])'; + (R * [0 ; sizePre(1) - 1])' ]; + sizePost(2) = round(max(corners(:,1)) - min(corners(:,1))) + 1; + sizePost(1) = round(max(corners(:,2)) - min(corners(:,2))) + 1; + ## This size computation yields perfect results for 0-degree (mod + ## 90) rotations and, together with the computation of the center of + ## rotation below, yields an image whose corresponding region is + ## identical to "crop". However, we may lose a boundary of a + ## fractional pixel for general angles. + endif + + ## Compute the center of rotation and the translational part of the + ## homography: + oPre = ([ sizePre(2); sizePre(1)] + 1) / 2; + oPost = ([sizePost(2); sizePost(1)] + 1) / 2; + T = oPost - R * oPre; # translation part of the homography + + ## And here is the homography mapping old to new coordinates: + H = [[R; 0 0] [T; 1]]; + + ## Treat trivial rotations specially (multiples of 90 degrees): + if (mod(thetaDeg, 90) == 0) + nRot90 = mod(thetaDeg, 360) / 90; + if (mod(thetaDeg, 180) == 0 || sizePre(1) == sizePre(2) || + strcmpi(bbox, "loose")) + imgPost = rot90(imgPre, nRot90); + return; + elseif (mod(sizePre(1), 2) == mod(sizePre(2), 2)) + ## Here, bbox is "crop" and the rotation angle is +/- 90 degrees. + ## This works only if the image dimensions are of equal parity. + imgRot = rot90(imgPre, nRot90); + imgPost = zeros(sizePre); + hw = min(sizePre) / 2 - 0.5; + imgPost (round(oPost(2) - hw) : round(oPost(2) + hw), + round(oPost(1) - hw) : round(oPost(1) + hw) ) = ... + imgRot(round(oPost(1) - hw) : round(oPost(1) + hw), + round(oPost(2) - hw) : round(oPost(2) + hw) ); + return; + else + ## Here, bbox is "crop", the rotation angle is +/- 90 degrees, and + ## the image dimensions are of unequal parity. This case cannot + ## correctly be handled by rot90() because the image square to be + ## cropped does not align with the pixels - we must interpolate. A + ## caller who wants to avoid this should ensure that the image + ## dimensions are of equal parity. + endif + end + + ## Now the actual rotations happen + if (strcmpi(interp, "Fourier")) + c = class (imgPre); + imgPre = im2double (imgPre); + if (isgray(imgPre)) + imgPost = imrotate_Fourier(imgPre, thetaDeg, interp, bbox); + else # rgb image + for i = 3:-1:1 + imgPost(:,:,i) = imrotate_Fourier(imgPre(:,:,i), thetaDeg, interp, bbox); + endfor + endif + valid = NA; + + switch (c) + case "uint8" + imgPost = im2uint8 (imgPost); + case "uint16" + imgPost = im2uint16 (imgPost); + case "single" + imgPost = single (imgPost); + endswitch + else + [imgPost, valid] = imperspectivewarp(imgPre, H, interp, bbox, extrapval); + endif +endfunction + +%!test +%! ## Verify minimal loss across six rotations that add up to 360 +/- 1 deg.: +%! methods = { "nearest", "bilinear", "bicubic", "Fourier" }; +%! angles = [ 59 60 61 ]; +%! tolerances = [ 7.4 8.5 8.6 # nearest +%! 3.5 3.1 3.5 # bilinear +%! 2.7 2.0 2.7 # bicubic +%! 2.7 1.6 2.8 ]/8; # Fourier +%! +%! # This is peaks(50) without the dependency on the plot package +%! x = y = linspace(-3,3,50); +%! [X,Y] = meshgrid(x,y); +%! x = 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); +%! +%! x -= min(x(:)); # Fourier does not handle neg. values well +%! x = x./max(x(:)); +%! for m = 1:(length(methods)) +%! y = x; +%! for i = 1:5 +%! y = imrotate(y, 60, methods{m}, "crop", 0); +%! end +%! for a = 1:(length(angles)) +%! assert(norm((x - imrotate(y, angles(a), methods{m}, "crop", 0)) +%! (10:40, 10:40)) < tolerances(m,a)); +%! end +%! end + + +%!#test +%! ## Verify exactness of near-90 and 90-degree rotations: +%! X = rand(99); +%! for angle = [90 180 270] +%! for da = [-0.1 0.1] +%! Y = imrotate(X, angle + da , "nearest", :, 0); +%! Z = imrotate(Y, -(angle + da), "nearest", :, 0); +%! assert(norm(X - Z) == 0); # exact zero-sum rotation +%! assert(norm(Y - imrotate(X, angle, "nearest", :, 0)) == 0); # near zero-sum +%! end +%! end + + +%!#test +%! ## Verify preserved pixel density: +%! methods = { "nearest", "bilinear", "bicubic", "Fourier" }; +%! ## This test does not seem to do justice to the Fourier method...: +%! tolerances = [ 4 2.2 2.0 209 ]; +%! range = 3:9:100; +%! for m = 1:(length(methods)) +%! t = []; +%! for n = range +%! t(end + 1) = sum(imrotate(eye(n), 20, methods{m}, :, 0)(:)); +%! end +%! assert(t, range, tolerances(m)); +%! end + diff --git a/octave_packages/image-1.0.15/imrotate_Fourier.m b/octave_packages/image-1.0.15/imrotate_Fourier.m new file mode 100644 index 0000000..b309726 --- /dev/null +++ b/octave_packages/image-1.0.15/imrotate_Fourier.m @@ -0,0 +1,186 @@ +## Copyright (C) 2002 Jeff Orchard +## +## 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} {} imrotate(@var{M}, @var{theta}, @var{method}, @var{bbox}) +## Rotation of a 2D matrix. +## +## Applies a rotation of @var{THETA} degrees to matrix @var{M}. +## +## The @var{method} argument is not implemented, and is only included for compatibility with Matlab. +## This function uses Fourier interpolation, +## decomposing the rotation matrix into 3 shears. +## +## @var{bbox} can be either 'loose' or 'crop'. +## 'loose' allows the image to grow to accomodate the rotated image. +## 'crop' keeps the same size as the original, clipping any part of the image +## that is moved outside the bounding box. +## @end deftypefn + +## Author: Jeff Orchard +## Created: Oct. 14, 2002 + +function fs = imrotate_Fourier(f, theta, method="fourier", bbox="loose") + + ## Input checking + if (nargin < 2) + error("imrotate_Fourier: not enough input arguments"); + endif + [imrows, imcols, tmp] = size(f); + if (tmp != 1) + error("imrotate_Fourier: first input argument must be a gray-scale image"); + endif + if (!isscalar(theta)) + error("imrotate_Fourier: second input argument must be a real scalar"); + endif + + # Get original dimensions. + [ydim_orig, xdim_orig] = size(f); + + # This finds the index coords of the centre of the image (indices are base-1) + # eg. if xdim_orig=8, then xcentre_orig=4.5 (half-way between 1 and 8) + xcentre_orig = (xdim_orig+1) / 2; + ycentre_orig = (ydim_orig+1) / 2; + + # Pre-process the angle =========================================================== + # Whichever 90 degree multiple theta is closest to, that multiple of 90 will + # be implemented by rot90. The remainder will be done by shears. + + # This ensures that 0 <= theta < 360. + theta = rem( rem(theta,360) + 360, 360 ); + + # This is a flag to keep track of 90-degree rotations. + perp = 0; + + if ( theta>=0 && theta<=45 ) + phi = theta; + elseif ( theta>45 && theta<=135 ) + phi = theta - 90; + f = rot90(f,1); + perp = 1; + elseif ( theta>135 && theta<=225 ) + phi = theta - 180; + f = rot90(f,2); + elseif ( theta>225 && theta<=315 ) + phi = theta - 270; + f = rot90(f,3); + perp = 1; + else + phi = theta; + endif + + + + if ( phi == 0 ) + fs = f; + if ( strcmp(bbox,"loose") == 1 ) + return; + else + xmax = xcentre_orig; + ymax = ycentre_orig; + if ( perp == 1 ) + xmax = max([xmax ycentre_orig]); + ymax = max([ymax xcentre_orig]); + [ydim xdim] = size(fs); + xpad = ceil( xmax - (xdim+1)/2 ); + ypad = ceil( ymax - (ydim+1)/2 ); + fs = impad(fs, [xpad,xpad], [ypad,ypad], "zeros"); + endif + xcentre_new = (size(fs,2)+1) / 2; + ycentre_new = (size(fs,1)+1) / 2; + endif + else + + # At this point, we can assume -451) = 1; + fs(fs<0) = 0; + endif + +endfunction + +function [S1, S2] = MakeShears(theta) + S1 = eye(2); + S2 = eye(2); + + S1(1,2) = -tan(theta/2); + S2(2,1) = sin(theta); +endfunction diff --git a/octave_packages/image-1.0.15/imshear.m b/octave_packages/image-1.0.15/imshear.m new file mode 100644 index 0000000..7e432e8 --- /dev/null +++ b/octave_packages/image-1.0.15/imshear.m @@ -0,0 +1,129 @@ +## Copyright (C) 2002 Jeff Orchard +## +## 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} {} imshear (@var{M}, @var{axis}, @var{alpha}, @var{bbox}) +## Applies a shear to the image @var{M}. +## +## The argument @var{M} is either a matrix or an RGB image. +## +## @var{axis} is the axis along which the shear is to be applied, and can +## be either 'x' or 'y'. +## For example, to shear sideways is to shear along the 'x' axis. Choosing +## 'y' causes an up/down shearing. +## +## @var{alpha} is the slope of the shear. For an 'x' shear, it is the +## horizontal shift (in pixels) applied to the pixel above the +## center. For a 'y' shear, it is the vertical shift (in pixels) +## applied to the pixel just to the right of the center pixel. +## +## NOTE: @var{alpha} does NOT need to be an integer. +## +## @var{bbox} can be one of 'loose', 'crop' or 'wrap'. +## 'loose' allows the image to grow to accomodate the new transformed image. +## 'crop' keeps the same size as the original, clipping any part of the image +## that is moved outside the bounding box. +## 'wrap' keeps the same size as the original, but does not clip the part +## of the image that is outside the bounding box. Instead, it wraps it back +## into the image. +## +## If called with only 3 arguments, @var{bbox} is set to 'loose' by default. +## @end deftypefn + +## Author: Jeff Orchard +## Created: June 2002 + +function g = imshear(m, axis, alpha, bbox, noshift) + + # The code below only does y-shearing. This is because of + # the implementation of fft (operates on columns, but not rows). + # So, transpose first for x-shearing. + if ( strcmp(axis, "x")==1 ) + m = m'; + endif + + if ( nargin < 4 ) + bbox = "loose"; + noshift = 0; + elseif ( nargin < 5 ) + noshift = 0; + endif + + [ydim_orig xdim_orig] = size(m); + if ( strcmp(bbox, "wrap") == 0 ) + ypad = ceil( (xdim_orig+1)/2 * abs(alpha) ); + m = impad(m, [0,0], [ypad,ypad]); + endif + + [ydim_new xdim_new] = size(m); + xcentre = ( xdim_new + 1 ) / 2; + ycentre = ( ydim_new + 1 ) / 2; + + # This applies FFT to columns of m (x-axis remains a spatial axis). + # Because the way that fft and fftshift are implemented, the origin + # will move by 1/2 pixel, depending on the polarity of the image + # dimensions. + # + # If dim is even (=2n), then the origin of the fft below is located + # at the centre of pixel (n+1). ie. if dim=16, then centre is at 9. + # + # If dim is odd (=2n+1), then the origin of the fft below is located + # at the centre of pixel (n). ie. if dim=15, then centre is at 8. + if ( noshift==1 ) + M = fft(m); + else + #M = imtranslate(fft(imtranslate(m, -xcentre, ycentre, "wrap")), xcentre, -ycentre, "wrap"); + M = fftshift(fft(fftshift(m))); + endif + + [ydim xdim] = size(m); + x = zeros(ydim, xdim); + + # Find coords of the origin of the image. + if ( noshift==1 ) + xc_coord = 1; + yc_coord = 1; + l = (1:ydim)' - yc_coord; + r = (1:xdim) - xc_coord; + if ( strcmp(bbox, "wrap")==1 ) + l((ydim/2):ydim) = l((ydim/2):ydim) - ydim; + r((xdim/2):xdim) = r((xdim/2):xdim) - xdim; + endif + else + xc_coord = (xdim+1)/2; + yc_coord = (ydim+1)/2; + l = (1:ydim)' - yc_coord; + r = (1:xdim) - xc_coord; + endif + x = l * r; + + Ms = M.* exp(2*pi*I*alpha/ydim * x); + + if ( noshift==1 ) + g = abs(ifft(Ms)); + else + #g = abs(imtranslate( ifft( imtranslate(Ms, -xcentre, ycentre, "wrap") ), xcentre, -ycentre, "wrap")); + g = abs( fftshift(ifft(ifftshift(Ms))) ); + endif + + if ( strcmp(bbox, "crop")==1 ) + g = g(ypad+1:ydim_orig+ypad, :); + endif + + # Un-transpose if x-shearing was wanted + if ( strcmp(axis, "x")==1 ) + g = g'; + endif +endfunction diff --git a/octave_packages/image-1.0.15/imsmooth.m b/octave_packages/image-1.0.15/imsmooth.m new file mode 100644 index 0000000..03d322c --- /dev/null +++ b/octave_packages/image-1.0.15/imsmooth.m @@ -0,0 +1,500 @@ +## Copyright (C) 2007 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{J} = imsmooth(@var{I}, @var{name}, @var{options}) +## Smooth the given image using several different algorithms. +## +## The first input argument @var{I} is the image to be smoothed. If it is an RGB +## image, each color plane is treated separately. +## The variable @var{name} must be a string that determines which algorithm will +## be used in the smoothing. It can be any of the following strings +## +## @table @asis +## @item "Gaussian" +## Isotropic Gaussian smoothing. This is the default. +## @item "Average" +## Smoothing using a rectangular averaging linear filter. +## @item "Disk" +## Smoothing using a circular averaging linear filter. +## @item "Median" +## Median filtering. +## @item "Bilateral" +## Gaussian bilateral filtering. +## @item "Perona & Malik" +## @itemx "Perona and Malik" +## @itemx "P&M" +## Smoothing using nonlinear isotropic diffusion as described by Perona and Malik. +## @item "Custom Gaussian" +## Gaussian smoothing with a spatially varying covariance matrix. +## @end table +## +## In all algorithms the computation is done in double precision floating point +## numbers, but the result has the same type as the input. Also, the size of the +## smoothed image is the same as the input image. +## +## @strong{Isotropic Gaussian smoothing} +## +## The image is convolved with a Gaussian filter with spread @var{sigma}. +## By default @var{sigma} is @math{0.5}, but this can be changed. If the third +## input argument is a scalar it is used as the filter spread. +## +## The image is extrapolated symmetrically before the convolution operation. +## +## @strong{Rectangular averaging linear filter} +## +## The image is convolved with @var{N} by @var{M} rectangular averaging filter. +## By default a 3 by 3 filter is used, but this can e changed. If the third +## input argument is a scalar @var{N} a @var{N} by @var{N} filter is used. If the third +## input argument is a two-vector @code{[@var{N}, @var{M}]} a @var{N} by @var{M} +## filter is used. +## +## The image is extrapolated symmetrically before the convolution operation. +## +## @strong{Circular averaging linear filter} +## +## The image is convolved with circular averaging filter. By default the filter +## has a radius of 5, but this can e changed. If the third input argument is a +## scalar @var{r} the radius will be @var{r}. +## +## The image is extrapolated symmetrically before the convolution operation. +## +## @strong{Median filtering} +## +## Each pixel is replaced with the median of the pixels in the local area. By +## default, this area is 3 by 3, but this can be changed. If the third input +## argument is a scalar @var{N} the area will be @var{N} by @var{N}, and if it's +## a two-vector [@var{N}, @var{M}] the area will be @var{N} by @var{M}. +## +## The image is extrapolated symmetrically before the filtering is performed. +## +## @strong{Gaussian bilateral filtering} +## +## The image is smoothed using Gaussian bilateral filtering as described by +## Tomasi and Manduchi [2]. The filtering result is computed as +## @example +## @var{J}(x0, y0) = k * SUM SUM @var{I}(x,y) * w(x, y, x0, y0, @var{I}(x0,y0), @var{I}(x,y)) +## x y +## @end example +## where @code{k} a normalisation variable, and +## @example +## w(x, y, x0, y0, @var{I}(x0,y0), @var{I}(x,y)) +## = exp(-0.5*d([x0,y0],[x,y])^2/@var{sigma_d}^2) +## * exp(-0.5*d(@var{I}(x0,y0),@var{I}(x,y))^2/@var{sigma_r}^2), +## @end example +## with @code{d} being the Euclidian distance function. The two paramteres +## @var{sigma_d} and @var{sigma_r} control the amount of smoothing. @var{sigma_d} +## is the size of the spatial smoothing filter, while @var{sigma_r} is the size +## of the range filter. When @var{sigma_r} is large the filter behaves almost +## like the isotropic Gaussian filter with spread @var{sigma_d}, and when it is +## small edges are preserved better. By default @var{sigma_d} is 2, and @var{sigma_r} +## is @math{10/255} for floating points images (with integer images this is +## multiplied with the maximal possible value representable by the integer class). +## +## The image is extrapolated symmetrically before the filtering is performed. +## +## @strong{Perona and Malik} +## +## The image is smoothed using nonlinear isotropic diffusion as described by Perona and +## Malik [1]. The algorithm iteratively updates the image using +## +## @example +## I += lambda * (g(dN).*dN + g(dS).*dS + g(dE).*dE + g(dW).*dW) +## @end example +## +## @noindent +## where @code{dN} is the spatial derivative of the image in the North direction, +## and so forth. The function @var{g} determines the behaviour of the diffusion. +## If @math{g(x) = 1} this is standard isotropic diffusion. +## +## The above update equation is repeated @var{iter} times, which by default is 10 +## times. If the third input argument is a positive scalar, that number of updates +## will be performed. +## +## The update parameter @var{lambda} affects how much smoothing happens in each +## iteration. The algorithm can only be proved stable is @var{lambda} is between +## 0 and 0.25, and by default it is 0.25. If the fourth input argument is given +## this parameter can be changed. +## +## The function @var{g} in the update equation determines the type of the result. +## By default @code{@var{g}(@var{d}) = exp(-(@var{d}./@var{K}).^2)} where @var{K} = 25. +## This choice gives privileges to high-contrast edges over low-contrast ones. +## An alternative is to set @code{@var{g}(@var{d}) = 1./(1 + (@var{d}./@var{K}).^2)}, +## which gives privileges to wide regions over smaller ones. The choice of @var{g} +## can be controlled through the fifth input argument. If it is the string +## @code{"method1"}, the first mentioned function is used, and if it is @var{"method2"} +## the second one is used. The argument can also be a function handle, in which case +## the given function is used. It should be noted that for stability reasons, +## @var{g} should return values between 0 and 1. +## +## The following example shows how to set +## @code{@var{g}(@var{d}) = exp(-(@var{d}./@var{K}).^2)} where @var{K} = 50. +## The update will be repeated 25 times, with @var{lambda} = 0.25. +## +## @example +## @var{g} = @@(@var{d}) exp(-(@var{d}./50).^2); +## @var{J} = imsmooth(@var{I}, "p&m", 25, 0.25, @var{g}); +## @end example +## +## @strong{Custom Gaussian Smoothing} +## +## The image is smoothed using a Gaussian filter with a spatially varying covariance +## matrix. The third and fourth input arguments contain the Eigenvalues of the +## covariance matrix, while the fifth contains the rotation of the Gaussian. +## These arguments can be matrices of the same size as the input image, or scalars. +## In the last case the scalar is used in all pixels. If the rotation is not given +## it defaults to zero. +## +## The following example shows how to increase the size of an Gaussian +## filter, such that it is small near the upper right corner of the image, and +## large near the lower left corner. +## +## @example +## [@var{lambda1}, @var{lambda2}] = meshgrid (linspace (0, 25, columns (@var{I})), linspace (0, 25, rows (@var{I}))); +## @var{J} = imsmooth (@var{I}, "Custom Gaussian", @var{lambda1}, @var{lambda2}); +## @end example +## +## The implementation uses an elliptic filter, where only neighbouring pixels +## with a Mahalanobis' distance to the current pixel that is less than 3 are +## used to compute the response. The response is computed using double precision +## floating points, but the result is of the same class as the input image. +## +## @strong{References} +## +## [1] P. Perona and J. Malik, +## "Scale-space and edge detection using anisotropic diffusion", +## IEEE Transactions on Pattern Analysis and Machine Intelligence, +## 12(7):629-639, 1990. +## +## [2] C. Tomasi and R. Manduchi, +## "Bilateral Filtering for Gray and Color Images", +## Proceedings of the 1998 IEEE International Conference on Computer Vision, Bombay, India. +## +## @seealso{imfilter, fspecial} +## @end deftypefn + +## TODO: Implement Joachim Weickert's anisotropic diffusion (it's soo cool) + +function J = imsmooth(I, name = "Gaussian", varargin) + ## Check inputs + if (nargin == 0) + print_usage(); + endif + if (!ismatrix(I)) + error("imsmooth: first input argument must be an image"); + endif + [imrows, imcols, imchannels, tmp] = size(I); + if ((imchannels != 1 && imchannels != 3) || tmp != 1) + error("imsmooth: first input argument must be an image"); + endif + if (nargin == 2 && isscalar (name)) + varargin {1} = name; + name = "Gaussian"; + endif + if (!ischar(name)) + error("imsmooth: second input must be a string"); + endif + len = length(varargin); + + ## Save information for later + C = class(I); + + ## Take action depending on 'name' + switch (lower(name)) + ############################## + ### Gaussian smoothing ### + ############################## + case "gaussian" + ## Check input + s = 0.5; + if (len > 0) + if (isscalar(varargin{1}) && varargin{1} > 0) + s = varargin{1}; + else + error("imsmooth: third input argument must be a positive scalar when performing Gaussian smoothing"); + endif + endif + ## Compute filter + h = ceil(3*s); + f = exp( (-(-h:h).^2)./(2*s^2) ); f /= sum(f); + ## Pad image + I = double(impad(I, h, h, "symmetric")); + ## Perform the filtering + for i = imchannels:-1:1 + J(:,:,i) = conv2(f, f, I(:,:,i), "valid"); + endfor + + ############################ + ### Square averaging ### + ############################ + case "average" + ## Check input + s = [3, 3]; + if (len > 0) + if (isscalar(varargin{1}) && varargin{1} > 0) + s = [varargin{1}, varargin{1}]; + elseif (isvector(varargin{1}) && length(varargin{1}) == 2 && all(varargin{1} > 0)) + s = varargin{1}; + else + error("imsmooth: third input argument must be a positive scalar or two-vector when performing averaging"); + endif + endif + ## Compute filter + f2 = ones(1,s(1))/s(1); + f1 = ones(1,s(2))/s(2); + ## Pad image + I = impad(double(I), floor([s(2), s(2)-1]/2), floor([s(1), s(1)-1]/2), "symmetric"); + ## Perform the filtering + for i = imchannels:-1:1 + J(:,:,i) = conv2(f1, f2, I(:,:,i), "valid"); + endfor + + ############################## + ### Circular averaging ### + ############################## + case "disk" + ## Check input + r = 5; + if (len > 0) + if (isscalar(varargin{1}) && varargin{1} > 0) + r = varargin{1}; + else + error("imsmooth: third input argument must be a positive scalar when performing averaging"); + endif + endif + ## Compute filter + f = fspecial("disk", r); + ## Pad image + I = impad(double(I), r, r, "symmetric"); + ## Perform the filtering + for i = imchannels:-1:1 + J(:,:,i) = conv2(I(:,:,i), f, "valid"); + endfor + + ############################ + ### Median Filtering ### + ############################ + case "median" + ## Check input + s = [3, 3]; + if (len > 0) + opt = varargin{1}; + if (isscalar(opt) && opt > 0) + s = [opt, opt]; + elseif (isvector(opt) && numel(opt) == 2 && all(opt>0)) + s = opt; + else + error("imsmooth: third input argument must be a positive scalar or two-vector"); + endif + s = round(s); # just in case the use supplies non-integers. + endif + ## Perform the filtering + for i = imchannels:-1:1 + J(:,:,i) = medfilt2(I(:,:,i), s, "symmetric"); + endfor + + ############################### + ### Bilateral Filtering ### + ############################### + case "bilateral" + ## Check input + if (len > 0 && !isempty(varargin{1})) + if (isscalar(varargin{1}) && varargin{1} > 0) + sigma_d = varargin{1}; + else + error("imsmooth: spread of closeness function must be a positive scalar"); + endif + else + sigma_d = 2; + endif + if (len > 1 && !isempty(varargin{2})) + if (isscalar(varargin{2}) && varargin{2} > 0) + sigma_r = varargin{2}; + else + error("imsmooth: spread of similarity function must be a positive scalar"); + endif + else + sigma_r = 10/255; + if (isinteger(I)), sigma_r *= intmax(C); endif + endif + ## Pad image + s = max([round(3*sigma_d),1]); + I = impad(I, s, s, "symmetric"); + ## Perform the filtering + J = __bilateral__(I, sigma_d, sigma_r); + + ############################ + ### Perona and Malik ### + ############################ + case {"perona & malik", "perona and malik", "p&m"} + ## Check input + K = 25; + method1 = @(d) exp(-(d./K).^2); + method2 = @(d) 1./(1 + (d./K).^2); + method = method1; + lambda = 0.25; + iter = 10; + if (len > 0 && !isempty(varargin{1})) + if (isscalar(varargin{1}) && varargin{1} > 0) + iter = varargin{1}; + else + error("imsmooth: number of iterations must be a positive scalar"); + endif + endif + if (len > 1 && !isempty(varargin{2})) + if (isscalar(varargin{2}) && varargin{2} > 0) + lambda = varargin{2}; + else + error("imsmooth: fourth input argument must be a scalar when using 'Perona & Malik'"); + endif + endif + if (len > 2 && !isempty(varargin{3})) + fail = false; + if (ischar(varargin{3})) + if (strcmpi(varargin{3}, "method1")) + method = method1; + elseif (strcmpi(varargin{3}, "method2")) + method = method2; + else + fail = true; + endif + elseif (strcmp(typeinfo(varargin{3}), "function handle")) + method = varargin{3}; + else + fail = true; + endif + if (fail) + error("imsmooth: fifth input argument must be a function handle or the string 'method1' or 'method2' when using 'Perona & Malik'"); + endif + endif + ## Perform the filtering + I = double(I); + for i = imchannels:-1:1 + J(:,:,i) = pm(I(:,:,i), iter, lambda, method); + endfor + + ##################################### + ### Custom Gaussian Smoothing ### + ##################################### + case "custom gaussian" + ## Check input + if (length (varargin) < 2) + error ("imsmooth: not enough input arguments"); + elseif (length (varargin) == 2) + varargin {3} = 0; # default theta value + endif + arg_names = {"third", "fourth", "fifth"}; + for k = 1:3 + if (isscalar (varargin {k})) + varargin {k} = repmat (varargin {k}, imrows, imcols); + elseif (ismatrix (varargin {k}) && ndims (varargin {k}) == 2) + if (rows (varargin {k}) != imrows || columns (varargin {k}) != imcols) + error (["imsmooth: %s input argument must have same number of rows " + "and columns as the input image"], arg_names {k}); + endif + else + error ("imsmooth: %s input argument must be a scalar or a matrix", arg_names {k}); + endif + if (!strcmp (class (varargin {k}), "double")) + error ("imsmooth: %s input argument must be of class 'double'", arg_names {k}); + endif + endfor + + ## Perform the smoothing + for i = imchannels:-1:1 + J(:,:,i) = __custom_gaussian_smoothing__ (I(:,:,i), varargin {:}); + endfor + + ###################################### + ### Mean Shift Based Smoothing ### + ###################################### + # NOT YET IMPLEMENTED + #case "mean shift" + # J = mean_shift(I, varargin{:}); + + ############################# + ### Unknown filtering ### + ############################# + otherwise + error("imsmooth: unsupported smoothing type '%s'", name); + endswitch + + ## Cast the result to the same class as the input + J = cast(J, C); +endfunction + +## Perona and Malik for gray-scale images +function J = pm(I, iter, lambda, g) + ## Initialisation + [imrows, imcols] = size(I); + J = I; + + for i = 1:iter + ## Pad image + padded = impad(J, 1, 1, "replicate"); + + ## Spatial derivatives + dN = padded(1:imrows, 2:imcols+1) - J; + dS = padded(3:imrows+2, 2:imcols+1) - J; + dE = padded(2:imrows+1, 3:imcols+2) - J; + dW = padded(2:imrows+1, 1:imcols) - J; + + gN = g(dN); + gS = g(dS); + gE = g(dE); + gW = g(dW); + + ## Update + J += lambda*(gN.*dN + gS.*dS + gE.*dE + gW.*dW); + endfor +endfunction + +## Mean Shift smoothing for gray-scale images +## XXX: This function doesn't work!! +#{ +function J = mean_shift(I, s1, s2) + sz = [size(I,2), size(I,1)]; + ## Mean Shift + [x, y] = meshgrid(1:sz(1), 1:sz(2)); + f = ones(s1); + tmp = conv2(ones(sz(2), sz(1)), f, "same"); # We use normalised convolution to handle the border + m00 = conv2(I, f, "same")./tmp; + m10 = conv2(I.*x, f, "same")./tmp; + m01 = conv2(I.*y, f, "same")./tmp; + ms_x = round( m10./m00 ); # konverter ms_x og ms_y til linære indices og arbejd med dem! + ms_y = round( m01./m00 ); + + ms = sub2ind(sz, ms_y, ms_x); + %for i = 1:10 + i = 0; + while (true) + disp(++i) + ms(ms) = ms; + #new_ms = ms(ms); + if (i >200), break; endif + #idx = ( abs(I(ms)-I(new_ms)) < s2 ); + #ms(idx) = new_ms(idx); + %for j = 1:length(ms) + % if (abs(I(ms(j))-I(ms(ms(j)))) < s2) + % ms(j) = ms(ms(j)); + % endif + %endfor + endwhile + %endfor + + ## Compute result + J = I(ms); +endfunction +#} diff --git a/octave_packages/image-1.0.15/imtophat.m b/octave_packages/image-1.0.15/imtophat.m new file mode 100644 index 0000000..3075446 --- /dev/null +++ b/octave_packages/image-1.0.15/imtophat.m @@ -0,0 +1,81 @@ +## Copyright (C) 2005 Carvalho-Mariel +## Copyright (C) 2010 Carnë Draug +## +## This program is free software; you can redistribute it and/or +## modify it under the terms of the GNU General Public License +## as published by the Free Software Foundation; either version 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. + +## -*- texinfo -*- +## @deftypefn {Function File} @var{B} = imtophat (@var{A}, @var{se}) +## @deftypefnx{Function File} @var{B} = imtophat (@var{A}, @var{se}, @var{type}) +## Perform morphological top hat filtering. +## +## The image @var{A} must be a grayscale or binary image, and @var{se} must be a +## structuring element. Both must have the same class, e.g., if @var{A} is a +## logical matrix, @var{se} must also be logical. +## +## @var{type} defines the type of top hat transform. To perform a white, or +## opening, top-hat transform its value must be @code{open} or @code{white}. To +## perform a black, or closing, top-hat transform its value must be @code{close} +## or @code{black}. If @var{type} is not specified, it performs a white top-hat +## transform. +## +## @seealso{imerode, imdilate, imopen, imclose, mmgradm} +## @end deftypefn + +function retval = imtophat(im, se, trans) + + ## Checkinput + if (nargin <=1 || nargin > 3) + print_usage(); + elseif (nargin == 2) + trans = "white"; + endif + if (!ismatrix(im) || !isreal(im)) + error("imtophat: first input argument must be a real matrix"); + elseif (!ismatrix(se) || !isreal(se)) + error("imtophat: second input argument must be a real matrix"); + elseif ( !strcmp(class(im), class(se)) ) + error("imtophat: image and structuring element must have the same class"); + endif + + ## Perform filtering + ## Note that in case that the transform is to applied to a logical image, + ## subtraction must be handled in a different way (x & !y) instead of (x - y) + ## or it will return a double precision matrix + if ( strcmpi(trans, "white") || strcmpi(trans, "open") ) + if (islogical(im)) + retval = im & !imopen(im,se); + else + retval = im - imopen(im, se); + endif + elseif ( strcmpi(trans, "black") || strcmpi(trans, "close") ) + if (islogical(im)) + retval = imclose(im, se) & !im; + else + retval = imclose(im, se) - im; + endif + else + error ("Unexpected type of top-hat transform"); + endif + +endfunction + +%!test +%! I = [1 1 1; 1 1 1; 1 1 1;]; +%! se = [1 1; 0 1;]; +%! ## class of input should be the same as the output +%! result = imtophat(logical(I), logical(se)); +%! expected = 0.5 < [0 0 1; 0 0 1; 1 1 1]; +%! assert(expected, result); +%! result = imtophat((I), (se)); +%! expected = [0 0 1; 0 0 1; 1 1 1]; +%! assert(expected, result); + + diff --git a/octave_packages/image-1.0.15/imtranslate.m b/octave_packages/image-1.0.15/imtranslate.m new file mode 100644 index 0000000..675e56c --- /dev/null +++ b/octave_packages/image-1.0.15/imtranslate.m @@ -0,0 +1,73 @@ +## Copyright (C) 2002 Jeff Orchard +## +## 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{Y}} = imtranslate (@var{M}, @var{x}, @var{y} [, @var{bbox}]) +## Translate a 2D image by (x,y) using Fourier interpolation. +## +## @var{M} is a matrix, and is translated to the right by @var{X} pixels +## and translated up by @var{Y} pixels. +## +## @var{bbox} can be either 'crop' or 'wrap' (default). +## +## @end deftypefn + +## Author: Jeff Orchard +## bug fix: Eugeniy Mikhailov in 2009 (removing fftshift and ifftshift they do no good) + +function Y = imtranslate(X, a, b, bbox_in) + + bbox = "wrap"; + if ( nargin > 3 ) + bbox = bbox_in; + endif + + if ( strcmp(bbox, "crop")==1 ) + + xpad = [0,0]; + if (a>0) + xpad = [0,ceil(a)]; + elseif (a<0) + xpad = [-ceil(a),0]; + endif + + ypad = [0,0]; + if (b>0) + ypad = [ceil(b),0]; + elseif (b<0) + ypad = [0,-ceil(b)]; + endif + + X = impad(X, xpad, ypad, 'zeros'); + endif + + + [dimy, dimx] = size(X); + x = fft2(X); + px = exp(-2*pi*i*a*(0:dimx-1)/dimx); + py = exp(-2*pi*i*b*(0:dimy-1)/dimy)'; % actually to correspond to index notation 'b' should be + % replaced with '-b' + % but I do not want to brake previous version compatibility + % note: it also must be done in the cropping iand padding code + P = py * px; + y = x .* P; + Y = real(ifft2(y)); % fft return complex number + % for integer shifts imaginary part is 0 + % so real takes care of transfer from complex number to real + + if ( strcmp(bbox, "crop")==1 ) + Y = Y( ypad(1)+1:dimy-ypad(2) , xpad(1)+1:dimx-xpad(2)); + endif +endfunction diff --git a/octave_packages/image-1.0.15/iradon.m b/octave_packages/image-1.0.15/iradon.m new file mode 100644 index 0000000..ee15126 --- /dev/null +++ b/octave_packages/image-1.0.15/iradon.m @@ -0,0 +1,169 @@ +## Copyright (C) 2010 Alex Opie +## +## +## This program is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @defun @var{recon} = iradon (@var{proj}, @var{theta}, @var{interp}, @ +## @var{filter}, @var{scaling}, @var{output_size}) +## +## Performs filtered back-projection on the projections in @var{proj} +## to reconstruct an approximation of the original image. +## +## @var{proj} should be a matrix whose columns are projections of an +## image (or slice). Each element of @var{theta} is used as the angle +## (in degrees) that the corresponding column of @var{proj} was +## projected at. If @var{theta} is omitted, it is assumed that +## projections were taken at evenly spaced angles between 0 and 180 degrees. +## @var{theta} can also be a scalar, in which case it is taken as the +## angle between projections if more than one projection is provided. +## +## @var{interp} determines the type of interpolation that is used +## in the back-projection. It must be one of the types accepted by +## @command{interp1}, and defaults to 'Linear' if it is omitted. +## +## @var{filter} and @var{scaling} determine the type of rho filter +## to apply. See the help for @command{rho_filter} for their use. +## +## @var{output_size} sets the edge length of the output image (it +## is always square). This argument does not scale the image. If it +## is omitted, the length is taken to be +## @group +## 2 * floor (size (proj, 1) / (2 * sqrt (2))). +## @end group +## +## If @var{proj} was obtained using @command{radon}, there is no +## guarantee that the reconstructed image will be exactly the same +## size as the original. +## +## @defunx [@var{recon}, @var{filt}] = iradon (...) +## +## This form also returns the filter frequency response in the vector +## @var{filt}. +## @end defun +## +## Performs filtered back-projection in order to reconstruct an +## image based on its projections. +## +## Filtered back-projection is the most common means of reconstructing +## images from CT scans. It is a two step process: First, each of +## the projections is filtered with a `rho filter', so named due +## to its frequency domain definition, which is simply |rho|, where +## rho is the radial axis in a polar coordinate system. Second, +## the filtered projections are each `smeared' across the image +## space. This is the back-projection part. +## +## Usage example: +## @example +## P = phantom (); +## projections = radon (P, 1:179); +## reconstruction = iradon (filtered_projections, 1:179, 'Spline', 'Hann'); +## figure, imshow (reconstruction, []) +## @end example + +function [recon, filt] = iradon (proj, theta, interp, filter, scaling, output_size) + + if (nargin == 0) + error ("No projections provided to iradon"); + endif + + if (nargin < 6) + output_size = 2 * floor (size (proj, 1) / (2 * sqrt (2))); + endif + if (nargin < 5) || (length (scaling) == 0) + scaling = 1; + endif + if (nargin < 4) || (length (filter) == 0) + filter = "Ram-Lak"; + endif + if (nargin < 3) || (length (interp) == 0) + interp = "linear"; + endif + if (nargin < 2) || (length (theta) == 0) + theta = 180 * (0:1:size (proj, 2) - 1) / size (proj, 2); + endif + + if (isscalar (theta)) && (size (proj, 2) != 1) + theta = (0:size (proj, 2) - 1) * theta; + endif + + if (length (theta) != size (proj, 2)) + error ("iradon: Number of projections does not match number of angles") + endif + if (!isscalar (scaling)) + error ("iradon: Frequency scaling value must be a scalar"); + endif + if (!length (find (strcmpi (interp, {'nearest', 'linear', 'spline', \ + 'pchip', 'cubic'})))) + error ("iradon: Invalid interpolation method specified"); + endif + + ## Convert angles to radians + theta *= pi / 180; + + ## First, filter the projections + [filtered, filt] = rho_filter (proj, filter, scaling); + + ## Next, back-project + recon = back_project (filtered, theta, interp, output_size); + +endfunction + + +function recon = back_project (proj, theta, interpolation, dim) + ## Make an empty image + recon = zeros (dim, dim); + + ## Zero pad the projections if the requested image + ## has a diagonal longer than the projections + diagonal = ceil (dim * sqrt (2)) + 1; + if (size (proj, 1) < diagonal) + diff = 2 * ceil ((diagonal - size (proj, 1)) / 2); + proj = padarray (proj, diff / 2); + endif + + ## Create the x & y values for each pixel + centre = floor ((dim + 1) / 2); + x = (0:dim - 1) - centre + 1; + x = repmat (x, dim, 1); + + y = (dim - 1: -1 : 0)' - centre; + y = repmat (y, 1, dim); + + ## s axis for projections, needed by interp1 + s = (0:size (proj, 1) - 1) - floor (size (proj, 1) / 2); + + ## Sum each projection's contribution + for i = 1:length (theta) + s_dash = (x * cos (theta (i)) + y * sin (theta (i))); + interpolated = interp1 (s, proj (:, i), s_dash (:), ["*", interpolation]); + recon += reshape (interpolated, dim, dim); + endfor + + ## Scale the reconstructed values to their original size + recon *= pi / (2 * length (theta)); + +endfunction + +%!demo +%! P = phantom (); +%! figure, imshow (P, []), title ("Original image") +%! projections = radon (P, 0:179); +%! reconstruction = iradon (projections, 0:179, 'Spline', 'Hann'); +%! figure, imshow (reconstruction, []), title ("Reconstructed image") + +% $Log$ +% 2010-30-03 lxop +% First submitted to Octave-Forge diff --git a/octave_packages/image-1.0.15/isbw.m b/octave_packages/image-1.0.15/isbw.m new file mode 100644 index 0000000..4ebe92c --- /dev/null +++ b/octave_packages/image-1.0.15/isbw.m @@ -0,0 +1,38 @@ +## Copyright (C) 2000 Kai Habel +## +## 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{bool}= isbw (@var{BW}) +## Returns true for a black-white (binary) image. +## All values must be either 0 or 1 +## @end deftypefn + +## Author: Kai Habel +## Date: 20/03/2000 + +function bool = isbw (BW) + + bool = 0; + if !(nargin == 1) + usage ("isbw(BW)"); + endif + + if !(ismatrix(BW)) + return; + endif + + bool = all (all ((BW == 1) + (BW == 0))); + +endfunction diff --git a/octave_packages/image-1.0.15/isgray.m b/octave_packages/image-1.0.15/isgray.m new file mode 100644 index 0000000..128f216 --- /dev/null +++ b/octave_packages/image-1.0.15/isgray.m @@ -0,0 +1,45 @@ +## Copyright (C) 2000 Kai Habel +## +## 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{bool}= isgray (@var{I}) +## Returns true for an gray-scale intensity image. An variable is a gray scale image +## if it is 2-dimensional matrix, and +## @itemize @bullet +## @item is of class double and all values are in the range [0, 1], or +## @item is of class uint8 or uint16. +## @end itemize +## @end deftypefn + +## Author: Kai Habel +## Date: 20/03/2000 + +function bool = isgray (I) + + if (nargin != 1) + print_usage (); + endif + + bool = false; + if (ismatrix(I) && ndims(I) == 2) + switch(class(I)) + case "double" + bool = all((I(:) >= 0 & I(:) <= 1) | isnan(I(:))); + case {"uint8", "uint16"} + bool = true; + endswitch + endif + +endfunction diff --git a/octave_packages/image-1.0.15/isind.m b/octave_packages/image-1.0.15/isind.m new file mode 100644 index 0000000..0ad99ea --- /dev/null +++ b/octave_packages/image-1.0.15/isind.m @@ -0,0 +1,42 @@ +## Copyright (C) 2000 Kai Habel +## +## 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 WXTHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABXLXTY or FXTNESS FOR A PARTXCULAR 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{bool}= isind (@var{X}) +## Returns true for an index image. All index values must +## be intergers and greater than or equal to 1. +## @end deftypefn + +## Author: Kai Habel +## Date: 20/03/2000 + +function ret = isind (X) + + if nargin != 1 + usage ("isind(X)"); + endif + + ret = isreal (X) && length (size (X)) == 2 ... + && all ( X(:) == floor (X(:)) ) && all ( X(:) >= 1 ); + +endfunction + +%!assert(isind([])) +%!assert(isind(1:10)) +%!assert(!isind(0:10)) +%!assert(isind(1)) +%!assert(!isind(0)) +%!assert(!isind([1.3,2.4])) +%!assert(isind([1,2;3,4])) diff --git a/octave_packages/image-1.0.15/isrgb.m b/octave_packages/image-1.0.15/isrgb.m new file mode 100644 index 0000000..887077a --- /dev/null +++ b/octave_packages/image-1.0.15/isrgb.m @@ -0,0 +1,80 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{flag} = } isrgb (@var{A}) +## Returns true if parameter is a RGB image. +## +## @code{flag=isrgb(A)} returns 1 if @var{A} is a RGB image and 0 if +## not. +## +## To the decide @code{isrgb} uses the follow algorithm: +## @itemize @bullet +## @item +## If @var{A} is of class double then it checks if all values are +## between 0 and 1, and if size is m-by-n-by-3. +## @item +## If @var{A} is of class uint16, uint8 or logical then it checks is m-by-n-by-3. +## @end itemize +## +## @strong{Compatibility notes:} +## +## Information needed on whether MATLAB accepts logical arrays as RGB +## images (now this functions accepts them if they are m-by-n-by-3 arrays. +## +## @end deftypefn + +## TODO: Check if logical arrays should be considered RGB + +## Author: Josep Mones i Teixidor + +function flag = isrgb(A) + if (nargin!=1) + usage("flag=isrgb(A)"); + endif + + if(ismatrix(A)) + flag=1; + s=size(A); + if(length(s)!=3 || s(3)!=3) + flag=0; ## false if not m-by-n-by-3 + elseif(strcmp(typeinfo(A),"matrix") && (any(A(:)<0) || any(A(:)>1))) + flag=0; ## false if class double but items are <0 or >1 + endif + else + flag=0; + endif +endfunction + + +%!demo +%! isrgb(rand(1,2,3)) +%! # A 1-by-2-by-3 double matrix with elements between 0 and 1 is a RGB image. + + +%!# Non-matrix +%!assert(isrgb("this is not a RGB image"),0); + +%!# Double matrix tests +%!assert(isrgb(rand(5,5)),0); +%!assert(isrgb(rand(5,5,1,5)),0); +%!assert(isrgb(rand(5,5,3,5)),0); +%!assert(isrgb(rand(5,5,3)),1); +%!assert(isrgb(ones(5,5,3)),1); +%!assert(isrgb(ones(5,5,3)+.0001),0); +%!assert(isrgb(zeros(5,5,3)-.0001),0); + +%!# Logical +%!assert(isrgb(logical(round(rand(5,5,3)))),1); diff --git a/octave_packages/image-1.0.15/label2rgb.m b/octave_packages/image-1.0.15/label2rgb.m new file mode 100644 index 0000000..e99f6f4 --- /dev/null +++ b/octave_packages/image-1.0.15/label2rgb.m @@ -0,0 +1,137 @@ +## Copyright (C) 2006 Søren Hauberg +## +## 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, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{RGB} = label2rgb(@var{L}) +## @deftypefnx{Function File} @var{RGB} = label2rgb(@var{L}, @var{map}) +## @deftypefnx{Function File} @var{RGB} = label2rgb(@var{L}, @var{map}, @var{background}) +## @deftypefnx{Function File} @var{RGB} = label2rgb(@var{L}, @var{map}, @var{background}, @var{order}) +## Converts a labeled image to an RGB image. +## +## label2rgb(@var{L}) returns a color image, where the background color +## (the background is the zero-labeled pixels) is white, and all other +## colors come from the @code{jet} colormap. +## +## label2rgb(@var{L}, @var{map}) uses colors from the given colormap. +## @var{map} can be +## @itemize +## @item A string containing the name of a function to be called to +## produce a colormap. The default value is "jet". +## @item A handle to a function to be called to produce a colormap. +## @item A @var{N}-by-3 colormap matrix. +## @end itemize +## +## label2rgb(@var{L}, @var{map}, @var{background}) sets the background +## color. @var{background} can be a 3-vector corresponding to the wanted +## RGB color, or one of the following strings +## @table @samp +## @item "b" +## The background color will be blue. +## @item "c" +## The background color will be cyan. +## @item "g" +## The background color will be green. +## @item "k" +## The background color will be black. +## @item "m" +## The background color will be magenta. +## @item "r" +## The background color will be red. +## @item "w" +## The background color will be white. This is the default behavior. +## @item "y" +## The background color will be yellow. +## @end table +## +## label2rgb(@var{L}, @var{map}, @var{background}, @var{order}) allows for random +## permutations of the colormap. @var{order} must be one of the following strings +## @table @samp +## @item "noshuffle" +## The colormap is not permuted in any ways. This is the default. +## @item "shuffle" +## The used colormap is permuted randomly. +## @end table +## @seealso{bwlabel, ind2rgb} +## @end deftypefn + +function rgb = label2rgb(L, map = "jet", background = "w", order = "noshuffle") + ## Input checking + if (nargin < 1) + print_usage(); + endif + if ( !ismatrix(L) || ndims(L) != 2 || any(L(:) != round(L(:))) || any(L(:) < 0) ) + error("label2rgb: first input argument must be a labelled image"); + endif + if ( !ischar(map) && !isa(map, "function_handle") && !(ismatrix(map) && ndims(map)==2 && columns(map)==3) ) + error("label2rgb: second input argument must be a color map or a function that can generate a colormap"); + endif + if ( !ischar(background) && !(isreal(background) && numel(background)==3) ) + error("label2rgb: third input argument must be a color given as a string or a 3-vector"); + endif + if ( !any(strcmpi(order, {"noshuffle", "shuffle"})) ) + error("label2rgb: fourth input argument must be either 'noshuffle' or 'shuffle'"); + endif + + ## Convert map to a matrix if needed + num_objects = max(L(:)); + if (ischar(map) || isa(map, "function_handle")) + map = feval(map, num_objects+1); + endif + + num_colors = rows(map); + if (num_objects > num_colors) + warning("label2rgb: number of objects exceeds number of colors in the colormap"); + endif + + ## Handle the background color + if (ischar(background)) + switch (background(1)) + case 'b' background = [0, 0, 1]; + case 'c' background = [0, 1, 1]; + case 'g' background = [0, 1, 0]; + case 'k' background = [0, 0, 0]; + case 'm' background = [1, 0, 1]; + case 'r' background = [1, 0, 0]; + case 'w' background = [1, 1, 1]; + case 'y' background = [1, 1, 0]; + otherwise + error("label2rgb: unknown background color '%s'", background); + endswitch + endif + background = background(:)'; + if (min(background) < 0 || max(background) > 1) + error("label2rgb: the background color must be in the interval [0, 1]"); + endif + + ## Should we shuffle the colormap? + if (strcmpi(order, "shuffle")) + r = rows(map); + map = map(randperm(r),:); + endif + + ## If the background color is in the color map: remove it + idx = find((map(:,1) == background(1)) & (map(:,2) == background(2)) & (map(:,3) == background(3))); + if (!isempty(idx)) + map(idx, :) = []; + endif + + ## Insert the background color as the first element in the color map + map = [background; map]; + + ## Convert L to an RGB image + rgb = ind2rgb(L+1, map); + rgb /= max(rgb(:)); + rgb = uint8(255*rgb); +endfunction diff --git a/octave_packages/image-1.0.15/makelut.m b/octave_packages/image-1.0.15/makelut.m new file mode 100644 index 0000000..91c9d57 --- /dev/null +++ b/octave_packages/image-1.0.15/makelut.m @@ -0,0 +1,72 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{lut} = } makelut (@var{fun},@var{n}) +## @deftypefnx {Function File} {@var{lut} = } makelut (@var{fun},@var{n},@var{P1},@var{P2},...) +## Create a lookup table which can be used by applylut. +## +## lut = makelut(fun,n) returns a vector which can be used by applylut +## as a lookup table. +## +## @var{fun} can be a function object as created by inline, or simply a +## string which contains the name of a function. @var{fun} should accept a +## @var{n}-by-@var{n} matrix whose elements are binary (0 or 1) and +## returns an scalar (actually anything suitable to be included in a +## vector). +## +## makelut calls @var{fun} with all possible matrices and builds a +## vector with its result, suitable to be used by applylut. The length +## of this vector is 2^(@var{n}^2), so 16 for 2-by-2 and 512 for 3-by-3. +## +## makelut also passes parameters @var{P1}, @var{P2}, .... to @var{fun}. +## +## @seealso{applylut} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function lut = makelut(fun, n, varargin) + if (nargin < 2) + usage ("lut = makelut(fun, n [, ...])"); + endif + + if (n<2) + error ("makelut: n should be a natural number >= 2"); + endif + + nq=n^2; + c=2^nq; + lut=zeros(c,1); + w=reshape(2.^[nq-1:-1:0],n,n); + for i=0:c-1 + idx=bitand(w,i)>0; + lut(i+1)= feval(fun, idx, varargin{:}); + endfor +endfunction + +%!demo +%! makelut(inline('sum(x(:))>=3','x'), 2) +%! % Returns '1' if one or more values +%! % in the input matrix are 1 + +%!assert(prod(makelut(inline('sum(x(:))==2','x'),2)==makelut(inline('sum(x(:))==a*b*c*d','x','a','b','c','d'),2,2/(3*4*5),3,4,5))); # test multiple params +%!assert(prod(makelut(inline('x(1,1)==1','x'),2)==[zeros(2^3,1);ones(2^3,1)])==1); # test 2-by-2 +%!assert(prod(makelut(inline('x(1,1)==1','x'),3)==[zeros(2^8,1);ones(2^8,1)])==1); # test 3-by-3 +%!assert(prod(makelut(inline('x(1,1)==1','x'),4)==[zeros(2^15,1);ones(2^15,1)])==1); # test 4-by-4 +%!assert(prod(makelut(inline('x(2,1)==1','x'),3)==[zeros(2^7,1);ones(2^7,1);zeros(2^7,1);ones(2^7,1)])==1); # another test for 3-by-3 + + + diff --git a/octave_packages/image-1.0.15/mat2gray.m b/octave_packages/image-1.0.15/mat2gray.m new file mode 100644 index 0000000..e1f8f67 --- /dev/null +++ b/octave_packages/image-1.0.15/mat2gray.m @@ -0,0 +1,48 @@ +## Copyright (C) 1999,2000 Kai Habel +## +## 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{I}= mat2gray (@var{M},[min max]) +## Converts a matrix to a intensity image. +## @end deftypefn + +## Author: Kai Habel +## Date: 22/03/2000 + +function I = mat2gray (M, scale) + + if (nargin < 1|| nargin > 2) + usage ("mat2gray(...) number of arguments must be 1 or 2"); + endif + + if (!ismatrix (M)) + usage ("mat2gray(M,...) M must be a matrix"); + endif + + if (nargin == 1) + Mmin = min (min (M)); + Mmax = max (max (M)); + else + if (isvector (scale)) + Mmin = min (scale (1), scale (2)); + Mmax = max (scale (1), scale (2)); + endif + endif + + I = (M < Mmin) .* 0; + I = I + (M >= Mmin & M < Mmax) .* (1 / (Mmax - Mmin) * (M - Mmin)); + I = I + (M >= Mmax); + +endfunction diff --git a/octave_packages/image-1.0.15/mean2.m b/octave_packages/image-1.0.15/mean2.m new file mode 100644 index 0000000..5fb6795 --- /dev/null +++ b/octave_packages/image-1.0.15/mean2.m @@ -0,0 +1,38 @@ +## Copyright (C) 2000 Kai Habel +## +## 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{m}= mean2 (@var{I}) +## Returns the mean value for a 2d real type matrix. +## Uses @code{mean(I(:))} +## @seealso{std2,mean} +## @end deftypefn + + +## Author: Kai Habel +## Date: 01/08/2000 + +function m = mean2 (I) + + if !(nargin == 1) + print_usage(); + endif + + if !(ismatrix(I) && isreal(I)) + error("mean2: argument must be a real type matrix"); + endif + + m = mean (I(:)); +endfunction diff --git a/octave_packages/image-1.0.15/medfilt2.m b/octave_packages/image-1.0.15/medfilt2.m new file mode 100644 index 0000000..53a7cb2 --- /dev/null +++ b/octave_packages/image-1.0.15/medfilt2.m @@ -0,0 +1,67 @@ +## Copyright (C) 2000 Teemu Ikonen +## +## 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} {} medfilt2(@var{A}, [@var{domain}, @var{padding}]) +## Two dimensional median filtering. +## +## Replaces elements of @var{A} with the median of their neighbours defined +## by true elements of logical matrix @var{domain}. The default @var{domain} +## is a 3 by 3 matrix with all elements equal to 1. If @var{domain} is 1 by 2 +## row vector, the domain matrix will be +## logical(ones(@var{domain}(2), @var{domain}(1))). +## +## Optional variable @var{padding} defines the padding used in augmenting +## the borders of @var{A}. See impad for details. +## +## @seealso{ordfilt2} +## @end deftypefn + +## Author: Teemu Ikonen +## Created: 5.5.2000 +## Keywords: image processing median filtering + +%!test +%! b = [0,1,2,3;1,8,12,12;4,20,24,21;7,22,25,18]; +%! assert(medfilt2(b),[0,1,2,0;1,4,12,3;4,12,20,12;0,7,20,0]); + +function retval = medfilt2(A, varargin) + +padding = "zeros"; +domain = logical(ones(3,3)); + +for i=1:length(varargin) + a = varargin{i}; + if(ischar(a)) + padding = a; + elseif(isvector(a) && size(a) == [1, 2]) + domain = logical(ones(a(2), a(1))); + elseif(ismatrix(a)) + domain = logical(a); + endif +endfor + +n = sum(sum(domain)); +if((n - 2*floor(n/2)) == 0) % n even - more work + nth = floor(n/2); + a = ordfilt2(A, nth, domain, padding); + b = ordfilt2(A, nth + 1, domain, padding); + retval = a./2 + b./2; # split into two divisions to avoid overflow on integer data +else + nth = floor(n/2) + 1; + retval = ordfilt2(A, nth, domain, padding); +endif + +endfunction diff --git a/octave_packages/image-1.0.15/mmgradm.m b/octave_packages/image-1.0.15/mmgradm.m new file mode 100644 index 0000000..4b12d9b --- /dev/null +++ b/octave_packages/image-1.0.15/mmgradm.m @@ -0,0 +1,50 @@ +## Copyright (C) 2010 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{grad} = mmgradm(@var{A}, @var{se}) +## @deftypefnx {Function File} @var{grad} = mmgradm(@var{A}, @var{se_dil}, @var{se_ero}) +## Calculates the morphological gradient @var{grad} of a given image @var{A}. +## +## In the first form, the same structuring element @var{se} is used for dilation +## and erosion. In the second form, @var{se_dil} and @var{se_ero} are the +## corresponding structuring elements used for dilation and erosion +## +## The image @var{A} must be a grayscale or a binary image. +## +## The morphological gradient of a image corresponds to its erosion subtracted +## to its dilation. +## +## @seealso{imerode, imdilate, imopen, imclose, imtophat} +## @end deftypefn + +function grad = mmgradm (im, se_dil, se_ero) + + ## sanity checks + if (nargin == 1) + error ("Structuring element must be specified"); + elseif (nargin == 2) # if only one SE is specified, use it for both erosion and dilation + se_ero = se_dil; + elseif (nargin == 3) + # all is good + else + print_usage; + endif + + dilated = imdilate (im, se_dil); + eroded = imerode (im, se_ero); + + grad = dilated - eroded; +endfunction diff --git a/octave_packages/image-1.0.15/nlfilter.m b/octave_packages/image-1.0.15/nlfilter.m new file mode 100644 index 0000000..e11994a --- /dev/null +++ b/octave_packages/image-1.0.15/nlfilter.m @@ -0,0 +1,178 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{B} = } nlfilter (@var{A}, [@var{m},@var{n}], @var{fun}) +## @deftypefnx {Function File} {@var{B} = } nlfilter (@var{A}, [@var{m},@var{n}], @var{fun}, ...) +## @deftypefnx {Function File} {@var{B} = } nlfilter (@var{A},'indexed', ...) +## Processes image in sliding blocks using user-supplied function. +## +## @code{B=nlfilter(A,[m,n],fun)} passes sliding @var{m}-by-@var{n} +## blocks to user-supplied function @var{fun}. A block is build for +## every pixel in @var{A}, such as it is centered within the block. +## @var{fun} must return a scalar, and it is used to create matrix +## @var{B}. @var{nlfilter} pads the @var{m}-by-@var{n} block at the +## edges if necessary. +## +## Center of block is taken at ceil([@var{m},@var{n}]/2). +## +## @code{B=nlfilter(A,[m,n],fun,...)} behaves as described above but +## passes extra parameters to function @var{fun}. +## +## @code{B=nlfilter(A,'indexed',...)} assumes that @var{A} is an indexed +## image, so it pads the image using proper value: 0 for uint8 and +## uint16 images and 1 for double images. Keep in mind that if 'indexed' +## is not specified padding is always done using 0. +## +## @seealso{colfilt,blkproc,inline} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function B = nlfilter(A, varargin) + if(nargin<3) + error("nlfilter: invalid number of parameters."); + endif + + ## check 'indexed' presence + indexed=false; + p=1; + if(ischar(varargin{1}) && strcmp(varargin{1}, "indexed")) + indexed=true; + p+=1; + if(isa(A,"uint8") || isa(A,"uint16")) + padval=0; + else + padval=1; + endif + else + padval=0; + endif + + ## check [m,n] + if(!isvector(varargin{p})) + error("nlfilter: expected [m,n] but param is not a vector."); + endif + if(length(varargin{p})!=2) + error("nlfilter: expected [m,n] but param has wrong length."); + endif + sblk=varargin{p}(:); + p+=1; + + ## check fun + ## TODO: add proper checks for this one + if(nargin0)) + A=padarray(A,prepad,padval,'both'); + endif + else + if(any(prepad>0)) + A=padarray(A,prepad,padval,'pre'); + endif + if(any(postpad>0)) + A=padarray(A,postpad,padval,'post'); + endif + endif + + ## calc end offsets + me=postpad(1)+prepad(1); + ne=postpad(2)+prepad(2); + + ## We concatenate everything to preserve fun return type + for i=1:as(1) + r=feval(fun,A(i:i+me,1:1+ne),varargin{p+1:nargin-1}); + for j=2:as(2) + r=horzcat(r,feval(fun,A(i:i+me,j:j+ne),varargin{p+1:nargin-1})); + endfor + if(i==1) + B=r; + else + B=vertcat(B,r); + endif + endfor + +endfunction + +%!demo +%! nlfilter(eye(10),[3,3],inline("any(x(:)>0)","x")) +%! # creates a "wide" diagonal + +%!assert(nlfilter(eye(4),[2,3],inline("sum(x(:))","x")),[2,2,1,0;1,2,2,1;0,1,2,2;0,0,1,1]); +%!assert(nlfilter(eye(4),'indexed',[2,3],inline("sum(x(:))","x")),[4,2,1,2;3,2,2,3;2,1,2,4;4,3,4,5]); +%!assert(nlfilter(eye(4),'indexed',[2,3],inline("sum(x(:))==y","x","y"),2),[0,1,0,1;0,1,1,0;1,0,1,0;0,0,0,0]!=0); + +% Check uint8 and uint16 padding +%!assert(nlfilter(uint8(eye(4)),'indexed',[2,3],inline("sum(x(:))","x")),[2,2,1,0;1,2,2,1;0,1,2,2;0,0,1,1]); +%!assert(nlfilter(uint16(eye(4)),'indexed',[2,3],inline("sum(x(:))","x")),[2,2,1,0;1,2,2,1;0,1,2,2;0,0,1,1]); + +% Check if function class is preserved +%!assert(nlfilter(uint8(eye(4)),'indexed',[2,3],inline("int8(sum(x(:)))","x")),int8([2,2,1,0;1,2,2,1;0,1,2,2;0,0,1,1])); + + + +% +% $Log$ +% Revision 1.4 2007/03/23 16:14:37 adb014 +% Update the FSF address +% +% Revision 1.3 2007/01/04 23:50:47 hauberg +% Put seealso before end deftypefn +% +% Revision 1.2 2007/01/04 23:37:54 hauberg +% Minor changes in help text +% +% Revision 1.1 2006/08/20 12:59:35 hauberg +% Changed the structure to match the package system +% +% Revision 1.5 2005/09/08 02:00:17 pkienzle +% [for Bill Denney] isstr -> ischar +% +% Revision 1.4 2004/11/15 16:04:20 pkienzle +% Fix tests for functions which return boolean matrices +% +% Revision 1.3 2004/09/03 13:28:32 jmones +% Corrected behaviour for int* and uint* types +% +% Revision 1.2 2004/08/15 19:43:11 jmones +% corrected a typo in doc +% +% Revision 1.1 2004/08/15 19:42:14 jmones +% nlfilter: Processes image in siliding blocks using user-supplied function +% +% diff --git a/octave_packages/image-1.0.15/ordfilt2.m b/octave_packages/image-1.0.15/ordfilt2.m new file mode 100644 index 0000000..073203d --- /dev/null +++ b/octave_packages/image-1.0.15/ordfilt2.m @@ -0,0 +1,68 @@ +## Copyright (C) 2000 Teemu Ikonen +## +## 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} {} ordfilt2(@var{A}, @var{nth}, @var{domain}, [@var{S}, @var{padding}]) +## Two dimensional ordered filtering. +## +## Ordered filter replaces an element of @var{A} with the @var{nth} +## element of the sorted set of neighbours defined by the logical +## (boolean) matrix @var{domain}. +## Neighbour elements are selected to the sort if the corresponding +## element in the @var{domain} matrix is true. +## +## The optional variable @var{S} is a matrix of size(@var{domain}). +## Values of @var{S} corresponding to nonzero values of domain are +## added to values obtained from @var{A} when doing the sorting. +## +## Optional variable @var{padding} determines how the matrix @var{A} +## is padded from the edges. See impad for details. +## +## @seealso{medfilt2} +## @end deftypefn + + +## Author: Teemu Ikonen +## Created: 5.5.2000 +## Keywords: image processing filtering + +function retval = ordfilt2(A, nth, domain, varargin) + +S = zeros(size(domain)); +padding = "zeros"; +for i=1:length(varargin) + a = varargin{:}; + if(ischar(a)) + padding = a; + elseif(ismatrix(a) && size(a) == size(domain)) + S = a; + endif +endfor + +domain = logical(domain); + +xpad(1) = floor((size(domain, 2)+1)/2) - 1; +xpad(2) = size(domain,2) - xpad(1) - 1; +ypad(1) = floor((size(domain, 1)+1)/2) - 1; +ypad(2) = size(domain,1) - ypad(1) - 1; + +if(ypad(1) >= size(A,1) || xpad(1) >= size(A,2)) + error("domain matrix too large"); +endif; + +A = impad(A, xpad, ypad, padding); +retval = __spatial_filtering__ (A, domain, "ordered", S, nth); + +endfunction diff --git a/octave_packages/image-1.0.15/ordfiltn.m b/octave_packages/image-1.0.15/ordfiltn.m new file mode 100644 index 0000000..03510f8 --- /dev/null +++ b/octave_packages/image-1.0.15/ordfiltn.m @@ -0,0 +1,99 @@ +## Copyright (C) 2008 Soren Hauberg +## +## This program is free software; you can redistribute it and/or +## modify it under the terms of the GNU General Public License +## as published by the Free Software Foundation; either version 3 +## of the License, or (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . +## +## This function is based on 'ordfilt2' by Teemu Ikonen which is released under +## GPLv2 or later. + +## -*- texinfo -*- +## @deftypefn {Function File} {} ordfiltn(@var{A}, @var{nth}, @var{domain}, [@var{S}, @var{padding}]) +## Two dimensional ordered filtering. +## +## Ordered filter replaces an element of @var{A} with the @var{nth} +## element of the sorted set of neighbours defined by the logical +## (boolean) matrix @var{domain}. +## Neighbour elements are selected to the sort if the corresponding +## element in the @var{domain} matrix is true. +## +## The optional variable @var{S} is a matrix of size(@var{domain}). +## Values of @var{S} corresponding to nonzero values of domain are +## added to values obtained from @var{A} when doing the sorting. +## +## Optional variable @var{padding} determines how the matrix @var{A} +## is padded from the edges. See @code{padarray} for details. +## +## @seealso{ordfilt2, padarray} +## @end deftypefn + + +## Author: Teemu Ikonen +## Created: 5.5.2000 +## Keywords: image processing filtering + +function retval = ordfiltn(A, nth, domain, varargin) + ## Check input + if (nargin < 3) + error("ordfiltn: not enough input arguments"); + endif + if (!ismatrix(A)) + error("ordfiltn: first input must be an array"); + endif + if (!isscalar(nth) || nth <= 0 || nth != round(nth)) + error("ordfiltn: second input argument must be a positive integer"); + endif + if (!ismatrix(domain) && !isscalar(domain)) + error("ordfiltn: third input argument must be an array or a scalar"); + endif + if (isscalar(domain) && (domain <= 0 || domain != round(domain))) + error("ordfiltn: third input argument must be a positive integer, when it is a scalar"); + endif + if (isscalar(domain)) + domain = ones(repmat(domain, 1, ndims(A)), "logical"); + endif + + if (ndims(A) != ndims(domain)) + error("ordfiltn: first and second argument must have same dimensionality"); + endif + if (any(size(A) < size(domain))) + error("ordfiltn: domain array cannot be larger than the data array"); + endif + + ## Parse varargin + S = zeros(size(domain)); + padding = 0; + for i=1:length(varargin) + a = varargin{:}; + if (ischar(a) || isscalar(a)) + padding = a; + elseif (ismatrix(a) && size_equal(a, domain)) + S = a; + endif + endfor + + ## Make sure 'domain' is logical. The C++ code assumes this. + domain = logical(domain); + + ## Pad array + pad = floor(size(domain)/2); + A = padarray(A, pad, padding); + even = ( round(size(domain)/2) == size(domain)/2 ); + idx = cell(1, ndims(A)); + for k = 1:ndims(A) + idx{k} = (even(k)+1):size(A,k); + endfor + A = A(idx{:}); + + ## Perform the filtering + retval = __spatial_filtering__ (A, domain, "ordered", S, nth); +endfunction diff --git a/octave_packages/image-1.0.15/packinfo/.autoload b/octave_packages/image-1.0.15/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/image-1.0.15/packinfo/DESCRIPTION b/octave_packages/image-1.0.15/packinfo/DESCRIPTION new file mode 100644 index 0000000..da8e00a --- /dev/null +++ b/octave_packages/image-1.0.15/packinfo/DESCRIPTION @@ -0,0 +1,15 @@ +Name: Image +Version: 1.0.15 +Date: 2011-04-12 +Author: Various Authors +Maintainer: Soren Hauberg +Title: Image Processing +Description: The Octave-forge Image package provides functions for + processing images. + The package also provides functions for feature extraction, image + statistics, spatial and geometric transformations, morphological + operations, linear filtering, and much more. +Depends: octave (>= 3.2.0) +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net diff --git a/octave_packages/image-1.0.15/packinfo/INDEX b/octave_packages/image-1.0.15/packinfo/INDEX new file mode 100644 index 0000000..0fad670 --- /dev/null +++ b/octave_packages/image-1.0.15/packinfo/INDEX @@ -0,0 +1,113 @@ +image >> Image processing +Display + rgbplot +Read/write + imginfo + bmpwrite + readexif + tiff_tag_read +Reshape + imremap + imperspectivewarp + imresize + imrotate + imrotate_Fourier + imtranslate + imshear + impad + padarray + rotate_scale +Analysis and Statistics + fftconv2 + corr2 + imhist + mean2 + std2 + entropy + qtdecomp + qtgetblk + qtsetblk + graycomatrix + houghtf + hough_line + hough_circle + graythresh + immaximas + phantom +Filtering + imfilter + colfilt + fspecial + imsmooth + histeq + imadjust + imnoise + medfilt2 + ordfilt2 + ordfiltn + uintlut + stretchlim + makelut applylut + deriche + radon + rho_filter + iradon + nonmax_supress +Black and white image functions + bwarea + bwboundaries + bwconncomp + bwdist + bweuler + bwfill + bwlabel + bwmorph + bwperim + bwselect + dilate + edtfunc + erode + bwborder edge + conndef + bwhitmiss + regionprops + fchcode +Morhophological Operations + imerode + imdilate + imopen + imclose + imtophat + mmgradm +Colour controls + cmpermute + cmunique + rgb2ycbcr +Representation + imdither + grayslice + im2bw + im2double + im2uint8 + im2uint16 + isbw + isgray + isind + isrgb + mat2gray + rgb2gray + label2rgb + imcomplement +Colour maps + colorgradient +Region-based and block processing + roicolor + poly2mask + bestblk + blkproc + nlfilter + im2col + col2im + rangefilt + stdfilt + entropyfilt diff --git a/octave_packages/image-1.0.15/padarray.m b/octave_packages/image-1.0.15/padarray.m new file mode 100644 index 0000000..4632c40 --- /dev/null +++ b/octave_packages/image-1.0.15/padarray.m @@ -0,0 +1,374 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{B} = } padarray (@var{A},@var{padsize}) +## @deftypefnx {Function File} {@var{B} = } padarray (@var{A},@var{padsize},@var{padval}) +## @deftypefnx {Function File} {@var{B} = } padarray (@var{A},@var{padsize},@var{padval},@var{direction}) +## Pads an array in a configurable way. +## +## B = padarray(A,padsize) pads an array @var{A} with zeros, where +## @var{padsize} defines the amount of padding to add in each dimension +## (it must be a vector of positive integers). +## +## Each component of @var{padsize} defines the number of elements of +## padding that will be added in the corresponding dimension. For +## instance, [4,5] adds 4 elements of padding in first dimension (vertical) +## and 5 in second dimension (horizontal). +## +## B = padarray(A,padsize,padval) pads @var{A} using the value specified +## by @var{padval}. @var{padval} can be a scalar or a string. Possible +## values are: +## +## @table @asis +## @item 0 +## Pads with 0 as described above. This is the default behaviour. +## @item Scalar +## Pads using @var{padval} as a padding value. +## @item "Circular" +## Pads with a circular repetition of elements in @var{A} (similar to +## tiling @var{A}). +## @item "Replicate" +## Pads replicating values of @var{A} which are at the border of the +## array. +## @item "Symmetric" +## Pads with a mirror reflection of @var{A}. +## @item "Reflect" +## Same as "symmetric", but the borders are not used in the padding. +## @end table +## +## B = padarray(A,padsize,padval,direction) pads @var{A} defining the +## direction of the pad. Possible values are: +## +## @table @asis +## @item "Both" +## For each dimension it pads before the first element the number +## of elements defined by @var{padsize} and the same number again after +## the last element. This is the default value. +## @item "Pre" +## For each dimension it pads before the first element the number of +## elements defined by @var{padsize}. +## @item "Post" +## For each dimension it pads after the last element the number of +## elements defined by @var{padsize}. +## @end table +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function B = padarray(A, padsize, padval = 0, direction = "both") + # Check parameters + if (nargin < 2 || nargin > 4) + print_usage(); + endif + + if (!isvector(padsize) || !isnumeric(padsize) || any(padsize < 0) || any(padsize != round(padsize))) + error("padarray: padsize must be a vector of positive integers."); + endif + if (!isscalar(padval) && !ischar(padval)) + error("padarray: third input argument must be a string or a scalar"); + endif + if (!ischar(direction) || strcmpi(direction, {"pre", "post", "both"})) + error("padarray: fourth input argument must be 'pre', 'post', or 'both'"); + endif + + ## Assure padsize is a row vector + padsize = padsize(:).'; + + # Check direction + pre = any(strcmpi(direction, {"pre", "both"})); + post = any(strcmpi(direction, {"post", "both"})); + + B = A; + dim = 1; + for s = padsize + if (s > 0) + # padding in this dimension was requested + ds = size(B); + ds = [ds, ones(1,dim-length(ds))]; # data size + ps = ds; + ps(dim) = s; # padding size + + if (ischar(padval)) + # Init a "index all" cell array. All cases need it. + idx = cell(1, length(ds)); + for i = 1:length(ds) + idx{i} = 1:ds(i); + endfor + + switch (padval) + case ("circular") + complete = 0; + D = B; + if (ps(dim) > ds(dim)) + complete = floor(ps(dim)/ds(dim)); + ps(dim) = rem(ps(dim), ds(dim)); + endif + if (pre) + for i = 1:complete + B = cat(dim, D, B); + endfor + idxt = idx; + idxt{dim} = ds(dim)-ps(dim)+1:ds(dim); + B = cat(dim, D(idxt{:}), B); + endif + if (post) + for i = 1:complete + B = cat(dim, B, D); + endfor + idxt = idx; + idxt{dim} = 1:ps(dim); + B = cat(dim, B, D(idxt{:})); + endif + # end circular case + + case ("replicate") + if (pre) + idxt = idx; + idxt{dim} = 1; + pad = B(idxt{:}); + # can we do this without the loop? + for i = 1:s + B = cat(dim, pad, B); + endfor + endif + if (post) + idxt = idx; + idxt{dim} = size(B, dim); + pad = B(idxt{:}); + for i = 1:s + B = cat(dim, B, pad); + endfor + endif + # end replicate case + + case ("symmetric") + if (ps(dim) > ds(dim)) + error("padarray: padding is longer than data using symmetric padding"); + endif + if (pre) + idxt = idx; + idxt{dim} = ps(dim):-1:1; + B = cat(dim, B(idxt{:}), B); + endif + if (post) + idxt = idx; + sbd = size(B, dim); + idxt{dim} = sbd:-1:sbd-ps(dim)+1; + B = cat(dim, B, B(idxt{:})); + endif + # end symmetric case + + case ("reflect") + if (ps(dim) > ds(dim)-1) + error("padarray: padding is longer than data using 'reflect' padding"); + endif + if (pre) + idxt = idx; + idxt{dim} = (ps(dim):-1:1) + 1; + B = cat(dim, B(idxt{:}), B); + endif + if (post) + idxt = idx; + sbd = size(B, dim)-1; + idxt{dim} = sbd:-1:sbd-ps(dim)+1; + B = cat(dim,B,B(idxt{:})); + endif + # end reflect case + + otherwise + error("padarray: invalid string in padval parameter."); + + endswitch + # end cases where padval is a string + + elseif (isscalar(padval)) + # Handle fixed value padding + if (padval == 0) + pad = zeros(ps, class(A)); ## class(pad) = class(A) + else + pad = padval*ones(ps, class(A)); ## class(pad) = class(A) + endif + if (pre && post) + # check if this is not quicker than just 2 calls (one for each) + B = cat(dim, pad, B, pad); + elseif (pre) + B = cat(dim, pad, B); + elseif (post) + B = cat(dim, B, pad); + endif + endif + endif + dim+=1; + endfor +endfunction + +%!demo +%! padarray([1,2,3;4,5,6],[2,1]) +%! % pads [1,2,3;4,5,6] with a whole border of 2 rows and 1 columns of 0 + +%!demo +%! padarray([1,2,3;4,5,6],[2,1],5) +%! % pads [1,2,3;4,5,6] with a whole border of 2 rows and 1 columns of 5 + +%!demo +%! padarray([1,2,3;4,5,6],[2,1],0,'pre') +%! % pads [1,2,3;4,5,6] with a left and top border of 2 rows and 1 columns of 0 + +%!demo +%! padarray([1,2,3;4,5,6],[2,1],'circular') +%! % pads [1,2,3;4,5,6] with a whole 'circular' border of 2 rows and 1 columns +%! % border 'repeats' data as if we tiled blocks of data + +%!demo +%! padarray([1,2,3;4,5,6],[2,1],'replicate') +%! % pads [1,2,3;4,5,6] with a whole border of 2 rows and 1 columns which +%! % 'replicates' edge data + +%!demo +%! padarray([1,2,3;4,5,6],[2,1],'symmetric') +%! % pads [1,2,3;4,5,6] with a whole border of 2 rows and 1 columns which +%! % is symmetric to the data on the edge + +% Test default padval and direction +%!assert(padarray([1;2],[1]), [0;1;2;0]); +%!assert(padarray([3,4],[0,2]), [0,0,3,4,0,0]); +%!assert(padarray([1,2,3;4,5,6],[1,2]), \ +%! [zeros(1,7);0,0,1,2,3,0,0;0,0,4,5,6,0,0;zeros(1,7)]); + +% Test padding on 3D array +%!test +%! int8(0); % fail for octave <= 2.1.57 without crashing +%! assert(padarray([1,2,3;4,5,6],[3,2,1]), cat(3, \ +%! zeros(8,7), \ +%! [zeros(3,7); [zeros(2,2), [1,2,3;4,5,6], zeros(2,2)]; zeros(3,7)], \ +%! zeros(8,7))); + +% Test if default param are ok +%!assert(padarray([1,2],[4,5])==padarray([1,2],[4,5],0)); +%!assert(padarray([1,2],[4,5])==padarray([1,2],[4,5],0,'both')); + +% Test literal padval +%!assert(padarray([1;2],[1],i), [i;1;2;i]); + +% Test directions (horizontal) +%!assert(padarray([1;2],[1],i,'pre'), [i;1;2]); +%!assert(padarray([1;2],[1],i,'post'), [1;2;i]); +%!assert(padarray([1;2],[1],i,'both'), [i;1;2;i]); + +% Test directions (vertical) +%!assert(padarray([1,2],[0,1],i,'pre'), [i,1,2]); +%!assert(padarray([1,2],[0,1],i,'post'), [1,2,i]); +%!assert(padarray([1,2],[0,1],i,'both'), [i,1,2,i]); + +% Test vertical padsize +%!assert(padarray([1,2],[0;1],i,'both'), [i,1,2,i]); + +% Test circular padding +%!test +%! A=[1,2,3;4,5,6]; +%! B=repmat(A,7,9); +%! assert(padarray(A,[1,2],'circular','pre'), B(2:4,2:6)); +%! assert(padarray(A,[1,2],'circular','post'), B(3:5,4:8)); +%! assert(padarray(A,[1,2],'circular','both'), B(2:5,2:8)); +%! % This tests when padding is bigger than data +%! assert(padarray(A,[5,10],'circular','both'), B(2:13,3:25)); + +% Test replicate padding +%!test +%! A=[1,2;3,4]; +%! B=kron(A,ones(10,5)); +%! assert(padarray(A,[9,4],'replicate','pre'), B(1:11,1:6)); +%! assert(padarray(A,[9,4],'replicate','post'), B(10:20,5:10)); +%! assert(padarray(A,[9,4],'replicate','both'), B); + +% Test symmetric padding +%!test +%! A=[1:3;4:6]; +%! HA=[3:-1:1;6:-1:4]; +%! VA=[4:6;1:3]; +%! VHA=[6:-1:4;3:-1:1]; +%! B=[VHA,VA,VHA; HA,A,HA; VHA,VA,VHA]; +%! assert(padarray(A,[1,2],'symmetric','pre'), B(2:4,2:6)); +%! assert(padarray(A,[1,2],'symmetric','post'), B(3:5,4:8)); +%! assert(padarray(A,[1,2],'symmetric','both'), B(2:5,2:8)); + +% Repeat some tests with int* uint* class types +%!assert(padarray(int8([1;2]),[1]), int8([0;1;2;0])); +%!assert(padarray(uint8([3,4]),[0,2]), uint8([0,0,3,4,0,0])); +%!assert(padarray(int16([1;2]),[1],4), int16([4;1;2;4])); +%!assert(padarray(uint16([1;2]),[1],0), uint16([0;1;2;0])); +%!assert(padarray(int32([1;2]),[1],int32(4),'pre'), int32([4;1;2])); +%!assert(padarray(uint32([1;2]),[1],6,'post'), uint32([1;2;6])); + +% Test circular padding with int* uint* class types +%!test +%! A=int8([1,2,3;4,5,6]); +%! B=repmat(A,7,9); +%! assert(padarray(A,[1,2],'circular','pre'), B(2:4,2:6)); +%! assert(padarray(A,[1,2],'circular','post'), B(3:5,4:8)); +%! assert(padarray(A,[1,2],'circular','both'), B(2:5,2:8)); +%! % This tests when padding is bigger than data +%! assert(padarray(A,[5,10],'circular','both'), B(2:13,3:25)); + +% Test replicate padding with int* uint* class types +%!test +%! A=uint8([1,2;3,4]); +%! B=[ones(10,5,"uint8")*1,ones(10,5,"uint8")*2; \ +%! ones(10,5,"uint8")*3,ones(10,5,"uint8")*4]; +%! assert(padarray(A,[9,4],'replicate','pre'), B(1:11,1:6)); +%! assert(padarray(A,[9,4],'replicate','post'), B(10:20,5:10)); +%! assert(padarray(A,[9,4],'replicate','both'), B); + +% Test symmetric padding with int* uint* class types +%!test +%! A=int16([1:3;4:6]); +%! HA=int16([3:-1:1;6:-1:4]); +%! VA=int16([4:6;1:3]); +%! VHA=int16([6:-1:4;3:-1:1]); +%! B=[VHA,VA,VHA; HA,A,HA; VHA,VA,VHA]; +%! assert(padarray(A,[1,2],'symmetric','pre'), B(2:4,2:6)); +%! assert(padarray(A,[1,2],'symmetric','post'), B(3:5,4:8)); +%! assert(padarray(A,[1,2],'symmetric','both'), B(2:5,2:8)); + + + +% +% $Log$ +% Revision 1.2 2007/03/23 16:14:37 adb014 +% Update the FSF address +% +% Revision 1.1 2006/08/20 12:59:35 hauberg +% Changed the structure to match the package system +% +% Revision 1.6 2005/09/08 02:00:17 pkienzle +% [for Bill Denney] isstr -> ischar +% +% Revision 1.5 2004/09/03 18:33:11 pkienzle +% skip tests which use cat(3,X,Y) for octave <= 2.1.57 +% +% Revision 1.4 2004/09/03 13:37:10 jmones +% Corrected behaviour for int* and uint* types +% +% Revision 1.3 2004/08/15 19:21:50 jmones +% support column vector padsize +% +% Revision 1.2 2004/08/11 15:04:59 pkienzle +% Convert dos line endings to unix line endings +% +% Revision 1.1 2004/08/08 21:20:25 jmones +% uintlut and padarray functions added +% +% diff --git a/octave_packages/image-1.0.15/phantom.m b/octave_packages/image-1.0.15/phantom.m new file mode 100644 index 0000000..efd51a4 --- /dev/null +++ b/octave_packages/image-1.0.15/phantom.m @@ -0,0 +1,215 @@ +## Copyright (C) 2010 Alex Opie +## +## This program is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## +## @defun {@var{P} =} phantom ('Shepp-Logan', @var{n}) +## +## Produces the Shepp-Logan phantom, with size @var{n} x @var{n}. +## If @var{n} is omitted, 256 is used. +## +## @defunx {@var{P} =} phantom ('Modified Shepp-Logan', @var{n}) +## +## Produces a modified version of the Shepp-Logan phantom which has +## higher contrast than the original, with size @var{n} x @var{n}. +## If @var{n} is omitted, 256 is used. +## +## @defunx {@var{P} =} phantom (@var{ellipses}, @var{n}) +## +## Produces a custom phantom using the ellipses described in @var{ellipses}. +## Each row of @var{ellipses} describes one ellipse, and must have 6 columns: +## @{I, a, b, x0, y0, phi@}: +## @table @abbr +## @item I +## is the additive intensity of the ellipse +## +## @item a +## is the length of the major axis +## +## @item b +## is the length of the minor axis +## +## @item x0 +## is the horizontal offset of the centre of the ellipse +## +## @item y0 +## is the vercal offset of the centre of the ellipse +## +## @item phi +## is the counterclockwise rotation of the ellipse in degrees, +## measured as the angle between the x axis and the ellipse major axis. +## +## @end table +## +## The image bounding box in the algorithm is @{[-1, -1], [1, 1]@}, so the +## values of a, b, x0, y0 should all be specified with this in mind. +## If @var{n} is omitted, 256 is used. +## +## @defunx {@var{P} =} phantom (@var{n}) +## +## Creates a modified Shepp-Logan phantom with size @var{n} x @var{n}. +## +## @defunx {@var{P} = } phantom () +## +## Creates a modified Shepp-Logan phantom with size 256 x 256. +## @end defun +## +## Create a Shepp-Logan or modified Shepp-Logan phantom. +## +## A phantom is a known object (either real or purely mathematical) that +## is used for testing image reconstruction algorithms. The Shepp-Logan +## phantom is a popular mathematical model of a cranial slice, made up +## of a set of ellipses. This allows rigorous testing of computed +## tomography (CT) algorithms as it can be analytically transformed with +## the radon transform (see the function @command{radon}). +## +## Example: +## +## @example +## P = phantom (512); +## imshow (P, []); +## @end example +## +## References: +## +## Shepp, L. A.; Logan, B. F.; Reconstructing Interior Head Tissue +## from X-Ray Transmissions, IEEE Transactions on Nuclear Science, +## Feb. 1974, p. 232. +## +## Toft, P.; "The Radon Transform - Theory and Implementation", Ph.D. thesis, +## Department of Mathematical Modelling, Technical University +## of Denmark, June 1996. + +function p = phantom (varargin) + + [n, ellipses] = read_args (varargin {:}); + + # Blank image + p = zeros (n); + + # Create the pixel grid + xvals = (-1 : 2 / (n - 1) : 1); + xgrid = repmat (xvals, n, 1); + + for i = 1:size (ellipses, 1) + I = ellipses (i, 1); + a2 = ellipses (i, 2)^2; + b2 = ellipses (i, 3)^2; + x0 = ellipses (i, 4); + y0 = ellipses (i, 5); + phi = ellipses (i, 6) * pi / 180; # Rotation angle in radians + + # Create the offset x and y values for the grid + x = xgrid - x0; + y = rot90 (xgrid) - y0; + + cos_p = cos (phi); + sin_p = sin (phi); + + # Find the pixels within the ellipse + locs = find (((x .* cos_p + y .* sin_p).^2) ./ a2 ... + + ((y .* cos_p - x .* sin_p).^2) ./ b2 <= 1); + + # Add the ellipse intensity to those pixels + p (locs) = p (locs) + I; + endfor +endfunction + +function [n, ellip] = read_args (varargin) + n = 256; + ellip = mod_shepp_logan (); + + if (nargin == 1) + if (ischar (varargin {1})) + ellip = select_phantom (varargin {1}); + elseif (numel (varargin {1}) == 1) + n = varargin {1}; + else + if (size (varargin {1}, 2) != 6) + error ("Wrong number of columns in user phantom"); + endif + ellip = varargin {1}; + endif + elseif (nargin == 2) + n = varargin {2}; + if (ischar (varargin {1})) + ellip = select_phantom (varargin {1}); + else + if (size (varargin {1}, 2) != 6) + error ("Wrong number of columns in user phantom"); + endif + ellip = varargin {1}; + endif + elseif (nargin > 2) + warning ("Extra arguments passed to phantom were ignored"); + endif +endfunction + +function e = select_phantom (name) + if (strcmpi (name, 'shepp-logan')) + e = shepp_logan (); + elseif (strcmpi (name, 'modified shepp-logan')) + e = mod_shepp_logan (); + else + error ("Unknown phantom type: %s", name); + endif +endfunction + +function e = shepp_logan + # Standard head phantom, taken from Shepp & Logan + e = [ 2, .69, .92, 0, 0, 0; + -.98, .6624, .8740, 0, -.0184, 0; + -.02, .1100, .3100, .22, 0, -18; + -.02, .1600, .4100, -.22, 0, 18; + .01, .2100, .2500, 0, .35, 0; + .01, .0460, .0460, 0, .1, 0; + .02, .0460, .0460, 0, -.1, 0; + .01, .0460, .0230, -.08, -.605, 0; + .01, .0230, .0230, 0, -.606, 0; + .01, .0230, .0460, .06, -.605, 0]; +endfunction + +function e = mod_shepp_logan + # Modified version of Shepp & Logan's head phantom, + # adjusted to improve contrast. Taken from Toft. + e = [ 1, .69, .92, 0, 0, 0; + -.80, .6624, .8740, 0, -.0184, 0; + -.20, .1100, .3100, .22, 0, -18; + -.20, .1600, .4100, -.22, 0, 18; + .10, .2100, .2500, 0, .35, 0; + .10, .0460, .0460, 0, .1, 0; + .10, .0460, .0460, 0, -.1, 0; + .10, .0460, .0230, -.08, -.605, 0; + .10, .0230, .0230, 0, -.606, 0; + .10, .0230, .0460, .06, -.605, 0]; +endfunction + +#function e = ?? +# # Add any further phantoms of interest here +# e = [ 0, 0, 0, 0, 0, 0; +# 0, 0, 0, 0, 0, 0]; +#endfunction + +%!demo +%! P = phantom (512); +%! imshow (P, []); + +% $Log$ +% 2010/03/31 lxop +% Fixed typo that prevented the use of custom ellipses +% +% 2010/03/09 lxop +% First commit to repo diff --git a/octave_packages/image-1.0.15/poly2mask.m b/octave_packages/image-1.0.15/poly2mask.m new file mode 100644 index 0000000..5722716 --- /dev/null +++ b/octave_packages/image-1.0.15/poly2mask.m @@ -0,0 +1,259 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{BW} = } poly2mask (@var{x},@var{y},@var{m},@var{n}) +## Convert a polygon to a region mask. +## +## BW=poly2mask(x,y,m,n) converts a polygon, specified by a list of +## vertices in @var{x} and @var{y} and returns in a @var{m}-by-@var{n} +## logical mask @var{BW} the filled polygon. Region inside the polygon +## is set to 1, values outside the shape are set to 0. +## +## @var{x} and @var{y} should always represent a closed polygon, first +## and last points should be coincident. If they are not poly2mask will +## close it for you. If @var{x} or @var{y} are fractional they are +## nearest integer. +## +## If all the polygon or part of it falls outside the masking area +## (1:m,1:n), it is discarded or clipped. +## +## This function uses scan-line polygon filling algorithm as described +## in http://www.cs.rit.edu/~icss571/filling/ with some minor +## modifications: capability of clipping and scan order, which can +## affect the results of the algorithm (algorithm is described not to +## reach ymax, xmax border when filling to avoid enlarging shapes). In +## this function we scan the image backwards (we begin at ymax and end +## at ymin), and we don't reach ymin, xmin, which we believe should be +## compatible with MATLAB. +## @end deftypefn + + +## TODO: check how to create a logical BW without any conversion + +## Author: Josep Mones i Teixidor + +function BW = poly2mask (x, y, m, n) + if (nargin != 4) + print_usage (); + endif + + ## check x and y + x = round (x (:).'); + y = round (y (:).'); + if (length (x) < 3) + error ("poly2mask: polygon must have at least 3 vertices."); + endif + if (length (x) != length (y)) + error ("poly2mask: length of x doesn't match length of y."); + endif + + ## create output matrix + BW = false (m, n); + + ## close polygon if needed + if ((x (1) != x (length (x))) || (y (1) != y (length (y)))) + x = horzcat (x, x (1)); + y = horzcat (y, y (1)); + endif + + ## build global edge table + ex = [x(1:length (x) - 1); x(1, 2:length (x))]; ## x values for each edge + ey = [y(1:length (y) - 1); y(1, 2:length (y))]; ## y values for each edge + idx = (ey (1, :) != ey (2, :)); ## eliminate horizontal edges + ex = ex (:, idx); + ey = ey (:, idx); + eminy = min (ey); ## minimum y for each edge + emaxy = max (ey); ## maximum y for each edge + t = (ey == [eminy; eminy]); ## values associated to miny + exminy = ex (:) (t); ## x values associated to min y + exmaxy = ex (:) (!t); ## x values associated to max y + emaxy = emaxy.'; ## we want them vertical now... + eminy = eminy.'; + m_inv = (exmaxy - exminy)./(emaxy - eminy); ## calculate inverse slope + ge = [emaxy, eminy, exmaxy, m_inv]; ## build global edge table + ge = sortrows (ge, [1, 3]); ## sort on eminy and exminy + + ## we add an extra dummy edge at the end just to avoid checking + ## while indexing it + ge = [-Inf, -Inf, -Inf, -Inf; ge]; + + ## initial parity is even (0) + parity = 0; + + ## init scan line set to bottom line + sl = ge (size (ge, 1), 1); + + ## init active edge table + ## we use a loop because the table is sorted and edge list could be + ## huge + ae = []; + gei = size (ge, 1); + while (sl == ge (gei, 1)) + ae = [ge(gei, 2:4); ae]; + gei -= 1; + endwhile + + ## calc minimum y to draw + miny = min (y); + if (miny < 1) + miny = 1; + endif + + while (sl >= miny) + ## check vert clipping + if (sl <= m) + ## draw current scan line + ## we have to round because 1/m is fractional + ie = round (reshape (ae (:, 2), 2, size (ae, 1)/2)); + + ## this discards left border of image (this differs from version at + ## http://www.cs.rit.edu/~icss571/filling/ which discards right + ## border) but keeps an exception when the point is a vertex. + ie (1, :) += (ie (1, :) != ie (2, :)); + + ## we'll clip too, just in case m,n is not big enough + ie (1, (ie (1, :) < 1)) = 1; + ie (2, (ie (2, :) > n)) = n; + + ## we eliminate segments outside window + ie = ie (:, (ie (1, :) <= n)); + ie = ie (:, (ie (2, :) >= 1)); + for i = 1:columns (ie) + BW (sl, ie (1, i):ie (2, i)) = true; + endfor + endif + + ## decrement scan line + sl -= 1; + + ## eliminate edges that eymax==sl + ## this discards ymin border of image (this differs from version at + ## http://www.cs.rit.edu/~icss571/filling/ which discards ymax). + ae = ae ((ae (:, 1) != sl), :); + + ## update x (x1=x0-1/m) + ae (:, 2) -= ae (:, 3); + + ## update ae with new values + while (sl == ge (gei, 1)) + ae = vertcat (ae, ge (gei, 2:4)); + gei -= 1; + endwhile + + ## order the edges in ae by x value + if (rows (ae) > 0) + ae = sortrows (ae, 2); + endif + endwhile +endfunction + +## This should create a filled octagon +%!demo +%! s = [0:pi/4:2*pi]; +%! x = cos (s) * 90 + 101; +%! y = sin (s) * 90 + 101; +%! bw = poly2mask(x, y, 200, 200); +%! imshow (bw); + +## This should create a 5-vertex star +%!demo +%! s = [0:2*pi/5:pi*4]; +%! s = s ([1, 3, 5, 2, 4, 6]); +%! x = cos (s) * 90 + 101; +%! y = sin (s) * 90 + 101; +%! bw = poly2mask (x, y, 200, 200); +%! imshow (bw); + +%!# Convex polygons + +%!shared xs, ys, Rs, xt, yt, Rt +%! xs=[3,3,10,10]; +%! ys=[4,12,12,4]; +%! Rs=zeros(16,14); +%! Rs(5:12,4:10)=1; +%! Rs=logical(Rs); +%! xt=[1,4,7]; +%! yt=[1,4,1]; +%! Rt=[0,0,0,0,0,0,0; +%! 0,0,1,1,1,1,0; +%! 0,0,0,1,1,0,0; +%! 0,0,0,1,0,0,0; +%! 0,0,0,0,0,0,0]; +%! Rt=logical(Rt); + +%!assert(poly2mask(xs,ys,16,14),Rs); # rectangle +%!assert(poly2mask(xs,ys,8,7),Rs(1:8,1:7)); # clipped +%!assert(poly2mask(xs-7,ys-8,8,7),Rs(9:16,8:14)); # more clipping + +%!assert(poly2mask(xt,yt,5,7),Rt); # triangle +%!assert(poly2mask(xt,yt,3,3),Rt(1:3,1:3)); # clipped + + +%!# Concave polygons + +%!test +%! x=[3,3,5,5,8,8,10,10]; +%! y=[4,12,12,8,8,11,11,4]; +%! R=zeros(16,14); +%! R(5:12,4:5)=1; +%! R(5:8,6:8)=1; +%! R(5:11,9:10)=1; +%! R=logical(R); +%! assert(poly2mask(x,y,16,14), R); + +%!# Complex polygons +%!test +%! x=[1,5,1,5]; +%! y=[1,1,4,4]; +%! R=[0,0,0,0,0,0; +%! 0,0,1,1,0,0; +%! 0,0,1,1,0,0; +%! 0,1,1,1,1,0; +%! 0,0,0,0,0,0]; +%! R=logical(R); +%! assert(poly2mask(x,y,5,6), R); + + + + + +% +% $Log$ +% Revision 1.3 2007/03/23 16:14:37 adb014 +% Update the FSF address +% +% Revision 1.2 2007/01/04 23:37:54 hauberg +% Minor changes in help text +% +% Revision 1.1 2006/08/20 12:59:35 hauberg +% Changed the structure to match the package system +% +% Revision 1.5 2004/09/07 14:47:50 pkienzle +% Avoid segfaults on pre-2.1.58 octave. Invisible whitespace changes. +% +% Revision 1.4 2004/09/03 17:12:36 jmones +% Uses uint8 to save some temporal memory (suggested by David Bateman) +% +% Revision 1.3 2004/09/03 13:32:07 jmones +% Work with logical arrays from BW creation +% +% Revision 1.2 2004/08/11 17:39:51 jmones +% Algorithm url in docs corrected. +% +% Revision 1.1 2004/08/11 17:34:11 jmones +% poly2mask added: creates filled polygon bw mask +% +% diff --git a/octave_packages/image-1.0.15/qtdecomp.m b/octave_packages/image-1.0.15/qtdecomp.m new file mode 100644 index 0000000..c03bdb9 --- /dev/null +++ b/octave_packages/image-1.0.15/qtdecomp.m @@ -0,0 +1,341 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{S} = } qtdecomp (@var{I}) +## @deftypefnx {Function File} {@var{S} = } qtdecomp (@var{I},@var{threshold}) +## @deftypefnx {Function File} {@var{S} = } qtdecomp (@var{I},@var{threshold},@var{mindim}) +## @deftypefnx {Function File} {@var{S} = } qtdecomp (@var{I},@var{threshold},@var{[mindim maxdim]}) +## @deftypefnx {Function File} {@var{S} = } qtdecomp (@var{I},@var{fun}) +## @deftypefnx {Function File} {@var{S} = } qtdecomp (@var{I},@var{fun},@var{P1},@var{P2},...) +## Performs quadtree decomposition. +## +## qtdecomp decomposes a square image @var{I} into four equal-sized +## blocks. Then it performs some kind of test on each block to decide if +## it should decompose them further. This process is repeated +## iteratively until there's no block left to be decomposed. +## +## Note that blocks are not decomposed if their dimensions are not even. +## +## The output is a sparse matrix whose non-zero elements determine the +## position of the block (the element is at top-left position in the +## block) and size of each block (the value of the element determines +## length of a side of the square-shaped block). +## +## S = qtdecomp(I) decomposes an intensity image @var{I} as described +## above. By default it doesn't split a block if all elements are equal. +## +## S = qtdecomp(I, threshold) decomposes an image as decribed, but only +## splits a block if the maximum value in the block minus the minimum +## value is greater than @var{threshold}, which is a value between 0 and +## 1. If @var{I} is of class uint8, @var{threshold} is multiplied by 255 +## before use. Also, if@var{I} is of class uint16, @var{threshold} is +## multiplied by 65535. +## +## S = qtdecomp(I, threshold, mindim) decomposes an image using the +## @var{threshold} as just described, but doesn't produce blocks smaller +## than mindim. +## +## S = qtdecomp(I, threshold, [mindim maxdim]) decomposes an image as +## described, but produces blocks that can't be bigger than maxdim. It +## decomposes to maxdim even if it isn't needed if only @var{threshold} +## was considered. +## +## S = qtdecomp(I, fun) decomposes an image @var{I} and uses function +## @var{fun} to decide if a block should be splitted or not. @var{fun} +## is called with a m-by-m-by-k array of m-by-m blocks to be +## considered, and should return a vector of size k, whose elements +## represent each block in the stacked array. @var{fun} sets the +## corresponding value to 1 if the block should be split, and 0 +## otherwise. +## +## S = qtdecomp(I, fun, ...) behaves as qtdecomp(I, fun) but passes +## extra parameters to @var{fun}. +## +## @seealso{qtgetblk, qtsetblk} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function S = qtdecomp(I, p1, varargin) + if (nargin<1) + usage("S=qtdecomp(I)"); + endif + + if (!ismatrix(I) || size(I,1)!=size(I,2)) + error("qtdecomp: I should be a square matrix."); + endif + + ## current size (assumed to be square) + curr_size=size(I,1); + + ## initial mindim to a sensible value + mindim=1; + + ## sensible default maxdim value + maxdim=curr_size; + + if (nargin<2) + ## Initialize decision method variable + ## We could have implemented threshold as a function and use an + ## uniform interface (function handle) to decide whether to split or + ## not blocks. We have decided not to do so because block + ## rearrangement that is needed as a parameter to functions is + ## expensive. + decision_method=0; + elseif (isreal(p1)) + ## p1 is threshold + threshold=p1; + decision_method=1; + + if(strcmp(typeinfo(I), 'uint8 matrix')) + threshold*=255; + elseif(strcmp(typeinfo(I), 'uint16 matrix')) + threshold*=65535; + endif + + if (nargin>3) + usage("S=qtdecomp(I,threshold,mindim), \ + S=qtdecomp(I,threshold,[mindim maxdim])"); + elseif (nargin==3) + dims=varargin{1}; + if (isvector(dims)&&length(dims)==2) + mindim=dims(1); + maxdim=dims(2); + elseif (isreal(dims)) + mindim=dims; + else + error("qtdecomp: third parameter must be 'mindim' or '[mindim maxdim]'"); + endif + ## we won't check if mindim or maxdim are powers of 2. It's too + ## restrictive and don't need it at all. + endif + + elseif strcmp(typeinfo(p1),"function handle") ... + || strcmp(typeinfo(p1),"inline function") + ## function handles seem to return true to isscalar + fun=p1; + decision_method=2; + else + error("qtdecomp: second parameter must be a integer (threshold) or a function handle (fun)."); + endif + + ## initialize results matrices + res=[]; + + ## bool to flag end + finished=false; + + ## array of offsets to blocks to evaluate + offsets=[1,1]; + + if (maxdim0) + divs=2^initial_splits; + if (rem(curr_size,divs)!=0) + error("qtdecomp: Can't decompose I enough times to fulfill maxdim requirement."); + endif + ## update curr_size + curr_size/=divs; + if(curr_size0) + ## check other ending conditions: + ## is size is odd? + ## is splitted size < than mindim? + if ((rem(curr_size,2)!=0)||((curr_size/2) varargin{:}. Now works on 2.1.58 +% +% Revision 1.5 2004/09/08 14:07:22 pkienzle +% Fix test for 'inline function' +% +% Revision 1.4 2004/08/11 19:52:41 jmones +% qtsetblk added +% +% Revision 1.3 2004/08/11 00:05:21 jmones +% seealso qtgetblk added to doc +% +% Revision 1.2 2004/08/10 00:19:42 jmones +% Corrected misleading comment. +% +% Revision 1.1 2004/08/09 01:48:54 jmones +% Added qtdecomp: quadtree decomposition +% +% + diff --git a/octave_packages/image-1.0.15/qtgetblk.m b/octave_packages/image-1.0.15/qtgetblk.m new file mode 100644 index 0000000..9b0f092 --- /dev/null +++ b/octave_packages/image-1.0.15/qtgetblk.m @@ -0,0 +1,162 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{vals}] = } qtgetblk (@var{I},@var{S},@var{dim}) +## @deftypefnx {Function File} {[@var{vals},@var{idx}] = } qtgetblk (@var{I},@var{S},@var{dim}) +## @deftypefnx {Function File} {[@var{vals},@var{r},@var{c}] = } qtgetblk (@var{I},@var{S},@var{dim}) +## Obtain block values from a quadtree decomposition. +## +## [vals]=qtgetblk(I,S,dim) returns a dim-by-dim-by-k array in +## @var{vals} which contains the dim-by-dim blocks in the quadtree +## decomposition (@var{S}, which is returned by qtdecomp) of @var{I}. If +## there are no blocks, an empty matrix is returned. +## +## [vals,idx]=qtgetblk(I,S,dim) returns @var{vals} as described above. +## In addition, it returns @var{idx}, a vector which contains the linear +## indices of the upper left corner of each block returned (the same +## result as find(full(S)==dim)). +## +## [vals,r,c]=qtgetblk(I,S,dim) returns @var{vals} as described, and two +## vectors, @var{r} and @var{c}, which contain the row and column +## coordinates of the blocks returned. +## +## @seealso{qtdecomp, qtsetblk} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function [varargout] = qtgetblk(I, S, dim) + if (nargin!=3) + usage("[vals,r,c]=qtgetblk(I,S,dim), [vals,idx]=qtgetblk(I,S,dim)"); + endif + if (nargout>3) + usage("[vals,r,c]=qtgetblk(I,S,dim), [vals,idx]=qtgetblk(I,S,dim)"); + endif + + ## get blocks + [i,j,v]=find(S); + + ## filter the ones which match dim + idx=find(v==dim); + + if(length(idx)==0) + for i=1:nargout + varargout{i}=[]; + endfor + else + r=i(idx); + c=j(idx); + + ## copy to a dim-by-dim-by-k array + vals=zeros(dim,dim,length(idx)); + for i=1:length(idx) + vals(:,:,i)=I(r(i):r(i)+dim-1,c(i):c(i)+dim-1); + endfor + + varargout{1}=vals; + + if(nargout==3) + varargout{2}=r; + varargout{3}=c; + elseif(nargout==2) + varargout{2}=(c-1)*rows(I)+r; + endif + endif +endfunction + + +%!demo +%! [vals,r,c]=qtgetblk(eye(4),qtdecomp(eye(4)),2) +%! % Returns 2 blocks, at [1,3] and [3,1] (2*2 zeros blocks) + +%!shared A,S +%! A=[ 1, 4, 2, 5,54,55,61,62; +%! 3, 6, 3, 1,58,53,67,65; +%! 3, 6, 3, 1,58,53,67,65; +%! 3, 6, 3, 1,58,53,67,65; +%! 23,42,42,42,99,99,99,99; +%! 27,42,42,42,99,99,99,99; +%! 23,22,26,25,99,99,99,99; +%! 22,22,24,22,99,99,99,99]; +%! S=qtdecomp(A,10); + +%!test +%! [va]=qtgetblk(A,S,8); +%! [vb,r,c]=qtgetblk(A,S,8); +%! [vc,i]=qtgetblk(A,S,8); +%! assert(va, vb); +%! assert(va, vc); +%! assert(i,[]); +%! assert(r,[]); +%! assert(c,[]); +%! R=[]; +%! assert(va,R); + + +%!test +%! [va]=qtgetblk(A,S,4); +%! [vb,r,c]=qtgetblk(A,S,4); +%! [vc,i]=qtgetblk(A,S,4); +%! assert(va, vb); +%! assert(va, vc); +%! assert(i, find(full(S)==4)); +%! assert(r,[1;5]); +%! assert(c,[1;5]); +%! R=zeros(4,4,2); +%! R(:,:,1)=A(1:4,1:4); +%! R(:,:,2)=A(5:8,5:8); +%! assert(va,R); + +%!test +%! [va]=qtgetblk(A,S,2); +%! [vb,r,c]=qtgetblk(A,S,2); +%! [vc,i]=qtgetblk(A,S,2); +%! assert(va, vb); +%! assert(va, vc); +%! assert(i, find(full(S)==2)); +%! assert(r,[7;5;7;1;3;1;3]); +%! assert(c,[1;3;3;5;5;7;7]); +%! R=zeros(2,2,7); +%! R(:,:,1)=A(7:8,1:2); +%! R(:,:,2)=A(5:6,3:4); +%! R(:,:,3)=A(7:8,3:4); +%! R(:,:,4)=A(1:2,5:6); +%! R(:,:,5)=A(3:4,5:6); +%! R(:,:,6)=A(1:2,7:8); +%! R(:,:,7)=A(3:4,7:8); +%! assert(va,R); + +% +% $Log$ +% Revision 1.4 2007/03/23 16:14:37 adb014 +% Update the FSF address +% +% Revision 1.3 2007/01/04 23:50:47 hauberg +% Put seealso before end deftypefn +% +% Revision 1.2 2007/01/04 23:41:47 hauberg +% Minor changes in help text +% +% Revision 1.1 2006/08/20 12:59:35 hauberg +% Changed the structure to match the package system +% +% Revision 1.3 2006/01/02 20:53:42 pkienzle +% Reduce number of shared variables in tests +% +% Revision 1.2 2004/08/11 19:52:41 jmones +% qtsetblk added +% +% diff --git a/octave_packages/image-1.0.15/qtsetblk.m b/octave_packages/image-1.0.15/qtsetblk.m new file mode 100644 index 0000000..d257cae --- /dev/null +++ b/octave_packages/image-1.0.15/qtsetblk.m @@ -0,0 +1,113 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{J} = } qtsetblk (@var{I},@var{S},@var{dim},@var{vals}) +## Set block values in a quadtree decomposition. +## +## J=qtsetblk(I,S,dim,vals) sets all the @var{dim}-by-@var{dim} blocks +## in the quadtree decomposition (@var{S} returned by qtdecomp) of +## @var{I} to @var{dim}-by-@var{dim} blocks in @var{vals}, which is +## itself a @var{dim}-by-@var{dim}-by-k array. k is the number of +## @var{dim}-by-@var{dim} blocks in the quadtree decomposition. +## @seealso{qtdecomp, qtgetblk} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function J = qtsetblk(I, S, dim, vals) + if (nargin!=4) + usage("J=qtsetblk(I,S,dim,vals)"); + endif + + ## get blocks + [ii,ji,v]=find(S); + + ## filter the ones which match dim + idx=find(v==dim); + if(size(vals,3)num blocks + error("qtsetblk: k (vals 3rd dimension) is not equal to number of blocks."); + endif + ii=ii(idx); + ji=ji(idx); + + ## calc end vertex + ie=ii+dim-1; + je=ji+dim-1; + + + J=I; + for b=1:length(idx) + J(ii(b):ie(b),ji(b):je(b))=vals(:,:,b); + endfor +endfunction + + +%!demo +%! J=qtsetblk(eye(4),qtdecomp(eye(4)),2,ones(2,2,2)) +%! % Sets upper-right and lower-left blocks of 2*2 zeros to ones + +%!shared A, S +%! A=[ 1, 4, 2, 5,54,55,61,62; +%! 3, 6, 3, 1,58,53,67,65; +%! 3, 6, 3, 1,58,53,67,65; +%! 3, 6, 3, 1,58,53,67,65; +%! 23,42,42,42,99,99,99,99; +%! 27,42,42,42,99,99,99,99; +%! 23,22,26,25,99,99,99,99; +%! 22,22,24,22,99,99,99,99]; +%! S=qtdecomp(A,10); + +%!test +%! R=A; +%! vals=zeros(4,4,2); +%! vals(:,:,1)=reshape([1:16],4,4); +%! vals(:,:,2)=reshape([21:36],4,4); +%! R(1:4,1:4)=reshape([1:16],4,4); +%! R(5:8,5:8)=reshape([21:36],4,4); +%! assert(qtsetblk(A,S,4,vals),R); + +%!test +%! R=A; +%! R(1:4,5:8)=1; +%! R(7:8,1:4)=1; +%! R(5:6,3:4)=1; +%! assert(qtsetblk(A,S,2,ones(2,2,7)),R); + +%!test +%! R=A; +%! R(5:6,1:2)=10; +%! assert(qtsetblk(A,S,1,ones(1,1,4)*10),R); + + + +% +% $Log$ +% Revision 1.4 2007/03/23 16:14:37 adb014 +% Update the FSF address +% +% Revision 1.3 2007/01/04 23:50:47 hauberg +% Put seealso before end deftypefn +% +% Revision 1.2 2007/01/04 23:41:47 hauberg +% Minor changes in help text +% +% Revision 1.1 2006/08/20 12:59:35 hauberg +% Changed the structure to match the package system +% +% Revision 1.1 2004/08/11 19:52:41 jmones +% qtsetblk added +% +% diff --git a/octave_packages/image-1.0.15/radon.m b/octave_packages/image-1.0.15/radon.m new file mode 100644 index 0000000..d8efc83 --- /dev/null +++ b/octave_packages/image-1.0.15/radon.m @@ -0,0 +1,88 @@ +## Copyright (C) 2007 Alexander Barth +## +## +## This program is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{RT},@var{xp}] =} radon(@var{I}, @var{theta}) +## @deftypefnx {Function File} {[@var{RT},@var{xp}] =} radon(@var{I}) +## +## Calculates the 2D-Radon transform of the matrix @var{I} at angles given in +## @var{theta}. To each element of @var{theta} corresponds a column in @var{RT}. +## The variable @var{xp} represents the x-axis of the rotated coordinate. +## If @var{theta} is not defined, then 0:179 is assumed. +## @end deftypefn + + +function [RT,xp] = radon (I,theta) + + ## Input checking + if (nargin == 0 || nargin > 2) + print_usage (); + elseif (nargin == 1) + theta = 0:179; + endif + + if (!ismatrix(I) || ndims(I) != 2) + error("radon: first input must be a MxN matrix"); + endif + + if (!isvector(theta)) + error("radon: second input must be a vector"); + endif + + [m, n] = size (I); + + # center of image + xc = floor ((m+1)/2); + yc = floor ((n+1)/2); + + # divide each pixel into 2x2 subpixels + + d = reshape (I,[1 m 1 n]); + d = d([1 1],:,[1 1],:); + d = reshape (d,[2*m 2*n])/4; + + b = ceil (sqrt (sum (size (I).^2))/2 + 1); + xp = [-b:b]'; + sz = size(xp); + + [X,Y] = ndgrid (0.75 - xc + [0:2*m-1]/2,0.75 - yc + [0:2*n-1]/2); + + X = X(:)'; + Y = Y(:)'; + d = d(:)'; + + th = theta*pi/180; + + for l=1:length (theta) + # project each pixel to vector (-sin(th),cos(th)) + Xp = -sin (th(l)) * X + cos (th(l)) * Y; + + ip = Xp + b + 1; + + k = floor (ip); + frac = ip-k; + + RT(:,l) = accumarray (k',d .* (1-frac),sz) + accumarray (k'+1,d .* frac,sz); + endfor + +endfunction + +%!test +%! A = radon(ones(2,2),30); +%! assert (A,[0 0 0.608253175473055 2.103325780167649 1.236538105676658 0.051882938682637 0]',1e-10) + + diff --git a/octave_packages/image-1.0.15/rangefilt.m b/octave_packages/image-1.0.15/rangefilt.m new file mode 100644 index 0000000..a4979d5 --- /dev/null +++ b/octave_packages/image-1.0.15/rangefilt.m @@ -0,0 +1,71 @@ +## Copyright (C) 2008 Søren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{R} =} rangefilt (@var{im}) +## @deftypefnx{Function File} {@var{R} =} rangefilt (@var{im}, @var{domain}) +## @deftypefnx{Function File} {@var{R} =} rangefilt (@var{im}, @var{domain}, @var{padding}, ...) +## Computes the local intensity range in a neighbourhood around each pixel in +## an image. +## +## The intensity range of the pixels of a neighbourhood is computed as +## +## @example +## @var{R} = max (@var{x}) - min (@var{x}) +## @end example +## +## where @var{x} is the value of the pixels in the neighbourhood, +## +## The neighbourhood is defined by the @var{domain} binary mask. Elements of the +## mask with a non-zero value are considered part of the neighbourhood. By default +## a 3 by 3 matrix containing only non-zero values is used. +## +## At the border of the image, extrapolation is used. By default symmetric +## extrapolation is used, but any method supported by the @code{padarray} function +## can be used. +## +## @seealso{paddarray, entropyfilt, stdfilt} +## @end deftypefn + +function retval = rangefilt (I, domain = true (3), padding = "symmetric", varargin) + ## Check input + if (nargin == 0) + error ("rangefilt: not enough input arguments"); + endif + + if (!ismatrix (I)) + error ("rangefilt: first input must be a matrix"); + endif + + if (!ismatrix (domain)) + error ("rangefilt: second input argument must be a logical matrix"); + endif + domain = (domain > 0); + + ## Pad image + pad = floor (size (domain)/2); + I = padarray (I, pad, padding, varargin {:}); + even = (round (size (domain)/2) == size (domain)/2); + idx = cell (1, ndims (I)); + for k = 1:ndims (I) + idx {k} = (even (k)+1):size (I, k); + endfor + I = I (idx {:}); + + ## Perform filtering + retval = __spatial_filtering__ (I, domain, "range", I, 0); + +endfunction diff --git a/octave_packages/image-1.0.15/readexif.m b/octave_packages/image-1.0.15/readexif.m new file mode 100644 index 0000000..c6eeeec --- /dev/null +++ b/octave_packages/image-1.0.15/readexif.m @@ -0,0 +1,529 @@ +## Copyright (C) 2009 Roderick Koehle koehle(at)users.sourceforge.net +## +## 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. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{exif} =} readexif(@var{filename}, @var{thumbnail}) +## Read EXIF information from JPEG image data. +## +## The exif tag information are returned in the @var{exif} data structure. +## Integer ratios are expressed as column vector. +## For example, a focal number of 2.8 is expressed +## as FNumber=[28; 10]. Otherwise all data are returned by the type +## as specified in the IFD structures. +## +## The filename for the thumbnail image is optional. +## If given, the thumbnail jpeg image will be stored to +## file @var{thumbnail}. +## +## Reference: +## JEITA CP-3451, Exchangeable image file format for digital still cameras: +## Exif Version 2.2 +## +## @seealso{imwrite, imfinfo} +## @end deftypefn + +function exif = readexif(file, thumbnail) + + % Enable the debug flag to see more of the JPG sections. + + debug = false; + + in = fopen(file); + if (in<0) + error('File "%s" not found !', file); + end + + s = fread(in, 1, 'uint16', 'ieee-be'); + + JPEG.SOI = 0xffd8; + JPEG.APP0 = 0xffe0; + JPEG.APP1 = 0xffe1; + JPEG.APP2 = 0xffe2; + JPEG.DQT = 0xffdb; + JPEG.DHT = 0xffc4; + JPEG.DRI = 0xffdd; + JPEG.SOF = 0xffc0; + JPEG.SOS = 0xffda; + JPEG.EOI = 0xffd9; + + % Stop if no Start of Image found + + if s~=JPEG.SOI + error('JPEG Format error - missing start of image tag.'); + end + + exif = []; + + while ~feof(in) + s = fread(in, 1, 'uint16', 'ieee-be'); + + switch s + case JPEG.SOI + case JPEG.APP0 + l = fread(in, 1, 'uint16', 'ieee-be'); + if debug, printf('APP0: %i\n', l); end + fseek(in, l-2, 'cof'); + case JPEG.APP1 + l = fread(in, 1, 'uint16', 'ieee-be'); + if debug, printf('APP1: %i\n', l); end + app1 = fread(in, l-2, 'uchar'); + if nargin==1 + exif = parseexif(app1); + else + exif = parseexif(app1, thumbnail); + end + % stop reading further, remove following break + % if you want to extend this parser. + break; + case JPEG.APP2 + l = fread(in, 1, 'uint16', 'ieee-be'); + if debug, printf('APP2: %i\n', l); end + fseek(in, l-2, 'cof'); + case JPEG.DQT % define quantization table + l = fread(in, 1, 'uint16', 'ieee-be'); + if debug, printf('DQT: %i\n', l); end; + fseek(in, l-2, 'cof'); + case JPEG.DHT % define huffmann table + l = fread(in, 1, 'uint16', 'ieee-be'); + fseek(in, l-2, 'cof'); + if debug, printf('DHT: %i\n', l); end + case JPEG.DRI % define restart interoperability + l = fread(in, 1, 'uint16', 'ieee-be'); + fseek(in, l-2, 'cof'); + if debug, printf('DRI: %i\n', l); end + case JPEG.SOF % start of frame + l = fread(in, 1, 'uint16', 'ieee-be'); + fseek(in, l-2, 'cof'); + if debug, printf('SOF: %i\n', l); end + case JPEG.SOS % start of scan + l = fread(in, 1, 'uint16', 'ieee-be'); + fseek(in, l-2, 'cof'); + if debug, printf('SOS: %i\n', l); end + + % JPEG compressed data comes here ... + break; + + case JPEG.EOI % end of image + printf('EOI'); + otherwise % Skip unknown tags + l = fread(in, 1, 'uint16', 'ieee-be'); + if debug, printf('TAG %04X: %i\n', s, l); end + fseek(in, l-2, 'cof'); + end + end + + fclose(in); +end + +% +% Parse EXIF APP1 section +% +% This routine will parse the APP1 section of an jpeg image. +% If a filename "thumb" is given, the tumbnail image data +% will be exported to given file. +% +% exif = parseexif(data, thumb) +% +function exif = parseexif(data, thumb) + + id = char(data(1:6).'); + if strncmp(id, ['Exif' 0 0], 6) + + % TIFF header + + byteorder = char(data(7:8).'); + littleendian = strncmp(byteorder, 'II', 2); + bigendian = strncmp(byteorder, 'MM', 2); + + tag42 = intn(data(9:10), bigendian); + offset = intn(data(11:14), bigendian); + + if (~littleendian && ~bigendian) || tag42~=42 + error('invalid TIFF header'); + end + + % IFD fields + + exif = ifdparse(tifftags(), data, offset, bigendian); + else + exif = []; + end + + % export thumbnail image + + if nargin==2 && isfield(exif, 'JPEGInterchangeFormat') + i = exif.JPEGInterchangeFormat; + n = exif.JPEGInterchangeFormatLength; + + jpg = data(7+i:7+i+n-1); + out = fopen(thumb, 'w'); + if (out<0), + error('Cannot open file "%s" for writing thumbnail image.', thumb); + end + fwrite(out, jpg, 'uint8'); + fclose(out); + end +end + +function ifd = ifdparse(dict, data, offset, endian) + + debug = false; + + ifd = []; + + while offset + ifd_fields = intn(data(7+offset+(0:1)), endian); + + if debug, printf('Tag Type Count Offset\n'); end + for i=1:ifd_fields + j = 9+offset+(i-1)*12; + ifd_tag = intn(data( j:j+1), endian); + ifd_type = intn(data(j+2:j+3), endian); + ifd_count = intn(data(j+4:j+7), endian); + ifd_offset = intn(data(j+8:j+11), endian); + + name = ifdtagname(dict, ifd_tag); + + if debug, + printf('%04x %04x %08x %08x %s : ', ifd_tag, ifd_type, ... + ifd_count, ifd_offset, name); + end + if ifd_type>0 + n = ifdsize(ifd_type); + + if n*ifd_count<=4 + value = data(j+8:j+8+n*ifd_count-1); + value = reshape(value, n, ifd_count); + else + a = 7+ifd_offset; + b = 7+ifd_offset+n*ifd_count-1; + if (a>0 && b>0 && a<=length(data) && b<=length(data)) + value = data(7+ifd_offset:7+ifd_offset+n*ifd_count-1); + value = reshape(value, n, ifd_count); + else + value = []; + end + end + end + + switch ifd_type + case 01 % unsigned char + ifd.(name) = uint8(value); + if debug, + printf('%02x ', uint8(value)); + printf('\n'); + end + case 02 % Ascii + ifd.(name) = char(value); + if debug, printf('%s\n', char(value)); end + case 03 % 16 bit unsigned int + ifd.(name) = uintn(value, endian); + if debug + printf('%i ', intn(value), endian); + printf('\n'); + end + case 04 % 32 bit unsigned int + ifd.(name) = uintn(value, endian); + if debug, printf('%i\n', uintn(value, endian)); end + case 05 % 32 bit unsigned rational + ifd.(name) = [uintn(value(1:4,:), endian); uintn(value(5:8,:), endian)]; + if debug, printf('%i/%i\n',uintn(value(1:4), endian),uintn(value(5:8)), endian); end + case 07 % unknown + ifd.(name) = uint8(value); + if debug + printf('%02x ', value); + printf('\n'); + end + case 09 % 32 bit signed int + ifd.(name) = intn(value, endian); + if debug, printf('%i\n', intn(value, endian)); end + case 10 % 32 bit signed rational + ifd.(name) = [intn(value(1:4,:), endian); intn(value(5:8,:), endian)]; + if debug, printf('%i/%i\n',intn(value(1:4), endian),intn(value(5:8)), endian); end + otherwise + printf('%02x ', value); + printf('\n'); + end + + switch ifd_tag + case 0x8769, % Exif Pointer + ifd.(name) = ifdparse(exiftags(), data, ifd_offset, endian); + case 0x8825, % GPS Pointer + ifd.(name) = ifdparse(gpstags(), data, ifd_offset, endian); + case 0xa005 % Interoperatibility Pointer + ifd.(name) = ifdparse(dict, data, ifd_offset, endian); +% case 0x927c % Makernotes +% ifd.(name) = ifdparse([], data, ifd_offset, endian); + otherwise + end + end + j = 9+offset+ifd_fields*12; + ifd_next = intn(data(j:j+3), endian); + + offset = ifd_next; + end +end + +% +% Return bytelength for respective IFD type +% +function n = ifdsize(ifd_type) + switch ifd_type + case {1, 2, 7}, n = 1; + case 03 , n = 2; + case {4, 9} , n = 4; + case {5, 10} , n = 8; + otherwise , n = 1; + end +end + + +% +% Convert little endian character vector to integer +% +function y = intn(x, bigendian) + if bigendian + y = polycol(x, int32(256)); + else + y = polycol(flipud(x), int32(256)); + end +end + +function y = uintn(x, bigendian) + if bigendian + y = polycol(x, uint32(256)); + else + y = polycol(flipud(x), uint32(256)); + end +end + +% +% Use own polyval that works with integers, +% it evaluates the number polygon columnwise. +% +% number = polycol(digits, base) +% +function y = polycol(c, x) + y = c(1,:); + for i=2:size(c, 1) + y = y.*x+c(i,:); + end +end + +% +% Query EXIF IFD tagname +% +% Unfortunately, neither MATLAB nor Octave provide a hash functionality, +% so use structures as hash. +% +function name = ifdtagname(dict, key) + k = sprintf('K%04X', key); + if isfield(dict, k) + name = dict.(k); + else + name = sprintf('tag%04X', key); + end +end + +% +% Primary image IFD tags according to Exif 2.2 +% +function dict = tifftags() + t = { + + % TIFF Tags according to EXIF2.2, additional baseline TIFF tags are marked by a '%' + + '0FE' 'NewSubfileType' % + '0FF' 'SubfileType' % + '100' 'ImageWidth' + '101' 'ImageLength' + '102' 'BitsPerSample' + '103' 'Compression' + '106' 'PhotometricInterpretation' + '108' 'CellWidth' % + '109' 'CellLength' % + '10A' 'FillOrder' % + '10E' 'ImageDescription' + '10F' 'Make' + '110' 'Model' + '111' 'StripOffsets' + '112' 'Orientation' + '115' 'SamplesPerPixel' + '116' 'RowsPerStrip' + '117' 'StripByteCounts' + '118' 'MinSampleValue' % + '119' 'MaxSampleValue' % + '11A' 'XResolution' + '11B' 'YResolution' + '11C' 'PlanarConfiguration' + '120' 'FreeOffsets' % + '121' 'FreeByteCounts' % + '122' 'GrayResponseUnit' % + '123' 'GrayResponseCurve' % + '128' 'ResolutionUnit' + '12D' 'TransferFunction' + '131' 'Software' + '132' 'DateTime' + '13B' 'Artist' + '13C' 'HostComputer' % + '13E' 'WhitePoint' + '13F' 'PrimaryChromaticities' + '140' 'ColorMap' % + '152' 'ExtraSamples' % + '201' 'JPEGInterchangeFormat' + '202' 'JPEGInterchangeFormatLength' + '211' 'YCbCrCoefficients' + '212' 'YCbCrSubSampling' + '213' 'YCbCrPositioning' + '214' 'ReferenceBlackWhite' + '8298' 'Copyright' + '8769' 'Exif IFD Pointer' + '8825' 'GPS Info IFD Pointer' + }; + + dict = []; + for i=1:size(t,1) + key = sprintf('K%04X', hex2dec(t{i,1})); + value = t{i,2}; + dict.(key) = strrep(value, ' ', '_'); + end +end + +% +% EXIF private tags +% +function dict = exiftags() + t = { + + % EXIF Tags + + '829A' 'ExposureTime' + '829D' 'FNumber' + '8822' 'ExposureProgram' + '8824' 'SpectralSensitivity' + '8827' 'ISOSpeedRatings' + '8828' 'OECF' + '9000' 'ExifVersion' + '9003' 'DateTimeOriginal' + '9004' 'DateTimeDigitized' + '9101' 'ComponentsConfiguration' + '9102' 'CompressedBitsPerPixel' + '9201' 'ShutterSpeedValue' + '9202' 'ApertureValue' + '9203' 'BrightnessValue' + '9204' 'ExposureBiasValue' + '9205' 'MaxApertureValue' + '9206' 'SubjectDistance' + '9207' 'MeteringMode' + '9208' 'LightSource' + '9209' 'Flash' + '920A' 'FocalLength' + '9214' 'SubjectArea' + '927C' 'MakerNote' + '9286' 'UserComment' + '9290' 'SubsecTime' + '9291' 'SubsecTimeOriginal' + '9292' 'SubsecTimeDigitized' + 'A000' 'FlashpixVersion' + 'A001' 'ColorSpace' + 'A002' 'PixelXDimension' + 'A003' 'PixelYDimension' + 'A004' 'RelatedSoundFile' + 'A005' 'Interoperatibility IFD Pointer' + 'A20B' 'FlashEnergy' + 'A20C' 'SpatialFrequencyResponse' + 'A20E' 'FocalPlaneXResolution' + 'A20F' 'FocalPlaneYResolution' + 'A210' 'FocalPlaneResolutionUnit' + 'A214' 'SubjectLocation' + 'A215' 'ExposureIndex' + 'A217' 'SensingMethod' + 'A300' 'FileSource' + 'A301' 'SceneType' + 'A302' 'CFAPattern' + 'A401' 'CustomRendered' + 'A402' 'ExposureMode' + 'A403' 'WhiteBalance' + 'A404' 'DigitalZoomRatio' + 'A405' 'FocalLengthIn35mmFilm' + 'A406' 'SceneCaptureType' + 'A407' 'GainControl' + 'A408' 'Contrast' + 'A409' 'Saturation' + 'A40A' 'Sharpness' + 'A40B' 'DeviceSettingDescription' + 'A40C' 'SubjectDistanceRange' + 'A420' 'ImageUniqueID' + + % Interoperatibility tags + + '001' 'InteroperatibilityIndex' + '002' 'InteroperatibilityVersion' + '1000' 'RelatedImageFileFormat' + '1001' 'RelatedImageWidth' + '1002' 'RelatedImageLength' + }; + + dict = []; + for i=1:size(t,1) + key = sprintf('K%04X', hex2dec(t{i,1})); + value = t{i,2}; + dict.(key) = strrep(value, ' ', '_'); + end +end + +% +% EXIF GPS tags +% +function dict = gpstags() + t = { + 0 'GPSVersionID' + 1 'GPSLatitudeRef' + 2 'GPSLatitude' + 3 'GPSLongitudeRef' + 4 'GPSLongitude' + 5 'GPSAltitudeRef' + 6 'GPSAltitude' + 7 'GPSTimeStamp' + 8 'GPSSatellites' + 9 'GPSStatus' + 10 'GPSMeasureMode' + 11 'GPSDOP' + 12 'GPSSpeedRef' + 13 'GPSSpeed' + 14 'GPSTrackRef' + 15 'GPSTrack' + 16 'GPSImgDirectionRef' + 17 'GPSImgDirection' + 18 'GPSMapDatum' + 19 'GPSDestLatitudeRef' + 20 'GPSDestLatitude' + 21 'GPSDestLongitudeRef' + 22 'GPSDestLongitude' + 23 'GPSDestBearingRef' + 24 'GPSDestBearing' + 25 'GPSDestDistanceRef' + 26 'GPSDestDistance' + }; + + dict = []; + for i=1:size(t,1) + key = sprintf('K%04X', t{i,1}); + value = t{i,2}; + dict.(key) = strrep(value, ' ', '_'); + end +end + diff --git a/octave_packages/image-1.0.15/regionprops.m b/octave_packages/image-1.0.15/regionprops.m new file mode 100644 index 0000000..9a7b724 --- /dev/null +++ b/octave_packages/image-1.0.15/regionprops.m @@ -0,0 +1,289 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{props} = } regionprops (@var{BW}) +## @deftypefnx {Function File} {@var{props} = } regionprops (@var{BW}, @var{properties}, @dots{}) +## Compute object properties in a binary image. +## +## @code{regionprops} computes various properties of the individual objects (as +## identified by @code{bwlabel}) in the binary image @var{BW}. The result is a +## structure array containing an entry per property per object. +## +## The following properties can be computed. +## +## @table @t +## @item "Area" +## The number of pixels in the object. +## @item "EulerNumber" +## @itemx "euler_number" +## The Euler number of the object (see @code{bweuler} for details). +## @item "BoundingBox" +## @itemx "bounding_box" +## The bounding box of the object. This is represented as a 4-vector where the +## first two entries are the @math{x} and @math{y} coordinates of the upper left +## corner of the bounding box, and the two last entries are the width and the +## height of the box. +## @item "Extent" +## The area of the object divided by the area of the bounding box. +## @item "Perimeter" +## The length of the boundary of the object. +## @item "Centroid" +## The center coordinate of the object. +## @item "PixelIdxList" +## @itemx "pixel_idx_list" +## The indices of the pixels in the object. +## @item "FilledArea" +## @itemx "filled_area" +## The area of the object including possible holes. +## @item "PixelList" +## @itemx "pixel_list" +## The actual pixel values inside the object. This is only useful for grey scale +## images. +## @item "FilledImage" +## @itemx "filled_image" +## A binary image with the same size as the object's bounding box that contains +## the object with all holes removed. +## @item "Image" +## An image with the same size as the bounding box that contains the original pixels. +## @item "MaxIntensity" +## @itemx "max_intensity" +## The maximum intensity inside the object. +## @item "MinIntensity" +## @itemx "min_intensity" +## The minimum intensity inside the object. +## @item "WeightedCentroid" +## @itemx "weighted_centroid" +## The centroid of the object where pixel values are used as weights. +## @item "MeanIntensity" +## @itemx "mean_intensity" +## The mean intensity inside the object. +## @item "PixelValues" +## @itemx "pixel_values" +## The pixel values inside the object represented as a vector. +## @end table +## +## The requested properties can either be specified as several input arguments +## or as a cell array of strings. As a short-hand it is also possible to give +## the following strings as arguments. +## +## @table @t +## @item "basic" +## The following properties are computed: @t{"Area"}, @t{"Centroid"} and @t{"BoundingBox"}. +## @item "all" +## All properties are computed. +## @end table +## +## If no properties are given, @t{basic} is assumed. +## @seealso{bwlabel, bwperim, bweuler} +## @end deftypefn + +function retval = regionprops (bw, varargin) + ## Check input + if (nargin < 1) + error ("regionprops: not enough input arguments"); + endif + + if (!ismatrix (bw) || ndims (bw) != 2) + error ("regionprops: first input argument must be a NxM matrix"); + endif + + if (numel (varargin) == 0) + properties = "basic"; + elseif (numel (varargin) == 1 && iscellstr (varargin {1})) + properties = varargin {1}; + elseif (iscellstr (varargin)) + properties = varargin; + else + error ("regionprops: properties must be a cell array of strings"); + endif + + if (ischar (properties) && strcmpi (properties, "basic")) + properties = {"Area", "Centroid", "BoundingBox"}; + elseif (ischar (properties) && strcmpi (properties, "all")) + properties = {"area", "eulernumber", "boundingbox", "extent", "perimeter", ... + "centroid", "pixelidxlist", "filledarea", "pixellist", ... + "filledimage", "image", "maxintensity", "minintensity", ... + "weightedcentroid", "meanintensity", "pixelvalues"}; + elseif (!iscellstr (properties)) + error ("%s %s", "regionprops: properties must be specified as a list of", + "strings or a cell array of strings"); + endif + + ## Get a labelled image + if (!islogical (bw) && all (bw >= 0) && all (bw == round (bw))) + L = bw; # the image was already labelled + num_labels = max (L (:)); + else + [L, num_labels] = bwlabel (bw); + endif + + ## Compute the properties + retval = struct (); + for k = 1:numel (properties) + switch (lower (properties {k})) + case "area" + for k = 1:num_labels + retval (k).Area = local_area (L == k); + endfor + + case {"eulernumber", "euler_number"} + for k = 1:num_labels + retval (k).EulerNumber = bweuler (L == k); + endfor + + case {"boundingbox", "bounding_box"} + for k = 1:num_labels + retval (k).BoundingBox = local_boundingbox (L == k); + endfor + + case "extent" + for k = 1:num_labels + bb = local_boundingbox (L == k); + area = local_area (L == k); + retval (k).Extent = area / (bb (3) * bb (4)); + endfor + + case "perimeter" + for k = 1:num_labels + retval (k).Perimeter = sum (bwperim (L == k) (:)); + endfor + + case "centroid" + for k = 1:num_labels + [Y, X] = find (L == k); + retval (k).Centroid = [mean(X), mean(Y)]; + endfor + + case {"pixelidxlist", "pixel_idx_list"} + for k = 1:num_labels + retval (k).PixelIdxList = find (L == k); + endfor + + case {"filledarea", "filled_area"} + for k = 1:num_labels + retval (k).FilledArea = sum (bwfill (L == k, "holes") (:)); + endfor + + case {"pixellist", "pixel_list"} + for k = 1:num_labels + [Y, X] = find (L == k); + retval (k).PixelList = [X, Y]; + endfor + + case {"filledimage", "filled_image"} + for k = 1:num_labels + retval (k).FilledImage = bwfill (L == k, "holes"); + endfor + + case "image" + for k = 1:num_labels + tmp = (L == k); + [R, C] = find (tmp); + retval (k).Image = tmp (min (R):max (R), min (C):max (C)); + endfor + + case {"maxintensity", "max_intensity"} + for k = 1:num_labels + retval (k).MaxIntensity = max (bw (L == k) (:)); + endfor + + case {"minintensity", "min_intensity"} + for k = 1:num_labels + retval (k).MaxIntensity = min (bw (L == k) (:)); + endfor + + case {"weightedcentroid", "weighted_centroid"} + for k = 1:num_labels + [Y, X] = find (L == k); + vals = bw (L == k) (:); + vals /= sum (vals); + retval (k).WeightedCentroid = [dot(X, vals), dot(Y, vals)]; + endfor + + case {"meanintensity", "mean_intensity"} + for k = 1:num_labels + retval (k).MaxIntensity = mean (bw (L == k) (:)); + endfor + + case {"pixelvalues", "pixel_values"} + for k = 1:num_labels + retval (k).PixelValues = bw (L == k)(:); + endfor + + case "orientation" + for k = 1:num_labels + [Y, X] = find (L == k); + if (numel (Y) > 1) + C = cov ([X(:), Y(:)]); + [V, lambda] = eig (C); + [max_val, max_idx] = max (diag (lambda)); + v = V (:, max_idx); + retval (k).Orientation = 180 - 180 * atan2 (v (2), v (1)) / pi; + else + retval (k).Orientation = 0; # XXX: What does the other brand do? + endif + endfor + + %{ + case "majoraxislength" + for k = 1:num_labels + [Y, X] = find (L == k); + if (numel (Y) > 1) + C = cov ([X(:), Y(:)]); + lambda = eig (C); + retval (k).MajorAxisLength = (max (lambda)); + else + retval (k).MajorAxisLength = 1; + endif + endfor + + case "minoraxislength" + for k = 1:num_labels + [Y, X] = find (L == k); + if (numel (Y) > 1) + C = cov ([X(:), Y(:)]); + lambda = eig (C); + retval (k).MinorAxisLength = (min (lambda)); + else + retval (k).MinorAxisLength = 1; + endif + endfor + %} + + #case "extrema" + #case "convexarea" + #case "convexhull" + #case "solidity" + #case "conveximage" + #case "subarrayidx" + #case "eccentricity" + #case "equivdiameter" + + otherwise + error ("regionprops: unsupported property '%s'", properties {k}); + endswitch + endfor +endfunction + +function retval = local_area (bw) + retval = sum (bw (:)); +endfunction + +function retval = local_boundingbox (bw) + [Y, X] = find (bw); + retval = [min(X)-0.5, min(Y)-0.5, max(X)-min(X)+1, max(Y)-min(Y)+1]; +endfunction + diff --git a/octave_packages/image-1.0.15/rgb2gray.m b/octave_packages/image-1.0.15/rgb2gray.m new file mode 100644 index 0000000..050009e --- /dev/null +++ b/octave_packages/image-1.0.15/rgb2gray.m @@ -0,0 +1,55 @@ +## Copyright (C) 2000, 2001 Kai Habel +## +## 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{gray}= rgb2gray (@var{rgb}) +## Converts an RGB image to a gray scale image, or a color map +## to a gray map. +## +## If the input is an RGB image, the conversion to a gray image +## is computed as the mean value of the color channels. +## +## If the input is a color map it is converted into the YIQ space +## of ntsc. The luminance value (Y) is taken to create a gray color map. +## R = G = B = Y +## @end deftypefn + +## Author: Kai Habel +## Date: 19. March 2000 + +function gray = rgb2gray (rgb) + + if (nargin != 1) + print_usage(); + endif + + if (ismatrix (rgb) && ndims(rgb) == 2 && columns(rgb) == 3) + ntscmap = rgb2ntsc (rgb); + gray = ntscmap (:, 1) * ones (1, 3); + elseif (ismatrix(rgb) && ndims(rgb) == 3) + switch(class(rgb)) + case "double" + gray = mean(rgb,3); + case "uint8" + gray = uint8(mean(rgb,3)); + case "uint16" + gray = uint16(mean(rgb,3)); + otherwise + error("rgb2gray: unsupported class %s", class(rgb)); + endswitch + else + error("rgb2gray: the input must either be an RGB image or a color map"); + endif +endfunction diff --git a/octave_packages/image-1.0.15/rgb2ycbcr.m b/octave_packages/image-1.0.15/rgb2ycbcr.m new file mode 100644 index 0000000..f637ada --- /dev/null +++ b/octave_packages/image-1.0.15/rgb2ycbcr.m @@ -0,0 +1,39 @@ +## Copyright (C) 2011 Santiago Reyes González +## +## This program is free software; you can redistribute it and/or +## modify it under the terms of the GNU General Public License +## as published by the Free Software Foundation; either version 3 +## of the License, or (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. + +## -*- texinfo -*- +## @deftypefn {Function File} @var{B} = rgb2ycbcr(@var{A}) +## Perform colour convertion from RGB to YCbCr on a given image. +## +## The image @var{A} must be a NxMx3 image. The conversion +## The convertion changes the image from the RGB color model to YCbCr e.g. +## @example +## imOut = rgb2ycbcr(imIn); +## @end example +## Currently this function only works with @samp{uint8} and will always return +## an @samp{uint8} matrix. +## @seealso{cmunique} +## @end deftypefn + +function im_out = rgb2ycbcr(im) + if (nargin != 1) + print_usage; + elseif (length(size(im)) != 3 || size(im,3) != 3) + error("image must be NxMx3"); + endif + + im = im2double(im); + im_out(:,:,1) = uint8(floor(77*im(:,:,1) + 150*im(:,:,2) + 29*im(:,:,3))); + im_out(:,:,2) = uint8(floor(((-44*im(:,:,1) - 87*im(:,:,2) + 131*im(:,:,3))/256 + 0.5)*256)); + im_out(:,:,3) = uint8(floor(((131*im(:,:,1) - 110*im(:,:,2) - 21*im(:,:,3))/256 + 0.5)*256)); + +endfunction diff --git a/octave_packages/image-1.0.15/rgbplot.m b/octave_packages/image-1.0.15/rgbplot.m new file mode 100644 index 0000000..c0b277a --- /dev/null +++ b/octave_packages/image-1.0.15/rgbplot.m @@ -0,0 +1,34 @@ +## Copyright (C) 2005 Berge-Gladel +## +## 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. + +## -*- texinfo -*- +## @deftypefn {Function File} rgbplot (@var{map}) +## @deftypefnx{Function File} @var{h} = rgbplot (@var{map}) +## Plot a given color map. +## The matrix @var{map} must be a @math{M} by 3 matrix. The three columns of the +## colormap matrix are plotted in red, green, and blue lines. +## +## If an output is requested, a graphics handle to the plot is returned. +## @end deftypefn + +function h_out = rgbplot(map) + ## Check input + if (!ismatrix(map) || ndims(map) != 2 || columns(map) != 3) + error("rgbplot: input must be a M by 3 matrix"); + endif + + ## Plot + h = plot(map(:,1), "-r", map(:,2), "g-", map(:,3), "b-"); + if (nargout > 0) + h_out = h; + endif +endfunction diff --git a/octave_packages/image-1.0.15/rho_filter.m b/octave_packages/image-1.0.15/rho_filter.m new file mode 100644 index 0000000..0e10bed --- /dev/null +++ b/octave_packages/image-1.0.15/rho_filter.m @@ -0,0 +1,183 @@ +## Copyright (C) 2010 Alex Opie +## +## +## This program is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @defun {@var{filtered} =} rho_filter (@var{proj}, @var{type}, @var{scaling}) +## +## Filters the parallel ray projections in the columns of @var{proj}, +## according to the filter type chosen by @var{type}. @var{type} +## can be chosen from +## @itemize +## @item 'none' +## @item 'Ram-Lak' (default) +## @item 'Shepp-Logan' +## @item 'Cosine' +## @item 'Hann' +## @item 'Hamming' +## @end itemize +## +## If given, @var{scaling} determines the proportion of frequencies +## below the nyquist frequency that should be passed by the filter. +## The window function is compressed accordingly, to avoid an abrupt +## truncation of the frequency response. +## +## @defunx {[@var{filtered}, @var{filter}] =} rho_filter (...) +## +## This form also returns the frequency response of the filter in +## the vector @var{filter}. +## +## @end defun +## +## Performs rho filtering on the parallel ray projections provided. +## +## Rho filtering is performed as part of the filtered back-projection +## method of CT image reconstruction. It is the filtered part of +## the name. +## The simplest rho filter is the Ramachadran-Lakshminarayanan (Ram-Lak), +## which is simply |rho|, where rho is the radial component of spatial +## frequency. However, this can cause unwanted amplification of noise, +## which is what the other types attempt to minimise, by introducing +## roll-off into the response. The Hann and Hamming filters multiply +## the standard response by a Hann or Hamming window, respectively. +## The cosine filter is the standard response multiplied by a cosine +## shape, and the Shepp-Logan filter multiplies the response with +## a sinc shape. The 'none' filter performs no filtering, and is +## included for completeness and to enable incorporating this function +## easily into scripts or functions that may offer the ability to choose +## to apply no filtering. +## +## This function is designed to be used by the function @command{iradon}, +## but has been exposed to facilitate custom inverse radon transforms +## and to more clearly break down the process for educational purposes. +## The operations +## @example +## filtered = rho_filter (proj); +## reconstruction = iradon (filtered, 1, 'linear', 'none'); +## @end example +## are exactly equivalent to +## @example +## reconstruction = iradon (proj, 1, 'linear', 'Ram-Lak'); +## @end example +## +## Usage example: +## @example +## P = phantom (); +## projections = radon (P); +## filtered_projections = rho_filter (projections, 'Hamming'); +## reconstruction = iradon (filtered_projections, 1, 'linear', 'none'); +## figure, imshow (reconstruction, []) +## @end example + +function [filtered_proj, filt] = rho_filter (proj, type, scaling) + + filtered_proj = proj; + + if (nargin < 3) + scaling = 1; + endif + if (nargin < 2) || (size (type) == 0) + type = 'ram-lak'; + endif + + if (strcmpi (type, 'none')) + filt = 1; + return; + endif + + if (scaling > 1) || (scaling < 0) + error ('Scaling factor must be in [0,1]'); + endif + + ## Extend the projections to a power of 2 + new_len = 2 * 2^nextpow2 (size (filtered_proj, 1)); + filtered_proj (new_len, 1) = 0; + + ## Scale the frequency response + int_len = (new_len * scaling); + if (mod (floor (int_len), 2)) + int_len = ceil (int_len); + else + int_len = floor (int_len); + endif + + ## Create the basic filter response + rho = scaling * (0:1 / (int_len / 2):1); + rho = [rho'; rho(end - 1:-1:2)']; + + ## Create the window to apply to the filter response + if (strcmpi (type, 'ram-lak')) + filt = 1; + elseif (strcmpi (type, 'hamming')) + filt = fftshift (hamming (length (rho))); + elseif (strcmpi (type, 'hann')) + filt = fftshift (hann (length (rho))); + elseif (strcmpi (type, 'cosine')) + f = 0.5 * (0:length (rho) - 1)' / length (rho); + filt = fftshift (sin (2 * pi * f)); + elseif (strcmpi (type, 'shepp-logan')) + f = (0:length (rho) / 2)' / length (rho); + filt = sin (pi * f) ./ (pi * f); + filt (1) = 1; + filt = [filt; filt(end - 1:-1:2)]; + else + error ('rho_filter: Unknown window type'); + endif + + ## Apply the window + filt = filt .* rho; + + ## Pad the response to the correct length + len_diff = new_len - int_len; + if (len_diff != 0) + pad = len_diff / 2; + filt = padarray (fftshift (filt), pad); + filt = fftshift (filt); + endif + + filtered_proj = fft (filtered_proj); + + ## Perform the filtering + for i = 1:size (filtered_proj, 2) + filtered_proj (:, i) = filtered_proj (:, i) .* filt; + endfor + + ## Finally bring the projections back to the spatial domain + filtered_proj = real (ifft (filtered_proj)); + + ## Chop the projections back to their original size + filtered_proj (size (proj, 1) + 1:end, :) = []; + +endfunction + +%!demo +%! P = phantom (); +%! projections = radon (P); +%! filtered_projections = rho_filter (projections, 'Hamming'); +%! reconstruction = iradon (filtered_projections, 1, 'linear', 'none'); +%! figure, imshow (reconstruction, []) + +% $Log$ +% 2010-05-27 lxop +% Function now returns a value in `filt' when `none' is specified +% as the filter type. Fixes the warning that was occuring with +% the demo. +% +% 2010-04-08 lxop +% Fixed default argument settings and checking. +% +% 2010-03-19 lxop +% Function completed to Matlab compatible level. diff --git a/octave_packages/image-1.0.15/roicolor.m b/octave_packages/image-1.0.15/roicolor.m new file mode 100644 index 0000000..0b9c86d --- /dev/null +++ b/octave_packages/image-1.0.15/roicolor.m @@ -0,0 +1,79 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{BW} = } roicolor (@var{A},@var{low},@var{high}) +## @deftypefnx {Function File} {@var{BW} = } roicolor (@var{A},@var{v}) +## Select a Region Of Interest of an image based on color. +## +## BW = roicolor(A,low,high) selects a region of interest (ROI) of an +## image @var{A} returning a black and white image in a logical array (1 for +## pixels inside ROI and 0 outside ROI), which is formed by all pixels +## whose values lie within the colormap range specified by [@var{low} +## @var{high}]. +## +## BW = roicolor(A,v) selects a region of interest (ROI) formed by all +## pixels that match values in @var{v}. +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function BW = roicolor(A, p1, p2) + if (nargin < 2 || nargin > 3) + usage("BW = roicolor(A, low, high), BW = roicolor(A, v)"); + endif + + if (nargin == 2) + if (!isvector(p1)) + error("BW = roicolor(A, v): v should be a vector."); + endif + BW=logical(zeros(size(A))); + for c=p1 + BW|=(A==c); + endfor + elseif (nargin==3) + if (!isscalar(p1) || !isscalar(p2)) + error("BW = roicolor(A, low, high): low and high must be scalars."); + endif + BW=logical((A>=p1)&(A<=p2)); + endif +endfunction + +%!demo +%! roicolor([1:10],2,4); +%! % Returns '1' where input values are between 2 and 4 (both included). + +%!assert(roicolor([1:10],2,4),logical([0,1,1,1,zeros(1,6)])); +%!assert(roicolor([1,2;3,4],3,3),logical([0,0;1,0])); +%!assert(roicolor([1,2;3,4],[1,4]),logical([1,0;0,1])); + +% +% $Log$ +% Revision 1.2 2007/03/23 16:14:37 adb014 +% Update the FSF address +% +% Revision 1.1 2006/08/20 12:59:35 hauberg +% Changed the structure to match the package system +% +% Revision 1.3 2004/09/15 17:54:59 pkienzle +% test that data type matches during assert +% +% Revision 1.2 2004/08/11 15:04:59 pkienzle +% Convert dos line endings to unix line endings +% +% Revision 1.1 2004/08/08 21:02:44 jmones +% Add roicolor function (selects ROI based on color) +% +% diff --git a/octave_packages/image-1.0.15/std2.m b/octave_packages/image-1.0.15/std2.m new file mode 100644 index 0000000..4022bf0 --- /dev/null +++ b/octave_packages/image-1.0.15/std2.m @@ -0,0 +1,37 @@ +## Copyright (C) 2000 Kai Habel +## +## 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{s}= std2 (@var{I}) +## Returns the standard deviation for a 2d real type matrix. +## Uses @code{std (I(:))} +## @seealso{mean2,std} +## @end deftypefn + +## Author: Kai Habel +## Date: 01/08/2000 + +function s = std2 (I) + + if !(nargin == 1) + print_usage (); + endif + + if !(ismatrix(I) && isreal(I)) + error("std2: argument must be a real type matrix"); + endif + + s = std (I(:)); +endfunction diff --git a/octave_packages/image-1.0.15/stdfilt.m b/octave_packages/image-1.0.15/stdfilt.m new file mode 100644 index 0000000..dda10ca --- /dev/null +++ b/octave_packages/image-1.0.15/stdfilt.m @@ -0,0 +1,74 @@ +## Copyright (C) 2008 Søren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{S} =} stdfilt (@var{im}) +## @deftypefnx{Function File} {@var{S} =} stdfilt (@var{im}, @var{domain}) +## @deftypefnx{Function File} {@var{S} =} stdfilt (@var{im}, @var{domain}, @var{padding}, ...) +## Computes the local standard deviation in a neighbourhood around each pixel in +## an image. +## +## The standard deviation of the pixels of a neighbourhood is computed as +## +## @example +## @var{S} = sqrt ((sum (@var{x} - @var{mu}).^2)/(@var{N}-1)) +## @end example +## +## where @var{mu} is the mean value of the pixels in the neighbourhood, +## @var{N} is the number of pixels in the neighbourhood. So, an unbiased estimator +## is used. +## +## The neighbourhood is defined by the @var{domain} binary mask. Elements of the +## mask with a non-zero value are considered part of the neighbourhood. By default +## a 3 by 3 matrix containing only non-zero values is used. +## +## At the border of the image, extrapolation is used. By default symmetric +## extrapolation is used, but any method supported by the @code{padarray} function +## can be used. Since extrapolation is used, one can expect a lower deviation near +## the image border. +## +## @seealso{std2, paddarray, entropyfilt} +## @end deftypefn + +function retval = stdfilt (I, domain = true (3), padding = "symmetric", varargin) + ## Check input + if (nargin == 0) + error ("stdfilt: not enough input arguments"); + endif + + if (!ismatrix (I)) + error ("stdfilt: first input must be a matrix"); + endif + + if (!ismatrix (domain)) + error ("stdfilt: second input argument must be a logical matrix"); + endif + domain = (domain > 0); + + ## Pad image + pad = floor (size (domain)/2); + I = padarray (I, pad, padding, varargin {:}); + even = (round (size (domain)/2) == size (domain)/2); + idx = cell (1, ndims (I)); + for k = 1:ndims (I) + idx {k} = (even (k)+1):size (I, k); + endfor + I = I (idx {:}); + + ## Perform filtering + retval = __spatial_filtering__ (I, domain, "std", I, 0); + +endfunction diff --git a/octave_packages/image-1.0.15/stretchlim.m b/octave_packages/image-1.0.15/stretchlim.m new file mode 100644 index 0000000..1cc37c3 --- /dev/null +++ b/octave_packages/image-1.0.15/stretchlim.m @@ -0,0 +1,208 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{LOW_HIGH} = } stretchlim (@var{I},@var{TOL}) +## @deftypefnx {Function File} {@var{LOW_HIGH} = } stretchlim (@var{I}) +## @deftypefnx {Function File} {@var{LOW_HIGH} = } stretchlim (@var{RGB},@var{TOL}) +## @deftypefnx {Function File} {@var{LOW_HIGH} = } stretchlim (@var{RGB}) +## Finds limits to contrast stretch an image +## +## @code{LOW_HIGH=stretchlim(I,TOL)} returns a vector @var{LOW_HIGH} +## which contains a pair of intensities which can be used in +## @code{imadjust} to stretch the contrast of an image, first of them +## will be lower value (@code{imadjust} would assign 0 to it) and second +## is the upper bound. @var{TOL} specifies the fraction of the image to +## saturate at lower and upper limits. It can be a vector of length 2: +## @code{[LOW_FRACT, HIGH_FRACT]}, or it can be a scalar, in that case +## @code{[LOW_FRACT, HIGH_FRACT]=[TOL, 1-TOL]}. +## +## @var{TOL} can't be larger than 0.50 and for TOL=0 then +## @code{LOW_HIGH=[min(I(:)), max(I(:))]}. +## +## @code{LOW_HIGH=stretchlim(I)} behaves as described but defaults +## @var{TOL} to @code{[0.01, 0.99]}. +## +## @code{LOW_HIGH=stretchlim(RGB,TOL)} returns a 2-by-3 matrix in +## @var{LOW_HIGH} of lower and upper values to saturate for each plane +## of the RGB image in M-by-N-by-3 array @var{RGB}. @var{TOL} is a +## vector or a scalar, as described above, and the same fractions are +## applied for each plane. +## +## @code{LOW_HIGH=stretchlim(RGB)} uses @code{[0.01, 0.99]} as default +## value for @var{TOL}. +## +## @strong{Notes:} +## +## Values in @var{LOW_HIGH} are of type double and comprised between 0 +## and 1 regardless class of input image. +## +## @strong{Compatibility notes:} +## +## @itemize @bullet +## @item +## int* and uint* types are still not implemented (waiting for support +## in Octave 2.1.58). +## @item +## This function tries to find limits that are nearer to saturate +## requested interval. So, for instance, if you requested a 5% and it +## has to choose between discarding a 1% and a 7%, it will choose the +## later despite being more than requested. This should be test against +## MATLAB behaviour. +## @end itemize +## +## @seealso{imadjust} +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function LOW_HIGH = stretchlim(image, TOL) + if (nargin<1 || nargin>2) + usage("LOW_HIGH=stretchlim(I [, TOL]), LOW_HIGH=stretchlim(RGB [, TOL])"); + endif + + if(!ismatrix(image) || ischar(image)) + error("stretchlim: image should be a matrix"); + endif + + ## Prepare limits + if(nargin==1) + low_count=0.01; + high_count=0.01; ## we use this definition in __stretchlim_plane__ + else + if(isscalar(TOL)) + if(TOL<0 || TOL>=0.5) + error("stretchlim: TOL out of bounds. Expected: 0<=TOL<0.5"); + endif + low_count=TOL; + high_count=TOL; ## as before... + elseif(isvector(TOL)) + if(length(TOL)!=2) + error("stretchlim: TOL length must be 2."); + endif + low_count=TOL(1); + high_count=1-TOL(2); ## as before... + else + error("stretchlim: TOL contains an invalid value."); + endif + endif + + ## well use size of image several times... + simage=size(image); + + ## Convert fractions to pixels + psimage=prod(simage(1:2)); + low_count*=psimage; + high_count*=psimage; + + if(length(simage)<=2) + ## intensity + LOW_HIGH=__stretchlim_plane__(image, low_count, high_count); + elseif(length(simage)==3 && simage(3)==3) + ## RGB + LOW_HIGH=zeros(2,3); + for i=1:3 + LOW_HIGH(:,i)=__stretchlim_plane__(image(:,:,i), low_count, \ + high_count); + endfor + else + error("stretchlim: invalid image."); + endif +endfunction + + +## Processes a plane +## high_count is defined so that high_count=elements is the same as +## low_count=elements (and not total_elements-elements) +function LOW_HIGH = __stretchlim_plane__(plane, low_count, high_count) + ## check exceptions + if(low_count==0 && high_count==0) + LOW_HIGH=[min(plane(:)); max(plane(:))]; + else + + ## we sort values + sorted=sort(plane(:)); + + low=sorted(round(low_count+1)); + pos=find(sorted>low); + if(length(pos)>0) + low2=sorted(pos(1)); + d1=low_count-sum(sorted0) + high2=sorted(pos(end)); + d1=high_count-sum(sorted>high); + d2=sum(sorted>high2)-high_count; + if(d2 1% lost + +%!# test RGB +%!test +%! RGB=zeros(100,1,3); +%! RGB(:,:,1)=[1:100]; +%! RGB(:,:,2)=[2:2:200]; +%! RGB(:,:,3)=[4:4:400]; +%! assert(stretchlim(RGB),[2,4,8;99,198,396]); + diff --git a/octave_packages/image-1.0.15/tiff_tag_read.m b/octave_packages/image-1.0.15/tiff_tag_read.m new file mode 100644 index 0000000..6a4eef3 --- /dev/null +++ b/octave_packages/image-1.0.15/tiff_tag_read.m @@ -0,0 +1,196 @@ +## Copyright (C) 2010 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . +## +## Based on the documentation at +## * http://en.wikipedia.org/wiki/Tagged_Image_File_Format +## * http://partners.adobe.com/public/developer/en/tiff/TIFF6.pdf +## * http://ibb.gsf.de/homepage/karsten.rodenacker/IDL/Lsmfile.doc +## * http://www.awaresystems.be/imaging/tiff/faq.html +## +## and the function tiff_read by F. Nedelec, EMBL (www.cytosim.org) +## * http://www.cytosim.org/misc/index.html + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{value}, @var{offset}] = tiff_tag_read (@var{file}, @var{tag}, @var{ifd}) +## Reads the values of TIFF file tags. +## +## @var{file} is a TIFF file and @var{tag} is the tag number to read. If +## @var{ifd} is given, only the tag value from that IFD (Image File Directory) +## will be read. By default, reads only the first IFD. +## +## @var{value} is the read value from @var{tag}. @var{offset} will be @code{1} +## if @var{value} is a file offset. +## +## @seealso{imread, imfinfo, readexif} +## @end deftypefn + +## * On the TIFF image file header: +## bytes 00-01 --> byte order used within the file: "II" for little endian +## and "MM" for big endian byte ordering. +## bytes 02-03 --> number 42 that identifies the file as TIFF +## bytes 04-07 --> file offset (in bytes) of the first IFD (Image File Directory) +## +## Note: offset is always from the start of the file ("bof" in fread) and first +## byte has an offset of zero. +## +## * On a TIFF's IFD structure: +## bytes 00-01 --> number of entries (or tags or fields or directories) +## bytes 02-13 --> the entry (the tag is repeated the number of times +## specified at the start of the IFD, but always takes +## 12 bytes of size) +## bytes XX-XX --> file offset for next IFD (last 4 bytes of the IFD) +## +## Note: there must be always one IFD and each IFD must have at least one entry +## +## * On an IFD entry (or TIFF's field) structure: +## bytes 00-01 --> tag that identifies the entry +## bytes 02-03 --> entry type +## 1 --> BYTE (uint8) +## 2 --> ASCII +## 3 --> SHORT (uint16) +## 4 --> LONG (uint32) +## 5 --> RATIONAL (two LONGS) +## 6 --> SBYTE (int8) +## 7 --> UNDEFINED (8 bit) +## 8 --> SSHORT (int16) +## 9 --> SLONG (int32) +## 10 --> FLOAT (single IEEE precision) +## 11 --> DOUBLE (double IEEE precision) +## bytes 04-07 --> number of values (count) +## bytes 08-11 --> file offset to the value or value (only if it fits in 4 bytes) +## +## Note: file offset of the value may point anywhere in the file, even after the image. + +function [value, offset] = tiff_tag_read (file, tag, ifd) + + [FID, msg] = fopen (file, "r", "native"); + if (msg != 0) + error ("Unable to fopen '%s': %s.", file, msg); + endif + + # Read byte order + byte_order = fread(FID, 2, "char=>char"); + if ( strcmp(byte_order', "II") ) + arch = "ieee-le"; # IEEE little endian format + elseif ( strcmp(byte_order',"MM") ) + arch = "ieee-be"; # IEEE big endian format + else + error("First 2 bytes of header returned '%s'. TIFF file expects either 'II' or 'MM'.", byte_order'); + endif + + # Read number 42 + nTIFF = fread(FID, 1, "uint16", arch); + if (nTIFF != 42) + error("This is not a TIFF file (missing 42 on header at offset 2. Instead got '%g').", tiff_id); + endif + + # Read offset and move for the first IFD + offset_IFD = fread(FID, 1, "uint32", arch); + status = fseek(FID, offset_IFD, "bof"); + if (status != 0) + error("Error on fseek when moving to first IFD."); + endif + + # Read number of entries (nTag) and look for the desired tag ID + nTag = fread(FID, 1, "uint16", arch); + iTag = 0; # Tag index + while (1) # Control is made inside the loop + iTag++; + cTag = fread(FID, 1, "uint16", arch); # Tag ID + if (cTag == tag) # Tag ID was found + value = read_value (FID, arch, tag); # Read tag value + break + elseif (iTag == nTag || cTag > tag) # All tags have been read (tags are in ascendent order) + error ("Unable to find tag %g.", tag) + endif + status = fseek(FID, 10, "cof"); # Move to the next tag + if (status != 0) + error("Error on fseek when moving to tag %g of %g. Last tag read had value of %g", rTag, nTag, tag); + endif + endwhile + + fclose (FID); + +endfunction + +##### +function [value, offset] = read_value (FID, arch, tag) + + tiff_type = fread(FID, 1, "uint16", arch); + count = fread(FID, 1, "uint32", arch); + + switch (tiff_type) + case 1 # BYTE = 8-bit unsigned integer + nBytes = 1; + precision = "uint8"; + case 2 # ASCII = 8-bit byte that contains a 7-bit ASCII code; the last byte must be NUL (binary zero) + nBytes = 1; + precision = "uchar"; + case 3 # SHORT = 16-bit (2-byte) unsigned integer + nBytes = 2; + precision = "uint16"; + case 4 # LONG = 32-bit (4-byte) unsigned integer + nBytes = 4; + precision = "uint32"; + case 5 # RATIONAL = Two LONGs: the first represents the numerator of a fraction; the second, the denominator + nBytes = 8; + precision = "uint32"; + case 6 # SBYTE = An 8-bit signed (twos-complement) integer + nBytes = 1; + precision = "int8"; + case 7 # UNDEFINED = An 8-bit byte that may contain anything, depending on the definition of the field + nBytes = 1; + precision = "uchar"; + case 8 # SSHORT = A 16-bit (2-byte) signed (twos-complement) integer + nBytes = 2; + precision = "int16"; + case 9 # SLONG = A 32-bit (4-byte) signed (twos-complement) integer + nBytes = 4; + precision = "int32"; + case 10 # SRATIONAL = Two SLONG’s: the first represents the numerator of a fraction, the second the denominator + nBytes = 8; + precision = "int32"; + case 11 # FLOAT = Single precision (4-byte) IEEE format + nBytes = 4; + precision = "float32"; + case 12 # DOUBLE = Double precision (8-byte) IEEE format + nBytes = 8; + precision = "float64"; + otherwise # Warning (from TIFF file specifications): It is possible that other TIFF field types will be added in the future + error("TIFF type %i not supported", tiff_type) + endswitch + + if ( (nBytes*count) > 4 ) # If it doesn't fit in 4 bytes, it's an offset + offset = 1; + value = fread(FID, 1, "uint32", arch); + ## The file offset must be an even number + if ( rem(value,2) != 0 ) + error("Couldn't find correct value offset for tag %g", tag); + endif + else + offset = 0; + ## read here + switch precision + case { 5, 10 } + value = fread(FID, 2*count, precision, arch); + otherwise + value = fread(FID, count, precision, arch); + endswitch + if (precision == 2) + value = char(value'); + endif + endif + +endfunction diff --git a/octave_packages/image-1.0.15/uintlut.m b/octave_packages/image-1.0.15/uintlut.m new file mode 100644 index 0000000..2caf6d7 --- /dev/null +++ b/octave_packages/image-1.0.15/uintlut.m @@ -0,0 +1,62 @@ +## Copyright (C) 2004 Josep Mones i Teixidor +## +## 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{B} = } uintlut (@var{A},@var{LUT}) +## Computes matrix B by using A as an index to lookup table LUT. +## +## B = uintlut(A, LUT) calculates a matrix B by using @var{LUT} as a +## lookup table indexed by values in @var{A}. +## +## B class is the same as @var{LUT}. +## @end deftypefn + +## Author: Josep Mones i Teixidor + +function B = uintlut(A, LUT) + if (nargin != 2) + usage("B = uintlut(A, LUT)"); + endif + + ## We convert indexing array A to double since even CVS version of + ## Octave is unable to use non-double arrays as indexing types. This + ## won't be needed in the future eventually. + B=LUT(double(A)); +endfunction + +%!demo +%! uintlut(uint8([1,2,3,4]),uint8([255:-1:0])); +%! % Returns a uint8 array [255,254,253,252] + +%!assert(uintlut(uint8([1,2,3,4]),uint8([255:-1:0])), uint8([255:-1:252])); +%!assert(uintlut(uint16([1,2,3,4]),uint16([255:-1:0])), uint16([255:-1:252])); +%!assert(uintlut(uint32([1,2,3,4]),uint32([255:-1:0])), uint32([255:-1:252])); +%!assert(uintlut(uint64([1,2,3,4]),uint64([255:-1:0])), uint64([255:-1:252])); + +% +% $Log$ +% Revision 1.2 2007/03/23 16:14:38 adb014 +% Update the FSF address +% +% Revision 1.1 2006/08/20 12:59:36 hauberg +% Changed the structure to match the package system +% +% Revision 1.2 2004/08/11 15:04:59 pkienzle +% Convert dos line endings to unix line endings +% +% Revision 1.1 2004/08/08 21:20:25 jmones +% uintlut and padarray functions added +% +% diff --git a/octave_packages/io-1.0.19/append_save.m b/octave_packages/io-1.0.19/append_save.m new file mode 100644 index 0000000..9f72971 --- /dev/null +++ b/octave_packages/io-1.0.19/append_save.m @@ -0,0 +1,165 @@ +## Copyright (C) 2003 Tomer Altman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## append_save M-file function +## +## Objective: be able to add variables to existing save files. Works for +## all the types of save files that "save" supports. +## +## Input: +## 1) A string which specifies the existing save file. +## 2) The options you need to pass to the 'save' function to save to the +## file type that you want. +## 3) A 1x2 cell, with the first element being a string representation +## of the variable/symbol that you're trying to add, followed by the +## actual variable/symbol itself. +## 4) Any number of additional 1x2 cells, following the same format as +## the 3rd argument specified immediately before this one. +## +## Output: +## Currently, none. But there might be some debugging / error-code +## messages in the future. +## +## Example: +## octave> B = ones(2,2); +## octave> append_save( "test.txt", "-binary", {"B", B } ) + + +function [ return_value ] = append_save ( filename, + option, + var_val_cell, + varargin ) + + ## Input checking: + + if ( nargin < 3 ) + error("append_save: needs three arguments."); + elseif ( !ischar(filename) ) + error("append_save: filename must be a string."); + elseif ( !ischar(option) ) + error("append_save: option must be a string." ); + elseif ( !iscell(var_val_cell) ) + error("append_save: variable-value pairs must be cells.") + elseif ( nargin > 3 ) + for i=1:(nargin-3) + current_cell = varargin(i); + if ( !iscell(current_cell) ) + error("append_save: variable-value pairs must be cells."); + elseif ( ( columns( current_cell ) != 2 ) + || ( rows( current_cell ) != 1 ) ) + error("append_save: variable-value pairs must be 1x2 cells.") + elseif ( !ischar(current_cell{1} ) ) + error("append_save: variable in pair must be a string." ) + endif + endfor + endif + + ## First step: load into the environment what is already stuffed in + ## the target file. Then, add their name to the list for "save". + + env1 = who; + + eval([ "load -force ", \ + option, " ", \ + filename ] ); + + env2 = who; + + num_orig_vars = rows(env1); + + # Not really 'current' env... + num_current_vars = rows(env2); + + num_new_vars = num_current_vars - num_orig_vars; + + var_str = ""; + + ## This double 'for loop' weeds out only the loaded vars for + ## inclusion. + + if ( num_new_vars ) + + for i=1:num_current_vars + + current_var = env2{i,1}; + + old_bool = 0; + + for j=1:num_orig_vars + + if ( strcmp( env1{j,1}, env2{i,1} ) + || + strcmp( env2{i,1}, "env1" ) ) + + old_bool = 1; + + endif + + endfor + + if ( old_bool == 0 ) + + var_name = env2{i,1}; + + var_str = [ var_str, " ", var_name, " " ]; + + endif + + endfor + + endif + + + ## Second step: load into the environment the variable pairs. Then, + ## add the name to the string for "save". + + var_name = var_val_cell{1}; + + var_val = var_val_cell{2}; + + temp = var_val; + + eval([ var_name, "=temp;" ]); + + var_str = [ var_str, " ", var_name, " " ]; + + ## Third step: do the same as step two, but loop through the possible + ## variable arguments. + + for i=1:(nargin-3) + + current_cell = varargin(i); + + var_name = current_cell{1}; + + var_val = current_cell{2}; + + temp = var_val; + + eval([ var_name, "=temp;" ]); + + var_str = [ var_str, " ", var_name, " " ]; + + var_str + + endfor + + ## Finally, save all of the variables into the target file: + + eval( [ "save ", \ + option, " ", \ + filename, " ", var_str; ] ); + +endfunction diff --git a/octave_packages/io-1.0.19/calccelladdress.m b/octave_packages/io-1.0.19/calccelladdress.m new file mode 100644 index 0000000..460a294 --- /dev/null +++ b/octave_packages/io-1.0.19/calccelladdress.m @@ -0,0 +1,88 @@ +## Copyright (C) 2009,2010,2011 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## calccelladdress (R, C) - compute spreadsheet style cell address from +## row & column index (both 1-based). +## +## Max column index currently set to 18278 (max ODS: 1024, OOXML: 16384). +## Row limits for ODF and OOXML are 65536 and 1048576, resp. + +## Author: Philip Nienhuis +## Created: 2009-12-12 +## Updates: +## 2009-12-27 Fixed OOXML limits +## 2010-03-17 Simplified argument list, only row + column needed +## 2010-09-27 Made error message more comprehensible +## 2010-10-11 Added check for row range +## 2011-04-21 Added tests +## 2011-04-30 Simplified column name computation +## 2011-12-17 Bugfix for wrong column address if column equals multiple of 26 +## 2011-12-18 Added tests for multiple-of-26 cases + +function [ celladdress ] = calccelladdress (row, column) + + if (nargin < 2) error ("calccelladdress: Two arguments needed") endif + + if (column > 18278 || column < 1) error ("Specified column out of range (1..18278)"); endif + if (row > 1048576 || row < 1), error ('Specified row out of range (1..1048576)'); endif + + str = ''; + while (column > 0.01) + rmd = floor ((column - 1) / 26); + str = [char(column - rmd * 26 + 'A' - 1) str]; + column = rmd; + endwhile + + celladdress = sprintf ("%s%d", str, row); + +endfunction + +%!test +%! a = calccelladdress (1, 1); +%! assert (a, 'A1'); + +%!test +%! a = calccelladdress (378, 28); +%! assert (a, 'AB378'); + +%!test +%! a = calccelladdress (65536, 1024); +%! assert (a, 'AMJ65536'); + +%!test +%! a = calccelladdress (1048576, 16384); +%! assert (a, 'XFD1048576'); + +%!test +%! a = calccelladdress (378, 26); +%! assert (a, 'Z378'); + +%!test +%! a = calccelladdress (378, 702); +%! assert (a, 'ZZ378'); + +%!test +%! a = calccelladdress (378, 701); +%! assert (a, 'ZY378'); + +%!test +%! a = calccelladdress (378, 703); +%! assert (a, 'AAA378'); + +%!test +%! a = calccelladdress (378, 676); +%! assert (a, 'YZ378'); + + diff --git a/octave_packages/io-1.0.19/chk_spreadsheet_support.m b/octave_packages/io-1.0.19/chk_spreadsheet_support.m new file mode 100644 index 0000000..4b0916f --- /dev/null +++ b/octave_packages/io-1.0.19/chk_spreadsheet_support.m @@ -0,0 +1,569 @@ +% Check Octave / Matlab environment for spreadsheet I/O support. +% +% usage: [ RETVAL ] = chk_spreadsheet_support ( [/PATH/TO/JARS], [,DEBUG_LEVEL] [,PATH_TO_OOO]) +% +% CHK_SPREADSHEET_SUPPORT first checks ActiveX (native MS-Excel); then +% Java JRE presence, then Java support (builtin/activated (Matlab) or +% added tru octave-forge Java package (Octave); then check existing +% javaclasspath for Java class libraries (.jar) needed for various +% Java-based spreadsheet I/O interfaces. +% If desired the relevant classes can be added to the dynamic +% javaclasspath. In that case the path name to the directory +% containing these classes should be specified as input argument +% with -TAKE NOTICE- /forward/ slashes. In these jars reside in +% different directories, multiple calls to chk_spreadsheet_support +% can be made. +% +% Input arguments (all are optional, but the order is important): +% /PATH/TO/JARS = (string) path (relative or absolute) to a +% subdirectory where java class libraries (.jar) +% for spreadsheet I/O reside. Can be [] or '' +% DEBUG_LEVEL = (integer) between [0 (no output) .. 3 (full output] +% PATH_TO_OOO = (string) installation directory of Openffice.org, +% usually (but not guaranteed): +% - Windows: C:\Program Files\OpenOffice.org +% - *nix: /usr/lib/ooo +% - Mac OSX: ????? +% IMPORTANT: PATH_TO_OOO should be such that both: +% 1. PATH_TO_OOO/program/ +% and +% 2. PATH_TO_OOO/ure/.../ridl.jar +% resolve OK +% Returns: +% RETVAL = 0 No spreadsheet I/O support found +% <> 0 At least one spreadsheet I/O interface found. RETVAL +% RETVAL will be set to the sum of values for found interfaces: +% ---------- XLS (Excel) interfaces: ---------- +% 1 = COM (ActiveX / Excel) +% 2 = POI (Java / Apache POI) +% 4 = POI+OOXML (Java / Apache POI) +% 8 = JXL (Java / JExcelAPI) +% 16 = OXS (Java / OpenXLS) +% --- ODS (OpenOffice.org Calc) interfaces ---- +% 32 = OTK (Java/ ODF Toolkit) +% 64 = JOD (Java / jOpenDocument) +% ----------------- XLS & ODS: ---------------- +% 128 = UNO (Java / UNO bridge - OpenOffice.org) + +function [ retval ] = chk_spreadsheet_support (path_to_jars, dbug, path_to_ooo) + +% Copyright (C) 2009,2010,2011 Philip Nienhuis +% +% This program is free software; you can redistribute it and/or modify it under +% the terms of the GNU General Public License as published by the Free Software +% Foundation; either version 3 of the License, or (at your option) any later +% version. +% +% This program is distributed in the hope that it will be useful, but WITHOUT +% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +% details. +% +% You should have received a copy of the GNU General Public License along with +% this program; if not, see . + + +% Author: Philip Nienhuis +% Created 2010-11-03 for Octave & Matlab +% Updates: +% 2010-12-19 Found that dom4j-1.6.1.jar is needed regardless of ML's dom4j +% presence in static classpath (ML r2007a) +% 2011-01-04 Adapted for general checks, debugging & set up, both Octave & ML +% 2011-04-04 Rebuilt into general setup/debug tool for spreadsheet I/O support +% and renamed chk_spreadsheet_support() +% 2011-05-04 Added in UNO support (OpenOffice.org & clones) +% '' Improved finding jar names in javaclasspath +% 2011-05-07 Improved help text +% 2011-05-15 Better error msg if OOo instal dir isn't found +% 2011-05-20 Attempt to cope with case variations in subdir names of OOo install dir (_get_dir_) +% 2011-05-27 Fix proper return value (retval); header text improved +% 2011-05-29 Made retval value dependent on detected interfaces & adapted help text +% 2011-06-06 Fix for javaclasspath format in *nix w. octave-java-1.2.8 pkg +% '' Fixed wrong return value update when adding UNO classes +% 2011-09-03 Small fix to better detect Basis* subdir when searching unoil.jar +% 2011-09-18 Fixed 'Matlab style short circuit' warning in L. 152 +% 2012-12-24 Amended code stanze to find unoil.jar; now works in LibreOffice 3.5b2 as well +% 2012-06-07 Replaced all tabs by double space + + jcp = []; retval = 0; + if (nargin < 3); path_to_ooo= ''; end %if + if (nargin < 2); dbug = 0; end %if + isOctave = exist ('OCTAVE_VERSION', 'builtin') ~= 0; + if (dbug); fprintf ('\n'); end %if + % interfaces = {'COM', 'POI', 'POI+OOXML', 'JXL', 'OXS', 'OTK', 'JOD', 'UNO'}; % Order = vital + + % Check if MS-Excel COM ActiveX server runs + if (dbug), fprintf ('Checking Excel/ActiveX/COM... '); end %if + try + app = actxserver ('Excel.application'); + % If we get here, the call succeeded & COM works. + xlsinterfaces.COM = 1; + % Close Excel to avoid zombie Excel invocation + app.Quit(); + delete(app); + if (dbug), fprintf ('OK.\n\n'); end %if + retval = retval + 1; + catch + % COM not supported + if (dbug), fprintf ('not working.\n\n'); end %if + end %try_catch + + % Check Java + if (dbug), fprintf ('Checking Java support...\n'); end %if + if (dbug > 1), fprintf (' 1. Checking Java JRE presence.... '); end %if + % Try if Java is installed at all + if (isOctave) + if (ispc) + jtst = (system ('java -version 2> nul')); + else + jtst = (system ('java -version 2> /dev/null')); + end %if + else + tst1 = version ('-java'); + jtst = isempty (strfind (tst1, 'Java')); + end %if + if (jtst) + error ('Apparently no Java JRE installed.'); + else + if (dbug > 1), fprintf ('OK, found one.\n'); end %if + end %if + if (dbug > 1 && isOctave), fprintf (' 2. Checking Octave Java support... '); end %if + try + jcp = javaclasspath ('-all'); % For Octave java pkg > 1.2.7 + if (isempty (jcp)), jcp = javaclasspath; end %if % For Octave java pkg < 1.2.8 + % If we get here, at least Java works. + if (dbug > 1 && isOctave), fprintf ('Java package seems to work OK.\n'); end %if + % Now check for proper version (> 1.6.x.x) + jver = char (javaMethod ('getProperty', 'java.lang.System', 'java.version')); + cjver = strsplit (jver, '.'); + if (sscanf (cjver{2}, '%d') < 6) + if (dbug) + fprintf (' Java version (%s) too old - you need at least Java 6 (v. 1.6.x.x)\n', jver); + if (isOctave) + warning (' At Octave prompt, try "!system ("java -version")"'); + else + warning (' At Matlab prompt, try "version -java"'); + end %if + end %if + return + else + if (dbug > 2), fprintf (' Java (version %s) seems OK.\n', jver); end %if + end %if + % Under *nix the classpath must first be split up. + % Matlab is braindead here. For ML we need a replacement for Octave's builtin strsplit() + % This is found on ML Central (BSD license so this is allowed) & adapted for input arg order + if (isunix && ~iscell (jcp)); jcp = strsplit (char (jcp), ':'); end %if + if (dbug > 1) + % Check JVM virtual memory settings + jrt = javaMethod ('getRuntime', 'java.lang.Runtime'); + jmem = jrt.maxMemory (); + if (isOctave), jmem = jmem.doubleValue(); end %if + jmem = int16 (jmem/1024/1024); + fprintf (' Maximum JVM memory: %5d MiB; ', jmem); + if (jmem < 400) + fprintf ('should better be at least 400 MB!\n'); + fprintf (' Hint: adapt setting -Xmx in file "java.opts" (supposed to be here:)\n'); + if (isOctave) + fprintf (' %s\n', [matlabroot filesep 'share' filesep 'octave' filesep 'packages' filesep 'java-' filesep 'java.opts']); + else + fprintf (' $matlabroot/bin/]\n'); + end %if + else + fprintf ('sufficient.\n'); + end %if + end %if + if (dbug), fprintf ('Java support OK\n'); end %if + catch + error ('No Java support found: %s.', lasterr); + end %try_catch + + if (dbug), fprintf ('\nChecking javaclasspath for .jar class libraries needed for spreadsheet I/O...:\n'); end %if + + % Try Java & Apache POI. First Check basic .xls (BIFF8) support + if (dbug > 1), fprintf ('\nBasic POI (.xls) :\n'); end %if + jpchk1 = 0; entries1 = {'poi-3', 'poi-ooxml-3'}; missing1 = zeros (1, numel (entries1)); + % Only under *nix we might use brute force: e.g., strfind (javaclasspath, classname) + % as javaclasspath is one long string. Under Windows however classpath is a cell array + % so we need the following more subtle, platform-independent approach: + for jj=1:length (entries1) + found = 0; + for ii=1:length (jcp) + jcplst = strsplit (jcp{ii}, filesep); + jcpentry = jcplst {end}; + if (~isempty (strfind (lower (jcpentry), lower (entries1{jj})))) + jpchk1 = jpchk1 + 1; found = 1; + if (dbug > 2), fprintf (' - %s OK\n', jcp{ii}); end %if + end %if + end %for + if (~found) + if (dbug > 2), fprintf (' %s....jar missing\n', entries1{jj}); end %if + missing1(jj) = 1; + end %if + end %for + if (jpchk1 >= numel (entries1)), retval = retval + 2; end %if + if (dbug > 1) + if (jpchk1 >= numel (entries1)) + fprintf (' => Apache (POI) OK\n'); + else + fprintf (' => Not all classes (.jar) required for POI in classpath\n'); + end %if + end %if + % Next, check OOXML support + if (dbug > 1), fprintf ('\nPOI OOXML (.xlsx) :\n'); end %if + jpchk2 = 0; entries2 = {'xbean', 'poi-ooxml-schemas', 'dom4j-1.6.1'}; + missing2 = zeros (1, numel (entries2)); + for jj=1:length (entries2) + found = 0; + for ii=1:length (jcp) + jcplst = strsplit (jcp{ii}, filesep); + jcpentry = jcplst {end}; + if (~isempty (strfind (lower (jcpentry), lower (entries2{jj})))) + jpchk2 = jpchk2 + 1; found = 1; + if (dbug > 2), fprintf (' - %s OK\n', jcp{ii}); end %if + end %if + end % for + if (~found) + if (dbug > 2), fprintf (' %s....jar missing\n', entries2{jj}); end %if + missing2(jj) = 1; + end %if + end % for + % Only update retval if all classes for basic POI have been found in javaclasspath + if (jpchk1 >= numel (entries1) && jpchk2 >= numel (entries2)), retval = retval + 4; end %if + if (dbug > 1) + if (jpchk2 >= numel (entries2)) + fprintf (' => POI OOXML OK\n'); + else + fprintf (' => Some classes for POI OOXML support missing\n'); + end %if + end %if + + % Try Java & JExcelAPI + if (dbug > 1), fprintf ('\nJExcelAPI (.xls (incl. BIFF5 read)) :\n'); end %if + jpchk = 0; entries3 = {'jxl'}; missing3 = zeros (1, numel (entries3)); + for jj=1:length (entries3) + found = 0; + for ii=1:length (jcp) + jcplst = strsplit (jcp{ii}, filesep); + jcpentry = jcplst {end}; + if (~isempty (strfind (lower (jcpentry), lower (entries3{jj})))) + jpchk = jpchk + 1; found = 1; + if (dbug > 2), fprintf (' - %s OK\n', jcp{ii}); end %if + end % if + end %for + if (~found) + if (dbug > 2), fprintf (' %s....jar missing\n', entries3{jj}); end %if + missing3(jj) = 1; + end %if + end %for + if (jpchk >= numel (entries3)), retval = retval + 8; end %if + if (dbug > 1) + if (jpchk >= numel (entries3)) + fprintf (' => Java/JExcelAPI (JXL) OK.\n'); + else + fprintf (' => Not all classes (.jar) required for JXL in classpath\n'); + end %if + end %if + + % Try Java & OpenXLS + if (dbug > 1), fprintf ('\nOpenXLS (.xls (BIFF8)) :\n'); end %if + jpchk = 0; entries4 = {'OpenXLS'}; missing4 = zeros (1, numel (entries4)); + for jj=1:length (entries4) + found = 0; + for ii=1:length (jcp) + jcplst = strsplit (jcp{ii}, filesep); + jcpentry = jcplst {end}; + if (~isempty (strfind (lower (jcpentry), lower (entries4{jj})))) + jpchk = jpchk + 1; found = 1; + if (dbug > 2), fprintf (' - %s OK\n', jcp{ii}); end %if + end % if + end %for + if (~found) + if (dbug > 2), fprintf (' %s....jar missing\n', entries4{jj}); end %if + missing4(jj) = 1; + end %if + end %for + if (jpchk >= numel (entries4)), retval = retval + 16; end %if + if (dbug > 1) + if (jpchk >= numel (entries4)) + fprintf (' => Java/OpenXLS (OXS) OK.\n'); + else + fprintf (' => Not all classes (.jar) required for OXS in classpath\n'); + end %if + end %if + + % Try Java & ODF toolkit + if (dbug > 1), fprintf ('\nODF Toolkit (.ods) :\n'); end %if + jpchk = 0; entries5 = {'odfdom', 'xercesImpl'}; missing5 = zeros (1, numel (entries5)); + for jj=1:length (entries5) + found = 0; + for ii=1:length (jcp) + jcplst = strsplit (jcp{ii}, filesep); + jcpentry = jcplst {end}; + if (~isempty (strfind ( lower (jcpentry), lower (entries5{jj})))) + jpchk = jpchk + 1; found = 1; + if (dbug > 2), fprintf (' - %s OK\n', jcp{ii}); end %if + end %if + end %for + if (~found) + if (dbug > 2), fprintf (' %s....jar missing\n', entries5{jj}); end %if + missing5(jj) = 1; + end %if + end %for + if (jpchk >= numel (entries5)) % Apparently all requested classes present. + % Only now we can check for proper odfdom version (only 0.7.5 & 0.8.6 work OK). + % The odfdom team deemed it necessary to change the version call so we need this: + odfvsn = ' '; + try + % New in 0.8.6 + odfvsn = javaMethod ('getOdfdomVersion', 'org.odftoolkit.odfdom.JarManifest'); + catch + % Worked in 0.7.5 + odfvsn = javaMethod ('getApplicationVersion', 'org.odftoolkit.odfdom.Version'); + end %try_catch + if ~(strcmp (odfvsn, '0.7.5') || strcmp (odfvsn, '0.8.6') || strcmp (odfvsn, '0.8.7')) + warning (' *** odfdom version (%s) is not supported - use v. 0.8.6 or 0.8.7.\n', odfvsn); + else + if (dbug > 1), fprintf (' => ODFtoolkit (OTK) OK.\n'); end %if + retval = retval + 32; + end %if + elseif (dbug > 1) + fprintf (' => Not all required classes (.jar) in classpath for OTK\n'); + end %if + + % Try Java & jOpenDocument + if (dbug > 1), fprintf ('\njOpenDocument (.ods + experimental .sxc readonly) :\n'); end %if + jpchk = 0; entries6 = {'jOpenDocument'}; missing6 = zeros (1, numel (entries6)); + for jj=1:length (entries6) + found = 0; + for ii=1:length (jcp) + jcplst = strsplit (jcp{ii}, filesep); + jcpentry = jcplst {end}; + if (~isempty (strfind (lower (jcpentry), lower (entries6{jj})))) + jpchk = jpchk + 1; found = 1; + if (dbug > 2), fprintf (' - %s OK\n', jcp{ii}); end %if + end %if + end %for + if (~found) + if (dbug > 2), fprintf (' %s....jar missing\n', entries6{jj}); end %if + missing6(jj) = 1; + end %if + end %for + if (jpchk >= numel (entries6)), retval = retval + 64; end %if + if (dbug > 1) + if (jpchk >= numel(entries6)) + fprintf (' => jOpenDocument (JOD) OK.\n'); + else + fprintf (' => Not all required classes (.jar) in classpath for JOD\n'); + end %if + end %if + + % Try Java & UNO + if (dbug > 1), fprintf ('\nUNO/Java (.ods, .xls, .xlsx, .sxc) :\n'); end %if + % entries0(1) = not a jar but a directory (<000_install_dir/program/>) + jpchk = 0; entries0 = {'program', 'unoil', 'jurt', 'juh', 'unoloader', 'ridl'}; + missing0 = zeros (1, numel (entries0)); + for jj=1:numel (entries0) + found = 0; + for ii=1:numel (jcp) + jcplst = strsplit (jcp{ii}, filesep); + jcpentry = jcplst {end}; + if (~isempty (strfind (lower (jcpentry), lower (entries0{jj})))) + jpchk = jpchk + 1; found = 1; + if (dbug > 2), fprintf (' - %s OK\n', jcp{ii}); end %if + end %if + end %for + if (~found) + if (dbug > 2) + if (jj == 1) + % Just a dir + fprintf (' %s.... (directory) not found\n', entries0{jj}); + else + fprintf (' %s....jar missing\n', entries0{jj}); + end %if + end %if + missing0(jj) = 1; + end %if + end %for + if (jpchk >= numel (entries0)), retval = retval + 128; end %if + if (dbug > 1) + if (jpchk >= numel (entries0)) + fprintf (' => UNO (OOo) OK\n'); + else + fprintf (' => One or more UNO classes (.jar) missing in javaclasspath\n'); + end %if + end %if + + % If requested, try to add UNO stuff to javaclasspath + ujars_complete = isempty (find (missing0, 1)); + + if (~ujars_complete && nargin > 0 && ~isempty (path_to_ooo)) + if (dbug), fprintf ('\nTrying to add missing UNO java class libs to javaclasspath...\n'); end %if + if (~ischar (path_to_jars)), error ('Path expected for arg # 1'); end %if + % Add missing jars to javaclasspath. First combine all entries + targt = sum (missing0); + if (missing0(1)) + % Add program dir (= where soffice or soffice.exe or ooffice resides) + programdir = [path_to_ooo filesep entries0{1}]; + if (exist (programdir, 'dir')) + if (dbug > 2), fprintf (' Found %s, adding it to javaclasspath ... ', programdir); end %if + try + javaaddpath (programdir); + targt = targt - 1; + if (dbug > 2), fprintf ('OK\n'); end %if + catch + if (dbug > 2), fprintf ('FAILED\n'); end %if + end %try_catch + else + if (dbug > 2), error ('Suggested OpenOffice.org install directory: %s not found!\n', path_to_ooo); end %if + end %if + end %if + % Rest of missing entries. Find where URE is located. Watch out because case of ./ure is unknown + uredir = get_dir_ (path_to_ooo, 'ure'); + if (isempty (uredir)), return; end %if + % Now search for UNO jars + for ii=2:length (entries0) + if (missing0(ii)) + if (ii == 2) + % Special case as unoil.jar usually resides in ./Basis/program/classes + % Find out the exact name of Basis..... + basisdirlst = dir ([path_to_ooo filesep '?asis' '*']); + jj = 1; + if (numel (basisdirlst) > 0) + while (jj <= size (basisdirlst, 1) && jj > 0) + basisdir = basisdirlst(jj).name; + if (basisdirlst(jj).isdir) + basisdir = basisdirlst(jj).name; + jj = 0; + else + jj = jj + 1; + end %if + end %while + basisdir = [path_to_ooo filesep basisdir ]; + else + basisdir = path_to_ooo; + endif + basisdirentries = {'program', 'classes'}; + tmp = basisdir; jj=1; + while (~isempty (tmp) && jj <= numel (basisdirentries)) + tmp = get_dir_ (tmp, basisdirentries{jj}); + jj = jj + 1; + end %if + unojarpath = tmp; + file = dir ([ unojarpath filesep entries0{2} '*' ]); + else + % Rest of jars in ./ure/share/java or ./ure/java + unojardir = get_dir_ (uredir, 'share'); + if (isempty (unojardir)) + tmp = uredir; + else + tmp = unojardir; + end %if + unojarpath = get_dir_ (tmp, 'java'); + file = dir ([unojarpath filesep entries0{ii} '*']); + end %if + % Path found, now try to add jar + if (isempty (file)) + if (dbug > 2), fprintf (' ? %s<...>.jar ?\n', entries0{ii}); end %if + else + if (dbug > 2), fprintf (' Found %s, adding it to javaclasspath ... ', file.name); end %if + try + javaaddpath ([unojarpath filesep file.name]); + targt = targt - 1; + if (dbug > 2), fprintf ('OK\n'); end %if + catch + if (dbug > 2), fprintf ('FAILED\n'); end %if + end %try_catch + end %if + end %if + end %for + if (~targt); retval = retval + 128; end %if + if (dbug) + if (targt) + fprintf ('Some UNO class libs still lacking...\n\n'); + else + fprintf ('UNO interface supported now.\n\n'); + end %if + end %f + end %if + +% ----------Rest of Java interfaces---------------------------------- + + missing = [missing1 missing2 missing3 missing4 missing5 missing6]; + jars_complete = isempty (find (missing, 1)); + if (dbug) + if (jars_complete) + fprintf ('All interfaces already fully supported.\n\n'); + else + fprintf ('Some class libs lacking yet...\n\n'); + end %if + end %if + + if (~jars_complete && nargin > 0 && ~isempty (path_to_jars)) + % Add missing jars to javaclasspath. Assume they're all in the same place + if (dbug), fprintf ('Trying to add missing java class libs to javaclasspath...\n'); end %if + if (~ischar (path_to_jars)), error ('Path expected for arg # 1'); end %if + % First combine all entries + targt = sum (missing); + % Search tru list of missing entries + for ii=1:6 % Adapt in case of future new interfaces + tmpe = eval ([ 'entries' char(ii + '0') ]); + tmpm = eval ([ 'missing' char(ii + '0') ]); + if (sum (tmpm)) + for jj=1:numel (tmpe) + if (tmpm(jj)) + file = dir ([path_to_jars filesep tmpe{jj} '*']); + if (isempty (file)) + if (dbug > 2), fprintf (' ? %s<...>.jar ?\n', tmpe{jj}); end %if + else + if (dbug > 2), fprintf (' Found %s, adding it to javaclasspath ... ', file(1).name); end %if + try + javaaddpath ([path_to_jars filesep file(1).name]); + targt = targt - 1; + tmpm(jj) = 0; + if (dbug > 2), fprintf ('OK\n'); end %if + catch + if (dbug > 2), fprintf ('FAILED\n'); end %if + end %try_catch + end %if + end %if + end %for + if (~sum (tmpm)) + retval = retval + 2^ii; + end %if + end %if + end %for + if (dbug) + if (targt) + fprintf ('Some other class libs still lacking...\n\n'); + else + fprintf ('All interfaces fully supported.now.\n\n'); + end %if + end %f + end %if + +end %function + + +function [ ret_dir ] = get_dir_ (base_dir, req_dir) + +% Construct path to subdirectory req_dir in a subdir tree, aimed +% at taking care of proper case (esp. for *nix) of existing subdir +% in the result. Case of input var req_dir is ignored on purpose. + + ret_dir = ''; + % Get list of directory entries + ret_dir_list = dir (base_dir); + % Find matching entries + idx = find (strcmpi ({ret_dir_list.name}, req_dir)); + % On *nix, several files and subdirs in one dir may have the same name as long as case differs + if (~isempty (idx)) + ii = 1; + while (~ret_dir_list(idx(ii)).isdir) + ii = ii + 1; + if (ii > numel (idx)); return; end %if + end %while + % If we get here, a dir with proper name has been found. Construct path + ret_dir = [ base_dir filesep ret_dir_list(idx(ii)).name ]; + end %if + +end %function diff --git a/octave_packages/io-1.0.19/doc-cache b/octave_packages/io-1.0.19/doc-cache new file mode 100644 index 0000000..59d6139 --- /dev/null +++ b/octave_packages/io-1.0.19/doc-cache @@ -0,0 +1,1809 @@ +# Created by Octave 3.6.2, Sun Jun 17 08:16:48 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 28 +# name: +# type: sq_string +# elements: 1 +# length: 11 +append_save + + +# name: +# type: sq_string +# elements: 1 +# length: 799 + append_save M-file function + + Objective: be able to add variables to existing save files. Works for + all the types of save files that "save" supports. + + Input: + 1) A string which specifies the existing save file. + 2) The options you need to pass to the 'save' function to save to the + file type that you want. + 3) A 1x2 cell, with the first element being a string representation + of the variable/symbol that you're trying to add, followed by the + actual variable/symbol itself. + 4) Any number of additional 1x2 cells, following the same format as + the 3rd argument specified immediately before this one. + + Output: + Currently, none. But there might be some debugging / error-code + messages in the future. + + Example: + octave> B = ones(2,2); + octave> append_save( "test.txt", "-binary", {"B", B } ) + + + +# name: +# type: sq_string +# elements: 1 +# length: 29 + append_save M-file function + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +calccelladdress + + +# name: +# type: sq_string +# elements: 1 +# length: 239 + calccelladdress (R, C) - compute spreadsheet style cell address from + row & column index (both 1-based). + + Max column index currently set to 18278 (max ODS: 1024, OOXML: 16384). + Row limits for ODF and OOXML are 65536 and 1048576, resp. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + calccelladdress (R, C) - compute spreadsheet style cell address from + row & col + + + +# name: +# type: sq_string +# elements: 1 +# length: 23 +chk_spreadsheet_support + + +# name: +# type: sq_string +# elements: 1 +# length: 2406 + Check Octave / Matlab environment for spreadsheet I/O support. + + usage: [ RETVAL ] = chk_spreadsheet_support ( [/PATH/TO/JARS], [,DEBUG_LEVEL] [,PATH_TO_OOO]) + + CHK_SPREADSHEET_SUPPORT first checks ActiveX (native MS-Excel); then + Java JRE presence, then Java support (builtin/activated (Matlab) or + added tru octave-forge Java package (Octave); then check existing + javaclasspath for Java class libraries (.jar) needed for various + Java-based spreadsheet I/O interfaces. + If desired the relevant classes can be added to the dynamic + javaclasspath. In that case the path name to the directory + containing these classes should be specified as input argument + with -TAKE NOTICE- /forward/ slashes. In these jars reside in + different directories, multiple calls to chk_spreadsheet_support + can be made. + + Input arguments (all are optional, but the order is important): + /PATH/TO/JARS = (string) path (relative or absolute) to a + subdirectory where java class libraries (.jar) + for spreadsheet I/O reside. Can be [] or '' + DEBUG_LEVEL = (integer) between [0 (no output) .. 3 (full output] + PATH_TO_OOO = (string) installation directory of Openffice.org, + usually (but not guaranteed): + - Windows: C:\Program Files\OpenOffice.org + - *nix: /usr/lib/ooo + - Mac OSX: ????? + IMPORTANT: PATH_TO_OOO should be such that both: + 1. PATH_TO_OOO/program/ + and + 2. PATH_TO_OOO/ure/.../ridl.jar + resolve OK + Returns: + RETVAL = 0 No spreadsheet I/O support found + <> 0 At least one spreadsheet I/O interface found. RETVAL + RETVAL will be set to the sum of values for found interfaces: + ---------- XLS (Excel) interfaces: ---------- + 1 = COM (ActiveX / Excel) + 2 = POI (Java / Apache POI) + 4 = POI+OOXML (Java / Apache POI) + 8 = JXL (Java / JExcelAPI) + 16 = OXS (Java / OpenXLS) + --- ODS (OpenOffice.org Calc) interfaces ---- + 32 = OTK (Java/ ODF Toolkit) + 64 = JOD (Java / jOpenDocument) + ----------------- XLS & ODS: ---------------- + 128 = UNO (Java / UNO bridge - OpenOffice.org) + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 + Check Octave / Matlab environment for spreadsheet I/O support. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +fexist + + +# name: +# type: sq_string +# elements: 1 +# length: 680 + -- Function File: ex = fexist (file, tspec, aspec) + Checks whether a file exists. FILE is the queried file path. + TSPEC is a combination of letters f,d,p,S, corresponding to file + types: + * f: regular file + + * d: directory + + * p: named pipe (FIFO special file) + + * S: socket + + The query is true if the actual file type matches any of the + specified options. + + ASPEC is a combination of letters r,w,x, corresponding to queried + access privileges to the file. The query is true if the current + user has all the spefied types of access, either through "user", + "group" or "other" specs. + + See also: stat, lstat + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 29 +Checks whether a file exists. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +getusedrange + + +# name: +# type: sq_string +# elements: 1 +# length: 1637 + -- Function File: [ TOPROW#, BOTTOMROW#, LEFTCOL#, RIGHTCOL# ] = + getusedrange (SPPTR, SHINDEX#) + Find occupied data range in worksheet SHINDEX# in a spreadsheet + pointed to in struct SPPTR (either MS-Excel or OpenOffice_org + Calc). + + SHINDEX# must be numeric and is 1-based. SPPTR can either refer to + an MS-Excel spreadsheet (spptr returned by xlsopen) or an + OpenOffice.org Calc spreadsheet (spptr returned by odsopen). None + of these inputs are checked! + + Be aware that especially for OpenOffice.org Calc (ODS) spreadsheets + the results can only be obtained by counting all cells in all rows; + this can be fairly time-consuming. Reliable ods data size results + can only be obtained using UNO interface. For the ActiveX (COM) + interface the underlying Visual Basic call relies on cached range + values and counts empty cells with only formatting too, so COM + returns only approximate (but then usually too big) range values. + + Examples: + + [trow, brow, lcol, rcol] = getusedrange (ods2, 3); + (which returns the outermost row & column numbers of the rectangle + enveloping the occupied cells in the third sheet of an OpenOffice_org + Calc spreadsheet pointedto in struct ods2) + + [trow, brow, lcol, rcol] = getusedrange (xls3, 3); + (which returns the outermost row & column numbers of the rectangle + enveloping the occupied cells in the third sheet of an Excel + spreadsheet pointed to in struct xls3) + + See also: xlsopen, xlsclose, odsopen, odsclose, xlsfinfo, odsfinfo + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Find occupied data range in worksheet SHINDEX# in a spreadsheet pointed +to in st + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +io_ods_testscript + + +# name: +# type: sq_string +# elements: 1 +# length: 180 + (Internal function) Check proper operation of ODS spreadsheet scripts. + Before running, a character variable 'intf' should be initialized with + a value of 'otk', 'jod', or 'uno'. + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 + (Internal function) Check proper operation of ODS spreadsheet scripts. + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +io_xls_testscript + + +# name: +# type: sq_string +# elements: 1 +# length: 194 + (Internal function) Check proper operation of XLS spreadsheet scripts. + Before running, a character variable 'intf' should be initialized with + a value of 'com', 'poi', 'jxl', 'oxs', or 'uno'. + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 + (Internal function) Check proper operation of XLS spreadsheet scripts. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +object2json + + +# name: +# type: sq_string +# elements: 1 +# length: 1521 + Returns a valid json string that will describe object; the string will + be in a compact form (no spaces or line breaks). + + It will map simple octave values this way: + function handles: string with the name of the function + double (numbers): depends: + If it's real it will map to a string representing that number + If it's complex it will map to an object with the next properties: + real: real part of the number + imag: imaginary part of the number + char: A string enclosed by double quotes representing that character + And will map more complex octave values this other way: + struct: an object with properties equal to the struct's field names + and value equal to the json counterpart of that field + cell: it will be mapped depending on the value of the cell (for + example {i} will be mapped to an object with real=0 and imag=1) + vectors or cell arrays: it will map them to a corresponding js + array (same size) with the values transformed to their json + counterpart (Note: that in javascript all arrays are like octave's + cells ,i.e. they can store different type and size variables) + strings or char vectors: they will be mapped to the same string + enclosed by double quotes + Other octave values will be mapped to a string enclosed by double + quotes with the value that the class() function returns + It can handle escape sequences and special chars automatically. + If they're valid in JSON it will keep them if not they'll be + escaped so they can become valid + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Returns a valid json string that will describe object; the string will + be in a + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +oct2ods + + +# name: +# type: sq_string +# elements: 1 +# length: 3268 + -- Function File: [ ODS, RSTATUS ] = oct2ods (ARR, ODS) + -- Function File: [ ODS, RSTATUS ] = oct2ods (ARR, ODS, WSH) + -- Function File: [ ODS, RSTATUS ] = oct2ods (ARR, ODS, WSH, RANGE) + -- Function File: [ ODS, RSTATUS ] = oct2ods (ARR, ODS, WSH, RANGE, + OPTIONS) + Transfer data to an OpenOffice_org Calc spreadsheet previously + opened by odsopen(). + + Data in 1D/2D array ARR are transferred into a cell range RANGE in + sheet WSH. ODS must have been made earlier by odsopen(). Return + argument ODS should be the same as supplied argument ODS and is + updated by oct2ods. A subsequent call to odsclose is needed to + write the updated spreadsheet to disk (and -if needed- close the + Java invocation holding the file pointer). + + ARR can be any 1D or 2D array containing numerical or character + data (cellstr) except complex. Mixed numeric/text arrays can only + be cell arrays. + + ODS must be a valid pointer struct created earlier by odsopen. + + WSH can be a number (sheet name) or string (sheet number). In + case of a yet non-existing Calc file, the first sheet will be used + & named according to WSH. In case of existing files, some checks + are made for existing sheet names or numbers. When new sheets are + to be added to the Calc file, they are inserted to the right of + all existing sheets. The pointer to the "active" sheet (shown when + Calc opens the file) remains untouched. + + If RANGE omitted, the top left cell where the data will be put is + supposed to be 'A1'; only a top left cell address can be specified + as well. In these cases the actual range to be used is determined + by the size of ARR. Be aware that large data array sizes may + exhaust the java shared memory space. For larger arrays, + appropriate memory settings are needed in the file java.opts; then + the maximum array size for the java-based spreadsheet options can + be in the order of perhaps 10^6 elements. + + Optional argument OPTIONS, a structure, can be used to specify + various write modes. Currently the only option field is + "formulas_as_text", which -if set to 1 or TRUE- specifies that + formula strings (i.e., text strings starting with "=" and ending + in a ")" ) should be entered as litteral text strings rather than + as spreadsheet formulas (the latter is the default). As + jOpenDocument doesn't support formula I/O at all yet, this option + is ignored for the JOD interface. + + Data are added to the sheet, ignoring other data already present; + existing data in the range to be used will be overwritten. + + If RANGE contains merged cells, also the elements of ARR not + corresponding to the top or left Calc cells of those merged cells + will be written, however they won't be shown until in Calc the + merge is undone. + + Examples: + + [ods, status] = ods2oct (arr, ods, 'Newsheet1', 'AA31:GH165'); + Write array arr into sheet Newsheet1 with upperleft cell at AA31 + + [ods, status] = ods2oct ({'String'}, ods, 'Oldsheet3', 'B15:B15'); + Put a character string into cell B15 in sheet Oldsheet3 + + See also: ods2oct, odsopen, odsclose, odsread, odswrite, odsfinfo + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Transfer data to an OpenOffice_org Calc spreadsheet previously opened +by odsopen + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +oct2xls + + +# name: +# type: sq_string +# elements: 1 +# length: 3321 + -- Function File: [ XLS, RSTATUS ] = oct2xls (ARR, XLS) + -- Function File: [ XLS, RSTATUS ] = oct2xls (ARR, XLS, WSH) + -- Function File: [ XLS, RSTATUS ] = oct2xls (ARR, XLS, WSH, RANGE) + -- Function File: [ XLS, RSTATUS ] = oct2xls (ARR, XLS, WSH, RANGE, + OPTIONS) + Add data in 1D/2D CELL array ARR into a cell range specified in + RANGE in worksheet WSH in an Excel spreadsheet file pointed to in + structure XLS. Return argument XLS equals supplied argument XLS + and is updated by oct2xls. + + A subsequent call to xlsclose is needed to write the updated + spreadsheet to disk (and -if needed- close the Excel or Java + invocation). + + ARR can be any 1D or 2D array containing numerical or character + data (cellstr) except complex. Mixed numeric/text arrays can only + be cell arrays. + + XLS must be a valid pointer struct created earlier by xlsopen. + + WSH can be a number or string (max. 31 chars). In case of a yet + non-existing Excel file, the first worksheet will be used & named + according to WSH - extra empty worksheets that Excel creates by + default are deleted. In case of existing files, some checks are + made for existing worksheet names or numbers, or whether WSH + refers to an existing sheet with a type other than worksheet + (e.g., chart). When new worksheets are to be added to the Excel + file, they are inserted to the right of all existing worksheets. + The pointer to the "active" sheet (shown when Excel opens the + file) remains untouched. + + If RANGE is omitted or just the top left cell of the range is + specified, the actual range to be used is determined by the size of + ARR. If nothing is specified for RANGE the top left cell is + assumed to be 'A1'. + + Data are added to the worksheet, ignoring other data already + present; existing data in the range to be used will be overwritten. + + If RANGE contains merged cells, only the elements of ARR + corresponding to the top or left Excel cells of those merged cells + will be written, other array cells corresponding to that cell will + be ignored. + + Optional argument OPTIONS, a structure, can be used to specify + various write modes. Currently the only option field is + "formulas_as_text", which -if set to 1 or TRUE- specifies that + formula strings (i.e., text strings starting with "=" and ending + in a ")" ) should be entered as litteral text strings rather than + as spreadsheet formulas (the latter is the default). + + Beware that -if invoked- Excel invocations may be left running + silently in case of COM errors. Invoke xlsclose with proper + pointer struct to close them. When using Java, note that large + data array sizes elements may exhaust the Java shared memory space + for the default java memory settings. For larger arrays, + appropriate memory settings are needed in the file java.opts; then + the maximum array size for the Java-based spreadsheet options may + be in the order of 10^6 elements. In caso of UNO this limit is not + applicable and spreadsheets may be much larger. + + Examples: + + [xlso, status] = xls2oct ('arr', xlsi, 'Third_sheet', 'AA31:AB278'); + + See also: xls2oct, xlsopen, xlsclose, xlsread, xlswrite, xlsfinfo + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Add data in 1D/2D CELL array ARR into a cell range specified in RANGE +in workshe + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +ods2oct + + +# name: +# type: sq_string +# elements: 1 +# length: 3684 + -- Function File: [ RAWARR, ODS, RSTATUS ] = ods2oct (ODS) + -- Function File: [ RAWARR, ODS, RSTATUS ] = ods2oct (ODS, WSH) + -- Function File: [ RAWARR, ODS, RSTATUS ] = ods2oct (ODS, WSH, RANGE) + -- Function File: [ RAWARR, ODS, RSTATUS ] = ods2oct (ODS, WSH, RANGE, + OPTIONS) + Read data contained within cell range RANGE from worksheet WSH in + an OpenOffice_org Calc spreadsheet file pointed to in struct ODS. + + ODS is supposed to have been created earlier by odsopen in the + same octave session. + + WSH is either numerical or text, in the latter case it is + case-sensitive. Note that in case of a numerical WSH this number + refers to the position in the worksheet stack, counted from the + left in a Calc window. The default is numerical 1, i.e. the + leftmost worksheet in the ODS file. + + RANGE is expected to be a regular spreadsheet range format, or "" + (empty string, indicating all data in a worksheet). If no range + is specified the occupied cell range will have to be determined + behind the scenes first; this can take some time. + + Optional argument OPTIONS, a structure, can be used to specify + various read modes by setting option fields in the struct to true + (1) or false (0). Currently recognized option fields are: + + "formulas_as_text" + If set to TRUE or 1, spreadsheet formulas (if at all present) + are read as formula strings rather than the evaluated formula + result values. This only works for the OTK and UNO interfaces. + The default value is 0 (FALSE). + + 'strip_array' + Set the value of this field set to TRUE or 1 to strip the + returned output array RAWARR from empty outer columns and + rows. The spreadsheet cell rectangle limits from where the + data actually came will be updated. The default value is + FALSE or 0 (no cropping). + + If only the first argument ODS is specified, ods2oct will try to + read all contents from the first = leftmost (or the only) + worksheet (as if a range of '' (empty string) was specified). + + If only two arguments are specified, ods2oct assumes the second + argument to be WSH. In that case ods2oct will try to read all data + contained in that worksheet. + + Return argument RAWARR contains the raw spreadsheet cell data. + Use parsecell() to separate numeric and text values from RAWARR. + + Optional return argument ODS contains the pointer struct. Field + ODS.limits contains the outermost column and row numbers of the + actually read cell range. + + Optional return argument RSTATUS will be set to 1 if the requested + data have been read successfully, 0 otherwise. + + Erroneous data and empty cells turn up empty in RAWARR. Date/time + values in OpenOffice.org are returned as numerical values with + base 1-1-0000 (same as octave). But beware that Excel spreadsheets + rewritten by OpenOffice.org into .ods format may have numerical + date cells with base 01-01-1900 (same as MS-Excel). + + When reading from merged cells, all array elements NOT + corresponding to the leftmost or upper OpenOffice.org cell will be + treated as if the "corresponding" cells are empty. + + Examples: + + A = ods2oct (ods1, '2nd_sheet', 'C3:ABS40000'); + (which returns the numeric contents in range C3:ABS40000 in worksheet + '2nd_sheet' from a spreadsheet file pointed to in pointer struct ods1, + into numeric array A) + + [An, ods2, status] = ods2oct (ods2, 'Third_sheet'); + + See also: odsopen, odsclose, parsecell, odsread, odsfinfo, + oct2ods, odswrite + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Read data contained within cell range RANGE from worksheet WSH in an +OpenOffice_ + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +odsclose + + +# name: +# type: sq_string +# elements: 1 +# length: 1547 + -- Function File: [ ODS] = odsclose (ODS) + -- Function File: [ ODS] = odsclose (ODS, FILENAME) + -- Function File: [ ODS] = odsclose (ODS, "FORCE") + Close the OpenOffice_org Calc spreadsheet pointed to in struct + ODS, if needed write the file to disk. odsclose will determine if + the file must be written to disk based on information contained in + ODS. An empty pointer struct will be returned if no errors + occurred. Optional argument FILENAME can be used to write changed + spreadsheet files to an other file than opened by odsopen(). + Optional string argument "FORCE" can be specified to force + resetting the file pointer struct. However, in case of UNO, a + hidden OOo invocation may linger on in memory then, preventing + proper closing of Octave. + + You need the Java package >= 1.2.6 plus odfdom.jar + xercesImpl.jar + and/or jopendocument-.jar installed on your computer + + proper javaclasspath set, to make this function work at all. For + UNO support, Octave-Java package >= 1.2.8 + latest fixes is + imperative; furthermore the relevant classes had best be added to + the javaclasspath by utility function chk_spreadsheet_support(). + + ODS must be a valid pointer struct made by odsopen() in the same + octave session. + + Examples: + + ods1 = odsclose (ods1); + (Close spreadsheet file pointed to in pointer struct ods1; ods1 is reset) + + See also: odsopen, odsread, odswrite, ods2oct, oct2ods, odsfinfo, + chk_spreadsheet_support + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Close the OpenOffice_org Calc spreadsheet pointed to in struct ODS, if +needed wr + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +odsfinfo + + +# name: +# type: sq_string +# elements: 1 +# length: 1703 + -- Function File: [ FILETYPE] = odsfinfo (FILENAME [, REQINTF]) + -- Function File: [ FILETYPE, SH_NAMES] = odsfinfo (FILENAME [, + REQINTF]) + Query an OpenOffice_org spreadsheet file FILENAME (with ods + suffix) for some info about its contents. + + If FILENAME is a recognizable OpenOffice.org spreadsheet file, + FILETYPE returns the string "OpenOffice.org Calc spreadsheet", or + '' (empty string) otherwise. + + If FILENAME is a recognizable OpenOffice.org Calc spreadsheet + file, optional argument SH_NAMES contains a list (cell array) of + sheet names contained in FILENAME, in the order (from left to + right) in which they occur in the sheet stack. + + If you omit return arguments FILETYPE and SH_NAMES altogether, + odsfinfo returns the sheet names and for each sheet the actual + occupied data ranges to the screen.The occupied cell range will + have to be determined behind the scenes first; this can take some + time. + + odsfinfo execution can take its time for large spreadsheets as the + entire spreadsheet has to be parsed to get the sheet names, let + alone exploring used data ranges. + + By specifying a value of 'jod', 'otk' or 'uno' for REQINTF the + automatic selection of the java interface is bypassed and the + specified interface will be used (if at all present). + + Examples: + + exist = odsfinfo ('test4.ods'); + (Just checks if file test4.ods is a readable Calc file) + + [exist, names] = odsfinfo ('test4.ods'); + (Checks if file test4.ods is a readable Calc file and return a + list of sheet names) + + See also: odsread, odsopen, ods2oct, odsclose + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Query an OpenOffice_org spreadsheet file FILENAME (with ods suffix) for +some inf + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +odsopen + + +# name: +# type: sq_string +# elements: 1 +# length: 2296 + -- Function File: ODS = odsopen (FILENAME) + -- Function File: ODS = odsopen (FILENAME, READWRITE) + -- Function File: ODS = odsopen (FILENAME, READWRITE, REQINTF) + Get a pointer to an OpenOffice_org spreadsheet in the form of + return argument ODS. + + Calling odsopen without specifying a return argument is fairly + useless! + + To make this function work at all, you need the Java package >= + 1.2.5 plus ODFtoolkit (version 0.7.5 or 0.8.6+) & xercesImpl, + and/or jOpenDocument, and/or OpenOffice.org (or clones) installed + on your computer + proper javaclasspath set. These interfaces are + referred to as OTK, JOD, and UNO resp., and are preferred in that + order by default (depending on their presence). For (currently + experimental) UNO support, Octave-Java package 1.2.8 + latest + fixes is imperative; furthermore the relevant classes had best be + added to the javaclasspath by utility function + chk_spreadsheet_support(). + + FILENAME must be a valid .ods OpenOffice.org file name including + .ods suffix. If FILENAME does not contain any directory path, the + file is saved in the current directory. For UNO bridge, filenames + need to be in the form "file:////filename"; a URL + will also work. If a plain file name is given (absolute or + relative), odsopen() will transform it into proper form. + + READWRITE must be set to true or numerical 1 if writing to + spreadsheet is desired immediately after calling odsopen(). It + merely serves proper handling of file errors (e.g., "file not + found" or "new file created"). + + Optional input argument REQINTF can be used to override the ODS + interface automatically selected by odsopen. Currently implemented + interfaces are 'OTK' (Java/ODF Toolkit), 'JOD' + (Java/jOpenDocument) and 'UNO' (Java/OpenOffice.org UNO bridge). + + Examples: + + ods = odsopen ('test1.ods'); + (get a pointer for reading from spreadsheet test1.ods) + + ods = odsopen ('test2.ods', [], 'JOD'); + (as above, indicate test2.ods will be read from; in this case using + the jOpenDocument interface is requested) + + See also: odsclose, odsread, oct2ods, ods2oct, odsfinfo, + chk_spreadsheet_support + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Get a pointer to an OpenOffice_org spreadsheet in the form of return +argument OD + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +odsread + + +# name: +# type: sq_string +# elements: 1 +# length: 4428 + -- Function File: [ NUMARR, TXTARR, RAWARR, LIMITS] = odsread + (FILENAME) + -- Function File: [ NUMARR, TXTARR, RAWARR, LIMITS] = odsread + (FILENAME, WSH) + -- Function File: [ NUMARR, TXTARR, RAWARR, LIMITS] = odsread + (FILENAME, WSH, RANGE) + -- Function File: [ NUMARR, TXTARR, RAWARR, LIMITS] = odsread + (FILENAME, WSH, RANGE, REQINTF) + Read data contained from cell range RANGE in worksheet WSH in + OpenOffice_org Calc spreadsheet file FILENAME. + + You need the octave-forge java package (> 1.2.6) and one or both of + jopendocument-.jar or preferrably: (odfdom.jar (versions + 0.7.5 or 0.8.6+) & xercesImpl.jar v. 2.9.1) in your javaclasspath. + There is also experimental support invoking OpenOffice.org or + clones through Java/UNO bridge. + + Return argument NUMARR contains the numeric data, optional return + arguments TXTARR and RAWARR contain text strings and the raw + spreadsheet cell data, respectively, and LIMITS is a struct + containing the data origins of the various returned arrays. + + If FILENAME does not contain any directory, the file is assumed to + be in the current directory. FILENAME should include the filename + extension (.ods). + + WSH is either numerical or text, in the latter case it is + case-sensitive and it should conform to OpenOffice.org Calc sheet + name requirements. Note that in case of a numerical WSH this + number refers to the position in the worksheet stack, counted from + the left in a Calc window. The default is numerical 1, i.e. the + leftmost worksheet in the Calc file. + + RANGE is expected to be a regular spreadsheet range format, or "" + (empty string, indicating all data in a worksheet). If no range + is specified the occupied cell range will have to be determined + behind the scenes first; this can take some time. + + If only the first argument is specified, odsread will try to read + all contents from the first = leftmost (or the only) worksheet (as + if a range of '' (empty string) was specified). + + If only two arguments are specified, odsread assumes the second + argument to be WSH and to refer to a worksheet. In that case + odsread tries to read all data contained in that worksheet. + + The optional last argument REQINTF can be used to override the + automatic selection by odsread of one interface out of the + supported ones: Java/ODFtoolkit ('OTK'), Java/jOpenDocument + ('JOD') or Java/UNO bridge ('UNO'). + + Erroneous data and empty cells are set to NaN in NUMARR and turn + up empty in TXTARR and RAWARR. Date/time values in date/time + formatted cells are returned as numerical values in OBJ with base + 1-1-000. Note that OpenOfice.org and MS-Excel have different date + base values (1/1/0000 & 1/1/1900, resp.) and internal + representation so MS-Excel spreadsheets rewritten into .ods format + by OpenOffice.org Calc may have different date base values. + + NUMARR and TXTARR are trimmed from empty outer rows and columns, + so any returned array may turn out to be smaller than requested in + RANGE. + + When reading from merged cells, all array elements NOT + corresponding to the leftmost or upper Calc cell will be treated + as if the "corresponding" Calc cells are empty. + + odsread is just a wrapper for a collection of scripts that find out + the interface to be used and do the actual reading. For each call + to odsread the interface must be started and the Calc file read + into memory. When reading multiple ranges (in optionally multiple + worksheets) a significant speed boost can be obtained by invoking + those scripts directly (odsopen / ods2oct [/ parsecell] / ... / + odsclose). + + Examples: + + A = odsread ('test4.ods', '2nd_sheet', 'C3:AB40'); + (which returns the numeric contents in range C3:AB40 in worksheet + '2nd_sheet' from file test4.ods into numeric array A) + + [An, Tn, Ra, limits] = odsread ('Sales2009.ods', 'Third_sheet'); + (which returns all data in worksheet 'Third_sheet' in file test4.ods + into array An, the text data into array Tn, the raw cell data into + cell array Ra and the ranges from where the actual data came in limits) + + See also: odsopen, ods2oct, oct2ods, odsclose, odswrite, odsfinfo, + parsecell + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Read data contained from cell range RANGE in worksheet WSH in +OpenOffice_org Cal + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +odswrite + + +# name: +# type: sq_string +# elements: 1 +# length: 3168 + -- Function File: RSTATUS = odswrite (FILENAME, ARR) + -- Function File: RSTATUS = odswrite (FILENAME, ARR, WSH) + -- Function File: RSTATUS = odswrite (FILENAME, ARR, WSH, RANGE) + -- Function File: RSTATUS = odswrite (FILENAME, ARR, WSH, RANGE, + REQINTF) + Add data in 1D/2D array ARR into sheet WSH in OpenOffice_org Calc + spreadsheet file FILENAME in cell range RANGE. + + RSTATUS returns 1 if write succeeded, 0 otherwise. + + FILENAME must be a valid .ods OpenOffice.org file name (including + file name extension). If FILENAME does not contain any directory + path, the file is saved in the current directory. + + ARR can be any 1D or 2D array containing numerical or character + data (cellstr) except complex. Mixed numeric/text arrays can only + be cell arrays. + + WSH can be a number or string. In case of a not yet existing + OpenOffice.org spreadsheet, the first sheet will be used & named + according to WSH - no extra empty sheets are created. In case of + existing files, some checks are made for existing sheet names or + numbers, or whether WSH refers to an existing sheet with a type + other than sheet (e.g., chart). When new sheets are to be added + to the spreadsheet file, they are inserted to the right of all + existing sheets. The pointer to the "active" sheet (shown when + OpenOffice.org Calc opens the file) remains untouched. + + RANGE is expected to be a regular spreadsheet range. Data is + added to the sheet; existing data in the requested range will be + overwritten. Array ARR will be clipped at the right and/or bottom + if its size is bigger than can be accommodated in RANGE. If ARR + is smaller than the RANGE allows, it is placed in the top left + rectangle of RANGE and cell values outside that rectangle will be + untouched. + + If RANGE contains merged cells, only the elements of ARR + corresponding to the top or left Calc cells of those merged cells + will be written, other array cells corresponding to that cell will + be ignored. + + The optional last argument REQINTF can be used to override the + automatic selection by odswrite of one interface out of the + supported ones: Java/ODFtooolkit ('OTK'), Java/jOpenDocument + ('JOD'), or Java/OpenOffice.org ('UNO'). + + odswrite is a mere wrapper for various scripts which find out what + ODS interface to use (ODF toolkit or jOpenDocument) plus code to + mimic the other brand's syntax. For each call to odswrite such an + interface must be started and possibly an ODS file loaded. When + writing to multiple ranges and/or worksheets in the same ODS file, + a speed bonus can be obtained by invoking those scripts (odsopen / + octods / .... / odsclose) directly. + + Example: + + status = odswrite ('test4.ods', 'arr', 'Eight_sheet', 'C3:AB40'); + (which adds the contents of array arr (any type) to range C3:AB40 + in sheet 'Eight_sheet' in file test4.ods and returns a logical + True (= numerical 1) in status if al went well) + + See also: odsread, oct2ods, ods2oct, odsopen, odsclose, odsfinfo + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Add data in 1D/2D array ARR into sheet WSH in OpenOffice_org Calc +spreadsheet fi + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +parse_sp_range + + +# name: +# type: sq_string +# elements: 1 +# length: 199 + Parse a string representing a range of cells for a spreadsheet + into nr of rows and nr of columns and also extract top left + cell address + top row + left column. Some error checks are implemented. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Parse a string representing a range of cells for a spreadsheet + into nr of rows + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +parsecell + + +# name: +# type: sq_string +# elements: 1 +# length: 1431 + -- Function File: [ NUMARR, TXTARR, LIM ] = parsecell (RAWARR) + -- Function File: [ NUMARR, TXTARR, LIM ] = parsecell (RAWARR, LIMITS) + Divide a heterogeneous 2D cell array into a 2D numeric array and a + 2D cell array containing only strings. Both returned arrays are + trimmed from empty outer rows and columns. This function is + particularly useful for parsing cell arrays returned by functions + reading spreadsheets (e.g., xlsread, odsread). + + Optional return argument LIM contains two field with the outer + column and row numbers of NUMARR and TXTARR in the original array + RAWARR. Optional input argument LIMITS can either be the + spreadsheet data limits returned in the spreadsheet file pointer + struct (field xls.limits or ods.limits), or the file ptr struct + itself. If one of these is specified, optional return argument LIM + will contain the real spreadsheet row & column numbers enclosing + the origins of the numerical and text data returned in NUMARR and + TXTARR. + + Examples: + + [An, Tn] = parsecell (Rn); + (which returns the numeric contents of Rn into array An and the + text data into array Tn) + + [An, Tn, lims] = parsecell (Rn, xls.limits); + (which returns the numeric contents of Rn into array An and the + text data into array Tn.) + + See also: xlsread, odsread, xls2oct, ods2oct + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Divide a heterogeneous 2D cell array into a 2D numeric array and a 2D +cell array + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +pch2mat + + +# name: +# type: sq_string +# elements: 1 +# length: 422 + -- Function File: DATA = pch2mat (FILENAME) + Converts NASTRAN PCH file (SORT2) to a data structure and + frequency vector. A filename as a string is the only needed input. + + The output is in the form of struct. containing a freq vector n x + 1 called data.f, and the remaining data are in the form of + subcases, point ids and directions respectively. for ex. + data.S1.p254686.x and they are n x 2 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 +Converts NASTRAN PCH file (SORT2) to a data structure and frequency +vector. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +spsh_chkrange + + +# name: +# type: sq_string +# elements: 1 +# length: 449 + -- Function File: [ TOPLEFTADDR, NROWS, NCOLS, TOPROW, LEFTCOL ] = + spsh_chkrange ( RANGE, ROWSIZE, COLSIZE, INTF-TYPE, FILENAME) + (Internal function) Get and check various cell and range address + parameters for spreadsheet input. + + spsh_chkrange should not be invoked directly but rather through + oct2xls or oct2ods. + + Example: + + [tl, nrw, ncl, trw, lcl] = spsh_chkrange (crange, nr, nc, xtype, fileptr); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +(Internal function) Get and check various cell and range address +parameters for + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +spsh_prstype + + +# name: +# type: sq_string +# elements: 1 +# length: 521 + -- Function File: [ TYPE-ARRAY ] = spsh_prstype ( IARRAY, ROWSIZE, + COLSIZE, CELLTYPES, OPTIONS) + (Internal function) Return rectangular array with codes for cell + types in rectangular input cell array IARRAY. Codes are contained + in input vector in order of Numeric, Boolean, Text, Formula and + Empty, resp. + + spsh_prstype should not be invoked directly but rather through + oct2xls or oct2ods. + + Example: + + typarr = spsh_chkrange (cellarray, nr, nc, ctypes, options); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +(Internal function) Return rectangular array with codes for cell types +in rectan + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +xls2oct + + +# name: +# type: sq_string +# elements: 1 +# length: 4421 + -- Function File: [ RAWARR, XLS, RSTATUS ] = xls2oct (XLS) + -- Function File: [ RAWARR, XLS, RSTATUS ] = xls2oct (XLS, WSH) + -- Function File: [ RAWARR, XLS, RSTATUS ] = xls2oct (XLS, WSH, RANGE) + -- Function File: [ RAWARR, XLS, RSTATUS ] = xls2oct (XLS, WSH, RANGE, + OPTIONS) + Read data contained within cell range RANGE from worksheet WSH in + an Excel spreadsheet file pointed to in struct XLS. + + XLS is supposed to have been created earlier by xlsopen in the + same octave session. + + WSH is either numerical or text, in the latter case it is + case-sensitive and it may be max. 31 characters long. Note that + in case of a numerical WSH this number refers to the position in + the worksheet stack, counted from the left in an Excel window. The + default is numerical 1, i.e. the leftmost worksheet in the Excel + file. + + RANGE is expected to be a regular spreadsheet range format, or "" + (empty string, indicating all data in a worksheet). If no range + is specified the occupied cell range will have to be determined + behind the scenes first; this can take some time for the + Java-based interfaces. Be aware that in COM/ActiveX interface the + used range can be outdated. The Java-based interfaces are more + reliable in this respect albeit much slower. + + Optional argument OPTIONS, a structure, can be used to specify + various read modes by setting option fields in the struct to true + (1) or false (0). Currently recognized option fields are: + + "formulas_as_text" + If set to TRUE or 1, spreadsheet formulas (if at all present) + are read as formula strings rather than the evaluated formula + result values. The default value is 0 (FALSE). + + 'strip_array' + Set the value of this field set to TRUE or 1 to strip the + returned output array RAWARR from empty outer columns and + rows. The spreadsheet cell rectangle limits from where the + data actually came will be updated. The default value is + FALSE or 0 (no cropping). When using the COM interface, the + output array is always cropped. + + If only the first argument XLS is specified, xls2oct will try to + read all contents from the first = leftmost (or the only) + worksheet (as if a range of '' (empty string) was specified). + + If only two arguments are specified, xls2oct assumes the second + argument to be WSH. In that case xls2oct will try to read all data + contained in that worksheet. + + Return argument RAWARR contains the raw spreadsheet cell data. + Use parsecell() to separate numeric and text values from RAWARR. + + Optional return argument XLS contains the pointer struct, If any + data have been read, field XLS.limits contains the outermost + column and row numbers of the actually returned cell range. + + Optional return argument RSTATUS will be set to 1 if the requested + data have been read successfully, 0 otherwise. + + Erroneous data and empty cells turn up empty in RAWARR. Date/time + values in Excel are returned as numerical values. Note that Excel + and Octave have different date base values (1/1/1900 & 1/1/0000, + resp.) Be aware that Excel trims RAWARR from empty outer rows & + columns, so any returned cell array may turn out to be smaller + than requested in RANGE, independent of field 'formulas_as_text' + in OPTIONS. When using COM, POI, or UNO interface, formulas in + cells are evaluated; if that fails cached values are retrieved. + These may be outdated depending on Excel's "Automatic calculation" + settings when the spreadsheet was saved. + + When reading from merged cells, all array elements NOT + corresponding to the leftmost or upper Excel cell will be treated + as if the "corresponding" Excel cells are empty. + + Beware: when the COM interface is used, hidden Excel invocations + may be kept running silently in case of COM errors. + + Examples: + + A = xls2oct (xls1, '2nd_sheet', 'C3:AB40'); + (which returns the numeric contents in range C3:AB40 in worksheet + '2nd_sheet' from a spreadsheet file pointed to in pointer struct xls1, + into numeric array A) + + [An, xls2, status] = xls2oct (xls2, 'Third_sheet'); + + See also: oct2xls, xlsopen, xlsclose, parsecell, xlsread, + xlsfinfo, xlswrite + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Read data contained within cell range RANGE from worksheet WSH in an +Excel sprea + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +xlsclose + + +# name: +# type: sq_string +# elements: 1 +# length: 1895 + -- Function File: [ XLS] = xlsclose (XLS) + -- Function File: [ XLS] = xlsclose (XLS, FILENAME) + -- Function File: [ XLS] = xlsclose (XLS, "FORCE") + Close the Excel spreadsheet pointed to in struct XLS, if needed + write the file to disk. Based on information contained in XLS, + xlsclose will determine if the file should be written to disk. + + If no errors occured during writing, the xls file pointer struct + will be reset and -if COM interface was used- ActiveX/Excel will + be closed. However if errors occurred, the file pinter will be + untouched so you can clean up before a next try with xlsclose(). + Be warned that until xlsopen is called again with the same XLS + pointer struct, hidden Excel or Java applications with associated + (possibly large) memory chunks are kept in memory, taking up + resources. If (string) argument "FORCE" is supplied, the file + pointer will be reset regardless, whether the possibly modified + file has been saved successfully or not. Hidden Excel (COM) or + OpenOffice.org (UNO) invocations may live on, possibly even + impeding proper shutdown of Octave. + + FILENAME can be used to write changed spreadsheet files to an + other file than opened with xlsopen(); unfortunately this doesn't + work with JXL (JExcelAPI) interface. + + You need MS-Excel (95 - 2010), and/or the Java package => 1.2.8 + plus Apache POI > 3.5 and/or JExcelAPI and/or OpenXLS and/or + OpenOffice.org or clones installed on your computer + proper + javaclasspath set, to make this function work at all. + + XLS must be a valid pointer struct made by xlsopen() in the same + octave session. + + Examples: + + xls1 = xlsclose (xls1); + (Close spreadsheet file pointed to in pointer struct xls1; xls1 is reset) + + See also: xlsopen, xlsread, xlswrite, xls2oct, oct2xls, xlsfinfo + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Close the Excel spreadsheet pointed to in struct XLS, if needed write +the file t + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +xlsfinfo + + +# name: +# type: sq_string +# elements: 1 +# length: 2353 + -- Function File: [ FILETYPE] = xlsfinfo (FILENAME [, REQINTF]) + -- Function File: [ FILETYPE, SH_NAMES] = xlsfinfo (FILENAME [, + REQINTF]) + -- Function File: [ FILETYPE, SH_NAMES, FFORMAT] = xlsfinfo (FILENAME + [, REQINTF]) + Query Excel spreadsheet file FILENAME for some info about its + contents. + + If FILENAME is a recognizable Excel spreadsheet file, FILETYPE + returns the string "Microsoft Excel Spreadsheet", or '' (empty + string) otherwise. + + If FILENAME is a recognizable Excel spreadsheet file, optional + argument SH_NAMES contains a list (cell array) of sheet names (and + in case Excel is installed: sheet types) contained in FILENAME, in + the order (from left to right) in which they occur in the sheet + stack. + + Optional return value FFORMAT currently returns '' (empty string) + unless FILENAME is a readable Excel 97-2003 .xls file or an Excel + 2007 .xlsx / .xlsb file in which case FFORMAT is set to + "xlWorkbookNormal". Excel 95 .xls files can only be read through + the JXL (JExcelAPI) or UNO (OpenOffice.org) Java-based interfaces. + + If no return arguments are specified the sheet names are echoed to + the terminal screen; in case of Java interfaces for each sheet the + actual occupied data range is echoed as well. The occupied cell + range will have to be determined behind the scenes first; this can + take some time for the Java-based interfaces. + + If multiple xls interfaces have been installed, REQINTF can be + specified. This can sometimes be handy, e.g. to get an idea of + occupied cell ranges in each worksheet using different interfaces + (due to cached info and/or different treatment of empty but + formatted cells, each interfaces may give different results). + + For use on OOXML spreadsheets one needs full POI and/or UNO + support (see xlsopen) and 'poi' or 'uno' needs to be specified for + REQINTF. For Excel 95 file use 'jxl' or 'uno'. + + Examples: + + exist = xlsfinfo ('test4.xls'); + (Just checks if file test4.xls is a readable Excel file) + + [exist, names] = xlsfinfo ('test4.xls'); + (Checks if file test4.xls is a readable Excel file and return a + list of sheet names and -types) + + See also: oct2xls, xlsread, xls2oct, xlswrite + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +Query Excel spreadsheet file FILENAME for some info about its contents. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +xlsopen + + +# name: +# type: sq_string +# elements: 1 +# length: 2964 + -- Function File: XLS = xlsopen (FILENAME) + -- Function File: XLS = xlsopen (FILENAME, READWRITE) + -- Function File: XLS = xlsopen (FILENAME, READWRITE, REQINTF) + Get a pointer to an Excel spreadsheet in the form of return + argument (file pointer struct) XLS. After processing the + spreadsheet, the file pointer must be explicitly closed by calling + xlsclose(). + + Calling xlsopen without specifying a return argument is fairly + useless! + + To make this function work at all, you need MS-Excel (95 - 2003), + and/or the Java package >= 1.2.8 plus Apache POI >= 3.5 and/or + JExcelAPI and/or OpenXLS and/or OpenOffice.org (or clones) + installed on your computer + proper javaclasspath set. These + interfaces are referred to as COM, POI, JXL, OXS, and UNO, resp., + and are preferred in that order by default (depending on their + presence). For OOXML support, in addition to Apache POI support + you also need the following jars in your javaclasspath: + poi-ooxml-schemas-3.5.jar, xbean.jar and dom4j-1.6.1.jar (or later + versions). Later OpenOffice.org versions (UNO) have support for + OOXML as well. Excel'95 spreadsheets can only be read by + JExcelAPI and OpenOffice.org. + + FILENAME should be a valid .xls or xlsx Excel file name (including + extension). But if you use the COM interface you can specify any + extension that your installed Excel version can read AND write; + the same goes for UNO (OpenOffice.org). Using the other Java + interfaces, only .xls or .xlsx are allowed. If FILENAME does not + contain any directory path, the file is saved in the current + directory. + + If READWRITE is set to 0 (default value) or omitted, the Excel file + is opened for reading. If READWRITE is set to True or 1, an Excel + file is opened (or created) for reading & writing. + + Optional input argument REQINTF can be used to override the Excel + interface that otherwise is automatically selected by xlsopen. + Currently implemented interfaces (in order of preference) are + 'COM' (Excel/COM), 'POI' (Java/Apache POI), 'JXL' + (Java/JExcelAPI), 'OXS' (Java/OpenXLS), or 'UNO' + (Java/OpenOffice.org - EXPERIMENTAL!). In most situations this + parameter is unneeded as xlsopen automatically selects the most + useful interface present. + + Beware: Excel invocations may be left running invisibly in case of + COM errors or forgetting to close the file pointer. Similarly for + OpenOffice.org which may even prevent Octave from being closed. + + Examples: + + xls = xlsopen ('test1.xls'); + (get a pointer for reading from spreadsheet test1.xls) + + xls = xlsopen ('test2.xls', 1, 'POI'); + (as above, indicate test2.xls will be written to; in this case using Java + and the Apache POI interface are requested) + + See also: xlsclose, xlsread, xlswrite, xls2oct, oct2xls, xlsfinfo + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Get a pointer to an Excel spreadsheet in the form of return argument +(file point + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +xlsread + + +# name: +# type: sq_string +# elements: 1 +# length: 5721 + -- Function File: [ NUMARR, TXTARR, RAWARR, LIMITS] = xlsread + (FILENAME) + -- Function File: [ NUMARR, TXTARR, RAWARR, LIMITS] = xlsread + (FILENAME, WSH) + -- Function File: [ NUMARR, TXTARR, RAWARR, LIMITS] = xlsread + (FILENAME, RANGE) + -- Function File: [ NUMARR, TXTARR, RAWARR, LIMITS] = xlsread + (FILENAME, WSH, RANGE) + -- Function File: [ NUMARR, TXTARR, RAWARR, LIMITS] = xlsread + (FILENAME, WSH, RANGE, REQINTF) + Read data contained in range RANGE from worksheet WSH in Excel + spreadsheet file FILENAME. Return argument NUMARR contains the + numeric data, optional return arguments TXTARR and RAWARR contain + text strings and the raw spreadsheet cell data, respectively. + Return argument LIMITS contains the outer column/row numbers of + the read spreadsheet range where NUMARR, TXTARR and RAWARR have + come from (remember, xlsread trims outer rows and columns). + + If FILENAME does not contain any directory, the file is assumed to + be in the current directory. The filename extension (.xls or + .xlsx) must be included in the file name; when using the COM + interface all file formats can be read that are supported by the + locally installed MS-Excel version (e.g., wk1, csv, dbf, etc.). + + RANGE is expected to be a regular spreadsheet range format, or "" + (empty string, indicating all data in a worksheet). If no range + is specified the occupied cell range will have to be determined + behind the scenes first; this can take some time for the + Java-based interfaces (but the results may be more reliable than + that of ActiveX/COM). + + WSH is either numerical or text; in the latter case it is + case-sensitive and it may be max. 31 characters long. Note that + in case of a numerical WSH this number refers to the position in + the worksheet stack, counted from the left in an Excel window. The + default is numerical 1, i.e. the leftmost worksheet in the Excel + file. + + If only the first argument is specified, xlsread will try to read + all contents (as if a range of '' (empty string) was specified) + from the first = leftmost (or the only) worksheet + + If only two arguments are specified, xlsread assumes the second + argument to be RANGE if it is a string argument and contains a + ":" or if it is '' (empty string), and in those cases assumes the + data must be read from the first worksheet (not necessarily + Sheet1! but the leftmost sheet). + + However, if only two arguments are specified and the second + argument is numeric or a text string that does not contain a ":", + it is assumed to be WSH and to refer to a worksheet. In that case + xlsread tries to read all data contained in that worksheet. + + The optional last argument REQINTF can be used to override the + automatic interface selection by xlsread out of the supported + ones: COM/Excel, Java/Apache POI, Java/JExcelAPI, Java/OpenXLS, or + Java/UNO (OpenOffice.org) (in that -built in- order of preference). + For reading from OOXML files a value of 'com', 'poi' or 'uno' must + be specified for REQINTF (see help for xlsopen); for Excel'95 + files use 'com', or if Excel is not installed use 'jxl', 'basic' + or 'uno' (POI can't read Excel 95 but will try to fall back to + JXL). As REQINTF can also be a cell array of strings, one can + select or exclude one or more interfaces. + + Erroneous data and empty cells are set to NaN in NUMARR and turn + up empty in TXTARR and RAWARR. Date/time values in Excel are + returned as numerical values in NUMARR. Note that Excel and Octave + have different date base values (1/1/1900 & 1/1/0000, resp.). + Spreadsheet date values lying before 1/1/1900 are returned as + strings, formatted as they appear in the spreadsheet. NUMARR and + TXTARR are trimmed from empty outer rows and columns. Be aware + that Excel does the same for RAWARR, so any returned array may + turn out to be smaller than requested in RANGE. + + When reading from merged cells, all array elements NOT + corresponding to the leftmost or upper Excel cell will be treated + as if the "corresponding" Excel cells are empty. + + xlsread is just a wrapper for a collection of scripts that find out + the interface to be used (COM, Java/POI, Java/JXL Java/OXS, + Java/UNO) and do the actual reading. For each call to xlsread the + interface must be started and the Excel file read into memory. + When reading multiple ranges (in optionally multiple worksheets) a + significant speed boost can be obtained by invoking those scripts + directly as in: xlsopen / xls2oct [/ parsecell] / ... / xlsclose + + Beware: when using the COM interface, hidden Excel invocations may + be kept running silently if not closed explicitly. + + Examples: + + A = xlsread ('test4.xls', '2nd_sheet', 'C3:AB40'); + (which returns the numeric contents in range C3:AB40 in worksheet + '2nd_sheet' from file test4.xls into numeric array A) + + [An, Tn, Ra, limits] = xlsread ('Sales2009.xls', 'Third_sheet'); + (which returns all data in worksheet 'Third_sheet' in file 'Sales2009.xls' + into array An, the text data into array Tn, the raw cell data into + cell array Ra and the ranges from where the actual data came in limits) + + numarr = xlsread ('Sales2010.xls', 4, [], {'JXL', 'COM'}); + (Read all data from 4th worksheet in file Sales2010.xls using either JXL + or COM interface (i.e, exclude POI interface). + + See also: xlswrite, xlsopen, xls2oct, xlsclose, xlsfinfo, oct2xls + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Read data contained in range RANGE from worksheet WSH in Excel +spreadsheet file + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +xlswrite + + +# name: +# type: sq_string +# elements: 1 +# length: 4031 + -- Function File: RSTATUS = xlswrite (FILENAME, ARR) + -- Function File: RSTATUS = xlswrite (FILENAME, ARR, WSH) + -- Function File: RSTATUS = xlswrite (FILENAME, ARR, WSH, RANGE) + -- Function File: RSTATUS = xlswrite (FILENAME, ARR, WSH, RANGE, + REQINTF) + Add data in 1D/2D array ARR to worksheet WSH in Excel spreadsheet + file FILENAME in cell range RANGE. + + RSTATUS returns 1 if write succeeded, 0 otherwise. + + FILENAME must be a valid .xls Excel file name (including file name + extension). If FILENAME does not contain any directory path, the + file is saved in the current directory. + + ARR can be any 1D or 2D array containing numerical or character + data (cellstr) except complex. Mixed numeric/text arrays can only + be cell arrays. + + If only 3 arguments are given, the 3rd is assumed to be a + spreadsheet range if it contains a ":" or is a completely empty + string (corresponding to A1:IV65336 for regular .xls or + A1:XFD1048576 for OOXML .xlsx). The 3rd argument is assumed to + refer to a worksheet if it is a numeric value or a non-empty text + string not containing ":" + + WSH can be a number or string (max. 31 chars). In case of a not + yet existing Excel file, the first worksheet will be used & named + according to WSH - the extra worksheets that Excel normally + creates by default are deleted. In case of existing files, some + checks are made for existing worksheet names or numbers, or + whether WSH refers to an existing sheet with a type other than + worksheet (e.g., chart). When new worksheets are to be added to + the Excel file, they are inserted to the right of all existing + worksheets. The pointer to the "active" sheet (shown when Excel + opens the file) remains untouched. + + RANGE is expected to be a regular spreadsheet range. Data is + added to the worksheet; existing data in the requested range will + be overwritten. Array ARR will be clipped at the right and/or + bottom if its size is bigger than can be accommodated in RANGE. + If ARR is smaller than the RANGE allows, it is placed in the top + left rectangle of RANGE and remaining cell values outside the + rectangle will be retained. + + If RANGE contains merged cells, only the elements of ARR + corresponding to the top or left Excel cells of those merged cells + will be written, other array cells corresponding to that cell will + be ignored. + + The optional last argument REQINTF can be used to override the + automatic selection by xlswrite of one interface out of the + supported ones: 'com' (ActiveX/Excel), 'poi' (Java/Apache POI), + 'jxl' (Java/JExcelAPI), or 'uno' (Java/OpenOffice.org). 'oxs' + (Java/OpenXLS) is implemented but disabled for writing as it is + too buggy. For writing to OOXML files (.xlsx) a value of 'com', + 'poi' or 'uno' must be specified for REQINTF. The value of REQINTF + is case-insensitive. Multiple interfaces can be selected if + entered as a cell array of strings. + + xlswrite is a mere wrapper for various scripts which find out what + Excel interface to use (COM, POI, etc) plus code to mimic the other + brand's syntax. For each call to xlswrite such an interface must be + started and possibly an Excel file loaded. When writing to multiple + ranges and/or worksheets in the same Excel file, a speed bonus can + be obtained by invoking those scripts directly with multiple calls + to oct2xls (one for each sheet or range) surrounded by one call to + xlsopen and xlsclose: (xlsopen / octxls / oct2xls / .... / + xlsclose) + + Examples: + + status = xlswrite ('test4.xls', 'arr', 'Third_sheet', 'C3:AB40'); + (which adds the contents of array arr (any type) to range C3:AB40 + in worksheet 'Third_sheet' in file test4.xls and returns a logical + True (= numerical 1) in status if al went well) + + See also: xlsread, oct2xls, xls2oct, xlsopen, xlsclose, xlsfinfo + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Add data in 1D/2D array ARR to worksheet WSH in Excel spreadsheet file +FILENAME + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +xmlwrite + + +# name: +# type: sq_string +# elements: 1 +# length: 211 + -- Function File: NB = xmlwrite (FILENAME, VALUE) + -- Function File: NB = xmlwrite (FD, VALUE, [NAME]) + Write a VALUE into FILENAME (FD) as an XML file. + + The number of elements (NB) or 0 is returned. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Write a VALUE into FILENAME (FD) as an XML file. + + + + + diff --git a/octave_packages/io-1.0.19/fexist.m b/octave_packages/io-1.0.19/fexist.m new file mode 100644 index 0000000..5aa7076 --- /dev/null +++ b/octave_packages/io-1.0.19/fexist.m @@ -0,0 +1,83 @@ +## Copyright (C) 2008 Jaroslav Hajek +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} ex = fexist (file, tspec, aspec) +## Checks whether a file exists. +## @var{file} is the queried file path. +## @var{tspec} is a combination of letters f,d,p,S, corresponding +## to file types: +## @itemize +## @item f: regular file +## @item d: directory +## @item p: named pipe (FIFO special file) +## @item S: socket +## @end itemize +## +## The query is true if the actual file type matches any of +## the specified options. +## +## @var{aspec} is a combination of letters r,w,x, corresponding +## to queried access privileges to the file. The query is true +## if the current user has all the spefied types of access, either +## through "user", "group" or "other" specs. +## +## @seealso{stat, lstat} +## @end deftypefn + +function ex = fexist (file, tspec, aspec) +s = stat (file); +if (isempty (s)) + ex = 0; +else + ex = 1; + if (nargin >= 2 && ! isempty (tspec)) + ft = 0; + for c = tspec + switch (c) + case 'f' + ft |= S_ISREG (s.mode); + case 'd' + ft |= S_ISDIR (s.mode); + case 'p' + ft |= S_ISFIFO (s.mode); + case 'S' + ft |= S_ISSOCK (s.mode); + otherwise + error ("invalid file type spec: %s", c) + endswitch + endfor + ex &= ft; + endif + if (ex && nargin >= 3 && ! isempty (aspec)) + at = 1; + mypid = (s.uid == getuid ()); + mygid = (s.gid == getgid ()); + mstr = s.modestr(2:end); + for c = aspec + switch (c) + case 'r' + at &= (mypid && mstr(1) == c) || (mygid && mstr(4) == c) || mstr(7) == c; + case 'w' + at &= (mypid && mstr(2) == c) || (mygid && mstr(5) == c) || mstr(8) == c; + case 'x' + at &= (mypid && mstr(3) == c) || (mygid && mstr(6) == c) || mstr(9) == c; + otherwise + error ("invalid access type spec: %s", c) + endswitch + endfor + ex &= at; + endif +endif diff --git a/octave_packages/io-1.0.19/getusedrange.m b/octave_packages/io-1.0.19/getusedrange.m new file mode 100644 index 0000000..c2d153b --- /dev/null +++ b/octave_packages/io-1.0.19/getusedrange.m @@ -0,0 +1,659 @@ +## Copyright (C) 2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [ @var{toprow#}, @var{bottomrow#}, @var{leftcol#}, @var{rightcol#} ] = getusedrange (@var{spptr}, @var{shindex#}) +## Find occupied data range in worksheet @var{shindex#} in a spreadsheet +## pointed to in struct @var{spptr} (either MS-Excel or +## OpenOffice_org Calc). +## +## @var{shindex#} must be numeric and is 1-based. @var{spptr} can either +## refer to an MS-Excel spreadsheet (spptr returned by xlsopen) or an +## OpenOffice.org Calc spreadsheet (spptr returned by odsopen). +## None of these inputs are checked! +## +## Be aware that especially for OpenOffice.org Calc (ODS) spreadsheets +## the results can only be obtained by counting all cells in all rows; +## this can be fairly time-consuming. Reliable ods data size results can +## only be obtained using UNO interface. +## For the ActiveX (COM) interface the underlying Visual Basic call relies +## on cached range values and counts empty cells with only formatting too, +## so COM returns only approximate (but then usually too big) range values. +## +## Examples: +## +## @example +## [trow, brow, lcol, rcol] = getusedrange (ods2, 3); +## (which returns the outermost row & column numbers of the rectangle +## enveloping the occupied cells in the third sheet of an OpenOffice_org +## Calc spreadsheet pointedto in struct ods2) +## @end example +## +## @example +## [trow, brow, lcol, rcol] = getusedrange (xls3, 3); +## (which returns the outermost row & column numbers of the rectangle +## enveloping the occupied cells in the third sheet of an Excel +## spreadsheet pointed to in struct xls3) +## @end example +## +## @seealso {xlsopen, xlsclose, odsopen, odsclose, xlsfinfo, odsfinfo} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2010-03-18 (First usable version) for ODS (java/OTK) +## Updates: +## 2010-03-20 Added Excel support (Java/POI) +## 2010-05-23 Added in support for jOpenDocument ODS +## 2010-05-31 Fixed bugs in getusedrange_jod.m +## 2010-08-24 Added support for odfdom 0.8.6 (ODF Toolkit) +## 2010-08-27 Added checks for input arguments +## '' Indentation changed from tab to doublespace +## 2010-10-07 Added COM support (at last!) +## 2011-05-06 Experimental support for Java/UNO bridge +## 2011-06-13 OpenXLS support added +## 2011-09-08 Style & layout updates +## 2012-01-26 Fixed "seealso" help string +## 2012-06-08 Replaced tabs by double space +## '' Added COM and OXS to message about supported interfaces +## +## Last subfunc update: 2012-06-08 (OTK) + +function [ trow, lrow, lcol, rcol ] = getusedrange (spptr, ii) + + # Some checks + if ~isstruct (spptr), error ("Illegal spreadsheet pointer argument"); endif + + if (strcmp (spptr.xtype, 'OTK')) + [ trow, lrow, lcol, rcol ] = getusedrange_otk (spptr, ii); + elseif (strcmp (spptr.xtype, 'JOD')) + [ trow, lrow, lcol, rcol ] = getusedrange_jod (spptr, ii); + elseif (strcmp (spptr.xtype, 'UNO')) + [ trow, lrow, lcol, rcol ] = getusedrange_uno (spptr, ii); + elseif (strcmp (spptr.xtype, 'COM')) + [ trow, lrow, lcol, rcol ] = getusedrange_com (spptr, ii); + elseif (strcmp (spptr.xtype, 'POI')) + [ trow, lrow, lcol, rcol ] = getusedrange_poi (spptr, ii); + elseif (strcmp (spptr.xtype, 'JXL')) + [ trow, lrow, lcol, rcol ] = getusedrange_jxl (spptr, ii); + elseif (strcmp (spptr.xtype, 'OXS')) + [ trow, lrow, lcol, rcol ] = getusedrange_oxs (spptr, ii); + else + error ("Only OTK, JOD, COM, POI, JXL and OXS interface implemented"); + endif + +endfunction + + +## Copyright (C) 2010,2011,2012 Philip Nienhuis, pr.nienhuis -at- users.sf.net +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## getusedrange_otk - get used range from ODS spreadsheet using ODF Toolkit + +## Author: Philip Nienhuis +## Created: 2010-03-18 (First usable version) +## Updates: +## 2010-08-24 Support for odfdom (ODF Toolkit) 0.8.6 checked; we still need +## => TableTable API because 0.8.6 is fooled by empty lowermost +## filler rows comprising number-rows-repeated table attribute :-( +## '' Indentation changed from tab to double space +## 2010-11-13 Catched jOpenDocument bug (1.2bx) where string cells have no office:value-type +## attrib set (by JOD). Somehow OTK is more robust as it catches these cells; +## Currently this fix is just commented. +## 2011-06-06 Fixed wrong if clause for finding last filler cells (L.160 & L.176) +## 2011-09-12 Support for odfdom-0.8.7 added (API change for XPATH) +## 2012-06-08 Support for odsfdom-0.8.8-incubator + +function [ trow, lrow, lcol, rcol ] = getusedrange_otk (ods, ii) + + odfcont = ods.workbook; # Local copy just in case + + if (isfield (ods, 'odfvsn')) + if (strcmp (ods.odfvsn, '0.8.6') || strcmp (ods.odfvsn, '0.7.5')) + xpath = ods.app.getXPath; + else + # API changed in odfdom-0.8.7 + xpath = ods.workbook.getXPath; + endif + else + error ("ODS file ptr struct for OTK interface seems broken."); + endif + + # Create an instance of type NODESET for use in subsequent statement + NODESET = java_get ('javax.xml.xpath.XPathConstants', 'NODESET'); + # Get table-rows in sheet no. wsh. Sheet count = 1-based (!) + str = sprintf ("//table:table[%d]/table:table-row", ii); + sh = xpath.evaluate (str, odfcont, NODESET); + nr_of_trows = sh.getLength(); + + jj = 0; # Table row counter + trow = 0; drows = 0; # Top data row, actual data row range + nrows = 0; reprows = 0; # Scratch counter + rcol = 0; lcol = 1024; # Rightmost and leftmost data column + while jj < nr_of_trows + row = sh.item(jj); + # Check for data rows + rw_char = char (row) (1:min(500, length (char (row)))); + if (findstr ('office:value-type', rw_char) || findstr (' attribute when writing strings + #if (isempty (findstr ('office:value-type', cl_char)) || isempty (findstr (' +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## getusedrange_jod + +## Author: Philip +## Created: 2010-05-25 +## Last updates: +## 2010-05-31 Fixed ignoring table-covered-cells; fixed count of sheets comprising just A1:A1 +## Added option for wsh being a string argument +## 2010-08-12 Little textual adaptations +## 2010-11-13 Catched jOpenDocument bug (1.2bx) where string cells have no office:value-type +## '' attrb set (by JOD). Somehow OTK is more robust as it catches these cells +## 2012-04-09 Fixed rowrepcnt (str2num not applied to tablerow) +## 2012-04-18 Added getUsedRange() method for JOD 1.3x and above + +function [ trow, brow, lcol, rcol ] = getusedrange_jod (ods, wsh) + + # This function works by virtue of sheets in JOD actually being a Java string. + # It works outside of the Java memory/heap space which is an added benefit... + # (Read: this is one big dirty hack...... prone to crash Java on BIG spreadsheets) + + if (isnumeric (wsh)) + sh = char (ods.workbook.getSheet (wsh - 1)); + else + sh = char (ods.workbook.getSheet (wsh)); + endif + + try + # Let's see if we have JOD v. 1.3x. If not, next call fails & we'll fall back to the old hack + sh_rng = char (sh.getUsedRange ()); + if (isempty (sh_rng)) + # Empty sheet + trow = brow = lcol = rcol = 0; + else + # Strip sheet name + sh_rng = sh_rng(length (sh.getName) + 2 : end); + # Get rid of period + sh_rng = strrep (sh_rng, '.', ''); + [~, nr, nc, trow, lcol] = parse_sp_range (sh_rng); + brow = trow + nr - 1; + rcol = lcol + nc - 1; + endif + + catch + # Fall back to the old hack :-( + sh = char (sh); + + # 1. Get table-row pointers + id_trow = strfind (sh, '') - 1; + id_trow = [id_trow id]; + + trow = rcol = 0; + lcol = 1024; brow = 0; + if (~isempty (id)) + # 2. Loop over all table-rows + rowrepcnt = 0; + for irow = 1:length (id_trow)-1 + # Isolate single table-row + tablerow = sh(id_trow(irow):id_trow(irow+1)-1); + # Search table-cells. table-c covers both table-cell & table-covered-cell + id_tcell = strfind (tablerow, '. + +## getusedrange_uno + +## Author: Philip Nienhuis +## Created: 2011-05-06 +## Updates: +## 2011-06-29 Fixed wrong address range inference in case of sheet names containing period(s) +## 2012-03-02 Adapted code to assess nr of range blocks to ';' separator fo LO3.5+ + +function [ srow, erow, scol, ecol ] = getusedrange_uno (ods, ii) + + # Get desired sheet + sheets = ods.workbook.getSheets (); + sh_names = sheets.getElementNames (); + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.sheet.XSpreadsheet'); + sh = sheets.getByName(sh_names(ii)).getObject.queryInterface (unotmp); + + # Prepare cell range query + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.sheet.XCellRangesQuery'); + xRQ = sh.queryInterface (unotmp); + Cellflgs = javaObject ("java.lang.Short", "23"); + ccells = xRQ.queryContentCells (Cellflgs); + + # Get addresses of all blocks containing data + addrs = ccells.getRangeAddressesAsString (); + + # Strip sheet name from addresses. Watch out, in LO3.5 they changed + # the separator from ',' to ';' (without telling me!) + # 1. Get nr of range blocks + nblks = numel (strfind (addrs, sh_names(ii))); + # 2. First try with ',' separator... + adrblks = strsplit (addrs, ','); + if (numel (adrblks) < nblks) + # Apparently we have a ';' separator, so try with semicolon + adrblks = strsplit (addrs, ';'); + endif + if (isempty (adrblks)) + srow = erow = scol = ecol = 0; + return + endif + + # Find leftmost & rightmost columns, and highest and lowest row with data + srow = scol = 1e10; + erow = ecol = 0; + for ii=1:numel (adrblks) + # Check if address contains a sheet name in quotes (happens if name contains a period) + if (int8 (adrblks{ii}(1)) == 39) + # Strip sheet name part + idx = findstr (adrblks{ii}, "'."); + range = adrblks{ii}(idx+2 : end); + else + # Same, but tru strsplit() + range = strsplit (adrblks{ii}, '.'){2}; + endif + [dummy, nrows, ncols, trow, lcol] = parse_sp_range (range); + brow = trow + nrows - 1; + rcol = lcol + ncols - 1; + srow = min (srow, trow); + scol = min (scol, lcol); + erow = max (erow, brow); + ecol = max (ecol, rcol); + endfor + +endfunction + + +## Copyright (C) 2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## getusedrange_com + +## Author: Philip Nienhuis +## Created: 2010-10-07 + +function [ trow, brow, lcol, rcol ] = getusedrange_com (xls, ii) + + sh = xls.workbook.Worksheets (ii); + + # Decipher used range. Beware, UsedRange() returns *cached* rectangle of + # all spreadsheet cells containing *anything*, including just formatting + # (i.e., empty cells are included too). ==> This is an approximation only + allcells = sh.UsedRange; + + # Get top left cell as a Range object + toplftcl = allcells.Columns(1).Rows(1); + + # Count number of rows & cols in virtual range from A1 to top left cell + lcol = sh.Range ("A1", toplftcl).columns.Count; + trow = sh.Range ("A1", toplftcl).rows.Count; + + # Add real occupied rows & cols to obtain end row & col + brow = trow + allcells.rows.Count() - 1; + rcol = lcol + allcells.columns.Count() - 1; + + # Check if there are real data + if ((lcol == rcol) && (trow = brow)) + if (isempty (toplftcl.Value)) + trow = brow = lcol = rcol = 0; + endif + endif + +endfunction + + +## Copyright (C) 2010,2011,2012 Philip Nienhuis, prnienhuis at users.sf.net +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## getusedrange_poi - get range of occupied data cells from Excel using java/POI + +## Author: Philip +## Created: 2010-03-20 + +function [ trow, brow, lcol, rcol ] = getusedrange_poi (xls, ii) + + persistent cblnk; cblnk = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_BLANK'); + + sh = xls.workbook.getSheetAt (ii-1); # Java POI starts counting at 0 + + trow = sh.getFirstRowNum (); # 0-based + brow = sh.getLastRowNum (); # 0-based + # Get column range + lcol = 1048577; # OOXML (xlsx) max. + 1 + rcol = 0; + botrow = brow; + for jj=trow:brow + irow = sh.getRow (jj); + if (~isempty (irow)) + scol = (irow.getFirstCellNum).intValue (); + lcol = min (lcol, scol); + ecol = (irow.getLastCellNum).intValue () - 1; + rcol = max (rcol, ecol); + # Keep track of lowermost non-empty row as getLastRowNum() is unreliable + if ~(irow.getCell(scol).getCellType () == cblnk && irow.getCell(ecol).getCellType () == cblnk) + botrow = jj; + endif + endif + endfor + if (lcol > 1048576) + # Empty sheet + trow = 0; brow = 0; lcol = 0; rcol = 0; + else + brow = min (brow, botrow) + 1; ++trow; ++lcol; ++rcol; # 1-based return values + endif + +endfunction + + +## Copyright (C) 2010,2011,2012 Philip Nienhuis, prnienhuis at users.sf.net +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## getusedrange_jxl - get occupied data cell range from Excel sheet +## using java/JExcelAPI + +## Author: Philip +## Created: 2010-03-20 + +function [ trow, brow, lcol, rcol ] = getusedrange_jxl (xls, wsh) + + persistent emptycell = (java_get ('jxl.CellType', 'EMPTY')).toString (); + + sh = xls.workbook.getSheet (wsh - 1); # JXL sheet count 0-based + + brow = sh.getRows (); + rcol = sh.getColumns (); + + if (brow == 0 || rcol == 0) + # Empty sheet + trow = 0; lcol = 0; brow = 0; rcol = 0; + else + trow = brow + 1; + lcol = rcol + 1; + for ii=0:brow-1 # For loop coz we must check ALL rows for leftmost column + emptyrow = 1; + jj = 0; + while (jj < rcol && emptyrow) # While loop => only til first non-empty cell + cell = sh.getCell (jj, ii); + if ~(strcmp (char (cell.getType ()), emptycell)) + lcol = min (lcol, jj + 1); + emptyrow = 0; + endif + ++jj; + endwhile + if ~(emptyrow) trow = min (trow, ii + 1); endif + endfor + endif + +endfunction + + +## Copyright (C) 2010,2011,2012 Philip Nienhuis, +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## getusedrange_oxs + +## Author: Philip +## Created: 2011-06-13 +## Updates: +## 2011-06-29 try-catch to be able to skip non-data (e.g., graph) sheets + +function [ trow, brow, lcol, rcol ] = getusedrange_oxs (xls, wsh) + + sh = xls.workbook.getWorkSheet (wsh - 1); + try + # Intriguing: sh.getFirst<> is off by one, sh.getLast<> = OK.... 8-Z + trow = sh.getFirstRow () + 1; + brow = sh.getLastRow (); + lcol = sh.getFirstCol () + 1; + rcol = sh.getLastCol (); + catch + # Might be an empty sheet + trow = brow = lcol = rcol = 0; + end_try_catch + # Check for empty sheet + if ((trow > brow) || (lcol > rcol)), trow = brow = lcol = rcol = 0; endif + +endfunction diff --git a/octave_packages/io-1.0.19/io_ods_testscript.m b/octave_packages/io-1.0.19/io_ods_testscript.m new file mode 100644 index 0000000..6a308f6 --- /dev/null +++ b/octave_packages/io-1.0.19/io_ods_testscript.m @@ -0,0 +1,121 @@ +## Copyright (C) 2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## (Internal function) Check proper operation of ODS spreadsheet scripts. +## Before running, a character variable 'intf' should be initialized with +## a value of 'otk', 'jod', or 'uno'. + +## Author: Philip Nienhuis +## Created: 2012-02-25 +## Updates: + + +printf ("\nTesting .ods interface %s ...\n", intf); + +## 1. Initialize test arrays +printf ("\n 1. Initialize arrays.\n"); +arr1 = [ 1 2; 3 4.5]; +arr2 = {'r1c1', '=c2+d2'; '', 'r2c2'; true, -83.4}; +opts = struct ("formulas_as_text", 0); + +## 2. Insert empty sheet +printf ("\n 2. Insert first empty sheet.\n"); +odswrite ('io-test.ods', {''}, 'EmptySheet', 'b4', intf); + +## 3. Add data to test sheet +printf ("\n 3. Add data to test sheet.\n"); +odswrite ('io-test.ods', arr1, 'Testsheet', 'c2:d3', intf); +odswrite ('io-test.ods', arr2, 'Testsheet', 'd4:z20', intf); + +## 4. Insert another sheet +printf ("\n 4. Add another sheet with just one number in A1.\n"); +odswrite ('io-test.ods', [1], 'JustOne', 'A1', intf); + +## 5. Get sheet info & find sheet with data and data range +printf ("\n 5. Explore sheet info.\n"); +[~, shts] = odsfinfo ('io-test.ods', intf); +shnr = strmatch ('Testsheet', shts(:, 1)); # Note case! +crange = shts{shnr, 2}; + +## 6. Read data back +printf ("\n 6. Read data back.\n"); +[num, txt, raw, lims] = odsread ('io-test.ods', shnr, crange, intf); + +## 7. Here come the tests, part 1 +printf ("\n 7. Tests part 1 (basic I/O):\n"); +try + printf (" ...Numeric array... "); + assert (num(1:2, 1:3), [1, 2, NaN; 3, 4.5, NaN], 1e-10); + assert (num(4:5, 1:3), [NaN, NaN, NaN; NaN, 1, -83.4], 1e-10); + assert (num(3, 1:2), [NaN, NaN], 1e-10); + # Just check if it's numeric, the value depends too much on cached results + assert (isnumeric (num(3,3)), true); + printf ("matches.\n"); +catch + printf ("Hmmm.... error, see 'num'\n"); + keyboard +end_try_catch +try + printf (" ...Cellstr array... "); + assert (txt{1, 1}, 'r1c1'); + assert (txt{2, 2}, 'r2c2'); + printf ("matches.\n"); +catch + printf ("Hmmm.... error, see 'txt'\n"); + keyboard +end_try_catch +try + printf (" ...Boolean... "); + assert (islogical (raw{5, 2}), true); # Fails on JOD + printf ("recovered.\n"); +catch + if (isnumeric (raw{5, 2})) + printf ("recovered as numeric '1' rather than logical TRUE\n"); + else + printf ("Hmmm.... error, see 'raw'\n"); + keyboard + endif +end_try_catch + +## Check if formulas_as_text works: +printf ("\n 8. Repeat reading, now return formulas as text\n"); +opts.formulas_as_text = 1; +ods = odsopen ('io-test.ods', 0, intf); +raw = ods2oct (ods, shnr, crange, opts); +ods = odsclose (ods); +clear ods; + +## 9. Here come the tests, part 2. Fails on COM +printf ("\n 9. Tests part 2 (read back formula):\n"); + +try + # Just check if it contains any string + assert ( (ischar (raw{3, 3}) && ~isempty (raw(3, 3))), true); + printf (" ...OK, formula recovered ('%s').\n", raw{3, 3}); +catch + printf ("Hmmm.... error, see 'raw(3, 3)'"); + if (isnumeric (raw{3, 3})) + printf (" (equals %f, should be a string like '=c2+d2')\n", raw{3, 3}); + else + printf ("\n"); + keyboard + endif +end_try_catch + +## 10. Clean up +printf ("\n10. Cleaning up....."); +delete 'io-test.ods'; +clear arr1 arr2 ods num txt raw lims opts shnr shts crange; +printf (" OK\n"); diff --git a/octave_packages/io-1.0.19/io_xls_testscript.m b/octave_packages/io-1.0.19/io_xls_testscript.m new file mode 100644 index 0000000..b7de6f1 --- /dev/null +++ b/octave_packages/io-1.0.19/io_xls_testscript.m @@ -0,0 +1,124 @@ +## Copyright (C) 2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## (Internal function) Check proper operation of XLS spreadsheet scripts. +## Before running, a character variable 'intf' should be initialized with +## a value of 'com', 'poi', 'jxl', 'oxs', or 'uno'. + +## Author: Philip Nienhuis +## Created: 2012-02-25 +## Updates: +## 2012-06-06 Adapted to COM implementation for "formulas_as_text" option + + +printf ("\nTesting .xls interface %s ...\n", intf); + +if (strcmp (lower (intf), 'oxs')); + printf ("OXS interface has no write support enabled - writing is done with POI.\n"); + intf2 = 'com'; +else; + intf2 = intf; +endif + +## 1. Initialize test arrays +printf ("\n 1. Initialize arrays.\n"); +arr1 = [ 1 2; 3 4.5]; +arr2 = {'r1c1', '=c2+d2'; '', 'r2c2'; true, -83.4}; +opts = struct ("formulas_as_text", 0); + +## 2. Insert empty sheet +printf ("\n 2. Insert first empty sheet.\n"); +xlswrite ('io-test.xls', {''}, 'EmptySheet', 'b4', intf2); + +## 3. Add data to test sheet +printf ("\n 3. Add data to test sheet.\n"); +xlswrite ('io-test.xls', arr1, 'Testsheet', 'c2:d3', intf2); +xlswrite ('io-test.xls', arr2, 'Testsheet', 'd4:z20', intf2); + +## 4. Insert another sheet +printf ("\n 4. Add another sheet with just one number in A1.\n"); +xlswrite ('io-test.xls', [1], 'JustOne', 'A1', intf2); + +## 5. Get sheet info & find sheet with data and data range +printf ("\n 5. Explore sheet info.\n"); +[~, shts] = xlsfinfo ('io-test.xls', intf); +shnr = strmatch ('Testsheet', shts(:, 1)); # Note case! +crange = shts{shnr, 2}; + +## 6. Read data back +printf ("\n 6. Read data back.\n"); +[num, txt, raw, lims] = xlsread ('io-test.xls', shnr, crange, intf); + +## 7. Here come the tests, part 1 +printf ("\n 7. Tests part 1 (basic I/O):\n"); +try + printf (" ...Numeric array... "); + assert (num(1:2, 1:3), [1, 2, NaN; 3, 4.5, NaN], 1e-10); + assert (num(4:5, 1:3), [NaN, NaN, NaN; NaN, 1, -83.4], 1e-10); + assert (num(3, 1:2), [NaN, NaN], 1e-10); + # Just check if it's numeric, the value depends too much on cached results + assert (isnumeric (num(3,3)), true); + printf ("matches...\n"); +catch + printf ("Hmmm.... error, see 'num'\n"); keyboard +end_try_catch +try + printf (" ...Cellstr array... "); + assert (txt{1, 1}, 'r1c1'); + assert (txt{2, 2}, 'r2c2'); + printf ("matches...\n"); +catch + printf ("Hmmm.... error, see 'txt'\n"); keyboard +end_try_catch +try + printf (" ...Boolean... "); + assert (islogical (raw{5, 2}), true); # Fails on COM + printf ("recovered...\n"); +catch + if (isnumeric (raw{5, 2})) + printf ("returned as numeric '1' rather than logical TRUE.\n"); + else + printf ("Hmmm.... error, see 'raw{5, 2}'\n"); keyboard + endif +end_try_catch + +## Check if "formulas_as_text" option works: +printf ("\n 8. Repeat reading, now return formulas as text\n"); +opts.formulas_as_text = 1; +xls = xlsopen ('io-test.xls', 0, intf); +raw = xls2oct (xls, shnr, crange, opts); +xls = xlsclose (xls); + +## 9. Here come the tests, part 2. +printf ("\n 9. Tests part 2 (read back formula):\n"); + +try + # Just check if it contains any string + assert ( (ischar (raw{3, 3}) && ~isempty (raw(3, 3)) && raw{3, 3}(1) == "="), true); + printf (" ...OK, formula recovered ('%s').\n", raw{3, 3}); +catch + printf ("Hmmm.... error, see 'raw(3, 3)'"); + if (isnumeric (raw{3, 3})) + printf (" (equals %f, should be a string like '=c2+d2')\n", raw{3, 3}); + else + printf ("\n"); + endif +end_try_catch + +## 10. Clean up +printf ("\n10. Cleaning up....."); +delete 'io-test.xls'; +clear arr1 arr2 xls num txt raw lims opts shnr shts crange intf2; +printf (" OK\n"); diff --git a/octave_packages/io-1.0.19/object2json.m b/octave_packages/io-1.0.19/object2json.m new file mode 100644 index 0000000..f0bdb87 --- /dev/null +++ b/octave_packages/io-1.0.19/object2json.m @@ -0,0 +1,189 @@ +%% Copyright (C) 2010 Torre Herrera, Daniel de +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% Returns a valid json string that will describe object; the string will +%% be in a compact form (no spaces or line breaks). +%% +%% It will map simple octave values this way: +%% function handles: string with the name of the function +%% double (numbers): depends: +%% If it's real it will map to a string representing that number +%% If it's complex it will map to an object with the next properties: +%% real: real part of the number +%% imag: imaginary part of the number +%% char: A string enclosed by double quotes representing that character +%% And will map more complex octave values this other way: +%% struct: an object with properties equal to the struct's field names +%% and value equal to the json counterpart of that field +%% cell: it will be mapped depending on the value of the cell (for +%% example {i} will be mapped to an object with real=0 and imag=1) +%% vectors or cell arrays: it will map them to a corresponding js +%% array (same size) with the values transformed to their json +%% counterpart (Note: that in javascript all arrays are like octave's +%% cells ,i.e. they can store different type and size variables) +%% strings or char vectors: they will be mapped to the same string +%% enclosed by double quotes +%% Other octave values will be mapped to a string enclosed by double +%% quotes with the value that the class() function returns +%% It can handle escape sequences and special chars automatically. +%% If they're valid in JSON it will keep them if not they'll be +%% escaped so they can become valid + +%% object2json.m +%% Created: 2010-12-06 +%% Updates: +%% 2011-01-23 Added support for especial chars and escaped sequences +%% 2011-04-01 Fixed error: Column vectors not working correctly +%% 2011-09-08 (Philip Nienhuis) layout & style changes cf. Octave coding style + +function json = object2json (object) + + s = size (object); + if (all (s==1)) + % It's not a vector so we must check how to map it + % Depending on the class of the object we must do one or another thing + switch (class (object)) + case 'function_handle' + % For a function handle we will only print the name + fun = functions (object); + json = [ '"', fun.function, '"' ]; + + case 'struct' + fields = fieldnames (object); + results = cellfun (@object2json, struct2cell (object), "UniformOutput", false); + json = '{'; + if (numel (fields) > 1) + sep = ','; + else + sep = ''; + endif + for (tmp = 1:numel (fields)) + json = [ json, '"', fields{tmp}, '":', results{tmp}, sep ]; + if(tmp >= numel (fields)-1) + sep = ''; + endif + endfor + json(end+1) = '}'; + + case 'cell' + % We dereference the cell and use it as a new value + json = object2json (object{1}); + + case 'double' + if (isreal (object)) + json = num2str (object); + else + if (iscomplex (object)) + json = [ '{"real":', num2str(real(object)), ',"imag":' , num2str(imag(object)), '}' ]; + endif + endif + + case 'char' + % Here we handle a single char + % JSON only admits the next escape sequences: + % \", \\, \/, \b, \f, \n, \r, \t and \u four-hex-digits + % so we must be sure that every other sequence gets replaced + object = replace_non_JSON_escapes (object); + json = [ '"', object, '"' ]; + + otherwise + % We don't know what is it so we'll put the class name + json = [ '"', class(object), '"' ]; + endswitch + + else + % It's a vector so it maps to an array + sep = ''; + if (numel (s) > 2) + json = '['; + for (tmp=1:s(1)) + json = [ json, sep, object2json(reshape(object(tmp, :), s(2:end))) ]; + sep = ','; + endfor + json(end+1) = ']'; + + else + % We can have three cases here: + % Object is a row -> array with all the elements + % Object is a column -> each element is an array in it's own + % Object is a 2D matrix -> separate each row + if (s(1) == 1) + % Object is a row + if (ischar (object)) + % If it's a row of chars we will take it as a string + % JSON only admits the next escape sequences: + % \", \\, \/, \b, \f, \n, \r, \t and \u four-hex-digits + % so we must be sure that every other sequence gets replaced + object = replace_non_JSON_escapes (object); + json = [ '"', object, '"']; + + else + json = '['; + for (tmp=1:s(2)) + json = [ json, sep, object2json(object(1, tmp)) ]; + sep = ','; + endfor + json(end+1) = ']'; + endif + + elseif (s(2) == 1) + % Object is a column + json = '['; + for (tmp=1:s(1)) + json = [ json, sep, '[', object2json(object(tmp, 1)), ']' ]; + sep = ','; + endfor + json(end+1) = ']'; + + else + % Object is a 2D matrix + json = '['; + for (tmp=1:s(1)) + json = [ json, sep, object2json(object(tmp, :)) ]; + sep = ','; + endfor + json(end+1) = ']'; + + endif + endif + endif + +endfunction + + +% JSON only admits the next escape sequences: +% \", \\, \/, \b, \f, \n, \r, \t and \u four-hex-digits +% This function replace every escaped sequence that isn't on that list +% with a compatible version +% Note that this function uses typeinfo so it may need to be updated +% with each octave release + +function object = replace_non_JSON_escapes (object) + + if (strcmp (typeinfo (object), 'string')) + % It's a double quoted string so newlines and other chars need + % to be converted back into escape sequences before anything + object = undo_string_escapes (object); + endif + % This first regex handles double quotes and slashes that are not + % after a backslash and thus aren't escaped + object = regexprep (object, '(? +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [ @var{ods}, @var{rstatus} ] = oct2ods (@var{arr}, @var{ods}) +## @deftypefnx {Function File} [ @var{ods}, @var{rstatus} ] = oct2ods (@var{arr}, @var{ods}, @var{wsh}) +## @deftypefnx {Function File} [ @var{ods}, @var{rstatus} ] = oct2ods (@var{arr}, @var{ods}, @var{wsh}, @var{range}) +## @deftypefnx {Function File} [ @var{ods}, @var{rstatus} ] = oct2ods (@var{arr}, @var{ods}, @var{wsh}, @var{range}, @var{options}) +## +## Transfer data to an OpenOffice_org Calc spreadsheet previously opened +## by odsopen(). +## +## Data in 1D/2D array @var{arr} are transferred into a cell range +## @var{range} in sheet @var{wsh}. @var{ods} must have been made earlier +## by odsopen(). Return argument @var{ods} should be the same as supplied +## argument @var{ods} and is updated by oct2ods. A subsequent call to +## odsclose is needed to write the updated spreadsheet to disk (and +## -if needed- close the Java invocation holding the file pointer). +## +## @var{arr} can be any 1D or 2D array containing numerical or character +## data (cellstr) except complex. Mixed numeric/text arrays can only be +## cell arrays. +## +## @var{ods} must be a valid pointer struct created earlier by odsopen. +## +## @var{wsh} can be a number (sheet name) or string (sheet number). +## In case of a yet non-existing Calc file, the first sheet will be +## used & named according to @var{wsh}. +## In case of existing files, some checks are made for existing sheet +## names or numbers. +## When new sheets are to be added to the Calc file, they are +## inserted to the right of all existing sheets. The pointer to the +## "active" sheet (shown when Calc opens the file) remains untouched. +## +## If @var{range} omitted, the top left cell where the data will be put +## is supposed to be 'A1'; only a top left cell address can be specified +## as well. In these cases the actual range to be used is determined by +## the size of @var{arr}. +## Be aware that large data array sizes may exhaust the java shared +## memory space. For larger arrays, appropriate memory settings are +## needed in the file java.opts; then the maximum array size for the +## java-based spreadsheet options can be in the order of perhaps 10^6 +## elements. +## +## Optional argument @var{options}, a structure, can be used to specify +## various write modes. +## Currently the only option field is "formulas_as_text", which -if set +## to 1 or TRUE- specifies that formula strings (i.e., text strings +## starting with "=" and ending in a ")" ) should be entered as litteral +## text strings rather than as spreadsheet formulas (the latter is the +## default). As jOpenDocument doesn't support formula I/O at all yet, +## this option is ignored for the JOD interface. +## +## Data are added to the sheet, ignoring other data already present; +## existing data in the range to be used will be overwritten. +## +## If @var{range} contains merged cells, also the elements of @var{arr} +## not corresponding to the top or left Calc cells of those merged cells +## will be written, however they won't be shown until in Calc the merge is +## undone. +## +## Examples: +## +## @example +## [ods, status] = ods2oct (arr, ods, 'Newsheet1', 'AA31:GH165'); +## Write array arr into sheet Newsheet1 with upperleft cell at AA31 +## @end example +## +## @example +## [ods, status] = ods2oct (@{'String'@}, ods, 'Oldsheet3', 'B15:B15'); +## Put a character string into cell B15 in sheet Oldsheet3 +## @end example +## +## @seealso {ods2oct, odsopen, odsclose, odsread, odswrite, odsfinfo} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-12-13 +## Updates: +## 2010-01-15 Updated texinfo header +## 2010-03-14 Updated help text (a.o. on java memory usage) +## 2010-03-25 see oct2jotk2ods +## 2010-03-28 Added basic support for ofdom v.0.8. Everything works except adding cols/rows +## 2010-03-29 Removed odfdom-0.8 support, it's simply too buggy :-( Added a warning instead +## 2010-06-01 Almost complete support for upcoming jOpenDocument 1.2b4. 1.2b3 still lacks a bit +## 2010-07-05 Added example for writng character strings +## 2010-07-29 Added option for entering / reading back spreadsheet formulas +## 2010-08-14 Moved check on input cell array to main function +## 2010-08-15 Texinfo header edits +## 2010-08-16 Added check on presence of output argument +## 2010-08-23 Added check on validity of ods file ptr +## '' Experimental support for odfdom 0.8.6 (in separate subfunc, to be integrated later) +## 2010-08-25 Improved help text (java memory, ranges) +## 2010-10-27 Improved file change tracking tru ods.changed +## 2010-11-12 Better input argument checks +## 2010-11-13 Reset ods.limits when read was successful +## 2010-11-13 Added check for 2-D input array +## 2011-03-23 First try of odfdom 0.8.7 +## 2011-05-15 Experimental UNO support added +## 2011-11-18 Fixed bug in test for range parameter being character string +## 2012-01-26 Fixed "seealso" help string +## 2012-02-20 Fixed range parameter to be default empty string rather than empty numeral +## 2012-02-27 More range arg fixes +## 2012-03-07 Updated texinfo help text +## 2012-06-08 Support for odfdom-incubator-0.8.8 +## '' Tabs replaced by double space +## +## Last update of subfunctions below: 2012-06-08 + +function [ ods, rstatus ] = oct2ods (c_arr, ods, wsh=1, crange='', spsh_opts=[]) + + if (nargin < 2) error ("oct2xls needs a minimum of 2 arguments."); endif + + # Check if input array is cell + if (isempty (c_arr)) + warning ("Request to write empty matrix - ignored."); + rstatus = 1; + return; + elseif (isnumeric (c_arr)) + c_arr = num2cell (c_arr); + elseif (ischar(c_arr)) + c_arr = {c_arr}; + printf ("(oct2ods: input character array converted to 1x1 cell)\n"); + elseif (~iscell (c_arr)) + error ("oct2ods: input array neither cell nor numeric array"); + endif + if (ndims (c_arr) > 2), error ("Only 2-dimensional arrays can be written to spreadsheet"); endif + + # Check ods file pointer struct + test1 = ~isfield (ods, "xtype"); + test1 = test1 || ~isfield (ods, "workbook"); + test1 = test1 || isempty (ods.workbook); + test1 = test1 || isempty (ods.app); + if test1 + error ("Arg #2: Invalid ods file pointer struct"); + endif + + # Check worksheet ptr + if (~(ischar (wsh) || isnumeric (wsh))), error ("Integer (index) or text (wsh name) expected for arg # 3"); endif + + # Check range + if (~isempty (crange) && ~ischar (crange)) + error ("Character string (range) expected for arg # 4"); + elseif (isempty (crange)) + crange = ''; + endif + + # Various options + if (isempty (spsh_opts)) + spsh_opts.formulas_as_text = 0; + # other options to be implemented here + elseif (isstruct (spsh_opts)) + if (~isfield (spsh_opts, 'formulas_as_text')), spsh_opts.formulas_as_text = 0; endif + # other options to be implemented here + else + error ("Structure expected for arg # 5"); + endif + + if (nargout < 1) printf ("Warning: no output spreadsheet file pointer specified.\n"); endif + + if (strcmp (ods.xtype, 'OTK')) + # Write ods file tru Java & ODF toolkit. + switch ods.odfvsn + case "0.7.5" + [ ods, rstatus ] = oct2jotk2ods (c_arr, ods, wsh, crange, spsh_opts); + case {"0.8.6", "0.8.7", "0.8.8"} + [ ods, rstatus ] = oct3jotk2ods (c_arr, ods, wsh, crange, spsh_opts); + otherwise + error ("Unsupported odfdom version"); + endswitch + + elseif (strcmp (ods.xtype, 'JOD')) + # Write ods file tru Java & jOpenDocument. API still leaves lots to be wished... + [ ods, rstatus ] = oct2jod2ods (c_arr, ods, wsh, crange); + + elseif (strcmp (ods.xtype, 'UNO')) + # Write ods file tru Java & UNO bridge (OpenOffice.org & clones) + [ ods, rstatus ] = oct2uno2ods (c_arr, ods, wsh, crange, spsh_opts); + +# elseif + # ---- < Other interfaces here > + + else + error (sprintf ("ods2oct: unknown OpenOffice.org .ods interface - %s.", ods.xtype)); + endif + + if (rstatus), ods.limits = []; endif + +endfunction + + +#============================================================================= + +## Copyright (C) 2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## oct2jotk2ods +## write data array to an ODS spreadsheet using Java & ODFtoolkit 0.7.5 + +## I'm truly sorry that oct2jotk2ods is so ridiculously complex, +## and therefore so slow; but there's a good reason for that: +## Writing to ODS is already fairly complicated when just making a +## new sheet ("table"); but it really becomes a headache when +## writing to an existing sheet. In that case one should beware of +## table-number-columns-repeated, table-number-rows-repeated, +## covered (merged) cells, incomplete tables and rows, etc. +## ODF toolkit v. 0.7.5 does nothing to hide this from the user; +## you may sort it out all by yourself. + +## Author: Philip Nienhuis +## Created: 2010-01-07 +## Updates: +## 2010-01-14 (finally seems to work OK) +## 2010-03-08 Some comment lines adapted +## 2010-03-25 Try-catch added f. unpatched-for-booleans java-1.2.6 / 1.2.7 package +## 2010-04-11 Changed all references to "cell" to "scell" to avoid reserved keyword +## '' Small bugfix for cases with empty left columns (wrong cell reference) +## 2010-04-13 Fixed bug with stray cell copies beyond added data rectangle +## 2010-07-29 Added formula input support (based on xls patch by Benjamin Lindner) +## 2010-08-01 Added try-catch around formula input +## '' Changed range arg to also allow just topleft cell +## 2010-08-03 Moved range checks and type array parsing to separate functions +## 2010-08-13 Fixed empty Sheet1 in case of new spreadsheets, fix input text sheet name +## 2010-10-27 Improved file change tracking tru ods.changed +## 2010-11-12 Improved file change tracking tru ods.changed + +function [ ods, rstatus ] = oct2jotk2ods (c_arr, ods, wsh, crange, spsh_opts) + + persistent ctype; + if (isempty (ctype)) + # Number, Boolean, String, Formula, Empty, Date, Time (last 2 are ignored) + ctype = [1, 2, 3, 4, 5, 6, 7]; + endif + + rstatus = 0; f_errs = 0; + + # Get some basic spreadsheet data from the pointer using ODFtoolkit + odfcont = ods.workbook; + xpath = ods.app.getXPath (); + offsprdsh = ods.app.getContentRoot(); + autostyles = odfcont.getOrCreateAutomaticStyles(); + officestyles = ods.app.getOrCreateDocumentStyles(); + + # Create an instance of type NODESET for use in subsequent statements + NODESET = java_get ('javax.xml.xpath.XPathConstants', 'NODESET'); + + # Parse sheets ("tables") from ODS file + sheets = xpath.evaluate ("//table:table", odfcont, NODESET); + nr_of_sheets = sheets.getLength (); + newsh = 0; # Assume existing sheet + if isempty (wsh) wsh = 1; endif + if (~isnumeric (wsh)) # Sheet name specified + # Search in sheet names, match sheet name to sheet number. + # Beware, 0-based index, 1-based count! + ii = 0; + while (++ii <= nr_of_sheets && ischar (wsh)) + # Look in first part of the sheet nodeset + sh_name = sheets.item(ii-1).getTableNameAttribute (); + if (strcmp (sh_name, wsh)) + # Convert local copy of wsh into a number (pointer) + wsh = ii - 1; + endif + endwhile + if (ischar (wsh) && nr_of_sheets < 256) newsh = 1; endif + else # Sheet index specified + if ((ods.changed > 2) || (wsh > nr_of_sheets && wsh < 256)) # Max nr of sheets = 256 + # Create a new sheet + newsh = 1; + elseif (wsh <=nr_of_sheets && wsh > 0) + # Existing sheet. Count = 1-based, index = 0-based + --wsh; sh = sheets.item(wsh); + printf ("Writing to sheet %s\n", sh.getTableNameAttribute()); + else + error ("oct2ods: illegal sheet number."); + endif + endif + +# Check size of data array & range / capacity of worksheet & prepare vars + [nr, nc] = size (c_arr); + [topleft, nrows, ncols, trow, lcol] = spsh_chkrange (crange, nr, nc, ods.xtype, ods.filename); + --trow; --lcol; # Zero-based row # & col # + if (nrows < nr || ncols < nc) + warning ("Array truncated to fit in range"); + c_arr = c_arr(1:nrows, 1:ncols); + endif + +# Parse data array, setup typarr and throw out NaNs to speed up writing; + typearr = spsh_prstype (c_arr, nrows, ncols, ctype, spsh_opts, 0); + if ~(spsh_opts.formulas_as_text) + # Find formulas (designated by a string starting with "=" and ending in ")") + fptr = cellfun (@(x) ischar (x) && strncmp (x, "=", 1) && strncmp (x(end:end), ")", 1), c_arr); + typearr(fptr) = ctype(4); # FORMULA + endif + +# Prepare worksheet for writing. If needed create new sheet + if (newsh) + if (ods.changed > 2) + # New spreadsheet. Prepare to use the default 1x1 first sheet. + sh = sheets.item(0); + else + # Other sheets exist, create a new sheet. First the basics + sh = java_new ('org.odftoolkit.odfdom.doc.table.OdfTable', odfcont); + # Append sheet to spreadsheet ( contentRoot) + offsprdsh.appendChild (sh); + # Rebuild sheets nodes + sheets = xpath.evaluate ("//table:table", odfcont, NODESET); + endif + + # Sheet name + if (isnumeric (wsh)) + # Give sheet a name + str = sprintf ("Sheet%d", wsh); + sh.setTableNameAttribute (str); + else + # Assign name to sheet and change wsh into numeric pointer + sh.setTableNameAttribute (wsh); + wsh = sheets.getLength () - 1; + endif + # Fixup wsh pointer in case of new spreadsheet + if (ods.changed > 2) wsh = 0; endif + + # Add table-column entry for style etc + col = sh.addTableColumn (); + col.setTableDefaultCellStyleNameAttribute ("Default"); + col.setTableNumberColumnsRepeatedAttribute (lcol + ncols + 1); + col.setTableStyleNameAttribute ("co1"); + + # Build up the complete row & cell structure to cover the data array. + # This will speed up processing later + + # 1. Build empty table row template + row = java_new ('org.odftoolkit.odfdom.doc.table.OdfTableRow', odfcont); + # Create an empty tablecell & append it to the row + scell = java_new ('org.odftoolkit.odfdom.doc.table.OdfTableCell', odfcont); + scell = row.appendCell (scell); + scell.setTableNumberColumnsRepeatedAttribute (1024); + # 2. If needed add empty filler row above the data rows & if needed add repeat count + if (trow > 0) + sh.appendRow (row); + if (trow > 1) row.setTableNumberRowsRepeatedAttribute (trow); endif + endif + # 3. Add data rows; first one serves as a template + drow = java_new ('org.odftoolkit.odfdom.doc.table.OdfTableRow', odfcont); + if (lcol > 0) + scell = java_new ('org.odftoolkit.odfdom.doc.table.OdfTableCell', odfcont); + drow.appendCell (scell); + if (lcol > 1) scell.setTableNumberColumnsRepeatedAttribute (lcol); endif + endif + # 4. Add data cell placeholders + scell = java_new ('org.odftoolkit.odfdom.doc.table.OdfTableCell', odfcont); + drow.appendCell (scell); + for jj=2:ncols + dcell = scell.cloneNode (1); # Deep copy + drow.appendCell (dcell); + endfor + # 5. Last cell is remaining column counter + rest = max (1024 - lcol - ncols); + if (rest) + dcell = scell.cloneNode (1); # Deep copy + drow.appendCell (dcell); + if (rest > 1) dcell.setTableNumberColumnsRepeatedAttribute (rest); endif + endif + # Only now add drow as otherwise for each cell an empty table-column is + # inserted above the rows (odftoolkit bug?) + sh.appendRow (drow); + if (ods.changed > 2) + # In case of a completely new spreadsheet, delete the first initial 1-cell row + # But check if it *is* a row... + try + sh.removeChild (drow.getPreviousRow ()); + catch + # Nothing. Apparently there was only the just appended row. + end_try_catch + endif + # 6. Row template ready. Copy row template down to cover future array + for ii=2:nrows + nrow = drow.cloneNode (1); # Deep copy + sh.appendRow (nrow); + endfor + ods.changed = min (ods.changed, 2); # Keep 2 for new spshsht, 1 for existing + changed + + else + # Existing sheet. We must be prepared for all situations, incomplete rows, + # number-rows/columns-repeated, merged (spanning) cells, you name it. + # First explore row buildup of existing sheet using an XPath + sh = sheets.item(wsh); # 0 - based + str = sprintf ("//table:table[%d]/table:table-row", wsh + 1); # 1 - based + trows = xpath.evaluate (str, odfcont, NODESET); + nr_of_trows = trows.getLength(); # Nr. of existing table-rows, not data rows! + + # For the first rows we do some preprocessing here. Similar stuff for cells + # i.e. table-cells (columns) is done in the loops below. + # Make sure the upper data array row doesn't end up in a nr-rows-repeated row + + # Provisionally! set start table-row in case "while" & "if" (split) are skipped + drow = trows.item(0); + rowcnt = 0; trowcnt = 0; # Spreadsheet/ table-rows, resp; + while (rowcnt < trow && trowcnt < nr_of_trows) + # Count rows & table-rows UNTIL we reach trow + ++trowcnt; # Nr of table-rows + row = drow; + drow = row.getNextSibling (); + repcnt = row.getTableNumberRowsRepeatedAttribute(); + rowcnt = rowcnt + repcnt; # Nr of spreadsheet rows + endwhile + rsplit = rowcnt - trow; + if (rsplit > 0) + # Apparently a nr-rows-repeated top table-row must be split, as the + # first data row seems to be projected in it (1st while condition above!) + row.removeAttribute ('table:number-rows-repeated'); + row.getCellAt (0).removeAttribute ('table:number-columns-repeated'); + nrow = row.cloneNode (1); + drow = nrow; # Future upper data array row + if (repcnt > 1) + row.setTableNumberRowsRepeatedAttribute (repcnt - rsplit); + else + row.removeAttribute ('table:number-rows-repeated'); + endif + rrow = row.getNextSibling (); + sh.insertBefore (nrow, rrow); + for jj=2:rsplit + nrow = nrow.cloneNode (1); + sh.insertBefore (nrow, rrow); + endfor + elseif (rsplit < 0) + # New data rows to be added below existing data & table(!) rows, i.e. + # beyond lower end of the current sheet. Add filler row and 1st data row + row = java_new ('org.odftoolkit.odfdom.doc.table.OdfTableRow', odfcont); + drow = row.cloneNode (1); # First data row + row.setTableNumberRowsRepeatedAttribute (-rsplit); # Filler row + scell = java_new ('org.odftoolkit.odfdom.doc.table.OdfTableCell', odfcont); + dcell = scell.cloneNode (1); + scell.setTableNumberColumnsRepeatedAttribute (COL_CAP); # Filler cell + row.appendCell (scell); + sh.appendRow (row); + drow.appendCell (dcell); + sh.appendRow (drow); + endif + endif + +# For each row, for each cell, add the data. Expand row/column-repeated nodes + + row = drow; # Start row; pointer still exists from above stanzas + for ii=1:nrows + if (~newsh) # Only for existing sheets the next checks should be made + # While processing next data rows, fix table-rows if needed + if (isempty (row) || (row.getLength () < 1)) + # Append an empty row with just one empty cell + row = java_new ('org.odftoolkit.odfdom.doc.table.OdfTableRow', odfcont); + scell = java_new ('org.odftoolkit.odfdom.doc.table.OdfTableCell', odfcont); + scell.setTableNumberColumnsRepeatedAttribute (lcol + 1); + row.appendCell (scell); + sh.appendRow (row); + else + # If needed expand nr-rows-repeated + repcnt = row.getTableNumberRowsRepeatedAttribute (); + if (repcnt > 1) + row.removeAttribute ('table:number-rows-repeated'); + # Insert new table-rows above row until our new data space is complete. + # Keep handle of upper new table-row as that's where data are added 1st + drow = row.cloneNode (1); + sh.insertBefore (drow, row); + for kk=1:min (repcnt, nrows-ii) + nrow = row.cloneNode (1); + sh.insertBefore (nrow, row); + endfor + if (repcnt > nrows-ii+1) + row.setTableNumberRowsRepeatedAttribute (repcnt - nrows +ii - 1); + endif + row = drow; + endif + endif + + # Check if leftmost cell ends up in nr-cols-repeated cell + colcnt = 0; tcellcnt = 0; rcellcnt = row.getLength(); + dcell = row.getCellAt (0); + while (colcnt < lcol && tcellcnt < rcellcnt) + # Count columns UNTIL we hit lcol + ++tcellcnt; # Nr of table-cells counted + scell = dcell; + dcell = scell.getNextSibling (); + repcnt = scell.getTableNumberColumnsRepeatedAttribute (); + colcnt = colcnt + repcnt; # Nr of spreadsheet cell counted + endwhile + csplit = colcnt - lcol; + if (csplit > 0) + # Apparently a nr-columns-repeated cell must be split + scell.removeAttribute ('table:number-columns-repeated'); + ncell = scell.cloneNode (1); + if (repcnt > 1) + scell.setTableNumberColumnsRepeatedAttribute (repcnt - csplit); + else + scell.removeAttribute ('table:number-columns-repeated'); + endif + rcell = scell.getNextSibling (); + row.insertBefore (ncell, rcell); + for jj=2:csplit + ncell = ncell.cloneNode (1); + row.insertBefore (ncell, rcell); + endfor + elseif (csplit < 0) + # New cells to be added beyond current last cell & table-cell in row + dcell = java_new ('org.odftoolkit.odfdom.doc.table.OdfTableCell', odfcont); + scell = dcell.cloneNode (1); + dcell.setTableNumberColumnsRepeatedAttribute (-csplit); + row.appendCell (dcell); + row.appendCell (scell); + endif + endif + + # Write a row of data from data array, column by column + + for jj=1:ncols + scell = row.getCellAt (lcol + jj - 1); + if (~newsh) + if (isempty (scell)) + # Apparently end of row encountered. Add cell + scell = java_new ('org.odftoolkit.odfdom.doc.table.OdfTableCell', odfcont); + scell = row.appendCell (scell); + else + # If needed expand nr-cols-repeated + repcnt = scell.getTableNumberColumnsRepeatedAttribute (); + if (repcnt > 1) + scell.removeAttribute ('table:number-columns-repeated'); + for kk=2:repcnt + ncell = scell.cloneNode (1); + row.insertBefore (ncell, scell.getNextSibling ()); + endfor + endif + endif + # Clear text contents + while (scell.hasChildNodes ()) + tmp = scell.getFirstChild (); + scell.removeChild (tmp); + endwhile + scell.removeAttribute ('table:formula'); + endif + + # Empty cell count stuff done. At last we can add the data + switch (typearr (ii, jj)) + case 1 # float + scell.setOfficeValueTypeAttribute ('float'); + scell.setOfficeValueAttribute (c_arr{ii, jj}); + case 2 # boolean + # Beware, for unpatched-for-booleans java-1.2.7- we must resort to floats + try + # First try the preferred java-boolean way + scell.setOfficeValueTypeAttribute ('boolean'); + scell.removeAttribute ('office:value'); + if (c_arr{ii, jj}) + scell.setOfficeBooleanValueAttribute (1); + else + scell.setOfficeBooleanValueAttribute (0); + endif + catch + # Unpatched java package. Fall back to transferring a float + scell.setOfficeValueTypeAttribute ('float'); + if (c_arr{ii, jj}) + scell.setOfficeValueAttribute (1); + else + scell.setOfficeValueAttribute (0); + endif + end_try_catch + case 3 # string + scell.setOfficeValueTypeAttribute ('string'); + pe = java_new ('org.odftoolkit.odfdom.doc.text.OdfTextParagraph', odfcont,'', c_arr{ii, jj}); + scell.appendChild (pe); + case 4 # Formula. + # As we don't know the result type, simply remove previous type info. + # Once OOo Calc reads it, it'll add the missing attributes + scell.removeAttribute ('office:value'); + scell.removeAttribute ('office:value-type'); + # Try-catch not strictly needed, there's no formula validator yet + try + scell.setTableFormulaAttribute (c_arr{ii, jj}); + scell.setOfficeValueTypeAttribute ('string'); + pe = java_new ('org.odftoolkit.odfdom.doc.text.OdfTextParagraph', odfcont,'', '#Recalc Formula#'); + scell.appendChild (pe); + catch + ++f_errs; + scell.setOfficeValueTypeAttribute ('string'); + pe = java_new ('org.odftoolkit.odfdom.doc.text.OdfTextParagraph', odfcont,'', c_arr{ii, jj}); + scell.appendChild (pe); + end_try_catch + case {0 5} # Empty. Clear value attributes + if (~newsh) + scell.removeAttribute ('office:value-type'); + scell.removeAttribute ('office:value'); + endif + case 6 # Date (implemented but Octave has no "date" data type - yet?) + scell.setOfficeValueTypeAttribute ('date'); + [hh mo dd hh mi ss] = datevec (c_arr{ii,jj}); + str = sprintf ("%4d-%2d-%2dT%2d:%2d:%2d", yy, mo, dd, hh, mi, ss); + scell.setOfficeDateValueAttribute (str); + case 7 # Time (implemented but Octave has no "time" data type) + scell.setOfficeValueTypeAttribute ('time'); + [hh mo dd hh mi ss] = datevec (c_arr{ii,jj}); + str = sprintf ("PT%2d:%2d:%2d", hh, mi, ss); + scell.setOfficeTimeValuettribute (str); + otherwise + # Nothing + endswitch + + scell = scell.getNextSibling (); + + endfor + + row = row.getNextSibling (); + + endfor + + if (f_errs) + printf ("%d formula errors encountered - please check input array\n", f_errs); + endif + ods.changed = max (min (ods.changed, 2), changed); # Preserve 2 (new file), 1 (existing) + rstatus = 1; + +endfunction + + +#============================================================================= + +## Copyright (C) 2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## odf3jotk2oct - read ODS spreadsheet data using Java & odftoolkit v 0.8.6+. +## You need proper java-for-octave & odfdom.jar 0.8.6+ & xercesImpl.jar 2.9.1 +## in your javaclasspath. For reliable writing odfdom-0.8.6+ is still +## experimental :-( v. 0.7.5 has been tested much more +## +## Author: Philip Nenhuis +## Created: 2010-03-16, after oct2jotk2ods() +## Updates: +## 2010-03-17 Rebuild for odfdom-0.8 +## 2010-03-19 Showstopper bug in odfdom-0.8 - getCellByPosition(
) +## crashes on rows > #10 !!! Rest seems to work OK, however +## 2010-03-22 First somewhat usable version for odfdom 0.8 +## 2010-03-29 Gave up. Writing a new empty sheet works, appending +## data to an existing one can crash virtually anywhere. +## The wait is for odfdom-0.8.+ .... +## 2010-06-05 odfdom 0.8.5 is there, next try.... +## 2010-06-## odfdom 0.8.5 dropped, too buggy +## 2010-08-22 odfdom 0.8.6 is there... seems to work with just one bug, easily worked around +## 2010-10-27 Improved file change tracking tru ods.changed +## 2010-11-12 Improved file change tracking tru ods.changed +## 2010-12-08 Bugfixes (obj -> arg L.715; removed stray arg in call to spsh_prstype L.719) +## 2011-03-23 First try of odfdom 0.8.7 +## 2012-06-08 Support for odfdom-incubator-0.8.8 + +function [ ods, rstatus ] = oct3jotk2ods (c_arr, ods, wsh, crange, spsh_opts) + + persistent ctype; + if (isempty (ctype)) + # Number, Boolean, String, Formula, Empty; Date, Time - last two aren't used + ctype = [1, 2, 3, 4, 5, 6, 7]; + endif + + rstatus = 0; changed = 0; newsh = 0; + + # Get contents and table stuff from the workbook + odfcont = ods.workbook; # Use a local copy just to be sure. octave + # makes physical copies only when needed (?) + odfroot = odfcont.getRootElement (); + offsprdsh = ods.app.getContentRoot(); + if (strcmp (ods.odfvsn, '0.8.7') || strfind (ods.odfvsn, "0.8.8")) + spsh = odfcont.getDocument (); + else + spsh = odfcont.getOdfDocument (); + endif + + # Get some basic spreadsheet data from the pointer using ODFtoolkit + autostyles = odfcont.getOrCreateAutomaticStyles(); + officestyles = ods.app.getOrCreateDocumentStyles(); + + # Parse sheets ("tables") from ODS file + sheets = ods.app.getTableList(); + nr_of_sheets = sheets.size (); + # Check user input & find sheet pointer + if (~isnumeric (wsh)) + try + sh = ods.app.getTableByName (wsh); + # We do need a sheet index number... + ii = 0; + while (ischar (wsh) && ii < nr_of_sheets) + sh_nm = sh.getTableName (); + if (strcmp (sh_nm, wsh)) wsh = ii + 1; else ++ii; endif + endwhile + catch + newsh = 1; + end_try_catch + if isempty (sh) newsh = 1; endif + elseif (wsh < 1) + # Negative sheet number: + error (sprintf ("Illegal worksheet nr. %d\n", wsh)); + elseif (wsh > nr_of_sheets) + newsh = 1; + else + sh = sheets.get (wsh - 1); + endif + + # Check size of data array & range / capacity of worksheet & prepare vars + [nr, nc] = size (c_arr); + [topleft, nrows, ncols, trow, lcol] = spsh_chkrange (crange, nr, nc, ods.xtype, ods.filename); + --trow; --lcol; # Zero-based row # & col # + if (nrows < nr || ncols < nc) + warning ("Array truncated to fit in range"); + c_arr = c_arr(1:nrows, 1:ncols); + endif + +# Parse data array, setup typarr and throw out NaNs to speed up writing; + typearr = spsh_prstype (c_arr, nrows, ncols, ctype, spsh_opts); + if ~(spsh_opts.formulas_as_text) + # Find formulas (designated by a string starting with "=" and ending in ")") + fptr = cellfun (@(x) ischar (x) && strncmp (x, "=", 1) && strncmp (x(end:end), ")", 1), c_arr); + typearr(fptr) = ctype(4); # FORMULA + endif + +# Prepare spreadsheet for writing (size, etc.). If needed create new sheet + if (newsh) + if (ods.changed > 2) + # New spreadsheet, use default first sheet + sh = sheets.get (0); + else + # Create a new sheet using DOM API. This part works OK. + sh = sheets.get (nr_of_sheets - 1).newTable (spsh, nrows, ncols); + endif + changed = 1; + if (isnumeric (wsh)) + # Give sheet a name + str = sprintf ("Sheet%d", wsh); + sh.setTableName (str); + wsh = str; + else + # Assign name to sheet and change wsh into numeric pointer + sh.setTableName (wsh); + endif + printf ("Sheet %s added to spreadsheet.\n", wsh); + + else + # Add "physical" rows & columns. Spreadsheet max. capacity checks have been done above + # Add spreadsheet data columns if needed. Compute nr of extra columns & rows. + curr_ncols = sh.getColumnCount (); + ii = max (0, lcol + ncols - curr_ncols); + if (ii == 1) + nwcols = sh.appendColumn (); + else + nwcols = sh.appendColumns (ii); + endif + + # Add spreadsheet rows if needed + curr_nrows = sh.getRowCount (); + ii = max (0, trow + nrows - curr_nrows); + if (ii == 1) + nwrows = sh.appendRow (); + else + nwrows = sh.appendRows (ii); + endif + endif + + # Transfer array data to sheet + for ii=1:nrows + for jj=1:ncols + ocell = sh.getCellByPosition (jj+lcol-1, ii+trow-1); + if ~(isempty (ocell )) # Might be spanned (merged), hidden, .... + # Number, String, Boolean, Date, Time + try + switch typearr (ii, jj) + case {1, 6, 7} # Numeric, Date, Time + ocell.setDoubleValue (c_arr{ii, jj}); + case 2 # Logical / Boolean + # ocell.setBooleanValue (c_arr{ii, jj}); # Doesn't work, bug in odfdom 0.8.6 + # Bug workaround: 1. Remove all cell contents + ocell.removeContent (); + # 2. Switch to TableTableElement API + tocell = ocell.getOdfElement (); + tocell.setAttributeNS ('office', 'office:value-type', 'boolean'); + # 3. Add boolean-value attribute. + # This is only accepted in TTE API with a NS tag (actual bug, IMO) + if (c_arr {ii,jj}) + tocell.setAttributeNS ('office', 'office:boolean-value', 'true'); + else + tocell.setAttributeNS ('office', 'office:boolean-value', 'false'); + endif + case 3 # String + ocell.setStringValue (c_arr{ii, jj}); + case 4 # Formula + ocell.setFormula (c_arr{ii, jj}); + otherwise # 5, empty and catch-all + # The above is all octave has to offer & java can accept... + endswitch + changed = 1; + catch + printf ("\n"); + end_try_catch + endif + endfor + endfor + + if (changed) + ods.changed = max (min (ods.changed, 2), changed); # Preserve 2 (new file), 1 (existing) + rstatus = 1; + endif + +endfunction + + +#============================================================================= + +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## ods2oct - write data from octave to an ODS spreadsheet using the +## jOpenDocument interface. +## +## Author: Philip Nienhuis +## Created: 2009-12-13 +## First usable version: 2010-01-14 +## Updates: +## 2010-03-17 Adapted to simplified calccelladdress argument list +## 2010-04-24 Added ensureColumnCount & ensureRowCount +## Fixed a few bugs with top row & left column indexes +## Fixed a number of other stupid bugs +## Added check on NaN before assigning data value to sprdsh-cell +## 2010-06-01 Checked logic. AFAICS all should work with upcoming jOpenDocument 1.2b4; +## in 1.2b3 adding a newsheet always leaves an incomplete upper row; +## supposedly (hopefully) that will be fixed in 1.2b4. +## '' Added check for jOpenDocument version. Adding sheets only works for +## 1.2b3+ (barring bug above) +## 2010-06-02 Fixed first sheet remaining in new spreadsheets +## 2010-08-01 Added option for crange to be only topleft cell address +## '' Code cleanup +## 2010-08-13 Fixed bug of ignoring text sheet name in case of new spreadsheet +## 2010-08-15 Fixed bug with invalid first sheet in new spreadsheets +## 2010-10-27 Improved file change tracking tru ods.changed +## 2010-11-12 Improved file change tracking tru ods.changed +## 2012-02-26 Write logicals as doubles (bug in jOpenDocument, would write as text) + +function [ ods, rstatus ] = oct2jod2ods (c_arr, ods, wsh, crange) + + rstatus = 0; sh = []; changed = 0; + + # Get worksheet. Use first one if none given + if (isempty (wsh)) wsh = 1; endif + sh_cnt = ods.workbook.getSheetCount (); + if (isnumeric (wsh)) + if (wsh > 1024) + error ("Sheet number out of range of ODS specification (>1024)"); + elseif (wsh > sh_cnt) + error ("Sheet number (%d) larger than number of sheets in file (%d)\n", wsh, sh_cnt); + else + wsh = wsh - 1; + sh = ods.workbook.getSheet (wsh); + if (isempty (sh)) + # Sheet number wsh didn't exist yet + wsh = sprintf ("Sheet%d", wsh+1); + elseif (ods.changed > 2) + sh.setName ('Sheet1'); + changed = 1; + endif + endif + endif + # wsh is now either a 0-based sheet no. or a string. In latter case: + if (isempty (sh) && ischar (wsh)) + sh = ods.workbook.getSheet (wsh); + if (isempty (sh)) + # Still doesn't exist. Create sheet + if (ods.odfvsn == 3) + if (ods.changed > 2) + # 1st "new" -unnamed- sheet has already been made when creating the spreadsheet + sh = ods.workbook.getSheet (0); + sh.setName (wsh); + changed = 1; + else + # For existing spreadsheets + printf ("Adding sheet '%s'\n", wsh); + sh = ods.workbook.addSheet (sh_cnt, wsh); + changed = 1; + endif + else + error ("jOpenDocument v. 1.2b2 does not support adding sheets - upgrade to v. 1.2b3\n"); + endif + endif + endif + + [nr, nc] = size (c_arr); + if (isempty (crange)) + trow = 0; + lcol = 0; + nrows = nr; + ncols = nc; + elseif (isempty (strfind (deblank (crange), ':'))) + [dummy1, dummy2, dummy3, trow, lcol] = parse_sp_range (crange); + nrows = nr; + ncols = nc; + # Row/col = 0 based in jOpenDocument + trow = trow - 1; lcol = lcol - 1; + else + [dummy, nrows, ncols, trow, lcol] = parse_sp_range (crange); + # Row/col = 0 based in jOpenDocument + trow = trow - 1; lcol = lcol - 1; + endif + + if (trow > 65535 || lcol > 1023) + error ("Topleft cell beyond spreadsheet limits (AMJ65536)."); + endif + # Check spreadsheet capacity beyond requested topleft cell + nrows = min (nrows, 65536 - trow); # Remember, lcol & trow are zero-based + ncols = min (ncols, 1024 - lcol); + # Check array size and requested range + nrows = min (nrows, nr); + ncols = min (ncols, nc); + if (nrows < nr || ncols < nc) warning ("Array truncated to fit in range"); endif + + if (isnumeric (c_arr)) c_arr = num2cell (c_arr); endif + + # Ensure sheet capacity is large enough to contain new data + try # try-catch needed to work around bug in jOpenDocument v 1.2b3 and earlier + sh.ensureColumnCount (lcol + ncols); # Remember, lcol & trow are zero-based + catch # catch is needed for new empty sheets (first ensureColCnt() hits null ptr) + sh.ensureColumnCount (lcol + ncols); + # Kludge needed because upper row is defective (NPE jOpenDocument bug). ?Fixed in 1.2b4? + if (trow == 0) + # Shift rows one down to avoid defective upper row + ++trow; + printf ("Info: empy upper row above data added to avoid JOD bug.\n"); + endif + end_try_catch + sh.ensureRowCount (trow + nrows); + + # Write data to worksheet + for ii = 1 : nrows + for jj = 1 : ncols + val = c_arr {ii, jj}; + if ((isnumeric (val) && ~isnan (val)) || ischar (val) || islogical (val)) + # FIXME: jOpenDocument doesn't really support writing booleans (doesn't set OffValAttr) + if (islogical (val)); val = double (val); endif + try + sh.getCellAt (jj + lcol - 1, ii + trow - 1).clearValue(); + jcell = sh.getCellAt (jj + lcol - 1, ii + trow - 1).setValue (val); + changed = 1; + catch + # No panic, probably a merged cell + # printf (sprintf ("Cell skipped at (%d, %d)\n", ii+lcol-1, jj+trow-1)); + end_try_catch + endif + endfor + endfor + + if (changed) + ods.changed = max (min (ods.changed, 2), changed); # Preserve 2 (new file), 1 (existing) + rstatus = 1; + endif + +endfunction + + +## Copyright (C) 2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## oct2uno2ods - transfer data to ods or xls file using Java/UNO bridge +## with OpenOffice_org & clones + +## Author: Philip Nienhuis +## Created: 2011-05-15 +## Updates: +## 2011-summer +## 2011-09-08 Stylistic changes +## 2011-09-18 Adapted sh_names type to LO 3.4.1 +## 2011-09-23 Removed stray debug statements +## 2012-02-25 Work around LO3.5rc1 Java Runtime Exception bug L.1043+ +## 2012-02-26 Bug fix when adding sheets near L.1101 (wrong if-else-end construct). + +function [ ods, rstatus ] = oct2uno2ods (c_arr, ods, wsh, crange, spsh_opts) + + changed = 0; + newsh = 0; + ctype = [1, 2, 3, 4, 5]; # Float, Logical, String, Formula, Empty + + # Get handle to sheet, create a new one if needed + sheets = ods.workbook.getSheets (); + sh_names = sheets.getElementNames (); + if (! iscell (sh_names)) + # Java array (LibreOffice 3.4.+); convert to cellstr + sh_names = char (sh_names); + else + sh_names = {sh_names}; + endif + + # Clear default 2 last sheets in case of a new spreadsheet file + if (ods.changed > 2) + ii = numel (sh_names); + while (ii > 1) + shnm = sh_names{ii}; + # Work around LibreOffice 3.5.rc1 bug (Java Runtime Exception) + try + sheets.removeByName (shnm); + end_try_catch + --ii; + endwhile + # Give remaining sheet a name + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.sheet.XSpreadsheet'); + sh = sheets.getByName (sh_names{1}).getObject.queryInterface (unotmp); + if (isnumeric (wsh)); wsh = sprintf ("Sheet%d", wsh); endif + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.container.XNamed'); + sh.queryInterface (unotmp).setName (wsh); + else + + # Check sheet pointer + # FIXME sheet capacity check needed. How many can fit in an OOo sprsh.file? + if (isnumeric (wsh)) + if (wsh < 1) + error ("Illegal sheet index: %d", wsh); + elseif (wsh > numel (sh_names)) + # New sheet to be added. First create sheet name but check if it already exists + shname = sprintf ("Sheet%d", numel (sh_names) + 1); + jj = strmatch (wsh, sh_names); + if (~isempty (jj)) + # New sheet name already in file, try to create a unique & reasonable one + ii = 1; filler = ''; maxtry = 5; + while (ii <= maxtry) + shname = sprintf ("Sheet%s%d", [filler "_"], numel (sh_names + 1)); + if (isempty (strmatch (wsh, sh_names))) + ii = 10; + else + ++ii; + endif + endwhile + if (ii > maxtry + 1) + error ("Could not add sheet with a unique name to file %s"); + endif + endif + wsh = shname; + newsh = 1; + else + # turn wsh index into the associated sheet name + wsh = sh_names (wsh); + endif + else + # wsh is a sheet name. See if it exists already + if (isempty (strmatch (wsh, sh_names))) + # Not found. New sheet to be added + newsh = 1; + endif + endif + if (newsh) + # Add a new sheet. Sheet index MUST be a Java Short object + shptr = java_new ("java.lang.Short", sprintf ("%d", numel (sh_names) + 1)); + sh = sheets.insertNewByName (wsh, shptr); + endif + # At this point we have a valid sheet name. Use it to get a sheet handle + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.sheet.XSpreadsheet'); + sh = sheets.getByName (wsh).getObject.queryInterface (unotmp); + endif + + # Check size of data array & range / capacity of worksheet & prepare vars + [nr, nc] = size (c_arr); + [topleft, nrows, ncols, trow, lcol] = spsh_chkrange (crange, nr, nc, ods.xtype, ods.filename); + --trow; --lcol; # Zero-based row # & col # + if (nrows < nr || ncols < nc) + warning ("Array truncated to fit in range"); + c_arr = c_arr(1:nrows, 1:ncols); + endif + + # Parse data array, setup typarr and throw out NaNs to speed up writing; + typearr = spsh_prstype (c_arr, nrows, ncols, ctype, spsh_opts, 0); + if ~(spsh_opts.formulas_as_text) + # Find formulas (designated by a string starting with "=" and ending in ")") + fptr = cellfun (@(x) ischar (x) && strncmp (x, "=", 1), c_arr); + typearr(fptr) = ctype(4); # FORMULA + endif + + # Transfer data to sheet + for ii=1:nrows + for jj=1:ncols + try + XCell = sh.getCellByPosition (lcol+jj-1, trow+ii-1); + switch typearr(ii, jj) + case 1 # Float + XCell.setValue (c_arr{ii, jj}); + case 2 # Logical. Convert to float + XCell.setValue (double (c_arr{ii, jj})); + case 3 # String + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.text.XText'); + XCell.queryInterface (unotmp).setString (c_arr{ii, jj}); + case 4 # Formula + if (spsh_opts.formulas_as_text) + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.text.XText'); + XCell.queryInterface (unotmp).setString (c_arr{ii, jj}); + else + XCell.setFormula (c_arr{ii, jj}); + endif + otherwise + # Empty cell + endswitch + changed = 1; + catch + printf ("Error writing cell %s (typearr() = %d)\n", calccelladdress(trow+ii, lcol+jj), typearr(ii, jj)); + end_try_catch + endfor + endfor + + if (changed) + ods.changed = max (min (ods.changed, 2), changed); # Preserve 2 (new file), 1 (existing) + rstatus = 1; + endif + +endfunction diff --git a/octave_packages/io-1.0.19/oct2xls.m b/octave_packages/io-1.0.19/oct2xls.m new file mode 100644 index 0000000..f907b02 --- /dev/null +++ b/octave_packages/io-1.0.19/oct2xls.m @@ -0,0 +1,1077 @@ +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [ @var{xls}, @var{rstatus} ] = oct2xls (@var{arr}, @var{xls}) +## @deftypefnx {Function File} [ @var{xls}, @var{rstatus} ] = oct2xls (@var{arr}, @var{xls}, @var{wsh}) +## @deftypefnx {Function File} [ @var{xls}, @var{rstatus} ] = oct2xls (@var{arr}, @var{xls}, @var{wsh}, @var{range}) +## @deftypefnx {Function File} [ @var{xls}, @var{rstatus} ] = oct2xls (@var{arr}, @var{xls}, @var{wsh}, @var{range}, @var{options}) +## +## Add data in 1D/2D CELL array @var{arr} into a cell range specified in +## @var{range} in worksheet @var{wsh} in an Excel spreadsheet file +## pointed to in structure @var{xls}. +## Return argument @var{xls} equals supplied argument @var{xls} and is +## updated by oct2xls. +## +## A subsequent call to xlsclose is needed to write the updated spreadsheet +## to disk (and -if needed- close the Excel or Java invocation). +## +## @var{arr} can be any 1D or 2D array containing numerical or character +## data (cellstr) except complex. Mixed numeric/text arrays can only be +## cell arrays. +## +## @var{xls} must be a valid pointer struct created earlier by xlsopen. +## +## @var{wsh} can be a number or string (max. 31 chars). +## In case of a yet non-existing Excel file, the first worksheet will be +## used & named according to @var{wsh} - extra empty worksheets that Excel +## creates by default are deleted. +## In case of existing files, some checks are made for existing worksheet +## names or numbers, or whether @var{wsh} refers to an existing sheet with +## a type other than worksheet (e.g., chart). +## When new worksheets are to be added to the Excel file, they are +## inserted to the right of all existing worksheets. The pointer to the +## "active" sheet (shown when Excel opens the file) remains untouched. +## +## If @var{range} is omitted or just the top left cell of the range is +## specified, the actual range to be used is determined by the size of +## @var{arr}. If nothing is specified for @var{range} the top left cell +## is assumed to be 'A1'. +## +## Data are added to the worksheet, ignoring other data already present; +## existing data in the range to be used will be overwritten. +## +## If @var{range} contains merged cells, only the elements of @var{arr} +## corresponding to the top or left Excel cells of those merged cells +## will be written, other array cells corresponding to that cell will be +## ignored. +## +## Optional argument @var{options}, a structure, can be used to specify +## various write modes. +## Currently the only option field is "formulas_as_text", which -if set +## to 1 or TRUE- specifies that formula strings (i.e., text strings +## starting with "=" and ending in a ")" ) should be entered as litteral +## text strings rather than as spreadsheet formulas (the latter is the +## default). +## +## Beware that -if invoked- Excel invocations may be left running silently +## in case of COM errors. Invoke xlsclose with proper pointer struct to +## close them. +## When using Java, note that large data array sizes elements may exhaust +## the Java shared memory space for the default java memory settings. +## For larger arrays, appropriate memory settings are needed in the file +## java.opts; then the maximum array size for the Java-based spreadsheet +## options may be in the order of 10^6 elements. In caso of UNO this +## limit is not applicable and spreadsheets may be much larger. +## +## Examples: +## +## @example +## [xlso, status] = xls2oct ('arr', xlsi, 'Third_sheet', 'AA31:AB278'); +## @end example +## +## @seealso {xls2oct, xlsopen, xlsclose, xlsread, xlswrite, xlsfinfo} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-12-01 +## Updates: +## 2010-01-03 (OOXML support) +## 2010-03-14 Updated help text section on java memory usage +## 2010-07-27 Added formula writing support (based on patch by Benjamin Lindner) +## 2010-08-01 Added check on input array size vs. spreadsheet capacity +## '' Changed argument topleft into range (now compatible with ML); the +## '' old argument version (just topleft cell) is still recognized, though +## 2010-08014 Added char array conversion to 1x1 cell for character input arrays +## 2010-08-16 Added check on presence of output argument. Made wsh = 1 default +## 2010-08-17 Corrected texinfo ("topleft" => "range") +## 2010-08-25 Improved help text (section on java memory usage) +## 2010-11-12 Moved ptr struct check into main func. More input validity checks +## 2010-11-13 Added check for 2-D input array +## 2010-12-01 Better check on file pointer struct (ischar (xls.xtype)) +## 2011-03-29 OpenXLS support added. Works but saving to file (xlsclose) doesn't work yet +## '' Bug fixes (stray variable c_arr, and wrong test for valid xls struct) +## 2011-05-18 Experimental UNO support +## 2011-09-08 Bug fix in range arg check; code cleanup +## 2011-11-18 Fixed another bug in test for range parameter being character string +## 2012-01-26 Fixed "seealso" help string +## 2012-02-20 Fixed range parameter to be default empty string rather than empty numeral +## 2012-02-27 More range param fixes +## 2012-03-07 Updated texinfo help text +## 2012-05-22 Cast all numeric data in input array to double + +## Last script file update (incl. subfunctions): 2012-05-21 + +function [ xls, rstatus ] = oct2xls (obj, xls, wsh=1, crange='', spsh_opts=[]) + + if (nargin < 2) error ("oct2xls needs a minimum of 2 arguments."); endif + + # Validate input array, make sure it is a cell array + if (isempty (obj)) + warning ("Request to write empty matrix - ignored."); + rstatus = 1; + return; + elseif (isnumeric (obj)) + obj = num2cell (obj); + elseif (ischar (obj)) + obj = {obj}; + printf ("(oct2xls: input character array converted to 1x1 cell)\n"); + elseif (~iscell (obj)) + error ("oct2xls: input array neither cell nor numeric array"); + endif + if (ndims (obj) > 2), error ("Only 2-dimensional arrays can be written to spreadsheet"); endif + # Cast all numerical values to double as spreadsheets only have double/boolean/text type + idx = cellfun (@isnumeric, obj, "UniformOutput", true); + obj(idx) = cellfun (@double, obj(idx), "UniformOutput", false); + + # Check xls file pointer struct + test1 = ~isfield (xls, "xtype"); + test1 = test1 || ~isfield (xls, "workbook"); + test1 = test1 || isempty (xls.workbook); + test1 = test1 || isempty (xls.app); + test1 = test1 || ~ischar (xls.xtype); + if (test1) + error ("Invalid xls file pointer struct"); + endif + + # Check worksheet ptr + if (~(ischar (wsh) || isnumeric (wsh))), error ("Integer (index) or text (wsh name) expected for arg # 3"); endif + + # Check range + if (~isempty (crange) && ~ischar (crange)) + error ("Character string (range) expected for arg # 4"); + elseif (isempty (crange)) + crange = ''; + endif + + # Various options + if (isempty (spsh_opts)) + spsh_opts.formulas_as_text = 0; + # other options to be implemented here + elseif (isstruct (spsh_opts)) + if (~isfield (spsh_opts, 'formulas_as_text')), spsh_opts.formulas_as_text = 0; endif + # other options to be implemented here + else + error ("Structure expected for arg # 5"); + endif + + if (nargout < 1) printf ("Warning: no output spreadsheet file pointer specified.\n"); endif + + # Select interface to be used + if (strcmpi (xls.xtype, 'COM')) + # Call oct2com2xls to do the work + [xls, rstatus] = oct2com2xls (obj, xls, wsh, crange, spsh_opts); + elseif (strcmpi (xls.xtype, 'POI')) + # Invoke Java and Apache POI + [xls, rstatus] = oct2jpoi2xls (obj, xls, wsh, crange, spsh_opts); + elseif (strcmpi (xls.xtype, 'JXL')) + # Invoke Java and JExcelAPI + [xls, rstatus] = oct2jxla2xls (obj, xls, wsh, crange, spsh_opts); + elseif (strcmpi (xls.xtype, 'OXS')) + # Invoke Java and OpenXLS ##### Not complete, saving file doesn't work yet! + printf ('Sorry, writing with OpenXLS not reliable => not supported yet\n'); +# [xls, rstatus] = oct2oxs2xls (obj, xls, wsh, crange, spsh_opts); + elseif (strcmpi (xls.xtype, 'UNO')) + # Invoke Java and UNO bridge (OpenOffice.org) + [xls, rstatus] = oct2uno2xls (obj, xls, wsh, crange, spsh_opts); +# elseif (strcmpi (xls.xtype, '')) +# + else + error (sprintf ("oct2xls: unknown Excel .xls interface - %s.", xls.xtype)); + endif + +endfunction + + +#=================================================================================== +## Copyright (C) 2009,2010,2011,2012 by Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{xlso}, @var{status}] = oct2com2xls (@var{obj}, @var{xlsi}) +## @deftypefnx {Function File} [@var{xlso}, @var{status}] = oct2com2xls (@var{obj}, @var{xlsi}, @var{wsh}) +## @deftypefnx {Function File} [@var{xlso}, @var{status}] = oct2com2xls (@var{obj}, @var{xlsi}, @var{wsh}, @var{top_left_cell}) +## Save matrix @var{obj} into worksheet @var{wsh} in Excel file pointed +## to in struct @var{xlsi}. All elements of @var{obj} are converted into +## Excel cells, starting at cell @var{top_left_cell}. Return argument +## @var{xlso} is @var{xlsi} with updated fields. +## +## oct2com2xls should not be invoked directly but rather through oct2xls. +## +## Excel invocations may be left running invisibly in case of COM errors. +## +## Example: +## +## @example +## xls = oct2com2xls (rand (10, 15), xls, 'Third_sheet', 'BF24'); +## @end example +## +## @seealso {oct2xls, xls2oct, xlsopen, xlsclose, xlswrite, xlsread, xls2com2oct} +## +## @end deftypefn + +## Author: Philip Nienhuis (originally based on mat2xls by Michael Goffioul) +## Rewritten: 2009-09-26 +## Updates: +## 2009-12-11 +## 2010-01-12 Fixed typearr sorting out (was only 1-dim & braces rather than parens)) +## Set cells corresponding to empty array cells empty (cf. Matlab) +## 2010-01-13 Removed an extraneous statement used for debugging +## I plan look at it when octave v.3.4 is about to arrive. +## 2010-08-01 Added checks for input array size vs check on capacity +## '' Changed topleft arg into range arg (just topleft still recognized) +## '' Some code cleanup +## '' Added option for formula input as text string +## 2010-08-01 Added range vs. array size vs. capacity checks +## 2010-08-03 Moved range checks and type array parsing to separate functions +## 2010-10-20 Bug fix removing new empty sheets in new workbook that haven't been +## created in the first place due to Excel setting (thanks Ian Journeaux) +## '' Changed range use in COM transfer call +## 2010-10-21 Improved file change tracking (var xls.changed) +## 2010-10-24 Fixed bug introduced in above fix: for loops have no stride param, +## '' replaced by while loop +## '' Added check for "live" ActiveX server +## 2010-11-12 Moved ptr struct check into main func +## 2012-01-26 Fixed "seealso" help string +## 2012-02-27 Copyright strings updated + +function [ xls, status ] = oct2com2xls (obj, xls, wsh, crange, spsh_opts) + + # Preliminary sanity checks + if (~strmatch (lower (xls.filename(end-4:end)), '.xls')) + error ("oct2com2xls can only write to Excel .xls or .xlsx files") + endif + if (isnumeric (wsh)) + if (wsh < 1) error ("Illegal worksheet number: %i\n", wsh); endif + elseif (size (wsh, 2) > 31) + error ("Illegal worksheet name - too long") + endif + # Check to see if ActiveX is still alive + try + wb_cnt = xls.workbook.Worksheets.count; + catch + error ("ActiveX invocation in file ptr struct seems non-functional"); + end_try_catch + + # define some constants not yet in __COM__.cc + xlWorksheet = -4167; # xlChart= 4; + # scratch vars + status = 0; + + # Parse date ranges + [nr, nc] = size (obj); + [topleft, nrows, ncols, trow, lcol] = spsh_chkrange (crange, nr, nc, xls.xtype, xls.filename); + lowerright = calccelladdress (trow + nrows - 1, lcol + ncols - 1); + crange = [topleft ':' lowerright]; + if (nrows < nr || ncols < nc) + warning ("Array truncated to fit in range"); + obj = obj(1:nrows, 1:ncols); + endif + + # Cleanup NaNs. Find where they are and mark as empty + ctype = [0 1 2 3 4]; # Numeric Boolean Text Formula Empty + typearr = spsh_prstype (obj, nrows, ncols, ctype, spsh_opts); + # Make cells now indicated to be empty, empty + fptr = ~(4 * (ones (size (typearr))) .- typearr); + obj(fptr) = cellfun (@(x) [], obj(fptr), "Uniformoutput", false); + + if (spsh_opts.formulas_as_text) + # find formulas (designated by a string starting with "=" and ending in ")") + fptr = cellfun (@(x) ischar (x) && strncmp (x, "=", 1) && strncmp (x(end:end), ")", 1), obj); + # ... and add leading "'" character + obj(fptr) = cellfun (@(x) ["'" x], obj(fptr), "Uniformoutput", false); + endif + clear fptr; + + if (xls.changed < 3) + # Existing file OR a new file with data added in a previous oct2xls call. + # Some involved investigation is needed to preserve + # existing data that shouldn't be touched. + # + # See if desired *sheet* name exists. + old_sh = 0; + ws_cnt = xls.workbook.Sheets.count; + if (isnumeric (wsh)) + if (wsh <= ws_cnt) + # Here we check for sheet *position* in the sheet stack + # rather than a name like "Sheet" + old_sh = wsh; + else + # wsh > nr of sheets; proposed new sheet name. + # This sheet name can already exist to the left in the sheet stack! + shnm = sprintf ("Sheet%d", wsh); shnm1 = shnm; + endif + endif + if (~old_sh) + # Check if the requested (or proposed) sheet already exists + # COM objects are not OO (yet?), so we need a WHILE loop + ii = 1; jj = 1; + while ((ii <= ws_cnt) && ~old_sh) + # Get existing sheet names one by one + sh_name = xls.workbook.Sheets(ii).name; + if (~isnumeric (wsh) && strcmp (sh_name, wsh)) + # ...and check with requested sheet *name*... + old_sh = ii; + elseif (isnumeric (wsh) && strcmp (sh_name, shnm)) + # ... or proposed new sheet name (corresp. to requested sheet *number*) + shnm = [shnm "_"]; + ii = 0; # Also check if this new augmented sheet name exists... + if (strmatch (shnm1, sh_name)), jj++; endif + if (jj > 5) # ... but not unlimited times... + error (sprintf (" > 5 sheets named [_]Sheet%d already present!", wsh)); + endif + endif + ++ii; + endwhile + endif + + if (old_sh) + # Requested sheet exists. Check if it is a *work*sheet + if ~(xls.workbook.Sheets(old_sh).Type == xlWorksheet) + # Error as you can't write data to Chart sheet + error (sprintf ("Existing sheet '%s' is not type worksheet.", wsh)); + else + # Simply point to the relevant sheet + sh = xls.workbook.Worksheets (old_sh); + endif + else + # Add a new worksheet. Earlier it was checked whether this is safe + try + sh = xls.workbook.Worksheets.Add (); + catch + error (sprintf ("Cannot add new worksheet to file %s\n", xls.filename)); + end_try_catch + if (~isnumeric (wsh)) + sh.Name = wsh; + else + sh.Name = shnm; + printf ("Writing to worksheet %s\n", shnm); + endif + # Prepare to move new sheet to right of the worksheet stack anyway + ws_cnt = xls.workbook.Worksheets.count; # New count needed + # Find where Excel has left it. We have to, depends on Excel version :-( + + ii = 1; + while ((ii < ws_cnt+1) && ~strcmp (sh.Name, xls.workbook.Worksheets(ii).Name) == 1) + ++ii; + endwhile + # Excel can't move it beyond the current last one, so we need a trick. + # First move it to just before the last one.... + xls.workbook.Worksheets(ii).Move (before = xls.workbook.Worksheets(ws_cnt)); + # ....then move the last one before the new sheet. + xls.workbook.Worksheets (ws_cnt).Move (before = xls.workbook.Worksheets(ws_cnt - 1)); + endif + + else + # The easy case: a new Excel file. Workbook was created in xlsopen. + + # Delete empty non-used sheets, last one first + xls.app.Application.DisplayAlerts = 0; + ii = xls.workbook.Sheets.count; + while (ii > 1) + xls.workbook.Worksheets(ii).Delete(); + --ii; + endwhile + xls.app.Application.DisplayAlerts = 1; + + # Write to first worksheet: + sh = xls.workbook.Worksheets (1); + # Rename the sheet + if (isnumeric (wsh)) + sh.Name = sprintf ("Sheet%i", wsh); + else + sh.Name = wsh; + endif + xls.changed = 2; # 3 => 2 + endif + + # MG's original part. + # Save object in Excel sheet, starting at cell top_left_cell + if (~isempty(obj)) + r = sh.Range (crange); + try + r.Value = obj; + catch + error (sprintf ("Cannot add data to worksheet %s in file %s\n", sh.Name, xls.filename)); + end_try_catch + delete (r); + endif + + # If we get here, all went OK + status = 1; + xls.changed = max (xls.changed, 1); # If it was 2, preserve it. + +endfunction + + +#==================================================================================== + +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [ @var{xlso}, @var{rstatus} ] = oct2jpoi2xls ( @var{arr}, @var{xlsi}) +## @deftypefnx {Function File} [ @var{xlso}, @var{rstatus} ] = oct2jpoi2xls (@var{arr}, @var{xlsi}, @var{wsh}) +## @deftypefnx {Function File} [ @var{xlso}, @var{rstatus} ] = oct2jpoi2xls (@var{arr}, @var{xlsi}, @var{wsh}, @var{range}) +## @deftypefnx {Function File} [ @var{xlso}, @var{rstatus} ] = oct2jpoi2xls (@var{arr}, @var{xlsi}, @var{wsh}, @var{range}, @var{options}) +## +## Add data in 1D/2D CELL array @var{arr} into a range with upper left +## cell equal to @var{topleft} in worksheet @var{wsh} in an Excel +## spreadsheet file pointed to in structure @var{range}. +## Return argument @var{xlso} equals supplied argument @var{xlsi} and is +## updated by oct2java2xls. +## +## oct2jpoi2xls should not be invoked directly but rather through oct2xls. +## +## Example: +## +## @example +## [xlso, status] = xls2jpoi2oct ('arr', xlsi, 'Third_sheet', 'AA31'); +## @end example +## +## @seealso {oct2xls, xls2oct, xlsopen, xlsclose, xlsread, xlswrite} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-11-26 +## Updates: +## 2010-01-03 Bugfixes +## 2010-01-12 Added xls.changed = 1 statement to signal successful write +## 2010-03-08 Dumped formula evaluator for booleans. Not being able to +## write booleans was due to a __java__.oct deficiency (see +## http://sourceforge.net/mailarchive/forum.php?thread_name=4B59A333.5060302%40net.in.tum.de&forum_name=octave-dev ) +## 2010-07-27 Added formula writing support (based on patch by Benjamin Lindner) +## 2010-08-01 Improved try-catch for formulas to enter wrong formulas as text strings +## 2010-08-01 Added range vs. array size vs. capacity checks +## 2010-08-03 Moved range checks and type array parsingto separate functions +## 2010-10-21 Improved logic for tracking file changes +## 2010-10-27 File change tracking again refined, internal var 'changed' dropped +## 2010-11-12 Moved ptr struct check into main func +## 2011-11-19 Try-catch added to allow for changed method name for nr of worksheets +## 2012-01-26 Fixed "seealso" help string +## 2012-02-27 Copyright strings updated +## 2012-05-21 "Double" cast added when writing numeric values +## 2012-05-21 "Double" cast moved into main func oct2xls + +function [ xls, rstatus ] = oct2jpoi2xls (obj, xls, wsh, crange, spsh_opts) + + # Preliminary sanity checks + if (~strmatch (tolower (xls.filename(end-4:end)), '.xls')) + error ("oct2jpoi2xls can only write to Excel .xls or .xlsx files") + endif + + persistent ctype; + if (isempty (ctype)) + # Get cell types. Beware as they start at 0 not 1 + ctype(1) = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_NUMERIC'); # 0 + ctype(2) = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_BOOLEAN'); # 4 + ctype(3) = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_STRING'); # 1 + ctype(4) = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_FORMULA'); # 2 + ctype(5) = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_BLANK'); # 3 + endif + # scratch vars + rstatus = 0; f_errs = 0; + + # Check if requested worksheet exists in the file & if so, get pointer + try + nr_of_sheets = xls.workbook.getNumWorkSheets (); + catch + nr_of_sheets = xls.workbook.getNumberOfSheets (); + end_try_catch + if (isnumeric (wsh)) + if (wsh > nr_of_sheets) + # Watch out as a sheet called Sheet%d can exist with a lower index... + strng = sprintf ("Sheet%d", wsh); + ii = 1; + while (~isempty (xls.workbook.getSheet (strng)) && (ii < 5)) + strng = ['_' strng]; + ++ii; + endwhile + if (ii >= 5) error (sprintf( " > 5 sheets named [_]Sheet%d already present!", wsh)); endif + sh = xls.workbook.createSheet (strng); + xls.changed = min (xls.changed, 2); # Keep 2 for new files + else + sh = xls.workbook.getSheetAt (wsh - 1); # POI sheet count 0-based + endif + printf ("(Writing to worksheet %s)\n", sh.getSheetName ()); + else + sh = xls.workbook.getSheet (wsh); + if (isempty (sh)) + # Sheet not found, just create it + sh = xls.workbook.createSheet (wsh); + xls.changed = min (xls.changed, 2); # Keep 2 or 3 f. new files + endif + endif + + # Parse date ranges + [nr, nc] = size (obj); + [topleft, nrows, ncols, trow, lcol] = spsh_chkrange (crange, nr, nc, xls.xtype, xls.filename); + if (nrows < nr || ncols < nc) + warning ("Array truncated to fit in range"); + obj = obj(1:nrows, 1:ncols); + endif + + # Prepare type array + typearr = spsh_prstype (obj, nrows, ncols, ctype, spsh_opts); + if ~(spsh_opts.formulas_as_text) + # Remove leading '=' from formula strings + # FIXME should be easier using typearr<4> info + fptr = ~(2 * (ones (size (typearr))) .- typearr); + obj(fptr) = cellfun (@(x) x(2:end), obj(fptr), "Uniformoutput", false); + endif + + # Create formula evaluator + frm_eval = xls.workbook.getCreationHelper ().createFormulaEvaluator (); + + for ii=1:nrows + ll = ii + trow - 2; # Java POI's row count = 0-based + row = sh.getRow (ll); + if (isempty (row)) row = sh.createRow (ll); endif + for jj=1:ncols + kk = jj + lcol - 2; # POI's column count is also 0-based + if (typearr(ii, jj) == ctype(5)) # Empty cells + cell = row.createCell (kk, ctype(5)); + elseif (typearr(ii, jj) == ctype(4)) # Formulas + # Try-catch needed as there's no guarantee for formula correctness + try + cell = row.createCell (kk, ctype(4)); + cell.setCellFormula (obj{ii,jj}); + catch + ++f_errs; + cell.setCellType (ctype (3)); # Enter formula as text + cell.setCellValue (obj{ii, jj}); + end_try_catch + else + cell = row.createCell (kk, typearr(ii,jj)); + if (isnumeric (obj{ii, jj})) + cell.setCellValue (obj{ii, jj}); + else + cell.setCellValue (obj{ii, jj}); + endif + endif + endfor + endfor + + if (f_errs) + printf ("%d formula errors encountered - please check input array\n", f_errs); + endif + xls.changed = max (xls.changed, 1); # Preserve a "2" + rstatus = 1; + +endfunction + + +#==================================================================================== +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [ @var{xlso}, @var{rstatus} ] = oct2jxla2xls ( @var{arr}, @var{xlsi}) +## @deftypefnx {Function File} [ @var{xlso}, @var{rstatus} ] = oct2jxla2xls (@var{arr}, @var{xlsi}, @var{wsh}) +## @deftypefnx {Function File} [ @var{xlso}, @var{rstatus} ] = oct2jxla2xls (@var{arr}, @var{xlsi}, @var{wsh}, @var{range}) +## @deftypefnx {Function File} [ @var{xlso}, @var{rstatus} ] = oct2jxla2xls (@var{arr}, @var{xlsi}, @var{wsh}, @var{range}, @var{options}) +## +## Add data in 1D/2D CELL array @var{arr} into spreadsheet cell range @var{range} +## in worksheet @var{wsh} in an Excel spreadsheet file pointed to in structure +## @var{range}. +## Return argument @var{xlso} equals supplied argument @var{xlsi} and is +## updated by oct2jxla2xls. +## +## oct2jxla2xls should not be invoked directly but rather through oct2xls. +## +## Example: +## +## @example +## [xlso, status] = oct2jxla2oct ('arr', xlsi, 'Third_sheet', 'AA31'); +## @end example +## +## @seealso {oct2xls, xls2oct, xlsopen, xlsclose, xlsread, xlswrite, xls2jxla2oct} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-12-04 +## Updates: +## 2009-12-11 +## 2010-01-12 Fixed skipping empty array values (now Excel-conformant => cell cleared) +## Added xls.changed = 1 statement to signal successful write +## 2010-07-27 Added formula writing support (based on POI patch by Benjamin Lindner) +## Added check for valid file pointer struct +## 2010-08-01 Improved try-catch for formulas to enter wrong formulas as text strings +## 2010-08-01 Added range vs. array size vs. capacity checks +## '' Code cleanup +## '' Changed topleft arg into range arg (topleft version still recognized) +## 2010-08-03 Moved range checks and cell type parsing to separate routines +## 2010-08-11 Moved addcell() into try-catch as it is addCell which throws fatal errors +## 2010-10-20 Improved logic for tracking file changes (xls.changed 2 or 3); dropped +## '' internal variable 'changed' +## 2010-10-27 File change tracking again refined +## 2010-11-12 Moved ptr struct check into main func +## 2012-01-26 Fixed "seealso" help string +## 2012-02-27 Copyright strings updated +## 2012-05-21 "Double" cast added when writing numeric values +## 2012-05-21 "Double" cast moved into main func oct2xls + +function [ xls, rstatus ] = oct2jxla2xls (obj, xls, wsh, crange, spsh_opts) + + # Preliminary sanity checks + if (~strmatch (tolower (xls.filename(end-4:end-1)), '.xls')) # No OOXML in JXL + error ("JExcelAPI can only write to Excel .xls files") + endif + + persistent ctype; + if (isempty (ctype)) + ctype = [1, 2, 3, 4, 5]; + # Number, Boolean, String, Formula, Empty + endif + # scratch vars + rstatus = 0; f_errs = 0; + + # Prepare workbook pointer if needed + if (xls.changed == 0) # Only for 1st call of octxls after xlsopen + # Create writable copy of workbook. If >2 a writable wb was made in xlsopen + xlsout = java_new ('java.io.File', xls.filename); + wb = java_invoke ('jxl.Workbook', 'createWorkbook', xlsout, xls.workbook); + # Catch JExcelAPI bug/"feature": when switching to write mode, the file on disk + # is affected and the memory file MUST be written to disk to save earlier data + xls.changed = 1; + xls.workbook = wb; + else + wb = xls.workbook; + endif + # Check if requested worksheet exists in the file & if so, get pointer + nr_of_sheets = xls.workbook.getNumberOfSheets (); # 1 based !! + if (isnumeric (wsh)) + if (wsh > nr_of_sheets) + # Watch out as a sheet called Sheet%d can exist with a lower index... + strng = sprintf ("Sheet%d", wsh); + ii = 1; + while (~isempty (wb.getSheet (strng)) && (ii < 5)) + strng = ['_' strng]; + ++ii; + endwhile + if (ii >= 5) error (sprintf( " > 5 sheets named [_]Sheet%d already present!", wsh)); endif + sh = wb.createSheet (strng, nr_of_sheets); ++nr_of_sheets; + xls.changed = min (xls.changed, 2); # Keep a 2 in case of new file + else + sh = wb.getSheet (wsh - 1); # JXL sheet count 0-based + endif + shnames = char (wb.getSheetNames ()); + printf ("(Writing to worksheet %s)\n", shnames {nr_of_sheets, 1}); + else + sh = wb.getSheet (wsh); + if (isempty(sh)) + # Sheet not found, just create it + sh = wb.createSheet (wsh, nr_of_sheets); + ++nr_of_sheets; + xls.changed = min (xls.changed, 2); # Keep a 2 for new file + endif + endif + + # Parse date ranges + [nr, nc] = size (obj); + [topleft, nrows, ncols, trow, lcol] = spsh_chkrange (crange, nr, nc, xls.xtype, xls.filename); + if (nrows < nr || ncols < nc) + warning ("Array truncated to fit in range"); + obj = obj(1:nrows, 1:ncols); + endif + + # Prepare type array + typearr = spsh_prstype (obj, nrows, ncols, ctype, spsh_opts); + if ~(spsh_opts.formulas_as_text) + # Remove leading '=' from formula strings + fptr = ~(4 * (ones (size (typearr))) .- typearr); + obj(fptr) = cellfun (@(x) x(2:end), obj(fptr), "Uniformoutput", false); + endif + clear fptr + + # Write date to worksheet + for ii=1:nrows + ll = ii + trow - 2; # Java JExcelAPI's row count = 0-based + for jj=1:ncols + kk = jj + lcol - 2; # JExcelAPI's column count is also 0-based + switch typearr(ii, jj) + case 1 # Numerical + tmp = java_new ('jxl.write.Number', kk, ll, obj{ii, jj}); + sh.addCell (tmp); + case 2 # Boolean + tmp = java_new ('jxl.write.Boolean', kk, ll, obj{ii, jj}); + sh.addCell (tmp); + case 3 # String + tmp = java_new ('jxl.write.Label', kk, ll, obj{ii, jj}); + sh.addCell (tmp); + case 4 # Formula + # First make sure formula functions are all uppercase + obj{ii, jj} = toupper (obj{ii, jj}); + # There's no guarantee for formula correctness, so.... + try # Actually JExcelAPI flags formula errors as mere warnings :-( + tmp = java_new ('jxl.write.Formula', kk, ll, obj{ii, jj}); + # ... while errors are actually detected in addCell(), so + # that should be within the try-catch + sh.addCell (tmp); + catch + ++f_errs; + # Formula error. Enter formula as text string instead + tmp = java_new ('jxl.write.Label', kk, ll, obj{ii, jj}); + sh.addCell (tmp); + end_try_catch + case 5 # Empty or NaN + tmp = java_new ('jxl.write.Blank', kk, ll); + sh.addCell (tmp); + otherwise + # Just skip + endswitch + endfor + endfor + + if (f_errs) + printf ("%d formula errors encountered - please check input array\n", f_errs); + endif + xls.changed = max (xls.changed, 1); # Preserve 2 for new files + rstatus = 1; + +endfunction + + +## Copyright (C) 2011 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [ @var{xlso}, @var{rstatus} ] = oct2oxs2xls ( @var{arr}, @var{xlsi}) +## @deftypefnx {Function File} [ @var{xlso}, @var{rstatus} ] = oct2oxs2xls (@var{arr}, @var{xlsi}, @var{wsh}) +## @deftypefnx {Function File} [ @var{xlso}, @var{rstatus} ] = oct2oxs2xls (@var{arr}, @var{xlsi}, @var{wsh}, @var{range}) +## @deftypefnx {Function File} [ @var{xlso}, @var{rstatus} ] = oct2oxs2xls (@var{arr}, @var{xlsi}, @var{wsh}, @var{range}, @var{options}) +## +## Add data in 1D/2D CELL array @var{arr} into spreadsheet cell range @var{range} +## in worksheet @var{wsh} in an Excel spreadsheet file pointed to in structure +## @var{range}. +## Return argument @var{xlso} equals supplied argument @var{xlsi} and is +## updated by oct2oxs2xls. +## +## oct2oxs2xls should not be invoked directly but rather through oct2xls. +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2011-03-29 +## Updates: +## + +function [ xls, rstatus ] = oct2oxs2xls (obj, xls, wsh, crange, spsh_opts) + + # Preliminary sanity checks + if (~strmatch (tolower (xls.filename(end-4:end-1)), '.xls')) # No OOXML in OXS + error ("OXS can only write to Excel .xls files") + endif + + changed = 0; + + persistent ctype; + if (isempty (ctype)) + ctype = [1, 2, 3, 4, 5]; + # Number, Boolean, String, Formula, Empty + endif + # scratch vars + rstatus = 0; f_errs = 0; + + # Prepare workbook pointer if needed + wb = xls.workbook; + + # Check if requested worksheet exists in the file & if so, get pointer + nr_of_sheets = wb.getNumWorkSheets (); # 1 based !! + if (isnumeric (wsh)) + if (wsh > nr_of_sheets) + # Watch out as a sheet called Sheet%d can exist with a lower index... + strng = sprintf ("Sheet%d", wsh); + ii = 1; + try + # While loop should be inside try-catch + while (ii < 5) + sh = wb.getWorkSheet (strng) + strng = ['_' strng]; + ++ii; + endwhile + catch + # No worksheet named found => we can proceed + end_try_catch + if (ii >= 5) error (sprintf( " > 5 sheets named [_]Sheet%d already present!", wsh)); endif + sh = wb.createWorkSheet (strng); ++nr_of_sheets; + xls.changed = min (xls.changed, 2); # Keep a 2 in case of new file + else + sh = wb.getWorkSheet (wsh - 1); # OXS sheet count 0-based + endif + printf ("(Writing to worksheet %s)\n", sh.getSheetName ()); + else + try + sh = wb.getWorkSheet (wsh); + catch + # Sheet not found, just create it + sh = wb.createWorkSheet (wsh); ++nr_of_sheets; + xls.changed = min (xls.changed, 2); # Keep a 2 for new file + end_try_catch + endif + + # Parse date ranges + [nr, nc] = size (obj); + [topleft, nrows, ncols, trow, lcol] = spsh_chkrange (crange, nr, nc, xls.xtype, xls.filename); + if (nrows < nr || ncols < nc) + warning ("Array truncated to fit in range"); + obj = obj(1:nrows, 1:ncols); + endif + + # Prepare type array + typearr = spsh_prstype (obj, nrows, ncols, ctype, spsh_opts); + if ~(spsh_opts.formulas_as_text) + # Remove leading '=' from formula strings //FIXME needs updating + fptr = ~(4 * (ones (size (typearr))) .- typearr); + obj(fptr) = cellfun (@(x) x(2:end), obj(fptr), "Uniformoutput", false); + endif + clear fptr + + for ii=1:ncols + for jj=1:nrows + try + # Set value + sh.getCell(jj+trow-2, ii+lcol-2).setVal (obj{jj, ii}); # Addr.cnt = 0-based + changed = 1; + catch + # Cell not existent. Add cell + if ~(typearr(jj, ii) == 5) + sh.add (obj{jj, ii}, jj+trow-2, ii+lcol-2); + changed = 1; + endif + end_try_catch + endfor + endfor + + if (changed), xls.changed = max (xls.changed, 1); endif # Preserve 2 for new files + rstatus = 1; + +endfunction + + +## Copyright (C) 2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## oct2uno2xls + +## Author: Philip Nienhuis +## Created: 2011-05-18 +## 2011-09-18 Adapted sh_names type to LO 3.4.1 +## 2011-09-23 Removed stray debug statements +## 2012-02-25 Fixed wrong var name in L.933 +## 2012-02-25 Catch stray Java RuntimeException when deleting sheets +## 2012-02-26 Bug fix when adding sheets near L.994 (wrong if-else-end construct). +## 2012-02-27 Copyright strings updated +## 2012-05-21 "Double" cast added when writing numeric values +## 2012-05-21 "Double" cast moved into main func oct2xls + +function [ xls, rstatus ] = oct2uno2xls (c_arr, xls, wsh, crange, spsh_opts) + + changed = 0; + newsh = 0; + ctype = [1, 2, 3, 4, 5]; # Float, Logical, String, Formula, Empty + + # Get handle to sheet, create a new one if needed + sheets = xls.workbook.getSheets (); + sh_names = sheets.getElementNames (); + if (! iscell (sh_names)) + # Java array (LibreOffice 3.4.+); convert to cellstr + sh_names = char (sh_names); + else + sh_names = {sh_names}; + endif + + # Clear default 2 last sheets in case of a new spreadsheet file + if (xls.changed > 2) + ii = numel (sh_names); + while (ii > 1) + shnm = sh_names{ii}; + try + # Catch harmless Java RuntimeException "out of range" in LibreOffice 3.5rc1 + sheets.removeByName (shnm); + end_try_catch + --ii; + endwhile + # Give remaining sheet a name + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.sheet.XSpreadsheet'); + sh = sheets.getByName (sh_names{1}).getObject.queryInterface (unotmp); + if (isnumeric (wsh)); wsh = sprintf ("Sheet%d", wsh); endif + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.container.XNamed'); + sh.queryInterface (unotmp).setName (wsh); + else + + # Check sheet pointer + # FIXME sheet capacity check needed + if (isnumeric (wsh)) + if (wsh < 1) + error ("Illegal sheet index: %d", wsh); + elseif (wsh > numel (sh_names)) + # New sheet to be added. First create sheet name but check if it already exists + shname = sprintf ("Sheet%d", numel (sh_names) + 1); + jj = strmatch (wsh, sh_names); + if (~isempty (jj)) + # New sheet name already in file, try to create a unique & reasonable one + ii = 1; filler = ''; maxtry = 5; + while (ii <= maxtry) + shname = sprintf ("Sheet%s%d", [filler "_"], numel (sh_names + 1)); + if (isempty (strmatch (wsh, sh_names))) + ii = 10; + else + ++ii; + endif + endwhile + if (ii > maxtry + 1) + error ("Could not add sheet with a unique name to file %s"); + endif + endif + wsh = shname; + newsh = 1; + else + # turn wsh index into the associated sheet name + wsh = sh_names (wsh); + endif + else + # wsh is a sheet name. See if it exists already + if (isempty (strmatch (wsh, sh_names))) + # Not found. New sheet to be added + newsh = 1; + endif + endif + if (newsh) + # Add a new sheet. Sheet index MUST be a Java Short object + shptr = java_new ("java.lang.Short", sprintf ("%d", numel (sh_names) + 1)); + sh = sheets.insertNewByName (wsh, shptr); + endif + # At this point we have a valid sheet name. Use it to get a sheet handle + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.sheet.XSpreadsheet'); + sh = sheets.getByName (wsh).getObject.queryInterface (unotmp); + endif + + # Check size of data array & range / capacity of worksheet & prepare vars + [nr, nc] = size (c_arr); + [topleft, nrows, ncols, trow, lcol] = spsh_chkrange (crange, nr, nc, xls.xtype, xls.filename); + --trow; --lcol; # Zero-based row # & col # + if (nrows < nr || ncols < nc) + warning ("Array truncated to fit in range"); + c_arr = c_arr(1:nrows, 1:ncols); + endif + + # Parse data array, setup typarr and throw out NaNs to speed up writing; + typearr = spsh_prstype (c_arr, nrows, ncols, ctype, spsh_opts, 0); + if ~(spsh_opts.formulas_as_text) + # Find formulas (designated by a string starting with "=" and ending in ")") + fptr = cellfun (@(x) ischar (x) && strncmp (x, "=", 1), c_arr); + typearr(fptr) = ctype(4); # FORMULA + endif + + # Transfer data to sheet + for ii=1:nrows + for jj=1:ncols + try + XCell = sh.getCellByPosition (lcol+jj-1, trow+ii-1); + switch typearr(ii, jj) + case 1 # Float + XCell.setValue (c_arr{ii, jj}); + case 2 # Logical. Convert to float as OOo has no Boolean type + XCell.setValue (double (c_arr{ii, jj})); + case 3 # String + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.text.XText'); + XCell.queryInterface (unotmp).setString (c_arr{ii, jj}); + case 4 # Formula + if (spsh_opts.formulas_as_text) + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.text.XText'); + XCell.queryInterface (unotmp).setString (c_arr{ii, jj}); + else + XCell.setFormula (c_arr{ii, jj}); + endif + otherwise + # Empty cell + endswitch + changed = 1; + catch + printf ("Error writing cell %s (typearr() = %d)\n", calccelladdress(trow+ii, lcol+jj), typearr(ii, jj)); + end_try_catch + endfor + endfor + + if (changed) + xls.changed = max (min (xls.changed, 2), changed); # Preserve 2 (new file), 1 (existing) + rstatus = 1; + endif + +endfunction diff --git a/octave_packages/io-1.0.19/ods2oct.m b/octave_packages/io-1.0.19/ods2oct.m new file mode 100644 index 0000000..e338d02 --- /dev/null +++ b/octave_packages/io-1.0.19/ods2oct.m @@ -0,0 +1,899 @@ +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [ @var{rawarr}, @var{ods}, @var{rstatus} ] = ods2oct (@var{ods}) +## @deftypefnx {Function File} [ @var{rawarr}, @var{ods}, @var{rstatus} ] = ods2oct (@var{ods}, @var{wsh}) +## @deftypefnx {Function File} [ @var{rawarr}, @var{ods}, @var{rstatus} ] = ods2oct (@var{ods}, @var{wsh}, @var{range}) +## @deftypefnx {Function File} [ @var{rawarr}, @var{ods}, @var{rstatus} ] = ods2oct (@var{ods}, @var{wsh}, @var{range}, @var{options}) +## +## Read data contained within cell range @var{range} from worksheet @var{wsh} +## in an OpenOffice_org Calc spreadsheet file pointed to in struct @var{ods}. +## +## @var{ods} is supposed to have been created earlier by odsopen in the +## same octave session. +## +## @var{wsh} is either numerical or text, in the latter case it is +## case-sensitive. +## Note that in case of a numerical @var{wsh} this number refers to the +## position in the worksheet stack, counted from the left in a Calc +## window. The default is numerical 1, i.e. the leftmost worksheet +## in the ODS file. +## +## @var{range} is expected to be a regular spreadsheet range format, +## or "" (empty string, indicating all data in a worksheet). +## If no range is specified the occupied cell range will have to be +## determined behind the scenes first; this can take some time. +## +## Optional argument @var{options}, a structure, can be used to +## specify various read modes by setting option fields in the struct +## to true (1) or false (0). Currently recognized option fields are: +## +## @table @asis +## @item "formulas_as_text" +## If set to TRUE or 1, spreadsheet formulas (if at all present) +## are read as formula strings rather than the evaluated formula +## result values. This only works for the OTK and UNO interfaces. +## The default value is 0 (FALSE). +## +## @item 'strip_array' +## Set the value of this field set to TRUE or 1 to strip the returned +## output array @var{rawarr} from empty outer columns and rows. The +## spreadsheet cell rectangle limits from where the data actually +## came will be updated. The default value is FALSE or 0 (no cropping). +## @end table +## +## If only the first argument @var{ods} is specified, ods2oct will +## try to read all contents from the first = leftmost (or the only) +## worksheet (as if a range of @'' (empty string) was specified). +## +## If only two arguments are specified, ods2oct assumes the second +## argument to be @var{wsh}. In that case ods2oct will try to read +## all data contained in that worksheet. +## +## Return argument @var{rawarr} contains the raw spreadsheet cell data. +## Use parsecell() to separate numeric and text values from @var{rawarr}. +## +## Optional return argument @var{ods} contains the pointer struct. Field +## @var{ods}.limits contains the outermost column and row numbers of the +## actually read cell range. +## +## Optional return argument @var{rstatus} will be set to 1 if the +## requested data have been read successfully, 0 otherwise. +## +## Erroneous data and empty cells turn up empty in @var{rawarr}. +## Date/time values in OpenOffice.org are returned as numerical values +## with base 1-1-0000 (same as octave). But beware that Excel spreadsheets +## rewritten by OpenOffice.org into .ods format may have numerical date +## cells with base 01-01-1900 (same as MS-Excel). +## +## When reading from merged cells, all array elements NOT corresponding +## to the leftmost or upper OpenOffice.org cell will be treated as if the +## "corresponding" cells are empty. +## +## Examples: +## +## @example +## A = ods2oct (ods1, '2nd_sheet', 'C3:ABS40000'); +## (which returns the numeric contents in range C3:ABS40000 in worksheet +## '2nd_sheet' from a spreadsheet file pointed to in pointer struct ods1, +## into numeric array A) +## @end example +## +## @example +## [An, ods2, status] = ods2oct (ods2, 'Third_sheet'); +## @end example +## +## @seealso {odsopen, odsclose, parsecell, odsread, odsfinfo, oct2ods, odswrite} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-12-13 +## Updates: +## 2009-12-30 First working version +## 2010-03-19 Added check for odfdom version (should be 0.7.5 until further notice) +## 2010-03-20 Works for odfdom v 0.8 too. Added subfunction ods3jotk2oct for that +## 2010-04-06 Benchmarked odfdom versions. v0.7.5 is up to 7 times faster than v0.8! +## So I added a warning for users using odfdom 0.8. +## 2010-04-11 Removed support for odfdom-0.8 - it's painfully slow and unreliable +## 2010-05-31 Updated help text (delay i.c.o. empty range due to getusedrange call) +## 2010-08-03 Added support for reading back formulas (works only in OTK) +## 2010-08-12 Added explicit support for jOpenDocument v 1.2b3+ +## 2010-08-25 Improved helptext (moved some text around) +## 2010-08-27 Added ods3jotk2oct - internal function for odfdom-0.8.6.jar +## '' Extended check on spsh_opts (must be a struct) +## 2010-10-27 Moved cropping rawarr from empty outer rows & columns to here +## 2011-05-06 Experimental UNO support +## 2011-09-18 Set rstatus var here +## 2012-01-26 Fixed "seealso" help string +## 2012-02-25 Added 0.8.7 to supported odfdom versions in L.155 +## 2012-02-26 Updated texinfo header help text +## 2012-06-08 Support for odfdom-incubator 0.8.8 +## '' Replaced tabs by double space +## +## (Latest update of subfunctions below: 2012-06-08) + +function [ rawarr, ods, rstatus ] = ods2oct (ods, wsh=1, datrange=[], spsh_opts=[]) + + # Check if ods struct pointer seems valid + if (~isstruct (ods)), error ("File ptr struct expected for arg @ 1"); endif + test1 = ~isfield (ods, "xtype"); + test1 = test1 || ~isfield (ods, "workbook"); + test1 = test1 || isempty (ods.workbook); + test1 = test1 || isempty (ods.app); + if (test1) + error ("Arg #1 is an invalid ods file struct"); + endif + # Check worksheet ptr + if (~(ischar (wsh) || isnumeric (wsh))), error ("Integer (index) or text (wsh name) expected for arg # 2"); endif + # Check range + if (~(isempty (datrange) || ischar (datrange))), error ("Character string (range) expected for arg # 3"); endif + # Check & setup options struct + if (nargin < 4 || isempty (spsh_opts)) + spsh_opts.formulas_as_text = 0; + spsh_opts.strip_array = 1; + # Other options here + elseif (~isstruct (spsh_opts)) + error ("struct expected for OPTIONS argument (# 4)"); + else + if (~isfield (spsh_opts, 'formulas_as_text')), spsh_opts.formulas_as_text = 0; endif + if (~isfield (spsh_opts, 'strip_array')), spsh_opts.strip_array = 1; endif + % Future options: + endif + + # Select the proper interfaces + if (strcmp (ods.xtype, 'OTK')) + # Read ods file tru Java & ODF toolkit + switch ods.odfvsn + case '0.7.5' + [rawarr, ods] = ods2jotk2oct (ods, wsh, datrange, spsh_opts); + case {'0.8.6', '0.8.7', '0.8.8'} + [rawarr, ods] = ods3jotk2oct (ods, wsh, datrange, spsh_opts); + otherwise + error ("Unsupported odfdom version or invalid ods file pointer."); + endswitch + elseif (strcmp (ods.xtype, 'JOD')) + # Read ods file tru Java & jOpenDocument. JOD doesn't know about formulas :-( + [rawarr, ods] = ods2jod2oct (ods, wsh, datrange); + elseif (strcmp (ods.xtype, 'UNO')) + # Read ods file tru Java & UNO + [rawarr, ods] = ods2uno2oct (ods, wsh, datrange, spsh_opts); +# elseif + # ---- < Other interfaces here > + else + error (sprintf ("ods2oct: unknown OpenOffice.org .ods interface - %s.", ods.xtype)); + endif + + rstatus = ~isempty (rawarr); + + # Optionally strip empty outer rows and columns & keep track of original data location + if (spsh_opts.strip_array && rstatus) + emptr = cellfun ('isempty', rawarr); + if (all (all (emptr))) + rawarr = {}; + ods.limits= []; + else + nrows = size (rawarr, 1); ncols = size (rawarr, 2); + irowt = 1; + while (all (emptr(irowt, :))), irowt++; endwhile + irowb = nrows; + while (all (emptr(irowb, :))), irowb--; endwhile + icoll = 1; + while (all (emptr(:, icoll))), icoll++; endwhile + icolr = ncols; + while (all (emptr(:, icolr))), icolr--; endwhile + + # Crop outer rows and columns and update limits + rawarr = rawarr(irowt:irowb, icoll:icolr); + ods.limits = ods.limits + [icoll-1, icolr-ncols; irowt-1, irowb-nrows]; + endif + endif + +endfunction + + +#===================================================================== + +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## odf2jotk2oct - read ODS spreadsheet data using Java & odftoolkit +## You need proper java-for-octave & odfdom.jar + xercesImpl.jar +## in your javaclasspath. + +## Author: Philip Nenhuis +## Created: 2009-12-24 +## Updates: +## 2010-01-08 First working version +## 2010-03-18 Fixed many bugs with wrong row references in case of empty upper rows +## "" Fixed reference to upper row in case of nr-rows-repeated top tablerow +## "" Tamed down memory usage for rawarr when desired data range is given +## "" Added call to getusedrange() for cases when no range was specified +## 2010-03-19 More code cleanup & fixes for bugs introduced 18/3/2010 8-() +## 2010-08-03 Added preliminary support for reading back formulas as text strings +## 2010-10-27 Moved cropping rawarr from empty outer rows & columns to caller +## 2011-09-18 Remove rstatus var (now set in caller) + +function [ rawarr, ods ] = ods2jotk2oct (ods, wsh, crange, spsh_opts) + + # Parts after user gfterry in + # http://www.oooforum.org/forum/viewtopic.phtml?t=69060 + + # Get contents and table stuff from the workbook + odfcont = ods.workbook; # Use a local copy just to be sure. octave + # makes physical copies only when needed (?) + xpath = ods.app.getXPath; + + # AFAICS ODS spreadsheets have the following hierarchy (after Xpath processing): + # - table nodes, the actual worksheets; + # - row nodes, the rows in a worksheet; + # - cell nodes, the cells in a row; + # Styles (formatting) are defined in a section "settings" outside the + # contents proper but are referenced in the nodes. + + # Create an instance of type NODESET for use in subsequent statement + NODESET = java_get ('javax.xml.xpath.XPathConstants', 'NODESET'); + # Parse sheets ("tables") from ODS file + sheets = xpath.evaluate ("//table:table", odfcont, NODESET); + nr_of_sheets = sheets.getLength (); + + # Check user input & find sheet pointer (1-based), using ugly hacks + if (~isnumeric (wsh)) + # Search in sheet names, match sheet name to sheet number + ii = 0; + while (++ii <= nr_of_sheets && ischar (wsh)) + # Look in first part of the sheet nodeset + sh_name = sheets.item(ii-1).getTableNameAttribute (); + if (strcmp (sh_name, wsh)) + # Convert local copy of wsh into a number (pointer) + wsh = ii; + endif + endwhile + if (ischar (wsh)) + error (sprintf ("No worksheet '%s' found in file %s", wsh, ods.filename)); + endif + elseif (wsh > nr_of_sheets || wsh < 1) + # We already have a numeric sheet pointer. If it's not in range: + error (sprintf ("Worksheet no. %d out of range (1 - %d)", wsh, nr_of_sheets)); + endif + + # Get table-rows in sheet no. wsh. Sheet count = 1-based (!) + str = sprintf ("//table:table[%d]/table:table-row", wsh); + sh = xpath.evaluate (str, odfcont, NODESET); + nr_of_rows = sh.getLength (); + + # Either parse (given cell range) or prepare (unknown range) help variables + if (isempty (crange)) + [ trow, brow, lcol, rcol ] = getusedrange (ods, wsh); + nrows = brow - trow + 1; # Number of rows to be read + ncols = rcol - lcol + 1; # Number of columns to be read + else + [dummy, nrows, ncols, trow, lcol] = parse_sp_range (crange); + brow = min (trow + nrows - 1, nr_of_rows); + # Check ODS column limits + if (lcol > 1024 || trow > 65536) + error ("ods2oct: invalid range; max 1024 columns & 65536 rows."); + endif + # Truncate range silently if needed + rcol = min (lcol + ncols - 1, 1024); + ncols = min (ncols, 1024 - lcol + 1); + nrows = min (nrows, 65536 - trow + 1); + endif + # Create storage for data content + rawarr = cell (nrows, ncols); + + # Prepare reading sheet row by row + rightmcol = 0; # Used to find actual rightmost column + ii = trow - 1; # Spreadsheet row counter + rowcnt = 0; + # Find uppermost requested *tablerow*. It may be influenced by nr-rows-repeated + if (ii >= 1) + tfillrows = 0; + while (tfillrows < ii) + row = sh.item(tfillrows); + extrarows = row.getTableNumberRowsRepeatedAttribute (); + tfillrows = tfillrows + extrarows; + ++rowcnt; + endwhile + # Desired top row may be in a nr-rows-repeated tablerow.... + if (tfillrows > ii); ii = tfillrows; endif + endif + + # Read from worksheet row by row. Row numbers are 0-based + while (ii < brow) + row = sh.item(rowcnt++); + nr_of_cells = min (row.getLength (), rcol); + rightmcol = max (rightmcol, nr_of_cells); # Keep track of max row length + # Read column (cell, "table-cell" in ODS speak) by column + jj = lcol; + while (jj <= rcol) + tcell = row.getCellAt(jj-1); + form = 0; + if (~isempty (tcell)) # If empty it's possibly in columns-repeated/spanned + if (spsh_opts.formulas_as_text) # Get spreadsheet formula rather than value + # Check for formula attribute + tmp = tcell.getTableFormulaAttribute (); + if isempty (tmp) + form = 0; + else + if (strcmp (tolower (tmp(1:3)), 'of:')) + tmp (1:end-3) = tmp(4:end); + endif + rawarr(ii-trow+2, jj-lcol+1) = tmp; + form = 1; + endif + endif + if ~(form || index (char(tcell), 'text:p>Err:') || index (char(tcell), 'text:p>#DIV')) + # Get data from cell + ctype = tcell.getOfficeValueTypeAttribute (); + cvalue = tcell.getOfficeValueAttribute (); + switch deblank (ctype) + case {'float', 'currency', 'percentage'} + rawarr(ii-trow+2, jj-lcol+1) = cvalue; + case 'date' + cvalue = tcell.getOfficeDateValueAttribute (); + # Dates are returned as octave datenums, i.e. 0-0-0000 based + yr = str2num (cvalue(1:4)); + mo = str2num (cvalue(6:7)); + dy = str2num (cvalue(9:10)); + if (index (cvalue, 'T')) + hh = str2num (cvalue(12:13)); + mm = str2num (cvalue(15:16)); + ss = str2num (cvalue(18:19)); + rawarr(ii-trow+2, jj-lcol+1) = datenum (yr, mo, dy, hh, mm, ss); + else + rawarr(ii-trow+2, jj-lcol+1) = datenum (yr, mo, dy); + endif + case 'time' + cvalue = tcell.getOfficeTimeValueAttribute (); + if (index (cvalue, 'PT')) + hh = str2num (cvalue(3:4)); + mm = str2num (cvalue(6:7)); + ss = str2num (cvalue(9:10)); + rawarr(ii-trow+2, jj-lcol+1) = datenum (0, 0, 0, hh, mm, ss); + endif + case 'boolean' + cvalue = tcell.getOfficeBooleanValueAttribute (); + rawarr(ii-trow+2, jj-lcol+1) = cvalue; + case 'string' + cvalue = tcell.getOfficeStringValueAttribute (); + if (isempty (cvalue)) # Happens with e.g., hyperlinks + tmp = char (tcell); + # Hack string value from between tags + ist = findstr (tmp, ' 0 && (ii + extrarows) < 65535) + # Expand rawarr cf. table-row + nr_of_rows = nr_of_rows + extrarows; + ii = ii + extrarows; + endif + ++ii; + endwhile + + # Keep track of data rectangle limits + ods.limits = [lcol, rcol; trow, brow]; + +endfunction + + +#=========================================================================== + +## Copyright (C) 2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## ods3jotk2oct: internal function for reading odf files using odfdom-0.8.6 + +## Author: Philip Nienhuis +## Created: 2010-08-24. First workable version Aug 27, 2010 +## Updates: +## 2010-10-27 Moved cropping rawarr from empty outer rows & columns to caller +## 2010-11-13 Added workaround for reading text cells in files made by jOpenDocument 1.2bx +## 2011-09-18 Comment out workaround for jOpenDocument bug (no OfficeValueAttr set) +## because this casts all numeric cells to string type for properly written ODS1.2 +## '' Remove rstatus var (now set in caller) + +function [ rawarr, ods ] = ods3jotk2oct (ods, wsh, crange, spsh_opts) + + # Get contents and table stuff from the workbook + odfcont = ods.workbook; # Use a local copy just to be sure. octave + # makes physical copies only when needed (?) + + # Parse sheets ("tables") from ODS file + sheets = ods.app.getTableList(); + nr_of_sheets = sheets.size (); + + # Check user input & find sheet pointer (1-based) + if (~isnumeric (wsh)) + try + sh = ods.app.getTableByName (wsh); + sh_err = isempty (sh); + catch + sh_err = 1; + end_try_catch + if (sh_err) + error (sprintf ("Sheet %s not found in file %s\n", wsh, ods.filename)); + endif + elseif (wsh > nr_of_sheets || wsh < 1) + # We already have a numeric sheet pointer. If it's not in range: + error (sprintf ("Worksheet no. %d out of range (1 - %d)", wsh, nr_of_sheets)); + else + sh = sheets.get (wsh - 1); + endif + + # Either parse (given cell range) or prepare (unknown range) help variables + if (isempty (crange)) + if ~isnumeric (wsh) + # Get sheet index + jj = nr_of_sheets; + while jj-- >= 0 + if (strcmp (wsh, sheets.get(jj).getTableName()) == 1) + wsh = jj +1; + jj = -1; + endif + endwhile + endif + [ trow, brow, lcol, rcol ] = getusedrange (ods, wsh); + nrows = brow - trow + 1; # Number of rows to be read + ncols = rcol - lcol + 1; # Number of columns to be read + else + [dummy, nrows, ncols, trow, lcol] = parse_sp_range (crange); + # Check ODS row/column limits + if (lcol > 1024 || trow > 65536) + error ("ods2oct: invalid range; max 1024 columns & 65536 rows."); + endif + # Truncate range silently if needed + rcol = min (lcol + ncols - 1, 1024); + ncols = min (ncols, 1024 - lcol + 1); + nrows = min (nrows, 65536 - trow + 1); + brow = trow + nrows - 1; + endif + + # Create storage for data content + rawarr = cell (nrows, ncols); + + # Read from worksheet row by row. Row numbers are 0-based + for ii=trow:nrows+trow-1 + row = sh.getRowByIndex (ii-1); + for jj=lcol:ncols+lcol-1; + ocell = row.getCellByIndex (jj-1); + if ~isempty (ocell) + otype = deblank (tolower (ocell.getValueType ())); + if (spsh_opts.formulas_as_text) + if ~isempty (ocell.getFormula ()) + otype = 'formula'; + endif + endif +# # Provisions for catching jOpenDocument 1.2b bug where text cells +# # haven't been assigned an attribute +# if (~isempty (ocell)) +# if (findstr (' tags +# ist = findstr (tmp, ' +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## ods2oct - get data out of an ODS spreadsheet into octave using jOpenDocument. +## Watch out, no error checks, and spreadsheet formula error results +## are conveyed as 0 (zero). +## +## Author: Philip Nienhuis +## Created: 2009-12-13 +## Last updates: + +## 2010-08-12 Added separate stanzas for jOpenDocument v 1.2b3 and up. This version +## allows better cell type parsing and is therefore more reliable +## 2010-10-27 Moved cropping rawarr from empty outer rows & columns to here +## 2010-11-13 Added workaround for reading text cells in files made by jOpenDocument 1.2bx +## 2011-09-18 Comment out workaround for jOpenDocument bug (no OfficeValueAttr set) +## because this casts all numeric cells to string type for properly written ODS1.2 +## '' Remove rstatus var (now set in caller) +## 2012-02-25 Fix reading string values written by JOD itself (no text attribue!!). But +## the cntents could be BOOLEAN as well (JOD doesn't write OffVal attr either) +## 2012-02-26 Further workaround for reading strings (actually: cells w/o OfficeValueAttr) + +function [ rawarr, ods] = ods2jod2oct (ods, wsh, crange) + + persistent months; + months = {"JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC"}; + + # Check jOpenDocument version + sh = ods.workbook.getSheet (0); + cl = sh.getCellAt (0, 0); + if (ods.odfvsn == 3) + # 1.2b3+ has public getValueType () + persistent ctype; + if (isempty (ctype)) + BOOLEAN = char (java_get ('org.jopendocument.dom.ODValueType', 'BOOLEAN')); + CURRENCY = char (java_get ('org.jopendocument.dom.ODValueType', 'CURRENCY')); + DATE = char (java_get ('org.jopendocument.dom.ODValueType', 'DATE')); + FLOAT = char (java_get ('org.jopendocument.dom.ODValueType', 'FLOAT')); + PERCENTAGE = char (java_get ('org.jopendocument.dom.ODValueType', 'PERCENTAGE')); + STRING = char (java_get ('org.jopendocument.dom.ODValueType', 'STRING')); + TIME = char (java_get ('org.jopendocument.dom.ODValueType', 'TIME')); + endif +# else +# # 1.2b2 has not +# ver = 2; + endif + + if (isnumeric (wsh)) wsh = wsh - 1; endif # Sheet INDEX starts at 0 + # Check if sheet exists. If wsh = numeric, nonexistent sheets throw errors. + try + sh = ods.workbook.getSheet (wsh); + catch + error ("Illegal sheet number (%d) requested for file %s\n", wsh+1, ods.filename); + end_try_catch + # If wsh = string, nonexistent sheets yield empty results + if (isempty (sh)) + error ("No sheet called '%s' present in file %s\n", wsh, ods.filename); + endif + + # Either parse (given cell range) or prepare (unknown range) help variables + if (isempty (crange)) + if (ods.odfvsn < 3) + error ("No empty read range allowed in jOpenDocument version 1.2b2") + else + if (isnumeric (wsh)) wsh = wsh + 1; endif + [ trow, brow, lcol, rcol ] = getusedrange (ods, wsh); + nrows = brow - trow + 1; # Number of rows to be read + ncols = rcol - lcol + 1; # Number of columns to be read + endif + else + [dummy, nrows, ncols, trow, lcol] = parse_sp_range (crange); + # Check ODS column limits + if (lcol > 1024 || trow > 65536) + error ("ods2oct: invalid range; max 1024 columns & 65536 rows."); + endif + # Truncate range silently if needed + rcol = min (lcol + ncols - 1, 1024); + ncols = min (ncols, 1024 - lcol + 1); + nrows = min (nrows, 65536 - trow + 1); + brow= trow + nrows - 1; + endif + # Create storage for data content + rawarr = cell (nrows, ncols); + + if (ods.odfvsn >= 3) + # Version 1.2b3+ + for ii=1:nrows + for jj = 1:ncols + try + scell = sh.getCellAt (lcol+jj-2, trow+ii-2); + sctype = char (scell.getValueType ()); + switch sctype + case { FLOAT, CURRENCY, PERCENTAGE } + rawarr{ii, jj} = scell.getValue ().doubleValue (); + case BOOLEAN + rawarr {ii, jj} = scell.getValue () == 1; + case STRING + rawarr{ii, jj} = scell.getValue(); + case DATE + tmp = strsplit (char (scell.getValue ()), ' '); + yy = str2num (tmp{6}); + mo = find (ismember (months, toupper (tmp{2})) == 1); + dd = str2num (tmp{3}); + hh = str2num (tmp{4}(1:2)); + mi = str2num (tmp{4}(4:5)); + ss = str2num (tmp{4}(7:8)); + rawarr{ii, jj} = datenum (yy, mo, dd, hh, mi, ss); + case TIME + tmp = strsplit (char (scell.getValue ().getTime ()), ' '); + hh = str2num (tmp{4}(1:2)) / 24.0; + mi = str2num (tmp{4}(4:5)) / 1440.0; + ss = str2num (tmp{4}(7:8)) / 86600.0; + rawarr {ii, jj} = hh + mi + ss; + otherwise + # Workaround for sheets written by jOpenDocument (no value-type attrb): + if (~isempty (scell.getValue) ) + # FIXME Assume cell contains string if there's a text attr. But it could be BOOLEAN too... + if (findstr (' +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## ods2uno2oct + +## Author: Philip Nienhuis +## Created: 2011-05-05 +## Updates: +## 2011-09-18 Adapted sh_names type to LO 3.4.1 +## '' Remove default 2 last sheets (LibreOffice 3.4.+) +## '' Remove rstatus var (now set in caller) +## 2011-09-19 Try to decipher if formulas return numeric or string values + +function [rawarr, ods] = ods2uno2oct (ods, wsh, datrange, spsh_opts) + + sheets = ods.workbook.getSheets (); + sh_names = sheets.getElementNames (); + if (! iscell (sh_names)) + # Java array (LibreOffice 3.4.+); convert to cellstr + sh_names = char (sh_names); + else + sh_names = {sh_names}; + endif + + # Check sheet pointer + if (isnumeric (wsh)) + if (wsh < 1 || wsh > numel (sh_names)) + error ("Sheet index %d out of range 1-%d", wsh, numel (sh_names)); + endif + else + ii = strmatch (wsh, sh_names); + if (isempty (ii)), error ("Sheet '%s' not found", wsh); endif + wsh = ii; + endif + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.sheet.XSpreadsheet'); + sh = sheets.getByName (sh_names{wsh}).getObject.queryInterface (unotmp); + + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.sheet.XCellRangesQuery'); + xRQ = sh.queryInterface (unotmp); + # Get cell ranges of all rectangles containing data. Type values: + #java_get ('com.sun.star.sheet.CellFlags', 'VALUE') ans = 1 + #java_get ('com.sun.star.sheet.CellFlags', 'DATETIME') ans = 2 + #java_get ('com.sun.star.sheet.CellFlags', 'STRING') ans = 4 + #java_get ('com.sun.star.sheet.CellFlags', 'FORMULA') ans = 16 + # Yep, boolean is lacking... + Cellflgs = javaObject ("java.lang.Short", "23"); + ccells = xRQ.queryContentCells (Cellflgs); + addrs = ccells.getRangeAddressesAsString (); + + # Strip sheet name from addresses + adrblks = strsplit (addrs, ','); + if (isempty (adrblks)) + warning ('Sheet %s contains no data', sh_names{wsh}); + return + endif + + # Either parse (given cell range) or prepare (unknown range) help variables. + # As OpenOffice knows the occupied range, we need the limits anyway to avoid + # out-of-range errors + [ trow, brow, lcol, rcol ] = getusedrange (ods, wsh); + if (isempty (datrange)) + nrows = brow - trow + 1; # Number of rows to be read + ncols = rcol - lcol + 1; # Number of columns to be read + else + [dummy, nrows, ncols, srow, scol] = parse_sp_range (datrange); + # Truncate range silently if needed + brow = min (srow + nrows - 1, brow); + rcol = min (scol + ncols - 1, rcol); + trow = max (trow, srow); + lcol = max (lcol, scol); + nrows = min (brow - trow + 1, nrows); # Number of rows to be read + ncols = min (rcol - lcol + 1, ncols); # Number of columns to be read + endif + # Create storage for data at Octave side + rawarr = cell (nrows, ncols); + + # Get data. Apparently row & column indices are 0-based in UNO + for ii=trow-1:brow-1 + for jj=lcol-1:rcol-1 + XCell = sh.getCellByPosition (jj, ii); + cType = XCell.getType().getValue (); + switch cType + case 1 # Value + rawarr{ii-trow+2, jj-lcol+2} = XCell.getValue (); + case 2 # String + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.text.XText'); + rawarr{ii-trow+2, jj-lcol+2} = XCell.queryInterface (unotmp).getString (); + case 3 # Formula + if (spsh_opts.formulas_as_text) + rawarr{ii-trow+2, jj-lcol+2} = XCell.getFormula (); + else + # Unfortunately OOo gives no clue as to the type of formula result + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.text.XText'); + rawarr{ii-trow+2, jj-lcol+2} = XCell.queryInterface (unotmp).getString (); + tmp = str2double (rawarr{ii-trow+2, jj-lcol+2}); + # If the string happens to contain just a number we'll assume it is numeric + if (~isnan (tmp)); rawarr{ii-trow+2, jj-lcol+2} = tmp; endif + endif + otherwise + # Empty cell + endswitch + endfor + endfor + + # Keep track of data rectangle limits + ods.limits = [lcol, rcol; trow, brow]; + +endfunction diff --git a/octave_packages/io-1.0.19/odsclose.m b/octave_packages/io-1.0.19/odsclose.m new file mode 100644 index 0000000..6df839b --- /dev/null +++ b/octave_packages/io-1.0.19/odsclose.m @@ -0,0 +1,186 @@ +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{ods}] = odsclose (@var{ods}) +## @deftypefnx {Function File} [@var{ods}] = odsclose (@var{ods}, @var{filename}) +## @deftypefnx {Function File} [@var{ods}] = odsclose (@var{ods}, "FORCE") +## Close the OpenOffice_org Calc spreadsheet pointed to in struct +## @var{ods}, if needed write the file to disk. +## odsclose will determine if the file must be written to disk based on +## information contained in @var{ods}. +## An empty pointer struct will be returned if no errors occurred. +## Optional argument @var{filename} can be used to write changed spreadsheet +## files to an other file than opened by odsopen(). +## Optional string argument "FORCE" can be specified to force resetting the +## file pointer struct. However, in case of UNO, a hidden OOo invocation +## may linger on in memory then, preventing proper closing of Octave. +## +## You need the Java package >= 1.2.6 plus odfdom.jar + xercesImpl.jar +## and/or jopendocument-.jar installed on your computer + +## proper javaclasspath set, to make this function work at all. +## For UNO support, Octave-Java package >= 1.2.8 + latest fixes is imperative; +## furthermore the relevant classes had best be added to the javaclasspath by +## utility function chk_spreadsheet_support(). +## +## @var{ods} must be a valid pointer struct made by odsopen() in the same +## octave session. +## +## Examples: +## +## @example +## ods1 = odsclose (ods1); +## (Close spreadsheet file pointed to in pointer struct ods1; ods1 is reset) +## @end example +## +## @seealso {odsopen, odsread, odswrite, ods2oct, oct2ods, odsfinfo, chk_spreadsheet_support} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-12-13 +## Updates: +## 2010-01-08 (OTK ODS write support) +## 2010-04-13 Improved help text a little bit +## 2010-08-25 Swapped in texinfo help text +## 2010-10-17 Fixed typo in error message about unknown interface +## 2010-10-27 Improved file change tracking tru ods.changed +## 2010-11-12 Keep ods file pointer when write errors occur. +## '' Added optional filename arg to change filename to be written to +## 2011-05-06 Experimental UNO support +## 2011-05-07 In case of UNO, soffice now properly closed using xDesk +## 2011-05-18 Saving newly created files using UNO supported now +## 2011-09-08 FIXME - closing OOo kills all other OOo invocations (known Java-UNO issue) +## 2012-01-26 Fixed "seealso" help string +## 2012-06-08 tabs replaced by double space + +function [ ods ] = odsclose (ods, varargs) + + # If needed warn that dangling spreadsheet pointers may be left + if (nargout < 1) warning ("return argument missing - ods invocation not reset."); endif + + force = 0; + + if (nargin > 1) + for ii=2:nargin + if (strcmp (lower (varargin{ii}), "force")) + # Close .ods anyway even if write errors occur + force = 1; + elseif (~isempty (strfind (tolower (varargin{ii}), '.ods')) || ... + ~isempty (strfind (tolower (varargin{ii}), '.sxc'))) + # Apparently a file name + if (ods.changed == 0 || ods.changed > 2) + warning ("File %s wasn't changed, new filename ignored.", ods.filename); + else + if (strfind (tolower (filename), '.sxc') || strfind (tolower (filename), '.ods')) + ods.filename = filename; + else + error ('No .sxc or .ods filename extension specified'); + endif + endif + endif + endfor + endif + + if (strcmp (ods.xtype, 'OTK')) + # Java & ODF toolkit + try + if (ods.changed && ods.changed < 3) + ods.app.save (ods.filename); + ods.changed = 0; + endif + ods.app.close (); + catch + if (force) + ods.app.close (); + endif + end_try_catch + + elseif (strcmp (ods.xtype, 'JOD')) + # Java & jOpenDocument + try + if (ods.changed && ods.changed < 3) + ofile = java_new ('java.io.File', ods.filename); + ods.workbook.saveAs (ofile); + ods.changed = 0; + endif + catch + end_try_catch + + elseif (strcmp (ods.xtype, 'UNO')) + # Java & UNO bridge + try + if (ods.changed && ods.changed < 3) + # Workaround: + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.frame.XModel'); + xModel = ods.workbook.queryInterface (unotmp); + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.util.XModifiable'); + xModified = xModel.queryInterface (unotmp); + if (xModified.isModified ()) + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.frame.XStorable'); # isReadonly() ? + xStore = ods.app.xComp.queryInterface (unotmp); + if (ods.changed == 2) + # Some trickery as Octave Java cannot create non-numeric arrays + lProps = javaArray ('com.sun.star.beans.PropertyValue', 1); + lProp = java_new ('com.sun.star.beans.PropertyValue', "Overwrite", 0, true, []); + lProps(1) = lProp; + # OK, save file to disk + xStore.storeAsURL (ods.filename, lProps); + else + xStore.store (); + endif + endif + endif + ods.changed = -1; # Needed for check op properly shutting down OOo + # Workaround: + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.frame.XModel'); + xModel = ods.app.xComp.queryInterface (unotmp); + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.util.XCloseable'); + xClosbl = xModel.queryInterface (unotmp); + xClosbl.close (true); + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.frame.XDesktop'); + xDesk = ods.app.aLoader.queryInterface (unotmp); + xDesk.terminate(); + ods.changed = 0; + catch + if (force) + # Force closing OOo + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.frame.XDesktop'); + xDesk = ods.app.aLoader.queryInterface (unotmp); + xDesk.terminate(); + else + warning ("Error dbclosing ods pointer (UNO)"); + endif + return + end_try_catch + +# elseif ---- < Other interfaces here > + + else + error (sprintf ("ods2close: unknown OpenOffice.org .ods interface - %s.", ods.xtype)); + + endif + + if (ods.changed && ods.changed < 3) + error ( sprintf ("Could not save file %s - read-only or in use elsewhere?\nFile pointer preserved", ods.filename)); + if (force) + ods = []; + endif + else + # Reset file pointer + ods = []; + endif + +endfunction diff --git a/octave_packages/io-1.0.19/odsfinfo.m b/octave_packages/io-1.0.19/odsfinfo.m new file mode 100644 index 0000000..ed0e0d9 --- /dev/null +++ b/octave_packages/io-1.0.19/odsfinfo.m @@ -0,0 +1,188 @@ +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{filetype}] = odsfinfo (@var{filename} [, @var{reqintf}]) +## @deftypefnx {Function File} [@var{filetype}, @var{sh_names}] = odsfinfo (@var{filename} [, @var{reqintf}]) +## Query an OpenOffice_org spreadsheet file @var{filename} (with ods +## suffix) for some info about its contents. +## +## If @var{filename} is a recognizable OpenOffice.org spreadsheet file, +## @var{filetype} returns the string "OpenOffice.org Calc spreadsheet", +## or @'' (empty string) otherwise. +## +## If @var{filename} is a recognizable OpenOffice.org Calc spreadsheet +## file, optional argument @var{sh_names} contains a list (cell array) +## of sheet names contained in @var{filename}, in the order (from left +## to right) in which they occur in the sheet stack. +## +## If you omit return arguments @var{filetype} and @var{sh_names} altogether, +## odsfinfo returns the sheet names and for each sheet the actual occupied +## data ranges to the screen.The occupied cell range will have to be +## determined behind the scenes first; this can take some time. +## +## odsfinfo execution can take its time for large spreadsheets as the entire +## spreadsheet has to be parsed to get the sheet names, let alone exploring +## used data ranges. +## +## By specifying a value of 'jod', 'otk' or 'uno' for @var{reqintf} the automatic +## selection of the java interface is bypassed and the specified interface +## will be used (if at all present). +## +## Examples: +## +## @example +## exist = odsfinfo ('test4.ods'); +## (Just checks if file test4.ods is a readable Calc file) +## @end example +## +## @example +## [exist, names] = odsfinfo ('test4.ods'); +## (Checks if file test4.ods is a readable Calc file and return a +## list of sheet names) +## @end example +## +## @seealso {odsread, odsopen, ods2oct, odsclose} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-12-17 +## Updates: +## 2010-01-03 Added functionality for JOD as well +## 2010-03-03 Fixed echo of proper number of occupied data rows +## 2010-03-18 Fixed proper echo of occupied data range +## (ah those pesky table-row-repeated & table-column-repeated attr.... :-( ) +## 2010-03-18 Separated range exploration (for OTK only yet) in separate function file +## 2010-03-20 "Beautified" output (for OTK ), used range now in more tabular form +## 2010-05-23 Updated jOpenDocument support (can also get occupied data range now) +## 2010-05-31 Added remark about delays when determining occupied data range +## 2011-03-23 Adapted to odfdom 0.8.7 (changed getXPath method call) +## 2011-05-07 Experimental UNO support added +## 2011-09-03 Normal return in case of no ODS support (empty ods struct) +## 2012-01-26 Fixed "seealso" help string +## 2012-02-25 Return occupied sheet ranges in output args +## '' Improve echo of sheet names & ranges if interactive +## 2012-03-01 Fix wrong cell refs in UNO section ("(..)" rather than "{..}" +## 2012-06-08 Support for odfdom-0.8.8-incubator + +function [ filetype, sheetnames ] = odsfinfo (filename, reqintf=[]) + + onscreen = nargout < 1; + + ods = odsopen (filename, 0, reqintf); + # If no ods support was found, odsopen will have complained. Just return here + if (isempty (ods)), return; endif + + filetype = 'OpenOffice.org Calc Document'; + + persistent adj_str; adj_str = ' '; # 30 char filler string + + # To save execution time, only proceed if sheet names are wanted + if ~(nargout == 1) + + if (strcmp (ods.xtype, 'OTK')) + # Get contents and table (= sheet) stuff from the workbook + odfcont = ods.workbook; # Local copy just in case + if (strcmp (ods.odfvsn, '0.8.7') || strfind (ods.odfvsn, "0.8.8")) + xpath = ods.workbook.getXPath; + else + xpath = ods.app.getXPath; + endif + + # Create an instance of type NODESET for use in subsequent statement + NODESET = java_get ('javax.xml.xpath.XPathConstants', 'NODESET'); + # Parse sheets ("tables") from ODS file + sheets = xpath.evaluate ("//table:table", odfcont, NODESET); + nr_of_sheets = sheets.getLength(); + sheetnames = cell (nr_of_sheets, 2); + + # Get sheet names (& optionally date row count estimate) + for ii=1:nr_of_sheets + # Check in first part of the sheet nodeset + sheetnames (ii) = sheets.item(ii-1).getTableNameAttribute (); + [ tr, lr, lc, rc ] = getusedrange (ods, ii); + if (onscreen) + printf (sprintf("%s", sheetnames{ii})); + if (tr) + printf (sprintf("%s (used range = %s:%s)", \ + adj_str(1:(30 - length (sheetnames{ii}))), \ + calccelladdress (tr, lc), calccelladdress (lr, rc))); + else + printf ("%s (empty)", adj_str(1:(30 - length (sheetnames{ii})))); + endif + printf ("\n"); + endif + if (tr) + sheetnames(ii, 2) = sprintf ("%s:%s", calccelladdress (tr, lc), calccelladdress (lr, rc)); + endif + endfor + + elseif (strcmp (ods.xtype, 'JOD')) + nr_of_sheets = ods.workbook.getSheetCount (); + sheetnames = cell (nr_of_sheets, 2); + for ii=1:nr_of_sheets + sheetnames(ii) = ods.workbook.getSheet (ii-1).getName (); + [ tr, lr, lc, rc ] = getusedrange (ods, ii); + if (onscreen) + printf (sprintf("%s", sheetnames{ii})); + if (tr) + printf (sprintf("%s (used range = %s:%s)", \ + adj_str(1:(30 - length (sheetnames{ii}))), \ + calccelladdress (tr, lc), calccelladdress (lr, rc))); + else + printf ("%s (empty)", adj_str(1:(30 - length (sheetnames{ii})))); + endif + printf ("\n"); + endif + if (tr) + sheetnames(ii, 2) = sprintf ("%s:%s", calccelladdress (tr, lc), calccelladdress (lr, rc)); + endif + endfor + + elseif (strcmp (ods.xtype, 'UNO')) + sheets = ods.workbook.getSheets (); + sheetnames = sheets.getElementNames (); # A Java object, NOT a cell array + nr_of_sheets = numel (sheetnames); + sheetnames = char (sheetnames); + for ii=1:nr_of_sheets + [ tr, lr, lc, rc ] = getusedrange (ods, ii); + if (onscreen) + printf (sprintf("%s", sheetnames{ii})); # () as it is a Java object + if (tr) + printf (sprintf ("%s (used range = %s:%s)", \ + adj_str (1:(30 - length (sheetnames{ii}))), \ + calccelladdress (tr, lc), calccelladdress (lr, rc))); + else + printf ("%s (empty)", adj_str(1:(30 - length (sheetnames{ii})))); + endif + printf ("\n"); + endif + if (tr) + sheetnames(ii, 2) = sprintf ("%s:%s", calccelladdress (tr, lc), calccelladdress (lr, rc)); + endif + + endfor + + else +# error (sprintf ("odsfinfo: unknown OpenOffice.org .ods interface - %s.", ods.xtype)); + + endif + endif + + ods = odsclose (ods); + +endfunction + diff --git a/octave_packages/io-1.0.19/odsopen.m b/octave_packages/io-1.0.19/odsopen.m new file mode 100644 index 0000000..3f02ddc --- /dev/null +++ b/octave_packages/io-1.0.19/odsopen.m @@ -0,0 +1,551 @@ +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## 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{ods} = odsopen (@var{filename}) +## @deftypefnx {Function File} @var{ods} = odsopen (@var{filename}, @var{readwrite}) +## @deftypefnx {Function File} @var{ods} = odsopen (@var{filename}, @var{readwrite}, @var{reqintf}) +## Get a pointer to an OpenOffice_org spreadsheet in the form of return +## argument @var{ods}. +## +## Calling odsopen without specifying a return argument is fairly useless! +## +## To make this function work at all, you need the Java package >= 1.2.5 plus +## ODFtoolkit (version 0.7.5 or 0.8.6+) & xercesImpl, and/or jOpenDocument, and/or +## OpenOffice.org (or clones) installed on your computer + proper javaclasspath +## set. These interfaces are referred to as OTK, JOD, and UNO resp., and are +## preferred in that order by default (depending on their presence). +## For (currently experimental) UNO support, Octave-Java package 1.2.8 + latest +## fixes is imperative; furthermore the relevant classes had best be added to +## the javaclasspath by utility function chk_spreadsheet_support(). +## +## @var{filename} must be a valid .ods OpenOffice.org file name including +## .ods suffix. If @var{filename} does not contain any directory path, +## the file is saved in the current directory. +## For UNO bridge, filenames need to be in the form "file:////filename"; +## a URL will also work. If a plain file name is given (absolute or relative), +## odsopen() will transform it into proper form. +## +## @var{readwrite} must be set to true or numerical 1 if writing to spreadsheet +## is desired immediately after calling odsopen(). It merely serves proper +## handling of file errors (e.g., "file not found" or "new file created"). +## +## Optional input argument @var{reqintf} can be used to override the ODS +## interface automatically selected by odsopen. Currently implemented interfaces +## are 'OTK' (Java/ODF Toolkit), 'JOD' (Java/jOpenDocument) and 'UNO' +## (Java/OpenOffice.org UNO bridge). +## +## Examples: +## +## @example +## ods = odsopen ('test1.ods'); +## (get a pointer for reading from spreadsheet test1.ods) +## +## ods = odsopen ('test2.ods', [], 'JOD'); +## (as above, indicate test2.ods will be read from; in this case using +## the jOpenDocument interface is requested) +## @end example +## +## @seealso {odsclose, odsread, oct2ods, ods2oct, odsfinfo, chk_spreadsheet_support} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-12-13 +## Updates: +## 2009-12-30 .... +## 2010-01-17 Make sure proper dimensions are checked in parsed javaclasspath +## 2010-01-24 Added warning when trying to create a new spreadsheet using jOpenDocument +## 2010-03-01 Removed check for rt.jar in javaclasspath +## 2010-03-04 Slight texinfo adaptation (reqd. odfdom version = 0.7.5) +## 2010-03-14 Updated help text (section on readwrite) +## 2010-06-01 Added check for jOpenDocument version + suitable warning +## 2010-06-02 Added ";" to supress debug stuff around lines 115 +## '' Moved JOD version check to subfunc getodsinterfaces +## '' Fiddled ods.changed flag when creating a spreadsheet to avoid unnamed 1st sheets +## 2010-08-23 Added version field "odfvsn" to ods file ptr, set in getodsinterfaces() (odfdom) +## '' Moved JOD version check to this func from subfunc getodsinterfaces() +## '' Full support for odfdom 0.8.6 (in subfunc) +## 2010-08-27 Improved help text +## 2010-10-27 Improved tracking of file changes tru ods.changed +## 2010-11-12 Small changes to help text +## '' Added try-catch to file open sections to create fallback to other intf +## 2011-05-06 Experimental UNO support +## 2011-05-18 Creating new spreadsheet docs in UNO now works +## 2011-06-06 Tamed down interface verbosity on first startup +## '' Multiple requested interfaces now possible +## 2011-09-03 Reset chkintf if no ods support was found to allow full interface rediscovery +## (otherwise javaclasspath additions will never be picked up) +## 2012-01-26 Fixed "seealso" help string +## 2012-02-26 Added ";" to suppress echo of filename f UNO +## 2012-06-06 Made interface checking routine less verbose when same requested interface +## was used consecutively +## +## Latest change on subfunctions below: 2012-06-08 + +function [ ods ] = odsopen (filename, rw=0, reqinterface=[]) + + persistent odsinterfaces; persistent chkintf; persistent lastintf; + if (isempty (chkintf)) + odsinterfaces = struct ( "OTK", [], "JOD", [], "UNO", [] ); + chkintf = 1; + endif + if (isempty (lastintf)); lastintf = '---'; endif + + if (nargout < 1) usage ("ODS = odsopen (ODSfile, [Rw]). But no return argument specified!"); endif + + if (~isempty (reqinterface)) + if ~(ischar (reqinterface) || iscell (reqinterface)), usage ("Arg # 3 not recognized"); endif + # Turn arg3 into cell array if needed + if (~iscell (reqinterface)), reqinterface = {reqinterface}; endif + ## Check if previously used interface matches a requested interface + if (isempty (regexpi (reqinterface, lastintf, 'once'){1})) + ## New interface requested + odsinterfaces.OTK = 0; odsinterfaces.JOD = 0; odsinterfaces.UNO = 0; + for ii=1:numel (reqinterface) + reqintf = toupper (reqinterface {ii}); + # Try to invoke requested interface(s) for this call. Check if it + # is supported anyway by emptying the corresponding var. + if (strcmp (reqintf, 'OTK')) + odsinterfaces.OTK = []; + elseif (strcmp (reqintf, 'JOD')) + odsinterfaces.JOD = []; + elseif (strcmp (reqintf, 'UNO')) + odsinterfaces.UNO = []; + else + usage (sprintf ("Unknown .ods interface \"%s\" requested. Only OTK, JOD or UNO supported\n", reqinterface{})); + endif + endfor + printf ("Checking requested interface(s):\n"); + odsinterfaces = getodsinterfaces (odsinterfaces); + # Well, is/are the requested interface(s) supported on the system? + # FIXME check for multiple interfaces + odsintf_cnt = 0; + for ii=1:numel (reqinterface) + if (~odsinterfaces.(toupper (reqinterface{ii}))) + # No it aint + printf ("%s is not supported.\n", toupper (reqinterface{ii})); + else + ++odsintf_cnt; + endif + endfor + # Reset interface check indicator if no requested support found + if (~odsintf_cnt) + chkintf = []; + ods = []; + return + endif + endif + endif + + # Var rw is really used to avoid creating files when wanting to read, or + # not finding not-yet-existing files when wanting to write. + + if (rw), rw = 1; endif # Be sure it's either 0 or 1 initially + + # Check if ODS file exists. Set open mode based on rw argument + if (rw), fmode = 'r+b'; else fmode = 'rb'; endif + fid = fopen (filename, fmode); + if (fid < 0) + if (~rw) # Read mode requested but file doesn't exist + err_str = sprintf ("File %s not found\n", filename); + error (err_str) + else # For writing we need more info: + fid = fopen (filename, 'rb'); # Check if it can be opened for reading + if (fid < 0) # Not found => create it + printf ("Creating file %s\n", filename); + rw = 3; + else # Found but not writable = error + fclose (fid); # Do not forget to close the handle neatly + error (sprintf ("Write mode requested but file %s is not writable\n", filename)) + endif + endif + else + # close file anyway to avoid Java errors + fclose (fid); + endif + +# Check for the various ODS interfaces. No problem if they've already +# been checked, getodsinterfaces (far below) just returns immediately then. + + [odsinterfaces] = getodsinterfaces (odsinterfaces); + +# Supported interfaces determined; now check ODS file type. + + chk1 = strcmp (tolower (filename(end-3:end)), '.ods'); + # Only jOpenDocument (JOD) can read from .sxc files, but only if odfvsn = 2 + chk2 = strcmp (tolower (filename(end-3:end)), '.sxc'); +# if (~chk1) +# error ("Currently ods2oct can only read reliably from .ods files") +# endif + + ods = struct ("xtype", [], "app", [], "filename", [], "workbook", [], "changed", 0, "limits", [], "odfvsn", []); + + # Preferred interface = OTK (ODS toolkit & xerces), so it comes first. + # Keep track of which interface is selected. Can be used for fallback to other intf + odssupport = 0; + + if (odsinterfaces.OTK && ~odssupport) + # Parts after user gfterry in + # http://www.oooforum.org/forum/viewtopic.phtml?t=69060 + odftk = 'org.odftoolkit.odfdom.doc'; + try + if (rw > 2) + # New spreadsheet + wb = java_invoke ([odftk '.OdfSpreadsheetDocument'], 'newSpreadsheetDocument'); + else + # Existing spreadsheet + wb = java_invoke ([odftk '.OdfDocument'], 'loadDocument', filename); + endif + ods.workbook = wb.getContentDom (); # Reads the entire spreadsheet + ods.xtype = 'OTK'; + ods.app = wb; + ods.filename = filename; + ods.odfvsn = odsinterfaces.odfvsn; + odssupport += 1; + lastintf = 'OTK'; + catch + if (odsinterfaces.JOD && ~rw && chk2) + printf ('Couldn''t open file %s using OTK; trying .sxc format with JOD...\n', filename); + else + error ('Couldn''t open file %s using OTK', filename); + endif + end_try_catch + endif + + if (odsinterfaces.JOD && ~odssupport) + file = java_new ('java.io.File', filename); + jopendoc = 'org.jopendocument.dom.spreadsheet.SpreadSheet'; + try + if (rw > 2) + # Create an empty 2 x 2 default TableModel template + tmodel= java_new ('javax.swing.table.DefaultTableModel', 2, 2); + wb = java_invoke (jopendoc, 'createEmpty', tmodel); + else + wb = java_invoke (jopendoc, 'createFromFile', file); + endif + ods.workbook = wb; + ods.filename = filename; + ods.xtype = 'JOD'; + ods.app = 'file'; + # Check jOpenDocument version. This can only work here when a + # workbook has been opened + sh = ods.workbook.getSheet (0); + cl = sh.getCellAt (0, 0); + try + # 1.2b3 has public getValueType () + cl.getValueType (); + ods.odfvsn = 3; + catch + # 1.2b2 has not + ods.odfvsn = 2; + printf ("NOTE: jOpenDocument v. 1.2b2 has limited functionality. Try upgrading to 1.2\n"); + end_try_catch + odssupport += 2; + lastintf = 'JOD'; + catch + error ('Couldn''t open file %s using JOD', filename); + end_try_catch + endif + + if (odsinterfaces.UNO && ~odssupport) + # First the file name must be transformed into a URL + if (~isempty (strmatch ("file:///", filename)) || ~isempty (strmatch ("http:///", filename))... + || ~isempty (strmatch ("ftp:///", filename)) || ~isempty (strmatch ("www:///", filename))) + # Seems in proper shape for OOO (at first sight) + else + # Transform into URL form + fname = canonicalize_file_name (strsplit (filename, filesep){end}); + # On Windows, change backslash file separator into forward slash + if (strcmp (filesep, "\\")) + tmp = strsplit (fname, filesep); + flen = numel (tmp); + tmp(2:2:2*flen) = tmp; + tmp(1:2:2*flen) = '/'; + fname = [ tmp{:} ]; + endif + filename = [ 'file://' fname ]; + endif + try + xContext = java_invoke ("com.sun.star.comp.helper.Bootstrap", "bootstrap"); + xMCF = xContext.getServiceManager (); + oDesktop = xMCF.createInstanceWithContext ("com.sun.star.frame.Desktop", xContext); + # Workaround: + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.frame.XComponentLoader'); + aLoader = oDesktop.queryInterface (unotmp); + # Some trickery as Octave Java cannot create non-numeric arrays + lProps = javaArray ('com.sun.star.beans.PropertyValue', 1); + lProp = java_new ('com.sun.star.beans.PropertyValue', "Hidden", 0, true, []); + lProps(1) = lProp; + if (rw > 2) + xComp = aLoader.loadComponentFromURL ("private:factory/scalc", "_blank", 0, lProps); + else + xComp = aLoader.loadComponentFromURL (filename, "_blank", 0, lProps); + endif + # Workaround: + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.sheet.XSpreadsheetDocument'); + # save in ods struct: + xSpdoc = xComp.queryInterface (unotmp); + ods.workbook = xSpdoc; # Needed to be able to close soffice in odsclose() + ods.filename = filename; + ods.xtype = 'UNO'; + ods.app.xComp = xComp; # Needed to be able to close soffice in odsclose() + ods.app.aLoader = aLoader; # Needed to be able to close soffice in odsclose() + ods.odfvsn = 'UNO'; + odssupport += 4; + lastintf = 'UNO'; + catch + error ('Couldn''t open file %s using UNO', filename); + end_try_catch + endif + +# if +# + + if (~odssupport) + printf ("None.\n"); + warning ("No support for OpenOffice.org .ods I/O"); + ods = []; + chkintf = []; + else + # From here on rw is tracked via ods.changed in the various lower + # level r/w routines and it is only used to determine if an informative + # message is to be given when saving a newly created ods file. + ods.changed = rw; + + # Until something was written to existing files we keep status "unchanged". + # ods.changed = 0 (existing/only read from), 1 (existing/data added), 2 (new, + # data added) or 3 (pristine, no data added). + if (ods.changed == 1) ods.changed = 0; endif + endif + +endfunction + + +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## 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{odsinterfaces} = getodsinterfaces (@var{odsinterfaces}) +## Get supported OpenOffice.org .ods file read/write interfaces from +## the system. +## Each interface for which the corresponding field is set to empty +## will be checked. So by manipulating the fields of input argument +## @var{odsinterfaces} it is possible to specify which +## interface(s) should be checked. +## +## Currently implemented interfaces comprise: +## - Java & ODFtoolkit (www.apache.org) +## - Java & jOpenDocument (www.jopendocument.org) +## - Java & UNO bridge (OpenOffice.org) +## +## Examples: +## +## @example +## odsinterfaces = getodsinterfaces (odsinterfaces); +## @end example + +## Author: Philip Nienhuis +## Created: 2009-12-27 +## Updates: +## 2010-01-14 +## 2010-01-17 Make sure proper dimensions are checked in parsed javaclasspath +## 2010-04-11 Introduced check on odfdom.jar version - only 0.7.5 works properly +## 2010-06-02 Moved in check on JOD version +## 2010-06-05 Experimental odfdom 0.8.5 support +## 2010-06-## dropped 0.8.5, too buggy +## 2010-08-22 Experimental odfdom 0.8.6 support +## 2010-08-23 Added odfvsn (odfdom version string) to output struct argument +## '' Bugfix: moved JOD version check to main function (it can't work here) +## '' Finalized odfdom 0.8.6 support (even prefered version now) +## 2010-09-11 Somewhat clarified messages about missing java classes +## '' Rearranged code a bit; fixed typos in OTK detection code (odfdvsn -> odfvsn) +## 2010-09-27 More code cleanup +## 2010-11-12 Warning added about waning support for odfdom v. 0.7.5 +## 2011-05-06 Fixed wrong strfind tests +## '' Experimental UNO support added +## 2011-05-18 Forgot to initialize odsinterfaces.UNO +## 2011-06-06 Fix for javaclasspath format in *nix w. java-1.2.8 pkg +## '' Implemented more rigid Java check +## '' Tamed down verbosity +## 2011-09-03 Fixed order of odsinterfaces. statement in Java detection try-catch +## '' Reset tmp1 (always allow interface rediscovery) for empty odsinterfaces arg +## 2011-09-18 Added temporary warning about UNO interface +## 2012-03-22 Improved Java checks (analogous to xlsopen) +## 2012-06-06 Again improved & simplified Java-based interface checking support +## 2012-06-08 Support for odfdom-0.8.8 (-incubator) + +function [odsinterfaces] = getodsinterfaces (odsinterfaces) + + # tmp1 = [] (not initialized), 0 (No Java detected), or 1 (Working Java found) + persistent tmp1 = []; persistent jcp; # Java class path + persistent uno_1st_time = 0; + + if (isempty (odsinterfaces.OTK) && isempty (odsinterfaces.JOD) && isempty (odsinterfaces.UNO)) + # Assume no interface detection has happened yet + printf ("Detected ODS interfaces: "); + tmp1 = []; + elseif (isempty (odsinterfaces.OTK) || isempty (odsinterfaces.JOD) || isempty (odsinterfaces.UNO)) + # Can't be first call. Here one of the Java interfaces is requested + if (~tmp1) + # Check Java support again + tmp1 = []; + endif + endif + deflt = 0; + + if (isempty (tmp1)) + # Check Java support + try + jcp = javaclasspath ("-all"); # For java pkg >= 1.2.8 + if (isempty (jcp)), jcp = javaclasspath; endif # For java pkg < 1.2.8 + # If we get here, at least Java works. Now check for proper version (>= 1.6) + jver = char (java_invoke ('java.lang.System', 'getProperty', 'java.version')); + cjver = strsplit (jver, '.'); + if (sscanf (cjver{2}, '%d') < 6) + warning ("\nJava version too old - you need at least Java 6 (v. 1.6.x.x)\n"); + return + endif + # Now check for proper entries in class path. Under *nix the classpath + # must first be split up. In java 1.2.8+ javaclasspath is already a cell array + if (isunix && ~iscell (jcp)), jcp = strsplit (char (jcp), pathsep ()); endif + tmp1 = 1; + catch + # No Java support + tmp1 = 0; + if (isempty (odsinterfaces.OTK) || isempty (odsinterfaces.JOD) || isempty (odsinterfaces.UNO)) + # Some or all Java-based interface explicitly requested; but no Java support + warning (' No Java support found (no Java JRE? no Java pkg installed AND loaded?'); + endif + # No specific Java-based interface requested. Just return + odsinterfaces.OTK = 0; + odsinterfaces.JOD = 0; + odsinterfaces.UNO = 0; + printf ("\n"); + return; + end_try_catch + endif + + # Try Java & ODF toolkit + if (isempty (odsinterfaces.OTK)) + odsinterfaces.OTK = 0; + jpchk = 0; entries = {"odfdom", "xercesImpl"}; + # Only under *nix we might use brute force: e.g., strfind(classpath, classname); + # under Windows we need the following more subtle, platform-independent approach: + for ii=1:length (jcp) + for jj=1:length (entries) + if (~isempty (strfind ( jcp{ii}, entries{jj}))), ++jpchk; endif + endfor + endfor + if (jpchk >= numel(entries)) # Apparently all requested classes present. + # Only now we can check for proper odfdom version (only 0.7.5 & 0.8.6 work OK). + # The odfdom team deemed it necessary to change the version call so we need this: + odfvsn = ' '; + try + # New in 0.8.6 + odfvsn = java_invoke ('org.odftoolkit.odfdom.JarManifest', 'getOdfdomVersion'); + catch + odfvsn = java_invoke ('org.odftoolkit.odfdom.Version', 'getApplicationVersion'); + end_try_catch + # For odfdom-incubator, strip extra info + odfvsn = regexp (odfvsn, '\d\.\d\.\d', "match"){1}; + if ~(strcmp (odfvsn, "0.7.5") || strcmp (odfvsn, "0.8.6") || strcmp (odfvsn, "0.8.7") + || strfind (odfvsn, "0.8.8")) + warning ("\nodfdom version %s is not supported - use v. 0.8.6 or later\n", odfvsn); + else + if (strcmp (odfvsn, '0.7.5')) + warning ("odfdom v. 0.7.5 support won't be maintained - please upgrade to 0.8.6 or higher."); + endif + odsinterfaces.OTK = 1; + printf ("OTK"); + if (deflt), printf ("; "); else, printf ("*; "); deflt = 1; endif + endif + odsinterfaces.odfvsn = odfvsn; + else + warning ("\nNot all required classes (.jar) in classpath for OTK"); + endif + endif + + # Try Java & jOpenDocument + if (isempty (odsinterfaces.JOD)) + odsinterfaces.JOD = 0; + jpchk = 0; entries = {"jOpenDocument"}; + for ii=1:length (jcp) + for jj=1:length (entries) + if (~isempty (strfind (jcp{ii}, entries{jj}))), ++jpchk; endif + endfor + endfor + if (jpchk >= numel(entries)) + odsinterfaces.JOD = 1; + printf ("JOD"); + if (deflt), printf ("; "); else, printf ("*; "); deflt = 1; endif + else + warning ("\nNot all required classes (.jar) in classpath for JOD"); + endif + endif + + # Try Java & UNO + if (isempty (odsinterfaces.UNO)) + odsinterfaces.UNO = 0; + # entries(1) = not a jar but a directory (<000_install_dir/program/>) + jpchk = 0; entries = {'program', 'unoil', 'jurt', 'juh', 'unoloader', 'ridl'}; + for jj=1:numel (entries) + for ii=1:numel (jcp) + jcplst = strsplit (jcp{ii}, filesep); + jcpentry = jcplst {end}; + if (~isempty (strfind (lower (jcpentry), lower (entries{jj})))) + jpchk = jpchk + 1; + endif + endfor + endfor + if (jpchk >= numel (entries)) + odsinterfaces.UNO = 1; + printf ("UNO"); + if (deflt), printf ("; "); else, printf ("*; "); deflt = 1; uno_1st_time = min (++uno_1st_time, 2); endif + else + warning ("\nOne or more UNO classes (.jar) missing in javaclasspath"); + endif + endif + + # ---- Other interfaces here, similar to the ones above + + if (deflt), printf ("(* = active interface)\n"); endif + + ## FIXME the below stanza should be dropped once UNO is stable. + # Echo a suitable warning about experimental status: + if (uno_1st_time == 1) + ++uno_1st_time; + printf ("\nPLEASE NOTE: UNO (=OpenOffice.org-behind-the-scenes) is EXPERIMENTAL\n"); + printf ("After you've opened a spreadsheet file using the UNO interface,\n"); + printf ("odsclose on that file will kill ALL OpenOffice.org invocations,\n"); + printf ("also those that were started outside and/or before Octave!\n"); + printf ("Trying to quit Octave w/o invoking odsclose will only hang Octave.\n\n"); + endif + +endfunction diff --git a/octave_packages/io-1.0.19/odsread.m b/octave_packages/io-1.0.19/odsread.m new file mode 100644 index 0000000..23d35d6 --- /dev/null +++ b/octave_packages/io-1.0.19/odsread.m @@ -0,0 +1,149 @@ +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{numarr}, @var{txtarr}, @var{rawarr}, @var{limits}] = odsread (@var{filename}) +## @deftypefnx {Function File} [@var{numarr}, @var{txtarr}, @var{rawarr}, @var{limits}] = odsread (@var{filename}, @var{wsh}) +## @deftypefnx {Function File} [@var{numarr}, @var{txtarr}, @var{rawarr}, @var{limits}] = odsread (@var{filename}, @var{wsh}, @var{range}) +## @deftypefnx {Function File} [@var{numarr}, @var{txtarr}, @var{rawarr}, @var{limits}] = odsread (@var{filename}, @var{wsh}, @var{range}, @var{reqintf}) +## +## Read data contained from cell range @var{range} in worksheet @var{wsh} +## in OpenOffice_org Calc spreadsheet file @var{filename}. +## +## You need the octave-forge java package (> 1.2.6) and one or both of +## jopendocument-.jar or preferrably: (odfdom.jar (versions +## 0.7.5 or 0.8.6+) & xercesImpl.jar v. 2.9.1) in your javaclasspath. +## There is also experimental support invoking OpenOffice.org or clones +## through Java/UNO bridge. +## +## Return argument @var{numarr} contains the numeric data, optional +## return arguments @var{txtarr} and @var{rawarr} contain text strings +## and the raw spreadsheet cell data, respectively, and @var{limits} is +##a struct containing the data origins of the various returned arrays. +## +## If @var{filename} does not contain any directory, the file is +## assumed to be in the current directory. @var{filename} should include +## the filename extension (.ods). +## +## @var{wsh} is either numerical or text, in the latter case it is +## case-sensitive and it should conform to OpenOffice.org Calc sheet +## name requirements. +## Note that in case of a numerical @var{wsh} this number refers to the +## position in the worksheet stack, counted from the left in a Calc +## window. The default is numerical 1, i.e. the leftmost worksheet +## in the Calc file. +## +## @var{range} is expected to be a regular spreadsheet range format, +## or "" (empty string, indicating all data in a worksheet). +## If no range is specified the occupied cell range will have to be +## determined behind the scenes first; this can take some time. +## +## If only the first argument is specified, odsread will try to read +## all contents from the first = leftmost (or the only) worksheet (as +## if a range of @'' (empty string) was specified). +## +## If only two arguments are specified, odsread assumes the second +## argument to be @var{wsh} and to refer to a worksheet. In that case +## odsread tries to read all data contained in that worksheet. +## +## The optional last argument @var{reqintf} can be used to override +## the automatic selection by odsread of one interface out of the +## supported ones: Java/ODFtoolkit ('OTK'), Java/jOpenDocument +## ('JOD') or Java/UNO bridge ('UNO'). +## +## Erroneous data and empty cells are set to NaN in @var{numarr} and +## turn up empty in @var{txtarr} and @var{rawarr}. Date/time values +## in date/time formatted cells are returned as numerical values in +## @var{obj} with base 1-1-000. Note that OpenOfice.org and MS-Excel +## have different date base values (1/1/0000 & 1/1/1900, resp.) and +## internal representation so MS-Excel spreadsheets rewritten into +## .ods format by OpenOffice.org Calc may have different date base +## values. +## +## @var{numarr} and @var{txtarr} are trimmed from empty outer rows +## and columns, so any returned array may turn out to be smaller than +## requested in @var{range}. +## +## When reading from merged cells, all array elements NOT corresponding +## to the leftmost or upper Calc cell will be treated as if the +## "corresponding" Calc cells are empty. +## +## odsread is just a wrapper for a collection of scripts that find out +## the interface to be used and do the actual reading. For each call +## to odsread the interface must be started and the Calc file read into +## memory. When reading multiple ranges (in optionally multiple worksheets) +## a significant speed boost can be obtained by invoking those scripts +## directly (odsopen / ods2oct [/ parsecell] / ... / odsclose). +## +## Examples: +## +## @example +## A = odsread ('test4.ods', '2nd_sheet', 'C3:AB40'); +## (which returns the numeric contents in range C3:AB40 in worksheet +## '2nd_sheet' from file test4.ods into numeric array A) +## @end example +## +## @example +## [An, Tn, Ra, limits] = odsread ('Sales2009.ods', 'Third_sheet'); +## (which returns all data in worksheet 'Third_sheet' in file test4.ods +## into array An, the text data into array Tn, the raw cell data into +## cell array Ra and the ranges from where the actual data came in limits) +## @end example +## +## @seealso {odsopen, ods2oct, oct2ods, odsclose, odswrite, odsfinfo, parsecell} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-12-12 +## Updates: +## 2010-01-05 (....) +## 2010-03-04 Slight adaptations in texinfo +## 2010-05-31 Updated help text (delays i.c.o. empty range due to getusedrange call) +## 2010-11-10 Updated help text (filename extension req'd) +## 2010-11-13 Added some input validity checks +## 2011-09-08 Catch empty ods structs after failed odsopen attempts +## 2011-09-18 Return empty output arg in case of empty rawarr +## 2012-01-26 Fixed "seealso" help string +## 2012-03-07 Updated texinfo help text +## 2012-06-08 Tabs replaced by double space + +function [ numarr, txtarr, rawarr, lim ] = odsread (filename, wsh=1, datrange=[], reqintf=[]) + + if (nargin < 1 || isempty (findstr ('.ods', tolower (filename)))) + usage ("odsread: at least a filename incl. suffix is needed"); + endif + if (nargout < 1) + usage ("odsread: no output argument(s) specified"); + endif + + ods = odsopen (filename, 0, reqintf); + + if (~isempty (ods)) + + [rawarr, ods, rstatus] = ods2oct (ods, wsh, datrange); + + if (rstatus) + [numarr, txtarr, lim] = parsecell (rawarr, ods.limits); + else + warning (sprintf ("No data read from %s.", filename)); + numarr = []; + endif + + ods = odsclose (ods); + + endif + +endfunction diff --git a/octave_packages/io-1.0.19/odswrite.m b/octave_packages/io-1.0.19/odswrite.m new file mode 100644 index 0000000..73eb598 --- /dev/null +++ b/octave_packages/io-1.0.19/odswrite.m @@ -0,0 +1,123 @@ +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{rstatus} = odswrite (@var{filename}, @var{arr}) +## @deftypefnx {Function File} @var{rstatus} = odswrite (@var{filename}, @var{arr}, @var{wsh}) +## @deftypefnx {Function File} @var{rstatus} = odswrite (@var{filename}, @var{arr}, @var{wsh}, @var{range}) +## @deftypefnx {Function File} @var{rstatus} = odswrite (@var{filename}, @var{arr}, @var{wsh}, @var{range}, @var{reqintf}) +## Add data in 1D/2D array @var{arr} into sheet @var{wsh} in +## OpenOffice_org Calc spreadsheet file @var{filename} in cell range @var{range}. +## +## @var{rstatus} returns 1 if write succeeded, 0 otherwise. +## +## @var{filename} must be a valid .ods OpenOffice.org file name (including +## file name extension). If @var{filename} does not contain any directory +## path, the file is saved in the current directory. +## +## @var{arr} can be any 1D or 2D array containing numerical or character +## data (cellstr) except complex. Mixed numeric/text arrays can only be +## cell arrays. +## +## @var{wsh} can be a number or string. In case of a not yet existing +## OpenOffice.org spreadsheet, the first sheet will be used & named +## according to @var{wsh} - no extra empty sheets are created. +## In case of existing files, some checks are made for existing sheet +## names or numbers, or whether @var{wsh} refers to an existing sheet with +## a type other than sheet (e.g., chart). +## When new sheets are to be added to the spreadsheet file, they are +## inserted to the right of all existing sheets. The pointer to the +## "active" sheet (shown when OpenOffice.org Calc opens the file) remains +## untouched. +## +## @var{range} is expected to be a regular spreadsheet range. +## Data is added to the sheet; existing data in the requested +## range will be overwritten. +## Array @var{arr} will be clipped at the right and/or bottom if its size +## is bigger than can be accommodated in @var{range}. +## If @var{arr} is smaller than the @var{range} allows, it is placed +## in the top left rectangle of @var{range} and cell values outside that +## rectangle will be untouched. +## +## If @var{range} contains merged cells, only the elements of @var{arr} +## corresponding to the top or left Calc cells of those merged cells +## will be written, other array cells corresponding to that cell will be +## ignored. +## +## The optional last argument @var{reqintf} can be used to override +## the automatic selection by odswrite of one interface out of the +## supported ones: Java/ODFtooolkit ('OTK'), Java/jOpenDocument ('JOD'), +## or Java/OpenOffice.org ('UNO'). +## +## odswrite is a mere wrapper for various scripts which find out what +## ODS interface to use (ODF toolkit or jOpenDocument) plus code to mimic +## the other brand's syntax. For each call to odswrite such an interface +## must be started and possibly an ODS file loaded. When writing to multiple +## ranges and/or worksheets in the same ODS file, a speed bonus can be +## obtained by invoking those scripts (odsopen / octods / .... / odsclose) +## directly. +## +## Example: +## +## @example +## status = odswrite ('test4.ods', 'arr', 'Eight_sheet', 'C3:AB40'); +## (which adds the contents of array arr (any type) to range C3:AB40 +## in sheet 'Eight_sheet' in file test4.ods and returns a logical +## True (= numerical 1) in status if al went well) +## @end example +## +## @seealso {odsread, oct2ods, ods2oct, odsopen, odsclose, odsfinfo} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-12-14 +## Updates: +## 2010-01-14 Finalized write support tru ODS toolkit +## 2010-01-15 Added texinfo help +## 2010-08-25 Removed text about 31 char limit for sheet names (invalid) +## 2010-11-13 Added note about required file extension in help text +## 2010-11-13 Added some input arg checks +## 2011-09-08 Minor filename error text adaptation +## 2012-01-26 Fixed "seealso" help string +## 2012-02-20 Fixed range parameter to be default empty string rather than empty numeral +## 2010-03-07 Updated texinfo help text +## 2012-06-08 Tabs replaced by double space + +function [ rstatus ] = odswrite (filename, data, wsh=1, crange='', reqintf=[]) + + # Input validity checks + if (nargin < 2) + usage ("Insufficient arguments - see 'help odswrite'"); + elseif (~ischar (filename) || isempty (findstr ('.ods', tolower (filename)))) + error ("First argument must be a filename (incl. .ods suffix for OTK & JOD)"); + endif + + ods = odsopen (filename, 1, reqintf); + + if (~isempty (ods)) + [ods, rstatus] = oct2ods (data, ods, wsh, crange); + + # If rstatus was not OK, reset change indicator in ods pointer + if (~rstatus) + ods.changed = rstatus; + warning ("odswrite: data transfer errors, file not rewritten"); + endif + + ods = odsclose (ods); + + endif + +endfunction diff --git a/octave_packages/io-1.0.19/packinfo/.autoload b/octave_packages/io-1.0.19/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/io-1.0.19/packinfo/DESCRIPTION b/octave_packages/io-1.0.19/packinfo/DESCRIPTION new file mode 100644 index 0000000..64f6c6b --- /dev/null +++ b/octave_packages/io-1.0.19/packinfo/DESCRIPTION @@ -0,0 +1,15 @@ +Name: io +Version: 1.0.19 +Date: 2012-06-08 +Author: various authors +Maintainer: Philip Nienhuis +Title: Input/Output +Description: Input/Output in external formats. +Categories: IO +Problems: Default initial java memory probably too small, increase with + java.opts (see documentation). No OXS write support. UNO support experimental. +Depends: octave (>= 3.4.0) +Suggested: java (>= 1.2.8), windows (>= 1.0.10) +Autoload: yes +License: GPLv3+, simplified BSD +Url: http://octave.sf.net diff --git a/octave_packages/io-1.0.19/packinfo/INDEX b/octave_packages/io-1.0.19/packinfo/INDEX new file mode 100644 index 0000000..cd649d1 --- /dev/null +++ b/octave_packages/io-1.0.19/packinfo/INDEX @@ -0,0 +1,44 @@ +io >> Input from and output to external formats +File I/O + append_save + fexist +Miscellaneous conversion functions + object2json + pch2mat +CSV file functions + csv2cell + csvconcat + csvexplode + cell2csv +XML I/O + xmlread + xmlwrite +Spreadsheet I/O user functions for MS-Excel + oct2xls + xls2oct + xlsclose + xlsfinfo + xlsopen + xlsread + xlswrite +Spreadsheet I/O user functions for OpenOffice.org Calc + oct2ods + ods2oct + odsclose + odsfinfo + odsopen + odsread + odswrite +Spreadsheet utility functions + calccelladdress + chk_spreadsheet_support + parsecell +Spreadsheet I/O internal functions + getusedrange + parse_sp_range + spsh_chkrange + spsh_prstype +Spreadsheet function test scripts + io_xls_testscript + io_ods_testscript + diff --git a/octave_packages/io-1.0.19/packinfo/NEWS b/octave_packages/io-1.0.19/packinfo/NEWS new file mode 100644 index 0000000..215060f --- /dev/null +++ b/octave_packages/io-1.0.19/packinfo/NEWS @@ -0,0 +1,128 @@ +Summary of important user-visible changes for releases of the io package + +=============================================================================== +io-1.0.19 Release Date: 2012-06-08 Release Manager: Philip Nienhuis +=============================================================================== + +** Bug fixes: +--- getusedrange subfunc getusedrange_jod: str2num applied to indices rather + than the substring. Must have been there for > 2 years, only surfaced + with jopendocument v 1.3b1 +--- oct2xls, oct2ods: cast all numeric types in input array to double as + spreadsheets have only double, boolean or character string type. This bug + has been there from the very beginning of the spreadsheet functions >8-O + +--- Support for reading back formulas from .xls spreadsheets using ActiveX/COM + +** Compatible with jOpenDocument version 1.3b1 + getUsedRange() method added (MUCH faster than the old hack) + +** Compatible with odfdom-java-0.8.8-incubator.jar (ODF Toolkit 0.5-incubating) + +** Compatible with Apache POI 3.8 final + +=============================================================================== +io-1.0.18 Release Date: 2012-03-22 Release Manager: Philip Nienhuis +=============================================================================== + +** The following functions have been imported from the miscellaneous package: + cell2csv csvconcat xmlread + csv2cell csvexplode xmlwrite + Their error messages and help messages have been cleaned up a bit. + +** Bug fixes: +--- odsfinfo: fixed "wrong type argument `cell'" bug when run interactively. +--- xlsopen, odsopen: fixed messed up screen output due to UNO usage warning. +--- csv2cell: checks if file is empty and if so, return an empty cell. +--- xlsopen: better Java detection logic, more informative error messages + +** Adapted to internal LibreOffice-3.5-final changes. + Some bugs (flashing LO screens) still have to be fixed upstream - see here: + https://bugs.freedesktop.org/show_bug.cgi?id=42470 + +** Tried OpenXLS-6.0.7.jar. Reads OK, still unusable for writing .xls files. + +=============================================================================== +io-1.0.17 Release Date: 2012-02-27 Release Manager: Philip Nienhuis +=============================================================================== + +** Bug fixes: +--- oct2ods, oct2xls, odswrite default range input arg. These functions may not + have worked properly for two years (!) + +** Fixed support for odfdom v.0.8.7 (ODS). Note: the OTK interface only works + well with xercesImpl.jar 2.9.1 (Sep 14, 2009) + +** Many small bug fixes & documentation updated to actual functionality. + +** Fixed "seealso" texinfo header string in almost all functions. + +** Added formal test scripts to "internal functions" section. + +=============================================================================== +io-1.0.16 Release Date: 2012-01-19 Release Manager: Philip Nienhuis +=============================================================================== + +** Bug fixing release + +** PKG_ADD now expects Java spreadsheet class libs (.jars) in /lib/java + (for MinGW) + +=============================================================================== +io-1.0.15 Release Date: 2011-10-02 Release Manager: Philip Nienhuis +=============================================================================== + +io-1.0.15 is primarily a bug fix release and a snapshot / wrap-up of current + development status (some still a bit experimental). It mainly comprises: + +** A number of bug fixes (incl. some serious ones, notably with .ods/OOo Calc); + +** Some mainly cosmetic improvements to existing code; less verbosity; + +** pch2mat (reading & transforming Nastran PCH files, contributed by + B. Oytun Peksel); + +** object2json.m (creating a json description string of objects, contributed + by Daniel Torre). This was already silently introduced in io-1.0.14; + +** A scripted troubleshooting / classpath setup tool for spreadsheet I/O + support (chk_spreadsheet_support.m); + +** Experimental OXS support (OpenXLS) for reading Excel xls (BIFF8). + OpenXLS is -let's say- a little bit lacking: For reading it is faster than + JXL. However, while OXS write support has been coded (and works) I had to + disable it as the OXS Java classes won't release the file handle so Octave + will hang upon closing :-( I'm stuck with this so I just release it as-is; + +** Experimental UNO support, i.e. invoking OpenOffice.org (or clones like + LibreOffice) behind the scenes to read spreadsheet files, much like + ActiveX/COM for MS-Excel. This is also based on Java. The first time you + use UNO, OOo has to be loaded and you'll have to be patient, but once loaded + (and in the OS cache) you'll see the pros: + --* Very fast; + --* Much lower Java memory usage as OOo loads the spreadsheet in its own + memory chunk (not Octave's) => much bigger spreadsheet capacity; + --* You can read *all* formats supported by OOo: .ods, .xls, .csv, .xlsx, + .sxc, .dbf, Lotus wk1, Quattro Pro, ......; and it doesn't really matter + whether xlsopen of odsopen is used. + Of course all this wonderful stuff comes at a prize: + --* After closing the spreadsheet file (odsclose, xlsclose) ALL OOo + invocations will be closed, also those started outside Octave. This is + due to "the way OpenOffice works" (quoted from OOo dev forum), especially + through Java. There are other ways to close OOo but they'll hang Octave; + --* The Java UNO classes supplied with e.g. LibreOffice aren't kept quite + up-to-date with the main program. As a consequence, with e.g., + LibreOffice 3.4 the main LO window will pop up (it can't be hidden). I + filed a bug report for this + (https://bugs.freedesktop.org/show_bug.cgi?id=40991) but I haven't seen + it being picked up yet. Another example: while LO 3.3.1's row capacity + was already > 10^6, it took until LO 3.4 before this capacity was + implemented in the Java UNO classes. + Like with OXS, I'm a bit stuck here - all this has to be fixed upstream. + +Hint: +for older Octave versions (< 3.4.0) you can install io-1.0.15 using the -nodeps + flag. You'll then loose the old and buggy textread and csv/dlm-read/write + functions but I'd consider that as no big loss. + + diff --git a/octave_packages/io-1.0.19/parse_sp_range.m b/octave_packages/io-1.0.19/parse_sp_range.m new file mode 100644 index 0000000..c3c86cb --- /dev/null +++ b/octave_packages/io-1.0.19/parse_sp_range.m @@ -0,0 +1,117 @@ +## Copyright (C) 2009-2011 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Parse a string representing a range of cells for a spreadsheet +## into nr of rows and nr of columns and also extract top left +## cell address + top row + left column. Some error checks are implemented. + +## Author: Philip Nienhuis +## Created: 2009-06-20 +## Latest update 2010-01-13 + +function [topleft, nrows, ncols, toprow, lcol] = parse_sp_range (range_org) + + range = deblank (toupper (range_org)); + range_error = 0; nrows = 0; ncols = 0; + + # Basic checks + if (index (range, ':') == 0) + if (isempty (range)) + range_error = 0; + leftcol = 'A'; + rightcol = 'A'; + else + # Only upperleft cell given, just complete range to 1x1 + # (needed for some routines) + range = [range ":" range]; + endif + endif + + # Split up both sides of the range + [topleft, lowerright] = strtok (range, ':'); + + # Get toprow and clean up left column + [st, en] = regexp (topleft, '\d+'); + toprow = str2num (topleft(st:en)); + leftcol = deblank (topleft(1:st-1)); + [st, en1] = regexp( leftcol,'\s+'); + if (isempty (en1)) + en1=0; + endif + [st, en2] = regexp (leftcol,'\D+'); + leftcol = leftcol(en1+1:en2); + + # Get bottom row and clean up right column + [st, en] = regexp (lowerright,'\d+'); + bottomrow = str2num (lowerright(st:en)); + rightcol = deblank (lowerright(2:st-1)); + [st, en1] = regexp (rightcol,'\s+'); + if (isempty (en1)) + en1=0; + endif + [st, en2] = regexp (rightcol,'\D+'); + rightcol = rightcol(en1+1:en2); + + # Check nr. of rows + nrows = bottomrow - toprow + 1; + if (nrows < 1) + range_error = 1; + endif + + if (range_error == 0) + # Get left column nr. + [st, en] = regexp (leftcol, '\D+'); + lcol = (leftcol(st:st) - 'A' + 1); + while (++st <= en) + lcol = lcol * 26 + (leftcol(st:st) - 'A' + 1); + endwhile + + # Get right column nr. + [st, en] = regexp (rightcol, '\D+'); + rcol = (rightcol(st:st) - 'A' + 1); + while (++st <= en) + rcol = rcol * 26 + (rightcol(st:st) - 'A' + 1); + endwhile + + # Check + ncols = rcol - lcol + 1; + if (ncols < 1) + range_error = 1; + endif + endif + + if (range_error > 0) + ncols = 0; nrows = 0; + error ("Spreadsheet range error! "); + endif + +endfunction + +%!test +%! [a b c d e] = parse_sp_range ('A1:B2'); +%! assert ([a b c d e], ['A1', 2, 2, 1, 1]); + +%!test +%! [a b c d e] = parse_sp_range ('A1:AB200'); +%! assert ([a b c d e], ['A1', 200, 28, 1, 1]); + +%!test +%! [a b c d e] = parse_sp_range ('cd230:iY65536'); +%! assert ([a b c d e], ['CD230', 65307, 178, 230, 82]); + +%!test +%! [a b c d e] = parse_sp_range ('BvV12798 : xFd1054786'); +%! assert ([b c d e], [1041989, 14439, 12798, 1946]); + diff --git a/octave_packages/io-1.0.19/parsecell.m b/octave_packages/io-1.0.19/parsecell.m new file mode 100644 index 0000000..770242a --- /dev/null +++ b/octave_packages/io-1.0.19/parsecell.m @@ -0,0 +1,171 @@ +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [ @var{numarr}, @var{txtarr}, @var{lim} ] = parsecell (@var{rawarr}) +## @deftypefnx {Function File} [ @var{numarr}, @var{txtarr}, @var{lim} ] = parsecell (@var{rawarr}, @var{limits}) +## +## Divide a heterogeneous 2D cell array into a 2D numeric array and a +## 2D cell array containing only strings. Both returned arrays are +## trimmed from empty outer rows and columns. +## This function is particularly useful for parsing cell arrays returned +## by functions reading spreadsheets (e.g., xlsread, odsread). +## +## Optional return argument @var{lim} contains two field with the outer +## column and row numbers of @var{numarr} and @var{txtarr} in the +## original array @var{rawarr}. +## Optional input argument @var{limits} can either be the spreadsheet +## data limits returned in the spreadsheet file pointer struct +## (field xls.limits or ods.limits), or the file ptr struct itself. +## If one of these is specified, optional return argument @var{lim} +## will contain the real spreadsheet row & column numbers enclosing +## the origins of the numerical and text data returned in @var{numarr} +## and @var{txtarr}. +## +## Examples: +## +## @example +## [An, Tn] = parsecell (Rn); +## (which returns the numeric contents of Rn into array An and the +## text data into array Tn) +## @end example +## +## @example +## [An, Tn, lims] = parsecell (Rn, xls.limits); +## (which returns the numeric contents of Rn into array An and the +## text data into array Tn.) +## @end example +## +## @seealso {xlsread, odsread, xls2oct, ods2oct} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-12-13 +## Updates: +## 2009-12-29 +## 2010-08-25 Added option for second argument to be a file ptr +## 2010-10-15 Simplified code for numerical array +## 2011-05-17 Fixed subscript indexing bug in cropping section when rawarr is +## " numeric scalar +## 2011-09-08 Copyright string updated +## 2012-01-26 Fixed "seealso" help string + +function [ numarr, txtarr, lim ] = parsecell (rawarr, arg2=[]) + + if (isstruct (arg2)) + # Assume a file ptr has been supplied + if (isfield (arg2, 'limits')) + rawlimits = arg2.limits; + else + warning ("Invalid file ptr supplied to parsecell() - limits ignored."); + endif + else + rawlimits = arg2; + endif + + lim = struct ( "numlimits", [], "txtlimits", []); + + numarr = []; + txtarr = {}; + + if (~isempty (rawarr)) + # Valid data returned. Divide into numeric & text arrays + no_txt = 0; no_num = 0; + if (isnumeric ([rawarr{:}])) + numarr = num2cell (rawarr); + no_txt = 1; + elseif (iscellstr (rawarr)) + txtarr = cellstr (rawarr); + no_num = 1; + endif + # Prepare parsing + [nrows, ncols] = size (rawarr); + + # Find text entries in raw data cell array + txtptr = cellfun ('isclass', rawarr, 'char'); + if (~no_txt) + # Prepare text array. Create placeholder for text cells + txtarr = cell (size (rawarr)); + txtarr(:) = {''}; + if (any (any (txtptr))) + # Copy any text cells found into place holder + txtarr(txtptr) = rawarr(txtptr); + # Clean up text array (find leading / trailing empty + # rows & columns) + irowt = 1; + while (~any (txtptr(irowt, :))) irowt++; endwhile + irowb = nrows; + while (~any (txtptr(irowb, :))) irowb--; endwhile + icoll = 1; + while (~any (txtptr(:, icoll))) icoll++; endwhile + icolr = ncols; + while (~any (txtptr(:, icolr))) icolr--; endwhile + # Crop textarray + txtarr = txtarr(irowt:irowb, icoll:icolr); + lim.txtlimits = [icoll, icolr; irowt, irowb]; + if (~isempty (rawlimits)) + correction = [1; 1]; + lim.txtlimits (:,1) = lim.txtlimits(:,1) + rawlimits(:,1) - correction; + lim.txtlimits (:,2) = lim.txtlimits(:,2) + rawlimits(:,1) - correction; + endif + else + # If no text cells found return empty text array + txtarr = {}; + endif + endif + + if (~no_num) + # Prepare numeric array. Set all text & empty cells to + # NaN. First get their locations + emptr = cellfun ('isempty', rawarr); + emptr(find (txtptr)) = 1; + if (all (all (emptr))) + numarr= []; + else + # Find leading & trailing empty rows + irowt = 1; + while (all(emptr(irowt, :))) irowt++; endwhile + irowb = nrows; + while (all(emptr(irowb, :))) irowb--; endwhile + icoll = 1; + while (all(emptr(:, icoll))) icoll++; endwhile + icolr = ncols; + while (all(emptr(:, icolr))) icolr--; endwhile + + # Pre-crop rawarr + rawarr = rawarr (irowt:irowb, icoll:icolr); + # Build numerical array + numarr = zeros (irowb-irowt+1, icolr-icoll+1); + # Watch out for scalar (non-empty) numarr where emptr = 0 + if (sum (emptr(:)) > 0) + numarr (emptr(irowt:irowb, icoll:icolr)) = NaN; + endif + numarr(~emptr(irowt:irowb, icoll:icolr)) = cell2mat (rawarr(~emptr(irowt:irowb, icoll:icolr))); + # Save limits + lim.numlimits = [icoll, icolr; irowt, irowb]; + if (~isempty (rawlimits)) + correction = [1; 1]; + lim.numlimits(:,1) = lim.numlimits(:,1) + rawlimits(:,1) - correction(:); + lim.numlimits(:,2) = lim.numlimits(:,2) + rawlimits(:,1) - correction(:); + endif + endif + endif + + lim.rawlimits = rawlimits; + + endif + +endfunction diff --git a/octave_packages/io-1.0.19/pch2mat.m b/octave_packages/io-1.0.19/pch2mat.m new file mode 100644 index 0000000..4b1d5dc --- /dev/null +++ b/octave_packages/io-1.0.19/pch2mat.m @@ -0,0 +1,93 @@ +%% Copyright (C) 2011, Bilen Oytun Peksel +%% All rights reserved. +%% +%% Redistribution and use in source and binary forms, with or without +%% modification, are permitted provided that the following conditions are met: +%% +%% 1 Redistributions of source code must retain the above copyright notice, +%% this list of conditions and the following disclaimer. +%% 2 Redistributions in binary form must reproduce the above copyright +%% notice, this list of conditions and the following disclaimer in the +%% documentation and/or other materials provided with the distribution. +%% +%% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +%% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +%% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +%% ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +%% ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +%% DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +%% SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +%% CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +%% OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +%% OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +%% -*- texinfo -*- +%% @deftypefn {Function File} {@var{data} =} pch2mat (@var{filename}) +%% Converts NASTRAN PCH file (SORT2) to a data structure and frequency vector. A +%% filename as a string is the only needed input. +%% +%% The output is in the form of struct. containing a freq vector n x 1 called +%% data.f, and the remaining data are in the form of subcases, point ids +%% and directions respectively. for ex. data.S1.p254686.x and they are n x 2 +%% +%% @end deftypefn + +function [data] = pch2mat(filename); + + %% Open the file and read the file line by line to form a line character array + fid = fopen(filename); + l = 1; + while (~feof(fid)) + raw{l} = fgets(fid); + l = l + 1; + end + + %% Determine Freq_count and number of lines for each case + a = strmatch('$TITLE',raw); + lines = a(2) -a(1); %number of lines on each subcase and related point id + freq_count = (lines-7)/4; + + %% Read from array + C = length(raw) / lines; %number of subcase and related point id + + for k = 1 : C; %looping through every case + scase = char(raw{(k-1) * lines + 3}(12:16)); + scase = genvarname(scase); + pid = char(raw{(k-1) * lines + 7}(16:25)); + pid = genvarname(['p' pid]); + if (k==1) + data.f = zeros(freq_count,1); + end; + data.(scase).(pid).x = zeros(freq_count,2); + data.(scase).(pid).y = zeros(freq_count,2); + data.(scase).(pid).z = zeros(freq_count,2); + data.(scase).(pid).r1 = zeros(freq_count,2); + data.(scase).(pid).r2 = zeros(freq_count,2); + data.(scase).(pid).r3 = zeros(freq_count,2); + i = (k-1) * lines + 8 ; + j = 0; + + while( i <= (lines * k)) %loop for each case + j=j+1; + if (k==1) + data.f(j) = str2double(raw{i}(5:17)); + end + data.(scase).(pid).x(j,1) = str2double(raw{i}(25:37)); + data.(scase).(pid).y(j,1) = str2double(raw{i}(43:55)); + data.(scase).(pid).z(j,1) = str2double(raw{i}(61:73)); + i=i+1; + data.(scase).(pid).r1(j,1) = str2double(raw{i}(25:37)); + data.(scase).(pid).r2(j,1) = str2double(raw{i}(43:55)); + data.(scase).(pid).r3(j,1) = str2double(raw{i}(61:73)); + i=i+1; + data.(scase).(pid).x(j,2) = str2double(raw{i}(25:37)); + data.(scase).(pid).y(j,2) = str2double(raw{i}(43:55)); + data.(scase).(pid).z(j,2) = str2double(raw{i}(61:73)); + i=i+1; + data.(scase).(pid).r1(j,2) = str2double(raw{i}(25:37)); + data.(scase).(pid).r2(j,2) = str2double(raw{i}(43:55)); + data.(scase).(pid).r3(j,2) = str2double(raw{i}(61:73)); + i=i+1; + end + end +end diff --git a/octave_packages/io-1.0.19/spsh_chkrange.m b/octave_packages/io-1.0.19/spsh_chkrange.m new file mode 100644 index 0000000..8859aa3 --- /dev/null +++ b/octave_packages/io-1.0.19/spsh_chkrange.m @@ -0,0 +1,103 @@ +## Copyright (C) 2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [ @var{topleftaddr}, @var{nrows}, @var{ncols}, @var{toprow}, @var{leftcol} ] = spsh_chkrange ( @var{range}, @var{rowsize}, @var{colsize}, @var{intf-type}, @var{filename}) +## (Internal function) Get and check various cell and range address parameters for spreadsheet input. +## +## spsh_chkrange should not be invoked directly but rather through oct2xls or oct2ods. +## +## Example: +## +## @example +## [tl, nrw, ncl, trw, lcl] = spsh_chkrange (crange, nr, nc, xtype, fileptr); +## @end example +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2010-08-02 +## Updates: +## 2010-08-25 Option for supplying file pointer rather than interface_type & filename +## (but this can be wasteful if the file ptr is copied) +## 2011-03-29 Bug fix - unrecognized pointer struct & wrong type error msg +## 2011-05-15 Experimental UNO support added (OpenOffice.org & clones) +## 2011-09-18 Updated UNO data row capacity for LibreOffice 3.4+ (now 1,048,576 rows) + +function [ topleft, nrows, ncols, trow, lcol ] = spsh_chkrange (crange, nr, nc, intf, filename=[]) + + if (nargin == 4) + # File pointer input assumed + if (isstruct (intf)) + xtype = intf.xtype; + filename = intf.filename; + else + error ("Too few or improper arguments supplied."); + endif + else + # Interface type & filename supplied + xtype = intf; + endif + + # Define max row & column capacity from interface type & file suffix + switch xtype + case { 'COM', 'POI' } + if (strmatch (tolower (filename(end-3:end)), '.xls')) + # BIFF5 & BIFF8 + ROW_CAP = 65536; COL_CAP = 256; + else + # OOXML (COM needs Excel 2007+ for this) + ROW_CAP = 1048576; COL_CAP = 16384; + endif + case { 'JXL', 'OXS' } + # JExcelAPI & OpenXLS can only process BIFF5 & BIFF8 + ROW_CAP = 65536; COL_CAP = 256; + case { 'OTK', 'JOD' } + # ODS + ROW_CAP = 65536; COL_CAP = 1024; + case { 'UNO' } + # ODS; LibreOffice has a higher row capacity + # FIXME - use UNO calls to check physical row capacity + # FIXME - LibreOffice has higher row capacity but its Java classes haven't been updated + ROW_CAP = 1048576; COL_CAP = 1024; + otherwise + error (sprintf ("Unknown interface type - %s\n", xtype)); + endswitch + + if (isempty (deblank (crange))) + trow = 1; + lcol = 1; + nrows = nr; + ncols = nc; + topleft = 'A1'; + elseif (isempty (strfind (deblank (crange), ':'))) + # Only top left cell specified + [topleft, dummy1, dummy2, trow, lcol] = parse_sp_range (crange); + nrows = nr; + ncols = nc; + else + [topleft, nrows, ncols, trow, lcol] = parse_sp_range (crange); + endif + if (trow > ROW_CAP || lcol > COL_CAP) + error ("Topleft cell (%s) beyond spreadsheet limits."); + endif + # Check spreadsheet capacity beyond requested topleft cell + nrows = min (nrows, ROW_CAP - trow + 1); + ncols = min (ncols, COL_CAP - lcol + 1); + # Check array size and requested range + nrows = min (nrows, nr); + ncols = min (ncols, nc); + +endfunction diff --git a/octave_packages/io-1.0.19/spsh_prstype.m b/octave_packages/io-1.0.19/spsh_prstype.m new file mode 100644 index 0000000..0c6f177 --- /dev/null +++ b/octave_packages/io-1.0.19/spsh_prstype.m @@ -0,0 +1,88 @@ +## Copyright (C) 2010,2011 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [ @var{type-array} ] = spsh_prstype ( @var{iarray}, @var{rowsize}, @var{colsize}, @var{celltypes}, @var{options}) +## (Internal function) Return rectangular array with codes for cell types in rectangular input cell array @var{iarray}. +## Codes are contained in input vector in order of Numeric, Boolean, Text, Formula and Empty, resp. +## +## spsh_prstype should not be invoked directly but rather through oct2xls or oct2ods. +## +## Example: +## +## @example +## typarr = spsh_chkrange (cellarray, nr, nc, ctypes, options); +## @end example +## +## @end deftypefn + +## Author: Philip Nienhuis, +## Created: 2010-08-02 +## Updates: +## 2010-08-25 Corrected help text (square -> rectangular; stressed "internal" use) +## 2011-04-21 Formulas now don't need closing ")" (e.g., =A1+B1 is OK as well) +## " Formula ptrs in output arg now OK (cellfun(@(x).... skips empty cells) + +function [ typearr ] = spsh_prstype (obj, nrows, ncols, ctype, spsh_opts) + + # ctype index: + # 1 = numeric + # 2 = boolean + # 3 = text + # 4 = formula + # 5 = error / NaN / empty + + typearr = ctype(5) * ones (nrows, ncols); # type "EMPTY", provisionally + obj2 = cell (size (obj)); # Temporary storage for strings + + txtptr = cellfun ('isclass', obj, 'char'); # type "STRING" replaced by "NUMERIC" + obj2(txtptr) = obj(txtptr); obj(txtptr) = ctype(3); # Save strings in a safe place + + emptr = cellfun ("isempty", obj); + obj(emptr) = ctype(5); # Set empty cells to NUMERIC + + lptr = cellfun ("islogical" , obj); # Find logicals... + obj2(lptr) = obj(lptr); # .. and set them to BOOLEAN + + ptr = cellfun ("isnan", obj); # Find NaNs & set to BLANK + typearr(ptr) = ctype(5); typearr(~ptr) = ctype(1); # All other cells are now numeric + + obj(txtptr) = obj2(txtptr); # Copy strings back into place + obj(lptr) = obj2(lptr); # Same for logicals + obj(emptr) = -1; # Add in a filler value for empty cells + + typearr(txtptr) = ctype(3); # ...and clean up + typearr(emptr) = ctype(5); # EMPTY + typearr(lptr) = ctype(2); # BOOLEAN + + if ~(spsh_opts.formulas_as_text) + # Find formulas (designated by a string starting with "=" and ending in ")") + #fptr = cellfun (@(x) ischar (x) && strncmp (x, "=", 1) && strncmp (x(end:end), ")", 1), obj); + # Find formulas (designated by a string starting with "=") + fptr = cellfun (@(x) ischar (x) && strncmp (x, "=", 1), obj); + typearr(fptr) = ctype(4); # FORMULA + endif + +endfunction + +%!test +%! tstobj = {1.5, true, []; 'Text1', '=A1+B1', '=SQRT(A1)'; NaN, {}, 0}; +%! typarr = spsh_prstype (tstobj, 3, 3, [1 2 3 4 5], struct ("formulas_as_text", 0)); +%! assert (typarr, [1 2 5; 3 4 4; 5 5 1]); + +%!test +%! tstobj = {1.5, true, []; 'Text1', '=A1+B1', '=SQRT(A1)'; NaN, {}, 0}; +%! typarr = spsh_prstype (tstobj, 3, 3, [1 2 3 4 5], struct ("formulas_as_text", 1)); +%! assert (typarr, [1 2 5; 3 3 3; 5 5 1]); diff --git a/octave_packages/io-1.0.19/xls2oct.m b/octave_packages/io-1.0.19/xls2oct.m new file mode 100644 index 0000000..ef4d167 --- /dev/null +++ b/octave_packages/io-1.0.19/xls2oct.m @@ -0,0 +1,995 @@ +## Copyright (C) 2009,2010,2011,12 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [ @var{rawarr}, @var{xls}, @var{rstatus} ] = xls2oct (@var{xls}) +## @deftypefnx {Function File} [ @var{rawarr}, @var{xls}, @var{rstatus} ] = xls2oct (@var{xls}, @var{wsh}) +## @deftypefnx {Function File} [ @var{rawarr}, @var{xls}, @var{rstatus} ] = xls2oct (@var{xls}, @var{wsh}, @var{range}) +## @deftypefnx {Function File} [ @var{rawarr}, @var{xls}, @var{rstatus} ] = xls2oct (@var{xls}, @var{wsh}, @var{range}, @var{options}) +## +## Read data contained within cell range @var{range} from worksheet @var{wsh} +## in an Excel spreadsheet file pointed to in struct @var{xls}. +## +## @var{xls} is supposed to have been created earlier by xlsopen in the +## same octave session. +## +## @var{wsh} is either numerical or text, in the latter case it is +## case-sensitive and it may be max. 31 characters long. +## Note that in case of a numerical @var{wsh} this number refers to the +## position in the worksheet stack, counted from the left in an Excel +## window. The default is numerical 1, i.e. the leftmost worksheet +## in the Excel file. +## +## @var{range} is expected to be a regular spreadsheet range format, +## or "" (empty string, indicating all data in a worksheet). +## If no range is specified the occupied cell range will have to be +## determined behind the scenes first; this can take some time for the +## Java-based interfaces. Be aware that in COM/ActiveX interface the +## used range can be outdated. The Java-based interfaces are more +## reliable in this respect albeit much slower. +## +## Optional argument @var{options}, a structure, can be used to +## specify various read modes by setting option fields in the struct +## to true (1) or false (0). Currently recognized option fields are: +## +## @table @asis +## @item "formulas_as_text" +## If set to TRUE or 1, spreadsheet formulas (if at all present) +## are read as formula strings rather than the evaluated formula +## result values. The default value is 0 (FALSE). +## +## @item 'strip_array' +## Set the value of this field set to TRUE or 1 to strip the returned +## output array @var{rawarr} from empty outer columns and rows. The +## spreadsheet cell rectangle limits from where the data actually +## came will be updated. The default value is FALSE or 0 (no cropping). +## When using the COM interface, the output array is always cropped. +## @end table +## +## If only the first argument @var{xls} is specified, xls2oct will try +## to read all contents from the first = leftmost (or the only) +## worksheet (as if a range of @'' (empty string) was specified). +## +## If only two arguments are specified, xls2oct assumes the second +## argument to be @var{wsh}. In that case xls2oct will try to read +## all data contained in that worksheet. +## +## Return argument @var{rawarr} contains the raw spreadsheet cell data. +## Use parsecell() to separate numeric and text values from @var{rawarr}. +## +## Optional return argument @var{xls} contains the pointer struct, +## If any data have been read, field @var{xls}.limits contains the +## outermost column and row numbers of the actually returned cell range. +## +## Optional return argument @var{rstatus} will be set to 1 if the +## requested data have been read successfully, 0 otherwise. +## +## Erroneous data and empty cells turn up empty in @var{rawarr}. +## Date/time values in Excel are returned as numerical values. +## Note that Excel and Octave have different date base values (1/1/1900 & +## 1/1/0000, resp.) +## Be aware that Excel trims @var{rawarr} from empty outer rows & columns, +## so any returned cell array may turn out to be smaller than requested +## in @var{range}, independent of field 'formulas_as_text' in @var{options}. +## When using COM, POI, or UNO interface, formulas in cells are evaluated; if +## that fails cached values are retrieved. These may be outdated depending +## on Excel's "Automatic calculation" settings when the spreadsheet was saved. +## +## When reading from merged cells, all array elements NOT corresponding +## to the leftmost or upper Excel cell will be treated as if the +## "corresponding" Excel cells are empty. +## +## Beware: when the COM interface is used, hidden Excel invocations may be +## kept running silently in case of COM errors. +## +## Examples: +## +## @example +## A = xls2oct (xls1, '2nd_sheet', 'C3:AB40'); +## (which returns the numeric contents in range C3:AB40 in worksheet +## '2nd_sheet' from a spreadsheet file pointed to in pointer struct xls1, +## into numeric array A) +## @end example +## +## @example +## [An, xls2, status] = xls2oct (xls2, 'Third_sheet'); +## @end example +## +## @seealso {oct2xls, xlsopen, xlsclose, parsecell, xlsread, xlsfinfo, xlswrite } +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2010-10-16 +## Updates: +## 2009-01-03 (added OOXML support & cleaned up code. Excel +## ADDRESS function still not implemented in Apache POI) +## 2010-03-14 Updated help text +## 2010-05-31 Updated help text (delay i.c.o. empty range due to getusedrange call) +## 2010-07-28 Added option to read formulas as text strings rather than evaluated value +## 2010-08-25 Small typo in help text +## 2010-10-20 Added option fornot stripping output arrays +## 2010-11-07 More rigorous input checks. +## 2010-11-12 Moved pointer check into main func +## 2010-11-13 Catch empty sheets when no range was specified +## 2011-03-26 OpenXLS support added +## 2011-03-29 Test for proper input xls struct extended +## 2011-05-18 Experimental UNO support added +## 2011-09-08 Minor code layout +## 2012-01-26 Fixed "seealso" help string +## 2012-02-25 Fixed missing quotes in struct check L.149-153 +## 2012-02-26 Updated texinfo header help text +## 2012-06-06 Implemented "formulas_as_text" option for COM +## 2012-06-07 Replaced all tabs by double space +## +## Latest subfunc update: 2012-06-06 + +function [ rawarr, xls, rstatus ] = xls2oct (xls, wsh=1, datrange='', spsh_opts=[]) + + # Check if xls struct pointer seems valid + if (~isstruct (xls)), error ("File ptr struct expected for arg @ 1"); endif + test1 = ~isfield (xls, "xtype"); + test1 = test1 || ~isfield (xls, "workbook"); + test1 = test1 || isempty (xls.workbook); + test1 = test1 || isempty (xls.app); + test1 = test1 || ~ischar (xls.xtype); + if test1 + error ("Invalid xls file pointer struct"); + endif + + # Check worksheet ptr + if (~(ischar (wsh) || isnumeric (wsh))), error ("Integer (index) or text (wsh name) expected for arg # 2"); endif + # Check range + if (~(isempty (datrange) || ischar (datrange))), error ("Character string (range) expected for arg # 3"); endif + + # Check & setup options struct + if (nargin < 4 || isempty (spsh_opts)) + spsh_opts.formulas_as_text = 0; + spsh_opts.strip_array = 1; + # Future options: + elseif (isstruct (spsh_opts)) + if (~isfield (spsh_opts', 'formulas_as_text')), spsh_opts.formulas_as_text = 0; endif + if (~isfield (spsh_opts', 'strip_array')), spsh_opts.strip_array = 1; endif + % Future options: + else + error ("Structure expected for arg # 4"); + endif + + # Select the proper interfaces + if (strcmp (xls.xtype, 'COM')) + # Call Excel tru COM / ActiveX server + [rawarr, xls, rstatus] = xls2com2oct (xls, wsh, datrange, spsh_opts); + elseif (strcmp (xls.xtype, 'POI')) + # Read xls file tru Java POI + [rawarr, xls, rstatus] = xls2jpoi2oct (xls, wsh, datrange, spsh_opts); + elseif (strcmp (xls.xtype, 'JXL')) + # Read xls file tru JExcelAPI + [rawarr, xls, rstatus] = xls2jxla2oct (xls, wsh, datrange, spsh_opts); + elseif (strcmp (xls.xtype, 'OXS')) + # Read xls file tru OpenXLS + [rawarr, xls, rstatus] = xls2oxs2oct (xls, wsh, datrange, spsh_opts); + elseif (strcmp (xls.xtype, 'UNO')) + # Read xls file tru OpenOffice.org UNO (Java) bridge + [rawarr, xls, rstatus] = xls2uno2oct (xls, wsh, datrange, spsh_opts); +# elseif ---- + # Call to next interface + else + error (sprintf ("xls2oct: unknown Excel .xls interface - %s.", xls.xtype)); + endif + + # Optionally strip empty outer rows and columns & keep track of original data location + if (spsh_opts.strip_array) + emptr = cellfun ('isempty', rawarr); + if (all (all (emptr))) + rawarr = {}; + xls.limits = []; + else + nrows = size (rawarr, 1); ncols = size (rawarr, 2); + irowt = 1; + while (all (emptr(irowt, :))), irowt++; endwhile + irowb = nrows; + while (all (emptr(irowb, :))), irowb--; endwhile + icoll = 1; + while (all (emptr(:, icoll))), icoll++; endwhile + icolr = ncols; + while (all (emptr(:, icolr))), icolr--; endwhile + + # Crop output cell array and update limits + rawarr = rawarr(irowt:irowb, icoll:icolr); + xls.limits = xls.limits + [icoll-1, icolr-ncols; irowt-1, irowb-nrows]; + endif + endif + +endfunction + + +#==================================================================================== +## Copyright (C) 2009,2010,2011,2012 P.R. Nienhuis, +## +## based on mat2xls by Michael Goffioul (2007) +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{obj}, @var{rstatus}, @var{xls} ] = xls2com2oct (@var{xls}) +## @deftypefnx {Function File} [@var{obj}, @var{rstatus}, @var{xls} ] = xls2com2oct (@var{xls}, @var{wsh}) +## @deftypefnx {Function File} [@var{obj}, @var{rstatus}, @var{xls} ] = xls2com2oct (@var{xls}, @var{wsh}, @var{range}) +## @deftypefnx {Function File} [@var{obj}, @var{rstatus}, @var{xls} ] = xls2com2oct (@var{xls}, @var{wsh}, @var{range}, @var{spsh_opts}) +## Get cell contents in @var{range} in worksheet @var{wsh} in an Excel +## file pointed to in struct @var{xls} into the cell array @var{obj}. +## +## xls2com2oct should not be invoked directly but rather through xls2oct. +## +## Examples: +## +## @example +## [Arr, status, xls] = xls2com2oct (xls, 'Second_sheet', 'B3:AY41'); +## Arr = xls2com2oct (xls, 'Second_sheet'); +## @end example +## +## @seealso {xls2oct, oct2xls, xlsopen, xlsclose, xlsread, xlswrite} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-09-23 +## Last updates: +## 2009-12-11 +## 2010-10-07 Implemented limits (only reliable for empty input ranges) +## 2010-10-08 Resulting data array now cropped (also in case of specified range) +## 2010-10-10 More code cleanup (shuffled xls tests & wsh ptr code before range checks) +## 2010-10-20 Slight change to Excel range setup +## 2010-10-24 Added check for "live" ActiveX server +## 2010-11-12 Moved ptr struct check into main func +## 2010-11-13 Catch empty sheets when no range was specified +## 2012-01-26 Fixed "seealso" help string +## 2012-06-06 Implemented "formulas_as_text option" + +function [rawarr, xls, rstatus ] = xls2com2oct (xls, wsh, crange, spsh_opts) + + rstatus = 0; rawarr = {}; + + # Basic checks + if (nargin < 2) error ("xls2com2oct needs a minimum of 2 arguments."); endif + if (size (wsh, 2) > 31) + warning ("Worksheet name too long - truncated") + wsh = wsh(1:31); + endif + app = xls.app; + wb = xls.workbook; + # Check to see if ActiveX is still alive + try + wb_cnt = wb.Worksheets.count; + catch + error ("ActiveX invocation in file ptr struct seems non-functional"); + end_try_catch + + # Check & get handle to requested worksheet + wb_cnt = wb.Worksheets.count; + old_sh = 0; + if (isnumeric (wsh)) + if (wsh < 1 || wsh > wb_cnt) + errstr = sprintf ("Worksheet number: %d out of range 1-%d", wsh, wb_cnt); + error (errstr) + rstatus = 1; + return + else + old_sh = wsh; + endif + else + # Find worksheet number corresponding to name in wsh + wb_cnt = wb.Worksheets.count; + for ii =1:wb_cnt + sh_name = wb.Worksheets(ii).name; + if (strcmp (sh_name, wsh)) old_sh = ii; endif + endfor + if (~old_sh) + errstr = sprintf ("Worksheet name \"%s\" not present", wsh); + error (errstr) + else + wsh = old_sh; + endif + endif + sh = wb.Worksheets (wsh); + + nrows = 0; + if ((nargin == 2) || (isempty (crange))) + allcells = sh.UsedRange; + # Get actually used range indices + [trow, brow, lcol, rcol] = getusedrange (xls, old_sh); + if (trow == 0 && brow == 0) + # Empty sheet + rawarr = {}; + printf ("Worksheet '%s' contains no data\n", sh.Name); + return; + else + nrows = brow - trow + 1; ncols = rcol - lcol + 1; + topleft = calccelladdress (trow, lcol); + lowerright = calccelladdress (brow, rcol); + crange = [topleft ':' lowerright]; + endif + else + # Extract top_left_cell from range + [topleft, nrows, ncols, trow, lcol] = parse_sp_range (crange); + brow = trow + nrows - 1; + rcol = lcol + ncols - 1; + endif; + + if (nrows >= 1) + # Get object from Excel sheet, starting at cell top_left_cell + rr = sh.Range (crange); + if (spsh_opts.formulas_as_text) + rawarr = rr.Formula; + else + rawarr = rr.Value; + endif + delete (rr); + + # Take care of actual singe cell range + if (isnumeric (rawarr) || ischar (rawarr)) + rawarr = {rawarr}; + endif + + # If we get here, all seems to have gone OK + rstatus = 1; + # Keep track of data rectangle limits + xls.limits = [lcol, rcol; trow, brow]; + else + error ("No data read from Excel file"); + rstatus = 0; + endif + +endfunction + + +#================================================================================== + +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{obj}, @var{rstatus}, @var{xls} ] = xls2jpoi2oct (@var{xls}) +## @deftypefnx {Function File} [@var{obj}, @var{rstatus}, @var{xls} ] = xls2jpoi2oct (@var{xls}, @var{wsh}) +## @deftypefnx {Function File} [@var{obj}, @var{rstatus}, @var{xls} ] = xls2jpoi2oct (@var{xls}, @var{wsh}, @var{range}) +## Get cell contents in @var{range} in worksheet @var{wsh} in an Excel +## file pointed to in struct @var{xls} into the cell array @var{obj}. +## @var{range} can be a range or just the top left cell of the range. +## +## xls2jpoi2oct should not be invoked directly but rather through xls2oct. +## +## Examples: +## +## @example +## [Arr, status, xls] = xls2jpoi2oct (xls, 'Second_sheet', 'B3:AY41'); +## B = xls2jpoi2oct (xls, 'Second_sheet', 'B3'); +## @end example +## +## @seealso {xls2oct, oct2xls, xlsopen, xlsclose, xlsread, xlswrite, oct2jpoi2xls} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-11-23 +## Updates: +## 2010-01-11 Fall back to cached values when formula evaluator fails +## 2010-03-14 Fixed max column nr for OOXML for empty given range +## 2010-07-28 Added option to read formulas as text strings rather than evaluated value +## 2010-08-01 Some bug fixes for formula reading (cvalue rather than scell) +## 2010-10-10 Code cleanup: -getusedrange called; - fixed typo in formula evaluation msg; +## '' moved cropping output array to calling function. +## 2010-11-12 Moved ptr struct check into main func +## 2010-11-13 Catch empty sheets when no range was specified +## 2010-11-14 Fixed sheet # index (was offset by -1) in call to getusedrange() in case +## of text sheet name arg +## 2012-01-26 Fixed "seealso" help string + +function [ rawarr, xls, rstatus ] = xls2jpoi2oct (xls, wsh, cellrange, spsh_opts) + + persistent ctype; + if (isempty (ctype)) + # Get enumerated cell types. Beware as they start at 0 not 1 + ctype(1) = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_NUMERIC'); + ctype(2) = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_STRING'); + ctype(3) = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_FORMULA'); + ctype(4) = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_BLANK'); + ctype(5) = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_BOOLEAN'); + ctype(6) = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_ERROR'); + endif + + rstatus = 0; jerror = 0; + wb = xls.workbook; + + # Check if requested worksheet exists in the file & if so, get pointer + nr_of_sheets = wb.getNumberOfSheets (); + if (isnumeric (wsh)) + if (wsh > nr_of_sheets), error (sprintf ("Worksheet # %d bigger than nr. of sheets (%d) in file %s", wsh, nr_of_sheets, xls.filename)); endif + sh = wb.getSheetAt (wsh - 1); # POI sheet count 0-based + printf ("(Reading from worksheet %s)\n", sh.getSheetName ()); + else + sh = wb.getSheet (wsh); + if (isempty (sh)), error (sprintf ("Worksheet %s not found in file %s", wsh, xls.filename)); endif + end + + # Check ranges + firstrow = sh.getFirstRowNum (); # 0-based + lastrow = sh.getLastRowNum (); # 0-based + if (isempty (cellrange)) + if (ischar (wsh)) + # get numeric sheet index + ii = wb.getSheetIndex (sh) + 1; + else + ii = wsh; + endif + [ firstrow, lastrow, lcol, rcol ] = getusedrange (xls, ii); + if (firstrow == 0 && lastrow == 0) + # Empty sheet + rawarr = {}; + printf ("Worksheet '%s' contains no data\n", sh.getSheetName ()); + rstatus = 1; + return; + else + nrows = lastrow - firstrow + 1; + ncols = rcol - lcol + 1; + endif + else + # Translate range to HSSF POI row & column numbers + [topleft, nrows, ncols, firstrow, lcol] = parse_sp_range (cellrange); + lastrow = firstrow + nrows - 1; + rcol = lcol + ncols - 1; + endif + + # Create formula evaluator (needed to infer proper cell type into rawarr) + frm_eval = wb.getCreationHelper().createFormulaEvaluator (); + + # Read contents into rawarr + rawarr = cell (nrows, ncols); # create placeholder + for ii = firstrow:lastrow + irow = sh.getRow (ii-1); + if ~isempty (irow) + scol = (irow.getFirstCellNum).intValue (); + ecol = (irow.getLastCellNum).intValue () - 1; + for jj = lcol:rcol + scell = irow.getCell (jj-1); + if ~isempty (scell) + # Explore cell contents + type_of_cell = scell.getCellType (); + if (type_of_cell == ctype(3)) # Formula + if ~(spsh_opts.formulas_as_text) + try # Because not al Excel formulas have been implemented in POI + cvalue = frm_eval.evaluate (scell); + type_of_cell = cvalue.getCellType(); + # Separate switch because form.eval. yields different type + switch type_of_cell + case ctype (1) # Numeric + rawarr {ii+1-firstrow, jj+1-lcol} = scell.getNumberValue (); + case ctype(2) # String + rawarr {ii+1-firstrow, jj+1-lcol} = char (scell.getStringValue ()); + case ctype (5) # Boolean + rawarr {ii+1-firstrow, jj+1-lcol} = scell.BooleanValue (); + otherwise + # Nothing to do here + endswitch + # Set cell type to blank to skip switch below + type_of_cell = ctype(4); + catch + # In case of formula errors we take the cached results + type_of_cell = scell.getCachedFormulaResultType (); + ++jerror; # We only need one warning even for multiple errors + end_try_catch + endif + endif + # Preparations done, get data values into data array + switch type_of_cell + case ctype(1) # 0 Numeric + rawarr {ii+1-firstrow, jj+1-lcol} = scell.getNumericCellValue (); + case ctype(2) # 1 String + rawarr {ii+1-firstrow, jj+1-lcol} = char (scell.getRichStringCellValue ()); + case ctype(3) + if (spsh_opts.formulas_as_text) + tmp = char (scell.getCellFormula ()); + rawarr {ii+1-firstrow, jj+1-lcol} = ['=' tmp]; + endif + case ctype(4) # 3 Blank + # Blank; ignore until further notice + case ctype(5) # 4 Boolean + rawarr {ii+1-firstrow, jj+1-lcol} = scell.getBooleanCellValue (); + otherwise # 5 Error + # Ignore + endswitch + endif + endfor + endif + endfor + + if (jerror > 0) warning (sprintf ("xls2oct: %d cached values instead of formula evaluations.\n", jerror)); endif + + rstatus = 1; + xls.limits = [lcol, rcol; firstrow, lastrow]; + +endfunction + + +#================================================================================== +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## 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{obj}, @var{rstatus}, @var{xls} ] = xls2jxla2oct (@var{xls}) +## @deftypefnx {Function File} [@var{obj}, @var{rstatus}, @var{xls} ] = xls2jxla2oct (@var{xls}, @var{wsh}) +## @deftypefnx {Function File} [@var{obj}, @var{rstatus}, @var{xls} ] = xls2jxla2oct (@var{xls}, @var{wsh}, @var{range}) +## Get cell contents in @var{range} in worksheet @var{wsh} in an Excel +## file pointed to in struct @var{xls} into the cell array @var{obj}. +## @var{range} can be a range or just the top left cell of the range. +## +## xls2jxla2oct should not be invoked directly but rather through xls2oct. +## +## Examples: +## +## @example +## [Arr, status, xls] = xls2jxla2oct (xls, 'Second_sheet', 'B3:AY41'); +## B = xls2jxla2oct (xls, 'Second_sheet'); +## @end example +## +## @seealso {xls2oct, oct2xls, xlsopen, xlsclose, xlsread, xlswrite, oct2jxla2xls} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-12-04 +## Updates: +## 2009-12-11 ??? some bug fix +## 2010-07-28 Added option to read formulas as text strings rather than evaluated value +## Added check for proper xls structure +## 2010-07-29 Added check for too latge requested data rectangle +## 2010-10-10 Code cleanup: -getusedrange(); moved cropping result array to +## '' calling function +## 2010-11-12 Moved ptr struct check into main func +## 2010-11-13 Catch empty sheets when no range was specified +## 2011-04-11 (Ron Goldman ) Fixed missing months var, wrong arg +## '' order in strsplit, wrong isTime condition +## 2012-01-26 Fixed "seealso" help string + +function [ rawarr, xls, rstatus ] = xls2jxla2oct (xls, wsh, cellrange, spsh_opts) + + persistent ctype; persistent months; + if (isempty (ctype)) + ctype = cell (11, 1); + # Get enumerated cell types. Beware as they start at 0 not 1 + ctype( 1) = (java_get ('jxl.CellType', 'BOOLEAN')).toString (); + ctype( 2) = (java_get ('jxl.CellType', 'BOOLEAN_FORMULA')).toString (); + ctype( 3) = (java_get ('jxl.CellType', 'DATE')).toString (); + ctype( 4) = (java_get ('jxl.CellType', 'DATE_FORMULA')).toString (); + ctype( 5) = (java_get ('jxl.CellType', 'EMPTY')).toString (); + ctype( 6) = (java_get ('jxl.CellType', 'ERROR')).toString (); + ctype( 7) = (java_get ('jxl.CellType', 'FORMULA_ERROR')).toString (); + ctype( 8) = (java_get ('jxl.CellType', 'NUMBER')).toString (); + ctype( 9) = (java_get ('jxl.CellType', 'LABEL')).toString (); + ctype(10) = (java_get ('jxl.CellType', 'NUMBER_FORMULA')).toString (); + ctype(11) = (java_get ('jxl.CellType', 'STRING_FORMULA')).toString (); + months = {'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'}; + endif + + rstatus = 0; + wb = xls.workbook; + + # Check if requested worksheet exists in the file & if so, get pointer + nr_of_sheets = wb.getNumberOfSheets (); + shnames = char (wb.getSheetNames ()); + if (isnumeric (wsh)) + if (wsh > nr_of_sheets), error (sprintf ("Worksheet # %d bigger than nr. of sheets (%d) in file %s", wsh, nr_of_sheets, xls.filename)); endif + sh = wb.getSheet (wsh - 1); # JXL sheet count 0-based + printf ("(Reading from worksheet %s)\n", shnames {wsh}); + else + sh = wb.getSheet (wsh); + if (isempty (sh)), error (sprintf ("Worksheet %s not found in file %s", wsh, xls.filename)); endif + end + + if (isempty (cellrange)) + # Get numeric sheet pointer (1-based) + ii = 1; + while (ii <= nr_of_sheets) + if (strcmp (wsh, shnames{ii}) == 1) + wsh = ii; + ii = nr_of_sheets + 1; + else + ++ii; + endif + endwhile + # Get data rectangle row & column numbers (1-based) + [firstrow, lastrow, lcol, rcol] = getusedrange (xls, wsh); + if (firstrow == 0 && lastrow == 0) + # Empty sheet + rawarr = {}; + printf ("Worksheet '%s' contains no data\n", shnames {wsh}); + rstatus = 1; + return; + else + nrows = lastrow - firstrow + 1; + ncols = rcol - lcol + 1; + endif + else + # Translate range to row & column numbers (1-based) + [dummy, nrows, ncols, firstrow, lcol] = parse_sp_range (cellrange); + # Check for too large requested range against actually present range + lastrow = min (firstrow + nrows - 1, sh.getRows ()); + nrows = min (nrows, sh.getRows () - firstrow + 1); + ncols = min (ncols, sh.getColumns () - lcol + 1); + rcol = lcol + ncols - 1; + endif + + # Read contents into rawarr + rawarr = cell (nrows, ncols); # create placeholder + for jj = lcol : rcol + for ii = firstrow:lastrow + scell = sh.getCell (jj-1, ii-1); + switch char (scell.getType ()) + case ctype {1} # Boolean + rawarr {ii+1-firstrow, jj+1-lcol} = scell.getValue (); + case ctype {2} # Boolean formula + if (spsh_opts.formulas_as_text) + tmp = scell.getFormula (); + rawarr {ii+1-firstrow, jj+1-lcol} = ["=" tmp]; + else + rawarr {ii+1-firstrow, jj+1-lcol} = scell.getValue (); + endif + case ctype {3} # Date + try + % Older JXL.JAR, returns float + rawarr {ii+1-firstrow, jj+1-lcol} = scell.getValue (); + catch + % Newer JXL.JAR, returns date string w. epoch = 1-1-1900 :-( + tmp = strsplit (char (scell.getDate ()), ' '); + yy = str2num (tmp{6}); + mo = find (ismember (months, upper (tmp{2})) == 1); + dd = str2num (tmp{3}); + hh = str2num (tmp{4}(1:2)); + mi = str2num (tmp{4}(4:5)); + ss = str2num (tmp{4}(7:8)); + if (scell.isTime ()) + yy = mo = dd = 0; + endif + rawarr {ii+1-firstrow, jj+1-lcol} = datenum (yy, mo, dd, hh, mi, ss); + end_try_catch + case ctype {4} # Date formula + if (spsh_opts.formulas_as_text) + tmp = scell.getFormula (); + rawarr {ii+1-firstrow, jj+1-lcol} = ["=" tmp]; + else + unwind_protect + % Older JXL.JAR, returns float + tmp = scell.getValue (); + % if we get here, we got a float (old JXL). + % Check if it is time + if (~scell.isTime ()) + % Reset rawarr <> so it can be processed below as date string + rawarr {ii+1-firstrow, jj+1-lcol} = []; + else + rawarr {ii+1-firstrow, jj+1-lcol} = tmp; + end + unwind_protect_cleanup + if (isempty (rawarr {ii+1-firstrow, jj+1-lcol})) + % Newer JXL.JAR, returns date string w. epoch = 1-1-1900 :-( + tmp = strsplit (char (scell.getDate ()), ' '); + yy = str2num (tmp{6}); + mo = find (ismember (months, upper (tmp{2})) == 1); + dd = str2num (tmp{3}); + hh = str2num (tmp{4}(1:2)); + mi = str2num (tmp{4}(4:5)); + ss = str2num (tmp{4}(7:8)); + if (scell.isTime ()) + yy = 0; mo = 0; dd = 0; + end + rawarr {ii+1-firstrow, jj+1-lcol} = datenum (yy, mo, dd, hh, mi, ss); + endif + end_unwind_protect + endif + case { ctype {5}, ctype {6}, ctype {7} } + # Empty, Error or Formula error. Nothing to do here + case ctype {8} # Number + rawarr {ii+1-firstrow, jj+1-lcol} = scell.getValue (); + case ctype {9} # String + rawarr {ii+1-firstrow, jj+1-lcol} = scell.getString (); + case ctype {10} # Numerical formula + if (spsh_opts.formulas_as_text) + tmp = scell.getFormula (); + rawarr {ii+1-firstrow, jj+1-lcol} = ["=" tmp]; + else + rawarr {ii+1-firstrow, jj+1-lcol} = scell.getValue (); + endif + case ctype {11} # String formula + if (spsh_opts.formulas_as_text) + tmp = scell.getFormula (); + rawarr {ii+1-firstrow, jj+1-lcol} = ["=" tmp]; + else + rawarr {ii+1-firstrow, jj+1-lcol} = scell.getString (); + endif + otherwise + # Do nothing + endswitch + endfor + endfor + + rstatus = 1; + xls.limits = [lcol, rcol; firstrow, lastrow]; + +endfunction + + +## Copyright (C) 2011 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{obj}, @var{rstatus}, @var{xls} ] = xls2oxs2oct (@var{xls}) +## @deftypefnx {Function File} [@var{obj}, @var{rstatus}, @var{xls} ] = xls2oxs2oct (@var{xls}, @var{wsh}) +## @deftypefnx {Function File} [@var{obj}, @var{rstatus}, @var{xls} ] = xls2oxs2oct (@var{xls}, @var{wsh}, @var{range}) +## Get cell contents in @var{range} in worksheet @var{wsh} in an Excel +## file pointed to in struct @var{xls} into the cell array @var{obj}. +## @var{range} can be a range or just the top left cell of the range. +## +## xls2oxs2oct should not be invoked directly but rather through xls2oct. +## + +## Author: Philip Nienhuis +## Created: 2011-03-26 +## Updates: +## 2012-02-25 Changed ctype into num array rather than cell array + +function [ rawarr, xls, rstatus ] = xls2oxs2oct (xls, wsh, cellrange, spsh_opts) + + persistent ctype; + if (isempty (ctype)) + ctype = zeros (6, 1); + # Get enumerated cell types. Beware as they start at 0 not 1 + ctype( 1) = (java_get ('com.extentech.ExtenXLS.CellHandle', 'TYPE_STRING')); # 0 + ctype( 2) = (java_get ('com.extentech.ExtenXLS.CellHandle', 'TYPE_FP')); # 1 + ctype( 3) = (java_get ('com.extentech.ExtenXLS.CellHandle', 'TYPE_INT')); # 2 + ctype( 4) = (java_get ('com.extentech.ExtenXLS.CellHandle', 'TYPE_FORMULA')); # 3 + ctype( 5) = (java_get ('com.extentech.ExtenXLS.CellHandle', 'TYPE_BOOLEAN')); # 4 + ctype( 6) = (java_get ('com.extentech.ExtenXLS.CellHandle', 'TYPE_DOUBLE')); # 5 + endif + + rstatus = 0; + wb = xls.workbook; + + # Check if requested worksheet exists in the file & if so, get pointer + nr_of_sheets = wb.getNumWorkSheets (); + if (isnumeric (wsh)) + if (wsh > nr_of_sheets), error (sprintf ("Worksheet # %d bigger than nr. of sheets (%d) in file %s", wsh, nr_of_sheets, xls.filename)); endif + sh = wb.getWorkSheet (wsh - 1); # OXS sheet count 0-based + printf ("(Reading from worksheet %s)\n", sh.getSheetName ()); + else + try + sh = wb.getWorkSheet (wsh); + catch + error (sprintf ("Worksheet %s not found in file %s", wsh, xls.filename)); + end_try_catch + end + + if (isempty (cellrange)) + # Get numeric sheet pointer (0-based) + wsh = sh.getTabIndex (); + # Get data rectangle row & column numbers (1-based) + [firstrow, lastrow, lcol, rcol] = getusedrange (xls, wsh+1); + if (firstrow == 0 && lastrow == 0) + # Empty sheet + rawarr = {}; + printf ("Worksheet '%s' contains no data\n", shnames {wsh}); + rstatus = 1; + return; + else + nrows = lastrow - firstrow + 1; + ncols = rcol - lcol + 1; + endif + else + # Translate range to row & column numbers (1-based) + [dummy, nrows, ncols, firstrow, lcol] = parse_sp_range (cellrange); + # Check for too large requested range against actually present range + lastrow = min (firstrow + nrows - 1, sh.getLastRow + 1 ()); + nrows = min (nrows, sh.getLastRow () - firstrow + 1); + ncols = min (ncols, sh.getLastCol () - lcol + 1); + rcol = lcol + ncols - 1; + endif + + # Read contents into rawarr + rawarr = cell (nrows, ncols); # create placeholder + for jj = lcol:rcol + for ii = firstrow:lastrow + try + scell = sh.getCell (ii-1, jj-1); + sctype = scell.getCellType (); + rawarr {ii+1-firstrow, jj+1-lcol} = scell.getVal (); + if (sctype == ctype(2) || sctype == ctype(3) || sctype == ctype(6)) + rawarr {ii+1-firstrow, jj+1-lcol} = scell.getDoubleVal (); + endif + catch + # Empty or non-existing cell + end_try_catch + endfor + endfor + + rstatus = 1; + xls.limits = [lcol, rcol; firstrow, lastrow]; + +endfunction + + +## Copyright (C) 2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## xls2uno2oct + +## Author: Philip Nienhuis +## Created: 2011-05-05 +## Updates: +## 2011-09-18 Adapted sh_names type to LO 3.4.1 +## 2011-09-19 Try to decipher if formulas return numeric or string values + +function [rawarr, xls, rstatus] = xls2uno2oct (xls, wsh, datrange, spsh_opts) + + sheets = xls.workbook.getSheets (); + sh_names = sheets.getElementNames (); + if (! iscell (sh_names)) + # Java array (LibreOffice 3.4.+); convert to cellstr + sh_names = char (sh_names); + else + sh_names = {sh_names}; + endif + + # Check sheet pointer + if (isnumeric (wsh)) + if (wsh < 1 || wsh > numel (sh_names)) + error ("Sheet index %d out of range 1-%d", wsh, numel (sh_names)); + endif + else + ii = strmatch (wsh, sh_names); + if (isempty (ii)), error ("Sheet '%s' not found", wsh); endif + wsh = ii; + endif + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.sheet.XSpreadsheet'); + sh = sheets.getByName(sh_names{wsh}).getObject.queryInterface (unotmp); + + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.sheet.XCellRangesQuery'); + xRQ = sh.queryInterface (unotmp); + # Get cell ranges of all rectangles containing data. Type values: + #java_get ('com.sun.star.sheet.CellFlags', 'VALUE') ans = 1 + #java_get ('com.sun.star.sheet.CellFlags', 'DATETIME') ans = 2 + #java_get ('com.sun.star.sheet.CellFlags', 'STRING') ans = 4 + #java_get ('com.sun.star.sheet.CellFlags', 'FORMULA') ans = 16 + # Yep, boolean is lacking... + Cellflgs = javaObject ("java.lang.Short", "23"); + ccells = xRQ.queryContentCells (Cellflgs); + addrs = ccells.getRangeAddressesAsString (); + + # Strip sheet name from addresses + adrblks = strsplit (addrs, ','); + if (isempty (adrblks)) + warning ('Sheet %s contains no data', sh_names{wsh}); + return + endif + + # Either parse (given cell range) or prepare (unknown range) help variables. + # As OpenOffice knows the occupied range, we need the limits anyway to avoid + # out-of-range errors + [ trow, brow, lcol, rcol ] = getusedrange (xls, wsh); + if (isempty (datrange)) + nrows = brow - trow + 1; # Number of rows to be read + ncols = rcol - lcol + 1; # Number of columns to be read + else + [dummy, nrows, ncols, srow, scol] = parse_sp_range (datrange); + # Truncate range silently if needed + brow = min (srow + nrows - 1, brow); + rcol = min (scol + ncols - 1, rcol); + trow = max (trow, srow); + lcol = max (lcol, scol); + nrows = min (brow - trow + 1, nrows); # Number of rows to be read + ncols = min (rcol - lcol + 1, ncols); # Number of columns to be read + endif + # Create storage for data at Octave side + rawarr = cell (nrows, ncols); + + # Get data. Apparently row & column indices are 0-based in UNO + for ii=trow-1:brow-1 + for jj=lcol-1:rcol-1 + XCell = sh.getCellByPosition (jj, ii); + cType = XCell.getType().getValue (); + switch cType + case 1 # Value + rawarr{ii-trow+2, jj-lcol+2} = XCell.getValue (); + case 2 # String + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.text.XText'); + rawarr{ii-trow+2, jj-lcol+2} = XCell.queryInterface (unotmp).getString (); + case 3 # Formula + if (spsh_opts.formulas_as_text) + rawarr{ii-trow+2, jj-lcol+2} = XCell.getFormula (); + else + # Unfortunately OOo gives no clue as to the type of formula result + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.text.XText'); + rawarr{ii-trow+2, jj-lcol+2} = XCell.queryInterface (unotmp).getString (); + tmp = str2double (rawarr{ii-trow+2, jj-lcol+2}); + # If the string happens to contain just a number we'll assume it is numeric + if (~isnan (tmp)); rawarr{ii-trow+2, jj-lcol+2} = tmp; endif + endif + otherwise + # Empty cell + endswitch + endfor + endfor + + # Keep track of data rectangle limits + xls.limits = [lcol, rcol; trow, brow]; + + rstatus = ~isempty (rawarr); + +endfunction diff --git a/octave_packages/io-1.0.19/xlsclose.m b/octave_packages/io-1.0.19/xlsclose.m new file mode 100644 index 0000000..c38fd80 --- /dev/null +++ b/octave_packages/io-1.0.19/xlsclose.m @@ -0,0 +1,278 @@ +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{xls}] = xlsclose (@var{xls}) +## @deftypefnx {Function File} [@var{xls}] = xlsclose (@var{xls}, @var{filename}) +## @deftypefnx {Function File} [@var{xls}] = xlsclose (@var{xls}, "FORCE") +## Close the Excel spreadsheet pointed to in struct @var{xls}, if needed +## write the file to disk. Based on information contained in @var{xls}, +## xlsclose will determine if the file should be written to disk. +## +## If no errors occured during writing, the xls file pointer struct will be +## reset and -if COM interface was used- ActiveX/Excel will be closed. +## However if errors occurred, the file pinter will be untouched so you can +## clean up before a next try with xlsclose(). +## Be warned that until xlsopen is called again with the same @var{xls} pointer +## struct, hidden Excel or Java applications with associated (possibly large) +## memory chunks are kept in memory, taking up resources. +## If (string) argument "FORCE" is supplied, the file pointer will be reset +## regardless, whether the possibly modified file has been saved successfully +## or not. Hidden Excel (COM) or OpenOffice.org (UNO) invocations may live on, +## possibly even impeding proper shutdown of Octave. +## +## @var{filename} can be used to write changed spreadsheet files to +## an other file than opened with xlsopen(); unfortunately this doesn't work +## with JXL (JExcelAPI) interface. +## +## You need MS-Excel (95 - 2010), and/or the Java package => 1.2.8 plus Apache +## POI > 3.5 and/or JExcelAPI and/or OpenXLS and/or OpenOffice.org or clones +## installed on your computer + proper javaclasspath set, to make this +## function work at all. +## +## @var{xls} must be a valid pointer struct made by xlsopen() in the same +## octave session. +## +## Examples: +## +## @example +## xls1 = xlsclose (xls1); +## (Close spreadsheet file pointed to in pointer struct xls1; xls1 is reset) +## @end example +## +## @seealso {xlsopen, xlsread, xlswrite, xls2oct, oct2xls, xlsfinfo} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-11-29 +## Updates: +## 2010-01-03 (checked OOXML support) +## 2010-08-25 See also: xlsopen (instead of xlsclose) +## 2010-10-20 Improved tracking of file changes and need to write it to disk +## 2010-10-27 Various changes to catch errors when writing to disk; +## " Added input arg "keepxls" for use with xlswrite.m to save the +## " untouched file ptr struct in case of errors rather than wipe it +## 2010-11-12 Replaced 'keepxls' by new filename arg; catch write errors and +## always keep file pointer in case of write errors +## 2011-03-26 Added OpenXLS support +## 2011-05-18 Added experimental UNO support, incl. saving newly created files +## 2011-09-08 Bug fix in check for filename input arg +## 2012-01-26 Fixed "seealso" help string + +function [ xls ] = xlsclose (xls, varargs) + + force = 0; + + if (nargin > 1) + for ii=2:nargin + if (strcmp (lower (varargin{ii}), "force")) + # Close .ods anyway even if write errors occur + force = 1; + elseif (~isempty (strfind (tolower (varargin{ii}), '.'))) + # Apparently a file name + if (xls.changed == 0 || xls.changed > 2) + printf ("File %s wasn't changed, new filename ignored.", xls.filename); + elseif (strcmp (xls.xtype, 'JXL')) + error ("JXL doesn't support changing filename, new filename ignored."); + elseif ~((strcmp (xls.xtype, 'COM') || strcmp (xls.xtype, 'UNO')) && isempty (strfind ( lower (filename), '.xls'))) + # Excel/ActiveX && OOo (UNO bridge) will write any valid filetype; POI/JXL/OXS need .xls[x] + error ('.xls or .xlsx extension lacking in filename %s', filename); + else + ### For multi-user environments, uncomment below AND relevant stanza in xlsopen + # In case of COM, be sure to first close the open workbook + #if (strcmp (xls.xtype, 'COM')) + # xls.app.Application.DisplayAlerts = 0; + # xls.workbook.close(); + # xls.app.Application.DisplayAlerts = 0; + #endif + if (strcmp (xls.xtype, 'UNO')) + # If needed, turn filename into URL + if (~isempty (strmatch ("file:///", filename)) || ~isempty (strmatch ("http:///", filename))... + || ~isempty (strmatch ("ftp:///", filename)) || ~isempty (strmatch ("www:///", filename))) + # Seems in proper shape for OOo (at first sight) + else + # Transform into URL form + fname = canonicalize_file_name (strsplit (filename, filesep){end}); + # On Windows, change backslash file separator into forward slash + if (strcmp (filesep, "\\")) + tmp = strsplit (fname, filesep); + flen = numel (tmp); + tmp(2:2:2*flen) = tmp; + tmp(1:2:2*flen) = '/'; + filename = [ 'file://' tmp{:} ]; + endif + endif + endif + # Preprocessing / -checking ready. Assign filename arg to file ptr struct + xls.filename = filename; + endif + endif + endfor + endif + + if (strcmp (xls.xtype, 'COM')) + # If file has been changed, write it out to disk. + # + # Note: COM / VB supports other Excel file formats as FileFormatNum: + # 4 = .wks - Lotus 1-2-3 / Microsoft Works + # 6 = .csv + # -4158 = .txt + # 36 = .prn + # 50 = .xlsb - xlExcel12 (Excel Binary Workbook in 2007 with or without macro's) + # 51 = .xlsx - xlOpenXMLWorkbook (without macro's in 2007) + # 52 = .xlsm - xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007) + # 56 = .xls - xlExcel8 (97-2003 format in Excel 2007) + # (see Excel Help, VB reference, Enumerations, xlFileType) + + # xls.changed = 0: no changes: just close; + # 1: existing file with changes: save, close. + # 2: new file with data added: save, close + # 3: new file, no added added (empty): close & delete on disk + + xls.app.Application.DisplayAlerts = 0; + try + if (xls.changed > 0 && xls.changed < 3) + if (xls.changed == 2) + # Probably a newly created, or renamed, Excel file + printf ("Saving file %s ...\n", xls.filename); + xls.workbook.SaveAs (canonicalize_file_name (xls.filename)); + elseif (xls.changed == 1) + # Just updated existing Excel file + xls.workbook.Save (); + endif + xls.changed = 0; + xls.workbook.Close (canonicalize_file_name (xls.filename)); + endif + xls.app.Quit (); + delete (xls.workbook); # This statement actually closes the workbook + delete (xls.app); # This statement actually closes down Excel + catch + xls.app.Application.DisplayAlerts = 1; + end_try_catch + + elseif (strcmp (xls.xtype, 'POI')) + if (xls.changed > 0 && xls.changed < 3) + try + xlsout = java_new ("java.io.FileOutputStream", xls.filename); + bufout = java_new ("java.io.BufferedOutputStream", xlsout); + if (xls.changed == 2) printf ("Saving file %s...\n", xls.filename); endif + xls.workbook.write (bufout); + bufout.flush (); + bufout.close (); + xlsout.close (); + xls.changed = 0; + catch +# xlsout.close (); + end_try_catch + endif + + elseif (strcmp (xls.xtype, 'JXL')) + if (xls.changed > 0 && xls.changed < 3) + try + if (xls.changed == 2) printf ("Saving file %s...\n", xls.filename); endif + xls.workbook.write (); + xls.workbook.close (); + if (xls.changed == 3) + # Upon entering write mode, JExcelAPI always makes a disk file + # Incomplete new files (no data added) had better be deleted. + xls.workbook.close (); + delete (xls.filename); + endif + xls.changed = 0; + catch + end_try_catch + endif + + elseif (strcmp (xls.xtype, 'OXS')) + if (xls.changed > 0 && xls.changed < 3) + try + xlsout = java_new ("java.io.FileOutputStream", xls.filename); + bufout = java_new ("java.io.BufferedOutputStream", xlsout); + if (xls.changed == 2) printf ("Saving file %s...\n", xls.filename); endif + xls.workbook.writeBytes (bufout); + xls.workbook.close (); + bufout.flush (); + bufout.close (); + xlsout.close (); + xls.changed = 0; + catch +# xlsout.close (); + end_try_catch + else + xls.workbook.close (); + endif + + elseif (strcmp (xls.xtype, 'UNO')) + # Java & UNO bridge + try + if (xls.changed && xls.changed < 3) + # Workaround: + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.frame.XModel'); + xModel = xls.workbook.queryInterface (unotmp); + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.util.XModifiable'); + xModified = xModel.queryInterface (unotmp); + if (xModified.isModified ()) + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.frame.XStorable'); # isReadonly() ? + xStore = xls.app.xComp.queryInterface (unotmp); + if (xls.changed == 2) + # Some trickery as Octave Java cannot create non-numeric arrays + lProps = javaArray ('com.sun.star.beans.PropertyValue', 1); + lProp = java_new ('com.sun.star.beans.PropertyValue', "Overwrite", 0, true, []); + lProps(1) = lProp; + # OK, store file + xStore.storeAsURL (xls.filename, lProps); + else + xStore.store (); + endif + endif + endif + xls.changed = -1; # Needed for check on properly shutting down OOo + # Workaround: + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.frame.XModel'); + xModel = xls.app.xComp.queryInterface (unotmp); + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.util.XCloseable'); + xClosbl = xModel.queryInterface (unotmp); + xClosbl.close (true); + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.frame.XDesktop'); + xDesk = xls.app.aLoader.queryInterface (unotmp); + xDesk.terminate(); + xls.changed = 0; + catch + if (force) + # Force closing OOo + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.frame.XDesktop'); + xDesk = xls.app.aLoader.queryInterface (unotmp); + xDesk.terminate(); + else + warning ("Error closing xls pointer (UNO)"); + endif + return + end_try_catch + +# elseif + + endif + + if (xls.changed && xls.changed < 3) + warning (sprintf ("File %s could not be saved. Read-only or in use elsewhere?\nFile pointer preserved.", xls.filename)); + if (force) + xls = []; + endif + else + xls = []; + endif + +endfunction diff --git a/octave_packages/io-1.0.19/xlsfinfo.m b/octave_packages/io-1.0.19/xlsfinfo.m new file mode 100644 index 0000000..7c94288 --- /dev/null +++ b/octave_packages/io-1.0.19/xlsfinfo.m @@ -0,0 +1,231 @@ +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{filetype}] = xlsfinfo (@var{filename} [, @var{reqintf}]) +## @deftypefnx {Function File} [@var{filetype}, @var{sh_names}] = xlsfinfo (@var{filename} [, @var{reqintf}]) +## @deftypefnx {Function File} [@var{filetype}, @var{sh_names}, @var{fformat}] = xlsfinfo (@var{filename} [, @var{reqintf}]) +## Query Excel spreadsheet file @var{filename} for some info about its +## contents. +## +## If @var{filename} is a recognizable Excel spreadsheet file, +## @var{filetype} returns the string "Microsoft Excel Spreadsheet", or +## @'' (empty string) otherwise. +## +## If @var{filename} is a recognizable Excel spreadsheet file, optional +## argument @var{sh_names} contains a list (cell array) of sheet +## names (and in case Excel is installed: sheet types) contained in +## @var{filename}, in the order (from left to right) in which they occur +## in the sheet stack. +## +## Optional return value @var{fformat} currently returns @'' (empty +## string) unless @var{filename} is a readable Excel 97-2003 .xls file or +## an Excel 2007 .xlsx / .xlsb file in which case @var{fformat} is set to +## "xlWorkbookNormal". Excel 95 .xls files can only be read through the JXL +## (JExcelAPI) or UNO (OpenOffice.org) Java-based interfaces. +## +## If no return arguments are specified the sheet names are echoed to the +## terminal screen; in case of Java interfaces for each sheet the actual +## occupied data range is echoed as well. The occupied cell range will have +## to be determined behind the scenes first; this can take some time for the +## Java-based interfaces. +## +## If multiple xls interfaces have been installed, @var{reqintf} can be +## specified. This can sometimes be handy, e.g. to get an idea of occupied +## cell ranges in each worksheet using different interfaces (due to cached +## info and/or different treatment of empty but formatted cells, each +## interfaces may give different results). +## +## For use on OOXML spreadsheets one needs full POI and/or UNO support (see +## xlsopen) and 'poi' or 'uno' needs to be specified for @var{reqintf}. For +## Excel 95 file use 'jxl' or 'uno'. +## +## Examples: +## +## @example +## exist = xlsfinfo ('test4.xls'); +## (Just checks if file test4.xls is a readable Excel file) +## @end example +## +## @example +## [exist, names] = xlsfinfo ('test4.xls'); +## (Checks if file test4.xls is a readable Excel file and return a +## list of sheet names and -types) +## @end example +## +## @seealso {oct2xls, xlsread, xls2oct, xlswrite} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-10-27 +## Updates: +## 2009-01-01 Echo sheet names to screen, request interface type) +## 2010-03-21 Better tabulated output; occupied date range per sheet echoed +## for Java interfaces (though it may be a bit off in case of JXL) +## 2010-05-31 Added remark about delays when determining occupied data range +## 2010-08-25 Improved help text (Excel file types) +## 2010-10-06 Added ";" to str2 declaration +## '' Added occupied range echo for COM interface (may be a bit off too) +## 2010-10-10 Made output arg2 contain only address ranges (or other sheet type names) +## 2010-11-01 Added other file type strings for return arg #3 (fformat) +## 2011-03-26 Added OpenXLS support +## 2011-05-18 Experimental UNO support +## 2011-09-08 Some code simplifications +## 2012-01-26 Fixed "seealso" help string +## 2012-02-25 Added info on occupied ranges to sh_names outarg for all interfaces + +function [ filetype, sh_names, fformat ] = xlsfinfo (filename, reqintf=[]) + + persistent str2; str2 = ' '; # 33 spaces + persistent lstr2; lstr2 = length (str2); + + xls = xlsopen (filename, 0, reqintf); + if (isempty (xls)); return; endif + + toscreen = nargout < 1; + + xlWorksheet = -4167; xlChart = 4; + # If any valid xls-pointer struct has been returned, it must be a valid Excel spreadsheet + filetype = 'Microsoft Excel Spreadsheet'; fformat = ''; + + if (strcmp (xls.xtype, 'COM')) + # See if desired worksheet number or name exists + sh_cnt = xls.workbook.Sheets.count; + sh_names = cell (sh_cnt, 2); + ws_cnt = 0; ch_cnt = 0; o_cnt = 0; + for ii=1:sh_cnt + sh_names(ii, 1) = xls.workbook.Sheets(ii).Name; + if (xls.workbook.Sheets(ii).Type == xlWorksheet) + [tr, lr, lc, rc] = getusedrange (xls, ++ws_cnt); + if (tr) + sh_names(ii, 2) = sprintf ("%s:%s", calccelladdress (tr, lc), calccelladdress (lr, rc)); + else + sh_names(ii, 2) = "Empty"; + endif + elseif (xls.workbook.Sheets(ii).Type == xlChart) + sh_names(ii, 2) = sprintf ("Chart"); ++ch_cnt; + else + sh_names(ii, 2) = 'Other_type'; ++o_cnt; + endif + endfor + if (ws_cnt > 0 || ch_cnt > 0) + if (strcmpi (xls.filename(end-2:end), 'xls')) + fformat = "xlWorkbookNormal"; + elseif (strcmpi (xls.filename(end-2:end), 'csv')) + fformat = "xlCSV"; # Works only with COM + elseif (strcmpi (xls.filename(end-3:end-1), 'xls')) + fformat = "xlOpenXMLWorkbook"; + elseif (strmatch ('htm', lower (xls.filename(end-3:end)))) + fformat = "xlHtml"; # Works only with COM + else + fformat = ''; + endif + endif + + elseif (strcmp (xls.xtype, 'POI')) + persistent cblnk; cblnk = java_get ('org.apache.poi.ss.usermodel.Cell', 'CELL_TYPE_BLANK'); + sh_cnt = xls.workbook.getNumberOfSheets(); + sh_names = cell (sh_cnt, 2); nsrows = zeros (sh_cnt, 1); + for ii=1:sh_cnt + sh = xls.workbook.getSheetAt (ii-1); # Java POI starts counting at 0 + sh_names(ii, 1) = char (sh.getSheetName()); + # Java POI doesn't distinguish between worksheets and graph sheets + [tr, lr, lc, rc] = getusedrange (xls, ii); + if (tr) + sh_names(ii, 2) = sprintf ("%s:%s", calccelladdress (tr, lc), calccelladdress (lr, rc)); + else + sh_names(ii, 2) = "Empty"; + endif + endfor + if (sh_cnt > 0) + if (strcmpi (xls.filename(end-2:end), 'xls')) + fformat = "xlWorkbookNormal"; + elseif (strcmpi (xls.filename(end-3:end-1), 'xls')) + fformat = "xlOpenXMLWorkbook"; + else + fformat = ''; + endif + endif + + elseif (strcmp (xls.xtype, 'JXL')) + sh_cnt = xls.workbook.getNumberOfSheets (); + sh_names = cell (sh_cnt, 2); nsrows = zeros (sh_cnt, 1); + sh_names(:,1) = char (xls.workbook.getSheetNames ()); + for ii=1:sh_cnt + [tr, lr, lc, rc] = getusedrange (xls, ii); + if (tr) + sh_names(ii, 2) = sprintf ("%s:%s", calccelladdress (tr, lc), calccelladdress (lr, rc)); + else + sh_names(ii, 2) = "Empty"; + endif + endfor + if (sh_cnt > 0) fformat = "xlWorkbookNormal"; else, fformat = ''; endif + + elseif (strcmp (xls.xtype, 'OXS')) + sh_cnt = xls.workbook.getNumWorkSheets (); + sh_names = cell (sh_cnt, 2); nsrows = zeros (sh_cnt, 1); + for ii=1:sh_cnt + sh = xls.workbook.getWorkSheet (ii-1); # OpenXLS starts counting at 0 + sh_names(ii, 1) = char (sh.getSheetName()); + # OpenXLS doesn't distinguish between worksheets and graph sheets + [tr, lr, lc, rc] = getusedrange (xls, ii); + if (tr) + sh_names(ii, 2) = sprintf ("%s:%s", calccelladdress (tr, lc), calccelladdress (lr, rc)); + else + sh_names(ii, 2) = "Empty or Chart"; + endif + endfor + if (sh_cnt > 0); fformat = "xlWorkbookNormal"; else; fformat = ''; endif + + elseif (strcmp (xls.xtype, 'UNO')) + sheets = xls.workbook.getSheets (); + sheetnames = sheets.getElementNames (); # A Java object, NOT a cell array + sh_cnt = numel (sheetnames); + sh_names = cell (sh_cnt, 2); + for ii=1:sh_cnt + sh_names(ii, 1) = sheetnames(ii); + [ tr, lr, lc, rc ] = getusedrange (xls, ii); + if (tr) + sh_names(ii, 2) = sprintf ("%s:%s", calccelladdress (tr, lc), calccelladdress (lr, rc)); + else + sh_names(ii, 2) = "Empty or Chart"; + endif + endfor + if (sh_cnt > 0); fformat = "xlWorkbookNormal"; else; fformat = ''; endif + +# elseif + + else + error (sprintf ("xlsfinfo: unknown Excel .xls interface - %s.", xls.xtype)); + + endif + + if (toscreen) + # Echo sheet names to screen + for ii=1:sh_cnt + str1 = sprintf ("%3d: %s", ii, sh_names{ii, 1}); + if (index (sh_names{ii, 2}, ":")) + str3 = ['(Used range ~ ' sh_names{ii, 2} ')']; + else + str3 = sh_names{ii, 2}; + endif + printf ("%s%s%s\n", str1, str2(1:lstr2-length (sh_names{ii, 1})), str3); + endfor + endif + + xlsclose (xls); + +endfunction diff --git a/octave_packages/io-1.0.19/xlsopen.m b/octave_packages/io-1.0.19/xlsopen.m new file mode 100644 index 0000000..13c83e9 --- /dev/null +++ b/octave_packages/io-1.0.19/xlsopen.m @@ -0,0 +1,647 @@ +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## 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{xls} = xlsopen (@var{filename}) +## @deftypefnx {Function File} @var{xls} = xlsopen (@var{filename}, @var{readwrite}) +## @deftypefnx {Function File} @var{xls} = xlsopen (@var{filename}, @var{readwrite}, @var{reqintf}) +## Get a pointer to an Excel spreadsheet in the form of return argument +## (file pointer struct) @var{xls}. After processing the spreadsheet, +## the file pointer must be explicitly closed by calling xlsclose(). +## +## Calling xlsopen without specifying a return argument is fairly useless! +## +## To make this function work at all, you need MS-Excel (95 - 2003), and/or +## the Java package >= 1.2.8 plus Apache POI >= 3.5 and/or JExcelAPI and/or +## OpenXLS and/or OpenOffice.org (or clones) installed on your computer + +## proper javaclasspath set. These interfaces are referred to as COM, POI, +## JXL, OXS, and UNO, resp., and are preferred in that order by default +## (depending on their presence). +## For OOXML support, in addition to Apache POI support you also need the +## following jars in your javaclasspath: poi-ooxml-schemas-3.5.jar, +## xbean.jar and dom4j-1.6.1.jar (or later versions). Later OpenOffice.org +## versions (UNO) have support for OOXML as well. +## Excel'95 spreadsheets can only be read by JExcelAPI and OpenOffice.org. +## +## @var{filename} should be a valid .xls or xlsx Excel file name (including +## extension). But if you use the COM interface you can specify any extension +## that your installed Excel version can read AND write; the same goes for UNO +## (OpenOffice.org). Using the other Java interfaces, only .xls or .xlsx are +## allowed. If @var{filename} does not contain any directory path, the file +## is saved in the current directory. +## +## If @var{readwrite} is set to 0 (default value) or omitted, the Excel file +## is opened for reading. If @var{readwrite} is set to True or 1, an Excel +## file is opened (or created) for reading & writing. +## +## Optional input argument @var{reqintf} can be used to override the Excel +## interface that otherwise is automatically selected by xlsopen. Currently +## implemented interfaces (in order of preference) are 'COM' (Excel/COM), +## 'POI' (Java/Apache POI), 'JXL' (Java/JExcelAPI), 'OXS' (Java/OpenXLS), or +## 'UNO' (Java/OpenOffice.org - EXPERIMENTAL!). +## In most situations this parameter is unneeded as xlsopen automatically +## selects the most useful interface present. +## +## Beware: Excel invocations may be left running invisibly in case of COM +## errors or forgetting to close the file pointer. Similarly for OpenOffice.org +## which may even prevent Octave from being closed. +## +## Examples: +## +## @example +## xls = xlsopen ('test1.xls'); +## (get a pointer for reading from spreadsheet test1.xls) +## +## xls = xlsopen ('test2.xls', 1, 'POI'); +## (as above, indicate test2.xls will be written to; in this case using Java +## and the Apache POI interface are requested) +## @end example +## +## @seealso {xlsclose, xlsread, xlswrite, xls2oct, oct2xls, xlsfinfo} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-11-29 +## Updates: +## 2010-01-03 Added OOXML support +## 2010-01-10 Changed (java) interface preference order to COM->POI->JXL +## 2010-01-16 Removed echoeing debug info in POI stanza +## 2010-03-01 Removed javaclasspath check for rt.jar +## 2010-03-14 Fixed check on xwrite flag lines 204+, if xlsopen fails xls ptr +## should be [] +## 2010-08-25 Improved help text +## 2010-09-27 Improved POI help message for unrecognized .xls format to hint for BIFF5/JXL +## 2010-10-20 Improved code for tracking changes to new/existing files +## '' Lots of code cleanup, improved error checking and catching +## '' Implemented fallback to JXL if POI can't read a file. +## 2010-10-30 More fine-grained file existence/writable checks +## 2010-11-01 Added .Application.DisplayAlerts=0 in COM section to avoid Excel pop-ups +## 2010-11-05 Option for multiple requested interface types (cell array) +## '' Bug fix: JXL fallback from POI for BIFF5 is only useful for reading +## 2010-11-05 Slight change to reporting to screen +## 2010-11-08 Tested with POI 3.7 (OK) +## 2010-11-10 Texinfo header updated +## 2010-12-01 Small bugfix - reset xlssupport in l. 102 +## 2010-12-06 Textual changes to info header +## 2011-03-26 OpenXLS support added +## 2011-05-18 Experimental UNO support added, incl. creating new spreadsheets +## 2011-05-22 Textual changes in header +## 2011-05-29 Cleanup of comments & messages +## 2011-09-03 Reset chkintf to [] if no xls support was discovered (to allow +## rediscovery of interfaces between xlsopen calls, e.g. javaclasspath changes) +## 2011-09-08 Minor code cleanup +## 2012-01-26 Fixed "seealso" help string +## 2012-06-06 Improved interface detection logic. No more messages if same interface is +## requested & used consecutively +## 2012-06-07 Fixed mixed-up lastintf assignments for POI and JXL +## +## Latest subfunction update: 2012-06-06 + +function [ xls ] = xlsopen (filename, xwrite=0, reqinterface=[]) + + persistent xlsinterfaces; persistent chkintf; persistent lastintf; + # xlsinterfaces. = [] (not yet checked), 0 (found to be unsupported) or 1 (OK) + if (isempty (chkintf)); + chkintf = 1; + xlsinterfaces = struct ('COM', [], 'POI', [], 'JXL', [], 'OXS', [], 'UNO', []); + endif + if (isempty (lastintf)) + lastintf = "---"; + endif + + xlssupport = 0; + + if (nargout < 1) + usage ("XLS = xlsopen (Xlfile [, Rw] [, reqintf]). But no return argument specified!"); + endif + + if (~(islogical (xwrite) || isnumeric (xwrite))) + usage ("Numerical or logical value expected for arg # 2") + endif + + if (~isempty (reqinterface)) + if ~(ischar (reqinterface) || iscell (reqinterface)), usage ("Arg # 3 not recognized"); endif + # Turn arg3 into cell array if needed + if (~iscell (reqinterface)), reqinterface = {reqinterface}; endif + ## Check if previously used interface matches a requested interface + if (isempty (regexpi (reqinterface, lastintf, 'once'){1})) + ## New interface requested + xlsinterfaces.COM = 0; xlsinterfaces.POI = 0; xlsinterfaces.JXL = 0; + xlsinterfaces.OXS = 0; xlsinterfaces.UNO = 0; + for ii=1:numel (reqinterface) + reqintf = toupper (reqinterface {ii}); + # Try to invoke requested interface(s) for this call. Check if it + # is supported anyway by emptying the corresponding var. + if (strcmpi (reqintf, 'COM')) + xlsinterfaces.COM = []; + elseif (strcmpi (reqintf, 'POI')) + xlsinterfaces.POI = []; + elseif (strcmpi (reqintf, 'JXL')) + xlsinterfaces.JXL = []; + elseif (strcmpi (reqintf, 'OXS')) + xlsinterfaces.OXS = []; + elseif (strcmpi (reqintf, 'UNO')) + xlsinterfaces.UNO = []; + else + usage (sprintf ("Unknown .xls interface \"%s\" requested. Only COM, POI, JXL, OXS or UNO supported\n", reqinterface{})); + endif + endfor + printf ("Checking requested interface(s):\n"); + xlsinterfaces = getxlsinterfaces (xlsinterfaces); + # Well, is/are the requested interface(s) supported on the system? + # FIXME check for multiple interfaces + xlsintf_cnt = 0; + for ii=1:numel (reqinterface) + if (~xlsinterfaces.(toupper (reqinterface{ii}))) + # No it aint + printf ("%s is not supported.\n", upper (reqinterface{ii})); + else + ++xlsintf_cnt; + endif + endfor + # Reset interface check indicator if no requested support found + if (~xlsintf_cnt) + chkintf = []; + xls = []; + return + endif + endif + endif + + # Var xwrite is really used to avoid creating files when wanting to read, or + # not finding not-yet-existing files when wanting to write. + + # Check if Excel file exists. Adapt file open mode for readwrite argument + if (xwrite), fmode = 'r+b'; else fmode = 'rb'; endif + fid = fopen (filename, fmode); + if (fid < 0) # File doesn't exist... + if (~xwrite) # ...which obviously is fatal for reading... + error ( sprintf ("File %s not found\n", filename)); + else # ...but for writing, we need more info: + fid = fopen (filename, 'rb'); # Check if it exists at all... + if (fid < 0) # File didn't exist yet. Simply create it + printf ("Creating file %s\n", filename); + xwrite = 3; + else # File exists, but is not writable => Error + fclose (fid); # Do not forget to close the handle neatly + error (sprintf ("Write mode requested but file %s is not writable\n", filename)) + endif + endif + else + # Close file anyway to avoid COM or Java errors + fclose (fid); + endif + + # Check for the various Excel interfaces. No problem if they've already + # been checked, getxlsinterfaces (far below) just returns immediately then. + xlsinterfaces = getxlsinterfaces (xlsinterfaces); + + # Supported interfaces determined; Excel file type check moved to seperate interfaces. + chk1 = strcmpi (filename(end-3:end), '.xls'); # Regular (binary) BIFF + chk2 = strcmpi (filename(end-4:end-1), '.xls'); # Zipped XML / OOXML + + # Initialize file ptr struct + xls = struct ("xtype", 'NONE', "app", [], "filename", [], "workbook", [], "changed", 0, "limits", []); + + # Keep track of which interface is selected + xlssupport = 0; + + # Interface preference order is defined below: currently COM -> POI -> JXL -> OXS -> UNO + if (xlsinterfaces.COM && ~xlssupport) + # Excel functioning has been tested above & file exists, so we just invoke it + app = actxserver ("Excel.Application"); + try # Because Excel itself can still crash on file formats etc. + app.Application.DisplayAlerts = 0; + if (xwrite < 2) + # Open workbook + wb = app.Workbooks.Open (canonicalize_file_name (filename)); + elseif (xwrite > 2) + # Create a new workbook + wb = app.Workbooks.Add (); + ### Uncommenting the below statement can be useful in multi-user environments. + ### Be sure to uncomment correspondig stanza in xlsclose to avoid zombie Excels + # wb.SaveAs (canonicalize_file_name (filename)) + endif + xls.app = app; + xls.xtype = 'COM'; + xls.workbook = wb; + xls.filename = filename; + xlssupport += 1; + lastintf = 'COM'; + catch + warning ( sprintf ("ActiveX error trying to open or create file %s\n", filename)); + app.Application.DisplayAlerts = 1; + app.Quit (); + delete (app); + end_try_catch + endif + + if (xlsinterfaces.POI && ~xlssupport) + if ~(chk1 || chk2) + error ("Unsupported file format for Apache POI.") + endif + # Get handle to workbook + try + if (xwrite > 2) + if (chk1) + wb = java_new ('org.apache.poi.hssf.usermodel.HSSFWorkbook'); + elseif (chk2) + wb = java_new ('org.apache.poi.xssf.usermodel.XSSFWorkbook'); + endif + xls.app = 'new_POI'; + else + xlsin = java_new ('java.io.FileInputStream', filename); + wb = java_invoke ('org.apache.poi.ss.usermodel.WorkbookFactory', 'create', xlsin); + xls.app = xlsin; + endif + xls.xtype = 'POI'; + xls.workbook = wb; + xls.filename = filename; + xlssupport += 2; + lastintf = 'POI'; + catch + clear xlsin; + if (xlsinterfaces.JXL) + printf ('Couldn''t open file %s using POI; trying Excel''95 format with JXL...\n', filename); + endif + end_try_catch + endif + + if (xlsinterfaces.JXL && ~xlssupport) + if (~chk1) + error ("JXL can only read reliably from .xls files") + endif + try + xlsin = java_new ('java.io.File', filename); + if (xwrite > 2) + # Get handle to new xls-file + wb = java_invoke ('jxl.Workbook', 'createWorkbook', xlsin); + else + # Open existing file + wb = java_invoke ('jxl.Workbook', 'getWorkbook', xlsin); + endif + xls.xtype = 'JXL'; + xls.app = xlsin; + xls.workbook = wb; + xls.filename = filename; + xlssupport += 4; + lastintf = 'JXL'; + catch + clear xlsin; + if (xlsinterfaces.POI) + printf ('... No luck with JXL either, unsupported file format.\n', filename); + endif + end_try_catch + endif + + if (xlsinterfaces.OXS && ~xlssupport) + if (~chk1) + error ("OXS can only read from .xls files") + endif + try + wb = javaObject ('com.extentech.ExtenXLS.WorkBookHandle', filename); + xls.xtype = 'OXS'; + xls.app = 'void - OpenXLS'; + xls.workbook = wb; + xls.filename = filename; + xlssupport += 8; + lastintf = 'OXS'; + catch + printf ('Unsupported file format for OpenXLS - %s\n'); + end_try_catch + endif + + if (xlsinterfaces.UNO && ~xlssupport) + # First, the file name must be transformed into a URL + if (~isempty (strmatch ("file:///", filename)) || ~isempty (strmatch ("http:///", filename))... + || ~isempty (strmatch ("ftp:///", filename)) || ~isempty (strmatch ("www:///", filename))) + # Seems in proper shape for OOo (at first sight) + else + # Transform into URL form + fname = canonicalize_file_name (strsplit (filename, filesep){end}); + # On Windows, change backslash file separator into forward slash + if (strcmp (filesep, "\\")) + tmp = strsplit (fname, filesep); + flen = numel (tmp); + tmp(2:2:2*flen) = tmp; + tmp(1:2:2*flen) = '/'; + fname = [ tmp{:} ]; + endif + filename = [ 'file://' fname ]; + endif + try + xContext = java_invoke ("com.sun.star.comp.helper.Bootstrap", "bootstrap"); + xMCF = xContext.getServiceManager (); + oDesktop = xMCF.createInstanceWithContext ("com.sun.star.frame.Desktop", xContext); + # Workaround for .queryInterface(): + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.frame.XComponentLoader'); + aLoader = oDesktop.queryInterface (unotmp); + # Some trickery as Octave Java cannot create initialized arrays + lProps = javaArray ('com.sun.star.beans.PropertyValue', 1); + lProp = java_new ('com.sun.star.beans.PropertyValue', "Hidden", 0, true, []); + lProps(1) = lProp; + if (xwrite > 2) + xComp = aLoader.loadComponentFromURL ("private:factory/scalc", "_blank", 0, lProps); + else + xComp = aLoader.loadComponentFromURL (filename, "_blank", 0, lProps); + endif + # Workaround for .queryInterface(): + unotmp = java_new ('com.sun.star.uno.Type', 'com.sun.star.sheet.XSpreadsheetDocument'); + xSpdoc = xComp.queryInterface (unotmp); + # save in ods struct: + xls.xtype = 'UNO'; + xls.workbook = xSpdoc; # Needed to be able to close soffice in odsclose() + xls.filename = filename; + xls.app.xComp = xComp; # Needed to be able to close soffice in odsclose() + xls.app.aLoader = aLoader; # Needed to be able to close soffice in odsclose() + xls.odfvsn = 'UNO'; + xlssupport += 16; + lastintf = 'UNO'; + catch + error ('Couldn''t open file %s using UNO', filename); + end_try_catch + endif + + # if + # ---- other interfaces + # endif + + # Rounding up. If none of the xlsinterfaces is supported we're out of luck. + if (~xlssupport) + if (isempty (reqinterface)) + printf ("None.\n"); + warning ("No support for Excel .xls I/O"); + else + warning ("File type not supported by %s %s %s %s %s", reqinterface{:}); + endif + xls = []; + # Reset found interfaces for re-testing in the next call. Add interfaces if needed. + chkintf = []; + else + # From here on xwrite is tracked via xls.changed in the various lower + # level r/w routines and it is only used to determine if an informative + # message is to be given when saving a newly created xls file. + xls.changed = xwrite; + + # Until something was written to existing files we keep status "unchanged". + # xls.changed = 0 (existing/only read from), 1 (existing/data added), 2 (new, + # data added) or 3 (pristine, no data added). + if (xls.changed == 1), xls.changed = 0; endif + endif + +endfunction + + +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## 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{xlsinterfaces} = getxlsinterfaces (@var{xlsinterfaces}) +## Get supported Excel .xls file read/write interfaces from the system. +## Each interface for which the corresponding field is set to empty +## will be checked. So by manipulating the fields of input argument +## @var{xlsinterfaces} it is possible to specify which +## interface(s) should be checked. +## +## Currently implemented interfaces comprise: +## - ActiveX / COM (native Excel in the background) +## - Java & Apache POI +## - Java & JExcelAPI +## - Java & OpenXLS (only JRE >= 1.4 needed) +## - Java & UNO bridge (native OpenOffice.org in background) - EXPERIMENTAL!! +## +## Examples: +## +## @example +## xlsinterfaces = getxlsinterfaces (xlsinterfaces); +## @end example + +## Author: Philip Nienhuis +## Created: 2009-11-29 +## Last updates: +## 2009-12-27 Make sure proper dimensions are checked in parsed javaclasspath +## 2010-09-11 Rearranged code and clarified messages about missing classes +## 2010-09-27 More code cleanup +## 2010-10-20 Added check for minimum Java version (should be >= 6 / 1.6) +## 2010-11-05 Slight change to reporting to screen +## 2011-02-15 Adapted to javaclasspath calling style of java-1.2.8 pkg +## 2011-03-26 OpenXLS support added +## '' Bug fix: javaclasspath change wasn't picked up between calls with req.intf +## 2011-05-18 Experimental UNO support added +## 2011-05-29 Reduced verbosity +## 2011-06-06 Fix for javaclasspath format in *nix w java-1.2.8 pkg +## 2011-06-13 Fixed potentially faulty tests for java classlib presence +## 2011-09-03 Fixed order of xlsinterfaces. statements in Java detection try-catch +## '' Reset tmp1 (always allow interface rediscovery) for empty xlsinterfaces arg +## 2011-09-08 Minor code cleanup +## 2011-09-18 Added temporary warning about UNO interface +## 2012-03-01 Changed UNO warning so that it is suppressed when UNO is not yet chosen +## 2012-03-07 Only check for COM if run on Windows +## 2012-03-21 Print newline if COM found but no Java support +## '' Improved logic for finding out what interfaces to check +## '' Fixed bugs with Java interface checking (tmp1 initialization) +## 2012-06-06 Improved & simplified Java check code + +function [xlsinterfaces] = getxlsinterfaces (xlsinterfaces) + + # tmp1 = [] (not initialized), 0 (No Java detected), or 1 (Working Java found) + persistent tmp1 = []; persistent jcp; # Java class path + persistent uno_1st_time = 0; + + if (isempty (xlsinterfaces.COM) && isempty (xlsinterfaces.POI) && isempty (xlsinterfaces.JXL) + && isempty (xlsinterfaces.OXS) && isempty (xlsinterfaces.UNO)) + # Looks like first call to xlsopen. Check Java support + printf ("Detected XLS interfaces: "); + tmp1 = []; + elseif (isempty (xlsinterfaces.POI) || isempty (xlsinterfaces.JXL) + || isempty (xlsinterfaces.OXS) || isempty (xlsinterfaces.UNO)) + # Can't be first call. Here one of the Java interfaces is requested + if (~tmp1) + # Check Java support again + tmp1 = []; + endif + endif + deflt = 0; + + # Check if MS-Excel COM ActiveX server runs (only on Windows!) + if (isempty (xlsinterfaces.COM)) + xlsinterfaces.COM = 0; + if (ispc) + try + app = actxserver ("Excel.application"); + # If we get here, the call succeeded & COM works. + xlsinterfaces.COM = 1; + # Close Excel. Yep this is inefficient when we need only one r/w action, + # but it quickly pays off when we need to do more with the same file + # (+, MS-Excel code is in OS cache anyway after this call so no big deal) + app.Quit(); + delete(app); + printf ("COM"); + if (deflt), printf ("; "); else, printf ("*; "); deflt = 1; endif + catch + # COM non-existent. Only print message if COM is explicitly requested (tmp1==[]) + if (~isempty (tmp1)) + printf ("ActiveX not working; no Excel installed?\n"); + endif + end_try_catch + endif + endif + + if (isempty (tmp1)) + # Check Java support. First try javaclasspath + try + jcp = javaclasspath ('-all'); # For java pkg > 1.2.7 + if (isempty (jcp)), jcp = javaclasspath; endif # For java pkg < 1.2.8 + # If we get here, at least Java works. Now check for proper version (>= 1.6) + jver = char (java_invoke ('java.lang.System', 'getProperty', 'java.version')); + cjver = strsplit (jver, '.'); + if (sscanf (cjver{2}, '%d') < 6) + warning ("\nJava version might be too old - you need at least Java 6 (v. 1.6.x.x)\n"); + return + endif + # Now check for proper entries in class path. Under *nix the classpath + # must first be split up. In java 1.2.8+ javaclasspath is already a cell array + if (isunix && ~iscell (jcp)); jcp = strsplit (char (jcp), ":"); endif + tmp1 = 1; + catch + # No Java support found + tmp1 = 0; + if (isempty (xlsinterfaces.POI) || isempty (xlsinterfaces.JXL)... + || isempty (xlsinterfaces.OXS) || isempty (xlsinterfaces.UNO)) + # Some or all Java-based interface(s) explicitly requested but no Java support + warning (' No Java support found (no Java JRE? no Java pkg installed AND loaded?'); + endif + # Set Java interfaces to 0 anyway as there's no Java support + xlsinterfaces.POI = 0; + xlsinterfaces.JXL = 0; + xlsinterfaces.OXS = 0; + xlsinterfaces.UNO = 0; + printf ("\n"); + # No more need to try any Java interface + return + end_try_catch + endif + + # Try Java & Apache POI + if (isempty (xlsinterfaces.POI)) + xlsinterfaces.POI = 0; + # Check basic .xls (BIFF8) support + jpchk1 = 0; entries1 = {"poi-3", "poi-ooxml-3"}; + # Only under *nix we might use brute force: e.g., strfind (classname, classpath); + # under Windows we need the following more subtle, platform-independent approach: + for ii=1:length (jcp) + for jj=1:length (entries1) + if (isempty (strfind (tolower (jcp{ii}), entries1{jj}))), ++jpchk1; endif + endfor + endfor + if (jpchk1 > 1) + xlsinterfaces.POI = 1; + printf ("POI"); + endif + # Check OOXML support + jpchk2 = 0; entries2 = {"xbean", "poi-ooxml-schemas", "dom4j"}; + for ii=1:length (jcp) + for jj=1:length (entries2) + if (isempty (strfind (lower (jcp{ii}), entries2{jj}))), ++jpchk2; endif + endfor + endfor + if (jpchk2 > 2), printf (" (& OOXML)"); endif + if (xlsinterfaces.POI) + if (deflt), printf ("; "); else, printf ("*; "); deflt = 1; endif + endif + endif + + # Try Java & JExcelAPI + if (isempty (xlsinterfaces.JXL)) + xlsinterfaces.JXL = 0; + jpchk = 0; entries = {"jxl"}; + for ii=1:length (jcp) + for jj=1:length (entries) + if (isempty (strfind (lower (jcp{ii}), entries{jj}))), ++jpchk; endif + endfor + endfor + if (jpchk > 0) + xlsinterfaces.JXL = 1; + printf ("JXL"); + if (deflt), printf ("; "); else, printf ("*; "); deflt = 1; endif + endif + endif + + # Try Java & OpenXLS + if (isempty (xlsinterfaces.OXS)) + xlsinterfaces.OXS = 0; + jpchk = 0; entries = {"openxls"}; + for ii=1:length (jcp) + for jj=1:length (entries) + if (isempty (strfind (lower (jcp{ii}), entries{jj}))), ++jpchk; endif + endfor + endfor + if (jpchk > 0) + xlsinterfaces.OXS = 1; + printf ("OXS"); + if (deflt), printf ("; "); else, printf ("*; "); deflt = 1; endif + endif + endif + + # Try Java & UNO + if (isempty (xlsinterfaces.UNO)) + xlsinterfaces.UNO = 0; + # entries0(1) = not a jar but a directory (<00o_install_dir/program/>) + jpchk = 0; entries = {'program', 'unoil', 'jurt', 'juh', 'unoloader', 'ridl'}; + for jj=1:numel (entries) + for ii=1:numel (jcp) + jcplst = strsplit (jcp{ii}, filesep); + jcpentry = jcplst {end}; + if (~isempty (strfind (lower (jcpentry), lower (entries{jj})))); ++jpchk; endif + endfor + endfor + if (jpchk >= numel (entries)) + xlsinterfaces.UNO = 1; + printf ('UNO'); + if (deflt), printf ("; "); else, printf ("*; "); deflt = 1; uno_1st_time = min (++uno_1st_time, 2); endif + endif + endif + + # ---- Other interfaces here, similar to the ones above + + if (deflt), printf ("(* = active interface)\n"); endif + + ## FIXME the below stanza should be dropped once UNO is stable. + # Echo a suitable warning about experimental status: + if (uno_1st_time == 1) + ++uno_1st_time; + printf ("\nPLEASE NOTE: UNO (=OpenOffice.org-behind-the-scenes) is EXPERIMENTAL\n"); + printf ("After you've opened a spreadsheet file using the UNO interface,\n"); + printf ("xlsclose on that file will kill ALL OpenOffice.org invocations,\n"); + printf ("also those that were started outside and/or before Octave!\n"); + printf ("Trying to quit Octave w/o invoking xlsclose will only hang Octave.\n\n"); + endif + +endfunction diff --git a/octave_packages/io-1.0.19/xlsread.m b/octave_packages/io-1.0.19/xlsread.m new file mode 100644 index 0000000..e1d105d --- /dev/null +++ b/octave_packages/io-1.0.19/xlsread.m @@ -0,0 +1,222 @@ +## Copyright (C) 2009,2010,2011,2012 by Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{numarr}, @var{txtarr}, @var{rawarr}, @var{limits}] = xlsread (@var{filename}) +## @deftypefnx {Function File} [@var{numarr}, @var{txtarr}, @var{rawarr}, @var{limits}] = xlsread (@var{filename}, @var{wsh}) +## @deftypefnx {Function File} [@var{numarr}, @var{txtarr}, @var{rawarr}, @var{limits}] = xlsread (@var{filename}, @var{range}) +## @deftypefnx {Function File} [@var{numarr}, @var{txtarr}, @var{rawarr}, @var{limits}] = xlsread (@var{filename}, @var{wsh}, @var{range}) +## @deftypefnx {Function File} [@var{numarr}, @var{txtarr}, @var{rawarr}, @var{limits}] = xlsread (@var{filename}, @var{wsh}, @var{range}, @var{reqintf}) +## +## Read data contained in range @var{range} from worksheet @var{wsh} +## in Excel spreadsheet file @var{filename}. +## Return argument @var{numarr} contains the numeric data, optional +## return arguments @var{txtarr} and @var{rawarr} contain text strings +## and the raw spreadsheet cell data, respectively. Return argument +## @var{limits} contains the outer column/row numbers of the read +## spreadsheet range where @var{numarr}, @var{txtarr} and @var{rawarr} +## have come from (remember, xlsread trims outer rows and columns). +## +## If @var{filename} does not contain any directory, the file is +## assumed to be in the current directory. The filename extension +## (.xls or .xlsx) must be included in the file name; when using the +## COM interface all file formats can be read that are supported by the +## locally installed MS-Excel version (e.g., wk1, csv, dbf, etc.). +## +## @var{range} is expected to be a regular spreadsheet range format, +## or "" (empty string, indicating all data in a worksheet). +## If no range is specified the occupied cell range will have to be +## determined behind the scenes first; this can take some time for the +## Java-based interfaces (but the results may be more reliable than +## that of ActiveX/COM). +## +## @var{wsh} is either numerical or text; in the latter case it is +## case-sensitive and it may be max. 31 characters long. +## Note that in case of a numerical @var{wsh} this number refers to the +## position in the worksheet stack, counted from the left in an Excel +## window. The default is numerical 1, i.e. the leftmost worksheet +## in the Excel file. +## +## If only the first argument is specified, xlsread will try to read +## all contents (as if a range of @'' (empty string) was specified) +## from the first = leftmost (or the only) worksheet +## +## If only two arguments are specified, xlsread assumes the second +## argument to be @var{range} if it is a string argument and contains +## a ":" or if it is @'' (empty string), and in those cases assumes +## the data must be read from the first worksheet (not necessarily +## Sheet1! but the leftmost sheet). +## +## However, if only two arguments are specified and the second argument +## is numeric or a text string that does not contain a ":", it is +## assumed to be @var{wsh} and to refer to a worksheet. In that case +## xlsread tries to read all data contained in that worksheet. +## +## The optional last argument @var{reqintf} can be used to override +## the automatic interface selection by xlsread out of the supported +## ones: COM/Excel, Java/Apache POI, Java/JExcelAPI, Java/OpenXLS, or +## Java/UNO (OpenOffice.org) (in that -built in- order of preference). +## For reading from OOXML files a value of 'com', 'poi' or 'uno' must +## be specified for @var{reqintf} (see help for xlsopen); for Excel'95 +## files use 'com', or if Excel is not installed use 'jxl', 'basic' +## or 'uno' (POI can't read Excel 95 but will try to fall back to JXL). +## As @var{reqintf} can also be a cell array of strings, one can +## select or exclude one or more interfaces. +## +## Erroneous data and empty cells are set to NaN in @var{numarr} and +## turn up empty in @var{txtarr} and @var{rawarr}. Date/time values in +## Excel are returned as numerical values in @var{numarr}. Note that +## Excel and Octave have different date base values (1/1/1900 & +## 1/1/0000, resp.). Spreadsheet date values lying before 1/1/1900 are +## returned as strings, formatted as they appear in the spreadsheet. +## @var{numarr} and @var{txtarr} are trimmed from empty outer rows +## and columns. Be aware that Excel does the same for @var{rawarr}, +## so any returned array may turn out to be smaller than requested in +## @var{range}. +## +## When reading from merged cells, all array elements NOT corresponding +## to the leftmost or upper Excel cell will be treated as if the +## "corresponding" Excel cells are empty. +## +## xlsread is just a wrapper for a collection of scripts that find out +## the interface to be used (COM, Java/POI, Java/JXL Java/OXS, Java/UNO) +## and do the actual reading. For each call to xlsread the interface must +## be started and the Excel file read into memory. When reading multiple +## ranges (in optionally multiple worksheets) a significant speed boost +## can be obtained by invoking those scripts directly as in: +## xlsopen / xls2oct [/ parsecell] / ... / xlsclose +## +## Beware: when using the COM interface, hidden Excel invocations may be +## kept running silently if not closed explicitly. +## +## Examples: +## +## @example +## A = xlsread ('test4.xls', '2nd_sheet', 'C3:AB40'); +## (which returns the numeric contents in range C3:AB40 in worksheet +## '2nd_sheet' from file test4.xls into numeric array A) +## @end example +## +## @example +## [An, Tn, Ra, limits] = xlsread ('Sales2009.xls', 'Third_sheet'); +## (which returns all data in worksheet 'Third_sheet' in file 'Sales2009.xls' +## into array An, the text data into array Tn, the raw cell data into +## cell array Ra and the ranges from where the actual data came in limits) +## @end example +## +## @example +## numarr = xlsread ('Sales2010.xls', 4, [], @{'JXL', 'COM'@}); +## (Read all data from 4th worksheet in file Sales2010.xls using either JXL +## or COM interface (i.e, exclude POI interface). +## @end example +## +## @seealso {xlswrite, xlsopen, xls2oct, xlsclose, xlsfinfo, oct2xls} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-10-16 +## Updates: +## 2009-12-29 bug fixes +## 2010-01-12 added unwind_protect to get rid of stray Excel invocations i.c.o. COM errors +## 2010-05-31 Updated help text (delays i.c.o. empty range due to getusedrange call) +## 2010-08-18 Added check for existence of xls after call to xlsopen to +## '' avoid unneeded error message clutter +## 2010-08-25 Improved help text, esp. sections Excel file types and interfaces +## 2010-10-20 Dropped wiping xls.limits for COM (nowadays COM can return those) +## 2010-10-21 Formally added 'BASIC' option as synonym for 'JXL' +## 2010-11-05 Updated help text +## 2010-11-13 Added some input checks +## 2011-04-11 Return upon empty xls struct from xlsopen() +## 2011-04-17 Suppress xlsopen messages (";" was missing) +## 2011-09-08 Minor code cleanup; included UNO & OXS support in test +## 2012-01-26 Fixed "seealso" help string +## 2012-03-07 Updated texinfo help header + +function [ numarr, txtarr, rawarr, lims ] = xlsread (fn, wsh, datrange, reqintf=[]) + + rstatus = 0; + + if (nargout < 1) + usage ("xlsread: no output argument(s) specified that should receive data"); + endif + if (nargin < 1) + error ("xlsread: no input arguments specified") + numarr = []; txtarr={}; rawarr = {}; + return + elseif (nargin == 1) + wsh = 1; + datrange = ''; + elseif (nargin == 2) + # Find out whether 2nd argument = worksheet or range + if (isnumeric (wsh) || (isempty (findstr (wsh,':')) && ~isempty (wsh))) + # Apparently a worksheet specified + datrange = ''; + else + # Range specified + datrange = wsh; + wsh = 1; + endif + endif + + # A small gesture for Matlab compatibility. JExcelAPI supports BIFF5. + if (~isempty (reqintf) && ischar (reqintf) && strcmpi (reqintf, 'BASIC')) + reqintf= {"JXL"} ; + printf ("(BASIC (BIFF5) support request translated to JXL.) \n"); + endif + + # Checks done. Get raw data into cell array "rawarr". xlsopen finds out + # what interface to use. If none found, just return as xlsopen will complain enough + + unwind_protect # Needed to catch COM errors & able to close stray Excel invocations + # Get pointer array to Excel file + xls_ok = 0; + xls = xlsopen (fn, 0, reqintf); + if (~isempty (xls)) + xls_ok = 1; + else + return + endif + +# if (strcmp (xls.xtype, 'COM') || strcmp (xls.xtype, 'POI') || strcmp (xls.xtype, 'JXL')... +# || strcmp (xls.xtype, 'OXS') || strcmp (xls.xtype, 'UNO')) + + # Get data from Excel file & return handle + [rawarr, xls, rstatus] = xls2oct (xls, wsh, datrange); + + # Save some results before xls is wiped + rawlimits = xls.limits; + xtype = xls.xtype; + + if (rstatus) + [numarr, txtarr, lims] = parsecell (rawarr, rawlimits); + else + rawarr = {}; numarr = []; txtarr = {}; + endif + +# else +# printf ("Error XLSREAD: reading EXCEL file (BIFF- or OOXML Format) isn\'t supported on this system.\n"); +# printf ("You need to convert the file into a tab- or comma delimited text file or .csv file\n"); +# printf ("and then invoke csvread(), dlmread() or textread()\n\n"); +# +# endif + + unwind_protect_cleanup + # Close Excel file + if (xls_ok) xls = xlsclose (xls); endif + + end_unwind_protect + +endfunction diff --git a/octave_packages/io-1.0.19/xlswrite.m b/octave_packages/io-1.0.19/xlswrite.m new file mode 100644 index 0000000..2100ba2 --- /dev/null +++ b/octave_packages/io-1.0.19/xlswrite.m @@ -0,0 +1,178 @@ +## Copyright (C) 2009,2010,2011,2012 Philip Nienhuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{rstatus} = xlswrite (@var{filename}, @var{arr}) +## @deftypefnx {Function File} @var{rstatus} = xlswrite (@var{filename}, @var{arr}, @var{wsh}) +## @deftypefnx {Function File} @var{rstatus} = xlswrite (@var{filename}, @var{arr}, @var{wsh}, @var{range}) +## @deftypefnx {Function File} @var{rstatus} = xlswrite (@var{filename}, @var{arr}, @var{wsh}, @var{range}, @var{reqintf}) +## Add data in 1D/2D array @var{arr} to worksheet @var{wsh} in Excel +## spreadsheet file @var{filename} in cell range @var{range}. +## +## @var{rstatus} returns 1 if write succeeded, 0 otherwise. +## +## @var{filename} must be a valid .xls Excel file name (including file +## name extension). If @var{filename} does not contain any directory path, +## the file is saved in the current directory. +## +## @var{arr} can be any 1D or 2D array containing numerical or character +## data (cellstr) except complex. Mixed numeric/text arrays can only be +## cell arrays. +## +## If only 3 arguments are given, the 3rd is assumed to be a spreadsheet +## range if it contains a ":" or is a completely empty string (corresponding +## to A1:IV65336 for regular .xls or A1:XFD1048576 for OOXML .xlsx). The +## 3rd argument is assumed to refer to a worksheet if it is a numeric value +## or a non-empty text string not containing ":" +## +## @var{wsh} can be a number or string (max. 31 chars). +## In case of a not yet existing Excel file, the first worksheet will be +## used & named according to @var{wsh} - the extra worksheets that Excel +## normally creates by default are deleted. +## In case of existing files, some checks are made for existing worksheet +## names or numbers, or whether @var{wsh} refers to an existing sheet with +## a type other than worksheet (e.g., chart). +## When new worksheets are to be added to the Excel file, they are +## inserted to the right of all existing worksheets. The pointer to the +## "active" sheet (shown when Excel opens the file) remains untouched. +## +## @var{range} is expected to be a regular spreadsheet range. +## Data is added to the worksheet; existing data in the requested +## range will be overwritten. +## Array @var{arr} will be clipped at the right and/or bottom if its size +## is bigger than can be accommodated in @var{range}. +## If @var{arr} is smaller than the @var{range} allows, it is placed +## in the top left rectangle of @var{range} and remaining cell values +## outside the rectangle will be retained. +## +## If @var{range} contains merged cells, only the elements of @var{arr} +## corresponding to the top or left Excel cells of those merged cells +## will be written, other array cells corresponding to that cell will be +## ignored. +## +## The optional last argument @var{reqintf} can be used to override +## the automatic selection by xlswrite of one interface out of the +## supported ones: 'com' (ActiveX/Excel), 'poi' (Java/Apache POI), 'jxl' +## (Java/JExcelAPI), or 'uno' (Java/OpenOffice.org). 'oxs' (Java/OpenXLS) +## is implemented but disabled for writing as it is too buggy. For +## writing to OOXML files (.xlsx) a value of 'com', 'poi' or 'uno' must +## be specified for @var{reqintf}. The value of @var{reqintf} is +## case-insensitive. Multiple interfaces can be selected if entered as +## a cell array of strings. +## +## xlswrite is a mere wrapper for various scripts which find out what +## Excel interface to use (COM, POI, etc) plus code to mimic the other +## brand's syntax. For each call to xlswrite such an interface must be +## started and possibly an Excel file loaded. When writing to multiple +## ranges and/or worksheets in the same Excel file, a speed bonus can be +## obtained by invoking those scripts directly with multiple calls to +## oct2xls (one for each sheet or range) surrounded by one call to +## xlsopen and xlsclose: +## (xlsopen / octxls / oct2xls / .... / xlsclose) +## +## Examples: +## +## @example +## status = xlswrite ('test4.xls', 'arr', 'Third_sheet', 'C3:AB40'); +## (which adds the contents of array arr (any type) to range C3:AB40 +## in worksheet 'Third_sheet' in file test4.xls and returns a logical +## True (= numerical 1) in status if al went well) +## @end example +## +## @seealso {xlsread, oct2xls, xls2oct, xlsopen, xlsclose, xlsfinfo} +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2009-10-16 +## Updates: +## 2010-01-04 (Adapted range capacity checks to OOXML) +## 2010-01-12 (Bug fix; added unwind_protect to xlsopen...xlsclose calls) +## 2010-01-15 Fixed typos in texinfo +## 2010-08-18 Added check for existence of xls after call to xlsopen to +## avoid unneeded error message clutter +## 2010-10-27 Changed range -> crange to unhide other range functions +## 2011-09-08 Minor code syntax updates +## 2012-01-26 Fixed "seealso" help string +## 2012-06-07 Replaced all tabs by double space + +function [ rstatus ] = xlswrite (filename, arr, arg3, arg4, arg5) + + rstatus = 0; + + # Sanity checks + if (nargin < 2) + usage ("Insufficient arguments - see 'help xlswrite'"); + elseif (~ischar (filename)) + error ("First argument must be a filename (incl. suffix)"); + elseif (nargin == 2) + # Assume first worksheet and full worksheet starting at A1 + wsh = 1; + if (strcmp (tolower (filename(end-4:end-1)), 'xls')) + crange = "A1:XFD1048576"; # OOXML has ridiculously large limits + else + crange = "A1:IV65536"; # Regular xls limits + endif + elseif (nargin == 3) + # Find out whether 3rd argument = worksheet or range + if (isnumeric (arg3) || (isempty (findstr (arg3, ':')) && ~isempty (arg3))) + # Apparently a worksheet specified + wsh = arg3; + if (strcmp (tolower (filename(end-4:end-1)), 'xls')) + crange = "A1:XFD1048576"; # OOXML has ridiculously large limits + else + crange = "A1:IV65536"; # Regular xls limits + endif + else + # Range specified + wsh = 1; + crange = arg3; + endif + elseif (nargin >= 4) + wsh = arg3; + crange = arg4; + endif + if (nargin == 5) + reqintf = arg5; + else + reqintf = []; + endif + + # Parse range + [topleft, nrows, ncols, trow, lcol] = parse_sp_range (crange); + + # Check if arr fits in range + [nr, nc] = size (arr); + if ((nr > nrows) || (nc > ncols)) + # Array too big; truncate + nr = min (nrows, nr); + nc = min (ncols, nc); + warning ("xlswrite - array truncated to %d by %d to fit in range %s", ... + nrows, ncols, crange); + endif + + unwind_protect # Needed to be sure Excel can be closed i.c.o. errors + xls_ok = 0; + xls = xlsopen (filename, 1, reqintf); + xls_ok = 1; + + [xls, rstatus] = oct2xls (arr(1:nr, 1:nc), xls, wsh, topleft); + + unwind_protect_cleanup + if (xls_ok), xls = xlsclose (xls); endif + + end_unwind_protect + +endfunction diff --git a/octave_packages/io-1.0.19/xmlwrite.m b/octave_packages/io-1.0.19/xmlwrite.m new file mode 100644 index 0000000..a29b030 --- /dev/null +++ b/octave_packages/io-1.0.19/xmlwrite.m @@ -0,0 +1,201 @@ +## Copyright (C) 2004 Laurent Mazet +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{nb} =} xmlwrite (@var{filename}, @var{value}) +## @deftypefnx {Function File} {@var{nb} =} xmlwrite (@var{fd}, @var{value}, [@var{name}]) +## +## Write a @var{value} into @var{filename} (@var{fd}) as an XML file. +## +##The number of elements (@var{nb}) or 0 is returned. +## @end deftypefn + +function nb = xmlwrite (filename, value, name) + persistent indent = ""; + persistent separator = "\n"; + + ## Check argument number + nb = 0; + if (nargin < 2) || (nargin > 3) + print_usage; + endif + + ## Get the file identificator + isopen = false; + if ischar(filename) + + ## Check file name + sn = char (strsplit (filename, ".")); + if !strcmp(tolower(deblank(sn(end,:))), "xml") + filename = [filename, ".xml"]; + endif + + ## Open file + fd = fopen (filename, "w"); + if fd <= 0 + error("xmlwrite: error opening file \"%s\"\n", filename); + endif + + ## XML header + fprintf (fd, "\n"); + fprintf (fd, "\n"); + fprintf (fd, "\n"); + indent = " "; + else + isopen = true; + fd = filename; + endif + + ## Store name in optional argument + opt = ""; + if nargin == 3 + opt = sprintf(" name=\"%s\"", name); + endif + + ## Process by type + + if ischar(value) && (rows(value) <= 1) + ## String type + + fprintf (fd, "%s%s%s", + indent, opt, length(value), value, separator); + + elseif ischar(value) + ## String array type + + fprintf (fd, "%s\n", indent, opt, rows(value)); + _indent = indent; indent = [indent, " "]; + for k=1:rows(value), + nb += xmlwrite (fd, deblank(value(k, :))); + endfor + indent = _indent; + fprintf (fd, "%s\n", indent); + + elseif isscalar(value) + ## Scalar type + + if iscomplex(value) + ## Complex type + + fprintf (fd, "%s", indent, opt); + _indent = indent; indent = ""; _separator = separator; separator = ""; + nb += xmlwrite (fd, real(value)); + nb += xmlwrite (fd, imag(value)); + indent = _indent; separator = _separator; + fprintf (fd, "%s", separator); + + elseif isbool(value) + ## Boolean type + + if value + fprintf (fd, "%s%s", indent, opt, separator); + else + fprintf (fd, "%s%s", indent, opt, separator); + endif + + elseif isinf(value) + ## Infinite type + + if value > 0 + fprintf (fd, "%s%s", + indent, opt, separator); + else + fprintf (fd, "%s%s", + indent, opt, separator); + endif + + elseif isnan(value) + ## Not-A-Number type + + fprintf (fd, "%s%s", indent, opt, separator); + + elseif isna(value) + ## Not-Avaliable + + fprintf (fd, "%s%s", indent, opt, separator); + + else + sc = sprintf(sprintf("%%.%dg", save_precision), value); + fprintf (fd, "%s%s%s", indent, opt, sc, ... + separator); + endif + + elseif ismatrix(value) && isnumeric(value) && (length(size(value)) <= 2) + ## Matrix type + + fprintf (fd, "%s\n", + indent, opt, rows(value), columns(value)); + _indent = indent; indent = ""; separator = ""; + for k=1:rows(value), + fprintf (fd, "%s ", _indent); + for l=1:columns(value)-1, + nb += xmlwrite (fd, value(k, l)); + fprintf (fd, " "); + endfor + nb += xmlwrite (fd, value(k, end)); + fprintf (fd, "\n"); + endfor + indent = _indent; separator = "\n"; + fprintf (fd, "%s\n", indent); + + elseif isstruct(value) + ## Structure type + + st = fieldnames(value); + fprintf (fd, "%s\n", indent, opt); + _indent = indent; indent = [indent, " "]; + for k=1:length(st), + eval(sprintf("nb += xmlwrite (fd, value.%s, \"%s\");", st{k}, st{k})); + endfor + indent = _indent; + fprintf (fd, "%s\n", indent); + + elseif iscell(value) + ## Cell type + + fprintf (fd, "%s\n", + indent, opt, rows(value), columns(value)); + _indent = indent; indent = [indent, " "]; + for k=1:rows(value), + for l=1:columns(value), + nb += xmlwrite (fd, value{k, l}); + endfor + endfor + indent = _indent; + fprintf (fd, "%s\n", indent); + + elseif islist(value) + ## List type + + fprintf (fd, "%s\n", indent, opt, length(value)); + _indent = indent; indent = [indent, " "]; + for k=1:length(value), + nb += xmlwrite (fd, value{k}); + endfor + indent = _indent; + fprintf (fd, "%s\n", indent); + + else + ## Unknown type + error("xmlwrite: unknown type\n"); + endif + nb++; + + if !isopen + fprintf (fd, "\n"); + fclose(fd); + endif + +endfunction diff --git a/octave_packages/java-1.2.8/__java__.h b/octave_packages/java-1.2.8/__java__.h new file mode 100644 index 0000000..5989731 --- /dev/null +++ b/octave_packages/java-1.2.8/__java__.h @@ -0,0 +1,272 @@ +/* Copyright (C) 2007 Michael Goffioul +** +** 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 . +*/ + +#ifndef __JAVA__H__ +#define __JAVA__H__ + +#include +#include +#ifndef OCTAVE_EXPORT +#include +#endif // OCTAVE_EXPORT +#include + +#ifdef JAVAPKG_BUILD +# define JAVAPKG_API OCTAVE_EXPORT +#else +# define JAVAPKG_API OCTAVE_IMPORT +#endif + +template +class java_local_ref +{ +public: + java_local_ref (JNIEnv *_env) + : jobj (0), detached (false), env (_env) + { } + + java_local_ref (JNIEnv *_env, T obj) + : jobj (obj), detached (false), env (_env) + { } + + ~java_local_ref (void) + { + release (); + } + + T& operator= (T obj) + { + release (); + jobj = obj; + detached = false; + return jobj; + } + operator bool () const { return (jobj != 0); } + operator T () { return jobj; } + + void detach () { detached = true; } + +private: + void release (void) + { + if (env && jobj && ! detached) + env->DeleteLocalRef (jobj); + jobj = 0; + } + + java_local_ref (void) + : jobj (0), detached (false), env (0) + { } + + +protected: + T jobj; + bool detached; + JNIEnv *env; +}; + +typedef java_local_ref jobject_ref; +typedef java_local_ref jclass_ref; +typedef java_local_ref jstring_ref; +typedef java_local_ref jobjectArray_ref; +typedef java_local_ref jintArray_ref; +typedef java_local_ref jbyteArray_ref; +typedef java_local_ref jdoubleArray_ref; +typedef java_local_ref jthrowable_ref; + +extern JAVAPKG_API std::string jstring_to_string (JNIEnv* jni_env, jstring s); +extern JAVAPKG_API std::string jstring_to_string (JNIEnv* jni_env, jobject obj); +extern JAVAPKG_API octave_value box (JNIEnv* jni_env, jobject jobj, jclass jcls = 0); +extern JAVAPKG_API octave_value box_more (JNIEnv* jni_env, jobject jobj, jclass jcls = 0); +extern JAVAPKG_API int unbox (JNIEnv* jni_env, const octave_value& val, jobject_ref& jobj, jclass_ref& jcls); +extern JAVAPKG_API int unbox (JNIEnv* jni_env, const octave_value_list& args, jobjectArray_ref& jobjs, jobjectArray_ref& jclss); + +extern JAVAPKG_API bool Vjava_convert_matrix; +extern JAVAPKG_API bool Vjava_unsigned_conversion; +extern JAVAPKG_API bool Vjava_debug; + +class JAVAPKG_API octave_java : public octave_base_value +{ +public: + octave_java (void) + : java_object (0), java_class (0) + { } + + octave_java (const octave_java& jobj) + : java_object (0), java_class (0) + { + init (jobj.java_object, jobj.java_class); + } + + octave_java (jobject obj, jclass cls = 0) + : java_object (0) + { + init (obj, cls); + } + + ~octave_java (void) + { + release (); + } + + jobject to_java () const { return java_object; } + jclass to_class () const { return java_class; } + std::string java_class_name () const { return java_type; } + + octave_base_value* clone(void) const { return new octave_java(*this); } + octave_base_value* empty_clone(void) const { return new octave_java(); } + + bool is_defined(void) const { return true; } + + bool is_map (void) const { return true; } + + string_vector map_keys(void) const; + + dim_vector dims(void) const; + + void print(std::ostream& os, bool pr_as_read_syntax = false) const + { + os << ""; + newline(os); + } + + void print_raw(std::ostream& os, bool pr_as_read_syntax = false) const + { + print(os, pr_as_read_syntax); + } + + octave_value_list subsref (const std::string& type, const std::list& idx, int nargout); + + octave_value subsref (const std::string& type, + const std::list& idx) + { + octave_value_list retval = subsref (type, idx, 1); + return (retval.length () > 0 ? retval(0) : octave_value ()); + } + + octave_value subsasgn (const std::string& type, const std::list& idx, const octave_value& rhs); + + octave_value convert_to_str_internal (bool pad, bool force, char type) const; + + bool is_string (void) const + { + JNIEnv *current_env = thread_jni_env (); + + if (current_env && java_object) + { + jclass_ref cls (current_env, current_env->FindClass ("java/lang/String")); + return current_env->IsInstanceOf (java_object, cls); + } + return false; + } + + static JNIEnv* thread_jni_env (void); + + octave_value do_java_invoke (JNIEnv* jni_env, const std::string& name, + const octave_value_list& args); + + octave_value do_java_invoke (const std::string& name, const octave_value_list& args) + { return do_java_invoke(thread_jni_env (), name, args); } + + static octave_value do_java_invoke (JNIEnv* jni_env, const std::string& class_name, + const std::string& name, const octave_value_list& args); + + static octave_value do_java_invoke (const std::string& class_name, + const std::string& name, const octave_value_list& args) + { return do_java_invoke(thread_jni_env (), class_name, name, args); } + + static octave_value do_java_create (JNIEnv* jni_env, const std::string& name, + const octave_value_list& args); + + static octave_value do_java_create (const std::string& name, const octave_value_list& args) + { return do_java_create (thread_jni_env (), name, args); } + + octave_value do_java_get (JNIEnv* jni_env, const std::string& name); + + octave_value do_java_get (const std::string& name) + { return do_java_get (thread_jni_env (), name); } + + static octave_value do_java_get (JNIEnv* jni_env, const std::string& class_name, + const std::string& name); + + static octave_value do_java_get (const std::string& class_name, const std::string& name) + { return do_java_get (thread_jni_env (), class_name, name); } + + octave_value do_java_set (JNIEnv* jni_env, const std::string& name, const octave_value& val); + + octave_value do_java_set (const std::string& name, const octave_value& val) + { return do_java_set (thread_jni_env (), name, val); } + + static octave_value do_java_set (JNIEnv* jni_env, const std::string& class_name, + const std::string& name, const octave_value& val); + + static octave_value do_java_set (const std::string& class_name, const std::string& name, + const octave_value& val) + { return do_java_set (thread_jni_env (), class_name, name, val); } + +private: + void init (jobject jobj, jclass jcls) + { + JNIEnv *current_env = thread_jni_env (); + + if (current_env) + { + if (jobj) + java_object = current_env->NewGlobalRef (jobj); + if (jcls) + java_class = reinterpret_cast (current_env->NewGlobalRef (jcls)); + else if (java_object) + { + jclass_ref ocls (current_env, current_env->GetObjectClass (java_object)); + java_class = reinterpret_cast (current_env->NewGlobalRef (jclass (ocls))); + } + + if (java_class) + { + jclass_ref clsCls (current_env, current_env->GetObjectClass (java_class)); + jmethodID mID = current_env->GetMethodID (clsCls, "getCanonicalName", "()Ljava/lang/String;"); + jobject_ref resObj (current_env, current_env->CallObjectMethod (java_class, mID)); + java_type = jstring_to_string (current_env, resObj); + } + } + } + + void release () + { + JNIEnv *current_env = thread_jni_env (); + + if (current_env) + { + if (java_object) + current_env->DeleteGlobalRef (java_object); + if (java_class) + current_env->DeleteGlobalRef (java_class); + java_object = 0; + java_class = 0; + } + } + +private: + DECLARE_OCTAVE_ALLOCATOR + + DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA + + jobject java_object; + jclass java_class; + std::string java_type; +}; + +#endif /* __JAVA__H__ */ diff --git a/octave_packages/java-1.2.8/dlgtest.m b/octave_packages/java-1.2.8/dlgtest.m new file mode 100644 index 0000000..c3692bb --- /dev/null +++ b/octave_packages/java-1.2.8/dlgtest.m @@ -0,0 +1,255 @@ +% +% Install the java package. +% Test the dlg... functions of the java package. +% +% Author: Martin Hepperle +% Version August 2010 +% +function dlgtest ( reinstall ) + + % Windows example paths + if ispc() + % NOTE: do NOT use backslashes as separator, only forward slashes! + pkgpath = 'z:/java-1.2.8.tar.gz'; + java_home = getenv ("JAVA_HOME"); + elseif isunix() + % Linux example paths + pkgpath = '~/java-1.2.8.tar.gz'; + java_home = getenv ("JAVA_HOME"); + else + pkgpath = 'unknown'; + java_home = 'unknown'; + end + + if nargin<1 + disp('usage: dlgtest ( reinstall )'); + disp( 'where: reinstall = 0 : do not reinstall java package'); + disp([' reinstall = 1 : reinstall java package from ', pkgpath, ... + ', using Java JDK from ', java_home]); + return + end + + if ! exist (java_home, "dir") + disp(['Java JDK home directory ', java_home,' does not exist.']); + disp('Please adapt java_home in dlgtest.m.'); + return; + end + + if reinstall == 1 + if ! exist (pkgpath, "file") + disp(['Package file ', pkgpath, ' does not exist.']); + disp('Please adapt pkgpath in dlgtest.m.'); + return; + end + end + + page_screen_output(0); + + if reinstall == 1 + disp('- uninstalling package java'); + pkg uninstall java + + disp(['- installing package java from ',pkgpath]); + disp([' using JDK from ',java_home]); + setenv('JAVA_HOME',java_home) + %% pkg does not understand variables as arguments? + eval(['pkg install ', pkgpath]) + disp('Done.'); + end + + page_screen_output(1); + + answer = 1; + while (answer > 0 ) + + disp(''); + disp('0 ... STOP'); + disp('1 ... listdlg tests'); + disp('2 ... errordlg tests'); + disp('3 ... warndlg tests'); + disp('4 ... helpdlg tests'); + disp('5 ... inputdlg tests'); + disp('6 ... TeX code tests'); + + answer = str2num(input ('Run which test? [0] > ','s')); + + disp(''); + + switch answer + case 1 + test_listdlg(); + case 2 + test_errordlg(); + case 3 + test_warndlg(); + case 4 + test_helpdlg(); + case 5 + test_inputdlg(); + case 6 + test_TeXCodes(); + end + end + + % d = javaObject('javax.swing.JDialog'); + % cp = d.getContentPane; + % b = javaObject('javax.swing.JButton','OK'); + % cp.add(b); + % d.pack; + % d.setVisible(true); + + + page_screen_output(1); + +end + +function test_listdlg + + %----------------------------------------------- + disp('- test listdlg with selectionmode single. No caption, no prompt.'); + itemlist = {'An item \\alpha', 'another', 'yet another'}; + s = listdlg ( 'ListString',itemlist, 'SelectionMode','Single' ); + imax = length(s); + for i=1:1:imax + disp(['Selected: ',num2str(i),': ', itemlist{s(i)}]); + end + + %----------------------------------------------- + disp('- test listdlg with selectionmode and preselection. Has caption and two lines prompt.'); + s = listdlg ( 'ListString',itemlist, ... + 'SelectionMode','Multiple', ... + 'Name','Selection Dialog', ... + 'InitialValue',[1,2,3,4], + 'PromptString',{'Select an item...', '...or multiple items'} ); + imax = length(s); + for i=1:1:imax + disp(['Selected: ',num2str(i),': ', itemlist{s(i)}]); + end + +end + +function test_errordlg + %----------------------------------------------- + disp('- test errordlg with prompt only.'); + errordlg('Oops, an expected error occured'); + %----------------------------------------------- + disp('- test errordlg with prompt and caption.'); + errordlg('Oops another error','This is a very long and informative caption'); +end + +function test_warndlg + %----------------------------------------------- + disp('- test warndlg with prompt only.'); + warndlg('Oh, a warning occured'); + %----------------------------------------------- + disp('- test warndlg with prompt and caption.'); + warndlg('Oh, No...','This is the last Warning'); +end + +function test_helpdlg + %----------------------------------------------- + disp('- test helpdlg with a help message only.'); + helpdlg("Below, you should see 3 lines:\nline #1\nline #2, and\nline #3."); + %----------------------------------------------- + disp('- test helpdlg with help message and caption.'); + helpdlg('You should see a single line.','A help dialog'); +end + +function test_inputdlg + %----------------------------------------------- + disp('- test inputdlg with prompt and caption only.'); + prompt = {'Width','Height','Depth'}; + dims = inputdlg ( prompt, 'Enter Box Dimensions' ); + if isempty(dims) + helpdlg('Canceled by user', 'Information'); + else + volume = str2num(dims{1}) * str2num(dims{2}) * str2num(dims{3}); + surface = 2 * (str2num(dims{1}) * str2num(dims{2}) + ... + str2num(dims{2}) * str2num(dims{3}) + ... + str2num(dims{1}) * str2num(dims{3})); + helpdlg(sprintf('Results:\nVolume = %.3f\nSurface = %.3f', volume, surface), 'Box Dimensions'); + end + + %----------------------------------------------- + disp('- test inputdlg with prescribed scalar (2 lines per text field) and defaults.'); + prompt = {'Width','Height','Depth'}; + default = {'1.1','2.2','3.3'}; + rc = 2; + dims = inputdlg ( prompt, 'Enter Box Dimensions',rc,default ); + if isempty(dims) + helpdlg('Canceled by user', 'Information'); + else + volume = str2num(dims{1}) * str2num(dims{2}) * str2num(dims{3}); + surface = 2 * (str2num(dims{1}) * str2num(dims{2}) + ... + str2num(dims{2}) * str2num(dims{3}) + ... + str2num(dims{1}) * str2num(dims{3})); + helpdlg(sprintf('Results:\nVolume = %.3f\nSurface = %.3f', volume, surface), 'Box Dimensions'); + end + %----------------------------------------------- + disp('- test inputdlg with prescribed vector [1,2,3] for # of lines per text field and defaults.'); + prompt = {'Width','Height','Depth'}; + default = {'1.10', '2.10', '3.10'}; + rc = [1,2,3]; % NOTE: must be an array + dims = inputdlg ( prompt, 'Enter Box Dimensions',rc,default ); + if isempty(dims) + helpdlg('Canceled by user', 'Information'); + else + volume = str2num(dims{1}) * str2num(dims{2}) * str2num(dims{3}); + surface = 2 * (str2num(dims{1}) * str2num(dims{2}) + ... + str2num(dims{2}) * str2num(dims{3}) + ... + str2num(dims{1}) * str2num(dims{3})); + helpdlg(sprintf('Results:\nVolume = %.3f\nSurface = %.3f', volume, surface), 'Box Dimensions'); + end + %----------------------------------------------- + disp('- test inputdlg with prescribed row by column sizes and defaults.'); + prompt = {'Width','Height','Depth'}; + default = {'1.10', '2.20', '3.30'}; + rc = [1,10; 2,20; 3,30]; % NOTE: must be an array + dims = inputdlg ( prompt, 'Enter Box Dimensions',rc,default ); + if isempty(dims) + helpdlg('Canceled by user', 'Information'); + else + volume = str2num(dims{1}) * str2num(dims{2}) * str2num(dims{3}); + surface = 2 * (str2num(dims{1}) * str2num(dims{2}) + ... + str2num(dims{2}) * str2num(dims{3}) + ... + str2num(dims{1}) * str2num(dims{3})); + helpdlg(sprintf('Results:\nVolume = %.3f\nSurface = %.3f', volume, surface), 'Box Dimensions'); + end +end + +%% show a table of TeX symbol codes and the resulting Unicode character +function test_TeXCodes + %----------------------------------------------- + disp('- test TeX code to Unicode translation.'); + + msgbox ( ['\\alpha = ''\alpha '' \\beta = ''\beta '' \\gamma = ''\gamma ''', 10, ... + '\\delta = ''\delta '' \\epsilon = ''\epsilon '' \\zeta = ''\zeta ''', 10, ... + '\\eta = ''\eta '' \\theta = ''\theta '' \\vartheta = ''\vartheta ''', 10, ... + '\\iota = ''\iota '' \\kappa = ''\kappa '' \\lambda = ''\lambda ''', 10, ... + '\\mu = ''\mu '' \\nu = ''\nu '' \\xi = ''\xi ''', 10, ... + '\\pi = ''\pi '' \\rho = ''\rho '' \\sigma = ''\sigma ''', 10, ... + '\\varsigma = ''\varsigma '' \\tau = ''\tau '' \\phi = ''\phi ''', 10, ... + '\\chi = ''\chi '' \\psi = ''\psi '' \\omega = ''\omega ''', 10, ... + '\\upsilon = ''\upsilon '' \\Gamma = ''\Gamma '' \\Delta = ''\Delta ''', 10, ... + '\\Theta = ''\Theta '' \\Lambda = ''\Lambda '' \\Pi = ''\Pi ''', 10, ... + '\\Xi = ''\Xi '' \\Sigma = ''\Sigma '' \\Upsilon = ''\Upsilon ''', 10, ... + '\\Phi = ''\Phi '' \\Psi = ''\Psi '' \\Omega = ''\Omega ''', 10, ... + '\\Im = ''\Im '' \\Re = ''\Re '' \\leq = ''\leq ''', 10, ... + '\\geq = ''\geq '' \\neq = ''\neq '' \\pm = ''\pm ''', 10, ... + '\\infty = ''\infty '' \\partial = ''\partial '' \\approx = ''\approx ''', 10, ... + '\\circ = ''\circ '' \\bullet = ''\bullet '' \\times = ''\times ''', 10, ... + '\\sim = ''\sim '' \\nabla = ''\nabla '' \\ldots = ''\ldots ''', 10, ... + '\\exists = ''\exists '' \\neg = ''\neg '' \\aleph = ''\aleph ''', 10, ... + '\\forall = ''\forall '' \\cong = ''\cong '' \\wp = ''\wp ''', 10, ... + '\\propto = ''\propto '' \\otimes = ''\otimes '' \\oplus = ''\oplus ''', 10, ... + '\\oslash = ''\oslash '' \\cap = ''\cap '' \\cup = ''\cup ''', 10, ... + '\\ni = ''\ni '' \\in = ''\in '' \\div = ''\div ''', 10, ... + '\\equiv = ''\equiv '' \\int = ''\int '' \\perp = ''\perp ''', 10, ... + '\\wedge = ''\wedge '' \\vee = ''\vee '' \\supseteq = ''\supseteq ''', 10, ... + '\\supset = ''\supset '' \\subseteq = ''\subseteq '' \\subset = ''\subset ''', 10, ... + '\\clubsuit = ''\clubsuit '' \\spadesuit = ''\spadesuit '' \\heartsuit = ''\heartsuit ''', 10, ... + '\\diamondsuit = ''\diamondsuit '' \\copyright = ''\copyright '' \\leftarrow = ''\leftarrow ''', 10, ... + '\\uparrow = ''\uparrow '' \\rightarrow = ''\rightarrow '' \\downarrow = ''\downarrow ''', 10, ... + '\\leftrightarrow = ''\leftrightarrow '' \\updownarrow = ''\updownarrow '''], ... + 'TeX symbol code table Test'); +end diff --git a/octave_packages/java-1.2.8/doc-cache b/octave_packages/java-1.2.8/doc-cache new file mode 100644 index 0000000..dae576e --- /dev/null +++ b/octave_packages/java-1.2.8/doc-cache @@ -0,0 +1,624 @@ +# Created by Octave 3.6.2, Sun Jul 22 21:28:07 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 16 +# name: +# type: sq_string +# elements: 1 +# length: 7 +dlgtest + + +# name: +# type: sq_string +# elements: 1 +# length: 124 + + Install the java package. + Test the dlg... functions of the java package. + + Author: Martin Hepperle + Version August 2010 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 + + Install the java package. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +errordlg + + +# name: +# type: sq_string +# elements: 1 +# length: 273 + -- Function file: P = errordlg (MESSAGE [,TITLE]) + Displays the MESSAGE using an error dialog box. The TITLE can be + used optionally to decorate the dialog caption. The return value + is always 1. + + + See also: helpdlg, inputdlg, listdlg, questdlg, warndlg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Displays the MESSAGE using an error dialog box. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +helpdlg + + +# name: +# type: sq_string +# elements: 1 +# length: 353 + -- Function file: P = helpdlg (MESSAGE [,TITLE]) + Displays a MESSAGE in a help dialog box. The help message can + have multiple lines, separated by a newline character '\n'. The + TITLE can be used optionally to decorate the dialog caption. The + return value is always 1. + + + See also: errordlg, inputdlg, listdlg, questdlg, warndlg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +Displays a MESSAGE in a help dialog box. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +inputdlg + + +# name: +# type: sq_string +# elements: 1 +# length: 1168 + -- Function file: P = inputdlg (PROMPT [,TITLE [,ROWSCOLS, DEFAULTS]]) + Returns the user's inputs from a multi-textfield dialog box in + form of a cell array of strings. If the dialog is closed by the + Cancel button, an empty cell array is returned. + + `PROMPT' + The first argument PROMPT is mandatory. It is a cell array + with strings labeling each textfield. + + `TITLE' + The optional string TITLE can be used as the caption of the + dialog. + + `ROWSCOLS' + The size of the text fields can be defined by the argument + ROWSCOLS, which can have three forms: - a scalar value which + defines the number of rows used for each text field. - a + vector which defines the individual number of rows used for + each text field. - a matrix which defines the individual + number of rows and columns used for each text field. + + `DEFAULTS' + It is possible to place default values into the text fields + by supplying the a cell array of strings or number for the + argument DEFAULTS. + + + See also: errordlg, helpdlg, listdlg, questdlg, warndlg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Returns the user's inputs from a multi-textfield dialog box in form of +a cell ar + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +java + + +# name: +# type: sq_string +# elements: 1 +# length: 75 +Please enter `doc java' to view the documentation for the package +`java'. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 +Please enter `doc java' to view the documentation for the package +`java'. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +javaArray + + +# name: +# type: sq_string +# elements: 1 +# length: 551 + -- Function file: A = javaArray (CLASS,[M,N,...]) + -- Function file: A = javaArray (CLASS,M,N,...) + Creates a Java array of size [M,N,...] with elements of class + CLASS. CLASS can be a Java object representing a class or a string + containing the fully qualified class name. + + The generated array is uninitialized, all elements are set to null + if CLASS is a reference type, or to a default value (usually 0) if + CLASS is a primitive type. + + a = javaArray ("java.lang.String", 2, 2); + a(1,1) = "Hello"; + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Creates a Java array of size [M,N,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +javaaddpath + + +# name: +# type: sq_string +# elements: 1 +# length: 253 + -- Function file: javaaddpath (PATH) + Adds PATH to the dynamic class path of the Java virtual machine. + PATH can be either a directory where .class files can be found, or + a .jar file containing Java classes. + + + See also: javaclasspath + + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 +Adds PATH to the dynamic class path of the Java virtual machine. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +javaclasspath + + +# name: +# type: sq_string +# elements: 1 +# length: 1049 + -- Function file: javaclasspath + -- Function file: STATIC = javaclasspath + -- Function file: [STATIC, DYNAMIC] = javaclasspath + -- Function file: PATH = javaclasspath (WHAT) + Returns the class path of the Java virtual machine in the form of + a cell array of strings. + + If called without input parameter: + * If no output variable is given, the result is simply printed + on the standard output. + + * If one output variable STATIC is given, the result is the + static classpath. + + * If two output variables STATIC and DYNAMIC are given, the + first variable will contain the static classpath, the second + will be filled with the dynamic claspath. + + If called with a single input parameter WHAT: + * If WHAT is '-static' the static classpath is returned. + + * If WHAT is '-dynamic' the dynamic classpath is returned. + + * If WHAT is '-all' the static and the dynamic classpath are + returned in a single cell array + + See also: javaaddpath, javarmpath + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Returns the class path of the Java virtual machine in the form of a +cell array o + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +javafields + + +# name: +# type: sq_string +# elements: 1 +# length: 246 + -- Function file: P = javafields (CLASS) + Returns the fields of a Java object in the form of a cell array of + strings. If no output variable is given, the result is simply + printed on the standard output. + + + See also: javamethods + + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 +Returns the fields of a Java object in the form of a cell array of +strings. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +javamem + + +# name: +# type: sq_string +# elements: 1 +# length: 1589 + -- Function File: javamem + -- Function File: [ JMEM] = javamem + Show current memory status of the Java virtual machine (JVM) & run + garbage collector. + + When no return argument is given the info is echoed to the screen. + Otherwise, output cell array JMEM contains Maximum, Total, and + Free memory (in bytes). + + All Java-based routines are run in the JVM's shared memory pool, a + dedicated and separate part of memory claimed by the JVM from your + computer's total memory (which comprises physical RAM and virtual + memory / swap space on hard disk). + + The maximum available memory can be set using the file java.opts + (in the same subdirectory where javaaddpath.m lives, see "which + javaaddpath". Usually that is: + [/usr]/share/octave/packages/java-. + + java.opts is a plain text file, one option per line. The default + initial memory size and default maximum memory size (which are + both system dependent) can be overridden like so: + -Xms64m + -Xmx512m + (in megabytes in this example.) You can adapt these values to + your own requirements if your system has limited available + physical memory or when you get Java memory errors. + + "Total memory" is what the operating system has currently assigned + to the JVM and depends on actual and active memory usage. "Free + memory" is self-explanatory. During operation of Java-based octave + functions the amounts of Total and Free memory will vary, due to + Java's own cleaning up and your operating system's memory + management. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Show current memory status of the Java virtual machine (JVM) & run +garbage colle + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +javamethods + + +# name: +# type: sq_string +# elements: 1 +# length: 244 + -- Function file: P = javamethods (CLASS) + Returns the methods of a Java object in the form of a cell array + of strings. If no output variable is given, the result is simply + printed on the standard output. + + + See also: methods + + + + +# name: +# type: sq_string +# elements: 1 +# length: 76 +Returns the methods of a Java object in the form of a cell array of +strings. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +javarmpath + + +# name: +# type: sq_string +# elements: 1 +# length: 270 + -- Function file: javarmpath (PATH) + Removes PATH from the dynamic class path of the Java virtual + machine. PATH can be either a directory where .class files can be + found, or a .jar file containing Java classes. + + + See also: javaaddpath, javaclasspath + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +Removes PATH from the dynamic class path of the Java virtual machine. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +listdlg + + +# name: +# type: sq_string +# elements: 1 +# length: 1661 + -- Function file: [SEL,OK] = listdlg (KEY ,VALUE [, KEY ,VALUE, ...]]) + Returns the user's inputs from a list dialog box in form of a + vector of selection indices SEL and a flag OK indicating how the + user closed the dialog box. The returned flag OK is 1 if the user + closed the box with the OK button, otherwise it is 0 and SEL is + empty. The indices in SEL are 1 based, i.e. the first list item + carries the index 1. + + The arguments are specified in form of KEY, VALUE pairs. At least + the 'ListString' argument pair must be specified. + + KEYs and VALUEs pairs can be selected from the following list: + + `ListString' + a cell array of strings comprising the content of the list. + + `SelectionMode' + can be either `Single' or `Multiple'. + + `ListSize' + a vector with two elements [width, height] defining the size + of the list field in pixels. + + `InitialValue' + a vector containing 1-based indices of preselected elements. + + `Name' + a string to be used as the dialog caption. + + `PromptString' + a cell array of strings to be displayed above the list field. + + `OKString' + a string used to label the OK button. + + `CancelString' + a string used to label the Cancel button. + + Example: + + [sel, ok] = listdlg ( 'ListString',{'An item', 'another', 'yet another'}, 'SelectionMode','Multiple' ); + if ok == 1 + imax = length(sel); + for i=1:1:imax + disp(sel(i)); + end + end + + + See also: errordlg, helpdlg, inputdlg, questdlg, warndlg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Returns the user's inputs from a list dialog box in form of a vector of +selectio + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +msgbox + + +# name: +# type: sq_string +# elements: 1 +# length: 393 + -- Function file: P = msgbox (MESSAGE [,TITLE [,ICON]]) + Displays the MESSAGE using a message dialog. The TITLE is an + optional string, which can be used to decorate the dialog caption. + The ICON can be used optionally to select a dialog icon. It can + be one of `'error'', `'help'' or `'warn''. The return value is + always 1. + + + See also: helpdlg, questdlg, warndlg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 +Displays the MESSAGE using a message dialog. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +questdlg + + +# name: +# type: sq_string +# elements: 1 +# length: 991 + -- Function file: P = questdlg (MESSAGE, TITLE) + -- Function file: P = questdlg (MESSAGE, TITLE, DEFAULT) + -- Function file: P = questdlg (MESSAGE, TITLE, BTN1, BTN2, DEFAULT) + -- Function file: P = questdlg (MESSAGE, TITLE, BTN1, BTN2, BTN3, + DEFAULT) + Displays the MESSAGE using a question dialog box. The dialog + contains two or three buttons which all close the dialog. It + returns the caption of the activated button. + + The TITLE can be used optionally to decorate the dialog caption. + The string DEFAULT identifies the default button, which is + activated by pressing the ENTER key. It must match one of the + strings given in BTN1, BTN2 or BTN3. + + If only MESSAGE and TITLE are specified, three buttons with the + default captions "Yes", "No", "Cancel" are used. + + If only two button captions BTN1 and BTN2 are specified, the + dialog will have only these two buttons. + + + See also: errordlg, helpdlg, inputdlg, listdlg, warndlg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Displays the MESSAGE using a question dialog box. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +warndlg + + +# name: +# type: sq_string +# elements: 1 +# length: 231 + -- Function file: P = warndlg (MESSAGE [,TITLE]) + Displays the MESSAGE using a warning dialog box. The TITLE can be + used optionally to decorate the dialog caption. + + + See also: helpdlg, inputdlg, listdlg, questiondlg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Displays the MESSAGE using a warning dialog box. + + + + + diff --git a/octave_packages/java-1.2.8/doc.info b/octave_packages/java-1.2.8/doc.info new file mode 100644 index 0000000..fa9eb30 --- /dev/null +++ b/octave_packages/java-1.2.8/doc.info @@ -0,0 +1,1255 @@ +This is octave-java.info, produced by makeinfo version 4.11 from +octave-java.texi. + + + + +File: octave-java.info, Node: Top, Next: javaclasspath, Up: (dir) + +1 Using Octave (and Matlab) with Java +************************************* + + This description is based on the Octave package `java-1.2.8'. The +`java' package usually installs its script files (.m) in the directory +`.../share/Octave/packages/java-1.2.8' and its binary (.oct) files in +`.../libexec/Octave/packages/java-1.2.8'. You can get help on +specific functions in Octave by executing the help command with the +name of a function from this package: + Octave > help javaObject + You can view this help file in Octave by executing the info +command with just the word java: + Octave > doc java + + +Note on calling Octave from Java +================================ + +The `java' package is designed for calling Java from Octave. If you +want to call Octave from Java, you might want to use a library like +`javaOctave' [http://kenai.com/projects/javaOctave] or `joPas' +[http://jopas.sourceforge.net]. + +2 Table of Contents +******************* + + Available Functions + +* Menu: + +* javaclasspath:: get the class path of the JVM +* javaaddpath:: add a path to the class path of the JVM +* javarmpath:: remove a path to the class path of the JVM +* javamem:: get information about available memory +* javaArray:: create a Java array +* javaObject:: create a Java object +* java_new:: create a Java object +* javaMethod:: invoke a method on the Java object +* java_invoke:: invoke a method on the Java object +* java_get:: get a field on the Java object +* java_set:: set a field on the Java object +* javamethods:: list the available methods of a Java objects +* javafields:: list the available fields of a Java objects +* msgbox:: display a dialog box +* errordlg:: display a dialog with an error symbol +* listdlg:: display a dialog with a selection list +* warndlg:: display a dialog with a warning symbol +* helpdlg:: display a dialog with a help symbol +* inputdlg:: display a dialog with edit fields +* questdlg:: display a dialog with a question icon + + Frequently Asked Questions + +* Menu: + +* How to distinguish between Octave and Matlab?:: +* How to make Java classes available?:: +* How to create an instance of a Java class?:: +* How can I handle memory limitations?:: +* How to compile the java package in Octave?:: +* Which TeX symbols are implemented in the dialog functions?:: + + +3 Available Functions +********************* + + +File: octave-java.info, Node: javaclasspath, Next: javaaddpath, Prev: Top, Up: Top + + + +3.1 javaclasspath +================= + + + + -- Function file: javaclasspath + -- Function file: STATIC = javaclasspath + -- Function file: [STATIC, DYNAMIC] = javaclasspath + -- Function file: PATH = javaclasspath (WHAT) + Return the class path of the Java virtual machine as a cell + array of strings. If called without an input parameter: + * If no output variable is given, the result is simply printed + to the standard output. + + * If one output variable STATIC is given, the result is the + static classpath. + + * If two output variables STATIC and DYNAMIC are given, the + first variable will contain the static classpath, the + second will be filled with the dynamic claspath. + If called with a single input parameter WHAT: + If no output parameter is given: + + * The result is printed to the standard output similar to the + call without input parameter. + If the output parameter PATH is used: + + * If WHAT is '-static' the static classpath is returned. + + * If WHAT is '-dynamic' the dynamic classpath is returned. + + * If WHAT is '-all' the static and the dynamic classpath are + returned in a single cell array. + For the example two entries have been added to the static + classpath using the file `classpath.txt'. Example: + Octave > javaclasspath('-all') + STATIC JAVA PATH + + z:/someclasses.jar + z:/classdir/classfiles + + DYNAMIC JAVA PATH + - empty - + + Octave > javaaddpath('z:/dynamic'); + Octave > ps = javaclasspath('-all') + ps = + { + [1,1] = z:/someclasses.jar + [1,2] = z:/classdir/classfiles + [1,3] = z:/dynamic + } + + + *See also:* *note javaaddpath: doc-javaaddpath, *note + javarmpath: doc-javarmpath, *note How to make Java + classes available to Octave?: doc-FAQ. + + + +File: octave-java.info, Node: javaaddpath, Next: javarmpath, Prev: javaclasspath, Up: Top + +3.2 javaaddpath +=============== + + + + -- Function File: javaaddpath (PATH) + Add PATH to the dynamic class path of the Java virtual machine. + PATH can be either a directory where .class files can be found, or + a .jar file containing Java classes. In both cases the directory + or file must exist. Example: This example adds a Java + archive and a directory containing .CLASS files to the CLASSPATH + and displays the current CLASSPATH list. + Octave > javaaddpath('C:/java/myclasses.jar'); + Octave > javaaddpath('C:/java/classes'); + Octave > javaclasspath; + ans = + { + [1,1] = C:\java\myclasses.jar + [1,2] = C:\java\classes + } + + *See also:* *note javaclasspath: doc-javaclasspath, *note + javarmpath: doc-javarmpath, *note How to make Java + classes available to Octave?: doc-FAQ. + + + +File: octave-java.info, Node: javarmpath, Next: javamem, Prev: javaaddpath, Up: Top + +3.3 javarmpath +============== + + + + -- Function File: javarmpath (PATH) + Remove PATH from the dynamic class path of the Java virtual + machine. PATH can be either a directory where .class files can be + found, or a .jar file containing Java classes. Example: This + example removes one of the directories added in the example for + the `javaaddpath' function. + Octave > javarmpath('C:/java/classes'); + Octave > javaclasspath + { + [1,1] = C:\java\myclasses.jar + } + + + *See also:* *note javaaddpath: doc-javaaddpath, *note + javaclasspath: doc-javaclasspath, *note How to make + Java classes available to Octave?: doc-FAQ. + + + +File: octave-java.info, Node: javamem, Next: javaArray, Prev: javarmpath, Up: Top + +3.4 javamem +=========== + + + + -- Function File: javamem + -- Function File: [JMEM] = javamem + Show current memory status of the java virtual machine (JVM) + & run garbage collector. When no return argument is given the + info is echoed to the screen. Otherwise, cell array JMEM + contains MAXIMUM, TOTAL, and FREE memory (in bytes). All + java-based routines are run in the JVM's shared memory pool, a + dedicated and separate part of memory claimed by the JVM from + your computer's total memory (which comprises physical RAM and + virtual memory / swap space on hard disk). The maximum + available memory can be set using the file `java.opts' (in the + same subdirectory where `javaaddpath.m' lives, see `which + javaaddpath'. Usually that is: + [/usr]/share/Octave/packages/java-1.2.8. `java.opts' is a + plain text file. It can contain memory related options, + starting with `-X'. In the following exmaple, the first line + specifies the initial memory size in megabytes, the second line + specifies the requested maximum size: + -Xms64m + -Xmx512m + You can adapt these values if your system has limited available + physical memory. When no `java.opts' file is present, the default + assignments are depending on system hardware and Java version. + Typically these are an initial memory size of RAM/64 and a + maximum memory size of MIN(RAM/4, 1GB), where RAM is the amount + of installed memory. In the output of javamem TOTAL MEMORY is + what the operating system has currently assigned to the JVM and + depends on actual and active memory usage. FREE MEMORY is + self-explanatory. During operation of java-based Octave + functions the amounts of Total and Free memory will vary, due to + java's own cleaning up and your operating system's memory + management. Example: + Octave > javamem + Java virtual machine (JVM) memory info: + Maximum available memory: 247 MB; + (...running garbage collector...) + OK, current status: + Total memory in virtual machine: 15 MB; + Free memory in virtual machine: 15 MB; + 2 CPUs available. + + Octave > [MEM] = javamem() + MEM = + { + [1,1] = 259522560 + [2,1] = 16318464 + [3,1] = 16085576 + } + + + *See also:* *note How can I handle memory limitations?: doc-FAQ. + + + +File: octave-java.info, Node: javaArray, Next: javaObject, Prev: javamem, Up: Top + +3.5 javaArray +============= + + + + -- Function File: ARRAY = javaArray (CLASS, [M, N, ...]) + -- Function File: ARRAY = javaArray (CLASS, M, N, ...) + Create a Java array of size `[M, N, ...]' with elements of + class CLASS. CLASS can be a Java object representing a class or a + string containing the fully qualified class name. The generated + array is uninitialized, all elements are set to null if CLASS is a + reference type, or to a default value (usually 0) if CLASS is a + primitive type. Example: This example creates a (2 x 2) + array of Java STRING objects and assigns a value to one of the + elements. Finally it displays the type of A. + Octave > a = javaArray('java.lang.String', 2, 2); + Octave > a(1,1) = 'Hello'; + Octave > a + a = + + + + +File: octave-java.info, Node: javaObject, Next: java_new, Prev: javaArray, Up: Top + +3.6 javaObject +============== + + + + -- Function File: OBJECT = javaObject (CLASS, [ARG1, ..., ARGN]) + Create a Java object of class CLASS, by calling the class + constructor with the given arguments ARG1, ..., ARGN. The CLASS + name should be given in fully qualified string form (including any + package prefix). In Matlab you should avoid to use the import + statement and the short form of object creation. Example: + This example demonstrates two ways to create a Java `StringBuffer' + object. The first variant creates an uninitialized STRINGBUFFER + object, while the second variant calls a constructor with the + given initial `String'. Then it displays the type of `o', and + finally the content of the `StringBuffer' object is displayed by + using its `toString' method. + Octave > o = javaObject('java.lang.StringBuffer'); + Octave > o = javaObject('java.lang.StringBuffer', 'Initial'); + Octave > o + o = + + Octave > o.toString + ans = Initial + Equivalent to the `java_new' function. For compatibility with + Matlab it is recommended to use the `javaObject' function. + + *See also:* *note java_new: doc-java_new. + + + +File: octave-java.info, Node: java_new, Next: javaMethod, Prev: javaObject, Up: Top + +3.7 java_new +============ + + + + -- Function File: OBJECT = java_new (CLASS, [ARG1, ..., ARGN]) + Create a Java object of class CLASS, by calling the class + constructor with the given arguments ARG1, ..., ARGN. + Equivalent to the `javaObject' function. For compatibility with + Matlab it is recommended to use the `javaObject' function. + Example: + Octave > o = java_new('java.lang.StringBuffer', 'Initial'); + Octave > o + o = + + Octave > o.toString + ans = Initial + + + *See also:* *note javaObject: doc-javaObject. + + + +File: octave-java.info, Node: javaMethod, Next: java_invoke, Prev: java_new, Up: Top + +3.8 javaMethod +============== + + + + -- Function File: RET = javaMethod (NAME, OBJECT[, ARG1, ..., ARGN]) + Invoke the method NAME on the Java object OBJECT with the + arguments ARG1, ... For static methods, OBJECT can be a string + representing the fully qualified name of the corresponding class. + The function returns the result of the method invocation. When + OBJECT is a regular Java object, the structure-like indexing can + be used as a shortcut syntax. For instance, the two statements in + the example are equivalent. Example: + Octave > ret = javaMethod("method1", x, 1.0, "a string") + Octave > ret = x.method1(1.0, "a string") + + + *See also:* *note javamethods: doc-javamethods. + + + +File: octave-java.info, Node: java_invoke, Next: java_get, Prev: javaMethod, Up: Top + +3.9 java_invoke +=============== + + + + -- Function File: RET = java_invoke (OBJECT, NAME[, ARG1, ..., ARGN]) + Invoke the method NAME on the Java object OBJECT with the + arguments ARG1, ... For static methods, OBJECT can be a string + representing the fully qualified name of the corresponding class. + The function returns the result of the method invocation. + Equivalent to the `javaMethod' function. When OBJECT is a regular + Java object, the structure-like indexing can be used as a shortcut + syntax. For instance, the two statements in the example are + equivalent. Example: + Octave > ret = java_invoke(x, "method1", 1.0, "a string") + Octave > ret = x.method1(1.0, "a string") + + + *See also:* *note javamethods: doc-javamethods. + + + +File: octave-java.info, Node: java_get, Next: java_set, Prev: java_invoke, Up: Top + +3.10 java_get +============= + + + + -- Function File: VAL = java_get (OBJECT, NAME) + Get the value of the field NAME of the Java object OBJECT. For + static fields, OBJECT can be a string representing the fully + qualified name of the corresponding class. When OBJECT is a + regular Java object, the structure-like indexing can be used as a + shortcut syntax. For instance, the two statements in the example + are equivalent Example: + Octave > java_get(x, "field1") + Octave > x.field1 + + + *See also:* *note javafields: doc-javafields, *note + java_set: doc-java_set. + + + +File: octave-java.info, Node: java_set, Next: javamethods, Prev: java_get, Up: Top + +3.11 java_set +============= + + + + -- Function File: OBJECT = java_set (OBJECT, NAME, VALUE) + Set the value of the field NAME of the Java object OBJECT to + VALUE. For static fields, OBJECT can be a string representing the + fully qualified named of the corresponding Java class. When + OBJECT is a regular Java object, the structure-like indexing can + be used as a shortcut syntax. For instance, the two statements in + the example are equivalent Example: + Octave > java_set(x, "field1", val) + Octave > x.field1 = val + + + *See also:* *note javafields: doc-javafields, *note + java_get: doc-java_get. + + + +File: octave-java.info, Node: javamethods, Next: javafields, Prev: java_set, Up: Top + +3.12 javamethods +================ + + + + -- Function File: M = javamethods (CLASSNAME) + -- Function File: M = javamethods (OBJECT) + Given a string with a Java class name CLASSNAME or a regular + Java object OBJECT, this function returns a cell array containing + descriptions of all methods of the Java class CLASSNAME + respectively the class of OBJECT. Examples: The first + example shows how the methods of a class can be queried, while the + second example works with the methods of a concrete instance of a + class. Note that creation of a `java.lang.Double' object requires + an initializer (in the example the value 1.2). + Octave > m = javamethods('java.lang.Double'); + Octave > size(m) + ans = + 1 30 + + Octave > m{7} + ans = double longBitsToDouble(long) + + Octave > o = javaObject('java.lang.Double', 1.2); + Octave > m = javamethods(o); + Octave > size(m) + ans = + 1 30 + + Octave > m{7} + ans = double longBitsToDouble(long) + + + *See also:* *note javafields: doc-javafields, *note + java_invoke: doc-java_invoke. + + + +File: octave-java.info, Node: javafields, Next: msgbox, Prev: javamethods, Up: Top + +3.13 javafields +=============== + + + + -- Function File: F = javafields (CLASSNAME) + -- Function File: F = javafields (OBJECT) + Given a string with a Java class name CLASSNAME or a regular + Java object OBJECT, this function returns a cell array containing + the descriptions for all fields of the Java class CLASSNAME + respectively the class of OBJECT. Examples: The first + example shows how the fields of a class can be queried without + creating an instance of the class. + Octave > f = javafields('java.lang.Double'); + Octave > size(f) + ans = + 1 10 + + Octave > f{7} + ans = public static final int java.lang.Double.MAX_EXPONENT + The second example works with the fields of an instance of a + class. Note that creation of a `java.lang.Double' object requires + an initializer (in the example a value of 1.2 is specified). + Octave > o = javaObject('java.lang.Double', 1.2); + Octave > f = javafields(o); + Octave > size(f) + ans = + 1 10 + + Octave > f{7} + ans = public static final int java.lang.Double.MAX_EXPONENT + + + *See also:* *note java_set: doc-java_set, *note + java_get: doc-java_get. + + + +File: octave-java.info, Node: msgbox, Next: errordlg, Prev: javafields, Up: Top + +3.14 msgbox +=========== + + + + -- Function File: F = msgbox (MESSAGE) + -- Function File: F = msgbox (MESSAGE, TITLE) + -- Function File: F = msgbox (MESSAGE, TITLE, ICON) + Displays a MESSAGE using a dialog box. The parameter TITLE can + be used to optionally decorate the dialog caption. The third + optional parameter ICON can be either `'error'', `'help'' or + `'warn'' and selectes the corresponding icon. If it is + omitted, no icon is shown. Examples: The first example shows + a dialog box without a caption text, whereas the second example + specifies a caption text of its own. The third example also + demonstrates how a character according to the TeX symbol set + can be specified. It is important to include a space character + after the symbol code and how to embed a newline character (ASCII + code 10) into the string. + Octave > msgbox('This is an important message'); + Octave > msgbox('Do not forget to feed the cat.', 'Remember'); + Octave > msgbox(['I \heartsuit Octave!',10, ... + ' Even if I hate it sometimes.'], ... + 'I Confess','warn'); + [image src="images/image003.png"] + + *See also:* *note errordlg: doc-errordlg, *note + helpdlg: doc-helpdlg, *note warndlg: doc-warndlg. + + + +File: octave-java.info, Node: errordlg, Next: helpdlg, Prev: msgbox, Up: Top + +3.15 errordlg +============= + + + + -- Function File: F = errordlg (MESSAGE) + -- Function File: F = errordlg (MESSAGE, TITLE) + Displays the MESSAGE using an error dialog box. The TITLE can + be used optionally to decorate the dialog caption instead of the + default title "Error Dialog". Examples: The first example + shows a dialog box with default caption, whereas the second + example specifies a its own caption + Octave > errordlg('Oops, an expected error occured'); + [image src="images/image001.png"] + Octave > errordlg('Another error occured', 'Oops'); + + + *See also:* *note helpdlg: doc-helpdlg, *note inputdlg: + doc-inputdlg, *note listdlg: doc-listdlg, + *note questdlg: doc-questdlg, *note warndlg: + doc-warndlg. + + + +File: octave-java.info, Node: helpdlg, Next: inputdlg, Prev: errordlg, Up: Top + +3.16 helpdlg +============ + + + + -- Function File: F = helpdlg (MESSAGE) + -- Function File: F = helpdlg (MESSAGE, TITLE) + Displays the MESSAGE using a help dialog box. The help message + can consist of multiple lines, separated by a newline character. + The TITLE can be used optionally to decorate the dialog caption + bar instead of the default title "Help Dialog". Examples: + The first example shows a dialog box with default caption, whereas + the next two examples specify their own caption. Note that if the + backslash escape notation is used in a double quoted string, it is + immediately replaced by Octave with a newline. If it is + contained in a single quoted string, it is not replaced by Octave, + but later by the dialog function. + Octave > helpdlg('This is a short notice'); + Octave > helpdlg(['line #1',10,'line #2'], 'Inventory'); + Octave > helpdlg("1 eel\n9 buckazoids\n2 peas", 'Inventory'); + [image src="images/image004.png"] + + *See also:* *note errordlg: doc-errordlg, *note + inputdlg: doc-inputdlg, *note listdlg: doc-listdlg, + *note questdlg: doc-questdlg, *note warndlg: + doc-warndlg. + + + +File: octave-java.info, Node: inputdlg, Next: listdlg, Prev: helpdlg, Up: Top + +3.17 inputdlg +============= + + + + -- Function File: C = inputdlg (PROMPT) + -- Function File: C = inputdlg (PROMPT, TITLE) + -- Function File: C = inputdlg (PROMPT, TITLE, ROWSCOLS) + -- Function File: C = inputdlg (PROMPT, TITLE, ROWSCOLS, DEFAULTS) + Returns the user's inputs from a multi-textfield dialog box in + form of a cell array of strings. If the user closed the dialog + with the Cancel button, en empty cell array is returned. This can + be checked with the ISEMPTY function. The first argument PROMPT is + mandatory. It is a cell array with strings labeling each text + field. The optional string TITLE can be used as the caption of the + dialog. The size of the text fields can be defined by the argument + ROWSCOLS, which can be either a scalar to define the number of + columns used for each text field, a vector to define the number of + rows for each text field individually, or a matrix to define the + number of rows and columns for each text field individually. It is + possible to place default values into the text fields by supplying + a cell array of strings for the argument DEFAULTS. Examples: + The first example shows a simple usage of the input dialog box + without defaults. + Octave > prompt = {'Width','Height','Depth'}; + Octave > dims = inputdlg(prompt, 'Enter Box Dimensions'); + Octave > volume = str2num(dims{1}) * ... + str2num(dims{2}) * str2num(dims{3}); + [image src="images/image005.png"] The second + example shows the application of a scalar for the number of rows + and a cell array with default values. + Octave > prompt = {'Width', 'Height', 'Depth'}; + Octave > defaults = {'1.1', '2.2', '3.3'}; + Octave > title = 'Enter Box Dimensions'; + Octave > dims = inputdlg(prompt, title, 1, defaults); + Octave > dims + dims = + { + [1,1] = 1.1 + [2,1] = 2.2 + [3,1] = 3.3 + } + [image src="images/image006.png"] The third + example shows the application of row height and column width + specification.. + Octave > prompt = {'Width', 'Height', 'Depth'}; + Octave > defaults = {'1.1', '2.2', '3.3'}; + Octave > rc = [1,10; 2,20; 3,30]; + Octave > title = 'Enter Box Dimensions'; + Octave > dims = inputdlg(prompt, title, rc, defaults); + [image src="images/image007.png"] + + *See also:* *note errordlg: doc-errordlg, *note + helpdlg: doc-helpdlg, *note listdlg: doc-listdlg, + *note questdlg: doc-questdlg, *note warndlg: + doc-warndlg. + + + +File: octave-java.info, Node: listdlg, Next: questdlg, Prev: inputdlg, Up: Top + +3.18 listdlg +============ + + + + -- Function File: [SEL, OK] = listdlg (KEY, VALUE[, KEY, VALUE, ...]) + This function returns the inputs from a list dialog box. The + result is returned as a vector of indices and a flag. The vector + SEL contains the 1-based indices of all list items selected by the + user. The flag OK is 1 if the user closed the dialog with the OK + Button, otherwise it is 0 and SEL is empty.. The arguments of this + function are specified in the form of KEY, VALUE pairs. At least + the `'ListString'' argument pair must be specified. It is also + possible to preselect items in the list in order to provide a + default selection. The KEY and VALUE pairs can be selected + from the following list: + `ListString' + a cell array of strings comprising the content of the list. + + `SelectionMode' + can be either `'single'' or `'multiple''. + + `ListSize' + a vector with two elements `[width, height]' defining the + size of the list field in pixels. + + `InitialValue' + a vector containing 1-based indices of preselected elements. + + `Name' + a string to be used as the dialog caption. + + `PromptString' + a cell array of strings to be displayed above the list + field. + + `OKString' + a string used to label the OK button. + + `CancelString' + a string used to label the Cancel button. + Example: + Octave > [s,ok] = listdlg('ListString', ... + {'An item', 'another', 'yet another'}, ... + 'Name', 'Selection Dialog', ... + 'SelectionMode', 'Multiple', ... + 'PromptString',['Select an item...',10,'...or multiple items']); + + Octave > imax = length(s); + Octave > for i=1:1:imax + Octave > disp(s(i)); + Octave > end + [image src="images/image002.png"] + + *See also:* *note errordlg: doc-errordlg, *note + helpdlg: doc-helpdlg, *note inputdlg: doc-inputdlg, + *note questdlg: doc-questdlg, *note warndlg: + doc-warndlg. + + + +File: octave-java.info, Node: questdlg, Next: warndlg, Prev: listdlg, Up: Top + +3.19 questdlg +============= + + + + -- Function File: C = questdlg (MESSAGE, TITLE) + -- Function File: C = questdlg (MESSAGE, TITLE, DEFAULT) + -- Function File: C = questdlg (MESSAGE, TITLE, BTN1, BTN2, DEFAULT) + -- Function File: C = questdlg (MESSAGE, TITLE, BTN1, BTN2, BTN3, + DEFAULT) + Displays the MESSAGE using a question dialog box with a caption + TITLE. The dialog contains two or three buttons which all close + the dialog. It returns the caption of the activated button. + If only MESSAGE and TITLE are specified, three buttons with the + default captions "Yes", "No", "Cancel" are used. The string + DEFAULT identifies the default button, which is activated by + pressing the ENTER key. It must match one of the strings given in + BTN1, BTN2 or BTN3. If only two button captions BTN1 and BTN2 are + specified, the dialog will have only these two buttons. + Examples: The first example shows a dialog box with two buttons, + whereas the next example demonstrates the use of three buttons. + Octave > questdlg('Select your gender', 'Sex', ... + 'Male', 'Female', 'Female'); + [image src="images/image008.png"] + Octave > questdlg('Select your gender', 'Sex', ... + 'Male', 'dont know', 'Female', 'Female'); + [image src="images/image009.png"] + + *See also:* *note errordlg: doc-errordlg, *note + helpdlg: doc-helpdlg, *note inputdlg: doc-inputdlg, + *note listdlg: doc-listdlg, *note warndlg: + doc-warndlg. + + + +File: octave-java.info, Node: warndlg, Next: How to distinguish between Octave and Matlab?, Prev: questdlg, Up: Top + +3.20 warndlg +============ + + + + -- Function File: F = warndlg (MESSAGE) + -- Function File: F = warndlg (MESSAGE, TITLE) + Displays a MESSAGE using a warning dialog box. The TITLE can be + used optionally to decorate the dialog caption instead of the + default title "Warning Dialog". Examples: The first example + shows a dialog box with default caption, whereas the second + example specifies a caption text of its own. The second example + also demonstrates how a character according to the TeX symbol + set can be specified. It is important to include a space + character after the symbol code. The \n character can be used to + start a new line. The third example shows an alternate way to + embed the newline character (the newline character has the ASCII + code 10) into the string. Please refer to the Octave manual for + the difference between single and double quoted strings. + Octave > warndlg('An expected warning occured'); + Octave > warndlg('I \heartsuit Octave!\nEven if I hate her sometimes.', ... + 'Confession'); + Octave > warndlg(['I \heartsuit Octave!',10, ... + ' Even if I hate her sometimes.'], ... + 'I Confess'); + [image src="images/image003.png"] + + *See also:* *note errordlg: doc-errordlg, *note + helpdlg: doc-helpdlg, *note inputdlg: doc-inputdlg, + *note listdlg: doc-listdlg, *note questdlg: + doc-questdlg. + + +4 FAQ - Frequently asked Questions +********************************** + + +File: octave-java.info, Node: How to distinguish between Octave and Matlab?, Next: How to make Java classes available?, Prev: warndlg, Up: Top + +4.1 How to distinguish between Octave and Matlab? +================================================= + + Octave and Matlab are very similar, but handle Java slightly +different. Therefore it may be necessary to detect the environment and +use the appropriate functions. The following function can be used to +detect the environment. Due to the persistent variable it can be called +repeatedly without a heavy performance hit. Example: + %% + %% Return: true if the environment is Octave. + %% + function ret = isOctave + persistent retval; % speeds up repeated calls + + if isempty(retval) + retval = (exist('Octave_VERSION','builtin') > 0); + end + + ret = retval; + end + + + +File: octave-java.info, Node: How to make Java classes available?, Next: How to create an instance of a Java class?, Prev: How to distinguish between Octave and Matlab?, Up: Top + +4.2 How to make Java classes available to Octave? +================================================= + + Java finds classes by searching a CLASSPATH. This is a list of Java +archive files and/or directories containing class files. In Octave +and Matlab the CLASSPATH is composed of two parts: + * the STATIC CLASSPATH is initialized once at startup of the JVM, + and + + * the DYNAMIC CLASSPATH which can be modified at runtime. + Octave searches the STATIC CLASSPATH first, then the DYNAMIC +CLASSPATH. Classes appearing in the STATIC as well as in the DYNAMIC +CLASSPATH will therefore be found in the STATIC CLASSPATH and loaded +from this location. + Classes which shall be used regularly or must be available to all +users should be added to the STATIC CLASSPATH. The STATIC +CLASSPATH is populated once from the contents of a plain text file +named `classpath.txt' when the Java Virtual Machine starts. This file +contains one line for each individual classpath to be added to the +STATIC CLASSPATH. These lines can identify single class files, +directories containing class files or Java archives with complete class +file hierarchies. Comment lines starting with a `#' or a `%' +character are ignored. The search rules for the file +`classpath.txt' are: + * First, Octave searches for the file `classpath.txt' in your home + directory, If such a file is found, it is read and defines the + initial STATIC CLASSPATH. Thus it is possible to build an + initial static classpath on a 'per user' basis. + + * Next, Octave looks for another file `classpath.txt' in the package + installation directory. This is where `javaclasspath.m' resides, + usually something like `...\share\Octave\packages\java-1.2.8'. + You can find this directory by executing the command + pkg list + If this file exists, its contents is also appended to the static + classpath. Note that the archives and class directories defined + in this file will affect all users. + Classes which are used only by a specific script should be placed +in the DYNAMIC CLASSPATH. This portion of the classpath can be modified +at runtime using the `javaaddpath' and `javarmpath' functions. +Example: + Octave > base_path = 'C:/Octave/java_files'; + + Octave > % add two JARchives to the dynamic classpath + Octave > javaaddpath([base_path, '/someclasses.jar']); + Octave > javaaddpath([base_path, '/moreclasses.jar']); + + Octave > % check the dynamic classpath + Octave > p = javaclasspath; + Octave > disp(p{1}); + C:/Octave/java_files/someclasses.jar + Octave > disp(p{2}); + C:/Octave/java_files/moreclasses.jar + + Octave > % remove the first element from the classpath + Octave > javarmpath([base_path, '/someclasses.jar']); + Octave > p = javaclasspath; + Octave > disp(p{1}); + C:/Octave/java_files/moreclasses.jar + + Octave > % provoke an error + Octave > disp(p{2}); + error: A(I): Index exceeds matrix dimension. + Another way to add files to the DYNAMIC CLASSPATH exclusively for +your user account is to use the file `.octaverc' which is stored in +your home directory. All Octave commands in this file are executed +each time you start a new instance of Octave. The following example +adds the directory `octave' to Octave's search path and the archive +`myclasses.jar' in this directory to the Java search path. + % content of .octaverc: + addpath('~/octave'); + javaaddpath('~/octave/myclasses.jar'); + + + +File: octave-java.info, Node: How to create an instance of a Java class?, Next: How can I handle memory limitations?, Prev: How to make Java classes available?, Up: Top + +4.3 How to create an instance of a Java class? +============================================== + + If your code shall work under Octave as well as Matlab you should +use the function `javaObject' to create Java objects. The function +`java_new' is Octave specific and does not exist in the Matlab +environment. Example 1, suitable for Octave but not for Matlab: + Passenger = java_new('package.FirstClass', row, seat); + Example 2, which works in Octave as well as in Matlab: + Passenger = javaObject('package.FirstClass', row, seat); + + + +File: octave-java.info, Node: How can I handle memory limitations?, Next: How to compile the java package in Octave?, Prev: How to create an instance of a Java class?, Up: Top + +4.4 How can I handle memory limitations? +======================================== + + In order to execute Java code Octave creates a Java Virtual Machine +(JVM). Such a JVM allocates a fixed amount of initial memory and may +expand this pool up to a fixed maximum memory limit. The default values +depend on the Java version (see *note javamem: doc-javamem.). The +memory pool is shared by all Java objects running in the JVM. This +strict memory limit is intended mainly to avoid that runaway +applications inside web browsers or in enterprise servers can consume +all memory and crash the system. When the maximum memory limit is +hit, Java code will throw exceptions so that applications will fail or +behave unexpectedly. In Octave as well as in Matlab, you can +specify options for the creation of the JVM inside a file named +`java.opts'. This is a text file where you can enter lines +containing `-X' and `-D' options handed to the JVM during +initialization. In Octave, the Java options file must be located +in the directory where `javaclasspath.m' resides, i.e. the package +installation directory, usually something like +...\SHARE\OCTAVE\PACKAGES\JAVA-1.2.8. You can find this directory by +executing + pkg list + In Matlab, the options file goes into the MATLABROOT/BIN/ARCH +directory or in your personal Matlab startup directory (can be +determined by a `pwd' command). MATLABROOT is the Matlab root directory +and ARCH is your system architecture, which you find by issuing the +commands `matlabroot' respectively `computer('arch')'. The `-X' +options allow you to increase the maximum amount of memory available to +the JVM to 256 Megabytes by adding the following line to the +`java.opts' file: + -Xmx256m + The maximum possible amount of memory depends on your system. On +a Windows system with 2 Gigabytes main memory you should be able to set +this maximum to about 1 Gigabyte. If your application requires a +large amount of memory from the beginning, you can also specify the +initial amount of memory allocated to the JVM. Adding the following +line to the `java.opts' file starts the JVM with 64 Megabytes of +initial memory: + -Xms64m + For more details on the available `-X' options of your Java +Virtual Machine issue the command `java -X' at the operating system +command prompt and consult the Java documentation. The `-D' +options can be used to define system properties which can then be used +by Java classes inside Octave. System properties can be retrieved by +using the `getProperty()' methods of the `java.lang.System' class. The +following example line defines the property MYPROPERTY and assigns it +the string `12.34'. + -DMyProperty=12.34 + The value of this property can then be retrieved as a string by a +Java object or in Octave: + Octave > javaMethod('java.lang.System', 'getProperty', 'MyProperty'); + ans = 12.34 + + +*See also:* *note javamem: doc-javamem. + + +File: octave-java.info, Node: How to compile the java package in Octave?, Next: Which TeX symbols are implemented in the dialog functions?, Prev: How can I handle memory limitations?, Up: Top + +4.5 How to compile the java package in Octave? +============================================== + + Most Octave installations come with the JAVA package pre-installed. +In case you want to replace this package with a more recent version, +you must perform the following steps: + +4.5.1 Uninstall the currently installed package JAVA +---------------------------------------------------- + +Check whether the JAVA package is already installed by issuing the +`pkg list' command: + Octave > pkg list + Package Name | Version | Installation directory + --------------+---------+----------------------- + java *| 1.2.8 | /home/octavio/octave/java-1.2.8 + Octave > + If the JAVA package appears in the list you must uninstall it +first by issuing the command + Octave > pkg uninstall java + Octave > pkg list + Now the java package should not be listed anymore. If you have +used the JAVA package during the current session of Octave, you have to +exit and restart Octave before you can uninstall the package. This is +because the system keeps certain libraries in memory after they have +been loaded once. + +4.5.2 Make sure that the build environment is configured properly +----------------------------------------------------------------- + +The installation process requires that the environment variable +`JAVA_HOME' points to the Java Development Kit (JDK) on your computer. + + * Note that JDK is not equal to JRE (Java Runtime Environment). The + JDK home directory contains subdirectories with include, library + and executable files which are required to compile the JAVA + package. These files are not part of the JRE, so you definitely + need the JDK. + + * Do not use backslashes but ordinary slashes in the path. + Set the environment variable `JAVA_HOME' according to your local +JDK installation. Please adapt the path in the following examples +according to the JDK installation on your system. + If you are using a Windows system that might be: + Octave > setenv("JAVA_HOME","C:/Java/jdk1.6.0_21"); + Note, that on both system types, Windows as well as Linux, you must +use the forward slash '/' as the separator, not the backslash '\'. +If you are using a Linux system this would look probably more like: + Octave > setenv("JAVA_HOME","/usr/local/jdk1.6.0_21"); + + +4.5.3 Compile and install the package in Octave +----------------------------------------------- + +If you have for example saved the package archive on your Z: drive the +command would be: + Octave> pkg install -verbose z:/java-1.2.8.tar.gz + or if you have Linux and the package file is stored in your home +directory: + Octave > pkg install -verbose ~/java-1.2.8.tar.gz + The option `-verbose' will produce some lengthy output, which should +not show any errors (maybe a few warnings at best). You can +then produce a list of all installed packages: + Octave > pkg list + This list of packages should now include the package JAVA: + Octave > pkg list + Package Name | Version | Installation directory + --------------+---------+----------------------- + java *| 1.2.8 | /home/octavio/octave/java-1.2.8 + Octave > + + +4.5.4 Test the java package installation +---------------------------------------- + + The following code creates a Java string object, which however is +automatically converted to an Octave string: + Octave > s = javaObject('java.lang.String', 'Hello OctaveString') + s = Hello OctaveString + Note that the java package automatically transforms the Java +String object to an Octave string. This means that you cannot apply +Java String methods to the result. This "auto boxing" scheme +seems to be implemented for the following Java classes: + * java.lang.Integer + + * java.lang.Double + + * java.lang.Boolean + + * java.lang.String + If you instead create an object for which no "auto-boxing" is +implemented, `javaObject' returns the genuine Java object: + Octave > v = javaObject('java.util.Vector') + v = + + Octave > v.add(12); + Octave > v.get(0) + ans = 12 + If you have created such a Java object, you can apply all methods +of the Java class to the returned object. Note also that for some +objects you must specify an initializer: + % not: + Octave > d = javaObject('java.lang.Double') + error: [java] java.lang.NoSuchMethodException: java.lang.Double + % but: + Octave > d = javaObject('java.lang.Double',12.34) + d = 12.340 + + + +File: octave-java.info, Node: Which TeX symbols are implemented in the dialog functions?, Prev: How to compile the java package in Octave?, Up: Top + +4.6 Which TeX symbols are implemented in the dialog functions? +============================================================== + + The dialog functions contain a translation table for TeX like symbol +codes. Thus messages and labels can be tailored to show some common +mathematical symbols or Greek characters. No further TeX formatting +codes are supported. The characters are translated to their Unicode +equivalent. However, not all characters may be displayable on your +system. This depends on the font used by the Java system on your +computer. Each TeX symbol code must be terminated by a space +character to make it distinguishable from the surrounding text. +Therefore the string `\alpha =12.0' will produce the desired result, +whereas `\alpha=12.0' would produce the literal text '\ALPHA=12.0'. + +*See also:* *note errordlg: doc-errordlg, *note helpdlg: +doc-helpdlg, *note inputdlg: doc-inputdlg, *note +listdlg: doc-listdlg, *note msgbox: doc-msgbox, +*note questdlg: doc-questdlg, *note warndlg: doc-warndlg. + + +Index +===== + + + +[index] +* Menu: + +* array, creating a Java array: javaArray. (line 6) +* available functions: Top. (line 29) +* calling Java from Octave: Top. (line 6) +* calling Octave from Java: Top. (line 16) +* classes, making available to Octave: How to make Java classes available?. + (line 6) +* classpath, adding new path: javaaddpath. (line 6) +* classpath, difference between static and dynamic: How to make Java classes available?. + (line 6) +* classpath, displaying: javaclasspath. (line 8) +* classpath, dynamic <1>: javaaddpath. (line 6) +* classpath, dynamic: javaclasspath. (line 8) +* classpath, removing path: javarmpath. (line 6) +* classpath, setting: How to make Java classes available?. + (line 6) +* classpath, static: javaclasspath. (line 8) +* classpath.txt: How to make Java classes available?. + (line 6) +* compiling the java package, how?: How to compile the java package in Octave?. + (line 6) +* dialog, displaying a help dialog: helpdlg. (line 6) +* dialog, displaying a list dialog: listdlg. (line 6) +* dialog, displaying a question dialog: questdlg. (line 6) +* dialog, displaying a warning dialog <1>: warndlg. (line 6) +* dialog, displaying a warning dialog: msgbox. (line 6) +* dialog, displaying an error dialog: errordlg. (line 6) +* dialog, displaying an input dialog: inputdlg. (line 6) +* dynamic classpath <1>: How to make Java classes available?. + (line 6) +* dynamic classpath: javaclasspath. (line 8) +* dynamic classpath, adding new path: javaaddpath. (line 6) +* field, returning value of Java object field: java_get. (line 6) +* field, setting value of Java object field: java_set. (line 6) +* fields, displaying available fields of a Java object: javafields. + (line 6) +* functions, available in the package java: Top. (line 29) +* instance, how to create: How to create an instance of a Java class?. + (line 6) +* java package, how to compile?: How to compile the java package in Octave?. + (line 6) +* java package, how to install?: How to compile the java package in Octave?. + (line 6) +* java package, how to uninstall?: How to compile the java package in Octave?. + (line 6) +* Java, calling from Octave: Top. (line 6) +* Java, using with Octave: Top. (line 6) +* memory, displaying Java memory status: javamem. (line 6) +* memory, limitations: How can I handle memory limitations?. + (line 6) +* method, invoking a method of a Java object <1>: java_invoke. (line 6) +* method, invoking a method of a Java object: javaMethod. (line 6) +* methods, displaying available methods of a Java object: javamethods. + (line 6) +* object, creating a Java object <1>: java_new. (line 6) +* object, creating a Java object: javaObject. (line 6) +* object, how to create: How to create an instance of a Java class?. + (line 6) +* Octave and Matlab, how to distinguish between: How to distinguish between Octave and Matlab?. + (line 6) +* Octave, calling from Java: Top. (line 16) +* package java, available functions: Top. (line 29) +* package, how to compile?: How to compile the java package in Octave?. + (line 6) +* path, adding to classpath: javaaddpath. (line 6) +* path, removing from classpath: javarmpath. (line 6) +* static classpath <1>: How to make Java classes available?. + (line 6) +* static classpath: javaclasspath. (line 8) +* symbols, translation table: Which TeX symbols are implemented in the dialog functions?. + (line 6) +* TeX symbols, translation table: Which TeX symbols are implemented in the dialog functions?. + (line 6) +* translation table for TeX symbols: Which TeX symbols are implemented in the dialog functions?. + (line 6) +* using Octave with Java: Top. (line 6) + + + + + +Tag Table: +Node: Top87 +Node: javaclasspath2609 +Ref: doc-javaclasspath2739 +Node: javaaddpath4789 +Ref: doc-javaaddpath4919 +Node: javarmpath5818 +Ref: doc-javarmpath5940 +Node: javamem6642 +Ref: doc-javamem6756 +Node: javaArray9286 +Ref: doc-javaArray9404 +Node: javaObject10242 +Ref: doc-javaObject10363 +Node: java_new11628 +Ref: doc-java_new11746 +Node: javaMethod12376 +Ref: doc-javaMethod12499 +Node: java_invoke13225 +Ref: doc-java_invoke13350 +Node: java_get14123 +Ref: doc-java_get14242 +Node: java_set14859 +Ref: doc-java_set14978 +Node: javamethods15629 +Ref: doc-javamethods15756 +Node: javafields16975 +Ref: doc-javafields17098 +Node: msgbox18392 +Ref: doc-msgbox18504 +Node: errordlg19854 +Ref: doc-errordlg19967 +Node: helpdlg20771 +Ref: doc-helpdlg20884 +Node: inputdlg22115 +Ref: doc-inputdlg22229 +Node: listdlg24956 +Ref: doc-listdlg25069 +Node: questdlg27274 +Ref: doc-questdlg27388 +Node: warndlg28988 +Ref: doc-warndlg29138 +Node: How to distinguish between Octave and Matlab?30751 +Ref: doc-FAQ31002 +Node: How to make Java classes available?31650 +Node: How to create an instance of a Java class?35404 +Node: How can I handle memory limitations?36140 +Node: How to compile the java package in Octave?39263 +Node: Which TeX symbols are implemented in the dialog functions?44056 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/octave_packages/java-1.2.8/errordlg.m b/octave_packages/java-1.2.8/errordlg.m new file mode 100644 index 0000000..e551214 --- /dev/null +++ b/octave_packages/java-1.2.8/errordlg.m @@ -0,0 +1,37 @@ +## Copyright (C) 2010 Martin Hepperle +## +## 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{P} =} errordlg (@var{MESSAGE} [,@var{TITLE}]) +## +## Displays the @var{MESSAGE} using an error dialog box. +## The @var{TITLE} can be used optionally to decorate the dialog caption. +## The return value is always 1. +## +## @end deftypefn +## @seealso{helpdlg, inputdlg, listdlg, questdlg, warndlg} + +function ret = errordlg(message,varargin) + + switch length (varargin) + case 0 + title = "Error Dialog"; + otherwise + title = varargin{1}; + endswitch + + ret = java_invoke ("org.octave.JDialogBox", "errordlg", message, title); + +endfunction diff --git a/octave_packages/java-1.2.8/helpdlg.m b/octave_packages/java-1.2.8/helpdlg.m new file mode 100644 index 0000000..c54dd41 --- /dev/null +++ b/octave_packages/java-1.2.8/helpdlg.m @@ -0,0 +1,38 @@ +## Copyright (C) 2010 Martin Hepperle +## +## 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{P} =} helpdlg (@var{MESSAGE} [,@var{TITLE}]) +## +## Displays a @var{MESSAGE} in a help dialog box. +## The help message can have multiple lines, separated by a newline character '\n'. +## The @var{TITLE} can be used optionally to decorate the dialog caption. +## The return value is always 1. +## +## @end deftypefn +## @seealso{errordlg, inputdlg, listdlg, questdlg, warndlg} + +function ret = helpdlg(message,varargin) + + switch length (varargin) + case 0 + title = "Help Dialog"; + otherwise + title = varargin{1}; + endswitch + + ret = java_invoke ("org.octave.JDialogBox", "helpdlg", message, title); + +endfunction diff --git a/octave_packages/java-1.2.8/inputdlg.m b/octave_packages/java-1.2.8/inputdlg.m new file mode 100644 index 0000000..7d14362 --- /dev/null +++ b/octave_packages/java-1.2.8/inputdlg.m @@ -0,0 +1,106 @@ +## Copyright (C) 2010 Martin Hepperle +## +## 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{P} =} inputdlg (@var{PROMPT} [,@var{TITLE} [,@var{ROWSCOLS}, @var{DEFAULTS}]]) +## +## Returns the user's inputs from a multi-textfield dialog box in form of a cell array of strings. +## If the dialog is closed by the Cancel button, an empty cell array is returned. +## +## @table @samp +## @item PROMPT +## The first argument @var{PROMPT} is mandatory. +## It is a cell array with strings labeling each textfield. +## @item TITLE +## The optional string @var{TITLE} can be used as the caption of the dialog. +## @item ROWSCOLS +## The size of the text fields can be defined by the argument @var{ROWSCOLS}, +## which can have three forms: +## - a scalar value which defines the number of rows used for each text field. +## - a vector which defines the individual number of rows used for each text field. +## - a matrix which defines the individual number of rows and columns used for each text field. +## @item DEFAULTS +## It is possible to place default values into the text fields by supplying +## the a cell array of strings or number for the argument @var{DEFAULTS}. +## @end table +## +## @end deftypefn +## @seealso{errordlg, helpdlg, listdlg, questdlg, warndlg} + +function varargout = inputdlg(prompt,varargin) + + switch length (varargin) + case 0 + title = "Input Dialog"; + lineNo = 1; + defaults = cellstr(cell(size(prompt))); + case 1 + title = varargin{1}; + lineNo = 1; + defaults = cellstr(cell(size(prompt))); + case 2 + title = varargin{1}; + lineNo = varargin{2}; + defaults = cellstr(cell(size(prompt))); + otherwise + title = varargin{1}; + lineNo = varargin{2}; + defaults = varargin{3}; + end + + + % specification of text field sizes as in Matlab + % Matlab requires a matrix for lineNo, not a cell array... + % rc = [1,10; 2,20; 3,30]; + % c1 c2 + % r1 1 10 first text field is 1x10 + % r2 2 20 second text field is 2x20 + % r3 3 30 third text field is 3x30 + if isscalar(lineNo) + % only scalar value in lineTo, copy from lineNo and add defaults + rowscols = zeros(size(prompt)(2),2); + % cols + rowscols(:,2) = 25; + rowscols(:,1) = lineNo; + elseif isvector(lineNo) + % only one column in lineTo, copy from vector lineNo and add defaults + rowscols = zeros(size(prompt)(2),2); + % rows from colum vector lineNo, columns are set to default + rowscols(:,2) = 25; + rowscols(:,1) = lineNo(:); + elseif ismatrix(lineNo) + if (size(lineNo)(1) == size(prompt)(2)) && (size(lineNo)(2) == 2) + % (rows x columns) match, copy array lineNo + rowscols = lineNo; + end + else + % dunno + disp('inputdlg: unknown form of lineNo argument.'); + lineNo + end + + % convert numeric values in defaults cell array to strings + defs = cellfun(@num2str,defaults,'UniformOutput',false); + rc = arrayfun(@num2str,rowscols,'UniformOutput',false); + + user_inputs = java_invoke ("org.octave.JDialogBox", "inputdlg", prompt, title, rc, defs); + + if isempty(user_inputs) + varargout{1} = {}; % empty + else + varargout{1} = cellstr (user_inputs); + end + +end diff --git a/octave_packages/java-1.2.8/java.m b/octave_packages/java-1.2.8/java.m new file mode 100644 index 0000000..202fbf4 --- /dev/null +++ b/octave_packages/java-1.2.8/java.m @@ -0,0 +1,19 @@ +## Copyright (C) 2010 Martin Hepperle +## +## 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 -*- +## Please enter @code{doc java} to view the documentation for +## the package @code{java}. +## diff --git a/octave_packages/java-1.2.8/javaArray.m b/octave_packages/java-1.2.8/javaArray.m new file mode 100644 index 0000000..c6dfb68 --- /dev/null +++ b/octave_packages/java-1.2.8/javaArray.m @@ -0,0 +1,48 @@ +## Copyright (C) 2007 Michael Goffioul +## +## 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{a} =} javaArray (@var{class},@var{[M,N,...]}) +## @deftypefnx {Function file} {@var{a} =} javaArray (@var{class},@var{M},@var{N},...) +## +## Creates a Java array of size [@var{M},@var{N},...] with elements of +## class @var{class}. @var{class} can be a Java object representing a class +## or a string containing the fully qualified class name. +## +## The generated array is uninitialized, all elements are set to null +## if @var{class} is a reference type, or to a default value (usually 0) +## if @var{class} is a primitive type. +## +## @example +## a = javaArray ("java.lang.String", 2, 2); +## a(1,1) = "Hello"; +## @end example +## +## @end deftypefn + +function [ ret ] = javaArray (class_name, varargin) + + switch length (varargin) + case 0 + error ("missing array size"); + case 1 + dims = varargin{1}; + otherwise + dims = [varargin{:}]; + endswitch + + ret = java_invoke ("org.octave.ClassHelper", "createArray", class_name, dims); + +endfunction diff --git a/octave_packages/java-1.2.8/javaaddpath.m b/octave_packages/java-1.2.8/javaaddpath.m new file mode 100644 index 0000000..c4b023d --- /dev/null +++ b/octave_packages/java-1.2.8/javaaddpath.m @@ -0,0 +1,44 @@ +## Copyright (C) 2007 Michael Goffioul +## Copyright (C) 2010 Martin Hepperle +## +## 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} {} javaaddpath (@var{path}) +## +## Adds @var{path} to the dynamic class path of the Java virtual +## machine. @var{path} can be either a directory where .class files +## can be found, or a .jar file containing Java classes. +## +## @end deftypefn +## @seealso{javaclasspath} + +function javaaddpath (class_path) + + if (nargin != 1) + print_usage (); + else + % MH 30-08-2010: added tilde_expand to allow for specification of user's home + new_path = canonicalize_file_name (tilde_expand (class_path)); + if (exist (new_path, "dir")) + if (! strcmp (new_path (end), filesep)) + new_path = [new_path, filesep]; + endif + elseif (! exist (new_path, "file")) + error ("invalid Java classpath: %s", class_path); + endif + success = java_invoke ("org.octave.ClassHelper", "addClassPath", new_path); + endif + +endfunction diff --git a/octave_packages/java-1.2.8/javaclasspath.m b/octave_packages/java-1.2.8/javaclasspath.m new file mode 100644 index 0000000..50b17ee --- /dev/null +++ b/octave_packages/java-1.2.8/javaclasspath.m @@ -0,0 +1,106 @@ +## Copyright (C) 2007 Michael Goffioul, 2010 Martin Hepperle +## +## 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} {} javaclasspath +## @deftypefnx {Function file} {@var{STATIC} =} javaclasspath +## @deftypefnx {Function file} {[@var{STATIC}, @var{DYNAMIC}] =} javaclasspath +## @deftypefnx {Function file} {@var{PATH} =} javaclasspath (@var{WHAT}) +## +## Returns the class path of the Java virtual machine in +## the form of a cell array of strings. +## +## If called without input parameter:@* +## @itemize +## @item If no output variable is given, the result is simply printed +## on the standard output. +## @item If one output variable @var{STATIC} is given, the result is +## the static classpath. +## @item If two output variables @var{STATIC} and @var{DYNAMIC} are +## given, the first variable will contain the static classpath, +## the second will be filled with the dynamic claspath. +## @end itemize +## +## If called with a single input parameter @var{WHAT}:@* +## @itemize +## @item If @var{WHAT} is '-static' the static classpath is returned. +## @item If @var{WHAT} is '-dynamic' the dynamic classpath is returned. +## @item If @var{WHAT} is '-all' the static and the dynamic classpath +## are returned in a single cell array +## @end itemize +## @end deftypefn +## @seealso{javaaddpath,javarmpath} + +function varargout = javaclasspath (which) + + % dynamic classpath + dynamic_path = java_invoke ("org.octave.ClassHelper", "getClassPath"); + dynamic_path_list = strsplit (dynamic_path, pathsep ()); + + % static classpath + static_path = java_invoke ('java.lang.System', 'getProperty', 'java.class.path'); + static_path_list = strsplit (static_path, pathsep ()); + if (length (static_path_list) > 1) + % remove first element (which is .../octave.jar) + static_path_list = static_path_list(2:length (static_path_list)); + else + static_path_list = {}; + end + + switch nargin + case 0 + switch nargout + case 0 + disp_path_list ( 'STATIC', static_path_list ) + disp(''); + disp_path_list ( 'DYNAMIC', dynamic_path_list ) + case 1 + varargout{1} = cellstr (dynamic_path_list); + case 2 + varargout{1} = cellstr (dynamic_path_list); + varargout{2} = cellstr (static_path_list); + endswitch + + case 1 + switch nargout + case 0 + if (strcmp (which, '-static') == 1) + disp_path_list ( 'STATIC', static_path_list ) + elseif (strcmp (which, '-dynamic') == 1) + disp_path_list ( 'DYNAMIC', dynamic_path_list ) + end + case 1 + if (strcmp (which, '-static') == 1) + varargout{1} = cellstr (static_path_list); + elseif (strcmp (which, '-dynamic') == 1) + varargout{1} = cellstr (dynamic_path_list); + elseif (strcmp (which, '-all') == 1) + varargout{1} = cellstr ([static_path_list, dynamic_path_list]); + end + endswitch + endswitch + +end +# +# Display cell array of paths +# +function disp_path_list ( which, path_list ) + printf (' %s JAVA PATH\n\n', which); + if (length (path_list) > 0) + printf (' %s\n', path_list{:}); + else + printf (' - empty -\n'); + endif +end diff --git a/octave_packages/java-1.2.8/javafields.m b/octave_packages/java-1.2.8/javafields.m new file mode 100644 index 0000000..4269aa7 --- /dev/null +++ b/octave_packages/java-1.2.8/javafields.m @@ -0,0 +1,44 @@ +## Copyright (C) 2007 Michael Goffioul +## +## 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{P} =} javafields (@var{class}) +## +## Returns the fields of a Java object in the form of a cell +## array of strings. If no output variable is +## given, the result is simply printed on the standard output. +## +## @end deftypefn +## @seealso{javamethods} + +function varargout = javafields(classname) + + if (nargin != 1) + print_usage (); + else + c_methods = java_invoke ("org.octave.ClassHelper", "getFields",classname); + method_list = strsplit (c_methods, ';'); + + switch nargout + case 0 + if (! isempty (method_list)) + disp(method_list); + endif + case 1 + varargout{1} = cellstr (method_list); + endswitch + endif + +endfunction diff --git a/octave_packages/java-1.2.8/javamem.m b/octave_packages/java-1.2.8/javamem.m new file mode 100644 index 0000000..33d3f6e --- /dev/null +++ b/octave_packages/java-1.2.8/javamem.m @@ -0,0 +1,84 @@ +## Copyright (C) 2010 Philip Nienhuis, +## +## 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} javamem +## @deftypefnx {Function File} [@var{jmem}] = javamem +## Show current memory status of the Java virtual machine (JVM) +## & run garbage collector. +## +## When no return argument is given the info is echoed to the screen. +## Otherwise, output cell array @var{jmem} contains Maximum, Total, +## and Free memory (in bytes). +## +## All Java-based routines are run in the JVM's shared memory pool, +## a dedicated and separate part of memory claimed by the JVM from +## your computer's total memory (which comprises physical RAM and +## virtual memory / swap space on hard disk). +## +## The maximum available memory can be set using the file java.opts +## (in the same subdirectory where javaaddpath.m lives, see +## "which javaaddpath". Usually that is: @* +## [/usr]/share/octave/packages/java-. +## +## java.opts is a plain text file, one option per line. The +## default initial memory size and default maximum memory size (which +## are both system dependent) can be overridden like so: @* +## -Xms64m @* +## -Xmx512m @* +## (in megabytes in this example.) +## You can adapt these values to your own requirements if your system +## has limited available physical memory or when you get Java memory +## errors. +## +## "Total memory" is what the operating system has currently assigned +## to the JVM and depends on actual and active memory usage. +## "Free memory" is self-explanatory. During operation of Java-based +## octave functions the amounts of Total and Free memory will vary, +## due to Java's own cleaning up and your operating system's memory +## management. +## +## @end deftypefn + +## Author: Philip Nienhuis +## Created: 2010-03-25 +## Updates: +## 2010-03-26 Changed name to javamem & indentation to double spaces +## 2010-08-25 Corrected text on java memory assignments +## 2010-09-05 Further overhauled help text + +function [ j_mem ] = javamem () + + rt = java_invoke ('java.lang.Runtime', 'getRuntime'); + rt.gc; + jmem = cell (3, 1); + jmem{1} = rt.maxMemory ().doubleValue (); + jmem{2} = rt.totalMemory ().doubleValue (); + jmem{3} = rt.freeMemory ().doubleValue (); + + if (nargout < 1) + printf ("\nJava virtual machine (JVM) memory info:\n"); + printf ("Maximum available memory: %5d MiB;\n", jmem{1} / 1024 / 1024); + printf (" (...running garbage collector...)\n"); + printf ("OK, current status:\n"); + printf ("Total memory in virtual machine: %5d MiB;\n", jmem{2} / 1024 / 1024); + printf ("Free memory in virtual machine: %5d MiB;\n", jmem{3} / 1024 / 1024); + printf ("%d CPUs available.\n", rt.availableProcessors ()); + else + j_mem = jmem; + endif + +endfunction diff --git a/octave_packages/java-1.2.8/javamethods.m b/octave_packages/java-1.2.8/javamethods.m new file mode 100644 index 0000000..b74eb22 --- /dev/null +++ b/octave_packages/java-1.2.8/javamethods.m @@ -0,0 +1,44 @@ +## Copyright (C) 2007 Michael Goffioul +## +## 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{P} =} javamethods (@var{class}) +## +## Returns the methods of a Java object in the form of a cell +## array of strings. If no output variable is +## given, the result is simply printed on the standard output. +## +## @end deftypefn +## @seealso{methods} + +function varargout = javamethods (classname) + + if (nargin != 1) + print_usage (); + else + c_methods = java_invoke ("org.octave.ClassHelper", "getMethods", classname); + method_list = strsplit (c_methods, ';'); + + switch nargout + case 0 + if (! isempty (method_list)) + disp(method_list); + endif + case 1 + varargout{1} = cellstr (method_list); + endswitch + endif + +endfunction diff --git a/octave_packages/java-1.2.8/javarmpath.m b/octave_packages/java-1.2.8/javarmpath.m new file mode 100644 index 0000000..77a0d64 --- /dev/null +++ b/octave_packages/java-1.2.8/javarmpath.m @@ -0,0 +1,45 @@ +## Copyright (C) 2007 Michael Goffioul +## Copyright (C) 2010 Martin Hepperle +## +## 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} {} javarmpath (@var{path}) +## +## Removes @var{path} from the dynamic class path of the Java virtual +## machine. @var{path} can be either a directory where .class files +## can be found, or a .jar file containing Java classes. +## +## @end deftypefn +## @seealso{javaaddpath,javaclasspath} + +function javarmpath (class_path) + + if (nargin != 1) + print_usage (); + else + % MH 30-08-2010: added tilde_expand to allow for specification of user's home + old_path = canonicalize_file_name (tilde_expand(class_path)); + if (exist (old_path, "dir")) + if (! strcmp (old_path (end), filesep)) + old_path = [old_path, filesep]; + end + end + success = java_invoke ('org.octave.ClassHelper', 'removeClassPath', old_path); + if (! success) + disp (['Warning: ', old_path, ' not found in Java classpath.', 10]); + end + end + +end diff --git a/octave_packages/java-1.2.8/listdlg.m b/octave_packages/java-1.2.8/listdlg.m new file mode 100644 index 0000000..a3fa7af --- /dev/null +++ b/octave_packages/java-1.2.8/listdlg.m @@ -0,0 +1,126 @@ +## Copyright (C) 2010 Martin Hepperle +## +## 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{[SEL,OK]} =} listdlg (@var{KEY} ,@var{VALUE} [, @var{KEY} ,@var{VALUE}, ...]]) +## +## Returns the user's inputs from a list dialog box in form of a vector of +## selection indices SEL and a flag OK indicating how the user closed the dialog box. +## The returned flag OK is 1 if the user closed the box with the OK button, +## otherwise it is 0 and SEL is empty. +## The indices in SEL are 1 based, i.e. the first list item carries the index 1. +## +## The arguments are specified in form of @var{KEY}, @var{VALUE} pairs. +## At least the 'ListString' argument pair must be specified. +## +## @var{KEY}s and @var{VALUE}s pairs can be selected from the following list: +## +## @table @samp +## @item ListString +## a cell array of strings comprising the content of the list. +## @item SelectionMode +## can be either @samp{Single} or @samp{Multiple}. +## @item ListSize +## a vector with two elements [width, height] defining the size of the list field in pixels. +## @item InitialValue +## a vector containing 1-based indices of preselected elements. +## @item Name +## a string to be used as the dialog caption. +## @item PromptString +## a cell array of strings to be displayed above the list field. +## @item OKString +## a string used to label the OK button. +## @item CancelString +## a string used to label the Cancel button. +## @end table +## +## Example: +## +## @example +## [sel, ok] = listdlg ( 'ListString',@{'An item', 'another', 'yet another'@}, 'SelectionMode','Multiple' ); +## if ok == 1 +## imax = length(sel); +## for i=1:1:imax +## disp(sel(i)); +## end +## end +## @end example +## +## @end deftypefn +## @seealso{errordlg, helpdlg, inputdlg, questdlg, warndlg} + +function varargout = listdlg(varargin) + + if nargin < 2 + print_usage (); + return; + end + + listcell = {''}; + selmode = 'single'; + listsize = [300,160]; % vector! + initialvalue = [1]; % vector! + name = ''; + prompt = {''}; + okstring = 'OK'; + cancelstring = 'Cancel'; + + % handle key, value pairs + for i=1:2:nargin-1 + if strcmp(varargin{i},'ListString') + listcell = varargin{i+1}; + elseif strcmp(varargin{i},'SelectionMode') + selmode = varargin{i+1}; + elseif strcmp(varargin{i},'ListSize') + listsize = varargin{i+1}; + elseif strcmp(varargin{i},'InitialValue') + initialvalue = varargin{i+1}; + elseif strcmp(varargin{i},'Name') + name = varargin{i+1}; + elseif strcmp(varargin{i},'PromptString') + prompt = varargin{i+1}; + elseif strcmp(varargin{i},'OKString') + okstring = varargin{i+1}; + elseif strcmp(varargin{i},'CancelString') + cancelstring = varargin{i+1}; + end + end + + % make sure prompt strings are a cell array + if ! iscell(prompt) + prompt = {prompt}; + end + + % make sure listcell strings are a cell array + if ! iscell(listcell) + listcell = {listcell}; + end + + + % transform matrices to cell arrays of strings + listsize = arrayfun(@num2str,listsize,'UniformOutput',false); + initialvalue = arrayfun(@num2str,initialvalue,'UniformOutput',false); + + ret = java_invoke ('org.octave.JDialogBox', 'listdlg', listcell, ... + selmode, listsize, initialvalue, name, prompt, ... + okstring, cancelstring ); + if length(ret) > 0 + varargout = {ret, 1}; + else + varargout = {{}, 0}; + end + + +end diff --git a/octave_packages/java-1.2.8/msgbox.m b/octave_packages/java-1.2.8/msgbox.m new file mode 100644 index 0000000..84eca46 --- /dev/null +++ b/octave_packages/java-1.2.8/msgbox.m @@ -0,0 +1,54 @@ +## Copyright (C) 2010 Martin Hepperle +## +## 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{P} =} msgbox (@var{MESSAGE} [,@var{TITLE} [,@var{ICON}]]) +## +## Displays the @var{MESSAGE} using a message dialog. +## The @var{TITLE} is an optional string, which can be used to decorate the dialog caption. +## The @var{ICON} can be used optionally to select a dialog icon. +## It can be one of @code{'error'}, @code{'help'} or @code{'warn'}. +## The return value is always 1. +## +## @end deftypefn +## @seealso{helpdlg, questdlg, warndlg} + +function ret = msgbox(message,varargin) + + switch length (varargin) + case 0 + title = ""; + dlg = 'emptydlg'; + case 1 + title = varargin{1}; + dlg = 'emptydlg'; + otherwise + % two or more arguments + title = varargin{1}; + icon = varargin{2}; + if strcmp(icon,'error') == 1 + dlg = 'errordlg'; + elseif strcmp(icon,'help') == 1 + dlg = 'helpdlg'; + elseif strcmp(icon,'warn') == 1 + dlg = 'warndlg'; + else + dlg = 'emptydlg'; + end + endswitch + + ret = java_invoke ('org.octave.JDialogBox', dlg, message, title ); + +endfunction diff --git a/octave_packages/java-1.2.8/octave.jar b/octave_packages/java-1.2.8/octave.jar new file mode 100644 index 0000000000000000000000000000000000000000..9715bd78da0710b275a8118c1ff1538d7a196011 GIT binary patch literal 30933 zcmb5VV~i+48?8Gtdu-dbZQHhO+qP}n_Uy53+qP%U{toUz?mfxvq${1&Tj}Z_EAQ&{ zq~xXk03!o{gM$MERlV>7{4W;-05E`zh_V2Ugsdpt&jbL#9{_nNF!29W0R8te`Tx(w z$p0$-pT#l)vJ#>qO3Jh{qK`6DlhRT&wDT}hG?X(_vrUThOH6ymj6aKoSm;#dZ)hZ>r^S@)r)VfgXe6lsDOL}T_l|)7brT2GqgX=!ULpMN{-2u&{6D?` z``@gcqZyr@k+XrT37wF&fs>QCiM73nBdyVYo@+EAyp@-ifAd~VPh?2r;DLx>;UT=z zGvHy6N$?{9nGt~yk^fj?kP0!zPyL+|23A9E>r}qPv_^4|uxW^uPihtiK-1Q$vC*0D zT8J@SyXT{78a&ehUlrvwTZ~ zg8aD-jQnk{hu5=s+W?Uv#Vi1LMd+YUM$V|DZA{Q9gb%aYiaR=P6e_w*J5`cFJB8Y{v`DSNt4ltedJZx0E*x`W?wlyf z(#WBP`)KUb+nqygS2m_qgP%6<1o(=usGe=i z7Orz`G8_AS$}h2^M`M?wC=YAIni;ow5a$AJ+QiY}hjw9B*2zOf5AD)&6YCc>G;sI+vPFDg42SN+i|K= z%p>T7j;oi20|j_*-mRj9aHk#fFDf+!+}U!GqFO=$;F}Jr?1-{cq~*s+v-oS4g)-25 z?X=hs%WZ8nki)5<(2$<_731}D2mFO0B;>R8*%fb7@pc&e!R77t(kNE4qPJapQCQ4D<8mM9e3 zRf7qnN~8l8-w;oudJf{G4RaT&sPzlP<5QqeL71#sge$nx!W^V0FQ<;~%uMC<20Yjt zY@Mvhi9H40`V=3VcEbfSmNW=6Ge)06S;TNbKbRW)m_Bjxh8Oek;CJKF7EZ3YdvCvo zlkfe;na61$9_~M{*x42MMA&ZXqEk{O;T7qr<6>6)gGXuPxvAzO1`^3+qU=e?!%o7P z4(fz3{M6WW5Y4TUl$m%@tq7EG2qPZUvl$keywOudiFh<}jbl)3R0&ByhN=q0$e*O0d^A0nM{w z9e<0lp{$RRCi^YAG4Gz825tVVm8HUIL%Ql(l}|Gcya}CNF7@bSM_6WBsp5vHR+rb* z@Nknn`NvzC>!F;w6G+d<(a>2sbm!5J;)T+OO*8~8EC3%&dppfe$=%Xdpnw_`@Dmz$ zlyl?Nd}Yc^{K>>yFhIrOFe8_{knot}pjxw3A*u~E_o7D6#7o^MVlOhyA~fgR4(>yo za1>t>LwYQ_PAGMT5oE7~E9SKXn1-og4KQplmoCd{5F3>{NA=x9aP0uZi&cd*%dsul zbl!@S#o>V#Y*Pvo)pF?!>aAOZJCnuX8~UT|>fpgKOifp29A0@y_f{qAHqS~+3`VUO z^0|#^vwDu(saE!R=1ZDxRhzV-R+q}zV2-mYqjXT|e_k7Wu z_F~bjr>eVn&fv*CnbuNMQ*gq6nXONc9B20C=v+#NwGl*P+IwrnFDKt7D;FsncL;%F zcZh={w{H0^B2?6HPO%TU+e4ong zOMP#u?iMMZm3SlO{3ZM1HsLD)e9`XSKQ?ddB)(UsN?`sz z-Wqx)pXxgzwwN02nMTU1aDI{#cP4-h6B&ogDLw1ogbs)I;`MlZbiFu>6vhinopz4y z{@5wgo#jfYNVaa#s>x#vHCsC5oPej&%T8l6{i`rkj<1;A=PWHL$%=XV0{{Jq%Sp^|s$q1+qyWP63F8?xG1z>2+6M#9zP!KGmT-9^1e{RA`&;IEuNHg&(d_ir>~b&nyE}C zl4RzdG8*{Bj?os!KBF1E{b?Sd1SR*7`U-5gqwRo2n@w5^l_r0)=zxNn#_I!(9;wn} zR6WH3V9}e@W_DR{Z^D2bs)#?j|K#6-nGHVz+TsHln;G>lATOKdVc z-}%kxkwymd7Y9v z*imhv$OcX)6d*=VhYt5o#Pzsp?h`$T&`-%XT4^!&CkKyAwKm$_bytopd~BUVi6WSQ zYOaBlbgk$u8E>?$5|GBV*E6ZKYTLKkeYjv67xB43YP@$}Y_ch_$}sVWCeyGYByOfS zAd)0vpjjHTPuDa!#~P}d5;b^-{V&9hh>#WIJ$NrBuk)<;wCihz~&1V}^=(7&?XtfARrFs@{o+(XB? zJhrl@`ELjEJx}IB3N1Hfp?x8Pq$0iOiyhEF-3I!pbjT}Oy{Z3J&(!Hn%Nufn z-ai7P-U+K3!iE-xqNK;!?Hgx@g0M&7;0W_*HlSnKbFw~c44Y3W-YHx)MEjuCt$SFn z#q7syvpWhzlz|alNN=N7Hc5R`?=#PD>uD~BBy6Lr*cc6_?nD69)j^5TJbGH|pwrk< z+qKw4O+4_0Y&TE0~IeE^hw0=wCCIwYQd}sz7)D{MdIf(8leabi8}X8Yy_c@`-WFZHZPI zeLGYVT^}a3f0rZ;Kj9r@N9v*t;lU>b1<`+`ehW>czWk#ZvwPMFtD( znILQ&o^jP>T?QIX39e7<+WqYh>4;egHg{|LYFXyZW*J{AtHJjazSY8WdpJg-TqV4Z# zk7SyB&Q`G9_il`tee}uZaDZc{<)QYYo9v4__KQCD3zT!C%R4KB?)@_)t6~e?osRM+4hEU)`%ZUq zz$?2W%Tw2Acm}90Zkv%sgRX(7Ru1R0;-tYW&oRER+zz2VATJA6{j=dIVm>0zT7IpOLWhKQjq>^h-(X`Vg+X zP?Q$-rP#YhNl+TKhZiy7)$zv4{RHYZNlZLNt7hPakI(s#WAn#;# zUs)mVkem)tVyw}GT(P8Nr4Qbq%xD%021k_D*lkkZi? zK!9{>2g%Kp;$*5^oP9UtYgWYq3^&x#qAaG5anUT?dLtecF{g|p?zR`*kYbIfw(ohM z?BhX%m;naNh(zVcMHbNA)%(hraT!O$)|tUb9@Pco>0-W13LvTT4B!eV8|IjW&eVp? zI1swK!pm#YObsEivyvNf_cq2O#zXZyc?1y>dLnQq;iItmQ$~*;R6}l8jY*#JMDr=k zLe@Jw+v(e9mm^<2(sk&E41i8FGO>x`$JT1%WJT$y`qaxtKr|!7nt_m-si_AVsRta~ zb`l6p#pN##C}$V_)kp#<47BgbR*yrA`a zqG<-$Iy0ypiO21%QlV(!{^Azxa%K_cUxeZ<6f z5;)PEu0j+|SveZHb2a4on`;0#SCM#ozcKP3=4J~q) z{fV^9Pb#(|ibeChD^`4Xv7?QFA8qdIgdTw+|NI;6Gs+W;ah_>Ko&gh2mcR-LUV4pl z+gPXFh=gu}*T`sx0sAgZ??NRm^)_Tz=U}@YZ{sm??{ zChh^#kKNF&@qrz~eOty`m-H76=})h~mrKn9An znpur!I*sSPJCu7j<#|5)&O-eR!$Hy#a5VDab{&k+nhAupBJ7Bs33Aq1EOzttAN(w_ z+5$55a8lC_l~e6?8kRcbgji zmP~monDUm99l{+erk#^}E#dq^Qsp84NOZ3x54)Uu*38`%DCMbOO*{S?wkcx|=B{%2 zk%m&cQkEPmiwiSOhk_*f^C1{choDjX9V3cVeNEOs! zgq?r^3N$~2!@lX3s0h8ms*&?kp`&9V=i;^{D{P{^>|zp_5sHtwO*Nks@ODSi>vx~ovj!tU<(;c3O{t$z0~bBYXY5(m`Pz4 zSs)@;BPq$V=jy5{W=hb{+|B9+iI?dg!#CrpyveK56+?e@^y zF)J*pC0gy(n9C$zA`oacCV__HeE(f>kX;!~vF)s4-rww?{i{5DXOdvT5)50C=!^-? z?8;_?9K_+_3D2#vp?jqgoH{D3yM#uFJSw#KQf*<82@+=Ib!noMN%K-ij+{bm2{Upv zCHaoj74lW3D#t&cAFmX8PLo!ugknyTT?Vav&0uVrGOFjU(aE(Fm#wdRUc9UWiMU(F z$qlzo4DmThDVzFgwq_Ar>Kk125u=bHScvafQN!ozGh>J+gFRsMQ&TZP#fBzKTiuLI zix_E1j&zVIpBZa$>0@ATbA*o3%Zktp5XhNtZNyB4o5FtRnT=3EDYl}&;ZmMR-vCxr z%P*x0C2mHAt8A5$IRg_an_};tHZq(448*7Cx@xMYHBURsxJeo^H(*5%db67Kp?sN@ zt&Hi`CKOB!Jo!{O^nq#O%vU}K+2T-ge}Ffa91jY`Z26+mzNlTPW*awwuT&6CuT$rj0djo7Plin_H}Y zx7&JsY6;GpH$&=rb(<^AU~cw@2Pd&YEGIl~z9H#%U=n_Hz(v=((9e%^#K=&sYkfCg zAB&JhvkYJRw=SDmHwLd9Lprd7YkBV2zWbg<%j@ZovXy)D*T@#$*ju<^?G^kVIC25x z)IHOaxHYpfn;m1J53t%3Ug)J?fJDh~465(wzQ;_w$$I*^4`$4FYvo@kRLOpZB@cA2 z%YN|34LT{adXTjWIPJ2__CXgz*OgGOyCeOgxj=EVBKWM&#=6CZg5b%L-3YcYeCG|=m21WGi6jFyrdx;3LbE`X{P(THXqV=RSK3qHxbZJ&F()CtJqiol|u z53AMbSdDU;R%CL}7twZ2ouzUwqwMMsb`cwGvxMCxK;p2Qun$=i`6uxXMRSjG^#mQO zy@BAlJlap)Hfx#(PWIf}+?(aV6DMmIb?Ve)XLKhEME+-RoaS{c~Xd7qjDGO z2J~E{yoGq8h+QqatMtHvEnnV8c>d{Cwi{5ppkdbTiI7~5rB?F|pj)J=pMLw{-tEGB zP8@$N@HHSiUHV=dY2%b@)0l>?!zD45(`j>iq?v?Wx7}*S@%q;8+)Z-Asn{&2cr~o| zxJ>qwXtb}Y7A+Fy zjUl;o6|yHh)jW%qEJy`C0)b9WNqWce27}&%Y3Pl3|m}dOH<@tF3d!8?6plXB$FD-pDJ~R>GE1yd=7FZ0YyPbd?Jv3gj?ncw zU-slztN8-_4)v94ne~qxqg*k}YkGZuIo>qOdw>7j#PFwA1S%DI>K_fsi{i&J6$W-# zg+U-lpnq-Wq|%oqp5#V@(x!H77#j9LfV-0yrX%DQ6y{gvkM2iVjLhs9(0_e@MaOpF zsbX{<*Hn;Eg|t|9FDZUB#&{aPP5DETtrpo~&s~>1*;s3=LNw8{W!GZ3!pJDi3Zzt8 zfa0X!*JPJ0pv^Z`PNK9JWdb+}ea#(OT>>-AZkYZdm)sd4pxD?lwHf&yThN!Xn+rgA zMtF1+J2j^?imbvU4H^}YzCa}^x;@9fx>FOq&d)G3pIk97A;^d8aIZdqZ>u2hi#f4+ z0hdya4p@b_LQhB#O9r$;V!c-pY=+JeS8{HU8y_Yi?jDPVXl(81A}xrh1=LE?JroTL{||ik+#*pnXD)kS&+_|a$(`pzdg+gYSxjwDjj;Rn%1*RDQ+e} zv1~?FfxNU*TSFQ)BFeKgVY=>#Z+B(_AGGYOF{>us!s_VLn;LY^{Jfn5yzJ+zeW_09 z>5_=(QtS;wA;us&+XDA>3N+1X8;^}|gUGr8c;o*KwgzFXCvMO#p;%1xH;NTg>gJ%P zOS<1SCp>j>3gT*-chKGl7?yXY7)~8E%jEzPe#gN(z)fSE%s#6)=tYP)Y`iVCLO3&N zC4JNba#amnrP*dCdw^zBEi}+9kNzI#;Bs#c8^k7#y*rk&IL`jDMC8DttR;`E06HftKp#a%#aV6MNupyB zNF>5BnzP$mz$E+UY3)LJ1Pg1=!gdXFK03)H@r70T8{|I4%`}~i~)r0)s6!cGG z|0@yur=Wje?7zXV7}ZZDtW}gBRERoaR#s9_FzX;0L#=9hN%6(R^tE9)#6W;ic87?~ zg_dT0i~^N35UkO-5fTesSJDhwtp$q>i!z0>?*hQG^c9PGnM>)9bXLCNIK9uXWZ%N9MV zdo{vvL;loL=jJnZ)qs|_%I^0}@IKm&phj;YX=nL=75L_@eFm6UT&icr#2Hz3B3D8l(ML=@qb(`3g9vBWA=!v*%>pIWjYpT2 z=CURWySPyP=5r0s-P>Yon9Fk8*Vs7Rwr!%7duWpW;*@doHJlzA%f8dnrok>L015(2 z&sYZ~*|dQ&1Ec1uWJCgViqpN|l=~d3a#{q1CCkRv98Sl9mYU=oMO_-YYhx8cXq6Oh z12Qq#^>t(z&cvUp7D@Ny@mH@@G33`bXBT57!lgM(8TK3dEeX$+V4Pc}O#`nn*K6wq z+639!?xLmDaZ5@U>pQlH#&#f!WlH zmK6N5;Go1D$2;eR83;P-Qh6^%rL!RMKBgPe>zQWdo`JG_kt>+y1A{*d%vR-})~V3h zBgFwa<_vS8Vl2wFqUL)HSFHA;-NX0!0jI-z)H4m1Zb>G4-Q>K)k!bca{9L$f^=ihu z1A~|sYSNvJ#)~+!9T+ zb9!WB>YZzEC8Y|Z_XFZg6RC8N zI52=UaAJs)AJC4bF;|lxk?UBgAu&b3I4kHH!=~I3=;1`)E_KvB=hGSG`I2Lf^09k7 zs0DdM-Kc1A#k`!lRR7efUX0iC+-1|W`*1f5G(8_J)z|n4I42sX)5$ep1m(2%r@;A( zWXU&Tk#oR1tdK#O=%UDgM`A%rlc^wc;+FUcHvUzl{hIhr>$oFSnM>;PO?-=i=mxDP z3i(MN_-%jw3&eR3nL9+n9dcWU#U}vdq4^Ek^9JD49zvk%VAtRpM9ls7`$t2WQkAu8 z@Wa*#-(itBiNTj10HZ=F1-m zTk4hl#v;BXJ^g~~#{Cr+mP19zp<6PVWsH0lLH3M?2fFqq&E6=Atk{t0#$IN2&{wl0 zz8b>llW`;(x2altPoMhE2>FDv`|MMEwChIsnW1_|GCV){Rw%81f{)N&$Nl2D00nCJ z!R2_$obEd5Z~v&}zw}zI_sF-LR9T`!7FsHo_)V_;>EHP!8~;UP-QVp_Jc1H6su1kX zOsylx>OZ=@w=zd>kE~JIJeg-FYg_oEUDfK8F&OJ{rQJJIMyPxcZQ| zF%@ZNFnp;I1KN9C&<)-5`{zGh)-JqYfB*~tKo;iz)@AYk-@2@#iK&UBiLKH9Xtzq6 zibw+RJV=RGrW&^Uh)0C@h^&B3k^X7G$yK66>VgIuyv3=;;86x_E!5<`NpR*A#my6N zcSY1*jRf)#%I}V)Wo5G&H@Ufdettio`9?AVWQGL62x{P@#L|>^M5KqY>PSG&7;eL! za{b6RQ0b`*Mf#|4g6`pBjJQ!Uih_~@*g=Fs&_iDuh-w0tAIUD)nx7uHR6rVm`aA!Nl)r+DEhKs1x-`hgZ7g8#; z8#JRD4e&TQdMzV|x>lTO9fo%AaBl3WMv(-iMBqS`oeQ)?@Cc!Ko+)T?Z{Pz6vKy(s z3{JK6)rXO|QR?}5veg)Z4IrW@Q|qe@p{by+amyT43XR*l5LH#U2b~}+Q0VRw1*T1h zEm*Vi)lo3I4bPf#0&f(aJF6v{dcmM`&}yf3Mt{zFl;_A(+EdKZmoTw*-%xc6mgamj z{V(OXFdd6hPp_Syw+S^rD#MEA(-#<5(^9%aoh#O24*#UxGBGdy?RLFFblWltJ@Z=@ z^{7J0v$))04u*9fw})OumGe^R?lZ?)>bj|VYNHp#t55PJ`Nn79HXb*A#TQ(Y>SBNQ zX{Nkqs(1f|d+Sv#w1aOgjIfXQJ(mflA3|pEIJz&w`!j_2wTV0#Z286IZNjWmpAvb4 zPAn`TRF8g6&)~h>RYoCb59ZtddjlO{e}|kn#}R@Jo8SX^TwID)Jv0I#W?xlFuinFh zuda6?=rS-b8A!;iNtG-}Heqf`=29^uZ)GasT|I(P<5Hk0*`%bDmQFf1Ia`fwQB9 z`+swuIcgBj%F7r(wx%9-p#<>(fPVl*H4>+c1LOli5%GbE(Ge#QF@c8D#^FH|GuSf# zDl{nz^>r>sO8phGEENh<{P~G&^=md(G}CI!au-#-E-F-QX3tIgK6kR%06~wK$vSRn ze}A`sKX3hhe@~WwaWBE-qj%dGU{*U6VlH*Ad=_EQTE}+UjGcn8GS)6cQEip$WooyJ z_e@bXx6y-fAZ-&acU2v#0ym47t|@Qi9m*oRl)c4fo2Em9YWY@XRMtHB(9QbV;lvv?9=3~NCxC;*yP2N9X*M zpQ_wv-a}ZpEA~79y_||`gz$?RG+$bRN#j+TbT`XU#E2RWCT3c!2JbO|V&hRY(NOO& zt!gxzOWJEKeAtus3Y|=eF(s72*B%}&A(+@!q~{4(63p9Mn`$Vq^-5V<97hsX)k#3I zJz_+~3`Q?hSX8rmB&*bHo|c5GDOW0t)*c_Qs=yP%Ra{A?97qa~8ZOKS&=Vsz5M`HC z&!^0h$g;Ed)FG888w{g6ZVc>ft5)U}s#*~2+;x8dBBhY-#hXn+Z3E^{RTEC?w=5NR zI(o8YljbjXf@T4Vq1wLeUbV zR)z>;T5VEcXY7)9FdROUz z<=uUSJN@DdG>ARi>(QxzSY<+#XB5-7l8&92`1~s z_v=W1JODDu( z&8(^bfJHC3NCvWyhE?|Ei)E~G@S>dHB;{x`r||l~>ip5{ht>hpnJ>lMmxJ&QS>SX> zv2dI9Yp_F+zl33ZDe=D?56mEUl9Bk*UN>enJo{J9%&cD7T;87raAz5J>xK_C(~M69 z(5)zL^lJ8K;CutxP`VHMyWHd6@low4VnYx&M(i6Lz94of=T2{oH_>iM)p+~vg<9~#w?A#~&6yWqAd^Ix(iyjDBHmB-auo|$t*=cf$ zdy$BG?xdWjf|^@1O~=EU%b|nht803g1hfbhenmZmzO0PylZj&B3uc|@imPmT<8S7g znt(CvBCW20icCOjB)qcH%^Nc~!KzDbfmUe^7;)-NhdZaPOM_;_|>RIqyDmgwQ_P%tB0 z(Bu~TXd9$7pSly8sjP2LR_V?(Sr3KI;9j4M&rtqlY7wqtpxpCJdZtfG6}5h z+FH5}3$g>l$7BzT_GgFIs_)}A!`l+jlJJAOYK7FQ;4z!(M3T%HRK0lO7XhMVwvgU7VE-dm4+i&;5Ch-{U)&Nxj^AbBEQitu#i1KLZvGd!S_oo;UgcEL&hb54d+Y0l zmoAOrb8r7IcIv~bfGuxV@#&Jr`_*>)fNJH3G9t{Hqz*4yMC^>~2lgg5@df351qpA6 zwvO?8m<{D-o6Ala(7J3=1JiJO0IsBv7XcgsIg5oH+4ZEvCuAZW(J_WL#i%uB8D^8X z4QuAR&a4C1DVrf|Yd+$uKCSCK!vYAEG}_bw!{!@~MF+lo{;jQgDx*HI4~Vt}X1#yh ziscN=Qh)EuvA!f`y$Go~P5%XZn>v`)nUnYBQ zxK&%@i5-ddkG&h7SOFN_Sp;a`8KCKsZVcd`pZzTuI2;%xQS zPcNjBnfG_Wl)e2&@&RS*>Q)_V7P$&nxfny(P$4(5#Qms14@IMgSaUyRrWDzjsIKyr zr5y939Y=tTgt$%b9Hr(Kg}aMavvi6cov`6Mds+!U0l%bPu0$>d--Z~idof6(VvUr8 z+@27QmKb5)u0VYDeEvZOBdl0`?RvPM0ie7dxU`pjM%WMf-cXO)(9>fxgojIE!4 znSDuD7nbRn(Y2^0V(W~ZF zKU+gu*e^cGt3xy1?87HE?A>l$*c~SBh?YBW-*C|z94-RuQ@De>bn?Cf1D0HP)m?G< zAVCA9T*M{&PGp$~94u2twa^gsdPFxqqp^;h5#{ucB)&`=sG^->)dIW*A3n*%dwFx+ zm~TJjtg^Iy~_0^r2J#Sp;J{;ki?C16B0F$q~g{{V~7t-CwsSPTVCK zy0p^C9E+@h@)yJSaYJ6Qzj^GR1ZKa{25;a=cWR_3aT;xW2Gc)Slh`z6=u^YujA<1Qa~M-pZ(RQGusI!%0Ikr*v|3>AYHKsc zdS#Dn#GMRcul@zgF@oRyX80~dTxU+H+54#PGhTXbGgzHYu`u>C)Po!-r<`S}H~xFn zbhT=04ASK3#M@9lNKgQ@0P9=r%PU;d-z`TfyPNE z1(y9O>1WG|e4w5I;LGa!K!Vk@oX(NfBjn$Ckbp#!Iw!#g1$ zs)X0$Aw8ajQaQwxlWMAQUOdu8e$4p%qPbM+_JB}KZ7djNnFGf_eL(MC4N{c>Iq#i{_zv~Wqa88{jaY7;N|$U0SW*B^IxR=KTlx% zpJzz0{`Ws&Nnr~EYdbSRyZ`R|Yd9d(wU?Jqw_Z(m=(+Vx)f2(i)qsGJi71IN6Zr!% z@PRbM3&(+V^%D(3r=T^qESYIrG}~56G+R_fzFU@sK@knDwGq=coSmY)wqHA!TR!q0 zcd`uBpW42E=#rdnd0w}gww-2qUhmi1yj}qLBf{AY*ko1hBLkIk@a;2^h_i2kKNCKWB|#t2r_3Or+SP{hHTy$k$40$H=?-*b0?9ZF z#*|$fkb2Z7^Jzi8)Mxb}W^;$~1^PwFuw!JPQyJAq^g9BnvgKo^xz#K7D9NV!mu0yz z&exF&T~N*4$gNESewwK>^A1!?0nU}@5e*;Kq!=8ow<=jIOT&w%_Hf}pty z?QlmmYJD_Rys-wEbx2&U%9w=(J*9NdMdD0%rO2J#0|Mn!xf6VOokh1cutx~Ofu1po zMQhsObK4`?(w#V)MAx3#g9P#0|Eu?Kl4w+W^g;=$#&w4Y_A?Q%%6Z2L_OlVN%5?_{ zwsSVLyC)<2MYA)7+cg}}_5kYY1in+ccP-lvbgK{b69&Ur-MJXx#xQ-0{bq^;jr{9N!_ZJM~6&?=H z^cj|(eQXZ_1kYuF);qd`cgFSE={8Q*8|b%qk6>kQ7WNCO&Cg|TH~Y=aTd}_k`>h!% zuis4Rj-K~)==2^0tamJlj^TI`)?1|C&)&ZK;_oWI?EB8gNF~d26hb{H zfsHRYdc;TIyh$&A8tuHpFtCgcPaH^~W$dZi%5>cWqpYC4suvYn?Y-(u)dOKMdQfR4 zip+gPW+#bM)&bH^rszc(#&=SxDhuoK(&{io6(;5dmUu9Oy6(EXno=8lzX?M{tzCHy z^SBbKd(E=yF5>=PFNMGj{ndjz+Z*erBv7xumV^=W6aHxOf};HBH2I!6+$NW-`jeaCK=Uw;q5X8@!Ved$r_?j?ay;GF zo~bY+)9ON`!#gmpE@_(8A3sYDBVb+P8kxA2dVa`>uLKFj@M3{DXOM7GD!&nNV#);O z3qZs}IFNIH;!sa3nfm43LZzvR_fQXt6JZnonc#(5Fise$veRGk-+Hg7*qJj{qXZ+R zG~4Ub1H2Yr;73vB(SoqSg8F{-^#drdnA|2AxC;ZnD28^U;+%Inx1N)}m`1$IM&^xJ z&%^AM=DU|6HU{4r3@Ozv&OuKylRt+`S;FSw-Tjt3 z7b(#)Hv7c}rl6uL^a}#Ts;Eg^-oA*5Oo?c~;`$)Oo zc)a;G7?z!pw@q_ydp0OLCU>YoaQk_bzW#WXZ*rN#ad$=_dJ|fIlP@+J+a=AC|^G%P$qyhx3d)<--BWCVi!+K^$yGN`~CZ>0x8qeHMN#o%Nf z90>IU_&ItmwdHm=d6QgcN zdni)g0vj;yk=NpAw7}Ex8z|3U)iLIfHcLT2O7Eb8WS6I^A!5drgiw4+!mX5!L*y#a zBeT?xFfnMM-!-MZsW^kRHYdduglRm9qx#T64Tjm2BTx&hcJOr`y{tt;kc%3TqRI>k z(uzaID$)i$WsK<~`kZ!-Gjl1ahr+xkm4={6{>Pv}mH~Z2aH41U<%Rsnm4)GMj^2$6 zm(agy$|71D&#F#L$_z@#RfWRX1(8JeJe6RfD!A4L6_l}txlQU_Mf0Ly_=3QIIw&Rw z=qlKglsKdL+RD%|culkiO19dhNYR@^JL<5=lK$2xaAmwG}GDJu1`bP|NQqyiHBh4IkZ+$xP6(!wyvxNGijGRbZe@U9TQP zpcl}o3-k44F)Py}G$>7tV9D?)f#36cz?3^9J3Uc!58~@bFXga~m3i4&?pi2ik)u@h zkC*N!ay%5IC`6YWAf2^ZH8~SABFoi=5haBWhM z)+!@q0=wTy{^d8}QpzEAyAqqxyRoLnH}AT zE(DdT{i@r8l29SkZA#DqvlrC*|w`J(%>A(E=Z7173d!Q+d_ZtpCj=lSwJh<7dU@6EqO z_~OcrwZgPkkRd==->DVO5ufF`GJA+7Hi#x68tg2s!7e=JmKjOXsp7F;Z<_~pF^Y3* zn=XD@Tny3#QYQ`>{JzTKK8pZk25Ij^zK0Bn9M!FnX<{-zp+(Q>! z&-Js_@{W%^L@U^!ZO)ATwqTw7McIa->VKJ>tfRoSg!G#!;??%QignDCiBEP}oQ>wRc;% zEr6L@`gDgWhS^o2I0;+Bo%OSd#$g6zbyQUxl~k(wEqNPN-hZrMH$q)<`8eaG@9W|i zE^m!*{v~fzh!`^Cc^4v$F-&I?U`}+`eKd{aCbW3x|$KVb4k_#Y4oXSb3|a_h-ay z<9uI6!r1Szn$$B123u6ayrd}P@)qDEvt?WthEeCSNM8=3fUW{1Stwyyfgom+H}()J zh)L;RvDAT6uOJ*)H?UXL)kMmxs=xWW&t#gP88X?N@Wr@r$gun+uFu^G8jV4~2li|} zz5r?mf*072KKS=*e=0_fGp9E-rt~oNGpMG3hVQ7oANdaf=Gws~Y6TqY{rH~HB}|LD zgfh&fXum0sw2qJqeV@I(T}Q^*V)Z^D)ovM_>~Xend1Bm!==<<1R7qs9)8ty@kqRn~ zmxICD>iUfx1KnN#ivzP?{P~gQ?o!nmnBq;oiD~V@)esbo$GBU31u{~Mja2sunBjys z0aj~?7^n!=0CKPCK!Lb11P?|>IF5&oC>e-gGlQhoIx_2xL&-AUIkX7%B$gn-WhSPk zbT)e4e@6ED5f*!~kvy;>FfpYsE~?G+uL)*l?P4%aj%>yirKfbd%Gy+NvPqEfersP# zbr$F(Z6EoaBW?M_p^zus&miEVfc)N)kvG+u+zehrL#zsHsUKc_YfKWqM;8mlPazU1 z={_Z4*P%Q`p}A(1krQC{rSJY}XO0oRmt1Z^$hWvY0a&+05nv>NfKNbuZ1X!ZcH!Gu zzDGQeJv!zetA#f^<{z(xHwp3mHjZbdx5dzTUZa*-&1-`ypBc-%whgrE7m+HTaZ5ec z4Q+RjpM>}%fkU;Vk-GV}=i+-TW?v?YtHNKq{!P(eoGPDH%iX4p*Zn_5-|#;c&3OHz zqMs22yZvxH2d{JhMo;hg^Jqb$dZaOq<*z8-GIv;*F(s+FkNQ++AfG&6ZfI|80$l;r z_(pvpx6})i;w21!mwe?jz4{ey=CCts_>-XA1SRLCr(-h_|C~Bb&qGzXk*Syb`K>VJ zp|J_NuLo3&|7|sD)E1_;Svncjn8?)j55aXIE4~hXYKk=VWSl!>Y@g`a!<~4xKJbK< z4t(Uld!>)M^i<3OY0Uk-j(sTCHY_*WZfS0awt7CM~NyoNr+a23U$F{$m_rCX@KK;G- zu03ju+COTJ+O=z}XFdyakq0d!3ud{tkt?b zsv>gr1@*E*AA#fZFFetU(G(3Rp{F8-slkWnE2auj@%DNB4be+imxKc>Y|TTPykON5 z)O2yu5mxzLVy1UJv%t3dj3B(hBDgSzZn(yVT&P>P$nlq%T&BwioCVQ~3-MsmLjm!j z^~VB6e6JAdl@#;VeJ$zg&s6NI2TU3~2#UCSK$J1}!u-`4iW!=pm$E-gr(*^7w0t`8 z*9OnUGy{885D{VVj6?yfLXa_WZtHSR&$Y0xGvs&B4sKGCXSt{f;Ep$EH(`v7sK}Bv z44P5P;+7USVB#(y?2RWd(2UHmvVqr*&eY%d{Fpg$XrjEuBM3xs<8540T7tRey*8@q z!dAO%N*Q>q`lhU@oKcNpagb!qb1jBBNvdg)Euy6%5wu57C;ZWa(A1{oF=01P8h94R zDcf91fX-n_AJd3oF}hZ?WD6#G7R)+6alP}DRWTNSIPba>+AtI3{*W+H0f9=Ntamnog}XlVBcW*KpNjZFJ59Cz-h z+aB51s+36XIg{Z1^_kL_LMAgO-y*!Y z)4<0IkIOs0`mEW;E8$H02`i)Xyz{C}`PYO?Z4>fc-O5GX;6+^sU%F)XCOco6xy1?j zurE7(l0#!(tcpm4xVa5<^=yt60*l$|*4FXYXzeBq$9thXh$~JLt&VVqOm7;5Aj-!d zVpm;57p`i^`MjY3Y@z0*yt=ebQAe~hqjH@F{6&i<-pNP=?)DYl!hy{?%Q2V;mn$bD z)iB51=iNvfqxY+WgiN{TngtCTG16OGVoij5n z;M|B}_MFVGZ&cX~#y6BLy$4^il=uWlZbbKN#=U`7z3rGR`-(UB_wdIZ5lzi2Kon|F z=(!-VGNhk3Ykuk2NpdVg^@i(A>_YfW&!dfFn*`}ylz?pR^!1wyHz>^?eAQ#d8kAws z9>(g%wFA;&V~m{4kC(0}*cDH{#)h_-sMMSnv@^@Fsk*#;LyI+btB{?DF^#KP8prL= z1@_tC$%=^e3C0;Pqe{5iP1Wxq47ag^!^XH6m@0O}EOzD5!&7c^r?i;dimv`zc2R`i zGyz$nD7?#>>R=O0X0J+RuiC7A=X)<0?yF7<+a zF~GIUr45C?t98?&4acU}GYi4B+lTs7Mi;*ul4~zc6U6#}&jajv;Q56Q_0HW6sTX3z zB~e-wgdG!p-}eW|ihgl>KK@|f7ZRHRiVK++6q`X|H>NkV%D&DmxChrZyv)9h9VN`( zFBiaG=mdlNVMky&Zebpko2d^7FPM7$3>R$v4=r}vE5slhXxJSL1zQl?oG(G|KgrlP z_j6!65qU18FQs3kUcft%T(>*>@x3Hp{PEEcV2CmhYuq#!`*DPj2$bGoVyQdOOY%aU zhRK*oWt;Mbd+5dy@ed(m$;Q#S0QEof;zcUzG*!9t@Ibu2BRL@h4@aI#tP>7Sp zP>9n`6oe(u{@%OSZNFEj%c57T%cfV8OAJwTd1|h0Dw8%h&0&m5%KUAOJ-5p?0Ew=0 zO5bs~d|SR1qAd;4WkrofTV)y|3Fo6+7MpNNS8SaCSIKFchjh5e?sEuytpRB{ zY>;qPbmqLvZ&b2=Ow%IBY*5kP$m5$7Ik^oGvB9H;Tft}fn_3ah4ucc;7tNh;>qVKG z?(uiZlO&JMu}QZezvbr=%H}LYuwppmaWP79`_rFGc_5hmu$25^&et&medXb2*}9E+ z1M7|@712%ZF8JNT++24%SwkE~nLKs*)#Z|85kFU!lh63 z=z%5kT~%QoJJ3jWy=nUDnrEJ+Uz#CntzL9mZn1Y|+1BP5-$?78^(?48vVF4ejIGKu z;z^%C;Ps3n!{=qV=NjTol_~x>`E{=${Q~G5b}kITf_+l>hVdjYB#FYndO%Z4`vMr< z{wJz^7ovSuwFJHfk?S~7j zYQ}VVfNnR}+AhEeTUoMDIM4~aEMWpvhZ}}F|I{wU3EnEnrOSP~*{t-JzkIR!dq&@Xo;=Z6qIU{_Ec9J?ahc`spb|ak5bII$OhYRQq>x z0+Fi_I(wU!QOx$Xomjh!Zjda^buhLD9Y)C|Fmw7rdbb`n1B|@ZUuOa4Hk_6iGOi?| zhsL?!sUka6Vhm9p3pni*MM=zvRQ)&b1+`+D330a3Ij*m?cEVVqKbgKk4EBg{!WRgG zDUOkIhU7RB`|kBhzQg=gzeVGW?Cp;Q1k}X%e`Rw1(9#mI`tl*f<78s<-;FoUD%OrD zDyTk*v_XPPGoJQT^1hrDrB~%noDVs$JcsJa!t1H^WHbRzCYbB3<3d~3b#<7RMJ#0 zYl7i8bF-l;&D_92#usDif@_B)Sc(iF_qW|tdfj0MnUDv~a5b=6vWP;M%m>)of}x<& zB8{YWuAL9DRP7aeU9{sCN3Tx9$2zFT*|@xfQ#e%G^0!;U8&xo&xATv8f@!Sux*N)N z&;ikhIM>8%%w|}kg?95A2WnNLwAdL7T$W=vFzLGeH8ANUN`~F?tpQ4PUrY#9SWkqg zNl?PfGRl_U;I_010v63j8(vtTUC1+Qgcd}>Vk6@*pfzg~=^XZ^>+A|64~h9wn{?NU zjl-h{zoMN;2Ondh36TBLa6bZkVg@Z@HYO zU75zQMEO+O}~^m8gKklN;;im`Nu9GW_uTS^}fXFyD4ksEicI$wr632S6J6=%oH zfiiW%)Oj@yNbab6L2;lhJUklgqgSxU04(e?SG&K1N7DD)TzPgBa3w*;dSW*%^auE} z12?q^4>i@t3@=Z;4sReSgJWo}a{UO;h6A%VU63@W=u=14CH9zSu{E(;)Uw=-VT*szNh zP>`UmdN9P9A7`MHYF%o%X%ntxl6z2IVrS){`Xk{<#l48idPW{2qK!7gfm{fl6FP<^ z6`TB9g~D>FM)BmE2w!&08j{KvH%Eu|og8Mtqpv3qa=(JN3Un5Vq+D7mOnNSYlwxs= zxf|3Hab}4*hK99R67AZFu2L>^dhbkwa4y{D8EsWzlU}SmdL|=01m1BjXyJbf;bSZ} zC2*jU`s?Ri&^piHZxyAwGbSeuk#RlZo(Y3t_S_K`L=AhkVHAeHO53;$w z!?LLgw*k)tbV1S2ipyJIO%E4F_L1cU|C$R`QkasTbad;8eyHgf`cA@ThKFPMlORhp zheX>BD$w6ksTU7smCwI5e=8dNtlYnq&Cb#Q$~p=ezFJrxl)GkefME(avi1TBovmMf zP1L86{@V5X(%^+qdz;bi6*s4&=SqdBmA16lkb!@#mf3z({^kSo8^M5~mye*AI9#f4 zU!uU&a;#fWxtdQ;B3a)-vB3%mC-V-1RVQLu9^Llr6t>H36${2;1naFR%2dYS2GLY} zD1Oq^;%lgbKnd;Zy(@7~pU#F5ncY1yJjBB<(Ub2+Z})X@tJXN`K?8N|(h84@3zR;f zcy;)D$^{C)G#);=7KO94-A?SlOEyb;*u*D#wq2grj>j-Y#DqP7qIm@)TypXEtJUc_ z4xo%iop0(P7qTXXUqX4Ig#IE8BRgM-^2&ULlLbJ=hJ?Q18;c{Fc#*A_T55Mk zbR#poBK+ksvv6=B4nTo`RzAcK|M%QC{y%fy$|mYg4hA-kRt8SC|JEOjns?V%?#F|; zI5)j}AS7WqER46S-1QdKC zD>5q*Ua1G>Et;S~NIf#Is0-&Fmmc_@ouKp}ouIWK{2u%s-5!)6@1WNp3MdFj2&fH0 zUQxG{kED`Dk7Lk2R0w1UlsF^?Yicg4&A&g)OpAS*E}gur1id43N(+LD^p^aWm~d&m?&8 zgVgHwpof2Hw;8)~jl-npUuyRx@A~`Jq&iD0@gl-SMetoT6d58s)i-N=vEiE8LZv>3 zfR^L89#pC5$hNLuGvO#awW?`uSGKDimW=v>Ui`M=xF@ule0X$ksgjf*kWN={3aDVz z41tIh)}2e^qDSy@;m+I+ZJf*EPKzraiE|;(&4i*T$FsW<ZQx~YR)qgtB_nGqd}&T?$k;>Tq=SJ;6l@Micgjz`Cdl3M6Ix^#7#L- ze5CjF7qc7yq0q~avqR&%zZ?h1Egfs`MPvGbYsZ;&u}||FE55qZwh2>aYR07OB#W$C zy{U4|=kf>%9!uqvUDnc>lD3lT=B0^g?l~FV@um8i5(c(8p$e^WzBBag5xhO8WvatH zdlosxb{(hN2#s6!Tf~_#ZOQLX={Ai;EG3tuzTgy@fd2I6fONUzc?S&@-Fj7T&dwu3 zJwU|Xq{{Nm-qm4^4Ot<-BUApu@WgRl+QM-e#pw|h`6@lyNg35~pl$adX*@vPKA1M4?K>Nr{y+lPyJ>6#rh)9^)fF)WXDWO_-D{ zZ<3yxT|8B~JWo1VtHMzEo~`=uoSik;T-fTe71@Sb$h)mcro)@DGa^eh!B=8GaXy^7CVYnMZ zXy?{BbrX50?`CGpiyl7g(|f$*k()arH(P)^UTJz$%6^ybgmnb}_0~H4jbZKAG^?J# zY&g0v_;xI0&SM}p>|0Kg$0zL}^8>1{inIF$$6539x|J~5^fVvoYE?Aub{X4QHWMBl zUh5mvig@g#(sX5ZjxbP{g8nDR)v8Qtm%tjb{SoW8)2wW|Zui~Zc2 za(gC@CXUvP%8qe-KB``&1ra#w%`{xj(VcwhhNv^|&6{E~^>?+TT&V@1jwr(KO80s* z_--je5eQip$%~b7nneB4A8$UxHM2K>cjAWW6>wtwlnhMe!UQ4{XUGx%V-9e`C`{fW z7S1<7-WG%E871qb5ND_=jiG`q#5V!r!{s*6Wc<%tnl5ifU zp%=Sn5h?>Ff+0fuw);-^Nhqo-CV~M%(ze`A_6ZVT)rdDzhob*=0Leu;Ty~&$DG?O` zJ4Qc~q~COh`>q+lYlUl)NzqR-fZnPbZauJHB`$SYblH3Yj`e+DzZ%EH>4!aEtE48> zPV9-|v_mA$B9nPJvyE{kgF%B~Q5c`5W^a^ub!xtf39gYIVfoU)el0`7JmJpN2~*7k zvyG`9>1D|!*hzKvF&u+&bi8Vp8?0wrSt&Yq?F}=wo<^!Taz4*ORKXZK@&3>PdGvC8cWF|6I zPv<;{1(`5q>u&GrWfkn5b^}{u7@KI(w$h$;{6!RR!#05v+vTr&5ClD(udvU9Cqjez zdI;P19~JjO?dvKOqbQzRH(8Fus>-$(o(&zooCPVe!KyYr>T3lPUpNE@h>Ppd-mZRx-ge!R&)RuZc{~rhGl;3@hbTmmKyFc5ToMOwl0|kg zv2L0~4$%DY+xZc;P=#7qnpwgz>p3_l)gE^12Gh7{&71YMZ`I4QSo}76v#E2U_O8!M zc^#v*;QOy)IG@`ClKzjjFev!{ix6P`e}uru*7)D;U?wpF^1Y0R{TpnO!hz;ePhSiT zECYie#1N%P3!sBl(MnOuhEyc;hKe6FVbPF52>cMfazc=TC%W=KuT7rwcdiQnNsJML zV#00i%t|5~;u;EFl=%>mj+QUeG%Kl4sWmXExXVH==lD#6jzGTRC}DX@{}_MQs_hTn z{F2V4n^dQL$S%hn4F*%`mADc%RXv`L&3xTGXoz_m*;6D zMHv*r+rf`P3QWThhF*9)-+wjKDOXP7-F!S3LEzt?oc|v}&VNuTb8CYyCXNjD&L)md z=C(HUb~a!7m7@ga)G&Q3JP)^ZZ3t48OV3PY*=BU|mzL+}U>aj%eol|(tx%U2<7BHG z?bGEc#3hmLk>P|*sVG-8enmdAkSR?SibUQcJ8a!p6R5s+pKzbpPuqXYIDgDYlK4X5 znf;O3Bu1|IM(1eIo=|ScpJct0Bu1k#xMJEmomfQp)U{Z`dAe(wJSvsr%@XzlF-NiL z4J$S?sAw?$pcFJmvK84!7Jyn2dKW(+!k}KBn@N?>_j8Yvp&x}M`sM)FXRk?@rr0*$hj1R5yUnT=u=yk z(ici{e-BNw6RK=!%N@L%ia@cIFvCz~5o}_F9R3`j93ma;Spy?T&10*#K139A#-BJd zPMh`EUIFke8``(YX@f$_MHAUT)1)Zm2^djr8WHyKwj6P)HD84e9Ikfe=vY+}wg+wnWy z{P%kCe;68d+f07Sl>ORqmBW|%-AAhe)T+J3Rcn|*H~+aoZ=-W(z&}&Pe|-^ z*-BVdL(@g)4heon_$(=|dm83khSQC?gUsOJVnxD^&KEhS!hzeo^bzh6d zEJ+5Ic!(MRI76CydOG)w*0SA1bL{H1Exl>vo=Hc00$YYJFxV313z{fbQyR>kD5_r1 zcQ0+a&yqwHXj@Mvs|q<~m?fo@41)b^$~xk=a4(9%se47mpRLJ`O6*#(Z+$oA=&+A| zy1~dc+Bf1KfwOXK`=GqFg`l%(rcT{a;MZ-QtMb0U#4KmI``wAV<#f*s9+-*mqd4)2 zx>9&#Y-QTq+-02;@SY35JGOcG`}@GcZ_W`0>l(R1lJsKYb*CyuMj3eFp0E4UF`e;+ zEE(zFHE}j?ztb7#9#=(46n;2ut;Tk$D=W{l;<(;!=jL$M?26pQ>u5JqyLBffqxqs^ z^+MgXWdLbhg$|E~jWIGs6X|n{F@Z1|a`h{9;WHaE(tCrt$$+Dyqft#9hp(KW81c_G zSNBbCyy%XOx22Z1)-a?c-C#xj`T6-$HBT)MM7@(Cw%UrT#1a63il#dM51Jd|=kGE- z&8w@6^&?;`Z-GfHdTOzU-3$}Iz8Fi4Vq0HL|3Ftv@wqU|!M_xdi?@P4fEbVOn7ErT zFE~ycm&2i>tW;DYt1jkAzPU*gRaETnM?n`)o;8*z=X^7NqWk2s1?Lert?%Enu<>P7 z_1%xi=k+AniP+O>!$v>AUiJ4TFmWu8~k6PiOesGstMCHsFn1Ci=dS;xACBIS% z!&`%UM(CUYq_;>`(;rpopyHC3oR;=P@wWZ3Tx<(>JE%diuPJ{IkLGo+xcKc&D*uOP zO?C1pifG7{mxQY6wzjIvP?x(s34HpMH`R+zoyv=^b*3j-okM2Z^8`81=4a0%F&^qUFdKYV$^ScNz3}= zY1B6V+Cz6VEtY}1s!u-qq`|@v!J^X8S2)VaePwq)o>?d5OTT935cghNk}6rk-pDkT z5}S*r-#Sa>Bi!wTZ`4$^=tv@D;LC%c65U?|Ne zc~us}>2F%|5M=1wwvTL`)%w|}d1OhWF3pJ0VLgtEC!xKM8qiMd!ga?purw%6lgL9i zsIDBl>|5{rB5%NlEnC~_l`PNpV zEe%!nL{^wJgeKpRj4vDZWKDk7{N(&>RzwJn*cYa`1u*z&sKaEL^;vt+vP%I=(Y$B$6COtGmcNl8h$LKHA?V)}dfhS9xapiX^c{OCTzzWv;X2L@pNuEUiTHw9(o z*^LbWxXt_LsioQ>V+Vs=5#~@PRwrX)V{dP7V8?7bXhOL7rY063U740vMF~g?b3yhM z&Mu6_Z5IZRS$&6#EF=<9IC%J+i3x+T{ORauc>c_HnqRnbYHCS?JK0POl%JcMhxD63 zF4$GsQqcW8fuw<0Wj)*12L{BHRfD;?zexlg9V;4S%N1$?+i~JTwt|BzsLY|u)vYKh zqtv0E{##0 zbqu>CcJodzv1$4pxa!WB)bi@+JS7C9$!GFDPG}-r6~P>9Z&lpeJ+=M$ba-b( z$~IkVS)3yw7@*BBG~eK!*b0F|^It zX~K38Fg)D95S2atViZ~pL2vR5jBVqfK=~ zmKoumHl;M99zA#~bhMjJjX|ZNLSby|xSd`Jc2evL$5%qL_!qj7d+;i$j%AL&X`E3vB~QqioA0T`ZV=UH&=rdFdwni0sQuP_ zV?kh%9bmI2Hl8=v1S~BnTBmt*r?V*Z;#y8ASPd0!Qu8xfB?lz%$J7{ze#sr`vNKXD zg}ww!3K63r>x@0_5@t{eEu`Sm>l^6R;`-Cv)1hOuR8)t1t5|*mmkz?#*TGW7T=T%G zI#!VpR*e8^>TDC-hXI!i{V{Bm$`?ZcOYKri)A3~9N`#fkF)Cl)&Z7G9w>RNq>9ryQ zA$?YsoSf^sxPayh8rd4=4l^!BpzKP-m^fbzyJpr=DT&0I>z z(ya^t&ATl>7A`*xoNX3=lig1PjyjH!B-5lLIX5W7li$7kXZkd88R zyyUzyUFY+UGnW?EL~I8Xx0Q6zG0pma9izNfiiB@cdQ7{5K)Z>*eP6v&_jdXQ^-YMa zgIjFJnK3IfgRE&{<~Slk??XcHQ|wo2n+8|f+B|HxdmC+fgAp?LV^Dg;JS_VY9!cK* zQ&PCc3Sp^?be%xCj1MQJp-uu?bPKe(ONor`>0f2*%>As$9YZltcXF9h*_Nt*t!p*D z4)NBYT8T-#i7|$3al?!I;N|8Ob`I_&$jv+5TdoF;h|7{dg$f62)YT~|v>5n}$T`Oq zJ-CX^R9!pWJJvO zBK+|&J@;*ewHif4f^$?rG~^*Bd>md}3U3t`R9_n~djd)OGDR_cNc`4&9ByI>-@(Di z0ZTcg4^_@q72#K&NF{!*X7oc~Aysv4w6vb7-fSA1w+0#_;)4CX{a{26JnmMc_+pK2l6} zG8}fYT31jIlfs_?N5tQ1QJz6MJP`4*sZPINfBpQhnImvwc+k`{8`TY~^-52HJxVPTKu zf7H6PgI53e68E+;1RzWj{Z8eGUxouvWR!=i*P9v;t z@m>IP+GqDSN$r_)mnA(14NcE{?Tg}PQW5U$XE@(^rL~_8rs_EGvJp;cG7FRV_%rAsfZC)1rCO*nDg6q*J8G7 z34u)-)=xs43c$Ix6dvApjooHME7K+YA_5+4JsKH(c+gpbwFwLDvxgkCqxBH5-cBtj zNcw7_^(eZ{1sb^cxVAL!rQUR~rhMucFcqV1qS^eIwnQ4vm40r{wW>11P0#qgMp}$b zzeXeE;LRKE=*AWUjmjSppE(x)M#^~=8-E1;_A|ugSb)B|y%ZMqy)$*(2c$SBj<9p{ z{RSMCZ9%>hXu!6(Fv3WpznnCR>=P{Qr!nazzdXF!@Tus$aP_2If;>!6T%QX&8N?>1 zHBytOODp{n53|*uZgZ3uE|vK|J;cBV5|3ef&ZfU6LZIFG-3&0%?9ryrSaKbbNLYf| ziaTT%#kw<#6q*ONpObmMW5p>%S#v1!kB}}0u&rBiF>l45`OiS`RIsoz;*Pjhg}JO2 zT-ZWG`~+@;k{5u1#vg}BHmJ~Ne65S?^Z5pKkM*+snoRQUceB9s-b_k;Rn4b}lviZX zVR?K49*WKW3J_GPO7WE`59d~5{VJHE1J5{g$jn>}&BX{hKx<%(#0hQhGeW#VHW49} zH6ibI)V|fcXkK)UU}hGAe-?=f#lJ)aK@X5cc zd3R6#=`+5DF;V}}Y;50{pU4FxE18Jy2FLR#hW-tUTgy{(nWL21r+-l+-8yb`N)RBR z-jCydr$&F&ko=n({nvE1znBr85|r`>GxB~HCJf38psi7tMM4x*L`0?DdyxnYvoe5* zKm|c&hoY=Gz9f_|sih?js86)(6O#f~QvTfc88{bBb7~u)92zRMrf!*Q{B)Scay>ET z$#UQE{0r^U+m+GGlod$-qUi)^nmLJFB~W{5KO90L7i;j!0Jx5_0T8Yi>p8|C2vXO#uVAjL6G{%SI1LZk-M~MC3~F;vX#Gh{pr>t_9)C+X zLj91qDqmLxvWFtu7uo^+kOJwY6nu&}@xgo?AJj!O@-t}y;fp2PStYx?_{9pZGpN7t z-G~`z8MY>JKrREJ_qVj=N`Tdi6+q1(g>A(V#$h1Vn4p?u)iH15g$g zM5fWu&t3S9LxSpW6kf3YY7i#a{?@!z`*3kc_K@adM2p|RJqxAdd4s?;&bAgzZAB+(6M02`9esU&JrP> z1?avJzevpyBe9^GCLiVutu=wPA|~1mf7QMD3finnXy%TfHkggWM1s^L@HK=0wnkyq zv5^l5d%?}>qx>t^>}$_}PtkWCTt{XC&`Cv)Aqs9omLn2?PV#~E zSAIss(kL>r;sqGaD8E}MGAJslMsVUNoJkxC{?vn+{`lD-uY>Ye{d6Ivn5;}2O?AfQ zZS55Od0ef`>mUsb<~-OMc8fIaR>4(i3Xl}$7O&hf;+9g4(gXF%jEvpjT{Y41M-Fs> zMW91Dm54gz76vpb9s#6+JxnF1`D&)^E906}QPMDa4g!Tx;?rH(mQk>pEgp;!kxes` zSYJ6J_B_V4UM9)yjQA$oDjJLeqlN^1cWDm=I8b_ z`1#CNb89_Xw;&Vn&8}z-uZm6QOC_hNFgc6o;$543k7@x|TlUp(%pa9R(myRFNQ9a4 zUB$}XY9N9MFCQ`4YdebkaS%C~wC)*L8c+_`aYl$`eEh2^yp?H9nEH-mCZ1XjQ&)xfO~-t5S{ z4i{mvi+u~5UQ+Vpv6(t0Oj71&zEoo8<4RL!`S1;t)aRT{s9LV7y9bqxQ2{gzt#srv zgj#yrdqvx%Wy(jY~FmF9a8Hecs*yMcT6| zLp7b(Y8Mx(dI;8iA#e8-)qXKqNB273#R;J#krldEN2QafHhr9#Adpw@Y0@kYPn)w0+Y<86I+cR`*d(IQmbEgu#7Yg~%wqx59M;_z)WxrHM zU;NbX(O!;wylIAk%sFkoQK7%Lm3EY_`P2_fvz%4|b51F*qdE_yJ6UqObx6@=A042g zo#i4eE;FMf;R^;PUjoopnM)h=5T|8|>e}YH$v5iTh#sHC3=RObkr`nLQ8zM*w+D-} zvq-Mrk3xAKhm#dl3W!KT=b8YLn`dXLs;Xxhe&*e|J;!>@(+>LP7rfp}<11g?|4Z-z z(ECi1{K2Xk|HZ6;KcNEsb8P5;&jkHzZ0JAjf98PxHAGZF`k$BnKFRa1p`m{p-^c0y zT>9Gx(ccmNn)vy?fc&8``6t@%njQbVB{}kcp#84S_dCd6 z@*cmJi~bcj{o6!7#M^)SU4M#w{0a1X71clgH+Y$U0R4Zprhg*+o__r+Rrt4kR{RIj zf2hIw6YKYcWDsNebCUz@4FZN=h0LH)6{`V;PV-}28_0bui= c;QpqJ3esR7p?x4A#E(z-hvQ*$`s>^O1Jer3 +Maintainer: Michael Goffioul +Title: Java Interface +Description: Provides Java interface with OO-like Java objects manipulation +Categories: Java +Depends: octave (>= 3.2.0) +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net diff --git a/octave_packages/java-1.2.8/packinfo/INDEX b/octave_packages/java-1.2.8/packinfo/INDEX new file mode 100644 index 0000000..f007672 --- /dev/null +++ b/octave_packages/java-1.2.8/packinfo/INDEX @@ -0,0 +1,30 @@ +java >> Java +Java Interface + java_exit + java_invoke + java_get + java_init + java_set + java_new + javaaddpath + javarmpath + javaclasspath + javamem + javaArray + java2mat + java_convert_matrix + java_unsigned_conversion + java_debug + javaObject + javaMethod + javamethods + javafields +Dialog Boxes + msgbox.m + errordlg.m + helpdlg.m + inputdlg.m + listdlg.m + msgbox.m + questdlg.m + warndlg.m \ No newline at end of file diff --git a/octave_packages/java-1.2.8/questdlg.m b/octave_packages/java-1.2.8/questdlg.m new file mode 100644 index 0000000..31a127d --- /dev/null +++ b/octave_packages/java-1.2.8/questdlg.m @@ -0,0 +1,81 @@ +## Copyright (C) 2010 Martin Hepperle +## +## 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{P} =} questdlg (@var{MESSAGE}, @var{TITLE}) +## @deftypefnx {Function file} @var{P} = questdlg (@var{MESSAGE}, @var{TITLE}, @var{DEFAULT}) +## @deftypefnx {Function file} @var{P} = questdlg (@var{MESSAGE}, @var{TITLE}, @var{BTN1}, @var{BTN2}, @var{DEFAULT}) +## @deftypefnx {Function file} @var{P} = questdlg (@var{MESSAGE}, @var{TITLE}, @var{BTN1}, @var{BTN2}, @var{BTN3}, @var{DEFAULT}) +## +## Displays the @var{MESSAGE} using a question dialog box. +## The dialog contains two or three buttons which all close the dialog. +## It returns the caption of the activated button. +## +## The @var{TITLE} can be used optionally to decorate the dialog caption. +## The string @var{DEFAULT} identifies the default button, +## which is activated by pressing the ENTER key. +## It must match one of the strings given in @var{BTN1}, @var{BTN2} or @var{BTN3}. +## +## If only @var{MESSAGE} and @var{TITLE} are specified, three buttons with +## the default captions "Yes", "No", "Cancel" are used. +## +## If only two button captions @var{BTN1} and @var{BTN2} are specified, +## the dialog will have only these two buttons. +## +## @end deftypefn +## @seealso{errordlg, helpdlg, inputdlg, listdlg, warndlg} + +function ret = questdlg(question,varargin) + + if length(varargin) < 1 + print_usage(); + end + + options{1} = 'Yes'; % button1 + options{2} = 'No'; % button2 + options{3} = 'Cancel'; % button3 + options{4} = 'Yes'; % default + + + switch length(varargin) + case 1 + % title was given + title = varargin{1}; + case 2 + % title and default button string + title = varargin{1}; + options{4} = varargin{2}; % default + case 4 + % title, two buttons and default button string + title = varargin{1}; + options{1} = varargin{2}; % button1 + options{2} = ''; % not used, no middle button + options{3} = varargin{3}; % button3 + options{4} = varargin{4}; % default + case 5 + % title, three buttons and default button string + title = varargin{1}; + options{1} = varargin{2}; % button1 + options{2} = varargin{3}; % button2 + options{3} = varargin{4}; % button3 + options{4} = varargin{5}; % default + otherwise + print_usage(); + end + + + ret = java_invoke ('org.octave.JDialogBox', 'questdlg', question, title, options); + +end diff --git a/octave_packages/java-1.2.8/warndlg.m b/octave_packages/java-1.2.8/warndlg.m new file mode 100644 index 0000000..8309c4b --- /dev/null +++ b/octave_packages/java-1.2.8/warndlg.m @@ -0,0 +1,36 @@ +## Copyright (C) 2010 Martin Hepperle +## +## 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{P} =} warndlg (@var{MESSAGE} [,@var{TITLE}]) +## +## Displays the @var{MESSAGE} using a warning dialog box. +## The @var{TITLE} can be used optionally to decorate the dialog caption. +## +## @end deftypefn +## @seealso{helpdlg, inputdlg, listdlg, questiondlg} + +function ret = warndlg(message,varargin) + + switch length (varargin) + case 0 + title = 'Warning Dialog'; + otherwise + title = varargin{1}; + endswitch + + ret = java_invoke ('org.octave.JDialogBox', 'warndlg', message, title); + +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/blksize.m b/octave_packages/linear-algebra-2.2.0/@blksparse/blksize.m new file mode 100644 index 0000000..7162fc5 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/blksize.m @@ -0,0 +1,25 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} blksize (@var{x}) +## Returns the block size of the matrix. +## @end deftypefn + +function siz = blksize (s) + siz = s.siz; +endfunction + diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/blksparse.m b/octave_packages/linear-algebra-2.2.0/@blksparse/blksparse.m new file mode 100644 index 0000000..c418a52 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/blksparse.m @@ -0,0 +1,114 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{s} =} blksparse (@var{i}, @var{j}, @var{sv}) +## @deftypefnx{Function File} {@var{s} =} blksparse (@var{i}, @var{j}, @var{sv}, @var{m}, @var{n}) +## @deftypefnx{Function File} {@var{s} =} blksparse (@dots{}, @var{mode}) +## +## Construct a block sparse matrix. The meaning of arguments is analogous to the +## built-in @code{sparse} function, except that @var{i}, @var{j} are indices of +## blocks rather than elements, and @var{sv} is a 3-dimensional array, the first two +## dimensions determining the block size. Optionally, @var{m} and @var{n} can be +## specified as the true block dimensions; if not, the maximum values of @var{i}, @var{j} +## are taken instead. The resulting sparse matrix has the size +## +## @example +## [@var{m}*@var{p}, @var{n}*@var{q}] +## @end example +## +## where +## +## @example +## @var{p} = size (@var{sv}, 1) +## @var{q} = size (@var{sv}, 2) +## @end example +## +## The blocks are located so that +## +## @example +## @var{s}(@var{i}(k):@var{i}(k)+@var{p}-1, @var{j}(k):@var{j}(K)+@var{q}-1) = @var{sv}(:,:,k) +## @end example +## +## Multiple blocks corresponding to the same pair of indices are summed, unless +## @var{mode} is "unique", in which case the last of them is used. +## @end deftypefn + +function s = blksparse (i, j, sv, m = 0, n = 0, mode) + persistent chkver = check_version (); + if (nargin == 0) + i = j = zeros (0, 1); + sv = zeros (1, 1, 0); + s = class (struct ("i", i, "j", j, "sv", sv, "siz", [0, 0], "bsiz", [1, 1]), "blksparse"); + return + endif + + if (nargin < 3 || nargin > 6) + print_usage (); + endif + + if (! isvector (i) || ! isvector (j)) + error ("blksparse: i, j must be vectors"); + elseif (ndims (sv) != 3) + error ("blksparse: sv must be a 3D array"); + endif + + if (nargin == 4 && ischar (m)) + mode = m; + m = 0; + elseif (nargin < 6) + mode = "sum"; + endif + + if (strcmp (mode, "unique")) + summation = false; + elseif (strcmp (mode, "sum") || strcmp (mode, "summation")) + summation = true; + else + error ("blksparse: invalid mode: %s", mode); + endif + + if (m == 0) + m = max (i); + endif + if (n == 0) + n = max (j); + endif + + siz = [m, n]; + ji = [j(:), i(:)]; + + [ji, fidx, ridx] = unique (ji, "rows"); + j = ji(:,1); + i = ji(:,2); + + if (summation) + sv = accumdim (ridx, sv, 3, rows (ji)); + else + sv = sv(:,:,fidx); + endif + + s = struct ("i", i, "j", j, "sv", sv, "siz", siz, "bsiz", size (sv)(1:2)); + s = class (s, "blksparse"); + +endfunction + +function ok = check_version () + ok = compare_versions (version, "3.3.51", ">="); + if (! ok) + error ("blksparse: can only be used with Octave 3.3.51+"); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/ctranspose.m b/octave_packages/linear-algebra-2.2.0/@blksparse/ctranspose.m new file mode 100644 index 0000000..1ba6ab5 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/ctranspose.m @@ -0,0 +1,28 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} ctranspose (@var{x}) +## Returns the conjugate transpose of a block sparse matrix @var{x}. +## @end deftypefn + +function y = ctranspose (x) + y.siz = x.siz(2:-1:1); + y.bsiz = x.bsiz(2:-1:1); + [y.j,idx] = sort (x.i); + y.i = x.j(idx); + y.sv = conj (permute (x.sv(:,:,idx), [2,1,3])); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/display.m b/octave_packages/linear-algebra-2.2.0/@blksparse/display.m new file mode 100644 index 0000000..98f3a18 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/display.m @@ -0,0 +1,39 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} display (@var{x}) +## Displays the block sparse matrix. +## @end deftypefn + +function display (s) + printf ("%s = \n\n", argn); + nbl = size (s.sv, 3); + header = "Block Sparse Matrix (rows = %d, cols = %d, block = %dx%d, nblocks = %d)\n\n"; + printf (header, s.siz .* s.bsiz, s.bsiz, nbl) + if (nbl == 0) + return; + endif + rng = [s.i, s.j] * diag (s.bsiz); + rng = [rng(:,1) + 1-s.bsiz(1), rng(:,1), rng(:,2) + 1-s.bsiz(2), rng(:,2)]; + for k = 1:nbl + printf ("(%d:%d, %d:%d) ->\n\n", rng(k,:)); + disp (s.sv(:,:,k)); + puts ("\n"); + endfor +endfunction + + diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/full.m b/octave_packages/linear-algebra-2.2.0/@blksparse/full.m new file mode 100644 index 0000000..b6c80b9 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/full.m @@ -0,0 +1,27 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} full (@var{x}) +## Converts a block sparse matrix to full. +## @end deftypefn + +function f = full (s) + f = zeros ([s.bsiz, s.siz]); + f(:,:, sub2ind (s.siz, s.i, s.j)) = s.sv; + f = reshape (permute (f, [1, 3, 2, 4]), s.bsiz .* s.siz); +endfunction + diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/ismatrix.m b/octave_packages/linear-algebra-2.2.0/@blksparse/ismatrix.m new file mode 100644 index 0000000..6bc6b8c --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/ismatrix.m @@ -0,0 +1,20 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +function yes = ismatrix (s) + yes = true; +endfunction + diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/isreal.m b/octave_packages/linear-algebra-2.2.0/@blksparse/isreal.m new file mode 100644 index 0000000..af7d272 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/isreal.m @@ -0,0 +1,21 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +function is = isreal (s) + is = isreal (s.sv); +endfunction + + diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/issparse.m b/octave_packages/linear-algebra-2.2.0/@blksparse/issparse.m new file mode 100644 index 0000000..d599007 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/issparse.m @@ -0,0 +1,20 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +function yes = issparse (s) + yes = true; +endfunction + diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/minus.m b/octave_packages/linear-algebra-2.2.0/@blksparse/minus.m new file mode 100644 index 0000000..c14f95f --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/minus.m @@ -0,0 +1,40 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +function s = minus (s1, s2) + if (isa (s1, "blksparse") && isa (s2, "blksparse")) + ## Conformance check. + siz1 = s1.siz; + bsiz1 = s1.bsiz; + siz2 = s2.siz; + bsiz2 = s2.bsiz; + if (bsiz1(2) != bsiz2(1)) + gripe_nonconformant (bsiz1, bsiz2, "block sizes"); + elseif (siz1(2) != siz2(1)) + gripe_nonconformant (bsiz1.*siz1, bsiz2.*siz2); + endif + + ## Stupid & simple. + s = blksparse ([s1.i; s2.i], [s1.j; s2.j], cat (3, s1.sv, -s2.sv), siz1(1), siz1(2)); + else + error ("blksparse: only blksparse - blksparse implemented"); + endif +endfunction + +function gripe_nonconformant (s1, s2, what = "arguments") + error ("Octave:nonconformant-args", ... + "nonconformant %s (op1 is %dx%d, op2 is %dx%d)", what, s1, s2); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/mldivide.m b/octave_packages/linear-algebra-2.2.0/@blksparse/mldivide.m new file mode 100644 index 0000000..3733aab --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/mldivide.m @@ -0,0 +1,115 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} mldivide (@var{x}, @var{y}) +## Performs a left division with a block sparse matrix. +## If @var{x} is a block sparse matrix, it must be either diagonal +## or triangular, and @var{y} must be full. +## If @var{x} is built-in sparse or full, @var{y} is converted +## accordingly, then the built-in division is used. +## @end deftypefn + +function c = mldivide (a, b) + if (isa (a, "blksparse")) + if (issparse (b)) + error ("blksparse: block sparse \\ sparse not implemented"); + else + c = mldivide_sm (a, b); + endif + elseif (issparse (a)) + c = a \ sparse (b); + else + c = a \ full (b); + endif +endfunction + +function y = mldivide_sm (s, x) + siz = s.siz; + bsiz = s.bsiz; + if (bsiz(1) != bsiz(2) || siz(1) != siz(2)) + error ("blksparse: can only divide by square matrices with square blocks"); + endif + + ## Check sizes. + [xr, xc] = size (x); + if (xr != siz(1)*bsiz(1)) + gripe_nonconformant (siz.*bsiz, [xr, xc]); + endif + + if (isempty (s) || isempty (x)) + y = x; + return; + endif + + ## Form blocks. + x = reshape (x, bsiz(1), siz(1), xc); + x = permute (x, [1, 3, 2]); + + sv = s.sv; + si = s.i; + sj = s.j; + ns = size (sv, 3); + + n = siz(1); + nb = bsiz(1); + d = find (si == sj); + full_diag = length (d) == n; + + isdiag = full_diag && ns == n; # block diagonal + islower = full_diag && all (si >= sj); # block upper triangular + isupper = full_diag && all (si <= sj); # block lower triangular + + if (isdiag) + xx = num2cell (x, [1, 2]); + ss = num2cell (sv, [1, 2]); + yy = cellfun (@mldivide, ss, xx, "uniformoutput", false); + y = cat (3, yy{:}); + clear xx ss yy; + elseif (islower) + y = x; + ## this is the axpy version + for j = 1:n-1 + y(:,:,j) = sv(:,:,d(j)) \ y(:,:,j); + k = d(j)+1:d(j+1)-1; + xy = y(:,:,j*ones (1, length (k))); + y(:,:,si(k)) -= blkmm (sv(:,:,k), xy); + endfor + y(:,:,n) = sv(:,:,ns) \ y(:,:,n); + elseif (isupper) + y = x; + ## this is the axpy version + for j = n:-1:2 + y(:,:,j) = sv(:,:,d(j)) \ y(:,:,j); + k = d(j-1)+1:d(j)-1; + xy = y(:,:,j*ones (1, length (k))); + y(:,:,si(k)) -= blkmm (sv(:,:,k), xy); + endfor + y(:,:,1) = sv(:,:,1) \ y(:,:,1); + else + error ("blksparse: mldivide: matrix must be block triangular or diagonal"); + endif + + ## Narrow blocks. + y = permute (y, [1, 3, 2]); + y = reshape (y, bsiz(1)*siz(1), xc); +endfunction + +function gripe_nonconformant (s1, s2, what = "arguments") + error ("Octave:nonconformant-args", ... + "nonconformant %s (op1 is %dx%d, op2 is %dx%d)", what, s1, s2); +endfunction + diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/mrdivide.m b/octave_packages/linear-algebra-2.2.0/@blksparse/mrdivide.m new file mode 100644 index 0000000..1178060 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/mrdivide.m @@ -0,0 +1,112 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} mrdivide (@var{x}, @var{y}) +## Performs a left division with a block sparse matrix. +## If @var{y} is a block sparse matrix, it must be either diagonal +## or triangular, and @var{x} must be full. +## If @var{y} is built-in sparse or full, @var{x} is converted +## accordingly, then the built-in division is used. +## @end deftypefn + +function c = mrdivide (a, b) + if (isa (b, "blksparse")) + if (issparse (a)) + error ("blksparse: sparse / block sparse not implemented"); + else + c = mrdivide_ms (a, b); + endif + elseif (issparse (b)) + c = sparse (a) / b; + else + c = full (a) / b; + endif +endfunction + +function y = mrdivide_ms (x, s) + siz = s.siz; + bsiz = s.bsiz; + if (bsiz(1) != bsiz(2) || siz(1) != siz(2)) + error ("blksparse: can only divide by square matrices with square blocks"); + endif + + ## Check sizes. + [xr, xc] = size (x); + if (xc != siz(2)*bsiz(2)) + gripe_nonconformant (siz.*bsiz, [xr, xc]); + endif + + if (isempty (s) || isempty (x)) + y = x; + return; + endif + + ## Form blocks. + x = reshape (x, xr, bsiz(2), siz(2)); + + sv = s.sv; + si = s.i; + sj = s.j; + ns = size (sv, 3); + + n = siz(2); + nb = bsiz(2); + d = find (si == sj); + full_diag = length (d) == n; + + isdiag = full_diag && ns == n; # block diagonal + islower = full_diag && all (si >= sj); # block upper triangular + isupper = full_diag && all (si <= sj); # block lower triangular + + if (isdiag) + xx = num2cell (x, [1, 2]); + ss = num2cell (sv, [1, 2]); + yy = cellfun (@mldivide, ss, xx, "uniformoutput", false); + y = cat (3, yy{:}); + clear xx ss yy; + elseif (isupper) + y = zeros (size (x)); + ## this is the dot version + y(:,:,1) = x(:,:,1) / sv(:,:,1); + for j = 2:n + k = d(j-1)+1:d(j)-1; + xy = blkmm (y(:,:,si(k)), sv(:,:,k)); + y(:,:,j) = (x(:,:,j) - sum (xy, 3)) / sv(:,:,d(j)); + endfor + elseif (islower) + y = zeros (size (x)); + ## this is the dot version + y(:,:,n) = x(:,:,n) / sv(:,:,ns); + for j = n-1:-1:1 + k = d(j)+1:d(j+1)-1; + xy = blkmm (y(:,:,si(k)), sv(:,:,k)); + y(:,:,j) = (x(:,:,j) - sum (xy, 3)) / sv(:,:,d(j)); + endfor + else + error ("blksparse: mldivide: matrix must be block triangular or diagonal"); + endif + + ## Narrow blocks. + y = reshape (y, xr, bsiz(2)*siz(2)); +endfunction + +function gripe_nonconformant (s1, s2, what = "arguments") + error ("Octave:nonconformant-args", ... + "nonconformant %s (op1 is %dx%d, op2 is %dx%d)", what, s1, s2); +endfunction + + diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/mtimes.m b/octave_packages/linear-algebra-2.2.0/@blksparse/mtimes.m new file mode 100644 index 0000000..009f66e --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/mtimes.m @@ -0,0 +1,121 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} mtimes (@var{x}, @var{y}) +## Multiplies a block sparse matrix with a full matrix, or two block sparse +## matrices. Multiplication of block sparse * sparse is not implemented. +## If one of arguments is a scalar, it's a scalar multiply. +## @end deftypefn + +function c = mtimes (a, b) + if (isa (a, "blksparse")) + if (isa (b, "blksparse")) + c = mtimes_ss (a, b); + else + c = mtimes_sm (a, b); + endif + elseif (isa (b, "blksparse")) + c = mtimes_ms (a, b); + else + error ("blksparse: invalid arguments to mtimes"); + endif +endfunction + +function y = mtimes_sm (s, x) + if (isscalar (x)) + y = s; + y.sv *= x; + return; + elseif (issparse (x)) + error ("blksparse * sparse not implemented."); + endif + siz = s.siz; + bsiz = s.bsiz; + ## Check sizes. + [xr, xc] = size (x); + if (xr != siz(2)*bsiz(2)) + gripe_nonconformant (siz.*bsiz, [xr, xc]); + endif + ## Form blocks. + x = reshape (x, bsiz(2), siz(2), xc); + x = permute (x, [1, 3, 2]); + ## Scatter. + xs = x(:,:,s.j); + ## Multiply. + ys = blkmm (s.sv, xs); + ## Gather. + y = accumdim (s.i, ys, 3, siz(1)); + y = permute (y, [1, 3, 2]); + ## Narrow blocks. + y = reshape (y, bsiz(1)*siz(1), xc); +endfunction + +function y = mtimes_ms (x, s) + if (isscalar (x)) + y = s; + y.sv *= x; + return; + elseif (issparse (x)) + error ("sparse * blksparse not implemented."); + endif + siz = s.siz; + bsiz = s.bsiz; + ## Check sizes. + [xr, xc] = size (x); + if (xc != siz(1)*bsiz(1)) + gripe_nonconformant ([xr, xc], siz.*bsiz); + endif + ## Form blocks. + x = reshape (x, xr, bsiz(2), siz(2)); + ## Scatter. + xs = x(:,:,s.i); + ## Multiply. + ys = blkmm (xs, s.sv); + ## Gather. + y = accumdim (s.j, ys, 3, siz(2)); + ## Narrow blocks. + y = reshape (y, xr, bsiz(2)*siz(2)); +endfunction + +function s = mtimes_ss (s1, s2) + + ## Conformance check. + siz1 = s1.siz; + bsiz1 = s1.bsiz; + siz2 = s2.siz; + bsiz2 = s2.bsiz; + if (bsiz1(2) != bsiz2(1)) + gripe_nonconformant (bsiz1, bsiz2, "block sizes"); + elseif (siz1(2) != siz2(1)) + gripe_nonconformant (bsiz1.*siz1, bsiz2.*siz2); + endif + + ## Hardcore hacks, man! + ss = sparse (s1.i, s1.j, 1:length (s1.i), "unique"); + ss = ss(:,s2.i); + [i, j, k] = find (ss); + sv = blkmm (s1.sv(:,:,k), s2.sv(:,:,j)); + j = s2.j(j); + + s = blksparse (i, j, sv, siz1(1), siz2(2)); + +endfunction + +function gripe_nonconformant (s1, s2, what = "arguments") + error ("Octave:nonconformant-args", ... + "nonconformant %s (op1 is %dx%d, op2 is %dx%d)", what, s1, s2); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/plus.m b/octave_packages/linear-algebra-2.2.0/@blksparse/plus.m new file mode 100644 index 0000000..146dfae --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/plus.m @@ -0,0 +1,40 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +function s = plus (s1, s2) + if (isa (s1, "blksparse") && isa (s2, "blksparse")) + ## Conformance check. + siz1 = s1.siz; + bsiz1 = s1.bsiz; + siz2 = s2.siz; + bsiz2 = s2.bsiz; + if (bsiz1(2) != bsiz2(1)) + gripe_nonconformant (bsiz1, bsiz2, "block sizes"); + elseif (siz1(2) != siz2(1)) + gripe_nonconformant (bsiz1.*siz1, bsiz2.*siz2); + endif + + ## Stupid & simple. + s = blksparse ([s1.i; s2.i], [s1.j; s2.j], cat (3, s1.sv, s2.sv), siz1(1), siz1(2)); + else + error ("blksparse: only blksparse + blksparse implemented"); + endif +endfunction + +function gripe_nonconformant (s1, s2, what = "arguments") + error ("Octave:nonconformant-args", ... + "nonconformant %s (op1 is %dx%d, op2 is %dx%d)", what, s1, s2); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/size.m b/octave_packages/linear-algebra-2.2.0/@blksparse/size.m new file mode 100644 index 0000000..7eade0e --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/size.m @@ -0,0 +1,24 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} size (@var{x}) +## Returns the size of the matrix. +## @end deftypefn + +function siz = size (s) + siz = s.bsiz .* s.siz; +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/sparse.m b/octave_packages/linear-algebra-2.2.0/@blksparse/sparse.m new file mode 100644 index 0000000..d6d32f4 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/sparse.m @@ -0,0 +1,32 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} sparse (@var{x}) +## Converts a block sparse matrix to (built-in) sparse. +## @end deftypefn + +function sp = sparse (s) + bsiz = s.bsiz; + i = repmat (shiftdim (s.i, -2), bsiz); + j = repmat (shiftdim (s.j, -2), bsiz); + [iofs, jofs] = ndgrid (1:bsiz(1), 1:bsiz(2)); + k = ones (1, size (s.sv, 3)); + i = sub2ind ([bsiz(1), s.siz(1)], iofs(:,:,k), i); + j = sub2ind ([bsiz(2), s.siz(2)], jofs(:,:,k), j); + + sp = sparse (i(:), j(:), s.sv(:), bsiz(1)*s.siz(1), bsiz(2)*s.siz(2)); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/subsref.m b/octave_packages/linear-algebra-2.2.0/@blksparse/subsref.m new file mode 100644 index 0000000..8e08db1 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/subsref.m @@ -0,0 +1,60 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +function ss = subsref (s, subs) + if (length (subs) != 1) + error ("blksparse: invalid index chain"); + endif + if (strcmp (subs(1).type, "()")) + ind = subs(1).subs; + if (length (ind) == 2) + idx = make_block_index (ind{1}, s.bsiz(1)); + jdx = make_block_index (ind{2}, s.bsiz(2)); + ## Use sparse indexing to solve it all. + sn = sparse (s.i, s.j, 1:size (s.sv, 3), s.siz(1), s.siz (2)); + sn = sn(idx, jdx); + [i, j, k] = find (sn); + ss = s; + ss.i = i; + ss.j = j; + ss.sv = s.sv(:,:,k); + ss.siz = size (sn); + else + error ("blksparse: linear indexing is not supported"); + endif + else + error ("blksparse: only supports () indexing"); + endif + +endfunction + +function bi = make_block_index (i, bs) + if (strcmp (i, ':')) + bi = i; + else + if (rem (numel (i), bs) == 0) + ba = reshape (i, bs, []); + bi = ba(1,:); + if (any (rem (bi, bs) != 1) || any ((ba != bsxfun (@plus, bi, [0:bs-1].'))(:))) + error ("blksparse: index must preserve block structure"); + else + bi = ceil (bi / bs); + endif + else + error ("blksparse: index must preserve block structure"); + endif + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/transpose.m b/octave_packages/linear-algebra-2.2.0/@blksparse/transpose.m new file mode 100644 index 0000000..fb0caba --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/transpose.m @@ -0,0 +1,29 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} transpose (@var{x}) +## Returns the transpose of a block sparse matrix @var{x}. +## @end deftypefn + +function y = transpose (x) + y.siz = x.siz(2:-1:1); + y.bsiz = x.bsiz(2:-1:1); + [y.j,idx] = sort (x.i); + y.i = x.j(idx); + y.sv = permute (x.sv(:,:,idx), [2,1,3]); +endfunction + diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/uminus.m b/octave_packages/linear-algebra-2.2.0/@blksparse/uminus.m new file mode 100644 index 0000000..d747879 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/uminus.m @@ -0,0 +1,25 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} uminus (@var{x}) +## Returns the negative of a block sparse matrix @var{x}. +## @end deftypefn + +function y = uminus (x) + y = x; + y.sv = -x.sv; +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@blksparse/uplus.m b/octave_packages/linear-algebra-2.2.0/@blksparse/uplus.m new file mode 100644 index 0000000..93c78bf --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@blksparse/uplus.m @@ -0,0 +1,26 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} uplus (@var{x}) +## Returns the unary plus of a block sparse matrix @var{x}. +## Effectively the matrix itself, except signs of zeros. +## @end deftypefn + +function y = uplus (x) + y = x; + y.sv = +x.sv; +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/columns.m b/octave_packages/linear-algebra-2.2.0/@kronprod/columns.m new file mode 100644 index 0000000..e3e24ff --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/columns.m @@ -0,0 +1,32 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} columns (@var{KP}) +## Return the number of columns in the Kronecker product @var{KP}. +## @seealso{@@kronprod/rows, @@kronprod/size, @@kronprod/numel} +## @end deftypefn + +function retval = columns (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("columns: input argument must be of class 'kronprod'"); + endif + + retval = columns (KP.A) * columns (KP.B); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/ctranspose.m b/octave_packages/linear-algebra-2.2.0/@kronprod/ctranspose.m new file mode 100644 index 0000000..8115772 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/ctranspose.m @@ -0,0 +1,37 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} ctranspose (@var{KP}) +## The complex conjugate transpose of a Kronecker product. This is equivalent +## to +## +## @example +## @var{KP}' +## @end example +## @seealso{ctranspose, @@kronprod/transpose} +## @end deftypefn + +function retval = ctranspose (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("ctranspose: input argument must be of class 'kronprod'"); + endif + + retval = kronprod (ctranspose (KP.A), ctranspose (KP.B)); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/det.m b/octave_packages/linear-algebra-2.2.0/@kronprod/det.m new file mode 100644 index 0000000..0c4be2b --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/det.m @@ -0,0 +1,56 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} det (@var{KP}) +## Compute the determinant of a Kronecker product. +## +## If @var{KP} is the Kronecker product of the @var{n}-by-@var{n} matrix @var{A} +## and the @var{q}-by-@var{q} matrix @var{B}, then the determinant is computed +## as +## +## @example +## det (@var{A})^q * det (@var{B})^n +## @end example +## +## If @var{KP} is not a Kronecker product of square matrices the determinant is +## computed by forming the full matrix and then computing the determinant. +## @seealso{det, @@kronprod/trace, @@kronprod/rank, @@kronprod/full} +## @end deftypefn + +function retval = det (KP) + ## Check input + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("det: input argument must be of class 'kronprod'"); + endif + + if (!issquare (KP)) + error ("det: argument must be a square matrix"); + endif + + ## Take action + [n, m] = size (KP.A); + [q, r] = size (KP.B); + if (n == m && q == r) # A and B are both square + retval = (det (KP.A)^q) * (det (KP.B)^n); + elseif (n*q == m*r) # kron (A, B) is square + ## XXX: Can we do something smarter here? We should be able to use the SVD... + retval = det (full (KP)); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/disp.m b/octave_packages/linear-algebra-2.2.0/@kronprod/disp.m new file mode 100644 index 0000000..8b21e91 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/disp.m @@ -0,0 +1,28 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} disp (@var{KP}) +## Show the content of the Kronecker product @var{KP}. To avoid evaluating the +## Kronecker product, this function displays the two matrices defining the product. +## To display the actual values of @var{KP}, use @code{disp (full (@var{KP}))}. +## +## This function is equivalent to @code{@@kronprod/display}. +## @seealso{@@kronprod/display, @@kronprod/full} +## @end deftypefn + +function disp (KP) + display (KP); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/display.m b/octave_packages/linear-algebra-2.2.0/@kronprod/display.m new file mode 100644 index 0000000..aae49bd --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/display.m @@ -0,0 +1,48 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} display (@var{KP}) +## Show the content of the Kronecker product @var{KP}. To avoid evaluating the +## Kronecker product, this function displays the two matrices defining the product. +## To display the actual values of @var{KP}, use @code{display (full (@var{KP}))}. +## @seealso{@@kronprod/displ, @@kronprod/full} +## @end deftypefn + +function display (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("display: input argument must be of class 'kronprod'"); + endif + + if (isempty (KP.P)) + disp ("Kronecker Product of A and B with"); + disp ("A = "); + disp (KP.A); + disp ("B = "); + disp (KP.B); + else + disp ("Permuted Kronecker Product of A and B (i.e. P * kron (A, B) * P') with"); + disp ("A = "); + disp (KP.A); + disp ("B = "); + disp (KP.B); + disp ("P = "); + disp (KP.P); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/full.m b/octave_packages/linear-algebra-2.2.0/@kronprod/full.m new file mode 100644 index 0000000..6539b06 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/full.m @@ -0,0 +1,41 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} full (@var{KP}) +## Return the full matrix representation of the Kronecker product @var{KP}. +## +## If @var{KP} is the Kronecker product of an @var{n}-by-@var{m} matrix and a +## @var{q}-by-@var{r} matrix, then the result is a @var{n}@var{q}-by-@var{m}@var{r} +## matrix. Thus, the result can require vast amount of memory, so this function +## should be avoided whenever possible. +## @seealso{full, @@kronprod/sparse} +## @end deftypefn + +function retval = full (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("full: input argument must be of class 'kronprod'"); + endif + + retval = full (kron (KP.A, KP.B)); + if (!isempty (KP.P)) + #retval = KP.P * retval * KP.P'; + retval = retval (KP.P, KP.P); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/inv.m b/octave_packages/linear-algebra-2.2.0/@kronprod/inv.m new file mode 100644 index 0000000..22ac506 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/inv.m @@ -0,0 +1,52 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} inv (@var{KP}) +## Return the inverse of the Kronecker product @var{KP}. +## +## If @var{KP} is the Kronecker product of two square matrices @var{A} and @var{B}, +## the inverse will be computed as the Kronecker product of the inverse of +## @var{A} and @var{B}. +## +## If @var{KP} is square but not a Kronecker product of square matrices, the +## inverse will be computed using the SVD +## @seealso{@@kronprod/sparse} +## @end deftypefn + +function retval = inv (KP) + ## Check input + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("inv: input argument must be of class 'kronprod'"); + endif + + ## Do the computations + [n, m] = size (KP.A); + [q, r] = size (KP.B); + if (n == m && q == r) # A and B are both square + retval = kronprod (inv (KP.A), inv (KP.B)); + elseif (n*q == m*r) # kron (A, B) is square + ## We use the SVD to compute the inverse. + ## XXX: Should we use 'eig' instead? + [U, S, V] = svd (KP); + retval = U * (1./S) * V'; + else + error ("inv: argument must be a square matrix"); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/iscomplex.m b/octave_packages/linear-algebra-2.2.0/@kronprod/iscomplex.m new file mode 100644 index 0000000..b6cf9ac --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/iscomplex.m @@ -0,0 +1,32 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} iscomplex (@var{KP}) +## Return @t{true} if the Kronecker product @var{KP} contains any complex values. +## @seealso{iscomplex, @@kronprod/isreal} +## @end deftypefn + +function retval = iscomplex (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("iscomplex: input argument must be of class 'kronprod'"); + endif + + retval = (iscomplex (KP.A) || iscomplex (KP.B); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/ismatrix.m b/octave_packages/linear-algebra-2.2.0/@kronprod/ismatrix.m new file mode 100644 index 0000000..3b426cc --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/ismatrix.m @@ -0,0 +1,24 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} ismatrix (@var{KP}) +## Return @t{true} to indicate that the Kronecker product @var{KP} always is a +## matrix. +## @end deftypefn + +function retval = ismatrix (KP) + retval = true; +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/isreal.m b/octave_packages/linear-algebra-2.2.0/@kronprod/isreal.m new file mode 100644 index 0000000..76cd468 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/isreal.m @@ -0,0 +1,33 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} isreal (@var{KP}) +## Return @t{true} if the Kronecker product @var{KP} is real, i.e. has no +## imaginary components. +## @seealso{isreal, @@kronprod/iscomplex} +## @end deftypefn + +function retval = isreal (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("isreal: input argument must be of class 'kronprod'"); + endif + + retval = (isreal (KP.A) & isreal (KP.B)); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/issparse.m b/octave_packages/linear-algebra-2.2.0/@kronprod/issparse.m new file mode 100644 index 0000000..6ea0559 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/issparse.m @@ -0,0 +1,34 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} issparse (@var{KP}) +## Return @t{true} if one of the matrices in the Kronecker product @var{KP} +## is sparse. +## @seealso{@@kronprod/sparse} +## @end deftypefn + +function retval = issparse (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("issparse: input argument must be of class 'kronprod'"); + endif + + retval = (issparse(KP.A) || issparse(KP.B)); +endfunction + diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/issquare.m b/octave_packages/linear-algebra-2.2.0/@kronprod/issquare.m new file mode 100644 index 0000000..d3a3824 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/issquare.m @@ -0,0 +1,33 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} issquare (@var{KP}) +## Return @t{true} if the Kronecker product @var{KP} is a square matrix. +## @seealso{@@kronprod/size} +## @end deftypefn + +function retval = issquare (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("issquare: input argument must be of class 'kronprod'"); + endif + + s = size (KP); + retval = (s (1) == s (2)); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/kronprod.m b/octave_packages/linear-algebra-2.2.0/@kronprod/kronprod.m new file mode 100644 index 0000000..8779506 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/kronprod.m @@ -0,0 +1,47 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} kronprod (@var{A}, @var{B}) +## @deftypefnx{Function File} kronprod (@var{A}, @var{B}, @var{P}) +## Construct a Kronecker product object. +## XXX: Write proper documentation +## +## With two input arguments, the following matrix is represented: kron (A, B); +## +## With three input arguments, the following matrix is represented: P * kron (A, B) * P' +## (P must be a permutation matrix) +## +## @end deftypefn + +function retval = kronprod (A, B, P) + if (nargin == 0) + KP.A = KP.B = KP.P = []; + elseif (nargin == 2 && ismatrix (A) && ismatrix (B)) + KP.A = A; + KP.B = B; + KP.P = []; + elseif (nargin == 3 && ismatrix (A) && ismatrix (B)) +# && strcmp (typeinfo (P), "permutation matrix")) + ## XXX: Check that the size of P is correct + KP.A = A; + KP.B = B; + KP.P = P; + else + print_usage (); + endif + + retval = class (KP, "kronprod"); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/minus.m b/octave_packages/linear-algebra-2.2.0/@kronprod/minus.m new file mode 100644 index 0000000..5bf47f1 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/minus.m @@ -0,0 +1,52 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} minus (@var{a}, @var{a}) +## Return the difference between a Kronecker product and another matrix. This is performed +## by forming the full matrix of both inputs and is as such a potential expensive +## operation. +## @seealso{minus, @@kronprod/plus} +## @end deftypefn + +function retval = minus (M1, M2) + if (nargin != 2) + print_usage (); + endif + + if (!ismatrix (M1) || !ismatrix (M2)) + error ("minus: both input arguments must be matrices"); + endif + + if (!size_equal (M1, M2)) + error ("minus: nonconformant arguments (op1 is %dx%d, op2 is %dx%d)", + rows (M1), columns (M1), rows (M2), columns (M2)); + endif + + ## XXX: Can we do something smarter here? + if (issparse (M1)) + M1 = sparse (M1); + else + M1 = full (M1); + endif + + if (issparse (M2)) + M2 = sparse (M2); + else + M2 = full (M2); + endif + + retval = M1 - M2; +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/mldivide.m b/octave_packages/linear-algebra-2.2.0/@kronprod/mldivide.m new file mode 100644 index 0000000..82cc42b --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/mldivide.m @@ -0,0 +1,59 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} mldivide (@var{M1}, @var{M2}) +## XXX: Write documentation +## @end deftypefn + +function retval = mldivide (M1, M2) + ## Check input + if (nargin != 2) + print_usage (); + endif + + if (!ismatrix (M1) || !ismatrix (M2)) + error ("mldivide: both input arguments must be matrices"); + endif + + if (rows (M1) != rows (M2)) + error ("mldivide: nonconformant arguments (op1 is %dx%d, op2 is %dx%d)", + rows (M1), columns (M1), rows (M2), columns (M2)); + endif + + ## Take action depending on types + M1_is_KP = isa (M1, "kronprod"); + M2_is_KP = isa (M2, "kronprod"); + + if (M1_is_KP && M2_is_KP) # Left division of Kronecker Products + error ("mldividide: this part not yet implemented as I'm lazy..."); + + elseif (M1_is_KP) # Left division of Kronecker Product and Matrix + ## XXX: Does this give the same minimum-norm solution as when using + ## XXX: full (M1) \ M2 + ## XXX: ? It is the same when M1 is invertible. + retval = zeros (columns (M1), columns (M2)); + for n = 1:columns (M2) + M = reshape (M2 (:, n), [rows(M1.B), rows(M1.A)]); + retval (:, n) = vec ((M1.A \ (M1.B \ M)')'); + endfor + + elseif (M2_is_KP) # Left division of Matrix and Kronecker Product + error ("mldividide: this part not yet implemented as I'm lazy..."); + + else + error ("mldivide: internal error for 'kronprod'"); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/mpower.m b/octave_packages/linear-algebra-2.2.0/@kronprod/mpower.m new file mode 100644 index 0000000..9800e6b --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/mpower.m @@ -0,0 +1,44 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} mpower (@var{KP}, @var{k}) +## XXX: Write documentation +## @end deftypefn + +function retval = mpower (KP, k) + ## Check input + if (nargin != 2) + print_usage (); + endif + + if (!ismatrix (KP)) + error ("mpower: first input argument must be a matrix"); + endif + + if (!isscalar (k)) + error ("mpower: second input argument must be a scalar"); + endif + + ## Do the actual computation + if (issquare (KP.A) && issquare (KP.B) && k == round (k)) + retval = kronprod (KP.A^k, KP.B^k); + elseif (issquare (KP)) + ## XXX: Can we do something smarter here? + retval = full (KP)^k; + else + error ("for A^b, A must be square"); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/mtimes.m b/octave_packages/linear-algebra-2.2.0/@kronprod/mtimes.m new file mode 100644 index 0000000..b539cc1 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/mtimes.m @@ -0,0 +1,92 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} mtimes (@var{KP}) +## XXX: Write documentation +## @end deftypefn + +function retval = mtimes (M1, M2) + ## Check input + if (nargin == 0) + print_usage (); + elseif (nargin == 1) + ## This seems to be what happens for full and sparse matrices, so we copy this behaviour + retval = M1; + return; + endif + + if (!ismatrix (M1) || !ismatrix (M2)) + error ("mtimes: input arguments must be matrices"); + endif + + if (columns (M1) != rows (M2)) + error ("mtimes: nonconformant arguments (op1 is %dx%d, op2 is %dx%d)", + rows (M1), columns (M1), rows (M2), columns (M2)); + endif + + ## Take action depending on input types + M1_is_KP = isa (M1, "kronprod"); + M2_is_KP = isa (M2, "kronprod"); + + if (M1_is_KP && M2_is_KP) # Product of Kronecker Products + ## Check if the size match such that the result is a Kronecker Product + if (columns (M1.A) == rows (M2.A) && columns (M1.B) == rows (M2.B)) + retval = kronprod (M1.A * M2.A, M1.B * M2.B); + else + ## Form the full matrix of the smallest matrix and use that to compute the + ## final product + ## XXX: Can we do something smarter here? + numel1 = numel (M1); + numel2 = numel (M2); + if (numel1 < numel2) + retval = full (M1) * M2; + else + retval = M1 * full (M2); + endif + endif + + elseif (M1_is_KP && isscalar (M2)) # Product of Kronecker Product and scalar + if (numel (M1.A) < numel (M1.B)) + retval = kronprod (M2 * M1.A, M1.B); + else + retval = kronprod (M1.A, M2 * M1.B); + endif + + elseif (M1_is_KP && ismatrix (M2)) # Product of Kronecker Product and Matrix + retval = zeros (rows (M1), columns (M2)); + for n = 1:columns (M2) + M = reshape (M2 (:, n), [columns(M1.B), columns(M1.A)]); + retval (:, n) = vec (M1.B * M * M1.A'); + endfor + + elseif (isscalar (M1) && M2_is_KP) # Product of scalar and Kronecker Product + if (numel (M2.A) < numel (M2.B)) + retval = kronprod (M1 * M2.A, M2.B); + else + retval = kronprod (M2.A, M1 * M2.B); + endif + + elseif (ismatrix (M1) && M2_is_KP) # Product of Matrix and Kronecker Product + retval = zeros (rows (M1), columns (M2)); + for n = 1:rows (M1) + M = reshape (M1 (n, :), [rows(M2.B), rows(M2.A)]); + retval (n, :) = vec (M2.B' * M * M2.A); + endfor + + else + error ("mtimes: internal error for 'kronprod'"); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/not_done/eig.m b/octave_packages/linear-algebra-2.2.0/@kronprod/not_done/eig.m new file mode 100644 index 0000000..d3773a0 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/not_done/eig.m @@ -0,0 +1,71 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{lambda} =} eig (@var{KP}) +## @deftypefnx{Function File} {[var{V}, @var{lambda}] =} eig (@var{KP}) +## XXX: Write help text +## @seealso{eig, @kronprod/svd} +## @end deftypefn + +function [V, lambda] = eig (KP, A) + ## XXX: This implementation provides a different permutation of eigenvalues and + ## eigenvectors compared to 'eig (full (KP))' + + ## Check input + if (nargin == 0 || nargin > 2) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("eig: first input argument must be of class 'kronprod'"); + endif + + if (!issquare (KP)) + error ("eig: first input must be a square matrix"); + endif + + ## Take action + if (nargin == 1) + if (nargout <= 1) + ## Only eigenvalues were requested + if (issquare (KP.A) && issquare (KP.B)) + lambda_A = eig (KP.A); + lambda_B = eig (KP.B); + V = kronprod (lambda_A, lambda_B); + else + ## We should be able to do this using SVD + error ("eig not implemented (yet) for Kronecker products of non-square matrices"); + endif + + elseif (nargout == 2) + ## Both eigenvectors and eigenvalues were requested + if (issquare (KP.A) && issquare (KP.B)) + [V_A, lambda_A] = eig (KP.A); + [V_B, lambda_B] = eig (KP.B); + V = kronprod (V_A, V_B); + lambda = kronprod (lambda_A, lambda_B); + else + ## We should be able to do this using SVD + error ("eig not implemented (yet) for Kronecker products of non-square matrices"); + endif + endif + + elseif (nargin == 2) + ## Solve generalised eigenvalue problem + ## XXX: Is there a fancy way of doing this? + [V, lambda] = eig (full (KP), full (A)); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/not_done/svd.m b/octave_packages/linear-algebra-2.2.0/@kronprod/not_done/svd.m new file mode 100644 index 0000000..86dedcb --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/not_done/svd.m @@ -0,0 +1,54 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} svd (@var{KP}) +## XXX: Write documentation +## @end deftypefn + +function [U, S, V] = svd (KP) + if (nargin < 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("svd: input must be of class 'kronprod'"); + endif + + ## XXX: I don't think this works properly for non-square A and B + + if (nargout <= 1) + ## Only singular values were requested + S_A = svd (KP.A); + S_B = svd (KP.B); + U = sort (kron (S_A, S_B), "descend"); + elseif (nargout == 3) + ## The full SVD was requested + [U_A, S_A, V_A] = svd (KP.A); + [U_B, S_B, V_B] = svd (KP.B); + + ## Compute and sort singular values + [sv, idx] = sort (kron (diag (S_A), diag (S_B)), "descend"); + + ## Form matrices + S = resize (diag (sv), [rows(KP), columns(KP)]); + #Pu = eye (rows (KP)) (idx, :); + U = kronprod (U_A, U_B, idx); + #Pv = eye (columns (KP)) (idx, :); + V = kronprod (V_A, V_B, idx); + else + print_usage (); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/numel.m b/octave_packages/linear-algebra-2.2.0/@kronprod/numel.m new file mode 100644 index 0000000..f4acb9a --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/numel.m @@ -0,0 +1,32 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} numel (@var{KP}) +## Return the number of elements in the Kronecker product @var{KP}. +## @seealso{numel, @@kronprod/rows, @@kronprod/columns, @@kronprod/size} +## @end deftypefn + +function retval = numel (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("numel: input must be of class 'kronprod'"); + endif + + retval = prod (size (KP.A) .* size (KP.B)); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/plus.m b/octave_packages/linear-algebra-2.2.0/@kronprod/plus.m new file mode 100644 index 0000000..9702341 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/plus.m @@ -0,0 +1,56 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} plus (@var{a}, @var{a}) +## Return the sum of a Kronecker product and another matrix. This is performed +## by forming the full matrix of both inputs and is as such a potential expensive +## operation. +## @seealso{plus, @@kronprod/minus} +## @end deftypefn + +function retval = plus (M1, M2) + if (nargin == 0 || nargin > 2) + print_usage (); + elseif (nargin == 1) + ## This seems to be the behaviour for the built-in types so we copy that + retval = M1; + return; + endif + + if (!ismatrix (M1) || !ismatrix (M2)) + error ("plus: input arguments must be matrics"); + endif + + if (!size_equal (M1, M2)) + error ("plus: nonconformant arguments (op1 is %dx%d, op2 is %dx%d)", + rows (M1), columns (M1), rows (M2), columns (M2)); + endif + + ## XXX: Can we do something smarter here? + if (issparse (M1)) + M1 = sparse (M1); + else + M1 = full (M1); + endif + + if (issparse (M2)) + M2 = sparse (M2); + else + M2 = full (M2); + endif + + retval = M1 + M2; +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/rank.m b/octave_packages/linear-algebra-2.2.0/@kronprod/rank.m new file mode 100644 index 0000000..2744f38 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/rank.m @@ -0,0 +1,33 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} rank (@var{KP}) +## Return the rank of the Kronecker product @var{KP}. This is computed as the +## product of the ranks of the matrices forming the product. +## @seealso{rank, @@kronprod/det, @@kronprod/trace} +## @end deftypefn + +function retval = rank (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("rank: input must be of class 'kronprod'"); + endif + + retval = rank (KP.A) * rank (KP.B); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/rdivide.m b/octave_packages/linear-algebra-2.2.0/@kronprod/rdivide.m new file mode 100644 index 0000000..86dceca --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/rdivide.m @@ -0,0 +1,53 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} rdivide (@var{a}, @var{b}) +## XXX: Write help text. +## @end deftypefn + +function retval = rdivide (a, b) + ## Check input + if (nargin < 2) + print_usage (); + endif + + if (!ismatrix (a) || !ismatrix (a)) + error ("rdivide: input arguments must be scalars or matrices"); + endif + + if (!size_equal (a, b) || !isscalar (b)) + error ("times: nonconformant arguments (op1 is %dx%d, op2 is %dx%d)", + rows (a), columns (a), rows (b), columns (b)); + endif + + ## Take action depending on input + if (isscalar (a) && isa (b, "kronprod")) + retval = kronprod (a ./ b.A, 1 ./ b.B); + elseif (isa (a, "kronprod") && isscalar (b)) + if (numel (a.A) < numel (a.B)) + retval = kronprod (a.A ./ b, a.B); + else + retval = kronprod (a.A, a.B ./ b); + endif + elseif (isa (a, "kronprod") && isa (b, "kronprod")) + ## XXX: Can we do something smarter here? + retval = full (a) ./ full (b); + else + ## XXX: We should probably handle sparse cases and all sorts of other + ## situations better here + retval = full (a) ./ full (b); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/rows.m b/octave_packages/linear-algebra-2.2.0/@kronprod/rows.m new file mode 100644 index 0000000..54e7e65 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/rows.m @@ -0,0 +1,32 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} rows (@var{KP}) +## Return the number of rows in the Kronecker product @var{KP}. +## @seealso{rows, @@kronprod/size, @@kronprod/columns, @@kronprod/numel} +## @end deftypefn + +function retval = rows (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("rows: input must be of class 'kronprod'"); + endif + + retval = rows (KP.A) * rows (KP.B); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/size.m b/octave_packages/linear-algebra-2.2.0/@kronprod/size.m new file mode 100644 index 0000000..6208d01 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/size.m @@ -0,0 +1,39 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} size (@var{KP}) +## @deftypefnx{Function File} size (@var{KP}, @var{dim}) +## Return the size of the Kronecker product @var{KP} as a vector. +## @seealso{size, @@kronprod/rows, @@kronprod/columns, @@kronprod/numel} +## @end deftypefn + +function retval = size (KP, dim) + if (nargin < 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("size: input must be of class 'kronprod'"); + endif + if (nargin > 1 && !(isscalar (dim) && dim == round (dim) && dim > 0)) + error ("size: optional second input must be a positive integer"); + endif + + retval = size (KP.A) .* size (KP.B); + if (nargin > 1) + retval = retval (dim); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/size_equal.m b/octave_packages/linear-algebra-2.2.0/@kronprod/size_equal.m new file mode 100644 index 0000000..ce4221a --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/size_equal.m @@ -0,0 +1,23 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} size_equal (...) +## XXX: Write documentation +## @end deftypefn + +function iseq = size_equal (varargin) + iseq = isequal (cellfun (@size, varargin, "UniformOutput", false){:}); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/sparse.m b/octave_packages/linear-algebra-2.2.0/@kronprod/sparse.m new file mode 100644 index 0000000..d947169 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/sparse.m @@ -0,0 +1,33 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} sparse (@var{KP}) +## Return the Kronecker product @var{KP} represented as a sparse matrix. +## @seealso{sparse, @@kronprod/issparse, @@kronprod/full} +## @end deftypefn + +function retval = sparse (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("sparse: input argument must be of class 'kronprod'"); + endif + + ## XXX: Would this be better? kron (sparse (KP.A), sparse (KP.B))) + retval = sparse (kron (KP.A, KP.B)); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/times.m b/octave_packages/linear-algebra-2.2.0/@kronprod/times.m new file mode 100644 index 0000000..249e761 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/times.m @@ -0,0 +1,67 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} times (@var{KP}) +## XXX: Write documentation +## @end deftypefn + +function retval = times (M1, M2) + ## Check input + if (nargin == 0) + print_usage (); + elseif (nargin == 1) + ## This seems to be what happens for full and sparse matrices, so we copy this behaviour + retval = M1; + return; + endif + + if (!ismatrix (M1) || !ismatrix (M2)) + error ("times: input arguments must be matrices"); + endif + + if (!size_equal (M1, M2)) + error ("times: nonconformant arguments (op1 is %dx%d, op2 is %dx%d)", + rows (M1), columns (M1), rows (M2), columns (M2)); + endif + + ## Take action depending on input types + M1_is_KP = isa (M1, "kronprod"); + M2_is_KP = isa (M2, "kronprod"); + + ## Product of Kronecker Products + ## Check if the size match such that the result is a Kronecker Product + if (M1_is_KP && M2_is_KP && size_equal (M1.A, M2.A) && size_equal (M1.B, M2.B)) + retval = kronprod (M1.A .* M2.A, M1.B .* M2.B); + elseif (isscalar (M1) || isscalar (M2)) # Product of Kronecker Product and scalar + retval = M1 * M2; ## Forward to mtimes. + else # All other cases. + ## Form the full matrix or sparse matrix of both matrices + ## XXX: Can we do something smarter here? + if (issparse (M1)) + M1 = sparse (M1); + else + M1 = full (M1); + endif + + if (issparse (M2)) + M2 = sparse (M2); + else + M2 = full (M2); + endif + + retval = M1 .* M2; + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/trace.m b/octave_packages/linear-algebra-2.2.0/@kronprod/trace.m new file mode 100644 index 0000000..75be2a5 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/trace.m @@ -0,0 +1,41 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} trace (@var{KP}) +## Returns the trace of the Kronecker product @var{KP}. +## +## If @var{KP} is a Kronecker product of two square matrices, the trace is +## computed as the product of the trace of these two matrices. Otherwise the +## trace is computed by forming the full matrix. +## @seealso{@@kronprod/det, @@kronprod/rank, @@kronprod/full} +## @end deftypefn + +function retval = trace (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("trace: input must be of class 'kronprod'"); + endif + + if (issquare (KP.A) && issquare (KP.B)) + retval = trace (KP.A) * trace (KP.B); + else + ## XXX: Can we do something smarter here? Using 'eig' or 'svd'? + retval = trace (full (KP)); + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/transpose.m b/octave_packages/linear-algebra-2.2.0/@kronprod/transpose.m new file mode 100644 index 0000000..e7d27bf --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/transpose.m @@ -0,0 +1,37 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} transpose (@var{KP}) +## Returns the transpose of the Kronecker product @var{KP}. This is equivalent +## to +## +## @example +## @var{KP}.' +## @end example +## @seealso{transpose, @@kronprod/ctranspose} +## @end deftypefn + +function retval = transpose (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("transpose: input must be of class 'kronprod'"); + endif + + retval = kronprod (transpose (KP.A), transpose (KP.B)); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/uminus.m b/octave_packages/linear-algebra-2.2.0/@kronprod/uminus.m new file mode 100644 index 0000000..9a82fdc --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/uminus.m @@ -0,0 +1,38 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} uminus (@var{KP}) +## Returns the unary minus operator working on the Kronecker product @var{KP}. +## This corresponds to @code{-@var{KP}} and simply returns the Kronecker +## product with the sign of the smallest matrix in the product reversed. +## @seealso{@@kronprod/uminus} +## @end deftypefn + +function KP = uplus (KP) + if (nargin != 1) + print_usage (); + endif + + if (!isa (KP, "kronprod")) + error ("uplus: input must be of class 'kronprod'"); + endif + + if (numel (KP.A) < numel (KP.B)) + KP.A *= -1; + else + KP.B *= -1; + endif +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/@kronprod/uplus.m b/octave_packages/linear-algebra-2.2.0/@kronprod/uplus.m new file mode 100644 index 0000000..7b1dee2 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/@kronprod/uplus.m @@ -0,0 +1,25 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3, 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 file. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} uplus (@var{KP}) +## Returns the unary plus operator working on the Kronecker product @var{KP}. +## This corresponds to @code{+@var{KP}} and simply returns the Kronecker +## product unchanged. +## @seealso{@@kronprod/uminus} +## @end deftypefn + +function KP = uplus (KP) +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/cartprod.m b/octave_packages/linear-algebra-2.2.0/cartprod.m new file mode 100644 index 0000000..f575e01 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/cartprod.m @@ -0,0 +1,59 @@ +## Copyright (C) 2008 Muthiah Annamalai +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cartprod (@var{varargin}) +## +## Computes the cartesian product of given column vectors ( row vectors ). +## The vector elements are assumend to be numbers. +## +## Alternatively the vectors can be specified by as a matrix, by its columns. +## +## To calculate the cartesian product of vectors, +## P = A x B x C x D ... . Requires A, B, C, D be column vectors. +## The algorithm is iteratively calcualte the products, +## ( ( (A x B ) x C ) x D ) x etc. +## +## @example +## @group +## cartprod(1:2,3:4,0:1) +## ans = 1 3 0 +## 2 3 0 +## 1 4 0 +## 2 4 0 +## 1 3 1 +## 2 3 1 +## 1 4 1 +## 2 4 1 +## @end group +## @end example +## @end deftypefn +## @seealso{kron} + +function p = cartprod (varargin) + if (nargin < 1) + print_usage (); + elseif (nargin == 1) + p = varargin{1}; + endif + + [p{1:nargin}] = ndgrid (varargin{:}); + p = cat (nargin+1, p{:}); + p = reshape (p, [], nargin); + +endfunction + +%!assert(cartprod(1:2,0:1),[1 0; 2 0; 1 1; 2 1]) diff --git a/octave_packages/linear-algebra-2.2.0/circulant_eig.m b/octave_packages/linear-algebra-2.2.0/circulant_eig.m new file mode 100644 index 0000000..39312c7 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/circulant_eig.m @@ -0,0 +1,66 @@ +## Copyright (C) 2012 Nir Krakauer +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{lambda} =} circulant_eig (@var{v}) +## @deftypefnx{Function File} {[@var{vs}, @var{lambda}] =} circulant_eig (@var{v}) +## +## Fast, compact calculation of eigenvalues and eigenvectors of a circulant matrix@* +## Given an @var{n}*1 vector @var{v}, return the eigenvalues @var{lambda} and optionally eigenvectors @var{vs} of the @var{n}*@var{n} circulant matrix @var{C} that has @var{v} as its first column +## +## Theoretically same as @code{eig(make_circulant_matrix(v))}, but many fewer computations; does not form @var{C} explicitly +## +## Reference: Robert M. Gray, Toeplitz and Circulant Matrices: A Review, Now Publishers, http://ee.stanford.edu/~gray/toeplitz.pdf, Chapter 3 +## +## @seealso{circulant_make_matrix, circulant_matrix_vector_product, circulant_inv} +## @end deftypefn + +function [a, b] = circulant_eig (v) + + ## FIXME when warning for broadcastin is turned off by default, this + ## unwind_protect block could be removed + + ## we are using broadcasting on the code below so we turn off the + ## warnings but will restore to previous state at the end + bc_warn = warning ("query", "Octave:broadcast"); + unwind_protect + warning ("off", "Octave:broadcast"); + + #find the eigenvalues + n = numel(v); + lambda = ones(n, 1); + s = (0:(n-1)); + lambda = sum(v .* exp(-2*pi*i*s'*s/n))'; + + if nargout < 2 + a = lambda; + return + endif + + #find the eigenvectors (which in fact do not depend on v) + a = exp(-2*i*pi*s'*s/n) / sqrt(n); + b = diag(lambda); + unwind_protect_cleanup + ## restore broadcats warning status + warning (bc_warn.state, "Octave:broadcast"); + end_unwind_protect + +endfunction + +%!shared v,C,vs,lambda +%! v = [1 2 3]'; +%! C = circulant_make_matrix(v); +%! [vs lambda] = circulant_eig(v); +%!assert (vs*lambda, C*vs, 100*eps); diff --git a/octave_packages/linear-algebra-2.2.0/circulant_inv.m b/octave_packages/linear-algebra-2.2.0/circulant_inv.m new file mode 100644 index 0000000..2f37767 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/circulant_inv.m @@ -0,0 +1,44 @@ +## Copyright (C) 2012 Nir Krakauer +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{c} =} circulant_inv (@var{v}) +## +## Fast, compact calculation of inverse of a circulant matrix@* +## Given an @var{n}*1 vector @var{v}, return the inverse @var{c} of the @var{n}*@var{n} circulant matrix @var{C} that has @var{v} as its first column +## The returned @var{c} is the first column of the inverse, which is also circulant -- to get the full matrix, use `circulant_make_matrix(c)' +## +## Theoretically same as @code{inv(make_circulant_matrix(v))(:, 1)}, but requires many fewer computations and does not form matrices explicitly +## +## Roundoff may induce a small imaginary component in @var{c} even if @var{v} is real -- use @code{real(c)} to remedy this +## +## Reference: Robert M. Gray, Toeplitz and Circulant Matrices: A Review, Now Publishers, http://ee.stanford.edu/~gray/toeplitz.pdf, Chapter 3 +## +## @seealso{circulant_make_matrix, circulant_matrix_vector_product, circulant_eig} +## @end deftypefn + +function c = circulant_inv(v) + + ## Find the eigenvalues and eigenvectors + [vs, lambda] = circulant_eig(v); + + ## Find the first column of the inverse + c = vs * diag(1 ./ diag(lambda)) * conj(vs(:, 1)); + +endfunction + +%!shared v +%! v = [1 2 3]'; +%!assert (circulant_make_matrix(circulant_inv(v)), inv(circulant_make_matrix(v)), 10*eps); diff --git a/octave_packages/linear-algebra-2.2.0/circulant_make_matrix.m b/octave_packages/linear-algebra-2.2.0/circulant_make_matrix.m new file mode 100644 index 0000000..069023a --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/circulant_make_matrix.m @@ -0,0 +1,41 @@ +## Copyright (C) 2012 Nir Krakauer +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{C} =} circulant_make_matrix (@var{v}) +## +## Produce a full circulant matrix given the first column@* +## Given an @var{n}*1 vector @var{v}, returns the @var{n}*@var{n} circulant matrix @var{C} where @var{v} is the left column and all other columns are downshifted versions of @var{v} +## +## Note: If the first row @var{r} of a circulant matrix is given, the first column @var{v} can be obtained as @code{v = r([1 end:-1:2])} +## +## Reference: Gene H. Golub and Charles F. Van Loan, Matrix Computations, 3rd Ed., Section 4.7.7 +## +## @seealso{circulant_matrix_vector_product, circulant_eig, circulant_inv} +## @end deftypefn + +function C = circulant_make_matrix(v) + + n = numel(v); + C = ones(n, n); + for i = 1:n + C(:, i) = v([(end-i+2):end 1:(end-i+1)]); #or circshift(v, i-1) + endfor + +endfunction + +%!shared v,C +%! v = [1 2 3]'; C = [1 3 2; 2 1 3; 3 2 1]; +%!assert (circulant_make_matrix(v), C); diff --git a/octave_packages/linear-algebra-2.2.0/circulant_matrix_vector_product.m b/octave_packages/linear-algebra-2.2.0/circulant_matrix_vector_product.m new file mode 100644 index 0000000..2ee79b9 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/circulant_matrix_vector_product.m @@ -0,0 +1,42 @@ +## Copyright (C) 2012 Nir Krakauer +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{y} =} circulant_matrix_vector_product (@var{v}, @var{x}) +## +## Fast, compact calculation of the product of a circulant matrix with a vector@* +## Given @var{n}*1 vectors @var{v} and @var{x}, return the matrix-vector product @var{y} = @var{C}@var{x}, where @var{C} is the @var{n}*@var{n} circulant matrix that has @var{v} as its first column +## +## Theoretically the same as @code{make_circulant_matrix(x) * v}, but does not form @var{C} explicitly; uses the discrete Fourier transform +## +## Because of roundoff, the returned @var{y} may have a small imaginary component even if @var{v} and @var{x} are real (use @code{real(y)} to remedy this) +## +## Reference: Gene H. Golub and Charles F. Van Loan, Matrix Computations, 3rd Ed., Section 4.7.7 +## +## @seealso{circulant_make_matrix, circulant_eig, circulant_inv} +## @end deftypefn + +function y = circulant_matrix_vector_product (v, x) + + xf = fft(x); + vf = fft(v); + z = vf .* xf; + y = ifft(z); + +endfunction + +%!shared v,x +%! v = [1 2 3]'; x = [2 5 6]'; +%!assert (circulant_matrix_vector_product(v, x), circulant_make_matrix(v)*x, eps); diff --git a/octave_packages/linear-algebra-2.2.0/cod.m b/octave_packages/linear-algebra-2.2.0/cod.m new file mode 100644 index 0000000..1c71358 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/cod.m @@ -0,0 +1,96 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{q}, @var{r}, @var{z}] =} cod (@var{a}) +## @deftypefnx{Function File} {[@var{q}, @var{r}, @var{z}, @var{p}] =} cod (@var{a}) +## @deftypefnx{Function File} {[@dots{}] =} cod (@var{a}, '0') +## Computes the complete orthogonal decomposition (COD) of the matrix @var{a}: +## @example +## @var{a} = @var{q}*@var{r}*@var{z}' +## @end example +## Let @var{a} be an M-by-N matrix, and let @code{K = min(M, N)}. +## Then @var{q} is M-by-M orthogonal, @var{z} is N-by-N orthogonal, +## and @var{r} is M-by-N such that @code{@var{r}(:,1:K)} is upper +## trapezoidal and @code{@var{r}(:,K+1:N)} is zero. +## The additional @var{p} output argument specifies that pivoting should be used in +## the first step (QR decomposition). In this case, +## @example +## @var{a}*@var{p} = @var{q}*@var{r}*@var{z}' +## @end example +## If a second argument of '0' is given, an economy-sized factorization is returned +## so that @var{r} is K-by-K. +## +## @emph{NOTE}: This is currently implemented by double QR factorization plus some +## tricky manipulations, and is not as efficient as using xRZTZF from LAPACK. +## @seealso{qr} +## @end deftypefn + +## Author: Jaroslav Hajek + +function [q, r, z, p] = cod (a, varargin) + + if (nargin < 1 || nargin > 2 || nargout > 4 || ! ismatrix (a)) + print_usage (); + endif + + [m, n] = size (a); + k = min (m, n); + economy = nargin == 2; + pivoted = nargout == 4; + + ## Compute the initial QR decomposition + if (pivoted) + [q, r, p] = qr (a, varargin{:}); + else + [q, r] = qr (a, varargin{:}); + endif + + if (m >= n) + ## In this case, Z is identity, and we're finished. + z = eye (n, class (a)); + else + ## Permutation inverts row order. + pr = eye (m) (m:-1:1, :); + ## Permutation inverts first m columns order. + pc = eye (n) ([m:-1:1, m+1:n], :); + ## Make n-by-m matrix, invert first m columns + r = (pr * r * pc')'; + ## QR factorize again. + [z, r] = qr (r, varargin{:}); + ## Recover final R and Z + if (economy) + r = pr * r' * pr'; + z = pc * z * pr'; + else + r = pr * r' * pc'; + z = pc * z * pc'; + endif + endif + +endfunction + +%!test +%! a = rand (5, 10); +%! [q, r, z] = cod (a); +%! assert (norm (q*r*z' - a) / norm (a) < 1e-10); +%!test +%! a = rand (5, 10) + i * rand (5, 10); +%! [q, r, z] = cod (a); +%! assert (norm (q*r*z' - a) / norm (a) < 1e-10); +%!test +%! a = rand (5, 10); +%! [q, r, z, p] = cod (a); +%! assert (norm (q*r*z' - a*p) / norm (a) < 1e-10); diff --git a/octave_packages/linear-algebra-2.2.0/condeig.m b/octave_packages/linear-algebra-2.2.0/condeig.m new file mode 100644 index 0000000..44b1d17 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/condeig.m @@ -0,0 +1,122 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{c} =} condeig (@var{a}) +## @deftypefnx {Function File} {[@var{v}, @var{lambda}, @var{c}] =} condeig (@var{a}) +## Compute condition numbers of the eigenvalues of a matrix. The +## condition numbers are the reciprocals of the cosines of the angles +## between the left and right eigenvectors. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{a} must be a square numeric matrix. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{c} is a vector of condition numbers of the eigenvalue of +## @var{a}. +## +## @item +## @var{v} is the matrix of right eigenvectors of @var{a}. The result is +## the same as for @code{[v, lambda] = eig (a)}. +## +## @item +## @var{lambda} is the diagonal matrix of eigenvalues of @var{a}. The +## result is the same as for @code{[v, lambda] = eig (a)}. +## @end itemize +## +## @subheading Example +## +## @example +## @group +## a = [1, 2; 3, 4]; +## c = condeig (a) +## @result{} [1.0150; 1.0150] +## @end group +## @end example +## @end deftypefn + +function [v, lambda, c] = condeig (a) + + # Check arguments + if (nargin != 1 || nargout > 3) + print_usage (); + endif + + if (! isempty (a) && ! ismatrix (a)) + error ("condeig: a must be a numeric matrix"); + endif + + if (columns (a) != rows (a)) + error ("condeig: a must be a square matrix"); + endif + + if (issparse (a) && (nargout == 0 || nargout == 1) && exist ("svds", "file")) + ## Try to use svds to calculate the condition as it will typically be much + ## faster than calling eig as only the smallest and largest eigenvalue are + ## calculated. + try + s0 = svds (a, 1, 0); + v = svds (a, 1) / s0; + catch + ## Caught an error as there is a singular value exactly at Zero!! + v = Inf; + end_try_catch + return; + endif + + # Right eigenvectors + [v, lambda] = eig (a); + + if (isempty (a)) + c = lambda; + else + # Corresponding left eigenvectors + vl = inv (v)'; + # Normalize vectors + vl = vl ./ repmat (sqrt (sum (abs (vl .^ 2))), rows (vl), 1); + + # Condition numbers + # cos (angle) = (norm (v1) * norm (v2)) / dot (v1, v2) + # Norm of the eigenvectors is 1 => norm (v1) * norm (v2) = 1 + c = abs (1 ./ dot (vl, v)'); + endif + + if (nargout == 0 || nargout == 1) + v = c; + endif + +endfunction + +%!test +%! a = [1, 2; 3, 4]; +%! c = condeig (a); +%! expected_c = [1.0150; 1.0150]; +%! assert (c, expected_c, 0.001); + +%!test +%! a = [1, 3; 5, 8]; +%! [v, lambda, c] = condeig (a); +%! [expected_v, expected_lambda] = eig (a); +%! expected_c = [1.0182; 1.0182]; +%! assert (v, expected_v, 0.001); +%! assert (lambda, expected_lambda, 0.001); +%! assert (c, expected_c, 0.001); diff --git a/octave_packages/linear-algebra-2.2.0/doc-cache b/octave_packages/linear-algebra-2.2.0/doc-cache new file mode 100644 index 0000000..ae3b256 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/doc-cache @@ -0,0 +1,972 @@ +# Created by Octave 3.6.1, Mon May 21 19:48:13 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 16 +# name: +# type: sq_string +# elements: 1 +# length: 8 +cartprod + + +# name: +# type: sq_string +# elements: 1 +# length: 770 + -- Function File: cartprod (VARARGIN) + Computes the cartesian product of given column vectors ( row + vectors ). The vector elements are assumend to be numbers. + + Alternatively the vectors can be specified by as a matrix, by its + columns. + + To calculate the cartesian product of vectors, P = A x B x C x D + ... . Requires A, B, C, D be column vectors. The algorithm is + iteratively calcualte the products, ( ( (A x B ) x C ) x D ) x + etc. + + cartprod(1:2,3:4,0:1) + ans = 1 3 0 + 2 3 0 + 1 4 0 + 2 4 0 + 1 3 1 + 2 3 1 + 1 4 1 + 2 4 1 + + See also: kron + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +Computes the cartesian product of given column vectors ( row vectors ). + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +circulant_eig + + +# name: +# type: sq_string +# elements: 1 +# length: 718 + -- Function File: LAMBDA = circulant_eig (V) + -- Function File: [VS, LAMBDA] = circulant_eig (V) + Fast, compact calculation of eigenvalues and eigenvectors of a + circulant matrix + Given an N*1 vector V, return the eigenvalues LAMBDA and + optionally eigenvectors VS of the N*N circulant matrix C that has + V as its first column + + Theoretically same as `eig(make_circulant_matrix(v))', but many + fewer computations; does not form C explicitly + + Reference: Robert M. Gray, Toeplitz and Circulant Matrices: A + Review, Now Publishers, http://ee.stanford.edu/~gray/toeplitz.pdf, + Chapter 3 + + See also: circulant_make_matrix, circulant_matrix_vector_product, + circulant_inv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Fast, compact calculation of eigenvalues and eigenvectors of a +circulant matrix + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +circulant_inv + + +# name: +# type: sq_string +# elements: 1 +# length: 875 + -- Function File: C = circulant_inv (V) + Fast, compact calculation of inverse of a circulant matrix + Given an N*1 vector V, return the inverse C of the N*N circulant + matrix C that has V as its first column The returned C is the + first column of the inverse, which is also circulant - to get the + full matrix, use `circulant_make_matrix(c)' + + Theoretically same as `inv(make_circulant_matrix(v))(:, 1)', but + requires many fewer computations and does not form matrices + explicitly + + Roundoff may induce a small imaginary component in C even if V is + real - use `real(c)' to remedy this + + Reference: Robert M. Gray, Toeplitz and Circulant Matrices: A + Review, Now Publishers, http://ee.stanford.edu/~gray/toeplitz.pdf, + Chapter 3 + + See also: circulant_make_matrix, circulant_matrix_vector_product, + circulant_eig + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Fast, compact calculation of inverse of a circulant matrix +Given an N*1 vector V + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +circulant_make_matrix + + +# name: +# type: sq_string +# elements: 1 +# length: 579 + -- Function File: C = circulant_make_matrix (V) + Produce a full circulant matrix given the first column + Given an N*1 vector V, returns the N*N circulant matrix C where V + is the left column and all other columns are downshifted versions + of V + + Note: If the first row R of a circulant matrix is given, the first + column V can be obtained as `v = r([1 end:-1:2])' + + Reference: Gene H. Golub and Charles F. Van Loan, Matrix + Computations, 3rd Ed., Section 4.7.7 + + See also: circulant_matrix_vector_product, circulant_eig, + circulant_inv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Produce a full circulant matrix given the first column +Given an N*1 vector V, re + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 +circulant_matrix_vector_product + + +# name: +# type: sq_string +# elements: 1 +# length: 751 + -- Function File: Y = circulant_matrix_vector_product (V, X) + Fast, compact calculation of the product of a circulant matrix + with a vector + Given N*1 vectors V and X, return the matrix-vector product Y = + CX, where C is the N*N circulant matrix that has V as its first + column + + Theoretically the same as `make_circulant_matrix(x) * v', but does + not form C explicitly; uses the discrete Fourier transform + + Because of roundoff, the returned Y may have a small imaginary + component even if V and X are real (use `real(y)' to remedy this) + + Reference: Gene H. Golub and Charles F. Van Loan, Matrix + Computations, 3rd Ed., Section 4.7.7 + + See also: circulant_make_matrix, circulant_eig, circulant_inv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Fast, compact calculation of the product of a circulant matrix with a +vector +Giv + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +cod + + +# name: +# type: sq_string +# elements: 1 +# length: 887 + -- Function File: [Q, R, Z] = cod (A) + -- Function File: [Q, R, Z, P] = cod (A) + -- Function File: [...] = cod (A, '0') + Computes the complete orthogonal decomposition (COD) of the matrix + A: + A = Q*R*Z' + Let A be an M-by-N matrix, and let `K = min(M, N)'. Then Q is + M-by-M orthogonal, Z is N-by-N orthogonal, and R is M-by-N such + that `R(:,1:K)' is upper trapezoidal and `R(:,K+1:N)' is zero. + The additional P output argument specifies that pivoting should be + used in the first step (QR decomposition). In this case, + A*P = Q*R*Z' + If a second argument of '0' is given, an economy-sized + factorization is returned so that R is K-by-K. + + _NOTE_: This is currently implemented by double QR factorization + plus some tricky manipulations, and is not as efficient as using + xRZTZF from LAPACK. + + See also: qr + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Computes the complete orthogonal decomposition (COD) of the matrix A: + A = + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +condeig + + +# name: +# type: sq_string +# elements: 1 +# length: 784 + -- Function File: C = condeig (A) + -- Function File: [V, LAMBDA, C] = condeig (A) + Compute condition numbers of the eigenvalues of a matrix. The + condition numbers are the reciprocals of the cosines of the angles + between the left and right eigenvectors. + +Arguments +--------- + + * A must be a square numeric matrix. + +Return values +------------- + + * C is a vector of condition numbers of the eigenvalue of A. + + * V is the matrix of right eigenvectors of A. The result is the + same as for `[v, lambda] = eig (a)'. + + * LAMBDA is the diagonal matrix of eigenvalues of A. The result + is the same as for `[v, lambda] = eig (a)'. + +Example +------- + + a = [1, 2; 3, 4]; + c = condeig (a) + => [1.0150; 1.0150] + + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 +Compute condition numbers of the eigenvalues of a matrix. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +funm + + +# name: +# type: sq_string +# elements: 1 +# length: 1117 + -- Function File: B = funm (A, F) + Compute matrix equivalent of function F; F can be a function name + or a function handle. + + For trigonometric and hyperbolic functions, `thfm' is automatically + invoked as that is based on `expm' and diagonalization is avoided. + For other functions diagonalization is invoked, which implies that + -depending on the properties of input matrix A- the results can be + very inaccurate _without any warning_. For easy diagonizable and + stable matrices results of funm will be sufficiently accurate. + + Note that you should not use funm for 'sqrt', 'log' or 'exp'; + instead use sqrtm, logm and expm as these are more robust. + + Examples: + + B = funm (A, sin); + (Compute matrix equivalent of sin() ) + + function bk1 = besselk1 (x) + bk1 = besselk(x, 1); + endfunction + B = funm (A, besselk1); + (Compute matrix equivalent of bessel function K1(); a helper function + is needed here to convey extra args for besselk() ) + + See also: thfm, expm, logm, sqrtm + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute matrix equivalent of function F; F can be a function name or a +function + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +lobpcg + + +# name: +# type: sq_string +# elements: 1 +# length: 9717 + -- Function File: [BLOCKVECTORX, LAMBDA] = lobpcg (BLOCKVECTORX, + OPERATORA) + -- Function File: [BLOCKVECTORX, LAMBDA, FAILUREFLAG] = lobpcg + (BLOCKVECTORX, OPERATORA) + -- Function File: [BLOCKVECTORX, LAMBDA, FAILUREFLAG, LAMBDAHISTORY, +RESIDUALNORMSHISTORY] = lobpcg (BLOCKVECTORX, OPERATORA, OPERATORB, + OPERATORT, BLOCKVECTORY, RESIDUALTOLERANCE, MAXITERATIONS, + VERBOSITYLEVEL) + Solves Hermitian partial eigenproblems using preconditioning. + + The first form outputs the array of algebraic smallest eigenvalues + LAMBDA and corresponding matrix of orthonormalized eigenvectors + BLOCKVECTORX of the Hermitian (full or sparse) operator OPERATORA + using input matrix BLOCKVECTORX as an initial guess, without + preconditioning, somewhat similar to: + + # for real symmetric operator operatorA + opts.issym = 1; opts.isreal = 1; K = size (blockVectorX, 2); + [blockVectorX, lambda] = eigs (operatorA, K, 'SR', opts); + + # for Hermitian operator operatorA + K = size (blockVectorX, 2); + [blockVectorX, lambda] = eigs (operatorA, K, 'SR'); + + The second form returns a convergence flag. If FAILUREFLAG is 0 + then all the eigenvalues converged; otherwise not all converged. + + The third form computes smallest eigenvalues LAMBDA and + corresponding eigenvectors BLOCKVECTORX of the generalized + eigenproblem Ax=lambda Bx, where Hermitian operators OPERATORA and + OPERATORB are given as functions, as well as a preconditioner, + OPERATORT. The operators OPERATORB and OPERATORT must be in + addition _positive definite_. To compute the largest eigenpairs of + OPERATORA, simply apply the code to OPERATORA multiplied by -1. + The code does not involve _any_ matrix factorizations of OPERATORA + and OPERATORB, thus, e.g., it preserves the sparsity and the + structure of OPERATORA and OPERATORB. + + RESIDUALTOLERANCE and MAXITERATIONS control tolerance and max + number of steps, and VERBOSITYLEVEL = 0, 1, or 2 controls the + amount of printed info. LAMBDAHISTORY is a matrix with all + iterative lambdas, and RESIDUALNORMSHISTORY are matrices of the + history of 2-norms of residuals + + Required input: + * BLOCKVECTORX (class numeric) - initial approximation to + eigenvectors, full or sparse matrix n-by-blockSize. + BLOCKVECTORX must be full rank. + + * OPERATORA (class numeric, char, or function_handle) - the + main operator of the eigenproblem, can be a matrix, a + function name, or handle + + Optional function input: + * OPERATORB (class numeric, char, or function_handle) - the + second operator, if solving a generalized eigenproblem, can + be a matrix, a function name, or handle; by default if empty, + `operatorB = I'. + + * OPERATORT (class char or function_handle) - the + preconditioner, by default `operatorT(blockVectorX) = + blockVectorX'. + + Optional constraints input: + * BLOCKVECTORY (class numeric) - a full or sparse n-by-sizeY + matrix of constraints, where sizeY < n. BLOCKVECTORY must be + full rank. The iterations will be performed in the + (operatorB-) orthogonal complement of the column-space of + BLOCKVECTORY. + + Optional scalar input parameters: + * RESIDUALTOLERANCE (class numeric) - tolerance, by default, + `residualTolerance = n * sqrt (eps)' + + * MAXITERATIONS - max number of iterations, by default, + `maxIterations = min (n, 20)' + + * VERBOSITYLEVEL - either 0 (no info), 1, or 2 (with pictures); + by default, `verbosityLevel = 0'. + + Required output: + * BLOCKVECTORX and LAMBDA (class numeric) both are computed + blockSize eigenpairs, where `blockSize = size (blockVectorX, + 2)' for the initial guess BLOCKVECTORX if it is full rank. + + Optional output: + * FAILUREFLAG (class integer) as described above. + + * LAMBDAHISTORY (class numeric) as described above. + + * RESIDUALNORMSHISTORY (class numeric) as described above. + + Functions `operatorA(blockVectorX)', `operatorB(blockVectorX)' and + `operatorT(blockVectorX)' must support BLOCKVECTORX being a + matrix, not just a column vector. + + Every iteration involves one application of OPERATORA and + OPERATORB, and one of OPERATORT. + + Main memory requirements: 6 (9 if `isempty(operatorB)=0') matrices + of the same size as BLOCKVECTORX, 2 matrices of the same size as + BLOCKVECTORY (if present), and two square matrices of the size + 3*blockSize. + + In all examples below, we use the Laplacian operator in a 20x20 + square with the mesh size 1 which can be generated in MATLAB by + running: + A = delsq (numgrid ('S', 21)); + n = size (A, 1); + + or in MATLAB and Octave by: + [~,~,A] = laplacian ([19, 19]); + n = size (A, 1); + + Note that `laplacian' is a function of the specfun octave-forge + package. + + The following Example: + [blockVectorX, lambda, failureFlag] = lobpcg (randn (n, 8), A, 1e-5, 50, 2); + + attempts to compute 8 first eigenpairs without preconditioning, + but not all eigenpairs converge after 50 steps, so failureFlag=1. + + The next Example: + blockVectorY = []; + lambda_all = []; + for j = 1:4 + [blockVectorX, lambda] = lobpcg (randn (n, 2), A, blockVectorY, 1e-5, 200, 2); + blockVectorY = [blockVectorY, blockVectorX]; + lambda_all = [lambda_all' lambda']'; + pause; + end + + attemps to compute the same 8 eigenpairs by calling the code 4 + times with blockSize=2 using orthogonalization to the previously + founded eigenvectors. + + The following Example: + R = ichol (A, struct('michol', 'on')); + precfun = @(x)R\(R'\x); + [blockVectorX, lambda, failureFlag] = lobpcg (randn (n, 8), A, [], @(x)precfun(x), 1e-5, 60, 2); + + computes the same eigenpairs in less then 25 steps, so that + failureFlag=0 using the preconditioner function `precfun', defined + inline. If `precfun' is defined as an octave function in a file, + the function handle `@(x)precfun(x)' can be equivalently replaced + by the function name `precfun'. Running: + + [blockVectorX, lambda, failureFlag] = lobpcg (randn (n, 8), A, speye (n), @(x)precfun(x), 1e-5, 50, 2); + + produces similar answers, but is somewhat slower and needs more + memory as technically a generalized eigenproblem with B=I is + solved here. + + The following example for a mostly diagonally dominant sparse + matrix A demonstrates different types of preconditioning, compared + to the standard use of the main diagonal of A: + + clear all; close all; + n = 1000; + M = spdiags ([1:n]', 0, n, n); + precfun = @(x)M\x; + A = M + sprandsym (n, .1); + Xini = randn (n, 5); + maxiter = 15; + tol = 1e-5; + [~,~,~,~,rnp] = lobpcg (Xini, A, tol, maxiter, 1); + [~,~,~,~,r] = lobpcg (Xini, A, [], @(x)precfun(x), tol, maxiter, 1); + subplot (2,2,1), semilogy (r'); hold on; + semilogy (rnp', ':>'); + title ('No preconditioning (top)'); axis tight; + M(1,2) = 2; + precfun = @(x)M\x; % M is no longer symmetric + [~,~,~,~,rns] = lobpcg (Xini, A, [], @(x)precfun(x), tol, maxiter, 1); + subplot (2,2,2), semilogy (r'); hold on; + semilogy (rns', '--s'); + title ('Nonsymmetric preconditioning (square)'); axis tight; + M(1,2) = 0; + precfun = @(x)M\(x+10*sin(x)); % nonlinear preconditioning + [~,~,~,~,rnl] = lobpcg (Xini, A, [], @(x)precfun(x), tol, maxiter, 1); + subplot (2,2,3), semilogy (r'); hold on; + semilogy (rnl', '-.*'); + title ('Nonlinear preconditioning (star)'); axis tight; + M = abs (M - 3.5 * speye (n, n)); + precfun = @(x)M\x; + [~,~,~,~,rs] = lobpcg (Xini, A, [], @(x)precfun(x), tol, maxiter, 1); + subplot (2,2,4), semilogy (r'); hold on; + semilogy (rs', '-d'); + title ('Selective preconditioning (diamond)'); axis tight; + +References +========== + + This main function `lobpcg' is a version of the preconditioned +conjugate gradient method (Algorithm 5.1) described in A. V. Knyazev, +Toward the Optimal Preconditioned Eigensolver: Locally Optimal Block +Preconditioned Conjugate Gradient Method, SIAM Journal on Scientific +Computing 23 (2001), no. 2, pp. 517-541. +`http://dx.doi.org/10.1137/S1064827500366124' + +Known bugs/features +=================== + + * an excessively small requested tolerance may result in often + restarts and instability. The code is not written to produce + an eps-level accuracy! Use common sense. + + * the code may be very sensitive to the number of eigenpairs + computed, if there is a cluster of eigenvalues not completely + included, cf. + operatorA = diag ([1 1.99 2:99]); + [blockVectorX, lambda] = lobpcg (randn (100, 1),operatorA, 1e-10, 80, 2); + [blockVectorX, lambda] = lobpcg (randn (100, 2),operatorA, 1e-10, 80, 2); + [blockVectorX, lambda] = lobpcg (randn (100, 3),operatorA, 1e-10, 80, 2); + +Distribution +============ + + The main distribution site: `http://math.ucdenver.edu/~aknyazev/' + + A C-version of this code is a part of the +`http://code.google.com/p/blopex/' package and is directly available, +e.g., in PETSc and HYPRE. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +Solves Hermitian partial eigenproblems using preconditioning. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +ndcovlt + + +# name: +# type: sq_string +# elements: 1 +# length: 771 + -- Function File: Y = ndcovlt (X, T1, T2, ...) + Computes an n-dimensional covariant linear transform of an n-d + tensor, given a transformation matrix for each dimension. The + number of columns of each transformation matrix must match the + corresponding extent of X, and the number of rows determines the + corresponding extent of Y. For example: + + size (X, 2) == columns (T2) + size (Y, 2) == rows (T2) + + The element `Y(i1, i2, ...)' is defined as a sum of + + X(j1, j2, ...) * T1(i1, j1) * T2(i2, j2) * ... + + over all j1, j2, .... For two dimensions, this reduces to + Y = T1 * X * T2.' + + [] passed as a transformation matrix is converted to identity + matrix for the corresponding dimension. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Computes an n-dimensional covariant linear transform of an n-d tensor, +given a t + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +nmf_bpas + + +# name: +# type: sq_string +# elements: 1 +# length: 3768 + -- Function File: [W, H, ITER, HIS] = nmf_bpas (A, K) + Nonnegative Matrix Factorization by Alternating Nonnegativity + Constrained Least Squares using Block Principal Pivoting/Active + Set method. + + This function solves one the following problems: given A and K, + find W and H such that (1) minimize 1/2 * || A-WH ||_F^2 + (2) minimize 1/2 * ( || A-WH ||_F^2 + alpha * || W ||_F^2 + beta * + || H ||_F^2 ) (3) minimize 1/2 * ( || A-WH ||_F^2 + alpha * || + W ||_F^2 + beta * (sum_(i=1)^n || H(:,i) ||_1^2 ) ) where W>=0 + and H>=0 elementwise. The input arguments are A : Input data + matrix (m x n) and K : Target low-rank. + + *Optional Inputs* + `Type : Default is 'regularized', which is recommended for quick application testing unless 'sparse' or 'plain' is explicitly needed. If sparsity is needed for 'W' factor, then apply this function for the transpose of 'A' with formulation (3). Then, exchange 'W' and 'H' and obtain the transpose of them. Imposing sparsity for both factors is not recommended and thus not included in this software.' + + 'plain' to use formulation (1) + + 'regularized' to use formulation (2) + + 'sparse' to use formulation (3) + + `NNLSSolver : Default is 'bp', which is in general faster.' + item 'bp' to use the algorithm in [1] item 'as' to use + the algorithm in [2] + + `Alpha : Parameter alpha in the formulation (2) or (3). Default is the average of all elements in A. No good justfication for this default value, and you might want to try other values.' + + `Beta : Parameter beta in the formulation (2) or (3).' + Default is the average of all elements in A. No good + justfication for this default value, and you might want to + try other values. + + `MaxIter : Maximum number of iterations. Default is 100.' + + `MinIter : Minimum number of iterations. Default is 20.' + + `MaxTime : Maximum amount of time in seconds. Default is 100,000.' + + `Winit : (m x k) initial value for W.' + + `Hinit : (k x n) initial value for H.' + + `Tol : Stopping tolerance. Default is 1e-3. If you want to obtain a more accurate solution, decrease TOL and increase MAX_ITER at the same time.' + + `Verbose :' + + 0 (default) - No debugging information is collected. + + 1 (debugging purpose) - History of computation is returned by 'HIS' variable. + + 2 (debugging purpose) - History of computation is additionally printed on screen. + + *Outputs* + `W : Obtained basis matrix (m x k)' + + `H : Obtained coefficients matrix (k x n)' + + `iter : Number of iterations' + + `HIS : (debugging purpose) History of computation' + + Usage Examples: + nmf(A,10) + nmf(A,20,'verbose',2) + nmf(A,30,'verbose',2,'nnls_solver','as') + nmf(A,5,'verbose',2,'type','sparse') + nmf(A,60,'verbose',1,'type','plain','w_init',rand(m,k)) + nmf(A,70,'verbose',2,'type','sparse','nnls_solver','bp','alpha',1.1,'beta',1.3) + + References: [1] For using this software, please cite: + Jingu Kim and Haesun Park, Toward Faster Nonnegative Matrix + Factorization: A New Algorithm and Comparisons, + In Proceedings of the 2008 Eighth IEEE International Conference on + Data Mining (ICDM'08), 353-362, 2008 + [2] If you use 'nnls_solver'='as' (see below), please cite: + Hyunsoo Kim and Haesun Park, Nonnegative Matrix Factorization + Based + on Alternating Nonnegativity Constrained Least Squares and Active + Set Method, + SIAM Journal on Matrix Analysis and Applications, 2008, 30, 713-730 + + Check original code at `http://www.cc.gatech.edu/~jingu' + + See also: nmf_pg + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Nonnegative Matrix Factorization by Alternating Nonnegativity +Constrained Least + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nmf_pg + + +# name: +# type: sq_string +# elements: 1 +# length: 909 + -- Function File: [W, H] = nmf_pg (V, WINIT, HINIT, TOL, TIMELIMIT, + MAXITER) + Non-negative matrix factorization by alternative non-negative + least squares using projected gradients. + + The matrix V is factorized into two possitive matrices W and H + such that `V = W*H + U'. Where U is a matrix of residuals that can + be negative or positive. When the matrix V is positive the order + of the elements in U is bounded by the optional named argument TOL + (default value `1e-9'). + + The factorization is not unique and depends on the inital guess + for the matrices W and H. You can pass this initalizations using + the optional named arguments WINIT and HINIT. + + timelimit, maxiter: limit of time and iterations + + Examples: + + A = rand(10,5); + [W H] = nmf_pg(A,tol=1e-3); + U = W*H -A; + disp(max(abs(U))); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Non-negative matrix factorization by alternative non-negative least +squares usin + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +rotparams + + +# name: +# type: sq_string +# elements: 1 +# length: 463 + -- Function File: [VSTACKED, ASTACKED] = rotparams (RSTACKED) + The function w = rotparams (r) - Inverse to rotv(). + Using, W = rotparams(R) is such that rotv(w)*r' == eye(3). + + If used as, [v,a]=rotparams(r) , idem, with v (1 x 3) s.t. w == + a*v. + + 0 <= norm(w)==a <= pi + + :-O !! Does not check if 'r' is a rotation matrix. + + Ignores matrices with zero rows or with NaNs. (returns 0 for them) + + See also: rotv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +The function w = rotparams (r) - Inverse to rotv(). + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +rotv + + +# name: +# type: sq_string +# elements: 1 +# length: 500 + -- Function File: R = rotv ( v, ang ) + The functionrotv calculates a Matrix of rotation about V w/ angle + |v| r = rotv(v [,ang]) + + Returns the rotation matrix w/ axis v, and angle, in radians, + norm(v) or ang (if present). + + rotv(v) == w'*w + cos(a) * (eye(3)-w'*w) - sin(a) * crossmat(w) + + where a = norm (v) and w = v/a. + + v and ang may be vertically stacked : If 'v' is 2x3, then rotv( v + ) == [rotv(v(1,:)); rotv(v(2,:))] + + + See also: rotparams, rota, rot + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +The functionrotv calculates a Matrix of rotation about V w/ angle |v| r += rotv(v + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +smwsolve + + +# name: +# type: sq_string +# elements: 1 +# length: 614 + -- Function File: X = smwsolve (A, U, V, B) + -- Function File: smwsolve (SOLVER, U, V, B) + Solves the square system `(A + U*V')*X == B', where U and V are + matrices with several columns, using the Sherman-Morrison-Woodbury + formula, so that a system with A as left-hand side is actually + solved. This is especially advantageous if A is diagonal, sparse, + triangular or positive definite. A can be sparse or full, the + other matrices are expected to be full. Instead of a matrix A, a + user may alternatively provide a function SOLVER that performs the + left division operation. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Solves the square system `(A + U*V')*X == B', where U and V are +matrices with se + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +thfm + + +# name: +# type: sq_string +# elements: 1 +# length: 692 + -- Function File: Y = thfm (X, MODE) + Trigonometric/hyperbolic functions of square matrix X. + + MODE must be the name of a function. Valid functions are 'sin', + 'cos', 'tan', 'sec', 'csc', 'cot' and all their inverses and/or + hyperbolic variants, and 'sqrt', 'log' and 'exp'. + + The code `thfm (x, 'cos')' calculates matrix cosinus _even if_ + input matrix X is _not_ diagonalizable. + + _Important note_: This algorithm does _not_ use an eigensystem + similarity transformation. It maps the MODE functions to functions + of `expm', `logm' and `sqrtm', which are known to be robust with + respect to non-diagonalizable ('defective') X. + + See also: funm + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Trigonometric/hyperbolic functions of square matrix X. + + + + + diff --git a/octave_packages/linear-algebra-2.2.0/funm.m b/octave_packages/linear-algebra-2.2.0/funm.m new file mode 100644 index 0000000..d9fcc49 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/funm.m @@ -0,0 +1,86 @@ +## Copyright (C) 2000, 2011 P.R. Nienhuis +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{B} =} funm (@var{A}, @var{F}) +## Compute matrix equivalent of function F; F can be a function name or +## a function handle. +## +## For trigonometric and hyperbolic functions, @code{thfm} is automatically +## invoked as that is based on @code{expm} and diagonalization is avoided. +## For other functions diagonalization is invoked, which implies that +## -depending on the properties of input matrix @var{A}- the results +## can be very inaccurate @emph{without any warning}. For easy diagonizable and +## stable matrices results of funm will be sufficiently accurate. +## +## Note that you should not use funm for 'sqrt', 'log' or 'exp'; instead +## use sqrtm, logm and expm as these are more robust. +## +## Examples: +## +## @example +## B = funm (A, sin); +## (Compute matrix equivalent of sin() ) +## @end example +## +## @example +## function bk1 = besselk1 (x) +## bk1 = besselk(x, 1); +## endfunction +## B = funm (A, besselk1); +## (Compute matrix equivalent of bessel function K1(); a helper function +## is needed here to convey extra args for besselk() ) +## @end example +## +## @seealso{thfm, expm, logm, sqrtm} +## @end deftypefn + +function B = funm (A, name) + + persistent thfuncs = {"cos", "sin", "tan", "sec", "csc", "cot", ... + "cosh", "sinh", "tanh", "sech", "csch", "coth", ... + "acos", "asin", "atan", "asec", "acsc", "acot", ... + "acosh", "asinh", "atanh", "asech", "acsch", "acoth", ... + } + + ## Function handle supplied? + try + ishndl = isstruct (functions (name)); + fname = functions (name).function; + catch + ishdnl = 0; + fname = ' ' + end_try_catch + + if (nargin < 2 || (!(ischar (name) || ishndl)) || ischar (A)) + usage ("B = funm (A, 'f' where A = square matrix and f = function name"); + endif + + if (~isempty (find (ismember (thfuncs, fname)))) + ## Use more robust thfm () + if (ishndl); name = fname; endif + B = thfm (A, name); + else + ## Simply invoke eigenvalues. Note: risk for repeated eigenvalues!! + ## Modeled after suggestion by N. Higham (based on R. Davis, 2007) + ## FIXME Do we need automatic setting of TOL? + tol = 1.e-15; + [V, D] = eig (A + tol * randn (size(A))); + D = diag (feval (name, diag(D))); + B = V * D / V; + endif + +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/lobpcg.m b/octave_packages/linear-algebra-2.2.0/lobpcg.m new file mode 100644 index 0000000..3058591 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/lobpcg.m @@ -0,0 +1,1070 @@ +## Copyright (C) 2000-2011 A.V. Knyazev +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU Lesser 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 Lesser General Public License +## for more details. +## +## You should have received a copy of the GNU Lesser General Public License +## along with this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{blockVectorX}, @var{lambda}] =} lobpcg (@var{blockVectorX}, @var{operatorA}) +## @deftypefnx {Function File} {[@var{blockVectorX}, @var{lambda}, @var{failureFlag}] =} lobpcg (@var{blockVectorX}, @var{operatorA}) +## @deftypefnx {Function File} {[@var{blockVectorX}, @var{lambda}, @var{failureFlag}, @var{lambdaHistory}, @var{residualNormsHistory}] =} lobpcg (@var{blockVectorX}, @var{operatorA}, @var{operatorB}, @var{operatorT}, @var{blockVectorY}, @var{residualTolerance}, @var{maxIterations}, @var{verbosityLevel}) +## Solves Hermitian partial eigenproblems using preconditioning. +## +## The first form outputs the array of algebraic smallest eigenvalues @var{lambda} and +## corresponding matrix of orthonormalized eigenvectors @var{blockVectorX} of the +## Hermitian (full or sparse) operator @var{operatorA} using input matrix +## @var{blockVectorX} as an initial guess, without preconditioning, somewhat +## similar to: +## +## @example +## # for real symmetric operator operatorA +## opts.issym = 1; opts.isreal = 1; K = size (blockVectorX, 2); +## [blockVectorX, lambda] = eigs (operatorA, K, 'SR', opts); +## +## # for Hermitian operator operatorA +## K = size (blockVectorX, 2); +## [blockVectorX, lambda] = eigs (operatorA, K, 'SR'); +## @end example +## +## The second form returns a convergence flag. If @var{failureFlag} is 0 then +## all the eigenvalues converged; otherwise not all converged. +## +## The third form computes smallest eigenvalues @var{lambda} and corresponding eigenvectors +## @var{blockVectorX} of the generalized eigenproblem Ax=lambda Bx, where +## Hermitian operators @var{operatorA} and @var{operatorB} are given as functions, as +## well as a preconditioner, @var{operatorT}. The operators @var{operatorB} and +## @var{operatorT} must be in addition @emph{positive definite}. To compute the largest +## eigenpairs of @var{operatorA}, simply apply the code to @var{operatorA} multiplied by +## -1. The code does not involve @emph{any} matrix factorizations of @var{operatorA} and +## @var{operatorB}, thus, e.g., it preserves the sparsity and the structure of +## @var{operatorA} and @var{operatorB}. +## +## @var{residualTolerance} and @var{maxIterations} control tolerance and max number of +## steps, and @var{verbosityLevel} = 0, 1, or 2 controls the amount of printed +## info. @var{lambdaHistory} is a matrix with all iterative lambdas, and +## @var{residualNormsHistory} are matrices of the history of 2-norms of residuals +## +## Required input: +## @itemize @bullet +## @item +## @var{blockVectorX} (class numeric) - initial approximation to eigenvectors, +## full or sparse matrix n-by-blockSize. @var{blockVectorX} must be full rank. +## @item +## @var{operatorA} (class numeric, char, or function_handle) - the main operator +## of the eigenproblem, can be a matrix, a function name, or handle +## @end itemize +## +## Optional function input: +## @itemize @bullet +## @item +## @var{operatorB} (class numeric, char, or function_handle) - the second operator, +## if solving a generalized eigenproblem, can be a matrix, a function name, or +## handle; by default if empty, @code{operatorB = I}. +## @item +## @var{operatorT} (class char or function_handle) - the preconditioner, by +## default @code{operatorT(blockVectorX) = blockVectorX}. +## @end itemize +## +## Optional constraints input: +## @itemize @bullet +## @item +## @var{blockVectorY} (class numeric) - a full or sparse n-by-sizeY matrix of +## constraints, where sizeY < n. @var{blockVectorY} must be full rank. The +## iterations will be performed in the (operatorB-) orthogonal complement of the +## column-space of @var{blockVectorY}. +## @end itemize +## +## Optional scalar input parameters: +## @itemize @bullet +## @item +## @var{residualTolerance} (class numeric) - tolerance, by default, @code{residualTolerance = n * sqrt (eps)} +## @item +## @var{maxIterations} - max number of iterations, by default, @code{maxIterations = min (n, 20)} +## @item +## @var{verbosityLevel} - either 0 (no info), 1, or 2 (with pictures); by +## default, @code{verbosityLevel = 0}. +## @end itemize +## +## Required output: +## @itemize @bullet +## @item +## @var{blockVectorX} and @var{lambda} (class numeric) both are computed +## blockSize eigenpairs, where @code{blockSize = size (blockVectorX, 2)} +## for the initial guess @var{blockVectorX} if it is full rank. +## @end itemize +## +## Optional output: +## @itemize @bullet +## @item +## @var{failureFlag} (class integer) as described above. +## @item +## @var{lambdaHistory} (class numeric) as described above. +## @item +## @var{residualNormsHistory} (class numeric) as described above. +## @end itemize +## +## Functions @code{operatorA(blockVectorX)}, @code{operatorB(blockVectorX)} and +## @code{operatorT(blockVectorX)} must support @var{blockVectorX} being a matrix, not +## just a column vector. +## +## Every iteration involves one application of @var{operatorA} and @var{operatorB}, and +## one of @var{operatorT}. +## +## Main memory requirements: 6 (9 if @code{isempty(operatorB)=0}) matrices of the +## same size as @var{blockVectorX}, 2 matrices of the same size as @var{blockVectorY} +## (if present), and two square matrices of the size 3*blockSize. +## +## In all examples below, we use the Laplacian operator in a 20x20 square +## with the mesh size 1 which can be generated in MATLAB by running: +## @example +## A = delsq (numgrid ('S', 21)); +## n = size (A, 1); +## @end example +## +## or in MATLAB and Octave by: +## @example +## [~,~,A] = laplacian ([19, 19]); +## n = size (A, 1); +## @end example +## +## Note that @code{laplacian} is a function of the specfun octave-forge package. +## +## The following Example: +## @example +## [blockVectorX, lambda, failureFlag] = lobpcg (randn (n, 8), A, 1e-5, 50, 2); +## @end example +## +## attempts to compute 8 first eigenpairs without preconditioning, but not all +## eigenpairs converge after 50 steps, so failureFlag=1. +## +## The next Example: +## @example +## blockVectorY = []; +## lambda_all = []; +## for j = 1:4 +## [blockVectorX, lambda] = lobpcg (randn (n, 2), A, blockVectorY, 1e-5, 200, 2); +## blockVectorY = [blockVectorY, blockVectorX]; +## lambda_all = [lambda_all' lambda']'; +## pause; +## end +## @end example +## +## attemps to compute the same 8 eigenpairs by calling the code 4 times with +## blockSize=2 using orthogonalization to the previously founded eigenvectors. +## +## The following Example: +## @example +## R = ichol (A, struct('michol', 'on')); +## precfun = @@(x)R\(R'\x); +## [blockVectorX, lambda, failureFlag] = lobpcg (randn (n, 8), A, [], @@(x)precfun(x), 1e-5, 60, 2); +## @end example +## +## computes the same eigenpairs in less then 25 steps, so that failureFlag=0 +## using the preconditioner function @code{precfun}, defined inline. If @code{precfun} +## is defined as an octave function in a file, the function handle +## @code{@@(x)precfun(x)} can be equivalently replaced by the function name @code{precfun}. Running: +## +## @example +## [blockVectorX, lambda, failureFlag] = lobpcg (randn (n, 8), A, speye (n), @@(x)precfun(x), 1e-5, 50, 2); +## @end example +## +## produces similar answers, but is somewhat slower and needs more memory as +## technically a generalized eigenproblem with B=I is solved here. +## +## The following example for a mostly diagonally dominant sparse matrix A +## demonstrates different types of preconditioning, compared to the standard +## use of the main diagonal of A: +## +## @example +## clear all; close all; +## n = 1000; +## M = spdiags ([1:n]', 0, n, n); +## precfun = @@(x)M\x; +## A = M + sprandsym (n, .1); +## Xini = randn (n, 5); +## maxiter = 15; +## tol = 1e-5; +## [~,~,~,~,rnp] = lobpcg (Xini, A, tol, maxiter, 1); +## [~,~,~,~,r] = lobpcg (Xini, A, [], @@(x)precfun(x), tol, maxiter, 1); +## subplot (2,2,1), semilogy (r'); hold on; +## semilogy (rnp', ':>'); +## title ('No preconditioning (top)'); axis tight; +## M(1,2) = 2; +## precfun = @@(x)M\x; % M is no longer symmetric +## [~,~,~,~,rns] = lobpcg (Xini, A, [], @@(x)precfun(x), tol, maxiter, 1); +## subplot (2,2,2), semilogy (r'); hold on; +## semilogy (rns', '--s'); +## title ('Nonsymmetric preconditioning (square)'); axis tight; +## M(1,2) = 0; +## precfun = @@(x)M\(x+10*sin(x)); % nonlinear preconditioning +## [~,~,~,~,rnl] = lobpcg (Xini, A, [], @@(x)precfun(x), tol, maxiter, 1); +## subplot (2,2,3), semilogy (r'); hold on; +## semilogy (rnl', '-.*'); +## title ('Nonlinear preconditioning (star)'); axis tight; +## M = abs (M - 3.5 * speye (n, n)); +## precfun = @@(x)M\x; +## [~,~,~,~,rs] = lobpcg (Xini, A, [], @@(x)precfun(x), tol, maxiter, 1); +## subplot (2,2,4), semilogy (r'); hold on; +## semilogy (rs', '-d'); +## title ('Selective preconditioning (diamond)'); axis tight; +## @end example +## +## @heading References +## This main function @code{lobpcg} is a version of the preconditioned conjugate +## gradient method (Algorithm 5.1) described in A. V. Knyazev, Toward the Optimal +## Preconditioned Eigensolver: +## Locally Optimal Block Preconditioned Conjugate Gradient Method, +## SIAM Journal on Scientific Computing 23 (2001), no. 2, pp. 517-541. +## @uref{http://dx.doi.org/10.1137/S1064827500366124} +## +## @heading Known bugs/features +## @itemize @bullet +## @item +## an excessively small requested tolerance may result in often restarts and +## instability. The code is not written to produce an eps-level accuracy! Use +## common sense. +## @item +## the code may be very sensitive to the number of eigenpairs computed, +## if there is a cluster of eigenvalues not completely included, cf. +## @example +## operatorA = diag ([1 1.99 2:99]); +## [blockVectorX, lambda] = lobpcg (randn (100, 1),operatorA, 1e-10, 80, 2); +## [blockVectorX, lambda] = lobpcg (randn (100, 2),operatorA, 1e-10, 80, 2); +## [blockVectorX, lambda] = lobpcg (randn (100, 3),operatorA, 1e-10, 80, 2); +## @end example +## @end itemize +## +## @heading Distribution +## The main distribution site: @uref{http://math.ucdenver.edu/~aknyazev/} +## +## A C-version of this code is a part of the @uref{http://code.google.com/p/blopex/} +## package and is directly available, e.g., in PETSc and HYPRE. +## @end deftypefn + +function [blockVectorX,lambda,varargout] = lobpcg(blockVectorX,operatorA,varargin) + %Begin + + % constants + + CONVENTIONAL_CONSTRAINTS = 1; + SYMMETRIC_CONSTRAINTS = 2; + + %Initial settings + + failureFlag = 1; + if nargin < 2 + error('BLOPEX:lobpcg:NotEnoughInputs',... + strcat('There must be at least 2 input agruments: ',... + 'blockVectorX and operatorA')); + end + if nargin > 8 + warning('BLOPEX:lobpcg:TooManyInputs',... + strcat('There must be at most 8 input agruments ',... + 'unless arguments are passed to a function')); + end + + if ~isnumeric(blockVectorX) + error('BLOPEX:lobpcg:FirstInputNotNumeric',... + 'The first input argument blockVectorX must be numeric'); + end + [n,blockSize]=size(blockVectorX); + if blockSize > n + error('BLOPEX:lobpcg:FirstInputFat',... + 'The first input argument blockVectorX must be tall, not fat'); + end + if n < 6 + error('BLOPEX:lobpcg:MatrixTooSmall',... + 'The code does not work for matrices of small sizes'); + end + + if isa(operatorA,'numeric') + nA = size(operatorA,1); + if any(size(operatorA) ~= nA) + error('BLOPEX:lobpcg:MatrixNotSquare',... + 'operatorA must be a square matrix or a string'); + end + if size(operatorA) ~= n + error('BLOPEX:lobpcg:MatrixWrongSize',... + ['The size ' int2str(size(operatorA))... + ' of operatorA is not the same as ' int2str(n)... + ' - the number of rows of blockVectorX']); + end + end + + count_string = 0; + + operatorT = []; + operatorB = []; + residualTolerance = []; + maxIterations = []; + verbosityLevel = []; + blockVectorY = []; sizeY = 0; + for j = 1:nargin-2 + if isequal(size(varargin{j}),[n,n]) + if isempty(operatorB) + operatorB = varargin{j}; + else + error('BLOPEX:lobpcg:TooManyMatrixInputs',... + strcat('Too many matrix input arguments. ',... + 'Preconditioner operatorT must be an M-function')); + end + elseif isequal(size(varargin{j},1),n) && size(varargin{j},2) < n + if isempty(blockVectorY) + blockVectorY = varargin{j}; + sizeY=size(blockVectorY,2); + else + error('BLOPEX:lobpcg:WrongConstraintsFormat',... + 'Something wrong with blockVectorY input argument'); + end + elseif ischar(varargin{j}) || isa(varargin{j},'function_handle') + if count_string == 0 + if isempty(operatorB) + operatorB = varargin{j}; + count_string = count_string + 1; + else + operatorT = varargin{j}; + end + elseif count_string == 1 + operatorT = varargin{j}; + else + warning('BLOPEX:lobpcg:TooManyStringFunctionHandleInputs',... + 'Too many string or FunctionHandle input arguments'); + end + elseif isequal(size(varargin{j}),[n,n]) + error('BLOPEX:lobpcg:WrongPreconditionerFormat',... + 'Preconditioner operatorT must be an M-function'); + elseif max(size(varargin{j})) == 1 + if isempty(residualTolerance) + residualTolerance = varargin{j}; + elseif isempty(maxIterations) + maxIterations = varargin{j}; + elseif isempty(verbosityLevel) + verbosityLevel = varargin{j}; + else + warning('BLOPEX:lobpcg:TooManyScalarInputs',... + 'Too many scalar parameters, need only three'); + end + elseif isempty(varargin{j}) + if isempty(operatorB) + count_string = count_string + 1; + elseif ~isempty(operatorT) + count_string = count_string + 1; + elseif ~isempty(blockVectorY) + error('BLOPEX:lobpcg:UnrecognizedEmptyInput',... + ['Unrecognized empty input argument number ' int2str(j+2)]); + end + else + error('BLOPEX:lobpcg:UnrecognizedInput',... + ['Input argument number ' int2str(j+2) ' not recognized.']); + end + end + + if verbosityLevel + if issparse(blockVectorX) + fprintf(['The sparse initial guess with %i colunms '... + 'and %i raws is detected \n'],n,blockSize); + else + fprintf(['The full initial guess with %i colunms '... + 'and %i raws is detected \n'],n,blockSize); + end + if ischar(operatorA) + fprintf('The main operator is detected as an M-function %s \n',... + operatorA); + elseif isa(operatorA,'function_handle') + fprintf('The main operator is detected as an M-function %s \n',... + func2str(operatorA)); + elseif issparse(operatorA) + fprintf('The main operator is detected as a sparse matrix \n'); + else + fprintf('The main operator is detected as a full matrix \n'); + end + if isempty(operatorB) + fprintf('Solving standard eigenvalue problem, not generalized \n'); + elseif ischar(operatorB) + fprintf(['The second operator of the generalized eigenproblem \n'... + 'is detected as an M-function %s \n'],operatorB); + elseif isa(operatorB,'function_handle') + fprintf(['The second operator of the generalized eigenproblem \n'... + 'is detected as an M-function %s \n'],func2str(operatorB)); + elseif issparse(operatorB) + fprintf(strcat('The second operator of the generalized',... + 'eigenproblem \n is detected as a sparse matrix \n')); + else + fprintf(strcat('The second operator of the generalized',... + 'eigenproblem \n is detected as a full matrix \n')); + end + if isempty(operatorT) + fprintf('No preconditioner is detected \n'); + elseif ischar(operatorT) + fprintf('The preconditioner is detected as an M-function %s \n',... + operatorT); + elseif isa(operatorT,'function_handle') + fprintf('The preconditioner is detected as an M-function %s \n',... + func2str(operatorT)); + end + if isempty(blockVectorY) + fprintf('No matrix of constraints is detected \n') + elseif issparse(blockVectorY) + fprintf('The sparse matrix of %i constraints is detected \n',sizeY); + else + fprintf('The full matrix of %i constraints is detected \n',sizeY); + end + if issparse(blockVectorY) ~= issparse(blockVectorX) + warning('BLOPEX:lobpcg:SparsityInconsistent',... + strcat('The sparsity formats of the initial guess and ',... + 'the constraints are inconsistent')); + end + end + + % Set defaults + + if isempty(residualTolerance) + residualTolerance = sqrt(eps)*n; + end + if isempty(maxIterations) + maxIterations = min(n,20); + end + if isempty(verbosityLevel) + verbosityLevel = 0; + end + + if verbosityLevel + fprintf('Tolerance %e and maximum number of iterations %i \n',... + residualTolerance,maxIterations) + end + + %constraints preprocessing + if isempty(blockVectorY) + constraintStyle = 0; + else + % constraintStyle = SYMMETRIC_CONSTRAINTS; % more accurate? + constraintStyle = CONVENTIONAL_CONSTRAINTS; + end + + if constraintStyle == CONVENTIONAL_CONSTRAINTS + + if isempty(operatorB) + gramY = blockVectorY'*blockVectorY; + else + if isnumeric(operatorB) + blockVectorBY = operatorB*blockVectorY; + else + blockVectorBY = feval(operatorB,blockVectorY); + end + gramY=blockVectorY'*blockVectorBY; + end + gramY=(gramY'+gramY)*0.5; + if isempty(operatorB) + blockVectorX = blockVectorX - ... + blockVectorY*(gramY\(blockVectorY'*blockVectorX)); + else + blockVectorX =blockVectorX - ... + blockVectorY*(gramY\(blockVectorBY'*blockVectorX)); + end + + elseif constraintStyle == SYMMETRIC_CONSTRAINTS + + if ~isempty(operatorB) + if isnumeric(operatorB) + blockVectorY = operatorB*blockVectorY; + else + blockVectorY = feval(operatorB,blockVectorY); + end + end + if isempty(operatorT) + gramY = blockVectorY'*blockVectorY; + else + blockVectorTY = feval(operatorT,blockVectorY); + gramY = blockVectorY'*blockVectorTY; + end + gramY=(gramY'+gramY)*0.5; + if isempty(operatorT) + blockVectorX = blockVectorX - ... + blockVectorY*(gramY\(blockVectorY'*blockVectorX)); + else + blockVectorX = blockVectorX - ... + blockVectorTY*(gramY\(blockVectorY'*blockVectorX)); + end + + end + + %Making the initial vectors (operatorB-) orthonormal + if isempty(operatorB) + %[blockVectorX,gramXBX] = qr(blockVectorX,0); + gramXBX=blockVectorX'*blockVectorX; + if ~isreal(gramXBX) + gramXBX=(gramXBX+gramXBX')*0.5; + end + [gramXBX,cholFlag]=chol(gramXBX); + if cholFlag ~= 0 + error('BLOPEX:lobpcg:ConstraintsTooTight',... + 'The initial approximation after constraints is not full rank'); + end + blockVectorX = blockVectorX/gramXBX; + else + %[blockVectorX,blockVectorBX] = orth(operatorB,blockVectorX); + if isnumeric(operatorB) + blockVectorBX = operatorB*blockVectorX; + else + blockVectorBX = feval(operatorB,blockVectorX); + end + gramXBX=blockVectorX'*blockVectorBX; + if ~isreal(gramXBX) + gramXBX=(gramXBX+gramXBX')*0.5; + end + [gramXBX,cholFlag]=chol(gramXBX); + if cholFlag ~= 0 + error('BLOPEX:lobpcg:InitialNotFullRank',... + sprintf('%s\n%s', ... + 'The initial approximation after constraints is not full rank',... + 'or/and operatorB is not positive definite')); + end + blockVectorX = blockVectorX/gramXBX; + blockVectorBX = blockVectorBX/gramXBX; + end + + % Checking if the problem is big enough for the algorithm, + % i.e. n-sizeY > 5*blockSize + % Theoretically, the algorithm should be able to run if + % n-sizeY > 3*blockSize, + % but the extreme cases might be unstable, so we use 5 instead of 3 here. + if n-sizeY < 5*blockSize + error('BLOPEX:lobpcg:MatrixTooSmall','%s\n%s', ... + 'The problem size is too small, relative to the block size.',... + 'Try using eig() or eigs() instead.'); + end + + % Preallocation + residualNormsHistory=zeros(blockSize,maxIterations); + lambdaHistory=zeros(blockSize,maxIterations+1); + condestGhistory=zeros(1,maxIterations+1); + + blockVectorBR=zeros(n,blockSize); + blockVectorAR=zeros(n,blockSize); + blockVectorP=zeros(n,blockSize); + blockVectorAP=zeros(n,blockSize); + blockVectorBP=zeros(n,blockSize); + + %Initial settings for the loop + if isnumeric(operatorA) + blockVectorAX = operatorA*blockVectorX; + else + blockVectorAX = feval(operatorA,blockVectorX); + end + + gramXAX = full(blockVectorX'*blockVectorAX); + gramXAX = (gramXAX + gramXAX')*0.5; + % eig(...,'chol') uses only the diagonal and upper triangle - + % not true in MATLAB + % Octave v3.2.3-4, eig() does not support inputting 'chol' + [coordX,gramXAX]=eig(gramXAX,eye(blockSize)); + + lambda=diag(gramXAX); %eig returns non-ordered eigenvalues on the diagonal + + if issparse(blockVectorX) + coordX=sparse(coordX); + end + + blockVectorX = blockVectorX*coordX; + blockVectorAX = blockVectorAX*coordX; + if ~isempty(operatorB) + blockVectorBX = blockVectorBX*coordX; + end + clear coordX + + condestGhistory(1)=-log10(eps)/2; %if too small cause unnecessary restarts + + lambdaHistory(1:blockSize,1)=lambda; + + activeMask = true(blockSize,1); + % currentBlockSize = blockSize; %iterate all + % + % restart=1;%steepest descent + + %The main part of the method is the loop of the CG method: begin + for iterationNumber=1:maxIterations + + % %Computing the active residuals + % if isempty(operatorB) + % if currentBlockSize > 1 + % blockVectorR(:,activeMask)=blockVectorAX(:,activeMask) - ... + % blockVectorX(:,activeMask)*spdiags(lambda(activeMask),0,currentBlockSize,currentBlockSize); + % else + % blockVectorR(:,activeMask)=blockVectorAX(:,activeMask) - ... + % blockVectorX(:,activeMask)*lambda(activeMask); + % %to make blockVectorR full when lambda is just a scalar + % end + % else + % if currentBlockSize > 1 + % blockVectorR(:,activeMask)=blockVectorAX(:,activeMask) - ... + % blockVectorBX(:,activeMask)*spdiags(lambda(activeMask),0,currentBlockSize,currentBlockSize); + % else + % blockVectorR(:,activeMask)=blockVectorAX(:,activeMask) - ... + % blockVectorBX(:,activeMask)*lambda(activeMask); + % %to make blockVectorR full when lambda is just a scalar + % end + % end + + %Computing all residuals + if isempty(operatorB) + if blockSize > 1 + blockVectorR = blockVectorAX - ... + blockVectorX*spdiags(lambda,0,blockSize,blockSize); + else + blockVectorR = blockVectorAX - blockVectorX*lambda; + %to make blockVectorR full when lambda is just a scalar + end + else + if blockSize > 1 + blockVectorR=blockVectorAX - ... + blockVectorBX*spdiags(lambda,0,blockSize,blockSize); + else + blockVectorR = blockVectorAX - blockVectorBX*lambda; + %to make blockVectorR full when lambda is just a scalar + end + end + + %Satisfying the constraints for the active residulas + if constraintStyle == SYMMETRIC_CONSTRAINTS + if isempty(operatorT) + blockVectorR(:,activeMask) = blockVectorR(:,activeMask) - ... + blockVectorY*(gramY\(blockVectorY'*... + blockVectorR(:,activeMask))); + else + blockVectorR(:,activeMask) = blockVectorR(:,activeMask) - ... + blockVectorY*(gramY\(blockVectorTY'*... + blockVectorR(:,activeMask))); + end + end + + residualNorms=full(sqrt(sum(conj(blockVectorR).*blockVectorR)')); + residualNormsHistory(1:blockSize,iterationNumber)=residualNorms; + + %index antifreeze + activeMask = full(residualNorms > residualTolerance) & activeMask; + %activeMask = full(residualNorms > residualTolerance); + %above allows vectors back into active, which causes problems with frosen Ps + %activeMask = full(residualNorms > 0); %iterate all, ignore freeze + + currentBlockSize = sum(activeMask); + if currentBlockSize == 0 + failureFlag=0; %all eigenpairs converged + break + end + + %Applying the preconditioner operatorT to the active residulas + if ~isempty(operatorT) + blockVectorR(:,activeMask) = ... + feval(operatorT,blockVectorR(:,activeMask)); + end + + if constraintStyle == CONVENTIONAL_CONSTRAINTS + if isempty(operatorB) + blockVectorR(:,activeMask) = blockVectorR(:,activeMask) - ... + blockVectorY*(gramY\(blockVectorY'*... + blockVectorR(:,activeMask))); + else + blockVectorR(:,activeMask) = blockVectorR(:,activeMask) - ... + blockVectorY*(gramY\(blockVectorBY'*... + blockVectorR(:,activeMask))); + end + end + + %Making active (preconditioned) residuals orthogonal to blockVectorX + if isempty(operatorB) + blockVectorR(:,activeMask) = blockVectorR(:,activeMask) - ... + blockVectorX*(blockVectorX'*blockVectorR(:,activeMask)); + else + blockVectorR(:,activeMask) = blockVectorR(:,activeMask) - ... + blockVectorX*(blockVectorBX'*blockVectorR(:,activeMask)); + end + + %Making active residuals orthonormal + if isempty(operatorB) + %[blockVectorR(:,activeMask),gramRBR]=... + %qr(blockVectorR(:,activeMask),0); %to increase stability + gramRBR=blockVectorR(:,activeMask)'*blockVectorR(:,activeMask); + if ~isreal(gramRBR) + gramRBR=(gramRBR+gramRBR')*0.5; + end + [gramRBR,cholFlag]=chol(gramRBR); + if cholFlag == 0 + blockVectorR(:,activeMask) = blockVectorR(:,activeMask)/gramRBR; + else + warning('BLOPEX:lobpcg:ResidualNotFullRank',... + 'The residual is not full rank.'); + break + end + else + if isnumeric(operatorB) + blockVectorBR(:,activeMask) = ... + operatorB*blockVectorR(:,activeMask); + else + blockVectorBR(:,activeMask) = ... + feval(operatorB,blockVectorR(:,activeMask)); + end + gramRBR=blockVectorR(:,activeMask)'*blockVectorBR(:,activeMask); + if ~isreal(gramRBR) + gramRBR=(gramRBR+gramRBR')*0.5; + end + [gramRBR,cholFlag]=chol(gramRBR); + if cholFlag == 0 + blockVectorR(:,activeMask) = ... + blockVectorR(:,activeMask)/gramRBR; + blockVectorBR(:,activeMask) = ... + blockVectorBR(:,activeMask)/gramRBR; + else + warning('BLOPEX:lobpcg:ResidualNotFullRankOrElse',... + strcat('The residual is not full rank or/and operatorB ',... + 'is not positive definite.')); + break + end + + end + clear gramRBR; + + if isnumeric(operatorA) + blockVectorAR(:,activeMask) = operatorA*blockVectorR(:,activeMask); + else + blockVectorAR(:,activeMask) = ... + feval(operatorA,blockVectorR(:,activeMask)); + end + + if iterationNumber > 1 + + %Making active conjugate directions orthonormal + if isempty(operatorB) + %[blockVectorP(:,activeMask),gramPBP] = qr(blockVectorP(:,activeMask),0); + gramPBP=blockVectorP(:,activeMask)'*blockVectorP(:,activeMask); + if ~isreal(gramPBP) + gramPBP=(gramPBP+gramPBP')*0.5; + end + [gramPBP,cholFlag]=chol(gramPBP); + if cholFlag == 0 + blockVectorP(:,activeMask) = ... + blockVectorP(:,activeMask)/gramPBP; + blockVectorAP(:,activeMask) = ... + blockVectorAP(:,activeMask)/gramPBP; + else + warning('BLOPEX:lobpcg:DirectionNotFullRank',... + 'The direction matrix is not full rank.'); + break + end + else + gramPBP=blockVectorP(:,activeMask)'*blockVectorBP(:,activeMask); + if ~isreal(gramPBP) + gramPBP=(gramPBP+gramPBP')*0.5; + end + [gramPBP,cholFlag]=chol(gramPBP); + if cholFlag == 0 + blockVectorP(:,activeMask) = ... + blockVectorP(:,activeMask)/gramPBP; + blockVectorAP(:,activeMask) = ... + blockVectorAP(:,activeMask)/gramPBP; + blockVectorBP(:,activeMask) = ... + blockVectorBP(:,activeMask)/gramPBP; + else + warning('BLOPEX:lobpcg:DirectionNotFullRank',... + strcat('The direction matrix is not full rank ',... + 'or/and operatorB is not positive definite.')); + break + end + end + clear gramPBP + end + + condestGmean = mean(condestGhistory(max(1,iterationNumber-10-... + round(log(currentBlockSize))):iterationNumber)); + + % restart=1; + + % The Raileight-Ritz method for [blockVectorX blockVectorR blockVectorP] + + if residualNorms > eps^0.6 + explicitGramFlag = 0; + else + explicitGramFlag = 1; %suggested by Garrett Moran, private + end + + activeRSize=size(blockVectorR(:,activeMask),2); + if iterationNumber == 1 + activePSize=0; + restart=1; + else + activePSize=size(blockVectorP(:,activeMask),2); + restart=0; + end + + gramXAR=full(blockVectorAX'*blockVectorR(:,activeMask)); + gramRAR=full(blockVectorAR(:,activeMask)'*blockVectorR(:,activeMask)); + gramRAR=(gramRAR'+gramRAR)*0.5; + + if explicitGramFlag + gramXAX=full(blockVectorAX'*blockVectorX); + gramXAX=(gramXAX'+gramXAX)*0.5; + if isempty(operatorB) + gramXBX=full(blockVectorX'*blockVectorX); + gramRBR=full(blockVectorR(:,activeMask)'*... + blockVectorR(:,activeMask)); + gramXBR=full(blockVectorX'*blockVectorR(:,activeMask)); + else + gramXBX=full(blockVectorBX'*blockVectorX); + gramRBR=full(blockVectorBR(:,activeMask)'*... + blockVectorR(:,activeMask)); + gramXBR=full(blockVectorBX'*blockVectorR(:,activeMask)); + end + gramXBX=(gramXBX'+gramXBX)*0.5; + gramRBR=(gramRBR'+gramRBR)*0.5; + + end + + for cond_try=1:2, %cond_try == 2 when restart + + if ~restart + gramXAP=full(blockVectorAX'*blockVectorP(:,activeMask)); + gramRAP=full(blockVectorAR(:,activeMask)'*... + blockVectorP(:,activeMask)); + gramPAP=full(blockVectorAP(:,activeMask)'*... + blockVectorP(:,activeMask)); + gramPAP=(gramPAP'+gramPAP)*0.5; + + if explicitGramFlag + gramA = [ gramXAX gramXAR gramXAP + gramXAR' gramRAR gramRAP + gramXAP' gramRAP' gramPAP ]; + else + gramA = [ diag(lambda) gramXAR gramXAP + gramXAR' gramRAR gramRAP + gramXAP' gramRAP' gramPAP ]; + end + + clear gramXAP gramRAP gramPAP + + if isempty(operatorB) + gramXBP=full(blockVectorX'*blockVectorP(:,activeMask)); + gramRBP=full(blockVectorR(:,activeMask)'*... + blockVectorP(:,activeMask)); + else + gramXBP=full(blockVectorBX'*blockVectorP(:,activeMask)); + gramRBP=full(blockVectorBR(:,activeMask)'*... + blockVectorP(:,activeMask)); + %or blockVectorR(:,activeMask)'*blockVectorBP(:,activeMask); + end + + if explicitGramFlag + if isempty(operatorB) + gramPBP=full(blockVectorP(:,activeMask)'*... + blockVectorP(:,activeMask)); + else + gramPBP=full(blockVectorBP(:,activeMask)'*... + blockVectorP(:,activeMask)); + end + gramPBP=(gramPBP'+gramPBP)*0.5; + gramB = [ gramXBX gramXBR gramXBP + gramXBR' gramRBR gramRBP + gramXBP' gramRBP' gramPBP ]; + clear gramPBP + else + gramB=[eye(blockSize) zeros(blockSize,activeRSize) gramXBP + zeros(blockSize,activeRSize)' eye(activeRSize) gramRBP + gramXBP' gramRBP' eye(activePSize) ]; + end + + clear gramXBP gramRBP; + + else + + if explicitGramFlag + gramA = [ gramXAX gramXAR + gramXAR' gramRAR ]; + gramB = [ gramXBX gramXBR + gramXBR' eye(activeRSize) ]; + clear gramXAX gramXBX gramXBR + else + gramA = [ diag(lambda) gramXAR + gramXAR' gramRAR ]; + gramB = eye(blockSize+activeRSize); + end + + clear gramXAR gramRAR; + + end + + condestG = log10(cond(gramB))+1; + if (condestG/condestGmean > 2 && condestG > 2 )|| condestG > 8 + %black magic - need to guess the restart + if verbosityLevel + fprintf('Restart on step %i as condestG %5.4e \n',... + iterationNumber,condestG); + end + if cond_try == 1 && ~restart + restart=1; %steepest descent restart for stability + else + warning('BLOPEX:lobpcg:IllConditioning',... + 'Gramm matrix ill-conditioned: results unpredictable'); + end + else + break + end + + end + + [gramA,gramB]=eig(gramA,gramB); + lambda=diag(gramB(1:blockSize,1:blockSize)); + coordX=gramA(:,1:blockSize); + + clear gramA gramB + + if issparse(blockVectorX) + coordX=sparse(coordX); + end + + if ~restart + blockVectorP = blockVectorR(:,activeMask)*... + coordX(blockSize+1:blockSize+activeRSize,:) + ... + blockVectorP(:,activeMask)*... + coordX(blockSize+activeRSize+1:blockSize + ... + activeRSize+activePSize,:); + blockVectorAP = blockVectorAR(:,activeMask)*... + coordX(blockSize+1:blockSize+activeRSize,:) + ... + blockVectorAP(:,activeMask)*... + coordX(blockSize+activeRSize+1:blockSize + ... + activeRSize+activePSize,:); + if ~isempty(operatorB) + blockVectorBP = blockVectorBR(:,activeMask)*... + coordX(blockSize+1:blockSize+activeRSize,:) + ... + blockVectorBP(:,activeMask)*... + coordX(blockSize+activeRSize+1:blockSize+activeRSize+activePSize,:); + end + else %use block steepest descent + blockVectorP = blockVectorR(:,activeMask)*... + coordX(blockSize+1:blockSize+activeRSize,:); + blockVectorAP = blockVectorAR(:,activeMask)*... + coordX(blockSize+1:blockSize+activeRSize,:); + if ~isempty(operatorB) + blockVectorBP = blockVectorBR(:,activeMask)*... + coordX(blockSize+1:blockSize+activeRSize,:); + end + end + + blockVectorX = blockVectorX*coordX(1:blockSize,:) + blockVectorP; + blockVectorAX=blockVectorAX*coordX(1:blockSize,:) + blockVectorAP; + if ~isempty(operatorB) + blockVectorBX=blockVectorBX*coordX(1:blockSize,:) + blockVectorBP; + end + clear coordX + %%end RR + + lambdaHistory(1:blockSize,iterationNumber+1)=lambda; + condestGhistory(iterationNumber+1)=condestG; + + if verbosityLevel + fprintf('Iteration %i current block size %i \n',... + iterationNumber,currentBlockSize); + fprintf('Eigenvalues lambda %17.16e \n',lambda); + fprintf('Residual Norms %e \n',residualNorms'); + end + end + %The main step of the method was the CG cycle: end + + %Postprocessing + + %Making sure blockVectorX's "exactly" satisfy the blockVectorY constrains?? + + %Making sure blockVectorX's are "exactly" othonormalized by final "exact" RR + if isempty(operatorB) + gramXBX=full(blockVectorX'*blockVectorX); + else + if isnumeric(operatorB) + blockVectorBX = operatorB*blockVectorX; + else + blockVectorBX = feval(operatorB,blockVectorX); + end + gramXBX=full(blockVectorX'*blockVectorBX); + end + gramXBX=(gramXBX'+gramXBX)*0.5; + + if isnumeric(operatorA) + blockVectorAX = operatorA*blockVectorX; + else + blockVectorAX = feval(operatorA,blockVectorX); + end + gramXAX = full(blockVectorX'*blockVectorAX); + gramXAX = (gramXAX + gramXAX')*0.5; + + %Raileigh-Ritz for blockVectorX, which is already operatorB-orthonormal + [coordX,gramXBX] = eig(gramXAX,gramXBX); + lambda=diag(gramXBX); + + if issparse(blockVectorX) + coordX=sparse(coordX); + end + + blockVectorX = blockVectorX*coordX; + blockVectorAX = blockVectorAX*coordX; + if ~isempty(operatorB) + blockVectorBX = blockVectorBX*coordX; + end + + %Computing all residuals + if isempty(operatorB) + if blockSize > 1 + blockVectorR = blockVectorAX - ... + blockVectorX*spdiags(lambda,0,blockSize,blockSize); + else + blockVectorR = blockVectorAX - blockVectorX*lambda; + %to make blockVectorR full when lambda is just a scalar + end + else + if blockSize > 1 + blockVectorR=blockVectorAX - ... + blockVectorBX*spdiags(lambda,0,blockSize,blockSize); + else + blockVectorR = blockVectorAX - blockVectorBX*lambda; + %to make blockVectorR full when lambda is just a scalar + end + end + + residualNorms=full(sqrt(sum(conj(blockVectorR).*blockVectorR)')); + residualNormsHistory(1:blockSize,iterationNumber)=residualNorms; + + if verbosityLevel + fprintf('Final Eigenvalues lambda %17.16e \n',lambda); + fprintf('Final Residual Norms %e \n',residualNorms'); + end + + if verbosityLevel == 2 + whos + figure(491) + semilogy((abs(residualNormsHistory(1:blockSize,1:iterationNumber-1)))'); + title('Residuals for Different Eigenpairs','fontsize',16); + ylabel('Eucledian norm of residuals','fontsize',16); + xlabel('Iteration number','fontsize',16); + %axis tight; + %axis([0 maxIterations+1 1e-15 1e3]) + set(gca,'FontSize',14); + figure(492); + semilogy(abs((lambdaHistory(1:blockSize,1:iterationNumber)-... + repmat(lambda,1,iterationNumber)))'); + title('Eigenvalue errors for Different Eigenpairs','fontsize',16); + ylabel('Estimated eigenvalue errors','fontsize',16); + xlabel('Iteration number','fontsize',16); + %axis tight; + %axis([0 maxIterations+1 1e-15 1e3]) + set(gca,'FontSize',14); + drawnow; + end + + varargout(1)={failureFlag}; + varargout(2)={lambdaHistory(1:blockSize,1:iterationNumber)}; + varargout(3)={residualNormsHistory(1:blockSize,1:iterationNumber-1)}; +end diff --git a/octave_packages/linear-algebra-2.2.0/ndcovlt.m b/octave_packages/linear-algebra-2.2.0/ndcovlt.m new file mode 100644 index 0000000..e2bab20 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/ndcovlt.m @@ -0,0 +1,99 @@ +## Copyright (C) 2010 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{y} =} ndcovlt (@var{x}, @var{t1}, @var{t2}, @dots{}) +## Computes an n-dimensional covariant linear transform of an n-d tensor, given a +## transformation matrix for each dimension. The number of columns of each transformation +## matrix must match the corresponding extent of @var{x}, and the number of rows determines +## the corresponding extent of @var{y}. For example: +## +## @example +## size (@var{x}, 2) == columns (@var{t2}) +## size (@var{y}, 2) == rows (@var{t2}) +## @end example +## +## The element @code{@var{y}(i1, i2, @dots{})} is defined as a sum of +## +## @example +## @var{x}(j1, j2, @dots{}) * @var{t1}(i1, j1) * @var{t2}(i2, j2) * @dots{} +## @end example +## +## over all j1, j2, @dots{}. For two dimensions, this reduces to +## @example +## @var{y} = @var{t1} * @var{x} * @var{t2}.' +## @end example +## +## [] passed as a transformation matrix is converted to identity matrix for +## the corresponding dimension. +## +## @end deftypefn + +## Author: Jaroslav Hajek + +function y = ndcovlt (x, varargin) + nd = max (ndims (x), nargin - 1); + varargin = resize (varargin, 1, nd); + + # check dimensions + for i = 1:nd + ti = varargin{i}; + if (isnumeric (ti) && ndims (ti) == 2) + [r, c] = size (ti); + if (r + c == 0) + varargin{i} = eye (size (x, i)); + elseif (c != size (x, i)) + error ("ndcovt: dimension mismatch for x-th transformation matrix"); + endif + else + error ("ndcovt: transformation matrices must be numeric 2d matrices"); + endif + endfor + + if (isempty (x)) + szy = cellfun (@rows, varargin); + y = zeros (szy); + return + endif + + ldp = [2:nd, 1]; + ## First transformation. + y = ldtrans (x, varargin{1}); + + ## Always shift one dimension. + for i = 2:nd-1 + y = ldtrans (permute (y, ldp), varargin{i}); + endfor + + ## Permute to normal order now to save one permutation. + if (nd > 2) + y = ipermute (y, [nd-1:nd, 1:nd-2]); + endif + + ## Now multiply from the right. + szy = size (y); + szy(end+1:nd-1) = 1; + m = varargin{nd}; + szy(nd) = rows (m); + y = reshape (y, [], size (y, nd)); + y = reshape (y * m.', szy); + +endfunction + +function y = ldtrans (x, m) + sz = size (x); + sz(1) = rows (m); + y = reshape (m * x(:,:), sz); +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/nmf_bpas.m b/octave_packages/linear-algebra-2.2.0/nmf_bpas.m new file mode 100644 index 0000000..8ff45df --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/nmf_bpas.m @@ -0,0 +1,711 @@ +## Copyright (c) 2012 by Jingu Kim and Haesun Park +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## 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{W}, @var{H}, @var{iter}, @var{HIS}] = } nmf_bpas (@var{A}, @var{k}) +## Nonnegative Matrix Factorization by Alternating Nonnegativity Constrained Least Squares +## using Block Principal Pivoting/Active Set method. +## +## This function solves one the following problems: given @var{A} and @var{k}, find @var{W} and @var{H} such that +## (1) minimize 1/2 * || @var{A}-@var{W}@var{H} ||_F^2 +## (2) minimize 1/2 * ( || @var{A}-@var{W}@var{H} ||_F^2 + alpha * || @var{W} ||_F^2 + beta * || @var{H} ||_F^2 ) +## (3) minimize 1/2 * ( || @var{A}-@var{W}@var{H} ||_F^2 + alpha * || @var{W} ||_F^2 + beta * (sum_(i=1)^n || @var{H}(:,i) ||_1^2 ) ) +## where @var{W}>=0 and @var{H}>=0 elementwise. +## The input arguments are @var{A} : Input data matrix (m x n) and @var{k} : Target low-rank. +## +## +## @strong{Optional Inputs} +## @table @samp +## @item Type : Default is 'regularized', which is recommended for quick application testing unless 'sparse' or 'plain' is explicitly needed. If sparsity is needed for 'W' factor, then apply this function for the transpose of 'A' with formulation (3). Then, exchange 'W' and 'H' and obtain the transpose of them. Imposing sparsity for both factors is not recommended and thus not included in this software. +## @table @asis +## @item 'plain' to use formulation (1) +## @item 'regularized' to use formulation (2) +## @item 'sparse' to use formulation (3) +## @end table +## +## @item NNLSSolver : Default is 'bp', which is in general faster. +## @table @asis +## item 'bp' to use the algorithm in [1] +## item 'as' to use the algorithm in [2] +## @end table +## +## @item Alpha : Parameter alpha in the formulation (2) or (3). Default is the average of all elements in A. No good justfication for this default value, and you might want to try other values. +## @item Beta : Parameter beta in the formulation (2) or (3). +## Default is the average of all elements in A. No good justfication for this default value, and you might want to try other values. +## @item MaxIter : Maximum number of iterations. Default is 100. +## @item MinIter : Minimum number of iterations. Default is 20. +## @item MaxTime : Maximum amount of time in seconds. Default is 100,000. +## @item Winit : (m x k) initial value for W. +## @item Hinit : (k x n) initial value for H. +## @item Tol : Stopping tolerance. Default is 1e-3. If you want to obtain a more accurate solution, decrease TOL and increase MAX_ITER at the same time. +## @item Verbose : +## @table @asis +## @item 0 (default) - No debugging information is collected.@* +## @item 1 (debugging purpose) - History of computation is returned by 'HIS' variable. +## @item 2 (debugging purpose) - History of computation is additionally printed on screen. +## @end table +## @end table +## +## @strong{Outputs} +## @table @samp +## @item W : Obtained basis matrix (m x k) +## @item H : Obtained coefficients matrix (k x n) +## @item iter : Number of iterations +## @item HIS : (debugging purpose) History of computation +## @end table +## +## Usage Examples: +## @example +## nmf(A,10) +## nmf(A,20,'verbose',2) +## nmf(A,30,'verbose',2,'nnls_solver','as') +## nmf(A,5,'verbose',2,'type','sparse') +## nmf(A,60,'verbose',1,'type','plain','w_init',rand(m,k)) +## nmf(A,70,'verbose',2,'type','sparse','nnls_solver','bp','alpha',1.1,'beta',1.3) +## @end example +## +## References: +## [1] For using this software, please cite:@* +## Jingu Kim and Haesun Park, Toward Faster Nonnegative Matrix Factorization: A New Algorithm and Comparisons,@* +## In Proceedings of the 2008 Eighth IEEE International Conference on Data Mining (ICDM'08), 353-362, 2008@* +## [2] If you use 'nnls_solver'='as' (see below), please cite:@* +## Hyunsoo Kim and Haesun Park, Nonnegative Matrix Factorization Based @* +## on Alternating Nonnegativity Constrained Least Squares and Active Set Method, @* +## SIAM Journal on Matrix Analysis and Applications, 2008, 30, 713-730 +## +## Check original code at @url{http://www.cc.gatech.edu/~jingu} +## +## @seealso{nmf_pg} +## @end deftypefn + +## 2012 - Modified and adapted to Octave 3.6.1 by +## Juan Pablo Carbajal + +# TODO +# - Format code. +# - Vectorize loops. + +function [W, H, iter, HIS] = nmf_bpas (A, k , varargin) + page_screen_output (0, "local"); + + [m,n] = size(A); + ST_RULE = 1; + + # --- Parse arguments --- # + parser = inputParser (); + parser.FunctionName = "nmf_bpas"; + parser = addParamValue (parser,'Winit', rand(m,k), @ismatrix); + parser = addParamValue (parser,'Hinit', rand(k,n), @ismatrix); + parser = addParamValue (parser,'Tol', 1e-3, @(x)x>0); + parser = addParamValue (parser,'Alpha', mean (A(:)), @(x)x>=0); + parser = addParamValue (parser,'Beta', mean (A(:)), @(x)x>=0); + parser = addParamValue (parser,'MaxIter', 100, @(x)x>0); + parser = addParamValue (parser,'MaxTime', 1e3, @(x)x>0); + parser = addParamValue (parser,'Verbose', false); + + val_type = @(x,c) ischar (x) && any (strcmpi (x,c)); + parser = addParamValue (parser,'Type', 'regularized', ... + @(x)val_type (x,{'regularized', 'sparse','plain'})); + parser = addParamValue (parser,'NNLSSolver', 'bp', ... + @(x)val_type (x,{'bp', 'as'})); + + parser = parse(parser,varargin{:}); + + % Default configuration + par.m = m; + par.n = n; + par.type = parser.Results.Type; + par.nnls_solver = parser.Results.NNLSSolver; + par.alpha = parser.Results.Alpha; + par.beta = parser.Results.Beta; + par.max_iter = parser.Results.MaxIter; + par.min_iter = 20; + par.max_time = parser.Results.MaxTime; + par.tol = parser.Results.Tol; + par.verbose = parser.Results.Verbose; + W = parser.Results.Winit; + H = parser.Results.Hinit; + + # TODO check if can be removed + argAlpha = par.alpha; + argBeta = par.beta; + + clear parser val_type + +### PARSING TYPE +# TODO add callbacks here to use during main loop. See [1] + % for regularized/sparse case + salphaI = sqrt (par.alpha) * eye (k); + zerokm = zeros (k,m); + + if strcmpi (par.type, 'regularized') + sbetaI = sqrt (par.beta) * eye (k); + zerokn = zeros (k,n); + + elseif strcmpi (par.type, 'sparse') + sbetaE = sqrt (par.beta) * ones (1,k); + betaI = par.beta * ones (k,k); + zero1n = zeros (1,n); + + end +### + +# Verbosity + display(par); +### Done till here Sun Mar 25 19:00:26 2012 + + HIS = 0; + if par.verbose % collect information for analysis/debugging + [gradW,gradH] = getGradient(A,W,H,par.type,par.alpha,par.beta); + initGrNormW = norm(gradW,'fro'); + initGrNormH = norm(gradH,'fro'); + initNorm = norm(A,'fro'); + numSC = 3; + initSCs = zeros(numSC,1); + for j=1:numSC + initSCs(j) = getInitCriterion(j,A,W,H,par.type,par.alpha,par.beta,gradW,gradH); + end +%---(1)------(2)--------(3)--------(4)--------(5)---------(6)----------(7)------(8)-----(9)-------(10)--------------(11)------- +% iter # | elapsed | totalTime | subIterW | subIterH | rel. obj.(%) | NM_GRAD | GRAD | DELTA | W density (%) | H density (%) +%------------------------------------------------------------------------------------------------------------------------------ + HIS = zeros(1,11); + HIS(1,[1:5])=0; + ver.initGrNormW = initGrNormW; + ver.initGrNormH = initGrNormH; + ver.initNorm = initNorm; HIS(1,6) = ver.initNorm; + ver.SC1 = initSCs(1); HIS(1,7) = ver.SC1; + ver.SC2 = initSCs(2); HIS(1,8) = ver.SC2; + ver.SC3 = initSCs(3); HIS(1,9) = ver.SC3; + ver.W_density = length(find(W>0))/(m*k); HIS(1,10) = ver.W_density; + ver.H_density = length(find(H>0))/(n*k); HIS(1,11) = ver.H_density; + if par.verbose == 2 + disp (ver); + end + tPrev = cputime; + end + + tStart = cputime; + tTotal = 0; + initSC = getInitCriterion(ST_RULE,A,W,H,par.type,par.alpha,par.beta); + SCconv = 0; + SC_COUNT = 3; + +#TODO: [1] Replace with callbacks avoid switching each time + for iter=1:par.max_iter + switch par.type + case 'plain' + [H,gradHX,subIterH] = nnlsm(W,A,H,par.nnls_solver); + [W,gradW,subIterW] = nnlsm(H',A',W',par.nnls_solver);, W=W';, gradW=gradW'; + gradH = (W'*W)*H - W'*A; + case 'regularized' + [H,gradHX,subIterH] = nnlsm([W;sbetaI],[A;zerokn],H,par.nnls_solver); + [W,gradW,subIterW] = nnlsm([H';salphaI],[A';zerokm],W',par.nnls_solver);, W=W';, gradW=gradW'; + gradH = (W'*W)*H - W'*A + par.beta*H; + case 'sparse' + [H,gradHX,subIterH] = nnlsm([W;sbetaE],[A;zero1n],H,par.nnls_solver); + [W,gradW,subIterW] = nnlsm([H';salphaI],[A';zerokm],W',par.nnls_solver);, W=W';, gradW=gradW'; + gradH = (W'*W)*H - W'*A + betaI*H; + end + + if par.verbose % collect information for analysis/debugging + elapsed = cputime-tPrev; + tTotal = tTotal + elapsed; + ver = []; + idx = iter+1; +%---(1)------(2)--------(3)--------(4)--------(5)---------(6)----------(7)------(8)-----(9)-------(10)--------------(11)------- +% iter # | elapsed | totalTime | subIterW | subIterH | rel. obj.(%) | NM_GRAD | GRAD | DELTA | W density (%) | H density (%) +%------------------------------------------------------------------------------------------------------------------------------ + ver.iter = iter; HIS(idx,1)=iter; + ver.elapsed = elapsed; HIS(idx,2)=elapsed; + ver.tTotal = tTotal; HIS(idx,3)=tTotal; + ver.subIterW = subIterW; HIS(idx,4)=subIterW; + ver.subIterH = subIterH; HIS(idx,5)=subIterH; + ver.relError = norm(A-W*H,'fro')/initNorm; HIS(idx,6)=ver.relError; + ver.SC1 = getStopCriterion(1,A,W,H,par.type,par.alpha,par.beta,gradW,gradH)/initSCs(1); HIS(idx,7)=ver.SC1; + ver.SC2 = getStopCriterion(2,A,W,H,par.type,par.alpha,par.beta,gradW,gradH)/initSCs(2); HIS(idx,8)=ver.SC2; + ver.SC3 = getStopCriterion(3,A,W,H,par.type,par.alpha,par.beta,gradW,gradH)/initSCs(3); HIS(idx,9)=ver.SC3; + ver.W_density = length(find(W>0))/(m*k); HIS(idx,10)=ver.W_density; + ver.H_density = length(find(H>0))/(n*k); HIS(idx,11)=ver.H_density; + if par.verbose == 2, display(ver);, end + tPrev = cputime; + end + + if (iter > par.min_iter) + SC = getStopCriterion(ST_RULE,A,W,H,par.type,par.alpha,par.beta,gradW,gradH); + if (par.verbose && (tTotal > par.max_time)) || (~par.verbose && ((cputime-tStart)>par.max_time)) + break; + elseif (SC/initSC <= par.tol) + SCconv = SCconv + 1; + if (SCconv >= SC_COUNT) + break; + end + else + SCconv = 0; + end + end + end + [m,n]=size(A); + norm2=sqrt(sum(W.^2,1)); + toNormalize = norm2>0; + W(:,toNormalize) = W(:,toNormalize)./repmat(norm2(toNormalize),m,1); + H(toNormalize,:) = H(toNormalize,:).*repmat(norm2(toNormalize)',1,n); + + final.iterations = iter; + if par.verbose + final.elapsed_total = tTotal; + else + final.elapsed_total = cputime-tStart; + end + final.relative_error = norm(A-W*H,'fro')/norm(A,'fro'); + final.W_density = length(find(W>0))/(m*k); + final.H_density = length(find(H>0))/(n*k); + display(final); + +endfunction + +%------------------------------------------------------------------------------------------------------------------------ +% Utility Functions +%------------------------------------------------------------------------------- +function retVal = getInitCriterion(stopRule,A,W,H,type,alpha,beta,gradW,gradH) +% STOPPING_RULE : 1 - Normalized proj. gradient +% 2 - Proj. gradient +% 3 - Delta by H. Kim +% 0 - None (want to stop by MAX_ITER or MAX_TIME) + if nargin~=9 + [gradW,gradH] = getGradient(A,W,H,type,alpha,beta); + end + [m,k]=size(W);, [k,n]=size(H);, numAll=(m*k)+(k*n); + switch stopRule + case 1 + retVal = norm([gradW; gradH'],'fro')/numAll; + case 2 + retVal = norm([gradW; gradH'],'fro'); + case 3 + retVal = getStopCriterion(3,A,W,H,type,alpha,beta,gradW,gradH); + case 0 + retVal = 1; + end + +endfunction +%------------------------------------------------------------------------------- +function retVal = getStopCriterion(stopRule,A,W,H,type,alpha,beta,gradW,gradH) +% STOPPING_RULE : 1 - Normalized proj. gradient +% 2 - Proj. gradient +% 3 - Delta by H. Kim +% 0 - None (want to stop by MAX_ITER or MAX_TIME) + if nargin~=9 + [gradW,gradH] = getGradient(A,W,H,type,alpha,beta); + end + + switch stopRule + case 1 + pGradW = gradW(gradW<0|W>0); + pGradH = gradH(gradH<0|H>0); + pGrad = [gradW(gradW<0|W>0); gradH(gradH<0|H>0)]; + pGradNorm = norm(pGrad); + retVal = pGradNorm/length(pGrad); + case 2 + pGradW = gradW(gradW<0|W>0); + pGradH = gradH(gradH<0|H>0); + pGrad = [gradW(gradW<0|W>0); gradH(gradH<0|H>0)]; + retVal = norm(pGrad); + case 3 + resmat=min(H,gradH); resvec=resmat(:); + resmat=min(W,gradW); resvec=[resvec; resmat(:)]; + deltao=norm(resvec,1); %L1-norm + num_notconv=length(find(abs(resvec)>0)); + retVal=deltao/num_notconv; + case 0 + retVal = 1e100; + end + +endfunction +%------------------------------------------------------------------------------- +function [gradW,gradH] = getGradient(A,W,H,type,alpha,beta) + switch type + case 'plain' + gradW = W*(H*H') - A*H'; + gradH = (W'*W)*H - W'*A; + case 'regularized' + gradW = W*(H*H') - A*H' + alpha*W; + gradH = (W'*W)*H - W'*A + beta*H; + case 'sparse' + k=size(W,2); + betaI = beta*ones(k,k); + gradW = W*(H*H') - A*H' + alpha*W; + gradH = (W'*W)*H - W'*A + betaI*H; + end + +endfunction + +%------------------------------------------------------------------------------------------------------------------------ +function [X,grad,iter] = nnlsm(A,B,init,solver) + switch solver + case 'bp' + [X,grad,iter] = nnlsm_blockpivot(A,B,0,init); + case 'as' + [X,grad,iter] = nnlsm_activeset(A,B,1,0,init); + end + +endfunction +%------------------------------------------------------------------------------------------------------------------------ +function [ X,Y,iter,success ] = nnlsm_activeset( A, B, overwrite, isInputProd, init) +% Nonnegativity Constrained Least Squares with Multiple Righthand Sides +% using Active Set method +% +% This software solves the following problem: given A and B, find X such that +% minimize || AX-B ||_F^2 where X>=0 elementwise. +% +% Reference: +% Charles L. Lawson and Richard J. Hanson, Solving Least Squares Problems, +% Society for Industrial and Applied Mathematics, 1995 +% M. H. Van Benthem and M. R. Keenan, +% Fast Algorithm for the Solution of Large-scale Non-negativity-constrained Least Squares Problems, +% J. Chemometrics 2004; 18: 441-450 +% +% Written by Jingu Kim (jingu@cc.gatech.edu) +% School of Computational Science and Engineering, +% Georgia Institute of Technology +% +% Last updated Feb-20-2010 +% +% +% A : input matrix (m x n) (by default), or A'*A (n x n) if isInputProd==1 +% B : input matrix (m x k) (by default), or A'*B (n x k) if isInputProd==1 +% overwrite : (optional, default:0) if turned on, unconstrained least squares solution is computed in the beginning +% isInputProd : (optional, default:0) if turned on, use (A'*A,A'*B) as input instead of (A,B) +% init : (optional) initial value for X +% +% X : the solution (n x k) +% Y : A'*A*X - A'*B where X is the solution (n x k) +% iter : number of iterations +% success : 1 for success, 0 for failure. +% Failure could only happen on a numericall very ill-conditioned problem. + + if nargin<3, overwrite=0;, end + if nargin<4, isInputProd=0;, end + + if isInputProd + AtA=A;,AtB=B; + else + AtA=A'*A;, AtB=A'*B; + end + + [n,k]=size(AtB); + MAX_ITER = n*5; + % set initial feasible solution + if overwrite + [X,iter] = solveNormalEqComb(AtA,AtB); + PassSet = (X > 0); + NotOptSet = any(X<0); + else + if nargin<5 + X = zeros(n,k); + PassSet = false(n,k); + NotOptSet = true(1,k); + else + X = init; + PassSet = (X > 0); + NotOptSet = any(X<0); + end + iter = 0; + end + + Y = zeros(n,k); + Y(:,~NotOptSet)=AtA*X(:,~NotOptSet) - AtB(:,~NotOptSet); + NotOptCols = find(NotOptSet); + + bigIter = 0;, success=1; + while(~isempty(NotOptCols)) + bigIter = bigIter+1; + if ((MAX_ITER >0) && (bigIter > MAX_ITER)) % set max_iter for ill-conditioned (numerically unstable) case + success = 0;, bigIter, break + end + + % find unconstrained LS solution for the passive set + Z = zeros(n,length(NotOptCols)); + [ Z,subiter ] = solveNormalEqComb(AtA,AtB(:,NotOptCols),PassSet(:,NotOptCols)); + iter = iter + subiter; + %Z(abs(Z)<1e-12) = 0; % One can uncomment this line for numerical stability. + InfeaSubSet = Z < 0; + InfeaSubCols = find(any(InfeaSubSet)); + FeaSubCols = find(all(~InfeaSubSet)); + + if ~isempty(InfeaSubCols) % for infeasible cols + ZInfea = Z(:,InfeaSubCols); + InfeaCols = NotOptCols(InfeaSubCols); + Alpha = zeros(n,length(InfeaSubCols));, Alpha(:,:) = Inf; + InfeaSubSet(:,InfeaSubCols); + [i,j] = find(InfeaSubSet(:,InfeaSubCols)); + InfeaSubIx = sub2ind(size(Alpha),i,j); + if length(InfeaCols) == 1 + InfeaIx = sub2ind([n,k],i,InfeaCols * ones(length(j),1)); + else + InfeaIx = sub2ind([n,k],i,InfeaCols(j)'); + end + Alpha(InfeaSubIx) = X(InfeaIx)./(X(InfeaIx)-ZInfea(InfeaSubIx)); + + [minVal,minIx] = min(Alpha); + Alpha(:,:) = repmat(minVal,n,1); + X(:,InfeaCols) = X(:,InfeaCols)+Alpha.*(ZInfea-X(:,InfeaCols)); + IxToActive = sub2ind([n,k],minIx,InfeaCols); + X(IxToActive) = 0; + PassSet(IxToActive) = false; + end + if ~isempty(FeaSubCols) % for feasible cols + FeaCols = NotOptCols(FeaSubCols); + X(:,FeaCols) = Z(:,FeaSubCols); + Y(:,FeaCols) = AtA * X(:,FeaCols) - AtB(:,FeaCols); + %Y( abs(Y)<1e-12 ) = 0; % One can uncomment this line for numerical stability. + + NotOptSubSet = (Y(:,FeaCols) < 0) & ~PassSet(:,FeaCols); + NewOptCols = FeaCols(all(~NotOptSubSet)); + UpdateNotOptCols = FeaCols(any(NotOptSubSet)); + if ~isempty(UpdateNotOptCols) + [minVal,minIx] = min(Y(:,UpdateNotOptCols).*~PassSet(:,UpdateNotOptCols)); + PassSet(sub2ind([n,k],minIx,UpdateNotOptCols)) = true; + end + NotOptSet(NewOptCols) = false; + NotOptCols = find(NotOptSet); + end + end + +endfunction +%------------------------------------------------------------------------------------------------------------------------ +function [ X,Y,iter,success ] = nnlsm_blockpivot( A, B, isInputProd, init ) +% Nonnegativity Constrained Least Squares with Multiple Righthand Sides +% using Block Principal Pivoting method +% +% This software solves the following problem: given A and B, find X such that +% minimize || AX-B ||_F^2 where X>=0 elementwise. +% +% Reference: +% Jingu Kim and Haesun Park, Toward Faster Nonnegative Matrix Factorization: A New Algorithm and Comparisons, +% In Proceedings of the 2008 Eighth IEEE International Conference on Data Mining (ICDM'08), 353-362, 2008 +% +% Written by Jingu Kim (jingu@cc.gatech.edu) +% Copyright 2008-2009 by Jingu Kim and Haesun Park, +% School of Computational Science and Engineering, +% Georgia Institute of Technology +% +% Check updated code at http://www.cc.gatech.edu/~jingu +% Please send bug reports, comments, or questions to Jingu Kim. +% This code comes with no guarantee or warranty of any kind. Note that this algorithm assumes that the +% input matrix A has full column rank. +% +% Last modified Feb-20-2009 +% +% +% A : input matrix (m x n) (by default), or A'*A (n x n) if isInputProd==1 +% B : input matrix (m x k) (by default), or A'*B (n x k) if isInputProd==1 +% isInputProd : (optional, default:0) if turned on, use (A'*A,A'*B) as input instead of (A,B) +% init : (optional) initial value for X +% +% X : the solution (n x k) +% Y : A'*A*X - A'*B where X is the solution (n x k) +% iter : number of iterations +% success : 1 for success, 0 for failure. +% Failure could only happen on a numericall very ill-conditioned problem. + + if nargin<3, isInputProd=0;, end + if isInputProd + AtA = A;, AtB = B; + else + AtA = A'*A;, AtB = A'*B; + end + + [n,k]=size(AtB); + MAX_ITER = n*5; + % set initial feasible solution + X = zeros(n,k); + if nargin<4 + Y = - AtB; + PassiveSet = false(n,k); + iter = 0; + else + PassiveSet = (init > 0); + [ X,iter ] = solveNormalEqComb(AtA,AtB,PassiveSet); + Y = AtA * X - AtB; + end + % parameters + pbar = 3; + P = zeros(1,k);, P(:) = pbar; + Ninf = zeros(1,k);, Ninf(:) = n+1; + iter = 0; + + NonOptSet = (Y < 0) & ~PassiveSet; + InfeaSet = (X < 0) & PassiveSet; + NotGood = sum(NonOptSet)+sum(InfeaSet); + NotOptCols = NotGood > 0; + + bigIter = 0;, success=1; + while(~isempty(find(NotOptCols))) + bigIter = bigIter+1; + if ((MAX_ITER >0) && (bigIter > MAX_ITER)) % set max_iter for ill-conditioned (numerically unstable) case + success = 0;, break + end + + Cols1 = NotOptCols & (NotGood < Ninf); + Cols2 = NotOptCols & (NotGood >= Ninf) & (P >= 1); + Cols3Ix = find(NotOptCols & ~Cols1 & ~Cols2); + if ~isempty(find(Cols1)) + P(Cols1) = pbar;,Ninf(Cols1) = NotGood(Cols1); + PassiveSet(NonOptSet & repmat(Cols1,n,1)) = true; + PassiveSet(InfeaSet & repmat(Cols1,n,1)) = false; + end + if ~isempty(find(Cols2)) + P(Cols2) = P(Cols2)-1; + PassiveSet(NonOptSet & repmat(Cols2,n,1)) = true; + PassiveSet(InfeaSet & repmat(Cols2,n,1)) = false; + end + if ~isempty(Cols3Ix) + for i=1:length(Cols3Ix) + Ix = Cols3Ix(i); + toChange = max(find( NonOptSet(:,Ix)|InfeaSet(:,Ix) )); + if PassiveSet(toChange,Ix) + PassiveSet(toChange,Ix)=false; + else + PassiveSet(toChange,Ix)=true; + end + end + end + NotOptMask = repmat(NotOptCols,n,1); + [ X(:,NotOptCols),subiter ] = solveNormalEqComb(AtA,AtB(:,NotOptCols),PassiveSet(:,NotOptCols)); + iter = iter + subiter; + X(abs(X)<1e-12) = 0; % for numerical stability + Y(:,NotOptCols) = AtA * X(:,NotOptCols) - AtB(:,NotOptCols); + Y(abs(Y)<1e-12) = 0; % for numerical stability + + % check optimality + NonOptSet = NotOptMask & (Y < 0) & ~PassiveSet; + InfeaSet = NotOptMask & (X < 0) & PassiveSet; + NotGood = sum(NonOptSet)+sum(InfeaSet); + NotOptCols = NotGood > 0; + end +endfunction +%------------------------------------------------------------------------------------------------------------------------ +function [ Z,iter ] = solveNormalEqComb( AtA,AtB,PassSet ) +% Solve normal equations using combinatorial grouping. +% Although this function was originally adopted from the code of +% "M. H. Van Benthem and M. R. Keenan, J. Chemometrics 2004; 18: 441-450", +% important modifications were made to fix bugs. +% +% Modified by Jingu Kim (jingu@cc.gatech.edu) +% School of Computational Science and Engineering, +% Georgia Institute of Technology +% +% Last updated Aug-12-2009 + + iter = 0; + if (nargin ==2) || isempty(PassSet) || all(PassSet(:)) + Z = AtA\AtB; + iter = iter + 1; + else + Z = zeros(size(AtB)); + [n,k1] = size(PassSet); + + ## Fixed on Aug-12-2009 + if k1==1 + Z(PassSet)=AtA(PassSet,PassSet)\AtB(PassSet); + else + ## Fixed on Aug-12-2009 + % The following bug was identified by investigating a bug report by Hanseung Lee. + [sortedPassSet,sortIx] = sortrows(PassSet'); + breaks = any(diff(sortedPassSet)'); + breakIx = [0 find(breaks) k1]; + % codedPassSet = 2.^(n-1:-1:0)*PassSet; + % [sortedPassSet,sortIx] = sort(codedPassSet); + % breaks = diff(sortedPassSet); + % breakIx = [0 find(breaks) k1]; + + for k=1:length(breakIx)-1 + cols = sortIx(breakIx(k)+1:breakIx(k+1)); + vars = PassSet(:,sortIx(breakIx(k)+1)); + Z(vars,cols) = AtA(vars,vars)\AtB(vars,cols); + iter = iter + 1; + end + end + end +endfunction + +%!shared m, n, k, A +%! m = 30; +%! n = 20; +%! k = 10; +%! A = rand(m,n); + +%!test +%! [W,H,iter,HIS]=nmf_bpas(A,k); + +%!test +%! [W,H,iter,HIS]=nmf_bpas(A,k,'verbose',2); + +%!test +%! [W,H,iter,HIS]=nmf_bpas(A,k,'verbose',1,'nnlssolver','as'); + +%!test +%! [W,H,iter,HIS]=nmf_bpas(A,k,'verbose',1,'type','sparse'); + +%!test +%! [W,H,iter,HIS]=nmf_bpas(A,k,'verbose',1,'type','sparse','nnlssolver','bp','alpha',1.1,'beta',1.3); + +%!test +%! [W,H,iter,HIS]=nmf_bpas(A,k,'verbose',2,'type','plain','winit',rand(m,k)); + +%!demo +%! m = 300; +%! n = 200; +%! k = 10; +%! +%! W_org = rand(m,k);, W_org(rand(m,k)>0.5)=0; +%! H_org = rand(k,n);, H_org(rand(k,n)>0.5)=0; +%! +%! % normalize W, since 'nmf' normalizes W before return +%! norm2=sqrt(sum(W_org.^2,1)); +%! toNormalize = norm2>0; +%! W_org(:,toNormalize) = W_org(:,toNormalize)./repmat(norm2(toNormalize),m,1); +%! +%! A = W_org * H_org; +%! +%! [W,H,iter,HIS]=nmf_bpas (A,k,'type','plain','tol',1e-4); +%! +%! % -------------------- column reordering before computing difference +%! reorder = zeros(k,1); +%! selected = zeros(k,1); +%! for i=1:k +%! for j=1:k +%! if ~selected(j), break, end +%! end +%! minIx = j; +%! +%! for j=minIx+1:k +%! if ~selected(j) +%! d1 = norm(W(:,i)-W_org(:,minIx)); +%! d2 = norm(W(:,i)-W_org(:,j)); +%! if (d2 +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions are met: +## +## 1 Redistributions of source code must retain the above copyright notice, +## this list of conditions and the following disclaimer. +## 2 Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## +## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +## +## The views and conclusions contained in the software and documentation are +## those of the authors and should not be interpreted as representing official +## policies, either expressed or implied, of the copyright holders. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{W}, @var{H}] =} nmf_pg (@var{V}, @var{Winit}, @ +## @var{Hinit}, @var{tol}, @var{timelimit}, @var{maxiter}) +## +## Non-negative matrix factorization by alternative non-negative least squares +## using projected gradients. +## +## The matrix @var{V} is factorized into two possitive matrices @var{W} and +## @var{H} such that @code{V = W*H + U}. Where @var{U} is a matrix of residuals +## that can be negative or positive. When the matrix @var{V} is positive the order +## of the elements in @var{U} is bounded by the optional named argument @var{tol} +## (default value @code{1e-9}). +## +## The factorization is not unique and depends on the inital guess for the matrices +## @var{W} and @var{H}. You can pass this initalizations using the optional +## named arguments @var{Winit} and @var{Hinit}. +## +## timelimit, maxiter: limit of time and iterations +## +## Examples: +## +## @example +## A = rand(10,5); +## [W H] = nmf_pg(A,tol=1e-3); +## U = W*H -A; +## disp(max(abs(U))); +## @end example +## +## @end deftypefn + +## 2012 - Modified and adapted to Octave 3.6.1 by +## Juan Pablo Carbajal + +function [W, H] = nmf_pg (V, varargin) + +# JuanPi Fri 16 Mar 2012 10:49:11 AM CET +# TODO: +# - finish docstring +# - avoid multiple transpositions + + # --- Parse arguments --- # + parser = inputParser (); + parser.FunctionName = "nmf_pg"; + parser = addParamValue (parser,'Winit', [], @ismatrix); + parser = addParamValue (parser,'Hinit', [], @ismatrix); + parser = addParamValue (parser,'Tol', 1e-6, @(x)x>0); + parser = addParamValue (parser,'TimeLimit', 10, @(x)x>0); + parser = addParamValue (parser,'MaxIter', 100, @(x)x>0); + parser = addParamValue (parser,'MaxSubIter', 1e3, @(x)x>0); + parser = addParamValue (parser,'Verbose', true); + parser = parse(parser,varargin{:}); + + Winit = parser.Results.Winit; + Hinit = parser.Results.Hinit; + tol = parser.Results.Tol; + timelimit = parser.Results.TimeLimit; + maxiter = parser.Results.MaxIter; + maxsubiter = parser.Results.MaxSubIter; + verbose = parser.Results.Verbose; + + clear parser + # ------ # + + # --- Initialize matrices --- # + [r c] = size (V); + Hgiven = !isempty (Hinit); + Wgiven = !isempty (Winit); + if Wgiven && !Hgiven + + W = Winit; + H = ones (size (W,2),c); + + elseif !Wgiven && Hgiven + + H = Hinit; + W = ones (r, size(H,2)); + + elseif !Wgiven && !Hgiven + + if r == c + W = ones (r) + H = W + else + W = ones (r); + H = ones (r,c); + end + + else + + W = Winit; + H = Hinit; + + end + [Hr,Hc] = size(H); + [Wr,Wc] = size(W); + + # start tracking time + initt = cputime (); + + gradW = W*(H*H') - V*H'; + gradH = (W'*W)*H - W'*V; + + initgrad = norm([gradW; gradH'],'fro'); + + # Tolerances for matrices + tolW = max(0.001,tol)*initgrad; + tolH = tolW; + + # ------ # + + # --- Main Loop --- # + if verbose + fprintf ('--- Factorizing %d-by-%d matrix into %d-by-%d times %d-by-%d\n',... + r,c,Wr,Wc,Hr,Hc); + fprintf ("Initial gradient norm = %f\n", initgrad); + fflush (stdout); + text_waitbar(0,'Please wait ...'); + end + + for iter = 1:maxiter + + # stopping condition + projnorm = norm ( [ gradW(gradW<0 | W>0); gradH(gradH<0 | H>0) ] ); + stop_cond = [projnorm < tol*initgrad , cputime-initt > timelimit]; + if any (stop_cond) + if stop_cond(2) + warning('mnf_pg:MaxIter',["Time limit exceeded.\n" ... + "Could be solved increasing TimeLimit.\n"]); + end + break + end + + + # FIXME: avoid multiple transpositions + [W, gradW, iterW] = nlssubprob(V', H', W', tolW, maxsubiter, verbose); + W = W'; + gradW = gradW'; + + if iterW == 1, + tolW = 0.1 * tolW; + end + + [H, gradH, iterH] = nlssubprob(V, W, H, tolH, maxsubiter, verbose); + if iterH == 1, + tolH = 0.1 * tolH; + end + + if (iterW == 1 && iterH == 1 && tolH + tolW < tol*initgrad), + warning ('nmf_pg:InvalidArgument','Failed to move'); + break + end + + if verbose + text_waitbar (iter/maxiter); + end + end + + if iter == maxiter + warning('mnf_pg:MaxIter',["Reached maximum iterations in main loop.\n" ... + "Could be solved increasing MaxIter.\n"]); + end + + if verbose + fprintf ('\nIterations = %d\nFinal proj-grad norm = %f\n', iter, projnorm); + fflush (stdout); + end +endfunction + +function [H, grad,iter] = nlssubprob(V,W,Hinit,tol,maxiter,verbose) +% H, grad: output solution and gradient +% iter: #iterations used +% V, W: constant matrices +% Hinit: initial solution +% tol: stopping tolerance +% maxiter: limit of iterations + + H = Hinit; + WtV = W'*V; + WtW = W'*W; + + alpha = 1; + beta = 0.1; + + for iter=1:maxiter + grad = WtW*H - WtV; + projgrad = norm ( grad(grad < 0 | H >0) ); + + if projgrad < tol, + break + end + + % search step size + Hn = max(H - alpha*grad, 0); + d = Hn-H; + gradd = sum ( sum (grad.*d) ); + dQd = sum ( sum ((WtW*d).*d) ); + + if gradd + 0.5*dQd > 0.01*gradd, + % decrease alpha + while 1, + alpha *= beta; + Hn = max (H - alpha*grad, 0); + d = Hn-H; + gradd = sum (sum (grad.*d) ); + dQd = sum (sum ((WtW*d).*d)); + + if gradd + 0.5*dQd <= 0.01*gradd || alpha < 1e-20 + H = Hn; + break + end + + endwhile + + else + % increase alpha + while 1, + Hp = Hn; + alpha /= beta; + Hn = max (H - alpha*grad, 0); + d = Hn-H; + gradd = sum ( sum (grad.*d) ); + dQd = sum (sum ( (WtW*d).*d ) ); + + if gradd + 0.5*dQd > 0.01*gradd || Hn == Hp || alpha > 1e10 + H = Hp; + alpha *= beta; + break + end + + endwhile + end + + endfor + + if iter == maxiter + warning('mnf_pg:MaxIter',["Reached maximum iterations in nlssubprob\n" ... + "Could be solved increasing MaxSubIter.\n"]); + end + +endfunction + +%!demo +%! t = linspace (0,1,100)'; +%! +%! ## --- Build hump functions of different frequency +%! W_true = arrayfun ( @(f)sin(2*pi*f*t).^2, linspace (0.5,2,4), ... +%! 'uniformoutput', false ); +%! W_true = cell2mat (W_true); +%! ## --- Build combinator vectors +%! c = (1:4)'; +%! H_true = arrayfun ( @(f)circshift(c,f), linspace (0,3,4), ... +%! 'uniformoutput', false ); +%! H_true = cell2mat (H_true); +%! ## --- Mix them +%! V = W_true*H_true; +%! ## --- Give good inital guesses +%! Winit = W_true + 0.4*randn(size(W_true)); +%! Hinit = H_true + 0.2*randn(size(H_true)); +%! ## --- Factorize +%! [W H] = nmf_pg(V,'Winit',Winit,'Hinit',Hinit,'Tol',1e-6,'MaxIter',1e3); +%! disp('True mixer') +%! disp(H_true) +%! disp('Rounded factorized mixer') +%! disp(round(H)) +%! ## --- Plot results +%! plot(t,W,'o;factorized;') +%! hold on +%! plot(t,W_true,'-;True;') +%! hold off +%! axis tight diff --git a/octave_packages/linear-algebra-2.2.0/packinfo/.autoload b/octave_packages/linear-algebra-2.2.0/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/linear-algebra-2.2.0/packinfo/DESCRIPTION b/octave_packages/linear-algebra-2.2.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..0fdf55f --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: Linear-algebra +Version: 2.2.0 +Date: 2012-21-05 +Author: various authors +Maintainer: Octave-Forge community +Title: Linear algebra. +Description: Additional linear algebra code, including general SVD and matrix functions. +Categories: Linear algebra +Depends: octave (>= 3.2.3), general (>= 1.3.0) +Autoload: yes +License: GPLv3+, LGPLv3+, FreeBSD +Url: http://octave.sf.net diff --git a/octave_packages/linear-algebra-2.2.0/packinfo/INDEX b/octave_packages/linear-algebra-2.2.0/packinfo/INDEX new file mode 100644 index 0000000..b954873 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/packinfo/INDEX @@ -0,0 +1,79 @@ +matrix >> Linear Algebra +Matrix functions + cartprod + cod + condeig + funm + lobpcg + ndcovlt + rotparams + rotv + smwsolve + thfm +Matrix factorization + gsvd + nmf_bpas + nmf_pg + +sparse >> Sparse matrix support +Block sparse matrices + @blksparse/blksparse + @blksparse/blksize + @blksparse/ctranspose + @blksparse/display + @blksparse/full + @blksparse/ismatrix + @blksparse/isreal + @blksparse/issparse + @blksparse/minus + @blksparse/mldivide + @blksparse/mrdivide + @blksparse/mtimes + @blksparse/plus + @blksparse/size + @blksparse/sparse + @blksparse/subsref + @blksparse/transpose + @blksparse/uminus + @blksparse/uplus + +Iterative techniques + pgmres + +Kronecker Products + @kronprod/kronprod + @kronprod/columns + @kronprod/ctranspose + @kronprod/det + @kronprod/disp + @kronprod/display + @kronprod/full + @kronprod/inv + @kronprod/iscomplex + @kronprod/ismatrix + @kronprod/isreal + @kronprod/issparse + @kronprod/issquare + @kronprod/minus + @kronprod/mldivide + @kronprod/mpower + @kronprod/mtimes + @kronprod/numel + @kronprod/plus + @kronprod/rank + @kronprod/rdivide + @kronprod/rows + @kronprod/size + @kronprod/size_equal + @kronprod/sparse + @kronprod/times + @kronprod/trace + @kronprod/transpose + @kronprod/uminus + @kronprod/uplus + +Circulant matrices + circulant_make_matrix + circulant_matrix_vector_product + circulant_eig + circulant_inv diff --git a/octave_packages/linear-algebra-2.2.0/packinfo/NEWS b/octave_packages/linear-algebra-2.2.0/packinfo/NEWS new file mode 100644 index 0000000..90f03a9 --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/packinfo/NEWS @@ -0,0 +1,33 @@ +Summary of important user-visible changes for linear-algebra 2.2.0: +------------------------------------------------------------------- + + ** The following functions are new in 2.2.0: + + circulant_eig circulant_inv circulant_make_matrix + circulant_matrix_vector_product + nmf_pg nmf_bpas + + ** Package is now dependent on general (>= 1.3.0) + + ** Package is no longer automatically loaded. + +Summary of important user-visible changes for linear-algebra 2.1.0: +------------------------------------------------------------------- + + ** The following functions are new in 2.1.0: + + lobpcg ndcovlt + + ** The following functions were removed since equivalents are now + part of GNU octave core: + + bicg mgorth + + ** The following functions were deprecated since equivalents are + now part of GNU octave core: + + pgmres + + ** The function `funm' now also accepts function handles. + + ** Help text of most functions has been improved. diff --git a/octave_packages/linear-algebra-2.2.0/rotparams.m b/octave_packages/linear-algebra-2.2.0/rotparams.m new file mode 100644 index 0000000..37a0c3e --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/rotparams.m @@ -0,0 +1,73 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{vstacked}, @var{astacked}] =} rotparams (@var{rstacked}) +## @cindex +## The function w = rotparams (r) - Inverse to rotv(). +## Using, @var{w} = rotparams(@var{r}) is such that +## rotv(w)*r' == eye(3). +## +## If used as, [v,a]=rotparams(r) , idem, with v (1 x 3) s.t. w == a*v. +## +## 0 <= norm(w)==a <= pi +## +## :-O !! Does not check if 'r' is a rotation matrix. +## +## Ignores matrices with zero rows or with NaNs. (returns 0 for them) +## +## @seealso{rotv} +## @end deftypefn + +function [vstacked, astacked] = rotparams (rstacked) + + N = size (rstacked,1) / 3; + + ## ang = 0 ; + ## if length(varargin), + ## if strcmp(varargin{1},'ang'), ang = 1; end + ## end + ok = all ( ! isnan (rstacked') ) & any ( rstacked' ); + ok = min ( reshape (ok,3,N) ); + ok = find (ok) ; + ## keyboard + vstacked = zeros (N,3); + astacked = zeros (N,1); + for j = ok, + r = rstacked(3*j-2:3*j,:); + [v,f] = eig (r); + f = diag(f); + + [m,i] = min (abs (real (f)-1)); + v = v(:,i); + + w = null (v'); + u = w(:,1); + a = u'*r*u; + if a<1, + a = real (acos (u'*r*u)); + else + a = 0; + endif + ## Check orientation + x=r*u; + if v'*[0 -u(3) u(2); u(3) 0 -u(1);-u(2) u(1) 0]*x < 0, v=-v; endif + + + if nargout <= 1, v = v*a; endif + vstacked(j,:) = -v'; + astacked(j) = a; + endfor +endfunction diff --git a/octave_packages/linear-algebra-2.2.0/rotv.m b/octave_packages/linear-algebra-2.2.0/rotv.m new file mode 100644 index 0000000..1f4419b --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/rotv.m @@ -0,0 +1,82 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{r} = } rotv ( v, ang ) +## @cindex +## The functionrotv calculates a Matrix of rotation about @var{v} w/ angle |v| +## r = rotv(v [,ang]) +## +## Returns the rotation matrix w/ axis v, and angle, in radians, norm(v) or +## ang (if present). +## +## rotv(v) == w'*w + cos(a) * (eye(3)-w'*w) - sin(a) * crossmat(w) +## +## where a = norm (v) and w = v/a. +## +## v and ang may be vertically stacked : If 'v' is 2x3, then +## rotv( v ) == [rotv(v(1,:)); rotv(v(2,:))] +## +## @example +## +## @end example +## @seealso{rotparams, rota, rot} +## @end deftypefn + +function r = rotv(v ,ang) + + if nargin > 1 + v = v.*((ang(:)./sqrt(sum(v'.^2))')*ones(1,3)); + end + ## For checking only + ## v00 = v ; + ## static toto = floor(rand(1)*100) ; + ## toto + a = sqrt(sum(v'.^2))' ; + oka = find(a!=0); + if all(size(oka)), + v(oka,:) = v(oka,:)./(a(oka)*ones(1,3)) ; + end + ## ca = cos(a); + ## sa = sin(a); + + N = size(v,1) ; N3 = 3*N ; + r = (reshape( v', N3,1 )*ones(1,3)).*kron(v,ones(3,1)) ; + r += kron(cos(a),ones(3,3)) .* (kron(ones(N,1),eye(3))-r) ; + + ## kron(cos(a),ones(3,3)) .* (kron(ones(N,1),eye(3))-r0) + ## cos(a) + + tmp = zeros(N3,3) ; + tmp( 2:3:N3,1 ) = v(:,3) ; + tmp( 1:3:N3,2 ) = -v(:,3) ; + tmp( 3:3:N3,1 ) = -v(:,2) ; + tmp( 1:3:N3,3 ) = v(:,2) ; + tmp( 2:3:N3,3 ) = -v(:,1) ; + tmp( 3:3:N3,2 ) = v(:,1) ; + ## keyboard + r -= kron(sin(a),ones(3)) .* tmp ; + +endfunction + +## For checking only +## r2 = zeros(N3,3) ; +## for i=1:size(v,1), +## v0 = v00(i,:); +## t = norm(v0); +## if t, v0 = v0/t; end; +## r2(3*i-2:3*i,:) = v0'*v0 + cos(t)*(eye(3)-v0'*v0) + -sin(t)*[0, -v0(3), v0(2);v0(3), 0, -v0(1);-v0(2), v0(1), 0]; +## end +## max(abs(r2(:)-r(:))) diff --git a/octave_packages/linear-algebra-2.2.0/smwsolve.m b/octave_packages/linear-algebra-2.2.0/smwsolve.m new file mode 100644 index 0000000..92ffedf --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/smwsolve.m @@ -0,0 +1,78 @@ +## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{x} =} smwsolve (@var{a}, @var{u}, @var{v}, @var{b}) +## @deftypefnx{Function File} {} smwsolve (@var{solver}, @var{u}, @var{v}, @var{b}) +## Solves the square system @code{(A + U*V')*X == B}, where @var{u} and @var{v} are +## matrices with several columns, using the Sherman-Morrison-Woodbury formula, +## so that a system with @var{a} as left-hand side is actually solved. This is +## especially advantageous if @var{a} is diagonal, sparse, triangular or +## positive definite. +## @var{a} can be sparse or full, the other matrices are expected to be full. +## Instead of a matrix @var{a}, a user may alternatively provide a function +## @var{solver} that performs the left division operation. +## @end deftypefn + +## Author: Jaroslav Hajek + +function x = smwsolve (a, u, v, b) + + if (nargin != 4) + print_usage (); + endif + + n = columns (u); + + if (n != columns (v) || rows (a) != rows (u) || columns (a) != rows (v)) + error ("smwsolve: dimension mismatch"); + elseif (! issquare (a)) + error ("smwsolve: need a square matrix"); + endif + + + nc = columns (b); + n = columns (u); + + if (ismatrix (a)) + xx = a \ [b, u]; + elseif (isa (a, "function_handle")) + xx = a ([b, u]); + if (rows (xx) != rows (a) || columns (xx) != (nc + n)) + error ("smwsolve: invalid result from a solver function"); + endif + else + error ("smwsolve: a must be a matrix or function handle"); + endif + + x = xx(:,1:nc); + y = xx(:,nc+1:nc+n); + + vxx = v' * xx; + vx = vxx(:,1:nc); + vy = vxx(:,nc+1:nc+n); + + x = x - y * ((eye (n) + vy) \ vx); + +endfunction + +%!test +%! A = 2.1*eye (10); +%! u = rand (10, 2); u /= diag (norm (u, "cols")); +%! v = rand (10, 2); v /= diag (norm (v, "cols")); +%! b = rand (10, 2); +%! x1 = (A + u*v') \ b; +%! x2 = smwsolve (A, u, v, b); +%! assert (x1, x2, 1e-13); diff --git a/octave_packages/linear-algebra-2.2.0/thfm.m b/octave_packages/linear-algebra-2.2.0/thfm.m new file mode 100644 index 0000000..8702d0f --- /dev/null +++ b/octave_packages/linear-algebra-2.2.0/thfm.m @@ -0,0 +1,98 @@ +## Copyright (C) 2001 Rolf Fabian +## Copyright (C) 2001 Paul Kienzle +## Copyright (C) 2011 Philip Nienhuis +## Copyright (C) 2011 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{y} =} thfm (@var{x}, @var{mode}) +## Trigonometric/hyperbolic functions of square matrix @var{x}. +## +## @var{mode} must be the name of a function. Valid functions are 'sin', 'cos', +## 'tan', 'sec', 'csc', 'cot' and all their inverses and/or hyperbolic variants, +## and 'sqrt', 'log' and 'exp'. +## +## The code @code{thfm (x, 'cos')} calculates matrix cosinus @emph{even if} input +## matrix @var{x} is @emph{not} diagonalizable. +## +## @emph{Important note}: +## This algorithm does @emph{not} use an eigensystem similarity transformation. It +## maps the @var{mode} functions to functions of @code{expm}, @code{logm} and +## @code{sqrtm}, which are known to be robust with respect to non-diagonalizable +## ('defective') @var{x}. +## +## @seealso{funm} +## @end deftypefn + +function y = thfm (x,M) + ## minimal arg check only + if ( nargin != 2 || !ischar (M) || ischar (x) ) + print_usage; + endif + + ## look for known functions of sqrt, log, exp + I = eye (size (x)); + + switch (M) + case {'cos'} + if (isreal(x)) y = real( expm( i*x ) ); + else y = ( expm( i*x ) + expm( -i*x ) ) / 2; + endif + case {'sin'} + if (isreal(x)) y = imag( expm( i*x ) ); + else y = ( expm( i*x ) - expm( -i*x ) ) / (2*i); + endif + case {'tan'} + if (isreal(x)) t = expm( i*x ); y = imag(t)/real(t); + else t = expm( -2*i*x ); y = -i*(I-t)/(I+t); + endif + case {'cot'} + if (isreal(x)) t = expm( i*x ); y = real(t)/imag(t); + else t = expm( -2*i*x ); y = i*(I+t)/(I-t); + endif + case {'sec'} + if (isreal(x)) y = inv( real(expm(i*x)) ); + else y = inv( expm(i*x)+expm(-i*x) )*2 ; + endif + case {'csc'} + if (isreal(x)) y = inv( imag(expm(i*x)) ); + else y = inv( expm(i*x)-expm(-i*x) )*2i; + endif + case {'log'} y = logm(x); + case {'exp'} y = expm(x); + case {'cosh'} y = ( expm(x)+expm(-x) )/2; + case {'sinh'} y = ( expm(x)-expm(-x) )/2; + case {'tanh'} t = expm( -2*x ); y = (I - t)/(I + t); + case {'coth'} t = expm( -2*x ); y = (I + t)/(I - t); + case {'sech'} y = 2 * inv( expm(x) + expm(-x) ); + case {'csch'} y = 2 * inv( expm(x) - expm(-x) ); + case {'asin'} y = -i * logm( i*x + sqrtm(I - x*x) ); + case {'acos'} y = i * logm( x - i*sqrtm(I - x*x) ); + case {'atan'} y = -i/2 * logm( (I + i*x)/(I - i*x) ); + case {'acot'} y = i/2 * logm( (I + i*x)/(i*x - I) ); + case {'asec'} y = i * logm( ( I - sqrtm(I - x*x) ) / x ); + case {'acsc'} y = -i * logm( i*( I + sqrtm(I - x*x) ) / x ); + case {'sqrt'} y = sqrtm(x); + case {'asinh'} y = logm( x + sqrtm (x*x + I) ); + case {'acosh'} y = logm( x + sqrtm (x*x - I) ); + case {'atanh'} y = logm( (I + x)/(I - x) ) / 2; + case {'acoth'} y = logm( (I + x)/(x - I) ) / 2; + case {'asech'} y = logm( (I + sqrtm (I - x*x)) / x ); + case {'acsch'} y = logm( (I + sqrtm (I + x*x)) / x ); + otherwise + error ("thfm doesn't support function %s - try to use funm instead.", M); + endswitch + +endfunction diff --git a/octave_packages/mapping-1.0.7/azimuth.m b/octave_packages/mapping-1.0.7/azimuth.m new file mode 100644 index 0000000..df485ae --- /dev/null +++ b/octave_packages/mapping-1.0.7/azimuth.m @@ -0,0 +1,94 @@ +## Copyright (C) 2004 Andrew Collier +## +## This program is free software; it is distributed in the hope that it +## will be useful, but WITHOUT ANY WARRANTY; without even the implied +## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 file; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{az} = azimuth(@var{lat1},@var{lon1},@var{lat2},@var{lon2}) +## @deftypefnx {Function File} {} @var{az} = azimuth(@var{lat1},@var{lon1},@var{lat2},@var{lon2},@var{units}) +## @deftypefnx {Function File} {} @var{az} = azimuth(@var{pt1}, @var{pt2}) +## @deftypefnx {Function File} {} @var{az} = azimuth(@var{pt1}, @var{pt2},@var{units}) +## +## Calculates the great circle azimuth from a point 1 to a point 2. +## The latitude and longitude of these two points can either be given +## independently or as columns of the matrices @var{pt1} and @var{pt2} in +## the form [latitude longitude]. +## +## The units for the input coordinates and output angles can be +## "degrees" (the default) or "radians". +## +## @example +## >> azimuth([10,10], [10,40]) +## ans = 87.336 +## >> azimuth([0,10], [0,40]) +## ans = 90 +## >> azimuth(pi/4,0,pi/4,-pi/2,"radians") +## ans = 5.3279 +## @end example +## +## @seealso{elevation,distance} +## @end deftypefn + +## Author: Andrew Collier +## Adapted-by: Alexander Barth + +## Uses "four-parts" formula. + +function az = azimuth(varargin) + ## default units are degrees + + units = "degrees"; + + [reg,prop] = parseparams(varargin); + + if length(reg) == 2 + pt1 = reg{1}; + pt2 = reg{2}; + + a = pt1(:,1); + b = pt2(:,1); + C = pt2(:,2) - pt1(:,2); + elseif length(reg) == 4 + a = reg{1}; + b = reg{3}; + C = reg{4} - reg{2}; + else + error("Wrong number of type of arguments"); + end + + if length(prop) == 1 + units = prop{1}; + + if (~strcmp(units,"degrees") & ~strcmp(units,"radians")) + error("Only degrees and radians are allowed as units"); + end + elseif length(prop) > 1 + error("Wrong number of type of arguments"); + end + + if (strcmp(units,"degrees")) + a = deg2rad(a); + b = deg2rad(b); + C = deg2rad(C); + end + + az = atan2(sin(C) , cos(a) .* tan(b) - sin(a) .* cos(C) ); + + ## bring the angle in the interval [0 2*pi[ + + az = mod(az,2*pi); + + ## convert to degrees if desired + + if (strcmp(units,"degrees")) + az = rad2deg(az); + end +endfunction + +## http://www.mathworks.com/access/helpdesk/help/toolbox/map/azimuth.shtml diff --git a/octave_packages/mapping-1.0.7/deg2rad.m b/octave_packages/mapping-1.0.7/deg2rad.m new file mode 100644 index 0000000..5bd269a --- /dev/null +++ b/octave_packages/mapping-1.0.7/deg2rad.m @@ -0,0 +1,24 @@ +## Copyright (C) 2004 Andrew Collier +## +## This program is free software; it is distributed in the hope that it +## will be useful, but WITHOUT ANY WARRANTY; without even the implied +## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 file; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{anglout} = deg2rad(@var{anglin}) +## +## Converts angles input in degrees to the equivalent in radians. +## @end deftypefn + +## Author: Andrew Collier + +function anglout = deg2rad(anglin) + anglout = anglin * pi / 180; +endfunction + +## http://www.mathworks.com/access/helpdesk/help/toolbox/map/functionlist.shtml diff --git a/octave_packages/mapping-1.0.7/distance.m b/octave_packages/mapping-1.0.7/distance.m new file mode 100644 index 0000000..8b726ae --- /dev/null +++ b/octave_packages/mapping-1.0.7/distance.m @@ -0,0 +1,44 @@ +## Copyright (C) 2004 Andrew Collier +## +## This program is free software; it is distributed in the hope that it +## will be useful, but WITHOUT ANY WARRANTY; without even the implied +## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 file; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{dist} = distance(@var{pt1}, @var{pt2}) +## +## Calculates the distance (in degrees) between @var{pt1} and @var{pt2}. +## +## @var{pt1} and @var{pt2} are two-column matrices of the form [latitude longitude]. +## +## @example +## >> distance([37,-76], [37,-9]) +## ans = 52.309 +## >> distance([37,-76], [67,-76]) +## ans = 30.000 +## @end example +## +## @seealso{azimuth,elevation} +## @end deftypefn + +## Author: Andrew Collier + +## Uses "cosine formula". + +function dist = distance(pt1, pt2) + pt1 = deg2rad(pt1); + pt2 = deg2rad(pt2); + + c = pi / 2 - pt1(1); + b = pi / 2 - pt2(1); + A = pt2(2) - pt1(2); + + dist = rad2deg(acos(cos(b) * cos(c) + sin(b) * sin(c) * cos(A))); +endfunction + +## http://www.mathworks.com/access/helpdesk/help/toolbox/map/distance.shtml diff --git a/octave_packages/mapping-1.0.7/doc-cache b/octave_packages/mapping-1.0.7/doc-cache new file mode 100644 index 0000000..722ba18 --- /dev/null +++ b/octave_packages/mapping-1.0.7/doc-cache @@ -0,0 +1,198 @@ +# Created by Octave 3.6.1, Tue Apr 03 20:39:46 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 6 +# name: +# type: sq_string +# elements: 1 +# length: 7 +azimuth + + +# name: +# type: sq_string +# elements: 1 +# length: 788 + -- Function File: AZ = azimuth(LAT1,LON1,LAT2,LON2) + -- Function File: AZ = azimuth(LAT1,LON1,LAT2,LON2,UNITS) + -- Function File: AZ = azimuth(PT1, PT2) + -- Function File: AZ = azimuth(PT1, PT2,UNITS) + Calculates the great circle azimuth from a point 1 to a point 2. + The latitude and longitude of these two points can either be given + independently or as columns of the matrices PT1 and PT2 in the + form [latitude longitude]. + + The units for the input coordinates and output angles can be + "degrees" (the default) or "radians". + + >> azimuth([10,10], [10,40]) + ans = 87.336 + >> azimuth([0,10], [0,40]) + ans = 90 + >> azimuth(pi/4,0,pi/4,-pi/2,"radians") + ans = 5.3279 + + See also: elevation, distance + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 +Calculates the great circle azimuth from a point 1 to a point 2. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +deg2rad + + +# name: +# type: sq_string +# elements: 1 +# length: 115 + -- Function File: ANGLOUT = deg2rad(ANGLIN) + Converts angles input in degrees to the equivalent in radians. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +Converts angles input in degrees to the equivalent in radians. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +distance + + +# name: +# type: sq_string +# elements: 1 +# length: 357 + -- Function File: DIST = distance(PT1, PT2) + Calculates the distance (in degrees) between PT1 and PT2. + + PT1 and PT2 are two-column matrices of the form [latitude + longitude]. + + >> distance([37,-76], [37,-9]) + ans = 52.309 + >> distance([37,-76], [67,-76]) + ans = 30.000 + + See also: azimuth, elevation + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 +Calculates the distance (in degrees) between PT1 and PT2. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +km2deg + + +# name: +# type: sq_string +# elements: 1 +# length: 149 + -- Function File: A = km2deg(X) + Convert a distance along a great circle of the Earth from km to + degrees. A radius of 6371 km is assumed. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 +Convert a distance along a great circle of the Earth from km to +degrees. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +rad2deg + + +# name: +# type: sq_string +# elements: 1 +# length: 115 + -- Function File: ANGLOUT = rad2deg(ANGLIN) + Converts angles input in radians to the equivalent in degrees. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +Converts angles input in radians to the equivalent in degrees. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +reckon + + +# name: +# type: sq_string +# elements: 1 +# length: 628 + -- Function File: [LATO,LONO] = reckon(LAT,LON,RANGE,AZIMUTH) + -- Function File: [LATO,LONO] = reckon(LAT,LON,RANGE,AZIMUTH,UNITS) + Compute the coordinates of the end-point of a displacement on a + sphere. LAT,LON are the coordinates of the starting point, RANGE + is the covered distance of the displacements along a great circle + and AZIMUTH is the direction of the displacement relative to the + North. The units of all input and output parameters can be either + 'degrees' (default) or 'radians'. + + This function can also be used to define a spherical coordinate + system with rotated poles. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +Compute the coordinates of the end-point of a displacement on a sphere. + + + + + diff --git a/octave_packages/mapping-1.0.7/km2deg.m b/octave_packages/mapping-1.0.7/km2deg.m new file mode 100644 index 0000000..4d5b389 --- /dev/null +++ b/octave_packages/mapping-1.0.7/km2deg.m @@ -0,0 +1,31 @@ +## Copyright (C) 2008 Alexander Barth +## +## 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, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +## -*- texinfo -*- +## @deftypefn {Function File} @var{a} = km2deg(@var{x}) +## Convert a distance along a great circle of the Earth from km to degrees. A radius +## of 6371 km is assumed. +## @end deftypefn + +## Author: Alexander Barth + +function a = km2deg(x) + +Re = 6371; + +a = 180 * x/(pi*Re); + +endfunction \ No newline at end of file diff --git a/octave_packages/mapping-1.0.7/packinfo/.autoload b/octave_packages/mapping-1.0.7/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/mapping-1.0.7/packinfo/DESCRIPTION b/octave_packages/mapping-1.0.7/packinfo/DESCRIPTION new file mode 100644 index 0000000..3feebd5 --- /dev/null +++ b/octave_packages/mapping-1.0.7/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: Mapping +Version: 1.0.7 +Date: 2009-05-06 +Author: Andrew Collier +Maintainer: The Octave Community +Title: Mapping Functions +Description: Simple Mapping functions. +Categories: Mathematics +Depends: octave (>= 2.9.7) +License: GPL version 2 or later +Url: http://octave.sf.net +Autoload: yes diff --git a/octave_packages/mapping-1.0.7/packinfo/INDEX b/octave_packages/mapping-1.0.7/packinfo/INDEX new file mode 100644 index 0000000..3f36c01 --- /dev/null +++ b/octave_packages/mapping-1.0.7/packinfo/INDEX @@ -0,0 +1,8 @@ +mapping >> Mapping Functions +Mapping Functions + azimuth + distance + reckon + rad2deg + deg2rad + km2deg diff --git a/octave_packages/mapping-1.0.7/rad2deg.m b/octave_packages/mapping-1.0.7/rad2deg.m new file mode 100644 index 0000000..107546d --- /dev/null +++ b/octave_packages/mapping-1.0.7/rad2deg.m @@ -0,0 +1,24 @@ +## Copyright (C) 2004 Andrew Collier +## +## This program is free software; it is distributed in the hope that it +## will be useful, but WITHOUT ANY WARRANTY; without even the implied +## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 file; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{anglout} = rad2deg(@var{anglin}) +## +## Converts angles input in radians to the equivalent in degrees. +## @end deftypefn + +## Author: Andrew Collier + +function anglout = rad2deg(anglin) + anglout = anglin * 180 / pi; +endfunction + +## http://www.mathworks.com/access/helpdesk/help/toolbox/map/functionlist.shtml diff --git a/octave_packages/mapping-1.0.7/reckon.m b/octave_packages/mapping-1.0.7/reckon.m new file mode 100644 index 0000000..23ca1d2 --- /dev/null +++ b/octave_packages/mapping-1.0.7/reckon.m @@ -0,0 +1,121 @@ +## Copyright (C) 2008 Alexander Barth +## +## 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, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{lato},@var{lono}] = } reckon(@var{lat},@var{lon},@var{range},@var{azimuth}) +## @deftypefnx {Function File} {[@var{lato},@var{lono}] = } reckon(@var{lat},@var{lon},@var{range},@var{azimuth},@var{units}) +## Compute the coordinates of the end-point of a displacement on a +## sphere. @var{lat},@var{lon} are the coordinates of the starting point, @var{range} +## is the covered distance of the displacements along a great circle and +## @var{azimuth} is the direction of the displacement relative to the North. +## The units of all input and output parameters can be either 'degrees' (default) +## or 'radians'. +## +## This function can also be used to define a spherical coordinate system +## with rotated poles. +## @end deftypefn + +## Author: Alexander Barth + +function [lato,lono] = reckon(varargin); + + units = "degrees"; + + [reg,prop] = parseparams(varargin); + + ## Input checking + if length(reg) != 4 + print_usage (); + endif + + sz = [1 1]; + + for i=1:4 + if !isscalar(reg{i}) + sz = size(reg{i}); + break; + endif + endfor + + for i=1:4 + if isscalar(reg{i}) + reg{i} = repmat(reg{i},sz); + elseif !isequal(size(reg{i}),sz) + print_usage(); + endif + endfor + + if length(prop) == 1 + units = prop{1}; + elseif length(prop) > 1 + error("reckon: wrong number of type of arguments"); + end + + lat = reg{1}; + lon = reg{2}; + range = reg{3}; + azimuth = reg{4}; + + if strcmp(units,"degrees") + d = pi/180; + elseif strcmp(units,"radians") + d = 1; + else + error(["reckon: unknown units: " units]); + endif + + ## convert to radians + + lat = lat*d; + lon = lon*d; + range = range*d; + azimuth = azimuth*d; + + lato = pi/2 - acos(sin(lat).*cos(range) + cos(lat).*sin(range).*cos(azimuth)); + + cos_gamma = (cos(range) - sin(lato).*sin(lat))./(cos(lato).*cos(lat)); + sin_gamma = sin(azimuth).*sin(range)./cos(lato); + + gamma = atan2(sin_gamma,cos_gamma); + + lono = lon + gamma; + + ## bring the lono in the interval [-pi pi[ + + lono = mod(lono+pi,2*pi)-pi; + + ## convert to degrees + + lono = lono/d; + lato = lato/d; + +endfunction + + +%!test +%! [lato,lono] = reckon(30,-80,20,40); +%! assert(lato,44.16661401448592,1e-10) +%! assert(lono,-62.15251496909770,1e-10) + +%!test +%! [lato,lono] = reckon(-30,80,[5 10],[40 45]); +%! assert(lato,[-26.12155703039504 -22.70996703614572],1e-10) +%! assert(lono,[83.57732793979254 87.64920016442251],1e-10) + +%!test +%! [lato,lono] = reckon([-30 31],[80 81],[5 10],[40 45]); +%! assert(lato,[-26.12155703039504 37.76782079033356],1e-10) +%! assert(lono,[83.57732793979254 89.93590456974810],1e-10) diff --git a/octave_packages/miscellaneous-1.1.0/apply.m b/octave_packages/miscellaneous-1.1.0/apply.m new file mode 100644 index 0000000..a5a5649 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/apply.m @@ -0,0 +1,102 @@ +## Copyright (C) 2007, Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {@var{return_value} =} apply (@var{@@function_handle},@var{cell_array_of_args}) +## @deftypefnx {Loadable Function} {@var{return_value} =} apply (@var{@@function_handle}) +## Apply calls the function @var{function_handle} with the arguments of the cell +## array @var{cell_array_of_args} which contains the actual arguments arg1,arg2,..., argn +## to the function, in that order. Apply invokes the function as +## @var{function_handle}(arg1, arg2, ... ,argn), where the arguments are +## extracted from each elements of the 1-row cell array @var{cell_array_of_args}. +## +## @emph{warning}: @code{apply} has been deprecated in favor of @code{arrayfun} +## and @code{cellfun} for arrays and cells respectively. This function will be +## removed from future versions of the 'miscellaneous' package". +## +## Apply also works on array of function handles if +## @var{function_handle} is passed as a cell array of a handles; in this +## case apply, evaluates each function (using the handle) with the same +## arguments. +## +## The cell-array argument is optional second argument, in the form +## of a 1-row with multiple elements. The elements of the cell-array +## form the actual arguments supplied when invoking the function @var{function_handle}. +## +## The return value depends on the function invoked, and the validity of +## the arguments. +## +## @example +## z=apply(@@sqrt,cell([1,2; 3,4])); +## z=apply(@@apply,cell(@@sqrt,cell([1,2; 3,4]))); +## apply(@@sum,cell([1,2,3,4])) +## apply(@@max,cell([1,2,3,4])) +## apply(@@min,cell([1,2,3,4])) +## @end example +## +## +## In first case, apply computes the sqrt of the matrix [1,2; 3,4]; +## The second example is meta-apply, using apply on itself. +## The rest of the examples invoke sum, max, min respectively. +## @end deftypefn +## + +function rval=apply(fun_handle,cell_array) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "apply has been deprecated, and will be removed in the future. Use `arrayfun' or `cellfun' instead."); + endif + + if (nargin == 0) + print_usage(); + error("apply(): needs at least 1 argument, see usage"); + elseif( nargin < 2) + if iscell(fun_handle) + for idx=1:length(fun_handle) + rval(idx)=feval(@feval,fun_handle{idx}); + end + else + rval=feval(@feval,fun_handle); + end + return + elseif(!iscell(cell_array)) + error("apply(): needs second argument, to be a cell-array"); + end + + + if iscell(fun_handle) + for idx=1:length(fun_handle) + rval(idx)=feval(@feval,fun_handle{idx},cell_array{:}); + end + return + end + + rval=feval(@feval,fun_handle,cell_array{:}); +end +%! +%!assert(apply({@min, @max, @mean},{[1:10]}),[ 1.0000 ,10.0000 ,5.5000]) +%!assert(apply(@min,{[1,2,3,4]}),1) +%!assert(apply(@dot,{[1,2],[3,4]}),11) +%!assert(apply(@min,{[1, 3]}),1) +%!assert(apply(@sum,{[1:10]}),55) +%!assert(apply(@sqrt,{[1,2; 3,4]}),sqrt([1,2;3,4])) +%!assert(apply(@apply,{@sqrt,{[1,2; 3,4]}}),sqrt([1,2;3,4])) +%!assert(apply(@sum,{[1,2,3,4]}),10) +%!assert(apply(@max,{[1,2,3,4]}),4) +%!assert(apply(@min,{[1,2,3,4]}),1) +%! diff --git a/octave_packages/miscellaneous-1.1.0/asci.m b/octave_packages/miscellaneous-1.1.0/asci.m new file mode 100644 index 0000000..b18cfdc --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/asci.m @@ -0,0 +1,88 @@ +## Copyright (C) 2008, Thomas Treichl +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function} {[@var{string}] =} asci ([@var{columns}]) +## Print ASCI table. +## +## If this function is called without any input argument and without any output +## argument then print a nice ASCI-table (excluding special characters with +## hexcode 0x00 to 0x20) on screen with four columns per default. If this +## function is called with one output argument then return an ASCI-table string +## and don't print anything on screen. Finally, if this function is called with +## one input argument of type scalar then either print (no output argument) or +## return (one output argument) an ASCI-table with a number of columns given in +## @var{columns}. +## +## For example, +## @example +## A = asci (3); +## disp (A); +## @end example +## @end deftypefn + +function [varargout] = asci (varargin) + + %# Check number and types of input arguments + if (nargin == 0) + vcol = 4; + elseif (isnumeric (varargin{1}) && \ + isequal (size (varargin{1}), [1, 1])) + vcol = floor (varargin{1}); + else + print_usage (); + endif + + %# First char is #32 (0x20) and last char is #128 (0x80) + vtab = ""; + voff = floor ((128 - 32) / vcol); + + %# Print a first row for the and underline that row + for vcnt = 1:vcol + vtab = sprintf ("%s Dec Hex Chr ", vtab); + endfor + vtab = sprintf ("%s\n", vtab); + + for vcnt = 1:vcol + vtab = sprintf ("%s-------------", vtab); + endfor + vtab = sprintf ("%s\n", vtab); + + %# Create the lines and columns of the asci table + for vpos = 32:(32+voff) + for vcnt = 1:vcol + vact = (vcnt-1)*voff+vpos; + vstr = {num2str(vact), dec2hex(vact), char(vact)}; + for vctn = 1:length (vstr) + vtab = sprintf ("%s %3s", vtab, vstr{vctn}); + endfor + vtab = sprintf ("%s ", vtab); + endfor + vtab = sprintf ("%s\n", vtab); + endfor + vtab = sprintf ("%s\n", vtab); + + %# Print table to screen or return it to output argument + if (nargout == 0) + printf ("%s", vtab); + elseif (nargout == 1) + varargout{1} = vtab; + endif +endfunction + +%!test +%! A = asci (); +%!test +%! A = asci (2); diff --git a/octave_packages/miscellaneous-1.1.0/chebyshevpoly.m b/octave_packages/miscellaneous-1.1.0/chebyshevpoly.m new file mode 100644 index 0000000..8ed32d8 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/chebyshevpoly.m @@ -0,0 +1,66 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{coefs}=} chebyshevpoly (@var{kind},@var{order},@var{x}) +## +## Compute the coefficients of the Chebyshev polynomial, given the +## @var{order}. We calculate the Chebyshev polynomial using the recurrence +## relations, Tn+1(x) = (2*x*Tn(x) - Tn-1(x)). The @var{kind} can set to +## compute the first or second kind chebyshev polynomial. +## +## If the value @var{x} is specified, the polynomial is also evaluated, +## otherwise just the return the coefficients of the polynomial are returned. +## +## This is NOT the generalized Chebyshev polynomial. +## +## @end deftypefn + +function h=chebyshevpoly(kind,order,val) + if nargin < 2, print_usage, endif + + h_prev=[0 1]; + if kind == 1 + h_now=[1 0]; + elseif (kind == 2) + h_now=[2 0]; + else + error('unknown kind'); + endif + + if order == 0 + h=h_prev; + else + h=h_now; + endif + + for ord=2:order + x=[];y=[]; + if (length(h_now) < (1+ord)) + x=0; + endif + y=zeros(1,(1+ord)-length(h_prev)); + p1=[h_now, x]; + p3=[y, h_prev]; + h=2*p1 -p3; + h_prev=h_now; + h_now=h; + endfor + + if nargin == 3 + h=polyval(h,val); + endif + +endfunction diff --git a/octave_packages/miscellaneous-1.1.0/clip.m b/octave_packages/miscellaneous-1.1.0/clip.m new file mode 100644 index 0000000..16b7618 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/clip.m @@ -0,0 +1,66 @@ +## Copyright (C) 1999 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} clip (@var{x}) +## @deftypefnx {Function File} {@var{x} =} clip (@var{x}, @var{hi}) +## @deftypefnx {Function File} {@var{x} =} clip (@var{x}, [@var{lo}, @var{hi}]) +## Clip @var{x} values outside the range.to the value at the boundary of the +## range. +## +## Range boundaries, @var{lo} and @var{hi}, default to 0 and 1 respectively. +## +## @var{x} = clip (@var{x}) +## Clip to range [0, 1] +## +## @var{x} = clip (@var{x}, @var{hi}) +## Clip to range [0, @var{hi}] +## +## @var{x} = clip (@var{x}, [@var{lo}, @var{hi}]) +## Clip to range [@var{lo}, @var{hi}] +## @end deftypefn + +## TODO: more clip modes, such as three level clip(X, [lo, mid, hi]), which +## TODO: sends everything above hi to hi, below lo to lo and between to +## TODO: mid; or infinite peak clipping, which sends everything above mid +## TODO: to hi and below mid to lo. + +function x = clip (x, range = [0, 1]) + + if (nargin < 1 || nargin > 2) + print_usage; + else + if (numel (range) == 2) + ## do nothing, it's good + elseif (numel (range) == 1) + range = [0, range]; + else + print_usage; + endif + endif + + x (x > range (2)) = range (2); + x (x < range (1)) = range (1); + +endfunction + +%!error clip +%!error clip(1,2,3) +%!assert (clip(pi), 1) +%!assert (clip(-pi), 0) +%!assert (clip([-1.5, 0, 1.5], [-1, 1]), [-1, 0, 1]); +%!assert (clip([-1.5, 0, 1.5]', [-1, 1]'), [-1, 0, 1]'); +%!assert (clip([-1.5, 1; 0, 1.5], [-1, 1]), [-1, 1; 0, 1]); +%!assert (isempty(clip([],1))); diff --git a/octave_packages/miscellaneous-1.1.0/colorboard.m b/octave_packages/miscellaneous-1.1.0/colorboard.m new file mode 100644 index 0000000..b5cd543 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/colorboard.m @@ -0,0 +1,174 @@ +## Copyright (C) 2009 VZLU Prague, a.s. +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} colorboard (@var{m}, @var{palette}, @var{options}) +## Displays a color board corresponding to a numeric matrix @var{m}. +## @var{m} should contain zero-based indices of colors. +## The available range of indices is given by the @var{palette} argument, +## which can be one of the following: +## +## @itemize +## @item "b&w" +## Black & white, using reverse video mode. This is the default if @var{m} is logical. +## @item "ansi8" +## The standard ANSI 8 color palette. This is the default unless @var{m} is logical. +## @item "aix16" +## The AIXTerm extended 16-color palette. Uses codes 100:107 for bright colors. +## @item "xterm16" +## The first 16 system colors of the Xterm 256-color palette. +## @item "xterm216" +## The 6x6x6 color cube of the Xterm 256-color palette. +## In this case, matrix can also be passed as a MxNx3 RGB array with values 0..5. +## @item "grayscale" +## The 24 grayscale levels of the Xterm 256-color palette. +## @item "xterm256" +## The full Xterm 256-color palette. The three above palettes together. +## @end itemize +## +## @var{options} comprises additional options. The recognized options are: +## +## @itemize +## @item "indent" +## The number of spaces by which the board is indented. Default 2. +## @item "spaces" +## The number of spaces forming one field. Default 2. +## @item "horizontalseparator" +## The character used for horizontal separation of the table. Default "#". +## @item "verticalseparator" +## The character used for vertical separation of the table. Default "|". +## @end itemize +## @end deftypefn + +function colorboard (m, palette, varargin) + if (nargin < 1) + print_usage (); + endif + + nopt = length (varargin); + + ## default options + + indent = 2; + spc = 2; + vsep = "|"; + hsep = "#"; + + ## parse options + + while (nopt > 1) + switch (tolower (varargin{nopt-1})) + case "indent" + indent = varargin{nopt}; + case "spaces" + spc = varargin{nopt}; + case "verticalseparator" + vsep = varargin{nopt}; + case "horizontalseparator" + hsep = varargin{nopt}; + otherwise + error ("unknown option: %s", varargin{nopt-1}); + endswitch + nopt -= 2; + endwhile + + if (nargin == 1) + if (islogical (m)) + palette = "b&w"; + else + palette = "ansi8"; + endif + endif + + persistent digs = char (48:55); # digits 0..7 + + switch (palette) + case "b&w" + colors = ["07"; "27"]; + case "ansi8" + i = ones (1, 8); + colors = (["4"(i, 1), digs.']); + case "aix16" + i = ones (1, 8); + colors = (["04"(i, :), digs.'; "10"(i, :), digs.']); + case "xterm16" + colors = xterm_palette (0:15); + case "xterm216" + colors = xterm_palette (16:231); + if (size (m, 3) == 3) + m = (m(:,:,1)*6 + m(:,:,2))*6 + m(:,:,3); + endif + case "grayscale" + colors = xterm_palette (232:255); + case "xterm256" + colors = xterm_palette (0:255); + otherwise + error ("colorboard: invalid palette"); + endswitch + + nc = rows (colors); + + persistent esc = char (27); + escl = [esc, "["](ones (1, nc), :); + escr = ["m", blanks(spc)](ones (1, nc), :); + + colors = [escl, colors, escr].'; + + [rm, cm] = size (m); + + if (isreal (m) && max (m(:)) <= 1) + m = min (floor (nc * m), nc-1); + endif + + try + board = reshape (colors(:, m + 1), [], rm, cm); + catch + error ("colorboard: m is not a valid index into palette"); + end_try_catch + + board = permute (board, [2, 1, 3])(:, :); + + persistent reset = [esc, "[0m"]; + + indent = blanks (indent); + vline = [indent, hsep(1, ones (1, spc*cm+2))]; + hlinel = [indent, vsep](ones (1, rm), :); + hliner = [reset, vsep](ones (1, rm), :); + + oldpso = page_screen_output (0); + unwind_protect + + disp (""); + disp (vline); + disp ([hlinel, board, hliner]); + disp (vline); + disp (""); + + puts (reset); # reset terminal + + unwind_protect_cleanup + page_screen_output (oldpso); + end_unwind_protect + +endfunction + +function pal = xterm_palette (r) + if (max (r) < 100) + fmt = "48;5;%02d"; l = 7; + else + fmt = "48;5;%03d"; l = 8; + endif + pal = reshape (sprintf (fmt, r), l, length (r)).'; +endfunction diff --git a/octave_packages/miscellaneous-1.1.0/csv2latex.m b/octave_packages/miscellaneous-1.1.0/csv2latex.m new file mode 100644 index 0000000..269e144 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/csv2latex.m @@ -0,0 +1,161 @@ +## Copyright (C) 2006 Hansgeorg Schwibbe +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Creates a latex file from a csv file. The generated latex file contains a +## tabular with all values of the csv file. The tabular can be decorated with +## row and column titles. The generated latex file can be inserted in any latex +## document by using the '\input{latex file name without .tex}' statement. +## +## Usage: +## - csv2latex(csv_file, csv_sep, latex_file) +## - csv2latex(csv_file, csv_sep, latex_file, tabular_alignments) +## - csv2latex(csv_file, csv_sep, latex_file, tabular_alignments, has_hline) +## - csv2latex(csv_file, csv_sep, latex_file, +## tabular_alignments, has_hline, column_titles) +## - csv2latex(csv_file, csv_sep, latex_file, tabular_alignments, +## has_hline, column_titles, row_titles) +## +## Parameters: +## csv_file - the path to an existing csv file +## csv_sep - the seperator of the csv values +## latex_file - the path of the latex file to create +## tabular_alignments - the tabular alignment preamble (default = {'l','l',...}) +## has_hline - indicates horizontal line seperator (default = false) +## column_titles - array with the column titles of the tabular (default = {}) +## row_titles - array with the row titles of the tabular (default = {}) +## +## Examples: +## # creates the latex file 'example.tex' from the csv file 'example.csv' +## csv2latex("example.csv", '\t', "example.tex"); +## +## # creates the latex file with horizontal and vertical lines +## csv2latex('example.csv', '\t', 'example.tex', {'|l|', 'l|'}, true); +## +## # creates the latex file with row and column titles +## csv2latex('example.csv', '\t', 'example.tex', {'|l|', 'l|'}, true, +## {'Column 1', 'Column 2', 'Column 3'}, {'Row 1', 'Row 2'}); + +function csv2latex (csv_file, csv_sep, latex_file, tabular_alignments, has_hline, column_titles, row_titles) + + ## set up the default values + if nargin < 7 + row_titles = {}; + end + if nargin < 6 + column_titles = {}; + end + if nargin < 5 + has_hline = false; + end + if nargin < 4 + tabular_alignments = {}; + end + + ## load the csv file and create the csv cell + [fid, msg] = fopen (csv_file, 'r'); # open the csv file to read + csv = cell(); + if fid != -1 + [val, count] = fread(fid); # read all data from the file + fclose(fid); # close the csv file after reading + csv_value = ''; + line_index = 1; + value_index = 1; + for index = 1:count + if val(index) == csv_sep + csv(line_index, value_index) = csv_value; + value_index++; + csv_value = ''; + elseif (val(index) == '\n' || (val(index) == '\r' && val(index+1) == '\r')) + csv(line_index, value_index) = csv_value; + value_index++; + csv_value = ''; + value_index = 1; + line_index++; + else + csv_value = sprintf('%s%c', csv_value, val(index)); + end + end + end + + ## get the size and length values + [row_size, col_size] = size(csv); + alignment_size = length(tabular_alignments); + column_title_size = length(column_titles); + row_title_size = length(row_titles); + + ## create the alignment preamble and the column titles + alignment_preamble = ''; + tabular_headline = ''; + if row_title_size != 0 + current_size = col_size + 1; + else + current_size = col_size; + end + for col_index = 1:current_size + if col_index <= alignment_size + alignment_preamble = sprintf ('%s%s', alignment_preamble, tabular_alignments(col_index)); + else + alignment_preamble = sprintf ('%sl', alignment_preamble); + end + if column_title_size != 0 + if col_index <= column_title_size + if col_index == 1 + tabular_headline = sprintf ('%s', column_titles(col_index)); + else + tabular_headline = sprintf ('%s & %s', tabular_headline, column_titles(col_index)); + end + else + tabular_headline = sprintf ('%s &', tabular_headline); + end + end + end + + ## print latex file + [fid, msg] = fopen (latex_file, 'w'); # open the latex file for writing + if fid != -1 + fprintf (fid, '\\begin{tabular}{%s}\n', alignment_preamble); # print the begin of the tabular + if column_title_size != 0 + if has_hline == true + fprintf (fid, ' \\hline\n'); + end + fprintf (fid, ' %s \\\\\n', tabular_headline); # print the headline of the tabular + end + for row_index = 1:row_size + if has_hline == true + fprintf (fid, ' \\hline\n'); + end + for col_index = 1:col_size + if col_index == 1 + if row_title_size != 0 + if row_index <= row_title_size + fprintf (fid, ' %s & ', row_titles(row_index)); # print the row title + else + fprintf (fid, ' & '); # print an empty row title + end + end + fprintf (fid, ' %s ', csv{row_index, col_index}); + else + fprintf (fid, '& %s ', csv{row_index, col_index}); + end + end + fprintf (fid, '\\\\\n'); + end + if has_hline == true + fprintf (fid, ' \\hline\n'); + end + fprintf (fid, '\\end{tabular}', alignment_preamble); # print the end of the tabular + fclose(fid); # close the latex file after writing + end +end diff --git a/octave_packages/miscellaneous-1.1.0/doc-cache b/octave_packages/miscellaneous-1.1.0/doc-cache new file mode 100644 index 0000000..3f98935 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/doc-cache @@ -0,0 +1,1258 @@ +# Created by Octave 3.6.1, Mon Apr 02 13:25:55 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 30 +# name: +# type: sq_string +# elements: 1 +# length: 5 +apply + + +# name: +# type: sq_string +# elements: 1 +# length: 1709 + -- Loadable Function: RETURN_VALUE = apply + (@FUNCTION_HANDLE,CELL_ARRAY_OF_ARGS) + -- Loadable Function: RETURN_VALUE = apply (@FUNCTION_HANDLE) + Apply calls the function FUNCTION_HANDLE with the arguments of the + cell array CELL_ARRAY_OF_ARGS which contains the actual arguments + arg1,arg2,..., argn to the function, in that order. Apply invokes + the function as FUNCTION_HANDLE(arg1, arg2, ... ,argn), where the + arguments are extracted from each elements of the 1-row cell array + CELL_ARRAY_OF_ARGS. + + _warning_: `apply' has been deprecated in favor of `arrayfun' and + `cellfun' for arrays and cells respectively. This function will be + removed from future versions of the 'miscellaneous' package". + + Apply also works on array of function handles if FUNCTION_HANDLE + is passed as a cell array of a handles; in this case apply, + evaluates each function (using the handle) with the same arguments. + + The cell-array argument is optional second argument, in the form + of a 1-row with multiple elements. The elements of the cell-array + form the actual arguments supplied when invoking the function + FUNCTION_HANDLE. + + The return value depends on the function invoked, and the validity + of the arguments. + + z=apply(@sqrt,cell([1,2; 3,4])); + z=apply(@apply,cell(@sqrt,cell([1,2; 3,4]))); + apply(@sum,cell([1,2,3,4])) + apply(@max,cell([1,2,3,4])) + apply(@min,cell([1,2,3,4])) + + In first case, apply computes the sqrt of the matrix [1,2; 3,4]; + The second example is meta-apply, using apply on itself. The rest + of the examples invoke sum, max, min respectively. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Apply calls the function FUNCTION_HANDLE with the arguments of the cell +array CE + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +asci + + +# name: +# type: sq_string +# elements: 1 +# length: 712 + -- Function: [STRING] = asci ([COLUMNS]) + Print ASCI table. + + If this function is called without any input argument and without + any output argument then print a nice ASCI-table (excluding + special characters with hexcode 0x00 to 0x20) on screen with four + columns per default. If this function is called with one output + argument then return an ASCI-table string and don't print anything + on screen. Finally, if this function is called with one input + argument of type scalar then either print (no output argument) or + return (one output argument) an ASCI-table with a number of + columns given in COLUMNS. + + For example, + A = asci (3); + disp (A); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +Print ASCI table. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +chebyshevpoly + + +# name: +# type: sq_string +# elements: 1 +# length: 536 + -- Function File: COEFS= chebyshevpoly (KIND,ORDER,X) + Compute the coefficients of the Chebyshev polynomial, given the + ORDER. We calculate the Chebyshev polynomial using the recurrence + relations, Tn+1(x) = (2*x*Tn(x) - Tn-1(x)). The KIND can set to + compute the first or second kind chebyshev polynomial. + + If the value X is specified, the polynomial is also evaluated, + otherwise just the return the coefficients of the polynomial are + returned. + + This is NOT the generalized Chebyshev polynomial. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +Compute the coefficients of the Chebyshev polynomial, given the ORDER. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +clip + + +# name: +# type: sq_string +# elements: 1 +# length: 407 + -- Function File: X = clip (X) + -- Function File: X = clip (X, HI) + -- Function File: X = clip (X, [LO, HI]) + Clip X values outside the range.to the value at the boundary of the + range. + + Range boundaries, LO and HI, default to 0 and 1 respectively. + + X = clip (X) Clip to range [0, 1] + + X = clip (X, HI) Clip to range [0, HI] + + X = clip (X, [LO, HI]) Clip to range [LO, HI] + + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 +Clip X values outside the range. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +colorboard + + +# name: +# type: sq_string +# elements: 1 +# length: 1540 + -- Function File: colorboard (M, PALETTE, OPTIONS) + Displays a color board corresponding to a numeric matrix M. M + should contain zero-based indices of colors. The available range + of indices is given by the PALETTE argument, which can be one of + the following: + + * "b&w" Black & white, using reverse video mode. This is the + default if M is logical. + + * "ansi8" The standard ANSI 8 color palette. This is the + default unless M is logical. + + * "aix16" The AIXTerm extended 16-color palette. Uses codes + 100:107 for bright colors. + + * "xterm16" The first 16 system colors of the Xterm 256-color + palette. + + * "xterm216" The 6x6x6 color cube of the Xterm 256-color + palette. In this case, matrix can also be passed as a + MxNx3 RGB array with values 0..5. + + * "grayscale" The 24 grayscale levels of the Xterm 256-color + palette. + + * "xterm256" The full Xterm 256-color palette. The three + above palettes together. + + OPTIONS comprises additional options. The recognized options are: + + * "indent" The number of spaces by which the board is + indented. Default 2. + + * "spaces" The number of spaces forming one field. Default 2. + + * "horizontalseparator" The character used for horizontal + separation of the table. Default "#". + + * "verticalseparator" The character used for vertical + separation of the table. Default "|". + + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 +Displays a color board corresponding to a numeric matrix M. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +csv2latex + + +# name: +# type: sq_string +# elements: 1 +# length: 1647 + Creates a latex file from a csv file. The generated latex file contains a + tabular with all values of the csv file. The tabular can be decorated with + row and column titles. The generated latex file can be inserted in any latex + document by using the '\input{latex file name without .tex}' statement. + + Usage: + - csv2latex(csv_file, csv_sep, latex_file) + - csv2latex(csv_file, csv_sep, latex_file, tabular_alignments) + - csv2latex(csv_file, csv_sep, latex_file, tabular_alignments, has_hline) + - csv2latex(csv_file, csv_sep, latex_file, + tabular_alignments, has_hline, column_titles) + - csv2latex(csv_file, csv_sep, latex_file, tabular_alignments, + has_hline, column_titles, row_titles) + + Parameters: + csv_file - the path to an existing csv file + csv_sep - the seperator of the csv values + latex_file - the path of the latex file to create + tabular_alignments - the tabular alignment preamble (default = {'l','l',...}) + has_hline - indicates horizontal line seperator (default = false) + column_titles - array with the column titles of the tabular (default = {}) + row_titles - array with the row titles of the tabular (default = {}) + + Examples: + # creates the latex file 'example.tex' from the csv file 'example.csv' + csv2latex("example.csv", '\t', "example.tex"); + + # creates the latex file with horizontal and vertical lines + csv2latex('example.csv', '\t', 'example.tex', {'|l|', 'l|'}, true); + + # creates the latex file with row and column titles + csv2latex('example.csv', '\t', 'example.tex', {'|l|', 'l|'}, true, + {'Column 1', 'Column 2', 'Column 3'}, {'Row 1', 'Row 2'}); + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + Creates a latex file from a csv file. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +gameoflife + + +# name: +# type: sq_string +# elements: 1 +# length: 333 + -- Function File: B = gameoflife (A, ngen, delay) + Runs the Conways' game of life from a given initial state for a + given number of generations and visualizes the process. If ngen + is infinity, the process is run as long as A changes. Delay sets + the pause between two frames. If zero, visualization is not done. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Runs the Conways' game of life from a given initial state for a given +number of + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +hermitepoly + + +# name: +# type: sq_string +# elements: 1 +# length: 352 + -- Function File: COEFS= hermitepoly (ORDER,X) + Compute the coefficients of the Hermite polynomial, given the + ORDER. We calculate the Hermite polynomial using the recurrence + relations, Hn+1(x) = 2x.Hn(x) - 2nHn-1(x). + + If the value X is specified, the polynomial is also evaluated, + otherwise just the return the coefficients. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 68 +Compute the coefficients of the Hermite polynomial, given the ORDER. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +hilbert_curve + + +# name: +# type: sq_string +# elements: 1 +# length: 322 + -- Function file: X, Y hilbert_curve (N) + Creates an iteration of the Hilbert space-filling curve with N + points. The argument N must be of the form `2^M', where M is an + integer greater than 0. + + n = 8 + [x ,y] = hilbert_curve (n); + line (x, y, "linewidth", 4, "color", "blue"); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +Creates an iteration of the Hilbert space-filling curve with N points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +infoskeleton + + +# name: +# type: sq_string +# elements: 1 +# length: 330 + -- Function File: infoskeleton (PROTOTYPE, INDEX_STR, SEE_ALSO) + Generate TeXinfo skeleton documentation of PROTOTYPE. + + Optionally INDEX_STR and SEE_ALSO can be specified. + + Usage of this function is typically, + infoskeleton('[V,Q] = eig( A )','linear algebra','eigs, chol, qr, det') + + See also: info + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Generate TeXinfo skeleton documentation of PROTOTYPE. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +laguerrepoly + + +# name: +# type: sq_string +# elements: 1 +# length: 461 + -- Function File: COEFS= laguerrepoly (ORDER,X) + Compute the coefficients of the Laguerre polynomial, given the + ORDER. We calculate the Laguerre polynomial using the recurrence + relations, Ln+1(x) = inv(n+1)*((2n+1-x)Ln(x) - nLn-1(x)). + + If the value X is specified, the polynomial is also evaluated, + otherwise just the return the coefficients of the polynomial are + returned. + + This is NOT the generalized Laguerre polynomial. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +Compute the coefficients of the Laguerre polynomial, given the ORDER. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +lauchli + + +# name: +# type: sq_string +# elements: 1 +# length: 417 + -- Function File: A = lauchli (N) + -- Function File: A = lauchli (N,MU) + Creates the matrix [ ones(1,N); MU*eye(N) ] The value MU defaults + to sqrt(eps). This is an ill-conditioned system for testing the + accuracy of the QR routine. + + A = lauchli(15); + [Q, R] = qr(A); + norm(Q*R - A) + norm(Q'*Q - eye(rows(Q))) + + See also: ones, zeros, eye + + + + +# name: +# type: sq_string +# elements: 1 +# length: 79 +Creates the matrix [ ones(1,N); MU*eye(N) ] The value MU defaults to +sqrt(eps). + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +legendrepoly + + +# name: +# type: sq_string +# elements: 1 +# length: 462 + -- Function File: COEFS= legendrepoly (ORDER,X) + Compute the coefficients of the Legendre polynomial, given the + ORDER. We calculate the Legendre polynomial using the recurrence + relations, Pn+1(x) = inv(n+1)*((2n+1)*x*Pn(x) - nPn-1(x)). + + If the value X is specified, the polynomial is also evaluated, + otherwise just the return the coefficients of the polynomial are + returned. + + This is NOT the generalized Legendre polynomial. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +Compute the coefficients of the Legendre polynomial, given the ORDER. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +map + + +# name: +# type: sq_string +# elements: 1 +# length: 1227 + -- Function File: RESULT = map (FUNCTION, ITERABLE, ...) + Apply FUNCTION to every item of ITERABLE and return the results. + + `map', like Lisp's ( & numerous other language's ) function for + iterating the result of a function applied to each of the data + structure's elements in turn. The results are stored in the + corresponding input's place. For now, just will work with cells and + matrices, but support for structs are intended for future versions. + Also, only "prefix" functions ( like `min (a, b, c, ...)' ) are + supported. FUN_HANDLE can either be a function name string or a + function handle (recommended). + + Example: + + octave> A + A + { + [1,1] = 0.0096243 + [2,1] = 0.82781 + [1,2] = 0.052571 + [2,2] = 0.84645 + } + octave> B + B = + { + [1,1] = 0.75563 + [2,1] = 0.84858 + [1,2] = 0.16765 + [2,2] = 0.85477 + } + octave> map(@min,A,B) + ans = + { + [1,1] = 0.0096243 + [2,1] = 0.82781 + [1,2] = 0.052571 + [2,2] = 0.84645 + } + + See also: reduce, match + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 +Apply FUNCTION to every item of ITERABLE and return the results. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +match + + +# name: +# type: sq_string +# elements: 1 +# length: 1002 + -- Function File: RESULT = match ( FUN_HANDLE, ITERABLE ) + match is filter, like Lisp's ( & numerous other language's ) + function for Python has a built-in filter function which takes two + arguments, a function and a list, and returns a list. 'match' + performs the same operation like filter in Python. The match + applies the function to each of the element in the ITERABLE and + collects that the result of a function applied to each of the data + structure's elements in turn, and the return values are collected + as a list of input arguments, whenever the function-result is + 'true' in Octave sense. Anything (1,true,?) evaluating to true, + the argument is saved into the return value. + + FUN_HANDLE can either be a function name string or a function + handle (recommended). + + Typically you can use it as, + match(@(x) ( x >= 1 ), [-1 0 1 2]) + => 1 2 + + See also: reduce, cellfun, arrayfun, cellfun, structfun, spfun + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +match is filter, like Lisp's ( & numerous other language's ) function +for Python + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +normc + + +# name: +# type: sq_string +# elements: 1 +# length: 269 + -- Function File: X = normc (M) + Normalize the columns of a matrix to a length of 1 and return the + matrix. + + M=[1,2; 3,4]; + normc(M) + + ans = + + 0.31623 0.44721 + 0.94868 0.89443 + + See also: normr + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 +Normalize the columns of a matrix to a length of 1 and return the +matrix. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +normr + + +# name: +# type: sq_string +# elements: 1 +# length: 267 + -- Function File: X = normr (M) + Normalize the rows of a matrix to a length of 1 and return the + matrix. + + M=[1,2; 3,4]; + normr(M) + + ans = + + 0.44721 0.89443 + 0.60000 0.80000 + + See also: normc + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +Normalize the rows of a matrix to a length of 1 and return the matrix. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +nze + + +# name: +# type: sq_string +# elements: 1 +# length: 147 + -- Function File: [Y, F] = nze (X) + Extract nonzero elements of X. Equivalent to `X(X != 0)'. + Optionally, returns also linear indices. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Extract nonzero elements of X. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +peano_curve + + +# name: +# type: sq_string +# elements: 1 +# length: 316 + -- Function file: X, Y peano_curve (N) + Creates an iteration of the Peano space-filling curve with N + points. The argument N must be of the form `3^M', where M is an + integer greater than 0. + + n = 9; + [x, y] = peano_curve (n); + line (x, y, "linewidth", 4, "color", "red"); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 68 +Creates an iteration of the Peano space-filling curve with N points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +publish + + +# name: +# type: sq_string +# elements: 1 +# length: 1772 + -- Function File: publish (FILENAME) + -- Function File: publish (FILENAME, OPTIONS) + Produces latex reports from scripts. + + publish (MY_SCRIPT) + + where the argument is a string that contains the file name of the + script we want to report. + + If two arguments are given, they are interpreted as follows. + + publish (FILENAME, [OPTION, VALUE, ...]) + + The following options are available: + + * format + + the only available format values are the strings `latex' and + `html'. + + * imageFormat: + + string that specifies the image format, valid formats are + `pdf', `png', and `jpg'(or `jpeg'). + + * showCode: + + boolean value that specifies if the source code will be + included in the report. + + * evalCode: + + boolean value that specifies if execution results will be + included in the report. + + + Default OPTIONS + + * format = latex + + * imageFormat = pdf + + * showCode = 1 + + * evalCode = 1 + + + Remarks + + * Any additional non-valid field is removed without + notification. + + * To include several figures in the resulting report you must + use figure with a unique number for each one of them. + + * You do not have to save the figures manually, publish will do + it for you. + + * The functions works only for the current path and no way ... + to specify other path is allowed. + + + Assume you have the script `myscript.m' which looks like + + x = 0:0.1:pi; + y = sin(x) + figure(1) + plot(x,y); + figure(2) + plot(x,y.^2); + + You can then call publish with default OPTIONS + + publish("myscript") + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Produces latex reports from scripts. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +read_options + + +# name: +# type: sq_string +# elements: 1 +# length: 1910 + -- Function File: [OP,NREAD] = read_options ( args, varargin ) + The function read_options parses arguments to a function as, + [ops,nread] = read_options (args,...) - Read options + + The input being ARGS a list of options and values. The options + can be any of the following, + + 'op0' , string : Space-separated names of opt taking no + argument <"> + + 'op1' , string : Space-separated names of opt taking one + argument <"> + + 'extra' , string : Name of nameless trailing arguments. + <"> + + 'default', struct : Struct holding default option values + + + 'prefix' , int : If false, only accept whole opt names. + Otherwise, <0> recognize opt from first chars, + and choose shortest if many opts start alike. + + 'nocase' , int : If set, ignore case in option names + <0> + + 'quiet' , int : Behavior when a non-string or unknown opt is + met <0> 0 - Produce an error 1 - + Return quietly (can be diagnosed by checking 'nread') + + 'skipnan', int : Ignore NaNs if there is a default value. + Note : At least one of 'op0' or 'op1' should be specified. + + The output variables are, OPS : struct : Struct whose + key/values are option names/values NREAD : int : Number of + elements of args that were read + + USAGE + # Define options and defaults + op0 = "is_man is_plane flies" + default = struct ("is_man",1, "flies",0); + + # Read the options + + s = read_options (list (all_va_args), "op0",op0,"default",default) + + # Create variables w/ same name as options + + [is_man, is_plane, flies] = getfields (s,"is_man", "is_plane", "flies") + pre 2.1.39 function [op,nread] = read_options (args, ...) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +The function read_options parses arguments to a function as, +[ops,nread] = read_ + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +reduce + + +# name: +# type: sq_string +# elements: 1 +# length: 938 + -- Function File: X = reduce (FUNCTION, SEQUENCE,INITIALIZER) + -- Function File: X = reduce (FUNCTION, SEQUENCE) + Implements the 'reduce' operator like in Lisp, or Python. Apply + function of two arguments cumulatively to the items of sequence, + from left to right, so as to reduce the sequence to a single + value. For example, reduce(@(x,y)(x+y), [1, 2, 3, 4, 5]) + calculates ((((1+2)+3)+4)+5). The left argument, x, is the + accumulated value and the right argument, y, is the update value + from the sequence. If the optional initializer is present, it is + placed before the items of the sequence in the calculation, and + serves as a default when the sequence is empty. If initializer is + not given and sequence contains only one item, the first item is + returned. + + reduce(@add,[1:10]) + => 55 + reduce(@(x,y)(x*y),[1:7]) + => 5040 (actually, 7!) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 +Implements the 'reduce' operator like in Lisp, or Python. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +rolldices + + +# name: +# type: sq_string +# elements: 1 +# length: 373 + -- Function File: rolldices (N) + -- Function File: rolldices (N, NREP, DELAY) + Returns N random numbers from the 1:6 range, displaying a visual + selection effect. + + NREP sets the number of rolls, DELAY specifies time between + successive rolls in seconds. Default is nrep = 25 and delay = 0.1. + + Requires a terminal with ANSI escape sequences enabled. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Returns N random numbers from the 1:6 range, displaying a visual +selection effec + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +slurp_file + + +# name: +# type: sq_string +# elements: 1 +# length: 293 + -- Function File: S = slurp_file ( f ) + slurp_file return a whole text file F as a string S. + + F : string : filename S : string : contents of the file + + If F is not an absolute filename, and is not an immediately + accessible file, slurp_file () will look for F in the path. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +slurp_file return a whole text file F as a string S. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +solvesudoku + + +# name: +# type: sq_string +# elements: 1 +# length: 313 + -- Function File: [ X, NTRIAL] = solvesudoku (S) + Solves a classical 9x9 sudoku. S should be a 9x9 array with + numbers from 0:9. 0 indicates empty field. Returns the filled + table or empty matrix if no solution exists. If requested, NTRIAL + returns the number of trial-and-error steps needed. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Solves a classical 9x9 sudoku. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +temp_name + + +# name: +# type: sq_string +# elements: 1 +# length: 504 + -- Function File: N = temp_name ( rootname, quick ) + name = temp_name(rootname, quick=1) - Return a name that is not + used + + Returns a name, suitable for defining a new function, script or + global variable, of the form + + [rootname,number] + + Default rootname is "temp_name_" + + "quick" is an optional parameter, which defaults to 1. If it is + false, temp_name() will find the smallest acceptable number for + the name. Otherwise, a hopefully quicker method is used. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +name = temp_name(rootname, quick=1) - Return a name that is not used + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +units + + +# name: +# type: sq_string +# elements: 1 +# length: 804 + -- Function File: units (FROMUNIT, TOUNIT) + -- Function File: units (FROMUNIT, TOUNIT, X) + Return the conversion factor from FROMUNIT to TOUNIT measurements. + + This is an octave interface to the *GNU Units* program which comes + with an annotated, extendable database defining over two thousand + measurement units. See `man units' or + `http://www.gnu.org/software/units' for more information. If the + optional argument X is supplied, return that argument multiplied + by the conversion factor. Nonlinear conversions such as + Fahrenheit to Celsius are not currently supported. For example, to + convert three values from miles per hour into meters per second: + + units ("mile/hr", "m/sec", [30, 55, 75]) + ans = + + 13.411 24.587 33.528 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +Return the conversion factor from FROMUNIT to TOUNIT measurements. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +z_curve + + +# name: +# type: sq_string +# elements: 1 +# length: 310 + -- Function file: X, Y z_curve (N) + Creates an iteration of the Z-order space-filling curve with N + points. The argument N must be of the form `2^M', where M is an + integer greater than 0. + + n = 8 + [x ,y] = z_curve (n); + line (x, y, "linewidth", 4, "color", "blue"); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +Creates an iteration of the Z-order space-filling curve with N points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +zagzig + + +# name: +# type: sq_string +# elements: 1 +# length: 627 + -- Function File: zagzig (MTRX) + Returns zagzig walk-off of the elements of MTRX. Essentially it + walks the matrix in a Z-fashion. + + mat = 1 4 7 2 5 8 3 6 9 then zagzag(mat) gives + the output, [1 4 2 3 5 7 8 6 9], by walking as shown in the figure + from pt 1 in that order of output. The argument MTRX should be a + MxN matrix. One use of zagzig the use with picking up DCT + coefficients like in the JPEG algorithm for compression. + + An example of zagzig use: + mat = reshape(1:9,3,3); + zagzag(mat) + ans =[1 4 2 3 5 7 8 6 9] + + + See also: zigzag + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Returns zagzig walk-off of the elements of MTRX. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +zigzag + + +# name: +# type: sq_string +# elements: 1 +# length: 550 + -- Function File: zigzag (MTRX) + Returns zigzag walk-off of the elements of MTRX. Essentially it + walks the matrix in a Z-fashion. + + mat = 1 4 7 2 5 8 3 6 9 then zigzag(mat) gives + the output, [1 2 4 7 5 3 6 8 9], by walking as + shown in the figure from pt 1 in that order of output. The + argument MTRX should be a MxN matrix + + An example of zagzig use: + mat = reshape(1:9,3,3); + zigzag(mat) + ans =[1 2 4 7 5 3 6 8 9] + + + See also: zagzig + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Returns zigzag walk-off of the elements of MTRX. + + + + + diff --git a/octave_packages/miscellaneous-1.1.0/gameoflife.m b/octave_packages/miscellaneous-1.1.0/gameoflife.m new file mode 100644 index 0000000..458032e --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/gameoflife.m @@ -0,0 +1,59 @@ +## Copyright (C) 2010 VZLU Prague, a.s. +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {B =} gameoflife (A, ngen, delay) +## Runs the Conways' game of life from a given initial state for a given +## number of generations and visualizes the process. +## If ngen is infinity, the process is run as long as A changes. +## Delay sets the pause between two frames. If zero, visualization is not done. +## @end deftypefn + +function B = gameoflife (A, ngen, delay = 0.2) + B = A != 0; + igen = 0; + CSI = char ([27, 91]); + + oldpso = page_screen_output (delay != 0); + unwind_protect + + if (delay > 0) + puts (["\n", CSI, "s"]); + printf ("generation 0\n"); + colorboard (! B); + pause (delay); + endif + + while (igen < ngen) + C = conv2 (B, ones (3), "same") - B; + B1 = C == 3 | (B & C == 2); + igen++; + if (isinf (ngen) && all ((B1 == B)(:))) + break; + endif + B = B1; + if (delay > 0) + puts (["\n", CSI, "u"]); + printf ("generation %d\n", igen); + colorboard (! B); + pause (delay); + endif + endwhile + + unwind_protect_cleanup + page_screen_output (oldpso); + end_unwind_protect + +endfunction diff --git a/octave_packages/miscellaneous-1.1.0/hermitepoly.m b/octave_packages/miscellaneous-1.1.0/hermitepoly.m new file mode 100644 index 0000000..7692417 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/hermitepoly.m @@ -0,0 +1,116 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{coefs}=} hermitepoly (@var{order},@var{x}) +## +## Compute the coefficients of the Hermite polynomial, given the +## @var{order}. We calculate the Hermite polynomial using the recurrence +## relations, Hn+1(x) = 2x.Hn(x) - 2nHn-1(x). +## +## If the value @var{x} is specified, the polynomial is also evaluated, +## otherwise just the return the coefficients. +## +## @end deftypefn + +function h = hermitepoly (order, val) + if nargin < 1, print_usage, end + + ## contains the first 50 hermite-polynomials + H = [ 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 2.00000000e+00 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 4.00000000e+00 0.00000000e+00 -2.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 8.00000000e+00 0.00000000e+00 -1.20000000e+01 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.60000000e+01 0.00000000e+00 -4.80000000e+01 0.00000000e+00 1.20000000e+01 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 3.20000000e+01 0.00000000e+00 -1.60000000e+02 0.00000000e+00 1.20000000e+02 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 6.40000000e+01 0.00000000e+00 -4.80000000e+02 0.00000000e+00 7.20000000e+02 0.00000000e+00 -1.20000000e+02 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.28000000e+02 0.00000000e+00 -1.34400000e+03 0.00000000e+00 3.36000000e+03 0.00000000e+00 -1.68000000e+03 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 2.56000000e+02 0.00000000e+00 -3.58400000e+03 0.00000000e+00 1.34400000e+04 0.00000000e+00 -1.34400000e+04 0.00000000e+00 1.68000000e+03 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 5.12000000e+02 0.00000000e+00 -9.21600000e+03 0.00000000e+00 4.83840000e+04 0.00000000e+00 -8.06400000e+04 0.00000000e+00 3.02400000e+04 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.02400000e+03 0.00000000e+00 -2.30400000e+04 0.00000000e+00 1.61280000e+05 0.00000000e+00 -4.03200000e+05 0.00000000e+00 3.02400000e+05 0.00000000e+00 -3.02400000e+04 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 2.04800000e+03 0.00000000e+00 -5.63200000e+04 0.00000000e+00 5.06880000e+05 0.00000000e+00 -1.77408000e+06 0.00000000e+00 2.21760000e+06 0.00000000e+00 -6.65280000e+05 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 4.09600000e+03 0.00000000e+00 -1.35168000e+05 0.00000000e+00 1.52064000e+06 0.00000000e+00 -7.09632000e+06 0.00000000e+00 1.33056000e+07 0.00000000e+00 -7.98336000e+06 0.00000000e+00 6.65280000e+05 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 8.19200000e+03 0.00000000e+00 -3.19488000e+05 0.00000000e+00 4.39296000e+06 0.00000000e+00 -2.63577600e+07 0.00000000e+00 6.91891200e+07 0.00000000e+00 -6.91891200e+07 0.00000000e+00 1.72972800e+07 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.63840000e+04 0.00000000e+00 -7.45472000e+05 0.00000000e+00 1.23002880e+07 0.00000000e+00 -9.22521600e+07 0.00000000e+00 3.22882560e+08 0.00000000e+00 -4.84323840e+08 0.00000000e+00 2.42161920e+08 0.00000000e+00 -1.72972800e+07 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 3.27680000e+04 0.00000000e+00 -1.72032000e+06 0.00000000e+00 3.35462400e+07 0.00000000e+00 -3.07507200e+08 0.00000000e+00 1.38378240e+09 0.00000000e+00 -2.90594304e+09 0.00000000e+00 2.42161920e+09 0.00000000e+00 -5.18918400e+08 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 6.55360000e+04 0.00000000e+00 -3.93216000e+06 0.00000000e+00 8.94566400e+07 0.00000000e+00 -9.84023040e+08 0.00000000e+00 5.53512960e+09 0.00000000e+00 -1.54983629e+10 0.00000000e+00 1.93729536e+10 0.00000000e+00 -8.30269440e+09 0.00000000e+00 5.18918400e+08 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.31072000e+05 0.00000000e+00 -8.91289600e+06 0.00000000e+00 2.33963520e+08 0.00000000e+00 -3.04152576e+09 0.00000000e+00 2.09104896e+10 0.00000000e+00 -7.52777626e+10 0.00000000e+00 1.31736084e+11 0.00000000e+00 -9.40972032e+10 0.00000000e+00 1.76432256e+10 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 2.62144000e+05 0.00000000e+00 -2.00540160e+07 0.00000000e+00 6.01620480e+08 0.00000000e+00 -9.12457728e+09 0.00000000e+00 7.52777626e+10 0.00000000e+00 -3.38749932e+11 0.00000000e+00 7.90416507e+11 0.00000000e+00 -8.46874829e+11 0.00000000e+00 3.17578061e+11 0.00000000e+00 -1.76432256e+10 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 5.24288000e+05 0.00000000e+00 -4.48266240e+07 0.00000000e+00 1.52410522e+09 0.00000000e+00 -2.66718413e+10 0.00000000e+00 2.60050452e+11 0.00000000e+00 -1.43027749e+12 0.00000000e+00 4.29083247e+12 0.00000000e+00 -6.43624870e+12 0.00000000e+00 4.02265544e+12 0.00000000e+00 -6.70442573e+11 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.04857600e+06 0.00000000e+00 -9.96147200e+07 0.00000000e+00 3.81026304e+09 0.00000000e+00 -7.62052608e+10 0.00000000e+00 8.66834842e+11 0.00000000e+00 -5.72110995e+12 0.00000000e+00 2.14541623e+13 0.00000000e+00 -4.29083247e+13 0.00000000e+00 4.02265544e+13 0.00000000e+00 -1.34088515e+13 0.00000000e+00 6.70442573e+11 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 2.09715200e+06 0.00000000e+00 -2.20200960e+08 0.00000000e+00 9.41359104e+09 0.00000000e+00 -2.13374730e+11 0.00000000e+00 2.80054333e+12 0.00000000e+00 -2.18442380e+13 0.00000000e+00 1.00119424e+14 0.00000000e+00 -2.57449948e+14 0.00000000e+00 3.37903057e+14 0.00000000e+00 -1.87723920e+14 0.00000000e+00 2.81585881e+13 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 4.19430400e+06 0.00000000e+00 -4.84442112e+08 0.00000000e+00 2.30110003e+10 0.00000000e+00 -5.86780508e+11 0.00000000e+00 8.80170762e+12 0.00000000e+00 -8.00955394e+13 0.00000000e+00 4.40525467e+14 0.00000000e+00 -1.41597471e+15 0.00000000e+00 2.47795575e+15 0.00000000e+00 -2.06496312e+15 0.00000000e+00 6.19488937e+14 0.00000000e+00 -2.81585881e+13 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 8.38860800e+06 0.00000000e+00 -1.06115891e+09 0.00000000e+00 5.57108429e+10 0.00000000e+00 -1.58775902e+12 0.00000000e+00 2.69919034e+13 0.00000000e+00 -2.83414985e+14 0.00000000e+00 1.84219741e+15 0.00000000e+00 -7.23720409e+15 0.00000000e+00 1.62837092e+16 0.00000000e+00 -1.89976607e+16 0.00000000e+00 9.49883037e+15 0.00000000e+00 -1.29529505e+15 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.67772160e+07 0.00000000e+00 -2.31525581e+09 0.00000000e+00 1.33706023e+11 0.00000000e+00 -4.23402406e+12 0.00000000e+00 8.09757101e+13 0.00000000e+00 -9.71708522e+14 0.00000000e+00 7.36878962e+15 0.00000000e+00 -3.47385796e+16 0.00000000e+00 9.77022552e+16 0.00000000e+00 -1.51981286e+17 0.00000000e+00 1.13985964e+17 0.00000000e+00 -3.10870812e+16 0.00000000e+00 1.29529505e+15 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 3.35544320e+07 0.00000000e+00 -5.03316480e+09 0.00000000e+00 3.18347674e+11 0.00000000e+00 -1.11421686e+13 0.00000000e+00 2.38163853e+14 0.00000000e+00 -3.23902841e+15 0.00000000e+00 2.83414985e+16 0.00000000e+00 -1.57902635e+17 0.00000000e+00 5.42790307e+17 0.00000000e+00 -1.08558061e+18 0.00000000e+00 1.13985964e+18 0.00000000e+00 -5.18118020e+17 0.00000000e+00 6.47647525e+16 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 6.71088640e+07 0.00000000e+00 -1.09051904e+10 0.00000000e+00 7.52458138e+11 0.00000000e+00 -2.89696383e+13 0.00000000e+00 6.88028910e+14 0.00000000e+00 -1.05268423e+16 0.00000000e+00 1.05268423e+17 0.00000000e+00 -6.84244751e+17 0.00000000e+00 2.82250960e+18 0.00000000e+00 -7.05627399e+18 0.00000000e+00 9.87878359e+18 0.00000000e+00 -6.73553426e+18 0.00000000e+00 1.68388357e+18 0.00000000e+00 -6.47647525e+16 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.34217728e+08 0.00000000e+00 -2.35552113e+10 0.00000000e+00 1.76664084e+12 0.00000000e+00 -7.44933556e+13 0.00000000e+00 1.95545059e+15 0.00000000e+00 -3.34382050e+16 0.00000000e+00 3.78966323e+17 0.00000000e+00 -2.84224743e+18 0.00000000e+00 1.38559562e+19 0.00000000e+00 -4.23376439e+19 0.00000000e+00 7.62077591e+19 0.00000000e+00 -7.27437700e+19 0.00000000e+00 3.03099042e+19 0.00000000e+00 -3.49729664e+18 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 2.68435456e+08 0.00000000e+00 -5.07343012e+10 0.00000000e+00 4.12216197e+12 0.00000000e+00 -1.89619451e+14 0.00000000e+00 5.47526164e+15 0.00000000e+00 -1.04029971e+17 0.00000000e+00 1.32638213e+18 0.00000000e+00 -1.13689897e+19 0.00000000e+00 6.46611289e+19 0.00000000e+00 -2.37090806e+20 0.00000000e+00 5.33454314e+20 0.00000000e+00 -6.78941854e+20 0.00000000e+00 4.24338659e+20 0.00000000e+00 -9.79243058e+19 0.00000000e+00 3.49729664e+18 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 5.36870912e+08 0.00000000e+00 -1.08984795e+11 0.00000000e+00 9.56341577e+12 0.00000000e+00 -4.78170789e+14 0.00000000e+00 1.51221512e+16 0.00000000e+00 -3.17565175e+17 0.00000000e+00 4.52530374e+18 0.00000000e+00 -4.39600935e+19 0.00000000e+00 2.88488114e+20 0.00000000e+00 -1.25011516e+21 0.00000000e+00 3.43781669e+21 0.00000000e+00 -5.62551822e+21 0.00000000e+00 4.92232844e+21 0.00000000e+00 -1.89320325e+21 0.00000000e+00 2.02843205e+20 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.07374182e+09 0.00000000e+00 -2.33538847e+11 0.00000000e+00 2.20694210e+13 0.00000000e+00 -1.19542697e+15 0.00000000e+00 4.12422305e+16 0.00000000e+00 -9.52695525e+17 0.00000000e+00 1.50843458e+19 0.00000000e+00 -1.64850351e+20 0.00000000e+00 1.23637763e+21 0.00000000e+00 -6.25057580e+21 0.00000000e+00 2.06269001e+22 0.00000000e+00 -4.21913866e+22 0.00000000e+00 4.92232844e+22 0.00000000e+00 -2.83980487e+22 0.00000000e+00 6.08529615e+21 0.00000000e+00 -2.02843205e+20 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 2.14748365e+09 0.00000000e+00 -4.99289948e+11 0.00000000e+00 5.06779297e+13 0.00000000e+00 -2.96465889e+15 0.00000000e+00 1.11174708e+17 0.00000000e+00 -2.81272012e+18 0.00000000e+00 4.92226021e+19 0.00000000e+00 -6.01218926e+20 0.00000000e+00 5.11036087e+21 0.00000000e+00 -2.98104384e+22 0.00000000e+00 1.16260710e+23 0.00000000e+00 -2.90651775e+23 0.00000000e+00 4.35977662e+23 0.00000000e+00 -3.52135804e+23 0.00000000e+00 1.25762787e+23 0.00000000e+00 -1.25762787e+22 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 4.29496730e+09 0.00000000e+00 -1.06515189e+12 0.00000000e+00 1.15835268e+14 0.00000000e+00 -7.29762188e+15 0.00000000e+00 2.96465889e+17 0.00000000e+00 -8.18245854e+18 0.00000000e+00 1.57512327e+20 0.00000000e+00 -2.13766729e+21 0.00000000e+00 2.04414435e+22 0.00000000e+00 -1.36276290e+23 0.00000000e+00 6.20057119e+23 0.00000000e+00 -1.86017136e+24 0.00000000e+00 3.48782129e+24 0.00000000e+00 -3.75611524e+24 0.00000000e+00 2.01220459e+24 0.00000000e+00 -4.02440919e+23 0.00000000e+00 1.25762787e+22 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 8.58993459e+09 0.00000000e+00 -2.26774273e+12 0.00000000e+00 2.63625093e+14 0.00000000e+00 -1.78386313e+16 0.00000000e+00 7.82669947e+17 0.00000000e+00 -2.34800984e+19 0.00000000e+00 4.95038741e+20 0.00000000e+00 -7.42558112e+21 0.00000000e+00 7.93608982e+22 0.00000000e+00 -5.99615676e+23 0.00000000e+00 3.14798230e+24 0.00000000e+00 -1.11610281e+25 0.00000000e+00 2.55773562e+25 0.00000000e+00 -3.54148008e+25 0.00000000e+00 2.65611006e+25 0.00000000e+00 -8.85370021e+24 0.00000000e+00 8.30034395e+23 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.71798692e+10 0.00000000e+00 -4.81895331e+12 0.00000000e+00 5.97550210e+14 0.00000000e+00 -4.33223902e+16 0.00000000e+00 2.04698294e+18 0.00000000e+00 -6.65269455e+19 0.00000000e+00 1.53011975e+21 0.00000000e+00 -2.52469758e+22 0.00000000e+00 2.99807838e+23 0.00000000e+00 -2.54836662e+24 0.00000000e+00 1.52901997e+25 0.00000000e+00 -6.32458261e+25 0.00000000e+00 1.73926022e+26 0.00000000e+00 -3.01025807e+26 0.00000000e+00 3.01025807e+26 0.00000000e+00 -1.50512904e+26 0.00000000e+00 2.82211694e+25 0.00000000e+00 -8.30034395e+23 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 3.43597384e+10 0.00000000e+00 -1.02220222e+13 0.00000000e+00 1.34930693e+15 0.00000000e+00 -1.04571287e+17 0.00000000e+00 5.30699280e+18 0.00000000e+00 -1.86275447e+20 0.00000000e+00 4.65688618e+21 0.00000000e+00 -8.41565860e+22 0.00000000e+00 1.10455519e+24 0.00000000e+00 -1.04932743e+25 0.00000000e+00 7.13542654e+25 0.00000000e+00 -3.40554448e+26 0.00000000e+00 1.10680196e+27 0.00000000e+00 -2.34131183e+27 0.00000000e+00 3.01025807e+27 0.00000000e+00 -2.10718065e+27 0.00000000e+00 6.58493953e+26 0.00000000e+00 -5.81024076e+25 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 6.87194767e+10 0.00000000e+00 -2.16466352e+13 0.00000000e+00 3.03594058e+15 0.00000000e+00 -2.50971088e+17 0.00000000e+00 1.36465529e+19 0.00000000e+00 -5.15839700e+20 0.00000000e+00 1.39706586e+22 0.00000000e+00 -2.75421554e+23 0.00000000e+00 3.97639869e+24 0.00000000e+00 -4.19730973e+25 0.00000000e+00 3.21094194e+26 0.00000000e+00 -1.75142288e+27 0.00000000e+00 6.64081174e+27 0.00000000e+00 -1.68574452e+28 0.00000000e+00 2.70923226e+28 0.00000000e+00 -2.52861678e+28 0.00000000e+00 1.18528912e+28 0.00000000e+00 -2.09168667e+27 0.00000000e+00 5.81024076e+25 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.37438953e+11 0.00000000e+00 -4.57671715e+13 0.00000000e+00 6.80786676e+15 0.00000000e+00 -5.99092275e+17 0.00000000e+00 3.48222385e+19 0.00000000e+00 -1.41378288e+21 0.00000000e+00 4.13531493e+22 0.00000000e+00 -8.86138914e+23 0.00000000e+00 1.40120716e+25 0.00000000e+00 -1.63474168e+26 0.00000000e+00 1.39770414e+27 0.00000000e+00 -8.64035286e+27 0.00000000e+00 3.78015438e+28 0.00000000e+00 -1.13404631e+29 0.00000000e+00 2.22759097e+29 0.00000000e+00 -2.67310917e+29 0.00000000e+00 1.75422789e+29 0.00000000e+00 -5.15949380e+28 0.00000000e+00 4.29957816e+27 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 2.74877907e+11 0.00000000e+00 -9.66195843e+13 0.00000000e+00 1.52175845e+16 0.00000000e+00 -1.42284415e+18 0.00000000e+00 8.82163375e+19 0.00000000e+00 -3.83741068e+21 0.00000000e+00 1.20878436e+23 0.00000000e+00 -2.80610656e+24 0.00000000e+00 4.84053382e+25 0.00000000e+00 -6.21201840e+26 0.00000000e+00 5.90141748e+27 0.00000000e+00 -4.10416761e+28 0.00000000e+00 2.05208381e+29 0.00000000e+00 -7.18229332e+29 0.00000000e+00 1.69296914e+30 0.00000000e+00 -2.53945371e+30 0.00000000e+00 2.22202200e+30 0.00000000e+00 -9.80303821e+29 0.00000000e+00 1.63383970e+29 0.00000000e+00 -4.29957816e+27 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 5.49755814e+11 0.00000000e+00 -2.03684529e+14 0.00000000e+00 3.39134741e+16 0.00000000e+00 -3.36308618e+18 0.00000000e+00 2.21963688e+20 0.00000000e+00 -1.03213115e+22 0.00000000e+00 3.49204372e+23 0.00000000e+00 -8.75505247e+24 0.00000000e+00 1.64157234e+26 0.00000000e+00 -2.30732112e+27 0.00000000e+00 2.42268718e+28 0.00000000e+00 -1.88308867e+29 0.00000000e+00 1.06708358e+30 0.00000000e+00 -4.30937599e+30 0.00000000e+00 1.20046903e+31 0.00000000e+00 -2.20085988e+31 0.00000000e+00 2.47596737e+31 0.00000000e+00 -1.52927396e+31 0.00000000e+00 4.24798323e+30 0.00000000e+00 -3.35367097e+29 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.09951163e+12 0.00000000e+00 -4.28809535e+14 0.00000000e+00 7.53632757e+16 0.00000000e+00 -7.91314395e+18 0.00000000e+00 5.54909220e+20 0.00000000e+00 -2.75234973e+22 0.00000000e+00 9.97726777e+23 0.00000000e+00 -2.69386230e+25 0.00000000e+00 5.47190779e+26 0.00000000e+00 -8.39025862e+27 0.00000000e+00 9.69074870e+28 0.00000000e+00 -8.36928297e+29 0.00000000e+00 5.33541789e+30 0.00000000e+00 -2.46250057e+31 0.00000000e+00 8.00312684e+31 0.00000000e+00 -1.76068790e+32 0.00000000e+00 2.47596737e+32 0.00000000e+00 -2.03903195e+32 0.00000000e+00 8.49596645e+31 0.00000000e+00 -1.34146839e+31 0.00000000e+00 3.35367097e+29 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 2.19902326e+12 0.00000000e+00 -9.01599535e+14 0.00000000e+00 1.67021314e+17 0.00000000e+00 -1.85393658e+19 0.00000000e+00 1.37886533e+21 0.00000000e+00 -7.28040896e+22 0.00000000e+00 2.82115847e+24 0.00000000e+00 -8.18135957e+25 0.00000000e+00 1.79478576e+27 0.00000000e+00 -2.99130959e+28 0.00000000e+00 3.78400664e+29 0.00000000e+00 -3.61200633e+30 0.00000000e+00 2.57355451e+31 0.00000000e+00 -1.34616698e+32 0.00000000e+00 5.04812616e+32 0.00000000e+00 -1.31251280e+33 0.00000000e+00 2.25588138e+33 0.00000000e+00 -2.38858028e+33 0.00000000e+00 1.39333850e+33 0.00000000e+00 -3.66668026e+32 0.00000000e+00 2.75001019e+31 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 4.39804651e+12 0.00000000e+00 -1.89335902e+15 0.00000000e+00 3.69205009e+17 0.00000000e+00 -4.32585203e+19 0.00000000e+00 3.40660847e+21 0.00000000e+00 -1.91110735e+23 0.00000000e+00 7.89924372e+24 0.00000000e+00 -2.45440787e+26 0.00000000e+00 5.79853860e+27 0.00000000e+00 -1.04695836e+29 0.00000000e+00 1.44480253e+30 0.00000000e+00 -1.51704266e+31 0.00000000e+00 1.20099211e+32 0.00000000e+00 -7.06737662e+32 0.00000000e+00 3.02887570e+33 0.00000000e+00 -9.18758961e+33 0.00000000e+00 1.89494036e+34 0.00000000e+00 -2.50800930e+34 0.00000000e+00 1.95067390e+34 0.00000000e+00 -7.70002854e+33 0.00000000e+00 1.15500428e+33 0.00000000e+00 -2.75001019e+31 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 8.79609302e+12 0.00000000e+00 -3.97143600e+15 0.00000000e+00 8.14144380e+17 0.00000000e+00 -1.00546831e+20 0.00000000e+00 8.37052367e+21 0.00000000e+00 -4.98046159e+23 0.00000000e+00 2.19140310e+25 0.00000000e+00 -7.27858886e+26 0.00000000e+00 1.84694192e+28 0.00000000e+00 -3.60153675e+29 0.00000000e+00 5.40230513e+30 0.00000000e+00 -6.21265089e+31 0.00000000e+00 5.43606953e+32 0.00000000e+00 -3.57526112e+33 0.00000000e+00 1.73655540e+34 0.00000000e+00 -6.07794390e+34 0.00000000e+00 1.48149882e+35 0.00000000e+00 -2.39654222e+35 0.00000000e+00 2.39654222e+35 0.00000000e+00 -1.32440491e+35 0.00000000e+00 3.31101227e+34 0.00000000e+00 -2.36500877e+33 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.75921860e+13 0.00000000e+00 -8.32110400e+15 0.00000000e+00 1.79111764e+18 0.00000000e+00 -2.32845293e+20 0.00000000e+00 2.04612801e+22 0.00000000e+00 -1.28906065e+24 0.00000000e+00 6.02635852e+25 0.00000000e+00 -2.13505273e+27 0.00000000e+00 5.80467462e+28 0.00000000e+00 -1.21898167e+30 0.00000000e+00 1.98084521e+31 0.00000000e+00 -2.48506036e+32 0.00000000e+00 2.39187059e+33 0.00000000e+00 -1.74790543e+34 0.00000000e+00 9.55105470e+34 0.00000000e+00 -3.82042188e+35 0.00000000e+00 1.08643247e+36 0.00000000e+00 -2.10895715e+36 0.00000000e+00 2.63619644e+36 0.00000000e+00 -1.94246053e+36 0.00000000e+00 7.28422700e+35 0.00000000e+00 -1.04060386e+35 0.00000000e+00 2.36500877e+33 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 3.51843721e+13 0.00000000e+00 -1.74162642e+16 0.00000000e+00 3.93172164e+18 0.00000000e+00 -5.37335291e+20 0.00000000e+00 4.97706813e+22 0.00000000e+00 -3.31472737e+24 0.00000000e+00 1.64355232e+26 0.00000000e+00 -6.19854019e+27 0.00000000e+00 1.80145074e+29 0.00000000e+00 -4.06327223e+30 0.00000000e+00 7.13104277e+31 0.00000000e+00 -9.72414923e+32 0.00000000e+00 1.02508740e+34 0.00000000e+00 -8.27955206e+34 0.00000000e+00 5.05644072e+35 0.00000000e+00 -2.29225313e+36 0.00000000e+00 7.52145557e+36 0.00000000e+00 -1.72551040e+37 0.00000000e+00 2.63619644e+37 0.00000000e+00 -2.49744926e+37 0.00000000e+00 1.31116086e+37 0.00000000e+00 -3.12181157e+36 0.00000000e+00 2.12850789e+35 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 0.00000000e+00 7.03687442e+13 0.00000000e+00 -3.64158251e+16 0.00000000e+00 8.61234264e+18 0.00000000e+00 -1.23587117e+21 0.00000000e+00 1.20497439e+23 0.00000000e+00 -8.47096996e+24 0.00000000e+00 4.44725923e+26 0.00000000e+00 -1.78208030e+28 0.00000000e+00 5.52444895e+29 0.00000000e+00 -1.33507516e+31 0.00000000e+00 2.52329206e+32 0.00000000e+00 -3.72759054e+33 0.00000000e+00 4.28672912e+34 0.00000000e+00 -3.80859395e+35 0.00000000e+00 2.58440304e+36 0.00000000e+00 -1.31804555e+37 0.00000000e+00 4.94267080e+37 0.00000000e+00 -1.32289130e+38 0.00000000e+00 2.42530072e+38 0.00000000e+00 -2.87206665e+38 0.00000000e+00 2.01044665e+38 0.00000000e+00 -7.18016662e+37 0.00000000e+00 9.79113629e+36 0.00000000e+00 -2.12850789e+35 + 0.00000000e+00 0.00000000e+00 0.00000000e+00 1.40737488e+14 0.00000000e+00 -7.60686125e+16 0.00000000e+00 1.88269816e+19 0.00000000e+00 -2.83346073e+21 0.00000000e+00 2.90429725e+23 0.00000000e+00 -2.15208426e+25 0.00000000e+00 1.19440676e+27 0.00000000e+00 -5.07622875e+28 0.00000000e+00 1.67515549e+30 0.00000000e+00 -4.32748501e+31 0.00000000e+00 8.78479456e+32 0.00000000e+00 -1.40157404e+34 0.00000000e+00 1.75196755e+35 0.00000000e+00 -1.70479920e+36 0.00000000e+00 1.27859940e+37 0.00000000e+00 -7.28801656e+37 0.00000000e+00 3.09740704e+38 0.00000000e+00 -9.56552173e+38 0.00000000e+00 2.07252971e+39 0.00000000e+00 -2.99971405e+39 0.00000000e+00 2.69974265e+39 0.00000000e+00 -1.34987132e+39 0.00000000e+00 3.06788937e+38 0.00000000e+00 -2.00079742e+37 0.00000000e+00 + 0.00000000e+00 0.00000000e+00 2.81474977e+14 0.00000000e+00 -1.58751887e+17 0.00000000e+00 4.10770507e+19 0.00000000e+00 -6.47648166e+21 0.00000000e+00 6.97031339e+23 0.00000000e+00 -5.43684445e+25 0.00000000e+00 3.18508470e+27 0.00000000e+00 -1.43328812e+29 0.00000000e+00 5.02546646e+30 0.00000000e+00 -1.38479520e+32 0.00000000e+00 3.01192956e+33 0.00000000e+00 -5.17504262e+34 0.00000000e+00 7.00787021e+35 0.00000000e+00 -7.43912376e+36 0.00000000e+00 6.13727710e+37 0.00000000e+00 -3.88694216e+38 0.00000000e+00 1.85844422e+39 0.00000000e+00 -6.55921490e+39 0.00000000e+00 1.65802377e+40 0.00000000e+00 -2.87972549e+40 0.00000000e+00 3.23969118e+40 0.00000000e+00 -2.15979412e+40 0.00000000e+00 7.36293449e+39 0.00000000e+00 -9.60382760e+38 0.00000000e+00 2.00079742e+37 + 0.00000000e+00 5.62949953e+14 0.00000000e+00 -3.31014573e+17 0.00000000e+00 8.94566882e+19 0.00000000e+00 -1.47603536e+22 0.00000000e+00 1.66607491e+24 0.00000000e+00 -1.36618142e+26 0.00000000e+00 8.43617030e+27 0.00000000e+00 -4.01320673e+29 0.00000000e+00 1.49241125e+31 0.00000000e+00 -4.37773967e+32 0.00000000e+00 1.01782447e+34 0.00000000e+00 -1.87834880e+35 0.00000000e+00 2.74708512e+36 0.00000000e+00 -3.16971360e+37 0.00000000e+00 2.86406265e+38 0.00000000e+00 -2.00484385e+39 0.00000000e+00 1.07133843e+40 0.00000000e+00 -4.28535374e+40 0.00000000e+00 1.24989484e+41 0.00000000e+00 -2.56557362e+41 0.00000000e+00 3.52766373e+41 0.00000000e+00 -3.02371176e+41 0.00000000e+00 1.44313516e+41 0.00000000e+00 -3.13725035e+40 0.00000000e+00 1.96078147e+39 0.00000000e+00 + 1.12589991e+15 0.00000000e+00 -6.89613693e+17 0.00000000e+00 1.94471061e+20 0.00000000e+00 -3.35462581e+22 0.00000000e+00 3.96684502e+24 0.00000000e+00 -3.41545356e+26 0.00000000e+00 2.22004482e+28 0.00000000e+00 -1.11477965e+30 0.00000000e+00 4.38944486e+31 0.00000000e+00 -1.36804365e+33 0.00000000e+00 3.39274825e+34 0.00000000e+00 -6.70838858e+35 0.00000000e+00 1.05657120e+37 0.00000000e+00 -1.32071400e+38 0.00000000e+00 1.30184666e+39 0.00000000e+00 -1.00242193e+40 0.00000000e+00 5.95188019e+40 0.00000000e+00 -2.67834609e+41 0.00000000e+00 8.92782029e+41 0.00000000e+00 -2.13797802e+42 0.00000000e+00 3.52766373e+42 0.00000000e+00 -3.77963971e+42 0.00000000e+00 2.40522527e+42 0.00000000e+00 -7.84312587e+41 0.00000000e+00 9.80390734e+40 0.00000000e+00 -1.96078147e+39]; + + + h_prev=[0 1]; + h_now=[2 0]; + + if order == 0 + h=h_prev; + else + h=h_now; + end + + if ( order >= 1 && order <= 50) + h = H(order,51-order:end); + end + + h_prev = H(49,2:end); + h_now = H(50,1:end); + + if ( order > 50 ) + for ord=51:order + x=[];y=[]; + if (length(h_now) < (1+ord)) + x=0; + end; + y=zeros(1,(1+ord)-length(h_prev)); + h=[2*h_now, x] -[y, 2*(ord-1)*h_prev]; + h_prev=h_now; + h_now=h; + end + end + + if nargin == 2 + h = polyval(h,val); + end +endfunction diff --git a/octave_packages/miscellaneous-1.1.0/hilbert_curve.m b/octave_packages/miscellaneous-1.1.0/hilbert_curve.m new file mode 100644 index 0000000..b2133bd --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/hilbert_curve.m @@ -0,0 +1,88 @@ +## Copyright (C) 2009 Javier Enciso +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function file} {@var{x}, @var{y}} hilbert_curve (@var{n}) +## Creates an iteration of the Hilbert space-filling curve with @var{n} points. +## The argument @var{n} must be of the form @code{2^M}, where @var{m} is an +## integer greater than 0. +## +## @example +## n = 8 +## [x ,y] = hilbert_curve (n); +## line (x, y, "linewidth", 4, "color", "blue"); +## @end example +## +## @end deftypefn + +function [x, y] = hilbert_curve (n) + + if (nargin != 1) + print_usage (); + endif + + check_power_of_two (n); + if (n == 2) + x = [0, 0, 1, 1]; + y = [0, 1, 1, 0]; + else + [x1, y1] = hilbert_curve (n/2); + x = [y1, x1, n/2 + x1, n - 1 - y1]; + y = [x1, n/2 + y1, n/2 + y1, n/2 - 1 - x1]; + endif + +endfunction + +function check_power_of_two (n) + if (frac_part (log (n) / log (2)) != 0) + error ("hilbert_curve: input argument must be a power of 2.") + endif +endfunction + +function d = frac_part (f) + d = f - floor (f); +endfunction + +%!test +%! n = 2; +%! expect = [0, 0, 1, 1; 0, 1, 1, 0]; +%! [get(1,:), get(2,:)] = hilbert_curve (n); +%! if (any(size (expect) != size (get))) +%! error ("wrong size: expected %d,%d but got %d,%d", size (expect), size (get)); +%! elseif (any (any (expect!=get))) +%! error ("didn't get what was expected."); +%! endif + +%!test +%! n = 5; +%!error hilbert_curve (n); + +%!demo +%! clf +%! n = 4; +%! [x, y] = hilbert_curve (n); +%! line (x, y, "linewidth", 4, "color", "blue"); +%! % ----------------------------------------------------------------------- +%! % the figure window shows an iteration of the Hilbert space-fillig curve +%! % with 4 points on each axis. + +%!demo +%! clf +%! n = 64; +%! [x, y] = hilbert_curve (n); +%! line (x, y, "linewidth", 2, "color", "blue"); +%! % ---------------------------------------------------------------------- +%! % the figure window shows an iteration of the Hilbert space-fillig curve +%! % with 64 points on each axis. diff --git a/octave_packages/miscellaneous-1.1.0/infoskeleton.m b/octave_packages/miscellaneous-1.1.0/infoskeleton.m new file mode 100644 index 0000000..6b217d6 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/infoskeleton.m @@ -0,0 +1,129 @@ +## Copyright (C) 2008 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +##-*- texinfo -*- +## @deftypefn{Function File} infoskeleton(@var{prototype}, @var{index_str}, @var{see_also}) +## Generate TeXinfo skeleton documentation of @var{prototype}. +## +## Optionally @var{index_str} and @var{see_also} can be specified. +## +## Usage of this function is typically, +## @example +## infoskeleton('[V,Q] = eig( A )','linear algebra','eigs, chol, qr, det') +## @end example +## @seealso{info} +## @end deftypefn + +function infoskeleton( prototype , index_str, seealso) + + ## FIXME: add placeholders for math TeX code, examples etc. + + if nargin < 1 + print_usage(); + end + + if nargin < 2 + index_str = ""; + end + + if nargin < 3 + seealso = ""; + end + + ## + ## try to parse the function prototype + ## as: + ## function retval = fname ( arg1, arg2, etc )" + ## + prototype = strtrim( prototype ); + idx = strfind( prototype, "function" ); + if ( !isempty( idx ) ) + prototype(idx:idx+7) = ""; + end + + idx = strfind( prototype, "=" ); + retval = ""; + if( !isempty( idx ) ) + retval = strtrim ( prototype( 1 : idx(1)-1 ) ); + prototype = prototype ( idx(1) + 1: end ); + end + + + idx = strfind( prototype, "(" ); + fname = prototype; + if( !isempty( idx ) ) + fname = strtrim( prototype(1:idx(1)-1) ); + prototype = prototype(idx(1) + 1:end); + end + + ## next time, use strtok() very easy & simple + + pos = 0; args = {}; + idx = strfind( prototype , "," ); + if ( !isempty( idx ) ) + prev = [ 0, idx ]; + for pos=1:length( idx ) + args{ pos } = strtrim ( prototype(prev( pos )+1 :idx(pos)-1) ); + end + prototype = prototype(idx(end) + 1:end); + end + + idx = strfind( prototype, ")" ); + if ( !isempty( idx ) ) + lvar = strtrim ( prototype(1:idx(1)-1) ); + if ( length( lvar ) > 0 ) + args{ pos + 1 } = lvar; + end + end + + + ## generate the code + fprintf("## -*- texinfo -*-\n") + if ( length( retval ) > 0 ) + fprintf("## @deftypefn{Function File} {@var{%s} = } %s (", ... + retval,fname ); + else + fprintf("## @deftypefn{Function File} { } %s (", ... + fname ); + end + + pos = 0; + for pos = 1:length(args)-1 + fprintf(" %s,", args{pos} ); + end + if ( length(args) > 0 ) + fprintf(" %s ) \n", args{pos+1} ); + end + fprintf("## @cindex %s \n",index_str); + fprintf("## The function %s calculates where",fname ); + pos = 0; + for pos = 1:length(args)-1 + fprintf(" @var{%s} is ,", args{pos} ); + end + if ( length(args) > 0 ) + fprintf(" @var{%s} is .\n", args{pos+1} ); + end + + fprintf("## @example\n"); + fprintf("## \n"); + fprintf("## @end example\n"); + + fprintf("## @seealso{%s}\n",seealso); + fprintf("## @end deftypefn\n"); +end + +%!demo infoskeleton( ' [x,y,z]=infoskeleton(func , z , z9 , jj, fjh, x) ') +%!demo infoskeleton('[V,Q] = eig( A )','linear algebra','eigs, chol, qr, det') +%!demo infoskeleton( 'function [x,y,z] = indian_languages ( x) ') diff --git a/octave_packages/miscellaneous-1.1.0/laguerrepoly.m b/octave_packages/miscellaneous-1.1.0/laguerrepoly.m new file mode 100644 index 0000000..af92046 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/laguerrepoly.m @@ -0,0 +1,63 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{coefs}=} laguerrepoly (@var{order},@var{x}) +## +## Compute the coefficients of the Laguerre polynomial, given the +## @var{order}. We calculate the Laguerre polynomial using the recurrence +## relations, Ln+1(x) = inv(n+1)*((2n+1-x)Ln(x) - nLn-1(x)). +## +## If the value @var{x} is specified, the polynomial is also evaluated, +## otherwise just the return the coefficients of the polynomial are returned. +## +## This is NOT the generalized Laguerre polynomial. +## +## @end deftypefn + +function h = laguerrepoly (order, val) + if (nargin < 1 || nargin > 2) + print_usage + endif + + h_prev=[0 1]; + h_now=[-1 1]; + + if order == 0 + h=h_prev; + else + h=h_now; + endif + + for ord=2:order + x=[]; + y=[]; + if (length(h_now) < (1+ord)) + x=0; + endif + y=zeros(1,(1+ord)-length(h_prev)); + p1=[h_now, x]; + p2=[x, h_now]; + p3=[y, h_prev]; + h=((2*ord -1).*p2 -p1 -(ord -1).*p3)./(ord); + h_prev=h_now; + h_now=h; + endfor + + if nargin == 2 + h=polyval(h,val); + endif + +endfunction diff --git a/octave_packages/miscellaneous-1.1.0/lauchli.m b/octave_packages/miscellaneous-1.1.0/lauchli.m new file mode 100644 index 0000000..3f65737 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/lauchli.m @@ -0,0 +1,32 @@ +## -*- texinfo -*- +## @deftypefn {Function File} {@var{a}} = lauchli (@var{n}) +## @deftypefnx {Function File} {@var{a}} = lauchli (@var{n},@var{mu}) +## Creates the matrix [ ones(1,@var{n}); @var{mu}*eye(@var{n}) ] +## The value @var{mu} defaults to sqrt(eps). +## This is an ill-conditioned system for testing the +## accuracy of the QR routine. +## +## @example +## @group +## A = lauchli(15); +## [Q, R] = qr(A); +## norm(Q*R - A) +## norm(Q'*Q - eye(rows(Q))) +## @end group +## @end example +## @end deftypefn +## @seealso {ones,zeros,eye} + +## This program is in the public domain +## Author: Paul Kienzle + +function A = lauchli(n,mu) + if (nargin < 1 || nargin > 2) + usage("A = lauchli(n [, mu])"); + endif + + if (nargin < 2), mu = sqrt(eps); endif + + A = [ ones(1,n); mu*eye(n) ]; + +endfunction diff --git a/octave_packages/miscellaneous-1.1.0/legendrepoly.m b/octave_packages/miscellaneous-1.1.0/legendrepoly.m new file mode 100644 index 0000000..385d87c --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/legendrepoly.m @@ -0,0 +1,62 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{coefs}=} legendrepoly (@var{order},@var{x}) +## +## Compute the coefficients of the Legendre polynomial, given the +## @var{order}. We calculate the Legendre polynomial using the recurrence +## relations, Pn+1(x) = inv(n+1)*((2n+1)*x*Pn(x) - nPn-1(x)). +## +## If the value @var{x} is specified, the polynomial is also evaluated, +## otherwise just the return the coefficients of the polynomial are returned. +## +## This is NOT the generalized Legendre polynomial. +## +## @end deftypefn + +function h = legendrepoly (order, val) + if (nargin < 1 || nargin > 2) + print_usage + endif + + h_prev = [0 1]; + h_now = [1 0]; + + if order == 0 + h=h_prev; + else + h=h_now; + endif + + for ord=2:order + x=[]; + y=[]; + if (length(h_now) < (1+ord)) + x=0; + endif + y=zeros(1,(1+ord)-length(h_prev)); + p1=[h_now, x]; + p3=[y, h_prev]; + h=((2*ord -1).*p1 -(ord -1).*p3)./(ord); + h_prev=h_now; + h_now=h; + endfor + + if nargin == 2 + h=polyval(h,val); + endif + +endfunction diff --git a/octave_packages/miscellaneous-1.1.0/map.m b/octave_packages/miscellaneous-1.1.0/map.m new file mode 100644 index 0000000..3d1517f --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/map.m @@ -0,0 +1,96 @@ +## Copyright (C) 2003 Tomer Altman +## Copyright (C) 2007 Muthiah Annamalai +## Copyright (C) 2012 Carnë Draug +## Copyright (C) 2012 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR 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{result} =} map (@var{function}, @var{iterable}, @dots{}) +## Apply @var{function} to every item of @var{iterable} and return the results. +## +## @code{map}, like Lisp's ( & numerous other language's ) function for +## iterating the result of a function applied to each of the data +## structure's elements in turn. The results are stored in the +## corresponding input's place. For now, just will work with cells and +## matrices, but support for structs are intended for future versions. +## Also, only "prefix" functions ( like @code{min (a, b, c, ...)} ) are +## supported. FUN_HANDLE can either be a function name string or a +## function handle (recommended). +## +## Example: +## @example +## +## octave> A +## A +## @{ +## [1,1] = 0.0096243 +## [2,1] = 0.82781 +## [1,2] = 0.052571 +## [2,2] = 0.84645 +## @} +## octave> B +## B = +## @{ +## [1,1] = 0.75563 +## [2,1] = 0.84858 +## [1,2] = 0.16765 +## [2,2] = 0.85477 +## @} +## octave> map(@@min,A,B) +## ans = +## @{ +## [1,1] = 0.0096243 +## [2,1] = 0.82781 +## [1,2] = 0.052571 +## [2,2] = 0.84645 +## @} +## @end example +## @seealso{reduce, match} +## @end deftypefn + +function return_type = map (fun_handle, data_struct, varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "map has been deprecated, and will be removed in the future. Use `arrayfun' or `cellfun' instead."); + endif + + if (nargin < 2) + print_usage; + elseif (!(isnumeric (data_struct) || iscell (data_struct))) + error ("second argument must be either a matrix or a cell object"); + endif + + if (isa (fun_handle, "function_handle")) + ##do nothing + elseif (ischar (fun_handle)) + fun_handle = str2func (fun_handle); + else + error ("fun_handle must either be a function handle or the name of a function"); + endif + + if (iscell (data_struct)) + return_type = cellfun (fun_handle, data_struct,varargin{:}); + else + return_type = arrayfun (fun_handle, data_struct,varargin{:}); + endif + +endfunction + +%!assert(map(@min,[1 2 3 4 5],[5 4 3 2 1]), [1 2 3 2 1]) +%!assert(map(@min,rand(1,5),[0 0 0 0 0]), [0 0 0 0 0]) +%!assert(map(@(x,y) (sin(x).^2 + cos(y).^2),-pi:0.5:+pi,-pi:0.5:+pi),ones(1,13)) diff --git a/octave_packages/miscellaneous-1.1.0/match.m b/octave_packages/miscellaneous-1.1.0/match.m new file mode 100644 index 0000000..fbfc571 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/match.m @@ -0,0 +1,75 @@ +## Copyright (C) 2007 Muthiah Annamalai +## Copyright (C) 2012 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{result} = {} match ( @var{fun_handle}, @var{iterable} ) +## match is filter, like Lisp's ( & numerous other language's ) function for +## Python has a built-in filter function which takes two arguments, +## a function and a list, and returns a list. 'match' performs the same +## operation like filter in Python. The match applies the +## function to each of the element in the @var{iterable} and collects +## that the result of a function applied to each of the data structure's +## elements in turn, and the return values are collected as a list of +## input arguments, whenever the function-result is 'true' in Octave +## sense. Anything (1,true,?) evaluating to true, the argument is +## saved into the return value. +## +## @var{fun_handle} can either be a function name string or a +## function handle (recommended). +## +## Typically you can use it as, +## @example +## match(@@(x) ( x >= 1 ), [-1 0 1 2]) +## @result{} 1 2 +## @end example +## @seealso{reduce, cellfun, arrayfun, cellfun, structfun, spfun} +## @end deftypefn + +function rval = match (fun_handle, data) + + if (nargin != 2) + print_usage; + endif + + if (isa (fun_handle, "function_handle")) + ##do nothing + elseif (ischar (fun_handle)) + fun_handle = str2func (fun_handle); + else + error ("fun_handle must either be a function handle or the name of a function"); + endif + + LD = length(data); + + if (iscell (data)) + rval = {}; + for idx=1:LD + if fun_handle(data{idx}), rval = [rval, data{idx}]; endif + endfor + elseif (ismatrix (data)) + rval = []; + for idx=1:LD + if fun_handle(data(idx)), rval = [rval, data(idx)]; endif + endfor + else + error("data must either be a cell array or matrix"); + endif +endfunction + +%!assert(match(@(x) mod(x,2),1:10),[1:2:10],0) +%!assert(match(@sin,1:10),[1:10],0) +%!assert(match(@(x) strcmp('Octave',x),{'Matlab','Octave'}),{'Octave'},0) +%!assert(match(@(x) (x>0), [-10:+10]),[1:10],0) diff --git a/octave_packages/miscellaneous-1.1.0/normc.m b/octave_packages/miscellaneous-1.1.0/normc.m new file mode 100644 index 0000000..931a496 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/normc.m @@ -0,0 +1,61 @@ +## Copyright (C) 2011 Thomas Weber +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} normc (@var{M}) +## Normalize the columns of a matrix to a length of 1 and return the matrix. +## +## @example +## M=[1,2; 3,4]; +## normc(M) +## +## ans = +## +## 0.31623 0.44721 +## 0.94868 0.89443 +## +## @end example +## @seealso{normr} +## @end deftypefn + +function X = normc(M) + if (1 != nargin) + print_usage; + endif + + X = normr(M.').'; +endfunction + +%% test for real and complex matrices +%!test +%! M = [1,2; 3,4]; +%! expected = [0.316227766016838, 0.447213595499958; +%! 0.948683298050514, 0.894427190999916]; +%! assert(normc(M), expected, eps); + +%!test +%! M = [i,2*i; 3*I,4*I]; +%! expected = [0.316227766016838*I, 0.447213595499958*I; +%! 0.948683298050514*I, 0.894427190999916*I]; +%! assert(normc(M), expected, eps); + +%!test +%! M = [1+2*I, 3+4*I; 5+6*I, 7+8*I]; +%! expected = [0.123091490979333 + 0.246182981958665i, 0.255376959227625 + 0.340502612303499i; +%! 0.615457454896664 + 0.738548945875996i, 0.595879571531124 + 0.681005224606999i]; +%! assert(normc(M), expected, 10*eps); + +%% test error/usage handling +%!error normc(); diff --git a/octave_packages/miscellaneous-1.1.0/normr.m b/octave_packages/miscellaneous-1.1.0/normr.m new file mode 100644 index 0000000..7eee7a4 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/normr.m @@ -0,0 +1,60 @@ +## Copyright (C) 2011 Thomas Weber +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} = } normr (@var{M}) +## Normalize the rows of a matrix to a length of 1 and return the matrix. +## +## @example +## M=[1,2; 3,4]; +## normr(M) +## +## ans = +## +## 0.44721 0.89443 +## 0.60000 0.80000 +## +## @end example +## @seealso{normc} +## @end deftypefn + +function X = normr(M) + if (1 != nargin) + print_usage; + endif + + norm = sqrt(sum(M .* conj(M),2)); + X = diag(1./norm) * M; +endfunction + +%% test for real and complex matrices +%!test +%! M = [1,2; 3,4]; +%! expected = [0.447213595499958, 0.894427190999916; 0.6, 0.8]; +%! assert(normr(M), expected, eps); + +%!test +%! M = [i,2*i; 3*I,4*I]; +%! expected = [0.447213595499958*I, 0.894427190999916*I; 0.6*I, 0.8*I]; +%! assert(normr(M), expected, eps); + +%!test +%! M = [1+2*I, 3+4*I; 5+6*I, 7+8*I]; +%! expected = [0.182574185835055 + 0.365148371670111i, 0.547722557505166 + 0.730296743340221i +%! 0.379049021789452 + 0.454858826147342i, 0.530668630505232 + 0.606478434863123i]; +%! assert(normr(M), expected, 10*eps); + +%% test error/usage handling +%!error normr(); diff --git a/octave_packages/miscellaneous-1.1.0/nze.m b/octave_packages/miscellaneous-1.1.0/nze.m new file mode 100644 index 0000000..ba3df12 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/nze.m @@ -0,0 +1,31 @@ +## Copyright (C) 2010 VZLU Prague +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{y}, @var{f}] = } nze (@var{x}) +## Extract nonzero elements of @var{x}. Equivalent to @code{@var{x}(@var{x} != 0)}. +## Optionally, returns also linear indices. +## @end deftypefn + +## Author: Etienne Grossmann +## Author: Jaroslav Hajek + +function [y, f] = nze (x) + nz = x != 0; + y = x(nz); + if (nargout > 1) + f = find (nz); + endif +endfunction diff --git a/octave_packages/miscellaneous-1.1.0/packinfo/DESCRIPTION b/octave_packages/miscellaneous-1.1.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..96513e8 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/packinfo/DESCRIPTION @@ -0,0 +1,14 @@ +Name: Miscellaneous +Version: 1.1.0 +Date: 2012-03-24 +Author: various authors +Maintainer: Octave-Forge community +Title: Miscellaneous functions +Description: Miscellaneous tools that don't fit somewhere else. +Categories: Miscellaneous +Depends: octave (>= 3.6.0) +Autoload: no +SystemRequirements: units +BuildRequires: termcap-devel [Debian] libncurses5-dev +License: GPLv3+ +Url: http://octave.sf.net diff --git a/octave_packages/miscellaneous-1.1.0/packinfo/INDEX b/octave_packages/miscellaneous-1.1.0/packinfo/INDEX new file mode 100644 index 0000000..5e4f115 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/packinfo/INDEX @@ -0,0 +1,35 @@ +miscellaneous >> Miscellaneous functions +miscellaneous + apply + asci + cell2cell + chebyshevpoly + clip + colorboard + csv2latex + gameoflife + hermitepoly + hilbert_curve + infoskeleton + laguerrepoly + legendrepoly + map + match + normc + normr + nze + partarray + peano_curve + publish + read_options + reduce + rolldices + sample + slurp_file + solvesudoku + temp_name + text_waitbar + units + zagzig + z_curve + zigzag diff --git a/octave_packages/miscellaneous-1.1.0/packinfo/NEWS b/octave_packages/miscellaneous-1.1.0/packinfo/NEWS new file mode 100644 index 0000000..5027933 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/packinfo/NEWS @@ -0,0 +1,46 @@ +Summary of important user-visible changes for miscellaneous 1.1.0: +------------------------------------------------------------------- + + ** IMPORTANT NOTE: + * the function `waitbar' has been renamed `text_waitbar'. Octave core has + implemented a Matlab compatible `waitbar' which is imcompatible with the + old miscellaneous `waitbar'. If you use the `waitbar' function from the + miscellaneous package you have 3 options: + 1. replace all `waitbar' calls by `text_waitbar'; + 2. fix your `waitbar' calls for the new API as per octave core. Note + that `waitbar' is graphical tool only; + 3. use an old version of the miscellaneous package or modify the source + to keep shadowing the octave core `waitbar'. + + ** The following functions are new: + + clip normr text_waitbar + normc sample + + ** The following functions have been moved to the IO package: + + cell2csv csvconcat xmlread + csv2cell csvexplode xmlwrite + + ** The function `clip' was imported from the audio package. + + ** The functions `apply' and `map' have been deprecated. `cellfun' and + `arrayfun' from octave core should be used instead. + + ** The function `partarray' has been deprecated. `mat2cell' from octave core + should be used instead. + + ** The function `temp_name' has been deprecated. `tmpnam' from octave core + should be used instead. + + ** Multiple bug fixes and increased input check on many functions. + + ** Package is no longer automatically loaded. + + ** improvements to help text. + + ** The function `csv2latex' has been made silent and had bugs fixed. + + ** The function `publish' had bugs fixed. + + ** The function `match' can now accept cell arrays as input. diff --git a/octave_packages/miscellaneous-1.1.0/peano_curve.m b/octave_packages/miscellaneous-1.1.0/peano_curve.m new file mode 100644 index 0000000..e48a9b8 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/peano_curve.m @@ -0,0 +1,99 @@ +## Copyright (C) 2009 Javier Enciso +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function file} {@var{x}, @var{y}} peano_curve (@var{n}) +## Creates an iteration of the Peano space-filling curve with @var{n} points. +## The argument @var{n} must be of the form @code{3^M}, where @var{m} is an +## integer greater than 0. +## +## @example +## n = 9; +## [x, y] = peano_curve (n); +## line (x, y, "linewidth", 4, "color", "red"); +## @end example +## +## @end deftypefn + +function [x, y] = peano_curve (n) + + if (nargin != 1) + print_usage (); + endif + + check_power_of_three (n); + if (n == 3) + x = [0, 0, 0, 1, 1, 1, 2, 2, 2]; + y = [0, 1, 2, 2, 1, 0, 0, 1, 2]; + else + [x1, y1] = peano_curve (n/3); + x2 = n/3 - 1 - x1; + x3 = n/3 + x1; + x4 = n - n/3 - 1 - x1; + x5 = n - n/3 + x1; + x6 = n - 1 - x1; + y2 = n/3 + y1; + y3 = n - n/3 + y1; + y4 = n - 1 - y1; + y5 = n - n/3 - 1 - y1; + y6 = n/3 - 1 - y1; + x = [x1, x2, x1, x3, x4, x3, x5, x6, x5]; + y = [y1, y2, y3, y4, y5, y6, y1, y2, y3]; + endif + +endfunction + +function check_power_of_three (n) + if (frac_part (log (n) / log (3)) != 0) + error ("peano_curve: input argument must be a power of 3.") + endif +endfunction + +function d = frac_part (f) + d = f - floor (f); +endfunction + +%!test +%! n = 3; +%! expect(1,:) = [0, 0, 0, 1, 1, 1, 2, 2, 2]; +%! expect(2,:) = [0, 1, 2, 2, 1, 0, 0, 1, 2]; +%! [get(1,:), get(2,:)] = peano_curve (n); +%! if (any(size (expect) != size (get))) +%! error ("wrong size: expected %d,%d but got %d,%d", size (expect), size (get)); +%! elseif (any (any (expect!=get))) +%! error ("didn't get what was expected."); +%! endif + +%!test +%! n = 5; +%!error peano_curve (n); + +%!demo +%! clf +%! n = 9; +%! [x, y] = peano_curve (n); +%! line (x, y, "linewidth", 4, "color", "red"); +%! % -------------------------------------------------------------------- +%! % the figure window shows an iteration of the Peano space-fillig curve +%! % with 9 points on each axis. + +%!demo +%! clf +%! n = 81; +%! [x, y] = peano_curve (n); +%! line (x, y, "linewidth", 2, "color", "red"); +%! % -------------------------------------------------------------------- +%! % the figure window shows an iteration of the Peano space-fillig curve +%! % with 81 points on each axis. diff --git a/octave_packages/miscellaneous-1.1.0/publish.m b/octave_packages/miscellaneous-1.1.0/publish.m new file mode 100644 index 0000000..88a0050 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/publish.m @@ -0,0 +1,335 @@ +## Copyright (C) 2010 Fotios Kasolis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} publish (@var{filename}) +## @deftypefnx {Function File} {} publish (@var{filename}, @var{options}) +## Produces latex reports from scripts. +## +## @example +## publish (@var{my_script}) +## @end example +## +## @noindent +## where the argument is a string that contains the file name of +## the script we want to report. +## +## If two arguments are given, they are interpreted as follows. +## +## @example +## publish (@var{filename}, [@var{option}, @var{value}, ...]) +## @end example +## +## @noindent +## The following options are available: +## +## @itemize @bullet +## @item format +## +## the only available format values are the strings `latex' and +## `html'. +## +## @item +## imageFormat: +## +## string that specifies the image format, valid formats are `pdf', +## `png', and `jpg'(or `jpeg'). +## +## @item +## showCode: +## +## boolean value that specifies if the source code will be included +## in the report. +## +## @item +## evalCode: +## +## boolean value that specifies if execution results will be included +## in the report. +## +## @end itemize +## +## Default @var{options} +## +## @itemize @bullet +## @item format = latex +## +## @item imageFormat = pdf +## +## @item showCode = 1 +## +## @item evalCode = 1 +## +## @end itemize +## +## Remarks +## +## @itemize @bullet +## @item Any additional non-valid field is removed without +## notification. +## +## @item To include several figures in the resulting report you must +## use figure with a unique number for each one of them. +## +## @item You do not have to save the figures manually, publish will +## do it for you. +## +## @item The functions works only for the current path and no way ... +## to specify other path is allowed. +## +## @end itemize +## +## Assume you have the script `myscript.m' which looks like +## +## @example +## @group +## x = 0:0.1:pi; +## y = sin(x) +## figure(1) +## plot(x,y); +## figure(2) +## plot(x,y.^2); +## @end group +## @end example +## +## You can then call publish with default @var{options} +## +## @example +## publish("myscript") +## @end example +## @end deftypefn + +function publish (file_name, varargin) + + if ((nargin < 1) || (rem (numel (varargin), 2) != 0)) + print_usage (); + endif + + if (!strcmp (file_name(end-1:end), ".m")) + ifile = strcat (file_name, ".m"); + ofile = strcat (file_name, ".tex"); + else + ifile = file_name; + ofile = strcat (file_name(1:end-1), "tex"); + endif + + if (exist (ifile, "file") != 2) + error ("File %s does not exist.", ifile); + endif + + options = set_default (struct ()); + options = read_options (varargin, "op1", "format imageFormat showCode evalCode", "default", options); + + if (strcmpi (options.format, "latex")) + create_latex (ifile, ofile, options); + elseif strcmpi(options.format, "html") + create_html (ifile, options); + endif + +endfunction + +function def_options = set_default (options); + + if (!isfield (options, "format")) + def_options.format = "latex"; + elseif (!ischar (options.format)) + error("Option format must be a string."); + else + valid_formats={"latex", "html"}; + validity_test = strcmpi (valid_formats, options.format); + if (isempty (find (validity_test))) + error ("The supplied format is not currently supported."); + else + def_options.format = options.format; + endif + endif + + if (! isfield (options, "imageFormat")) + def_options.imageFormat = "pdf"; + elseif (! ischar(options.imageFormat)) + error("Option imageFormat must be a string."); + else + valid_formats = {"pdf", "png", "jpg", "jpeg"}; + validity_test = strcmpi (valid_formats, options.imageFormat); + if (isempty (find (validity_test))) + error ("The supplied image format is not available."); + else + def_options.imageFormat = options.imageFormat; + endif + endif + + if (!isfield (options,"showCode")) + def_options.showCode = true; + elseif (!isbool (options.showCode)) + error ("Option showCode must be a boolean."); + else + def_options.showCode = options.showCode; + endif + + if (!isfield (options,"evalCode")) + def_options.evalCode = true; + elseif (!isbool (options.evalCode)) + error ("Option evalCode must be a boolean."); + else + def_options.evalCode = options.evalCode; + endif +endfunction + +function create_html (ifile, options) + + ofile = strcat (ifile(1:end-1), "html"); + html_start = "\n\n"; + html_end = "\n\n"; + + if options.showCode + section1_title = "

Source code

\n"; + fid = fopen (ifile, "r"); + source_code = fread (fid, "*char")'; + fclose(fid); + else + section1_title = ""; + source_code = ""; + endif + + if options.evalCode + section2_title = "

Execution results

\n"; + oct_command = strcat ("octave> ", ifile(1:end-2), "\n"); + script_result = exec_script (ifile); + else + section2_title = ""; + oct_command = ""; + script_result = ""; + endif + + [section3_title, disp_fig] = exec_print (ifile, options); + + final_document = strcat (html_start, section1_title, "\n", source_code,"\n",... + "\n", section2_title, oct_command, script_result,... + "", section3_title, disp_fig, html_end); + + + fid = fopen (ofile, "w"); + fputs (fid, final_document); + fclose (fid); + +endfunction + +function create_latex (ifile, ofile, options) + latex_preamble = "\ +\\documentclass[a4paper,12pt]{article}\n\ +\\usepackage{listings}\n\ +\\usepackage{graphicx}\n\ +\\usepackage{color}\n\ +\\usepackage[T1]{fontenc}\n\ +\\definecolor{lightgray}{rgb}{0.9,0.9,0.9}\n"; + + listing_source_option = "\ +\\lstset{\n\ +language = Octave,\n\ +basicstyle =\\footnotesize,\n\ +numbers = left,\n\ +numberstyle = \\footnotesize,\n\ +backgroundcolor=\\color{lightgray},\n\ +frame=single,\n\ +tabsize=2,\n\ +breaklines=true}\n"; + + listing_exec_option = "\ +\\lstset{\n\ +language = Octave,\n\ +basicstyle =\\footnotesize,\n\ +numbers = none,\n\ +backgroundcolor=\\color{white},\n\ +frame=none,\n\ +tabsize=2,\n\ +breaklines=true}\n"; + + if options.showCode + section1_title = strcat ("\\section*{Source code: \\texttt{", ifile, "}}\n"); + source_code = strcat ("\\lstinputlisting{", ifile, "}\n"); + else + section1_title = ""; + source_code = ""; + endif + + if options.evalCode + section2_title = "\\section*{Execution results}\n"; + oct_command = strcat ("octave> ", ifile(1:end-2), "\n"); + script_result = exec_script (ifile); + else + section2_title = ""; + oct_command = ""; + script_result = ""; + endif + + [section3_title, disp_fig] = exec_print (ifile, options); + + final_document = strcat (latex_preamble, listing_source_option, + "\\begin{document}\n", + section1_title, source_code, + section2_title, listing_exec_option, + "\\begin{lstlisting}\n", + oct_command, script_result, + "\\end{lstlisting}\n", + section3_title, + "\\begin{center}\n", + disp_fig, + "\\end{center}\n", + "\\end{document}"); + + fid = fopen (ofile, "w"); + fputs(fid, final_document); + fclose(fid); +endfunction + +function script_result = exec_script (ifile) + diary publish_tmp_script.txt + eval (ifile(1:end-2)) + diary off + fid = fopen ("publish_tmp_script.txt", 'r'); + script_result = fread (fid, '*char')'; + fclose(fid); + delete ("publish_tmp_script.txt"); +endfunction + +function [section3_title, disp_fig] = exec_print (ifile, options) + figures = findall (0, "type", "figure"); + section3_title = ""; + disp_fig = ""; + if (!isempty (figures)) + for nfig = 1:length (figures) + figure (figures(nfig)); + print (sprintf ("%s%d.%s", ifile(1:end-2), nfig, options.imageFormat), + sprintf ("-d%s", options.imageFormat), "-color"); + if (strcmpi (options.format, "html")); + section3_title = "

Generated graphics

\n"; + disp_fig = strcat (disp_fig, ""); + elseif (strcmpi (options.format, "latex")) + section3_title = "\\section*{Generated graphics}\n"; + disp_fig = strcat (disp_fig, "\\includegraphics[scale=0.6]{", ifile(1:end-2), + sprintf("%d",nfig), "}\n"); + endif + endfor + endif +endfunction + +# TODO +# * ADD VARARGIN FOR ADDITIONAL FILES SOURCES TO BE INLCUDED AS +# APPENDICES (THIS SOLVES THE PROBLEM OF FUNCTIONS SINCE YOU CAN +# PUT THE FUNCTION CALL IN SCRIPT CALL PUBLISH(SCRIPT) AND ADD +# THE FUNCTIONS CODE AS APPENDIX) +# +# * KNOWN PROBLEM: THE COMMENTING LINES IN HTML diff --git a/octave_packages/miscellaneous-1.1.0/read_options.m b/octave_packages/miscellaneous-1.1.0/read_options.m new file mode 100644 index 0000000..73a1f6b --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/read_options.m @@ -0,0 +1,199 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{[op,nread]} = } read_options ( args, varargin ) +## @cindex +## The function read_options parses arguments to a function as, +## [ops,nread] = read_options (args,...) - Read options +## +## The input being @var{args} a list of options and values. +## The options can be any of the following, +## +## 'op0' , string : Space-separated names of opt taking no argument <''> +## +## 'op1' , string : Space-separated names of opt taking one argument <''> +## +## 'extra' , string : Name of nameless trailing arguments. <''> +## +## 'default', struct : Struct holding default option values +## +## 'prefix' , int : If false, only accept whole opt names. Otherwise, <0> +## recognize opt from first chars, and choose +## shortest if many opts start alike. +## +## 'nocase' , int : If set, ignore case in option names <0> +## +## 'quiet' , int : Behavior when a non-string or unknown opt is met <0> +## 0 - Produce an error +## 1 - Return quietly (can be diagnosed by checking 'nread') +## +## 'skipnan', int : Ignore NaNs if there is a default value. +## Note : At least one of 'op0' or 'op1' should be specified. +## +## The output variables are, +## @var{ops} : struct : Struct whose key/values are option names/values +## @var{nread} : int : Number of elements of args that were read +## +## USAGE +## @example +## # Define options and defaults +## op0 = "is_man is_plane flies" +## default = struct ("is_man",1, "flies",0); +## +## # Read the options +## +## s = read_options (list (all_va_args), "op0",op0,"default",default) +## +## # Create variables w/ same name as options +## +## [is_man, is_plane, flies] = getfields (s,"is_man", "is_plane", "flies") +## pre 2.1.39 function [op,nread] = read_options (args, ...) +## @end example +## @end deftypefn + +function [op,nread] = read_options (args, varargin) ## pos 2.1.39 + + verbose = 0; + + op = struct (); # Empty struct + op0 = op1 = " "; + skipnan = prefix = quiet = nocase = quiet = 0; + extra = ""; + + + nargs = nargin-1; # nargin is now a function + if rem (nargs, 2), error ("odd number of optional args"); endif + + + i=1; + while i 1 # Ambiguous option name + + fullen = zeros (1,length (ii)); # Full length of each optio + tmp = correct = ""; + j = 0; + for i = ii + fullen(++j) = spi(find (spi > i,1))-i ; + tmp = [tmp,"', '",opts(i:i+fullen(j)-1)]; + endfor + tmp = tmp(5:length(tmp)); + + if sum (fullen == min (fullen)) > 1 || ... + ((min (fullen) != length(name)) && ! prefix) , + error ("ambiguous option '%s'. Could be '%s'",oname,tmp); + endif + j = find (fullen == min (fullen), 1); + ii = ii(j); + endif + + # Full name of option (w/ correct case) + + fullname = opts_orig(ii:spi(find (spi > ii, 1))-1); + if ii < iend + if verbose, printf ("read_options : found boolean '%s'\n",fullname); endif + op.(fullname) = 1; + else + if verbose, printf ("read_options : found '%s'\n",fullname); endif + if nread < length (args) + tmp = args{++nread}; + if verbose, printf ("read_options : size is %i x %i\n",size(tmp)); endif + if !isnumeric (tmp) || !all (isnan (tmp(:))) || ... + !isfield (op, fullname) + op.(fullname) = tmp; + else + if verbose, printf ("read_options : ignoring nan\n"); endif + endif + else + error ("options end before I can read value of option '%s'",oname); + endif + endif + endwhile +endfunction diff --git a/octave_packages/miscellaneous-1.1.0/reduce.m b/octave_packages/miscellaneous-1.1.0/reduce.m new file mode 100644 index 0000000..85e9077 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/reduce.m @@ -0,0 +1,72 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} reduce (@var{function}, @var{sequence},@var{initializer}) +## @deftypefnx {Function File} {@var{x} =} reduce (@var{function}, @var{sequence}) +## Implements the 'reduce' operator like in Lisp, or Python. +## Apply function of two arguments cumulatively to the items of sequence, +## from left to right, so as to reduce the sequence to a single value. For example, +## reduce(@@(x,y)(x+y), [1, 2, 3, 4, 5]) calculates ((((1+2)+3)+4)+5). +## The left argument, x, is the accumulated value and the right argument, y, is the +## update value from the sequence. If the optional initializer is present, it is +## placed before the items of the sequence in the calculation, and serves as +## a default when the sequence is empty. If initializer is not given and sequence +## contains only one item, the first item is returned. +## +## @example +## reduce(@@add,[1:10]) +## @result{} 55 +## reduce(@@(x,y)(x*y),[1:7]) +## @result{} 5040 (actually, 7!) +## @end example +## @end deftypefn + +## Parts of documentation copied from the "Python Library Reference, v2.5" + +function rv = reduce (func, lst, init) + if (nargin < 2) || nargin > 3 || (class(func)!='function_handle') || (nargin == 2 && length(lst)<2) + print_usage(); + end + + l=length(lst); + + if (l<2 && nargin==3) + if(l==0) + rv=init; + elseif (l==1) + rv=func(init,lst(1)); + end + return; + end + + if(nargin == 3) + rv=func(init,lst(1)); + start=2; + else + rv=func(lst(1),lst(2)); + start=3; + end + + for i=start:l + rv=func(rv,lst(i)); + end +end + +%!assert(reduce(@(x,y)(x+y),[],-1),-1) +%!assert(reduce(@(x,y)(x+y),[+1],-1),0) +%!assert(reduce(@(x,y)(x+y),[-10:-1]),-55) +%!assert(reduce(@(x,y)(x+y),[-10:-1],+55),0) +%!assert(reduce(@(x,y)(y*x),[1:4],5),120) diff --git a/octave_packages/miscellaneous-1.1.0/rolldices.m b/octave_packages/miscellaneous-1.1.0/rolldices.m new file mode 100644 index 0000000..bf54f5e --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/rolldices.m @@ -0,0 +1,81 @@ +## Copyright (C) 2009 Jaroslav Hajek +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} rolldices (@var{n}) +## @deftypefnx{Function File} rolldices (@var{n}, @var{nrep}, @var{delay}) +## Returns @var{n} random numbers from the 1:6 range, displaying a visual selection +## effect. +## +## @var{nrep} sets the number of rolls, @var{delay} specifies time between +## successive rolls in seconds. Default is nrep = 25 and delay = 0.1. +## +## Requires a terminal with ANSI escape sequences enabled. +## @end deftypefn + +function numbers = rolldices (n, nrep = 25, delay = .1) + if (nargin != 1) + print_usage (); + endif + + persistent matrices = getmatrices (); + + screen_cols = getenv ("COLUMNS"); + if (isempty (screen_cols)) + screen_cols = 80; + else + screen_cols = str2num (screen_cols); + endif + + dices_per_row = floor ((screen_cols-1) / 7); + + oldpso = page_screen_output (0); + + numbers = []; + + unwind_protect + while (n > 0) + m = min (n, dices_per_row); + for i = 1:nrep + if (i > 1) + puts (char ([27, 91, 51, 70])); + sleep (delay); + endif + nums = ceil (6 * rand (1, m)); + disp (matrices(:,:,nums)(:,:)); + endfor + numbers = [numbers, nums]; + n -= m; + puts ("\n"); + endwhile + unwind_protect_cleanup + page_screen_output (oldpso); + end_unwind_protect + +endfunction + +function matrices = getmatrices () + lbrk = [27, 91, 55, 109](ones (1, 3), :); + rbrk = [27, 91, 50, 55, 109](ones (1, 3), :); + spcs = [32, 32; 32, 32; 32, 32]; + dchrs = reshape( + [" @ @ @ @@ @@ @"; + " @ @ @ @ @"; + " @ @@ @@ @@ @"], [3, 5, 6]); + + matrices = mat2cell (dchrs, 3, 5, ones (1, 6)); + matrices = cellfun (@(mat) [spcs, lbrk, mat, rbrk], matrices, "UniformOutput", false); + matrices = cat (3, matrices{:}); +endfunction diff --git a/octave_packages/miscellaneous-1.1.0/slurp_file.m b/octave_packages/miscellaneous-1.1.0/slurp_file.m new file mode 100644 index 0000000..cc77771 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/slurp_file.m @@ -0,0 +1,54 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{s} = } slurp_file ( f ) +## @cindex +## slurp_file return a whole text file @var{f} as a string @var{s}. +## +## @var{f} : string : filename +## @var{s} : string : contents of the file +## +## If @var{f} is not an absolute filename, and +## is not an immediately accessible file, slurp_file () +## will look for @var{f} in the path. +## @end deftypefn + +function s = slurp_file (f) + + if (nargin != 1) + print_usage; + elseif ! ischar (f) + error ("f is not a string"); + elseif isempty (f) + error ("f is empty"); + endif + + s = ""; + + f0 = f; + [st,err,msg] = stat (f); + if err && f(1) != "/", + f = file_in_loadpath (f); + if isempty (f) + ## Could not find it anywhere. Open will fail + f = f0; + error ("slurp_file : Can't find '%s' anywhere",f0); + end + end + + ## I'll even get decent error messages! + [status, s] = system (sprintf ("cat '%s'",f), 1); +endfunction diff --git a/octave_packages/miscellaneous-1.1.0/solvesudoku.m b/octave_packages/miscellaneous-1.1.0/solvesudoku.m new file mode 100644 index 0000000..41cc2f0 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/solvesudoku.m @@ -0,0 +1,192 @@ +## Copyright (C) 2009 Jaroslav Hajek +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} [@var{x}, @var{ntrial}] = solvesudoku (@var{s}) +## Solves a classical 9x9 sudoku. @var{s} should be a 9x9 array with +## numbers from 0:9. 0 indicates empty field. +## Returns the filled table or empty matrix if no solution exists. +## If requested, @var{ntrial} returns the number of trial-and-error steps needed. +## @end deftypefn + +## This uses a recursive backtracking technique combined with revealing new singleton +## fields by logic. The beauty of it is that it is completely vectorized. + +function [x, ntrial] = solvesudoku (s) + + if (nargin != 1) + print_usage (); + endif + + if (! (ismatrix (s) && ndims (s) == 2 && all (size (s) == [9, 9]))) + error ("needs a 9x9 matrix"); + endif + + if (! ismember (unique (s(:)), 0:9)) + error ("matrix must contain values from 0:9"); + endif + + if (! verifysudoku (s)) + error ("matrix is not a valid sudoku grid"); + endif + + [x, ntrial] = solvesudoku_rec (s); + +endfunction + +function ok = verifysudoku (s) + [i, j, k] = find (s); + b = false (9, 9, 9); + b(sub2ind ([9, 9, 9], i, j, k)) = true; + okc = sum (b, 1) <= 1; + okr = sum (b, 2) <= 1; + b = reshape (b, [3, 3, 3, 3, 9]); + ok3 = sum (sum (b, 1), 3) <= 1; + ok = all (okc(:) & okr(:) & ok3(:)); +endfunction + +function [x, ntrial] = solvesudoku_rec (s) + + x = s; + ntrial = 0; + + ## Run until the logic is exhausted. + do + b = getoptions (x); + s = x; + x = getsingletons (b, x); + finished = isempty (x) || all (x(:)); + until (finished || all ((x == s)(:))); + + if (! finished) + x = []; + ## Find the field with minimum possibilities. + sb = sum (b, 3); + sb(s != 0) = 10; + [msb, i] = min (sb(:)); + [i, j] = ind2sub ([9, 9], i); + ## Try all guesses. + for k = find (b(i,j,:))' + s(i,j) = k; + [x, ntrial1] = solvesudoku_rec (s); + ntrial += 1 + ntrial1; + if (! isempty (x)) + ## Found solutions. + break; + endif + s(i,j) = 0; + endfor + endif + +endfunction + +## Given a 9x9x9 logical array of allowed values, get the logical singletons. +function s = getsingletons (b, s) + + n0 = sum (s(:) != 0); + + ## Check for fields with only one option. + sb = sum (b, 3); + if (any (sb(:) == 0)) + s = []; + return; + else + s1 = sb == 1; + ## We want to return as soon as some new singletons are found. + [s(s1), xx] = find (reshape (b, [], 9)(s1, :).'); + if (sum (s(:) != 0) > n0) + return; + endif + endif + + ## Check for columns where a number has only one field left. + sb = squeeze (sum (b, 1)); + if (any (sb(:) == 0)) + s = []; + return; + else + s1 = sb == 1; + [j, k] = find (s1); + [i, xx] = find (b(:, s1)); + s(sub2ind ([9, 9], i, j)) = k; + if (sum (s(:) != 0) > n0) + return; + endif + endif + + ## Ditto for rows. + sb = squeeze (sum (b, 2)); + if (any (sb(:) == 0)) + s = []; + return; + else + s1 = sb == 1; + [i, k] = find (s1); + [j, xx] = find (permute (b, [2, 1, 3])(:, s1)); + s(sub2ind ([9, 9], i, j)) = k; + if (sum (s(:) != 0) > n0) + return; + endif + endif + + ## 3x3 tiles. + bb = reshape (b, [3, 3, 3, 3, 9]); + sb = squeeze (sum (sum (bb, 1), 3)); + if (any (sb(:) == 0)) + s = []; + return; + else + s1 = reshape (sb == 1, 9, 9); + [j, k] = find (s1); + [i, xx] = find (reshape (permute (bb, [1, 3, 2, 4, 5]), 9, 9*9)(:, s1)); + [i1, i2] = ind2sub ([3, 3], i); + [j1, j2] = ind2sub ([3, 3], j); + s(sub2ind ([3, 3, 3, 3], i1, j1, i2, j2)) = k; + if (sum (s(:) != 0) > n0) + return; + endif + endif + +endfunction + +## Given known values (singletons), calculate options. +function b = getoptions (s) + + ## Find true values. + [i, j, s] = find (s); + ## Columns. + bc = true (9, 9, 9); + bc(:, sub2ind ([9, 9], j, s)) = false; + ## Rows. + br = true (9, 9, 9); + br(:, sub2ind ([9, 9], i, s)) = false; + ## 3x3 tiles. + b3 = true (3, 3, 3, 3, 9); + b3(:, :, sub2ind ([3, 3, 9], ceil (i/3), ceil (j/3), s)) = false; + ## Permute elements to correct order. + br = permute (br, [2, 1, 3]); + b3 = reshape (permute (b3, [1, 3, 2, 4, 5]), [9, 9, 9]); + ## The singleton fields themselves. + bb = true (9*9, 9); + bb(sub2ind ([9, 9], i, j), :) = false; + bb = reshape (bb, [9, 9, 9]); + ## Form result. + b = bc & br & b3 & bb; + ## Correct singleton fields. + b = reshape (b, 9, 9, 9); + b(sub2ind ([9, 9, 9], i, j, s)) = true; + +endfunction + diff --git a/octave_packages/miscellaneous-1.1.0/temp_name.m b/octave_packages/miscellaneous-1.1.0/temp_name.m new file mode 100644 index 0000000..4cb6f9d --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/temp_name.m @@ -0,0 +1,71 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{n} = } temp_name ( rootname, quick ) +## @cindex +## name = temp_name(rootname, quick=1) - Return a name that is not used +## +## Returns a name, suitable for defining a new function, script or global +## variable, of the form +## +## [rootname,number] +## +## Default rootname is "temp_name_" +## +## "quick" is an optional parameter, which defaults to 1. If it is false, +## temp_name() will find the smallest acceptable number for the name. +## Otherwise, a hopefully quicker method is used. +## +## @end deftypefn + +function n = temp_name (rootname, quick) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "temp_name has been deprecated, and will be removed in the future. Use `tmpnam' instead."); + endif + + ### Keep track of previously asked names + persistent cnt = struct ("dummy",0); + + if nargin<1 || !length(rootname), rootname = "temp_name_" ; endif + + if nargin<2, quick = 1; endif + + if quick + if ! isfield (cnt, rootname) + cnt.(rootname) = 0; + c = 0 ; + else + c = cnt.(rootname) ; + endif + else + c = 0; + endif + + n = sprintf ([rootname,"%i"], c); + + while exist (n), + c++ ; + n = sprintf ([rootname,"%i"], c); + endwhile + + if quick + cnt.(rootname) = c ; + endif +endfunction diff --git a/octave_packages/miscellaneous-1.1.0/units.m b/octave_packages/miscellaneous-1.1.0/units.m new file mode 100644 index 0000000..2951203 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/units.m @@ -0,0 +1,61 @@ +## Copyright (C) 2005 Carl Osterwisch +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} units (@var{fromUnit}, @var{toUnit}) +## @deftypefnx {Function File} {} units (@var{fromUnit}, @var{toUnit}, @var{x}) +## Return the conversion factor from @var{fromUnit} to @var{toUnit} measurements. +## +## This is an octave interface to the @strong{GNU Units} program which comes +## with an annotated, extendable database defining over two thousand +## measurement units. See @code{man units} or +## @url{http://www.gnu.org/software/units} for more information. +## If the optional argument @var{x} is supplied, return that argument +## multiplied by the conversion factor. Nonlinear conversions +## such as Fahrenheit to Celsius are not currently supported. For example, to +## convert three values from miles per hour into meters per second: +## +## @example +## units ("mile/hr", "m/sec", [30, 55, 75]) +## ans = +## +## 13.411 24.587 33.528 +## @end example +## @end deftypefn + +function y = units(fromUnit, toUnit, x) + if 2 > nargin || 3 < nargin || !ischar(fromUnit) || !ischar(toUnit) + print_usage; + endif + + [status, rawoutput] = system(sprintf('units "%s" "%s"', fromUnit, toUnit), 1); + (0 == status) || error([rawoutput, + 'Verify that GNU units is installed in the current path.']); + + i = index(rawoutput, "*"); + j = index(rawoutput, "\n") - 1; + i && (i < j) || error('parsing units output "%s"', rawoutput); + + exist("x", "var") || (x = 1); + eval(['y = x', rawoutput(i:j), ';']) +endfunction + +%!demo +%! a.value = 100; a.unit = 'lb'; +%! b.value = 50; b.unit = 'oz'; +%! c.unit = 'kg'; +%! c.value = units(a.unit, c.unit, a.value) + units(b.unit, c.unit, b.value) + +%!assert( units("in", "mm"), 25.4 ) diff --git a/octave_packages/miscellaneous-1.1.0/z_curve.m b/octave_packages/miscellaneous-1.1.0/z_curve.m new file mode 100644 index 0000000..2fcebeb --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/z_curve.m @@ -0,0 +1,90 @@ +## Copyright (C) 2009 Javier Enciso +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function file} {@var{x}, @var{y}} z_curve (@var{n}) +## Creates an iteration of the Z-order space-filling curve with @var{n} points. +## The argument @var{n} must be of the form @code{2^M}, where @var{m} is an +## integer greater than 0. +## +## @example +## n = 8 +## [x ,y] = z_curve (n); +## line (x, y, "linewidth", 4, "color", "blue"); +## @end example +## +## @end deftypefn + +function [x, y] = z_curve (n) + + if (nargin != 1) + print_usage (); + endif + + check_power_of_two (n); + if (n == 2) + x = [0, 1, 0, 1]; + y = [0, 0, -1, -1]; + else + [x1, y1] = z_curve (n/2); + x2 = n/2 + x1; + y2 = y1 - n/2; + x = [x1, x2, x1, x2]; + y = [y1, y1, y2, y2]; + endif + +endfunction + +function check_power_of_two (n) + if (frac_part (log (n) / log (2)) != 0) + error ("z_curve: input argument must be a power of 2.") + endif +endfunction + +function d = frac_part (f) + d = f - floor (f); +endfunction + +%!test +%! n = 2; +%! expect = [0, 1, 0, 1; 0, 0, -1, -1]; +%! [get(1,:), get(2,:)] = z_curve (n); +%! if (any(size (expect) != size (get))) +%! error ("wrong size: expected %d,%d but got %d,%d", size (expect), size (get)); +%! elseif (any (any (expect!=get))) +%! error ("didn't get what was expected."); +%! endif + +%!test +%! n = 5; +%!error z_curve (n); + +%!demo +%! clf +%! n = 4; +%! [x, y] = z_curve (n); +%! line (x, y, "linewidth", 4, "color", "blue"); +%! % ----------------------------------------------------------------------- +%! % the figure window shows an iteration of the Z-order space-fillig curve +%! % with 4 points on each axis. + +%!demo +%! clf +%! n = 32; +%! [x, y] = z_curve (n); +%! line (x, y, "linewidth", 2, "color", "blue"); +%! % ---------------------------------------------------------------------- +%! % the figure window shows an iteration of the Z-order space-fillig curve +%! % with 32 points on each axis. diff --git a/octave_packages/miscellaneous-1.1.0/zagzig.m b/octave_packages/miscellaneous-1.1.0/zagzig.m new file mode 100644 index 0000000..d042279 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/zagzig.m @@ -0,0 +1,87 @@ +## Copyright (C) 2006 Fredrik Bulow +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} zagzig (@var{mtrx}) +## Returns zagzig walk-off of the elements of @var{mtrx}. +## Essentially it walks the matrix in a Z-fashion. +## +## mat = +## 1 4 7 +## 2 5 8 +## 3 6 9 +## then zagzag(mat) gives the output, +## [1 4 2 3 5 7 8 6 9], by walking as +## shown in the figure from pt 1 in that order of output. +## The argument @var{mtrx} should be a MxN matrix. One use of +## zagzig the use with picking up DCT coefficients +## like in the JPEG algorithm for compression. +## +## An example of zagzig use: +## @example +## @group +## mat = reshape(1:9,3,3); +## zagzag(mat) +## ans =[1 4 2 3 5 7 8 6 9] +## +## @end group +## @end example +## +## @end deftypefn +## @seealso{zigzag} + +function rval = zagzig(mtrx) + + if nargin != 1 #Checking arguments. + print_usage; + endif + + if issquare(mtrx) #Square matrix (quick case) + n=length(mtrx); + ##We create a matrix of the same size as mtrx where odd elements are + ##1, others 0. + odd=kron(ones(n,n),eye(2))((1:n),(1:n)); + + ##We transpose even elements only. + mtrx = (mtrx.*odd)' + (mtrx.*(1-odd)); + + ##Now we mirror the matrix. The desired vector is now the + ##concatenation of the diagonals. + mtrx=mtrx(:,1+size(mtrx,2)-(1:size(mtrx,2))); + + ##Picking out the diagonals. + rval = []; + for i = n-1:-1:1-n + rval=[rval diag(mtrx,i)']; + endfor + + else #Not square (Slow cases) + n=size(mtrx); + mtrx=mtrx(:,1+size(mtrx,2)-(1:size(mtrx,2))); + + ##Picking out the diagonals and reversing odd ones manually. + rval = []; + for i = n(2)-1:-1:1-n(1) + new = diag(mtrx,i); + if floor(i/2)==i/2 ##Even? + rval=[rval new((1+length(new))-(1:length(new)))']; + else ##Odd! + rval=[rval new']; + endif + endfor + endif +endfunction + +%!assert(zagzig(reshape(1:9,3,3)),[1 4 2 3 5 7 8 6 9]) diff --git a/octave_packages/miscellaneous-1.1.0/zigzag.m b/octave_packages/miscellaneous-1.1.0/zigzag.m new file mode 100644 index 0000000..956c638 --- /dev/null +++ b/octave_packages/miscellaneous-1.1.0/zigzag.m @@ -0,0 +1,84 @@ +## Copyright (C) 2006 Fredrik Bulow +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} zigzag (@var{mtrx}) +## Returns zigzag walk-off of the elements of @var{mtrx}. +## Essentially it walks the matrix in a Z-fashion. +## +## mat = +## 1 4 7 +## 2 5 8 +## 3 6 9 +## then zigzag(mat) gives the output, +## [1 2 4 7 5 3 6 8 9], by walking as +## shown in the figure from pt 1 in that order of output. +## The argument @var{mtrx} should be a MxN matrix +## +## An example of zagzig use: +## @example +## @group +## mat = reshape(1:9,3,3); +## zigzag(mat) +## ans =[1 2 4 7 5 3 6 8 9] +## +## @end group +## @end example +## +## @end deftypefn +## @seealso{zagzig} + +function rval = zigzag(mtrx) + if nargin != 1 + print_usage; + endif + n=size(mtrx); + + if(issquare(mtrx)) #Square matrix (quick case) + + ##We create a matrix of the same size as mtrx where odd elements are + ##1, others 0. + odd=kron(ones(ceil(n/2)),eye(2))((1:n(1)),(1:n(2))); + + ##We transpose even elements only. + mtrx = mtrx.*odd + (mtrx.*(1-odd))'; + + ##Now we mirror the matrix. The desired vector is now the + ##concatenation of the diagonals. + mtrx=mtrx(:,1+size(mtrx,2)-(1:size(mtrx,2))); + + ##Picking out the diagonals. + rval = []; + for i = n(2)-1:-1:1-n(1) + rval=[rval diag(mtrx,i)']; + endfor + + else #Not square (Slow cases) + mtrx=mtrx(:,1+size(mtrx,2)-(1:size(mtrx,2))); + + ##Picking out the diagonals and reversing odd ones manually. + rval = []; + for i = n(2)-1:-1:1-n(1) + new = diag(mtrx,i); + if(floor(i/2)==i/2) ##Even? + rval=[rval new']; + else ##Odd! + rval=[rval new((1+length(new))-(1:length(new)))']; + endif + endfor + endif +endfunction + +%!assert(zigzag(reshape(1:9,3,3)),[1 2 4 7 5 3 6 8 9]) diff --git a/octave_packages/missing-functions-1.0.2/__functionstatus__.m b/octave_packages/missing-functions-1.0.2/__functionstatus__.m new file mode 100644 index 0000000..43c91bd --- /dev/null +++ b/octave_packages/missing-functions-1.0.2/__functionstatus__.m @@ -0,0 +1,45 @@ +## Copyright (C) 2008 Bill Denney +## +## This software is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This software is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this software; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{status} =} __functionstatus__ (@var{funname}) +## Return if a function is present in octave: -1 = not checked, 0 = +## missing, 1 = present +## @end deftypefn + +function status = __functionstatus__ (funname) + + if ischar (funname) + funname = {funname}; + elseif ~ iscellstr (funname) + print_usage (); + endif + + status = zeros (size (funname)); + for i = 1:numel (funname) + if any (! (isalpha (funname{i}) | isdigit (funname{i}))) + ## not checked + status(i) = -1; + elseif iskeyword (funname{i}) || which (funname{i}) + ## present + status(i) = 1; + else + ## missing + status(i) = 0; + endif + endfor + +endfunction diff --git a/octave_packages/missing-functions-1.0.2/__matlabfunctionlist__.m b/octave_packages/missing-functions-1.0.2/__matlabfunctionlist__.m new file mode 100644 index 0000000..c3a019d --- /dev/null +++ b/octave_packages/missing-functions-1.0.2/__matlabfunctionlist__.m @@ -0,0 +1,92 @@ +## Copyright (C) 2008 Bill Denney +## +## This software is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This software is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this software; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{funlist}, @var{funloc}, @var{catlist}, @var{catloc}, @var{catlvl}] =} __matlabfunctionlist__ (@var{url}) +## Return a list of matlab functions, @var{funlist}, from the @var{url}. +## It will also return the list of locations of the functions within the +## file, the categories in the url (@var{catlist}), the location of the +## categories within the url (@var{catloc}), and the level of the +## categories (@var{catlvl}, 2 = h2, 3 = h3, ...). Note, the locations +## may not be sorted or unique. +## @end deftypefn + +function [funlist, funloc, catlist, catloc, catlvl] = __matlabfunctionlist__ (url = "http://www.mathworks.com/access/helpdesk/help/techdoc/ref/f16-6011.html") + + [raw, success, message] = urlread(url); + if (! success) + warning ("__matlabfunctionlist__:url", + "__matlabfunctionlist__: Could not read\n%s\n%s", url, message); + funlist = {}; + funloc = []; + catlist = {}; + catloc = []; + catlvl = []; + return + endif + ## Building up a really rough single-purpose XML parser + + ## Tags + tagopen = find (raw == "<"); + tagclose = find (raw == ">"); + ## categories + h2loc = findstr (raw, " tmpfunloc(i), 3)(3))+1: + tagopen(find (tagopen > tmpfunloc(i), 3)(3))-1); + ## convert all whitespace to actual spaces + tmpfunname(isspace (tmpfunname)) = " "; + if (numel (tmpfunname) > 2) + tmpfunname = split (tmpfunname, ", "); + endif + for j = 1:rows (tmpfunname) + idx++; + funlist{idx} = strtrim (tmpfunname(j,:)); + funloc(idx) = tmpfunloc(i); + endfor + endfor + +endfunction + +function name = getname (raw, loc, tagopen, tagclose) + + name = cell (size (loc)); + for i = 1:numel (loc) + name{i} = raw(tagclose(find (tagclose > loc(i), 1))+1:tagopen(find (tagopen > loc(i), 1))-1); + endfor + +endfunction diff --git a/octave_packages/missing-functions-1.0.2/__missingmatlab2txt__.m b/octave_packages/missing-functions-1.0.2/__missingmatlab2txt__.m new file mode 100644 index 0000000..795ff11 --- /dev/null +++ b/octave_packages/missing-functions-1.0.2/__missingmatlab2txt__.m @@ -0,0 +1,96 @@ +## Copyright (C) 2008 Bill Denney +## +## This software is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This software is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this software; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __missingmatlab2txt__ (@var{funlist}, @var{funloc}, @var{funstat}, @var{catlist}, @var{catloc}, @var{catlvl}, @var{outformat}) +## Convert the function and category information into text. The +## @var{outformat} can be one of "wiki" or "html". +## @end deftypefn + +function output = __missingmatlab2txt__ (funlist, funloc, funstat, catlist, catloc, catlvl, outformat = "wiki") + + ## this will be to keep track of what we are currently looking at, + ## functions will be considered at category level 99. + funlvl = 99; + statstr = {"Not Checked" "Missing" "Present"}; + + allloc = [catloc(:);funloc(:)]; + [alloc, sidx] = sort (allloc); + allname = [catlist(:);funlist(:)](sidx); + allstat = [zeros(numel(catlist), 1);funstat(:)](sidx); + alllvl = [catlvl(:);funlvl*ones(numel(funlist), 1)](sidx); + + switch lower (outformat) + case "wiki" + output = __towiki__ (alllvl, allname, allstat, funlvl, statstr); + case "html" + output = __tohtml__ (alllvl, allname, allstat, funlvl, statstr); + otherwise + error ("missingmatlab2txt: invalid outformat (%s)", outformat); + endswitch + +endfunction + +function output = __towiki__ (alllvl, allname, allstat, funlvl, statstr) + + output = cell (size (allname)); + for i = 1:numel (alllvl) + if (alllvl(i) == funlvl) + output{i} = sprintf ("||%s||%s||\n", allname{i}, statstr{allstat(i)+2}); + else + hstring = char ("="*ones (1, alllvl(i))); + output{i} = sprintf ("\n%s%s%s\n", hstring, allname{i}, hstring) + endif + endfor + +endfunction + +function output = __tohtml__ (alllvl, allname, allstat, funlvl, statstr) + + output = cell (size (allname)); + + lastwasfun = false (); + idx = 1; + output{idx} = "Matlab Functions Missing from Octave\n"; + + for i = 1:numel (alllvl) + if (alllvl(i) == funlvl) + if (! lastwasfun) + output{++idx} = "\n"; + endif + + thisclass = statstr{allstat(i)+2}; + thisclass(isspace (thisclass)) = []; + output{++idx} = sprintf ("\n", + thisclass, allname{i}, statstr{allstat(i)+2}); + lastwasfun = true (); + else + if lastwasfun + output{++idx} = "
%s%s
\n"; + endif + hstring = sprintf ("h%d", alllvl(i)); + output{++idx} = sprintf ("\n<%s>%s\n", hstring, allname{i}, hstring); + lastwasfun = false (); + endif + endfor + + if lastwasfun + output{++idx} = "\n"; + endif + output{++idx} = ""; + +endfunction + diff --git a/octave_packages/missing-functions-1.0.2/doc-cache b/octave_packages/missing-functions-1.0.2/doc-cache new file mode 100644 index 0000000..4235487 --- /dev/null +++ b/octave_packages/missing-functions-1.0.2/doc-cache @@ -0,0 +1,68 @@ +# Created by Octave 3.6.1, Fri Mar 16 17:49:39 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 2 +# name: +# type: sq_string +# elements: 1 +# length: 21 +missingfunctionstatus + + +# name: +# type: sq_string +# elements: 1 +# length: 185 + -- Function File: missingfunctionstatus (OUTDIR) + Write out all the current Matlab functions and toolboxes to OUTDIR + in html format. + + See also: missingmatlabfunctions + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Write out all the current Matlab functions and toolboxes to OUTDIR in +html forma + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +missingmatlabfunctions + + +# name: +# type: sq_string +# elements: 1 +# length: 306 + -- Function File: matlabfunctionlist (OUTFILE, OUTFORMAT, URL) + Show or write to OUTFILE the missing Matlab functions listed at + the category index URL. OUTFORMAT is the output format to show or + write and it may be one of "wiki" (default) or "html". + + See also: missingfunctionstatus + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Show or write to OUTFILE the missing Matlab functions listed at the +category ind + + + + + diff --git a/octave_packages/missing-functions-1.0.2/missingfunctionstatus.m b/octave_packages/missing-functions-1.0.2/missingfunctionstatus.m new file mode 100644 index 0000000..6dd8017 --- /dev/null +++ b/octave_packages/missing-functions-1.0.2/missingfunctionstatus.m @@ -0,0 +1,88 @@ +## Copyright (C) 2008 Bill Denney +## +## This software is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This software is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this software; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} missingfunctionstatus (@var{outdir}) +## Write out all the current Matlab functions and toolboxes to +## @var{outdir} in html format. +## @seealso{missingmatlabfunctions} +## @end deftypefn + +function missingfunctionstatus (outdir = ".") + + urlbase = "http://www.mathworks.com/access/helpdesk/help/"; + + toolboxes = {"Matlab" "techdoc/ref/f16-6011.html"; + "Aerospace" "toolbox/aerotbx/ug/bqj21qj.html"; + "Bioinformatics" "toolbox/bioinfo/ref/a1052308804.html"; + "Communications" "toolbox/comm/ug/a1037894415.html"; + "Control System" "toolbox/control/ref/f2-1014412.html"; + "Curve Fitting" "toolbox/curvefit/f2-17602.html"; + "Data Acquisition" "toolbox/daq/f14-17602.html"; + "Database" "toolbox/database/ug/f4-6010.html"; + "Datafeed" "toolbox/datafeed/bp_usto-1.html"; + "Filter Design" "toolbox/filterdesign/ref/f11-35125.html"; + "Financial" "toolbox/finance/f6-213137.html"; + "Financial Derivatives" "toolbox/finderiv/f0-23501.html"; + "Fixed-Income" "toolbox/finfixed/f5-6010.html"; + "Fixed-Point" "toolbox/fixedpoint/ref/f20333.html"; + "Fuzzy Logic" "toolbox/fuzzy/fp4856.html"; + "GARCH" "toolbox/garch/f9-21078.html"; + "Genetic Algorithm and Direct Search" "toolbox/gads/bqe0w5v.html"; + "Image Acquisition" "toolbox/imaq/f14-17602.html"; + "Image Processing" "toolbox/images/f3-23960.html"; + "Instrument Control" "toolbox/instrument/f9-42439.html"; + "Mapping" "toolbox/map/f3-12193.html"; + "Mapping (Projections)" "toolbox/map/f4-4154.html"; + "Model Predictive Control" "toolbox/mpc/chmpcrefintro.html"; + "Neural Network" "toolbox/nnet/function.html"; + "OPC" "toolbox/opc/ug/f7-6010.html"; + "Optimization" "toolbox/optim/ug/bqnk0r0.html"; + "Partial Differential Equation" "toolbox/pde/ug/f7498.html"; + "RF" "toolbox/rf/bq33b0t.html"; + "Robust Control" "toolbox/robust/refintro.html"; + "Signal Processing" "toolbox/signal/f9-131178c.html"; + "Spline" "toolbox/splines/refer1_html.html"; + "Spreadsheet Link EX" "toolbox/exlink/f4-6010.html"; + "Statistics" "toolbox/stats/bq_w_hm.html"; + "Symbolic Math" "toolbox/symbolic/f3-157665.html"; + "System Identification" "toolbox/ident/ref/f3-8911.html"; + "Virtual Reality" "toolbox/vr/f0-6010.html"; + "Wavelet" "toolbox/wavelet/ref_open.html"}; + + filenames = cell (rows (toolboxes), 1); + for i = 1:rows (toolboxes) + basename = toolboxes{i,1}; + basename(isspace (basename)) = "_"; + filenames{i} = [basename ".html"]; + missingmatlabfunctions (fullfile (outdir, filenames{i}), "", + [urlbase toolboxes{i,2}]) + endfor + + ## make the index page + [fid msg] = fopen (fullfile (outdir, "index.html"), "wt"); + if (fid < 0) + error ("missingfunctionstatus: could not open index.html, %s", msg) + endif + fprintf (fid, "Matlab Functions Missing from Octave\n"); + for i = 1:rows (toolboxes) + fprintf (fid, "%s
", + filenames{i}, toolboxes{i,1}); + endfor + fprintf (fid, "") + fclose (fid); + +endfunction diff --git a/octave_packages/missing-functions-1.0.2/missingmatlabfunctions.m b/octave_packages/missing-functions-1.0.2/missingmatlabfunctions.m new file mode 100644 index 0000000..0249c2e --- /dev/null +++ b/octave_packages/missing-functions-1.0.2/missingmatlabfunctions.m @@ -0,0 +1,57 @@ +## Copyright (C) 2008 Bill Denney +## +## This software is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This software is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this software; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} matlabfunctionlist (@var{outfile}, @var{outformat}, @var{url}) +## Show or write to @var{outfile} the missing Matlab functions listed at +## the category index @var{url}. @var{outformat} is the output format +## to show or write and it may be one of "wiki" (default) or "html". +## @seealso{missingfunctionstatus} +## @end deftypefn + +function missingmatlabfunctions (outfile = "", outformat = "", url = "http://www.mathworks.com/access/helpdesk/help/techdoc/ref/f16-6011.html") + + [funlist, funloc, catlist, catloc, catlvl] = __matlabfunctionlist__ (url); + funstat = __functionstatus__ (funlist); + + ## guess the output format defaulting to wiki. + if isempty (outformat) + if isempty (outfile) + outformat = "wiki"; + else + [dirname, filename, ext] = fileparts (outfile); + if (! isempty (findstr (ext, "htm"))) + outformat = "html"; + else + outformat = "wiki"; + endif + endif + endif + + output = __missingmatlab2txt__ (funlist, funloc, funstat, + catlist, catloc, catlvl, outformat); + if isempty (outfile) + printf ("%s", output{:}); + else + [fid msg] = fopen (outfile, "wt"); + if (fid < 0) + error ("missingmatlabfunctions: error opening %s, %s", outfile, msg); + endif + fprintf (fid, "%s", output{:}); + fclose (fid); + endif + +endfunction diff --git a/octave_packages/missing-functions-1.0.2/packinfo/.autoload b/octave_packages/missing-functions-1.0.2/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/missing-functions-1.0.2/packinfo/DESCRIPTION b/octave_packages/missing-functions-1.0.2/packinfo/DESCRIPTION new file mode 100644 index 0000000..97dc09c --- /dev/null +++ b/octave_packages/missing-functions-1.0.2/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: missing-functions +Version: 1.0.2 +Date: 2009-05-06 +Author: Bill Denney +Maintainer: Bill Denney +Title: Missing Functions +Description: Find functions that are in Matlab but not in Octave. +Categories: Missing +Depends: octave (>= 3.0.0) +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net diff --git a/octave_packages/missing-functions-1.0.2/packinfo/INDEX b/octave_packages/missing-functions-1.0.2/packinfo/INDEX new file mode 100644 index 0000000..9c16217 --- /dev/null +++ b/octave_packages/missing-functions-1.0.2/packinfo/INDEX @@ -0,0 +1,7 @@ +missing-functions >> Missing Functions +Missing + __functionstatus__ + __matlabfunctionlist__ + __missingmatlab2txt__ + missingfunctionstatus + missingmatlabfunctions diff --git a/octave_packages/nan-2.5.5/bland_altman.m b/octave_packages/nan-2.5.5/bland_altman.m new file mode 100644 index 0000000..516026b --- /dev/null +++ b/octave_packages/nan-2.5.5/bland_altman.m @@ -0,0 +1,121 @@ +function RES = bland_altman(data,group,arg3) +% BLAND_ALTMANN shows the Bland-Altman plot of two columns of measurements +% and computes several summary results. +% +% bland_altman(m1, m2 [,group]) +% bland_altman(data [, group]) +% R = bland_altman(...) +% +% m1,m2 are two colums with the same number of elements +% containing the measurements. m1,m2 can be also combined +% in a single two column data matrix. +% group [optional] indicates which measurements belong to the same group +% This is useful to account for repeated measurements. +% +% +% References: +% [1] JM Bland and DG Altman, Measuring agreement in method comparison studies. +% Statistical Methods in Medical Research, 1999; 8; 135. +% doi:10.1177/09622802990080204 +% [2] P.S. Myles, Using the Bland– Altman method to measure agreement with repeated measures +% British Journal of Anaesthesia 99(3):309–11 (2007) +% doi:10.1093/bja/aem214 + +% $Id$ +% Copyright (C) 2010,2011 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 3 +% of the License, or (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + +if nargin<2, group = []; end; +if nargin<3, arg3 = []; end; + +if (size(data,2)==1) + data = [data, group]; + group = arg3; +end; + + +D = data * [1;-1]; +M = data * [1;1]/2; + +RES.corrcoef = corrcoef(data(:,1),data(:,2),'spearman'); +[REs.cc,RES.p] = corrcoef(M,D,'spearman'); +if (RES.p<0.05) + warning('A regression model according to section 3.2 [1] should be used'); + %% TODO: implement support for this type of data. + RES.a = [ones(size(data,1),1),D]\M; + RES.b = [ones(size(data,1),1),M]\D; +end; + +if isempty(group) + G = [1:size(data,1)]'; + m = ones(size(data,1),1); + d = D; + RES.Bias = mean(d,1); + RES.Var = var(d); + +elseif ~isempty(group) + %% TODO: this is not finished + warning('analysis of data with repetitions is experimental - it might yield incorrect results - you are warned.!') + [G,I,J] = unique (group); + R = zeros(size(data)); + m = repmat(NaN,length(G),1); + n = repmat(NaN,length(G),1); + d = repmat(NaN,length(G),1); + d2 = repmat(NaN,length(G),1); + data2 = repmat(NaN,length(G),size(data,2)); + SW2 = repmat(NaN,length(G),size(data,2)); + for i = 1:length(G), + ix = find(group==G(i)); + n(i) = length(ix); +% IX((i-1)*N+1:i*N) = ix(ceil(rand(N,1)*n(i))); + + [R(ix,:), data2(i,:)] = center(data(ix,:),1); + d(i) = mean(D(ix,:),1); + m(i) = mean(M(ix,:),1); + d2(i) = mean(D(ix,:).^2,1); + RES.SW2(i,:) = var(data(ix,:),[],1); + RES.avg(i,:) = mean(data(ix,:),1); + end; + + W = 1./n(J); + RES.SSW = sumskipnan(R.^2,1,W); + RES.SSB = var(data,[],1,W)*sum(W)*(sum(W)-1); + RES.sigma2_w= RES.SSW/(sum(W)*(length(G)-1)); + RES.sigma2_u= RES.SSB/(sum(W)*(length(G)-1)) - RES.sigma2_w/(length(G)); + RES.group = bland_altman(data2); % FIXME: this plot shows incorrect interval, it does not account for the group/repeated samples. + RES.repeatability_coefficient1 = 2.77*sqrt(var(R,1,1)); % variance with factor group removed + RES.repeatability_coefficient = 2.77*sqrt(mean(SW2,1)); % variance with factor group removed + RES.std_d_ = std(d); + RES.std_D_ = std(D); + RES.std_m_ = std(m); + + RES.n = n; + return; + + D = d; + M = m; +% RES.sigma2_dw = + + RES.Bias = mean(d,1,[],n); +end; + + +plot(M,D,'o', [min(M),max(M)]', [0,0]','k--', [min(M),max(M)]', [1,1,1; 0,1.96,-1.96]'*[RES.Bias;std(D)]*[1,1], 'k-'); +xlabel('mean'); +ylabel('difference'); + diff --git a/octave_packages/nan-2.5.5/cat2bin.m b/octave_packages/nan-2.5.5/cat2bin.m new file mode 100644 index 0000000..7e1969b --- /dev/null +++ b/octave_packages/nan-2.5.5/cat2bin.m @@ -0,0 +1,90 @@ +function [B,BLab]=cat2bin(D, Label, MODE) +% CAT2BIN converts categorial into binary data +% each category of each column in D is converted into a logical column +% +% B = cat2bin(C); +% [B,BinLabel] = cat2bin(C,Label); +% [B,BinLabel] = cat2bin(C,Label,MODE) +% +% C categorial data +% B binary data +% Label description of each column in C +% BinLabel description of each column in B +% MODE default [], ignores NaN +% 'notIgnoreNAN' includes binary column for NaN +% 'IgnoreZeros' zeros do not get a separate category +% 'IgnoreZeros+NaN' zeros and NaN are ignored +% +% example: +% cat2bin([1;2;5;1;5]) results in +% 1 0 0 +% 0 1 0 +% 0 0 1 +% 1 0 0 +% 0 0 1 + +% $Id: cat2bin.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 3 +% of the License, or (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + +if nargin<3, + MODE = []; +end; + +% convert data +B = []; + +c = 0; +k1 = 0; +BLab = []; +for m = 1:size(D,2) + h = histo_mex(D(:,m)); + x = h.X(h.H>0); + if strcmpi(MODE,'notIgnoreNaN') + ; + elseif strcmpi(MODE,'IgnoreZeros') + x = x(x~=0); + elseif strcmpi(MODE,'IgnoreZeros+NaN') + x = x((x~=0) & (x==x)); + else + x = x(x==x); + end; + for k = 1:size(D,1), + if ~isnan(D(k,m)) + B(k, c + find(D(k,m)==x)) = 1; + elseif isnan(x(end)), + B(k, c + length(x)) = 1; + end; + end; + + c = c + length(x); + if nargout>1, + for k = 1:length(x), + k1 = k1+1; + if isempty(Label) + BLab{k1} = ['#',int2str(m),':',int2str(x(k))]; + else + BLab{k1} = [Label{m},':',int2str(x(k))]; + end; + end; + end; +end; + + +%!assert(cat2bin([1;2;5;1;5]),[1,0,0;0,1,0;0,0,1;1,0,0;0,0,1]) + diff --git a/octave_packages/nan-2.5.5/cdfplot.m b/octave_packages/nan-2.5.5/cdfplot.m new file mode 100644 index 0000000..9a8a795 --- /dev/null +++ b/octave_packages/nan-2.5.5/cdfplot.m @@ -0,0 +1,57 @@ +function [h,stats] = cdfplot(X, varargin) +% CDFPLOT plots empirical commulative distribution function +% +% cdfplot(X) +% cdfplot(X, FMT) +% cdfplot(X, PROPERTY, VALUE,...) +% h = cdfplot(...) +% [h,stats] = cdfplot(X) +% +% X contains the data vector +% (matrix data is currently changed to a vector, this might change in future) +% FMT,PROPERTY,VALUE +% are used for formating; see HELP PLOT for more details +% h graphics handle to the cdf curve +% stats +% a struct containing various summary statistics including +% mean, std, median, min, max. +% +% see also: ecdf, median, statistics, hist2res, plot +% +% References: + +% $Id: cdfplot.m 8351 2011-06-24 17:35:07Z carandraug $ +% Copyright (C) 2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 3 +% of the License, or (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + + +his = histo_mex(X(:)); +cdf = cumsum(his.H,1) ./ sum(his.H,1); +ix1 = ceil ([1:2*size(his.X,1)]'/2); +ix2 = floor([2:2*size(his.X,1)]'/2); +hh = plot (his.X(ix1), [0; cdf(ix2)], varargin{:}); + +if nargout>0, + h = hh; +end; +if nargout>1, + stats = hist2res(his); + stats.median = quantile(his,.5); +end; + + diff --git a/octave_packages/nan-2.5.5/center.m b/octave_packages/nan-2.5.5/center.m new file mode 100644 index 0000000..8062f1a --- /dev/null +++ b/octave_packages/nan-2.5.5/center.m @@ -0,0 +1,62 @@ +function [i,S] = center(i,DIM,W) +% CENTER removes the mean +% +% [z,mu] = center(x,DIM,W) +% removes mean x along dimension DIM +% +% x input data +% DIM dimension +% 1: column +% 2: row +% default or []: first DIMENSION, with more than 1 element +% W weights to computed weighted mean (default: [], all weights = 1) +% numel(W) must be equal to size(x,DIM) +% +% features: +% - can deal with NaN's (missing values) +% - weighting of data +% - dimension argument +% - compatible to Matlab and Octave +% +% see also: SUMSKIPNAN, MEAN, STD, DETREND, ZSCORE +% +% REFERENCE(S): + +% 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 . + + +% $Id: center.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2003,2005,2009 by Alois Schloegl +% This is part of the NaN-toolbox. For more details see +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +if any(size(i)==0); return; end; + +if nargin<3, + W = []; +end; +if nargin>1, + [S,N] = sumskipnan(i,DIM,W); +else + [S,N] = sumskipnan(i,[],W); +end; + +S = S./N; +szi = size(i); +szs = size(S); +if length(szs) +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 3 +% of the License, or (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + +if nargin<4 + TYPE = 'linear'; +end; + +if strcmp(TYPE,'linear') + TYPE = 'LDA'; +elseif strcmp(TYPE,'quadratic') + TYPE = 'QDA2'; % result is closer to Matlab +elseif strcmp(TYPE,'diagLinear') + TYPE = 'NBC'; +elseif strcmp(TYPE,'diagQuadratic') + TYPE = 'NBC'; +elseif strcmp(TYPE,'mahalanobis') + TYPE = 'MDA'; +end; + +[group,I,classlabel] = unique(classlabel); + +CC = train_sc(training,classlabel,TYPE); +R = test_sc(CC,sample); +CLASS = group(R.classlabel); + +if nargout>1, + R = test_sc(CC,training,[],classlabel); + ERR = 1-R.ACC; +end; + +if nargout>2, + warning('output arguments POSTERIOR,LOGP and COEF not supported') + POSTERIOR = []; + LOGP = []; + COEF = []; +end; + diff --git a/octave_packages/nan-2.5.5/coefficient_of_variation.m b/octave_packages/nan-2.5.5/coefficient_of_variation.m new file mode 100644 index 0000000..64a44cb --- /dev/null +++ b/octave_packages/nan-2.5.5/coefficient_of_variation.m @@ -0,0 +1,44 @@ +function cv=coefficient_of_variation(i,DIM) +% COEFFICIENT_OF_VARIATION returns STD(X)/MEAN(X) +% +% cv=coefficient_of_variation(x [,DIM]) +% cv=std(x)/mean(x) +% +% see also: SUMSKIPNAN, MEAN, STD +% +% REFERENCE(S): +% http://mathworld.wolfram.com/VariationCoefficient.html + +% $Id: coefficient_of_variation.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 1997-2003 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% 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 . + + +if nargin<2, + DIM = find(size(i)>1,1); + if isempty(DIM), DIM=1; end; +end; + +[S,N,SSQ] = sumskipnan(i,DIM); + +% sqrt((SSQ-S.*S./N)./max(N-1,0))/(S./N); % = std(i)/mean(i) + +cv = sqrt(SSQ.*N./(S.*S)-1); + +%if flag_implicit_unbiased_estim, + cv = cv.*sqrt(N./max(N-1,0)); +%end; diff --git a/octave_packages/nan-2.5.5/cor.m b/octave_packages/nan-2.5.5/cor.m new file mode 100644 index 0000000..1febc22 --- /dev/null +++ b/octave_packages/nan-2.5.5/cor.m @@ -0,0 +1,101 @@ +function [r2] = cor(X,Y); +% COR calculates the correlation matrix +% X and Y can contain missing values encoded with NaN. +% NaN's are skipped, NaN do not result in a NaN output. +% (Its assumed that the occurence of NaN's is uncorrelated) +% The output gives NaN only if there are insufficient input data +% +% COR(X); +% calculates the (auto-)correlation matrix of X +% COR(X,Y); +% calculates the crosscorrelation between X and Y +% +% c = COR(...); +% c is the correlation matrix +% +% W weights to compute weighted mean (default: []) +% if W=[], all weights are 1. +% number of elements in W must match size(x,DIM) + +% NOTE: Under certain circumstances (Missing values and small number of samples) +% abs(COR) can be larger than 1. +% If you need abs(COR)<=1, use CORRCOEF. CORRCOEF garantees abs(COR)<=1. +% +% see also: SUMSKIPNAN, COVM, COV, CORRCOEF +% +% REFERENCES: +% http://mathworld.wolfram.com/CorrelationCoefficient.html + + +% $Id: cor.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2004,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +% 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 . + + +if nargin==1 + Y = []; +elseif nargin==0 + fprintf(2,'Error COR: Missing argument(s)\n'); +end; + +[r1,c1]=size(X); +if (c1>r1), + fprintf(2,'Warning COR: Covariance is ill-defined, because of too less observations (rows).\n'); +end; + +[r1,c1]=size(X); +if ~isempty(Y) + [r2,c2]=size(Y); + if r1~=r2, + fprintf(2,'Error COR: X and Y must have the same number of observations (rows).\n'); + return; + end; +else + [r2,c2]=size(X); +end; + +if (c1>r1) || (c2>r2), + fprintf(2,'Warning COR: Covariance is ill-defined, because of too less observations (rows).\n'); +end; + +if ~isempty(Y), + [S1,N1,SSQ1] = sumskipnan(X,1); + [S2,N2,SSQ2] = sumskipnan(Y,1); + + NN = double(~isnan(X)')*double(~isnan(Y)); + X(isnan(X)) = 0; % skip NaN's + Y(isnan(Y)) = 0; % skip NaN's + CC = X'*Y; + + M1 = S1./N1; + M2 = S2./N2; + cc = CC./NN - M1'*M2; + r2 = cc./sqrt((SSQ1./N1-M1.*M1)'*(SSQ2./N2-M2.*M2)); + +else + [S,N,SSQ] = sumskipnan(X,1); + + NN = double(~isnan(X)')*double(~isnan(X)); + X(isnan(X)) = 0; % skip NaN's + CC = X'*X; + + M = S./N; + cc = CC./NN - M'*M; + v = (SSQ./N- M.*M); %max(N-1,0); + r2 = cc./sqrt(v'*v); +end; diff --git a/octave_packages/nan-2.5.5/corrcoef.m b/octave_packages/nan-2.5.5/corrcoef.m new file mode 100644 index 0000000..f14b754 --- /dev/null +++ b/octave_packages/nan-2.5.5/corrcoef.m @@ -0,0 +1,386 @@ +function [R,sig,ci1,ci2,nan_sig] = corrcoef(X,Y,varargin) +% CORRCOEF calculates the correlation matrix from pairwise correlations. +% The input data can contain missing values encoded with NaN. +% Missing data (NaN's) are handled by pairwise deletion [15]. +% In order to avoid possible pitfalls, use case-wise deletion or +% or check the correlation of NaN's with your data (see below). +% A significance test for testing the Hypothesis +% 'correlation coefficient R is significantly different to zero' +% is included. +% +% [...] = CORRCOEF(X); +% calculates the (auto-)correlation matrix of X +% [...] = CORRCOEF(X,Y); +% calculates the crosscorrelation between X and Y +% +% [...] = CORRCOEF(..., Mode); +% Mode='Pearson' or 'parametric' [default] +% gives the correlation coefficient +% also known as the 'product-moment coefficient of correlation' +% or 'Pearson''s correlation' [1] +% Mode='Spearman' gives 'Spearman''s Rank Correlation Coefficient' +% This replaces SPEARMAN.M +% Mode='Rank' gives a nonparametric Rank Correlation Coefficient +% This is the "Spearman rank correlation with proper handling of ties" +% This replaces RANKCORR.M +% +% [...] = CORRCOEF(..., param1, value1, param2, value2, ... ); +% param value +% 'Mode' type of correlation +% 'Pearson','parametric' +% 'Spearman' +% 'rank' +% 'rows' how do deal with missing values encoded as NaN's. +% 'complete': remove all rows with at least one NaN +% 'pairwise': [default] +% 'alpha' 0.01 : significance level to compute confidence interval +% +% [R,p,ci1,ci2,nansig] = CORRCOEF(...); +% R is the correlation matrix +% R(i,j) is the correlation coefficient r between X(:,i) and Y(:,j) +% p gives the significance of R +% It tests the null hypothesis that the product moment correlation coefficient is zero +% using Student's t-test on the statistic t = r*sqrt(N-2)/sqrt(1-r^2) +% where N is the number of samples (Statistics, M. Spiegel, Schaum series). +% p > alpha: do not reject the Null hypothesis: 'R is zero'. +% p < alpha: The alternative hypothesis 'R is larger than zero' is true with probability (1-alpha). +% ci1 lower (1-alpha) confidence interval +% ci2 upper (1-alpha) confidence interval +% If no alpha is provided, the default alpha is 0.01. This can be changed with function flag_implicit_significance. +% nan_sig p-value whether H0: 'NaN''s are not correlated' could be correct +% if nan_sig < alpha, H1 ('NaNs are correlated') is very likely. +% +% The result is only valid if the occurence of NaN's is uncorrelated. In +% order to avoid this pitfall, the correlation of NaN's should be checked +% or case-wise deletion should be applied. +% Case-Wise deletion can be implemented +% ix = ~any(isnan([X,Y]),2); +% [...] = CORRCOEF(X(ix,:),Y(ix,:),...); +% +% Correlation (non-random distribution) of NaN's can be checked with +% [nan_R,nan_sig]=corrcoef(X,isnan(X)) +% or [nan_R,nan_sig]=corrcoef([X,Y],isnan([X,Y])) +% or [R,p,ci1,ci2] = CORRCOEF(...); +% +% Further recommandation related to the correlation coefficient: +% + LOOK AT THE SCATTERPLOTS to make sure that the relationship is linear +% + Correlation is not causation because +% it is not clear which parameter is 'cause' and which is 'effect' and +% the observed correlation between two variables might be due to the action of other, unobserved variables. +% +% see also: SUMSKIPNAN, COVM, COV, COR, SPEARMAN, RANKCORR, RANKS, +% PARTCORRCOEF, flag_implicit_significance +% +% REFERENCES: +% on the correlation coefficient +% [ 1] http://mathworld.wolfram.com/CorrelationCoefficient.html +% [ 2] http://www.geography.btinternet.co.uk/spearman.htm +% [ 3] Hogg, R. V. and Craig, A. T. Introduction to Mathematical Statistics, 5th ed. New York: Macmillan, pp. 338 and 400, 1995. +% [ 4] Lehmann, E. L. and D'Abrera, H. J. M. Nonparametrics: Statistical Methods Based on Ranks, rev. ed. Englewood Cliffs, NJ: Prentice-Hall, pp. 292, 300, and 323, 1998. +% [ 5] Press, W. H.; Flannery, B. P.; Teukolsky, S. A.; and Vetterling, W. T. Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: Cambridge University Press, pp. 634-637, 1992 +% [ 6] http://mathworld.wolfram.com/SpearmanRankCorrelationCoefficient.html +% on the significance test of the correlation coefficient +% [11] http://www.met.rdg.ac.uk/cag/STATS/corr.html +% [12] http://www.janda.org/c10/Lectures/topic06/L24-significanceR.htm +% [13] http://faculty.vassar.edu/lowry/ch4apx.html +% [14] http://davidmlane.com/hyperstat/B134689.html +% [15] http://www.statsoft.com/textbook/stbasic.html%Correlations +% others +% [20] http://www.tufts.edu/~gdallal/corr.htm +% [21] Fisher transformation http://en.wikipedia.org/wiki/Fisher_transformation + +% $Id: corrcoef.m 9387 2011-12-15 10:42:14Z schloegl $ +% Copyright (C) 2000-2004,2008,2009,2011 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +% Features: +% + handles missing values (encoded as NaN's) +% + pairwise deletion of missing data +% + checks independence of missing values (NaNs) +% + parametric and non-parametric (rank) correlation +% + Pearson's correlation +% + Spearman's rank correlation +% + Rank correlation (non-parametric, Spearman rank correlation with proper handling of ties) +% + is fast, using an efficient algorithm O(n.log(n)) for calculating the ranks +% + significance test for null-hypthesis: r=0 +% + confidence interval included +% - rank correlation works for cell arrays, too (no check for missing values). +% + compatible with Octave and Matlab + +global FLAG_NANS_OCCURED; + +NARG = nargout; % needed because nargout is not reentrant in Octave, and corrcoef is recursive +mode = []; + +if nargin==1 + Y = []; + Mode='Pearson'; +elseif nargin==0 + fprintf(2,'Error CORRCOEF: Missing argument(s)\n'); +elseif nargin>1 + if ischar(Y) + varg = [Y,varargin]; + Y=[]; + else + varg = varargin; + end; + + if length(varg)<1, + Mode = 'Pearson'; + elseif length(varg)==1, + Mode = varg{1}; + else + for k = 2:2:length(varg), + mode = setfield(mode,lower(varg{k-1}),varg{k}); + end; + if isfield(mode,'mode') + Mode = mode.mode; + end; + end; +end; +if isempty(Mode) Mode='pearson'; end; +Mode=[Mode,' ']; + + + +FLAG_WARNING = warning; % save warning status +warning('off'); + +[r1,c1]=size(X); +if ~isempty(Y) + [r2,c2]=size(Y); + if r1~=r2, + fprintf(2,'Error CORRCOEF: X and Y must have the same number of observations (rows).\n'); + return; + end; + NN = real(~isnan(X)')*real(~isnan(Y)); +else + [r2,c2]=size(X); + NN = real(~isnan(X)')*real(~isnan(X)); +end; + +%%%%% generate combinations using indices for pairwise calculation of the correlation +YESNAN = any(isnan(X(:))) | any(isnan(Y(:))); +if YESNAN, + FLAG_NANS_OCCURED=(1==1); + if isfield(mode,'rows') + if strcmp(mode.rows,'complete') + ix = ~any([X,Y],2); + X = X(ix,:); + if ~isempty(Y) + Y = Y(ix,:); + end; + YESNAN = 0; + NN = size(X,1); + elseif strcmp(mode.rows,'all') + fprintf(1,'Warning: data contains NaNs, rows=pairwise is used.'); + %%NN(NN < size(X,1)) = NaN; + elseif strcmp(mode.rows,'pairwise') + %%% default + end; + end; +end; +if isempty(Y), + IX = ones(c1)-diag(ones(c1,1)); + [jx, jy ] = find(IX); + [jxo,jyo] = find(IX); + R = eye(c1); +else + IX = sparse([],[],[],c1+c2,c1+c2,c1*c2); + IX(1:c1,c1+(1:c2)) = 1; + [jx,jy] = find(IX); + + IX = ones(c1,c2); + [jxo,jyo] = find(IX); + R = zeros(c1,c2); +end; + +if strcmp(lower(Mode(1:7)),'pearson'); + % see http://mathworld.wolfram.com/CorrelationCoefficient.html + if ~YESNAN, + [S,N,SSQ] = sumskipnan(X,1); + if ~isempty(Y), + [S2,N2,SSQ2] = sumskipnan(Y,1); + CC = X'*Y; + M1 = S./N; + M2 = S2./N2; + cc = CC./NN - M1'*M2; + R = cc./sqrt((SSQ./N-M1.*M1)'*(SSQ2./N2-M2.*M2)); + else + CC = X'*X; + M = S./N; + cc = CC./NN - M'*M; + v = SSQ./N - M.*M; %max(N-1,0); + R = cc./sqrt(v'*v); + end; + else + if ~isempty(Y), + X = [X,Y]; + end; + for k = 1:length(jx), + %ik = ~any(isnan(X(:,[jx(k),jy(k)])),2); + ik = ~isnan(X(:,jx(k))) & ~isnan(X(:,jy(k))); + [s,n,s2] = sumskipnan(X(ik,[jx(k),jy(k)]),1); + v = (s2-s.*s./n)./n; + cc = X(ik,jx(k))'*X(ik,jy(k)); + cc = cc/n(1) - prod(s./n); + %r(k) = cc./sqrt(prod(v)); + R(jxo(k),jyo(k)) = cc./sqrt(prod(v)); + end; + end + +elseif strcmp(lower(Mode(1:4)),'rank'); + % see [ 6] http://mathworld.wolfram.com/SpearmanRankCorrelationCoefficient.html + if ~YESNAN, + if isempty(Y) + R = corrcoef(ranks(X)); + else + R = corrcoef(ranks(X),ranks(Y)); + end; + else + if ~isempty(Y), + X = [X,Y]; + end; + for k = 1:length(jx), + %ik = ~any(isnan(X(:,[jx(k),jy(k)])),2); + ik = ~isnan(X(:,jx(k))) & ~isnan(X(:,jy(k))); + il = ranks(X(ik,[jx(k),jy(k)])); + R(jxo(k),jyo(k)) = corrcoef(il(:,1),il(:,2)); + end; + X = ranks(X); + end; + +elseif strcmp(lower(Mode(1:8)),'spearman'); + % see [ 6] http://mathworld.wolfram.com/SpearmanRankCorrelationCoefficient.html + if ~isempty(Y), + X = [X,Y]; + end; + + n = repmat(nan,c1,c2); + + if ~YESNAN, + iy = ranks(X); % calculates ranks; + + for k = 1:length(jx), + [R(jxo(k),jyo(k)),n(jxo(k),jyo(k))] = sumskipnan((iy(:,jx(k)) - iy(:,jy(k))).^2); % NN is the number of non-missing values + end; + else + for k = 1:length(jx), + %ik = ~any(isnan(X(:,[jx(k),jy(k)])),2); + ik = ~isnan(X(:,jx(k))) & ~isnan(X(:,jy(k))); + il = ranks(X(ik,[jx(k),jy(k)])); + % NN is the number of non-missing values + [R(jxo(k),jyo(k)),n(jxo(k),jyo(k))] = sumskipnan((il(:,1) - il(:,2)).^2); + end; + X = ranks(X); + end; + R = 1 - 6 * R ./ (n.*(n.*n-1)); + +elseif strcmp(lower(Mode(1:7)),'partial'); + fprintf(2,'Error CORRCOEF: use PARTCORRCOEF \n',Mode); + + return; + +elseif strcmp(lower(Mode(1:7)),'kendall'); + fprintf(2,'Error CORRCOEF: mode ''%s'' not implemented yet.\n',Mode); + + return; +else + fprintf(2,'Error CORRCOEF: unknown mode ''%s''\n',Mode); +end; + +if (NARG<2), + warning(FLAG_WARNING); % restore warning status + return; +end; + + +% CONFIDENCE INTERVAL +if isfield(mode,'alpha') + alpha = mode.alpha; +elseif exist('flag_implicit_significance','file'), + alpha = flag_implicit_significance; +else + alpha = 0.01; +end; +% fprintf(1,'CORRCOEF: confidence interval is based on alpha=%f\n',alpha); + + +% SIGNIFICANCE TEST +R(isnan(R))=0; +tmp = 1 - R.*R; +tmp(tmp<0) = 0; % prevent tmp<0 i.e. imag(t)~=0 +t = R.*sqrt(max(NN-2,0)./tmp); + +if exist('t_cdf','file'); + sig = t_cdf(t,NN-2); +elseif exist('tcdf','file')>1; + sig = tcdf(t,NN-2); +else + fprintf('CORRCOEF: significance test not completed because of missing TCDF-function\n') + sig = repmat(nan,size(R)); +end; +sig = 2 * min(sig,1 - sig); + + +if NARG<3, + warning(FLAG_WARNING); % restore warning status + return; +end; + + +tmp = R; +%tmp(ix1 | ix2) = nan; % avoid division-by-zero warning +z = log((1+tmp)./(1-tmp))/2; % Fisher transformation [21] +%sz = 1./sqrt(NN-3); % standard error of z +sz = sqrt(2)*erfinv(1-alpha)./sqrt(NN-3); % confidence interval for alpha of z + +ci1 = tanh(z-sz); +ci2 = tanh(z+sz); + +%ci1(isnan(ci1))=R(isnan(ci1)); % in case of isnan(ci), the interval limits are exactly the R value +%ci2(isnan(ci2))=R(isnan(ci2)); + +if (NARG<5) || ~YESNAN, + nan_sig = repmat(NaN,size(R)); + warning(FLAG_WARNING); % restore warning status + return; +end; + +%%%%% ----- check independence of NaNs (missing values) ----- +[nan_R, nan_sig] = corrcoef(X,double(isnan(X))); + +% remove diagonal elements, because these have not any meaning % +nan_sig(isnan(nan_R)) = nan; +% remove diagonal elements, because these have not any meaning % +nan_R(isnan(nan_R)) = 0; + +if 0, any(nan_sig(:) < alpha), + tmp = nan_sig(:); % Hack to skip NaN's in MIN(X) + min_sig = min(tmp(~isnan(tmp))); % Necessary, because Octave returns NaN rather than min(X) for min(NaN,X) + fprintf(1,'CORRCOFF Warning: Missing Values (i.e. NaNs) are not independent of data (p-value=%f)\n', min_sig); + fprintf(1,' Its recommended to remove all samples (i.e. rows) with any missing value (NaN).\n'); + fprintf(1,' The null-hypotheses (NaNs are uncorrelated) is rejected for the following parameter pair(s).\n'); + [ix,iy] = find(nan_sig < alpha); + disp([ix,iy]) +end; + +%%%%% ----- end of independence check ------ + +warning(FLAG_WARNING); % restore warning status +return; + diff --git a/octave_packages/nan-2.5.5/cov.m b/octave_packages/nan-2.5.5/cov.m new file mode 100644 index 0000000..49de763 --- /dev/null +++ b/octave_packages/nan-2.5.5/cov.m @@ -0,0 +1,95 @@ +function CC = cov(X,Y,Mode) +% COV covariance matrix +% X and Y can contain missing values encoded with NaN. +% NaN's are skipped, NaN do not result in a NaN output. +% The output gives NaN only if there are insufficient input data +% The mean is removed from the data. +% +% Remark: for data contains missing values, the resulting +% matrix might not be positiv definite, and its elements have magnitudes +% larger than one. This ill-behavior is more likely for small sample +% sizes, but there is no garantee that the result "behaves well" for larger +% sample sizes. If you want the a "well behaved" result (i.e. positive +% definiteness and magnitude of elements not larger than 1), use CORRCOEF. +% However, COV is faster than CORRCOEF and might be good enough in some cases. +% +% C = COV(X [,Mode]); +% calculates the (auto-)correlation matrix of X +% C = COV(X,Y [,Mode]); +% calculates the crosscorrelation between X and Y. +% C(i,j) is the correlation between the i-th and jth +% column of X and Y, respectively. +% NOTE: Octave and Matlab have (in some special cases) incompatible implemenations. +% This implementation follows Octave. If the result could be ambigous or +% incompatible, a warning will be presented in Matlab. To avoid this warning use: +% a) use COV([X(:),Y(:)]) if you want the traditional Matlab result. +% b) use C = COV([X,Y]), C = C(1:size(X,2),size(X,2)+1:size(C,2)); if you want to be compatible with this software. +% +% Mode = 0 [default] scales C by (N-1) +% Mode = 1 scales C by N. +% +% see also: COVM, COR, CORRCOEF, SUMSKIPNAN +% +% REFERENCES: +% http://mathworld.wolfram.com/Covariance.html + +% $Id: cov.m 9803 2012-03-09 20:03:49Z schloegl $ +% Copyright (C) 2000-2003,2005,2009,2011,2012 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% 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 . + + +if nargin==1 + Mode = 0; + Y = []; +elseif nargin==2, + % if all(size(Y)==1) & any(Y==[0,1]); % This is not compatible with octave + % short-circuit evaluation is required + % but for compatibility to matlab, && is avoided + SW = all(size(Y)==1); + if SW, SW = any(Y==[0,1]); end; + if SW, + Mode = Y; + Y = []; + else + Mode = 0; + end; +elseif nargin==3, + +else + fprintf(2,'Error COV: invalid number of arguments\n'); +end; + +if ~exist('OCTAVE_VERSION','builtin') && ~isempty(Y) && (size(X,2)+size(Y,2)~=2), + % COV in Matlab is differently defined than COV in Octave. + % For compatibility reasons, this branch reflects the difference. + fprintf(2,'Warning NaN/COV: This kind of use of COV is discouraged because it produces different results for Matlab and Octave. \n'); + fprintf(2,' (a) the traditional Matlab result can be obtained with: C = COV([X(:),Y(:)]).\n'); + fprintf(2,' (b) the traditional Octave result can be obtained with: C = COV([X,Y]); C = C(1:size(X,2),size(X,2)+1:size(C,2)).\n'); + + if numel(Y)~=numel(X), + error('The lengths of X and Y must match.'); + end; + X = [X(:),Y(:)]; + Y = []; +end; + +if isempty(Y) + CC = covm(X,['D',int2str(Mode>0)]); +else + CC = covm(X,Y,['D',int2str(Mode>0)]); +end; + diff --git a/octave_packages/nan-2.5.5/covm.m b/octave_packages/nan-2.5.5/covm.m new file mode 100644 index 0000000..91602bf --- /dev/null +++ b/octave_packages/nan-2.5.5/covm.m @@ -0,0 +1,248 @@ +function [CC,NN] = covm(X,Y,Mode,W) +% COVM generates covariance matrix +% X and Y can contain missing values encoded with NaN. +% NaN's are skipped, NaN do not result in a NaN output. +% The output gives NaN only if there are insufficient input data +% +% COVM(X,Mode); +% calculates the (auto-)correlation matrix of X +% COVM(X,Y,Mode); +% calculates the crosscorrelation between X and Y +% COVM(...,W); +% weighted crosscorrelation +% +% Mode = 'M' minimum or standard mode [default] +% C = X'*X; or X'*Y correlation matrix +% +% Mode = 'E' extended mode +% C = [1 X]'*[1 X]; % l is a matching column of 1's +% C is additive, i.e. it can be applied to subsequent blocks and summed up afterwards +% the mean (or sum) is stored on the 1st row and column of C +% +% Mode = 'D' or 'D0' detrended mode +% the mean of X (and Y) is removed. If combined with extended mode (Mode='DE'), +% the mean (or sum) is stored in the 1st row and column of C. +% The default scaling is factor (N-1). +% Mode = 'D1' is the same as 'D' but uses N for scaling. +% +% C = covm(...); +% C is the scaled by N in Mode M and by (N-1) in mode D. +% [C,N] = covm(...); +% C is not scaled, provides the scaling factor N +% C./N gives the scaled version. +% +% see also: DECOVM, XCOVF + +% $Id: covm.m 9032 2011-11-08 20:25:36Z schloegl $ +% Copyright (C) 2000-2005,2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + +global FLAG_NANS_OCCURED; + +if nargin<3, + W = []; + if nargin==2, + if isnumeric(Y), + Mode='M'; + else + Mode=Y; + Y=[]; + end; + elseif nargin==1, + Mode = 'M'; + Y = []; + elseif nargin==0, + error('Missing argument(s)'); + end; + +elseif (nargin==3) && isnumeric(Y) && ~isnumeric(Mode); + W = []; + +elseif (nargin==3) && ~isnumeric(Y) && isnumeric(Mode); + W = Mode; + Mode = Y; + Y = []; + +elseif (nargin==4) && ~isnumeric(Mode) && isnumeric(Y); + ; %% ok +else + error('invalid input arguments'); +end; + +Mode = upper(Mode); + +[r1,c1]=size(X); +if ~isempty(Y) + [r2,c2]=size(Y); + if r1~=r2, + error('X and Y must have the same number of observations (rows).'); + end; +else + [r2,c2]=size(X); +end; + +persistent mexFLAG2; +persistent mexFLAG; +if isempty(mexFLAG2) + mexFLAG2 = exist('covm_mex','file'); +end; +if isempty(mexFLAG) + mexFLAG = exist('sumskipnan_mex','file'); +end; + + +if ~isempty(W) + W = W(:); + if (r1~=numel(W)) + error('Error COVM: size of weight vector does not fit number of rows'); + end; + %w = spdiags(W(:),0,numel(W),numel(W)); + %nn = sum(W(:)); + nn = sum(W); +else + nn = r1; +end; + + +if mexFLAG2 && mexFLAG && ~isempty(W), + %% the mex-functions here are much slower than the m-scripts below + %% however, the mex-functions support weighting of samples. + if isempty(FLAG_NANS_OCCURED), + %% mex-files require that FLAG_NANS_OCCURED is not empty, + %% otherwise, the status of NAN occurence can not be returned. + FLAG_NANS_OCCURED = logical(0); % default value + end; + + if any(Mode=='D') || any(Mode=='E'), + [S1,N1] = sumskipnan(X,1,W); + if ~isempty(Y) + [S2,N2] = sumskipnan(Y,1,W); + else + S2 = S1; N2 = N1; + end; + if any(Mode=='D'), % detrending mode + X = X - ones(r1,1)*(S1./N1); + if ~isempty(Y) + Y = Y - ones(r1,1)*(S2./N2); + end; + end; + end; + + [CC,NN] = covm_mex(real(X), real(Y), FLAG_NANS_OCCURED, W); + %% complex matrices + if ~isreal(X) && ~isreal(Y) + [iCC,inn] = covm_mex(imag(X), imag(Y), FLAG_NANS_OCCURED, W); + CC = CC + iCC; + end; + if isempty(Y) Y = X; end; + if ~isreal(X) + [iCC,inn] = covm_mex(imag(X), real(Y), FLAG_NANS_OCCURED, W); + CC = CC - i*iCC; + end; + if ~isreal(Y) + [iCC,inn] = covm_mex(real(X), imag(Y), FLAG_NANS_OCCURED, W); + CC = CC + i*iCC; + end; + + if any(Mode=='D') && ~any(Mode=='1'), % 'D1' + NN = max(NN-1,0); + end; + if any(Mode=='E'), % extended mode + NN = [nn, N2; N1', NN]; + CC = [nn, S2; S1', CC]; + end; + + +elseif ~isempty(W), + + error('Error COVM: weighted COVM requires sumskipnan_mex and covm_mex but it is not available'); + + %% weighted covm without mex-file support + %% this part is not working. + +elseif ~isempty(Y), + if (~any(Mode=='D') && ~any(Mode=='E')), % if Mode == M + NN = real(X==X)'*real(Y==Y); + FLAG_NANS_OCCURED = any(NN(:). + +% $Id$ +% Copyright (C) 2011 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +%%% TODO: implement as mex-function + +i = isnan(x); +x(i) = 0; + +if nargin==2, + x = cumsum(x,DIM); + x(i) = NaN; +elseif nargin==1, + x = cumsum(x); + x(i) = NaN; +else + help cumsumskipnan +end; + + + diff --git a/octave_packages/nan-2.5.5/decovm.m b/octave_packages/nan-2.5.5/decovm.m new file mode 100644 index 0000000..401a5fe --- /dev/null +++ b/octave_packages/nan-2.5.5/decovm.m @@ -0,0 +1,78 @@ +function [mu,sd,COV,xc,M,R2]=decovm(XCN,NN) +% decompose extended covariance matrix into mean (mu), +% standard deviation, the (pure) Covariance (COV), +% correlation (xc) matrix and the correlation coefficients R2. +% NaN's are condsidered as missing values. +% [mu,sd,COV,xc,N,R2]=decovm(ECM[,NN]) +% +% ECM is the extended covariance matrix +% NN is the number of elements, each estimate (in ECM) is based on +% +% see also: MDBC, COVM, R2 + +% $Id: decovm.m 2140 2009-07-02 12:03:55Z schloegl $ +% Copyright (c) 1999-2002,2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 3 +% of the License, or (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + +[r,c]=size(XCN); +if r~=c, + fprintf(2,'Warning DECOVM: input argument is not a square matrix\n'); + XCN = ecovm(XCN); + c = c + 1; +else + M = XCN(1,1); + if nargin<2, + XCN = XCN/(XCN(1,1)); + else %if nargin==2 + XCN = XCN./(NN); + end; + + if any(isnan(XCN(:))), + warning('DECOVM: Extended Covariance Matrix should not contain NaN''s'); + end; + if 0, %det(XCN)<0; % check removed for performance reasons + warning('DECOVM: Extended Covariance Matrix must be non-negative definite'); + end; +end; + +mu = XCN(1,2:c); +COV = XCN(2:c,2:c) - mu'*mu; +sd = sqrt(diag(COV))'; +if nargout<4, return; end; +xc = COV./(sd'*sd); +M = XCN(1,1); +if nargout<6, return; end; +R2 = xc.*xc; + +return; + +mu=XCN(2:N,1)/XCN(1,1); +COV=(XCN(2:N,2:N)/XCN(1,1)-XCN(2:N,1)*XCN(1,2:N)/XCN(1,1)^2); +sd=sqrt(diag(COV)); +xc=COV./(sd*sd'); + +% function [ECM] = ecovm(signal); +% Generates extended Covariance matrix, +% ECM= [l signal]'*[l signal]; % l is a matching column of 1's +% ECM is additive, i.e. it can be applied to subsequent blocks and summed up afterwards +% [ECM1] = ecovm(s1); +% [ECM2] = ecovm(s1); +% [ECM] = ecovm([s1;s2]); +% ECM1+ECM2==ECM; +% +% SS=sum(signal); ECM=[[size(signal,1),SS];[SS',signal'*signal]]; diff --git a/octave_packages/nan-2.5.5/detrend.m b/octave_packages/nan-2.5.5/detrend.m new file mode 100644 index 0000000..a49ac72 --- /dev/null +++ b/octave_packages/nan-2.5.5/detrend.m @@ -0,0 +1,157 @@ +function [X,T]=detrend(t,X,p) +% DETREND removes the trend from data, NaN's are considered as missing values +% +% DETREND is fully compatible to previous Matlab and Octave DETREND with the following features added: +% - handles NaN's by assuming that these are missing values +% - handles unequally spaced data +% - second output parameter gives the trend of the data +% - compatible to Matlab and Octave +% +% [...]=detrend([t,] X [,p]) +% removes trend for unequally spaced data +% t represents the time points +% X(i) is the value at time t(i) +% p must be a scalar +% +% [...]=detrend(X,0) +% [...]=detrend(X,'constant') +% removes the mean +% +% [...]=detrend(X,p) +% removes polynomial of order p (default p=1) +% +% [...]=detrend(X,1) - default +% [...]=detrend(X,'linear') +% removes linear trend +% +% [X,T]=detrend(...) +% +% X is the detrended data +% T is the removed trend +% +% see also: SUMSKIPNAN, ZSCORE + +% 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 . + + +% Copyright (C) 1995, 1996 Kurt Hornik +% $Id: detrend.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2001,2007 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +if (nargin == 1) + p = 1; + X = t; + t = []; +elseif (nargin == 2) + if strcmpi(X,'constant'), + p = 0; + X = t; + t = []; + elseif strcmpi(X,'linear'), + p = 1; + X = t; + t = []; + elseif ischar(X) + error('unknown 2nd input argument'); + elseif all(size(X)==1), + p = X; + X = t; + t = []; + else + p = 1; + end; +elseif (nargin == 3) + if ischar(X), + warning('input arguments are not supported'); + end; + +elseif (nargin > 3) + fprintf (1,'usage: detrend (x [, p])\n'); +end; + +% check data, must be in culomn order +[m, n] = size (X); +if (m == 1) + X = X'; + r=n; +else + r=m; +end +% check time scale +if isempty(t), + t = (1:r).'; % make time scale +elseif ~all(size(t)==size(X)) + t = t(:); +end; +% check dimension of t and X +if ~all(size(X,1)==size(t,1)) + fprintf (2,'detrend: size(t,1) must same as size(x,1) \n'); +end; +% check the order of the polynomial +if (~(all(size(p)==1) && (p == round (p)) && (p >= 0))) + fprintf (2,'detrend: p must be a nonnegative integer\n'); +end + +if (nargout>1) , % needs more memory + T = zeros(size(X))+nan; + %T=repmat(nan,size(X)); % not supported by Octave 2.0.16 + + + if (size(t,2)>1), % for multiple time scales + for k=1:size(X,2), + idx=find(~isnan(X(:,k))); + b = (t(idx,k) * ones (1, p + 1)) .^ (ones (length(idx),1) * (0 : p)); + T(idx,k) = b * (b \ X(idx,k)); + end; + + else % if only one time scale is used + b = (t * ones (1, p + 1)) .^ (ones (length(t),1) * (0 : p)); + for k=1:size(X,2), + idx=find(~isnan(X(:,k))); + T(idx,k) = b(idx,:) * (b(idx,:) \ X(idx,k)); + %X(idx,k) = X(idx,k) - T(idx,k); % 1st alternative implementation + %X(:,k) = X(:,k) - T(:,k); % 2nd alternative + end; + end; + X = X-T; % 3nd alternative + + if (m == 1) + X = X'; + T = T'; + end +else % needs less memory + if (size(t,2)>1), % for multiple time scales + for k = 1:size(X,2), + idx = find(~isnan(X(:,k))); + b = (t(idx,k) * ones (1, p + 1)) .^ (ones (length(idx),1) * (0 : p)); + X(idx,k) = X(idx,k) - b * (b \ X(idx,k)); + end; + else % if only one time scale is used + b = (t * ones (1, p + 1)) .^ (ones (length(t),1) * (0 : p)); + for k = 1:size(X,2), + idx = find(~isnan(X(:,k))); + X(idx,k) = X(idx,k) - b(idx,:) * (b(idx,:) \ X(idx,k)); + end; + end; + + if (m == 1) + X = X'; + end +end; + + + diff --git a/octave_packages/nan-2.5.5/doc-cache b/octave_packages/nan-2.5.5/doc-cache new file mode 100644 index 0000000..d7ed2d4 --- /dev/null +++ b/octave_packages/nan-2.5.5/doc-cache @@ -0,0 +1,3690 @@ +# Created by Octave 3.6.1, Mon Apr 23 21:08:02 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 81 +# name: +# type: sq_string +# elements: 1 +# length: 12 +bland_altman + + +# name: +# type: sq_string +# elements: 1 +# length: 865 + BLAND_ALTMANN shows the Bland-Altman plot of two columns of measurements + and computes several summary results. + + bland_altman(m1, m2 [,group]) + bland_altman(data [, group]) + R = bland_altman(...) + + m1,m2 are two colums with the same number of elements + containing the measurements. m1,m2 can be also combined + in a single two column data matrix. + group [optional] indicates which measurements belong to the same group + This is useful to account for repeated measurements. + + + References: + [1] JM Bland and DG Altman, Measuring agreement in method comparison studies. + Statistical Methods in Medical Research, 1999; 8; 135. + doi:10.1177/09622802990080204 + [2] P.S. Myles, Using the Bland– Altman method to measure agreement with repeated measures + British Journal of Anaesthesia 99(3):309–11 (2007) + doi:10.1093/bja/aem214 + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + BLAND_ALTMANN shows the Bland-Altman plot of two columns of measurements + and + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +cat2bin + + +# name: +# type: sq_string +# elements: 1 +# length: 755 + CAT2BIN converts categorial into binary data + each category of each column in D is converted into a logical column + + B = cat2bin(C); + [B,BinLabel] = cat2bin(C,Label); + [B,BinLabel] = cat2bin(C,Label,MODE) + + C categorial data + B binary data + Label description of each column in C + BinLabel description of each column in B + MODE default [], ignores NaN + 'notIgnoreNAN' includes binary column for NaN + 'IgnoreZeros' zeros do not get a separate category + 'IgnoreZeros+NaN' zeros and NaN are ignored + + example: + cat2bin([1;2;5;1;5]) results in + 1 0 0 + 0 1 0 + 0 0 1 + 1 0 0 + 0 0 1 + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + CAT2BIN converts categorial into binary data + each category of each column i + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +cdfplot + + +# name: +# type: sq_string +# elements: 1 +# length: 565 + CDFPLOT plots empirical commulative distribution function + + cdfplot(X) + cdfplot(X, FMT) + cdfplot(X, PROPERTY, VALUE,...) + h = cdfplot(...) + [h,stats] = cdfplot(X) + + X contains the data vector + (matrix data is currently changed to a vector, this might change in future) + FMT,PROPERTY,VALUE + are used for formating; see HELP PLOT for more details + h graphics handle to the cdf curve + stats + a struct containing various summary statistics including + mean, std, median, min, max. + + see also: ecdf, median, statistics, hist2res, plot + + References: + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 + CDFPLOT plots empirical commulative distribution function + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +center + + +# name: +# type: sq_string +# elements: 1 +# length: 505 + CENTER removes the mean + + [z,mu] = center(x,DIM,W) + removes mean x along dimension DIM + + x input data + DIM dimension + 1: column + 2: row + default or []: first DIMENSION, with more than 1 element + W weights to computed weighted mean (default: [], all weights = 1) + numel(W) must be equal to size(x,DIM) + + features: + - can deal with NaN's (missing values) + - weighting of data + - dimension argument + - compatible to Matlab and Octave + + see also: SUMSKIPNAN, MEAN, STD, DETREND, ZSCORE + + REFERENCE(S): + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 + CENTER removes the mean + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +classify + + +# name: +# type: sq_string +# elements: 1 +# length: 792 + CLASSIFY classifies sample data into categories + defined by the training data and its group information + + CLASS = classify(sample, training, group) + CLASS = classify(sample, training, group, TYPE) + [CLASS,ERR,POSTERIOR,LOGP,COEF] = CLASSIFY(...) + + CLASS contains the assigned group. + ERR is the classification error on the training set weighted by the + prior propability of each group. + + The same classifier as in TRAIN_SC are supported. + + ATTENTION: no cross-validation is applied, therefore the + classification error is too optimistic (overfitting). + Use XVAL instead to obtain cross-validated performance. + + see also: TRAIN_SC, TEST_SC, XVAL + + References: + [1] R. Duda, P. Hart, and D. Stork, Pattern Classification, second ed. + John Wiley & Sons, 2001. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + CLASSIFY classifies sample data into categories + defined by the training data + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +coefficient_of_variation + + +# name: +# type: sq_string +# elements: 1 +# length: 221 + COEFFICIENT_OF_VARIATION returns STD(X)/MEAN(X) + + cv=coefficient_of_variation(x [,DIM]) + cv=std(x)/mean(x) + + see also: SUMSKIPNAN, MEAN, STD + + REFERENCE(S): + http://mathworld.wolfram.com/VariationCoefficient.html + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + COEFFICIENT_OF_VARIATION returns STD(X)/MEAN(X) + + cv=coefficient_of_variation( + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +cor + + +# name: +# type: sq_string +# elements: 1 +# length: 576 + COR calculates the correlation matrix + X and Y can contain missing values encoded with NaN. + NaN's are skipped, NaN do not result in a NaN output. + (Its assumed that the occurence of NaN's is uncorrelated) + The output gives NaN only if there are insufficient input data + + COR(X); + calculates the (auto-)correlation matrix of X + COR(X,Y); + calculates the crosscorrelation between X and Y + + c = COR(...); + c is the correlation matrix + + W weights to compute weighted mean (default: []) + if W=[], all weights are 1. + number of elements in W must match size(x,DIM) + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + COR calculates the correlation matrix + X and Y can contain missing values encod + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +corrcoef + + +# name: +# type: sq_string +# elements: 1 +# length: 4692 + CORRCOEF calculates the correlation matrix from pairwise correlations. + The input data can contain missing values encoded with NaN. + Missing data (NaN's) are handled by pairwise deletion [15]. + In order to avoid possible pitfalls, use case-wise deletion or + or check the correlation of NaN's with your data (see below). + A significance test for testing the Hypothesis + 'correlation coefficient R is significantly different to zero' + is included. + + [...] = CORRCOEF(X); + calculates the (auto-)correlation matrix of X + [...] = CORRCOEF(X,Y); + calculates the crosscorrelation between X and Y + + [...] = CORRCOEF(..., Mode); + Mode='Pearson' or 'parametric' [default] + gives the correlation coefficient + also known as the 'product-moment coefficient of correlation' + or 'Pearson''s correlation' [1] + Mode='Spearman' gives 'Spearman''s Rank Correlation Coefficient' + This replaces SPEARMAN.M + Mode='Rank' gives a nonparametric Rank Correlation Coefficient + This is the "Spearman rank correlation with proper handling of ties" + This replaces RANKCORR.M + + [...] = CORRCOEF(..., param1, value1, param2, value2, ... ); + param value + 'Mode' type of correlation + 'Pearson','parametric' + 'Spearman' + 'rank' + 'rows' how do deal with missing values encoded as NaN's. + 'complete': remove all rows with at least one NaN + 'pairwise': [default] + 'alpha' 0.01 : significance level to compute confidence interval + + [R,p,ci1,ci2,nansig] = CORRCOEF(...); + R is the correlation matrix + R(i,j) is the correlation coefficient r between X(:,i) and Y(:,j) + p gives the significance of R + It tests the null hypothesis that the product moment correlation coefficient is zero + using Student's t-test on the statistic t = r*sqrt(N-2)/sqrt(1-r^2) + where N is the number of samples (Statistics, M. Spiegel, Schaum series). + p > alpha: do not reject the Null hypothesis: 'R is zero'. + p < alpha: The alternative hypothesis 'R is larger than zero' is true with probability (1-alpha). + ci1 lower (1-alpha) confidence interval + ci2 upper (1-alpha) confidence interval + If no alpha is provided, the default alpha is 0.01. This can be changed with function flag_implicit_significance. + nan_sig p-value whether H0: 'NaN''s are not correlated' could be correct + if nan_sig < alpha, H1 ('NaNs are correlated') is very likely. + + The result is only valid if the occurence of NaN's is uncorrelated. In + order to avoid this pitfall, the correlation of NaN's should be checked + or case-wise deletion should be applied. + Case-Wise deletion can be implemented + ix = ~any(isnan([X,Y]),2); + [...] = CORRCOEF(X(ix,:),Y(ix,:),...); + + Correlation (non-random distribution) of NaN's can be checked with + [nan_R,nan_sig]=corrcoef(X,isnan(X)) + or [nan_R,nan_sig]=corrcoef([X,Y],isnan([X,Y])) + or [R,p,ci1,ci2] = CORRCOEF(...); + + Further recommandation related to the correlation coefficient: + + LOOK AT THE SCATTERPLOTS to make sure that the relationship is linear + + Correlation is not causation because + it is not clear which parameter is 'cause' and which is 'effect' and + the observed correlation between two variables might be due to the action of other, unobserved variables. + + see also: SUMSKIPNAN, COVM, COV, COR, SPEARMAN, RANKCORR, RANKS, + PARTCORRCOEF, flag_implicit_significance + + REFERENCES: + on the correlation coefficient + [ 1] http://mathworld.wolfram.com/CorrelationCoefficient.html + [ 2] http://www.geography.btinternet.co.uk/spearman.htm + [ 3] Hogg, R. V. and Craig, A. T. Introduction to Mathematical Statistics, 5th ed. New York: Macmillan, pp. 338 and 400, 1995. + [ 4] Lehmann, E. L. and D'Abrera, H. J. M. Nonparametrics: Statistical Methods Based on Ranks, rev. ed. Englewood Cliffs, NJ: Prentice-Hall, pp. 292, 300, and 323, 1998. + [ 5] Press, W. H.; Flannery, B. P.; Teukolsky, S. A.; and Vetterling, W. T. Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: Cambridge University Press, pp. 634-637, 1992 + [ 6] http://mathworld.wolfram.com/SpearmanRankCorrelationCoefficient.html + on the significance test of the correlation coefficient + [11] http://www.met.rdg.ac.uk/cag/STATS/corr.html + [12] http://www.janda.org/c10/Lectures/topic06/L24-significanceR.htm + [13] http://faculty.vassar.edu/lowry/ch4apx.html + [14] http://davidmlane.com/hyperstat/B134689.html + [15] http://www.statsoft.com/textbook/stbasic.html%Correlations + others + [20] http://www.tufts.edu/~gdallal/corr.htm + [21] Fisher transformation http://en.wikipedia.org/wiki/Fisher_transformation + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 + CORRCOEF calculates the correlation matrix from pairwise correlations. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +cov + + +# name: +# type: sq_string +# elements: 1 +# length: 1606 + COV covariance matrix + X and Y can contain missing values encoded with NaN. + NaN's are skipped, NaN do not result in a NaN output. + The output gives NaN only if there are insufficient input data + The mean is removed from the data. + + Remark: for data contains missing values, the resulting + matrix might not be positiv definite, and its elements have magnitudes + larger than one. This ill-behavior is more likely for small sample + sizes, but there is no garantee that the result "behaves well" for larger + sample sizes. If you want the a "well behaved" result (i.e. positive + definiteness and magnitude of elements not larger than 1), use CORRCOEF. + However, COV is faster than CORRCOEF and might be good enough in some cases. + + C = COV(X [,Mode]); + calculates the (auto-)correlation matrix of X + C = COV(X,Y [,Mode]); + calculates the crosscorrelation between X and Y. + C(i,j) is the correlation between the i-th and jth + column of X and Y, respectively. + NOTE: Octave and Matlab have (in some special cases) incompatible implemenations. + This implementation follows Octave. If the result could be ambigous or + incompatible, a warning will be presented in Matlab. To avoid this warning use: + a) use COV([X(:),Y(:)]) if you want the traditional Matlab result. + b) use C = COV([X,Y]), C = C(1:size(X,2),size(X,2)+1:size(C,2)); if you want to be compatible with this software. + + Mode = 0 [default] scales C by (N-1) + Mode = 1 scales C by N. + + see also: COVM, COR, CORRCOEF, SUMSKIPNAN + + REFERENCES: + http://mathworld.wolfram.com/Covariance.html + + + +# name: +# type: sq_string +# elements: 1 +# length: 76 + COV covariance matrix + X and Y can contain missing values encoded with NaN. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +covm + + +# name: +# type: sq_string +# elements: 1 +# length: 1182 + COVM generates covariance matrix + X and Y can contain missing values encoded with NaN. + NaN's are skipped, NaN do not result in a NaN output. + The output gives NaN only if there are insufficient input data + + COVM(X,Mode); + calculates the (auto-)correlation matrix of X + COVM(X,Y,Mode); + calculates the crosscorrelation between X and Y + COVM(...,W); + weighted crosscorrelation + + Mode = 'M' minimum or standard mode [default] + C = X'*X; or X'*Y correlation matrix + + Mode = 'E' extended mode + C = [1 X]'*[1 X]; % l is a matching column of 1's + C is additive, i.e. it can be applied to subsequent blocks and summed up afterwards + the mean (or sum) is stored on the 1st row and column of C + + Mode = 'D' or 'D0' detrended mode + the mean of X (and Y) is removed. If combined with extended mode (Mode='DE'), + the mean (or sum) is stored in the 1st row and column of C. + The default scaling is factor (N-1). + Mode = 'D1' is the same as 'D' but uses N for scaling. + + C = covm(...); + C is the scaled by N in Mode M and by (N-1) in mode D. + [C,N] = covm(...); + C is not scaled, provides the scaling factor N + C./N gives the scaled version. + + see also: DECOVM, XCOVF + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + COVM generates covariance matrix + X and Y can contain missing values encoded wi + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +cumsumskipnan + + +# name: +# type: sq_string +# elements: 1 +# length: 249 + CUMSUMSKIPNAN Cumulative sum while skiping NaN's. + If DIM is omitted, it defaults to the first non-singleton dimension. + + Y = cumsumskipnan(x [,DIM]) + + x input data + DIM dimension (default: []) + y resulting sum + + see also: CUMSUM, SUMSKIPNAN + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 + CUMSUMSKIPNAN Cumulative sum while skiping NaN's. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +decovm + + +# name: +# type: sq_string +# elements: 1 +# length: 384 + decompose extended covariance matrix into mean (mu), + standard deviation, the (pure) Covariance (COV), + correlation (xc) matrix and the correlation coefficients R2. + NaN's are condsidered as missing values. + [mu,sd,COV,xc,N,R2]=decovm(ECM[,NN]) + + ECM is the extended covariance matrix + NN is the number of elements, each estimate (in ECM) is based on + + see also: MDBC, COVM, R2 + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + decompose extended covariance matrix into mean (mu), + standard deviation, the + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +detrend + + +# name: +# type: sq_string +# elements: 1 +# length: 837 + DETREND removes the trend from data, NaN's are considered as missing values + + DETREND is fully compatible to previous Matlab and Octave DETREND with the following features added: + - handles NaN's by assuming that these are missing values + - handles unequally spaced data + - second output parameter gives the trend of the data + - compatible to Matlab and Octave + + [...]=detrend([t,] X [,p]) + removes trend for unequally spaced data + t represents the time points + X(i) is the value at time t(i) + p must be a scalar + + [...]=detrend(X,0) + [...]=detrend(X,'constant') + removes the mean + + [...]=detrend(X,p) + removes polynomial of order p (default p=1) + + [...]=detrend(X,1) - default + [...]=detrend(X,'linear') + removes linear trend + + [X,T]=detrend(...) + + X is the detrended data + T is the removed trend + + see also: SUMSKIPNAN, ZSCORE + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + DETREND removes the trend from data, NaN's are considered as missing values + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +ecdf + + +# name: +# type: sq_string +# elements: 1 +# length: 443 + ECDF empirical cumulative function + NaN's are considered Missing values and are ignored. + + [F,X] = ecdf(Y) + calculates empirical cumulative distribution functions (i.e Kaplan-Meier estimate) + ecdf(Y) + ecdf(gca,Y) + without output arguments plots the empirical cdf, in axis gca. + + Y input data + must be a vector or matrix, in case Y is a matrix, the ecdf for every column is computed. + + see also: HISTO2, HISTO3, PERCENTILE, QUANTILE + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + ECDF empirical cumulative function + NaN's are considered Missing values and + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +flag_accuracy_level + + +# name: +# type: sq_string +# elements: 1 +# length: 1033 + FLAG_ACCURACY_LEVEL sets and gets accuracy level + used in SUMSKIPNAN_MEX and COVM_MEX + The error margin of the naive summation is N*eps (N is the number of samples), + the error margin is only 2*eps if Kahan's summation is used [1]. + + 0: maximum speed [default] + accuracy of double (64bit) with naive summation (error = N*2^-52) + 1: accuracy of extended (80bit) with naive summation (error = N*2^-64) + 2: accuracy of double (64bit) with Kahan summation (error = 2^-52) + 3: accuracy of extended (80bit) with Kahan summation (error = 2^-64) + + Please note, level 3 might be equally accurate but slower than 1 or 2 on + some platforms. In order to determine what is good for you, you might want + to run ACCTEST. + + FLAG = flag_accuracy_level() + gets current level + flag_accuracy_level(FLAG) + sets accuracy level + + see also: ACCTEST + + Reference: + [1] David Goldberg, + What Every Computer Scientist Should Know About Floating-Point Arithmetic + ACM Computing Surveys, Vol 23, No 1, March 1991. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + FLAG_ACCURACY_LEVEL sets and gets accuracy level + used in SUMSKIPNAN_MEX and + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 +flag_implicit_significance + + +# name: +# type: sq_string +# elements: 1 +# length: 928 + The use of FLAG_IMPLICIT_SIGNIFICANCE is in experimental state. + flag_implicit_significance might even become obsolete. + + FLAG_IMPLICIT_SIGNIFICANCE sets and gets default alpha (level) of any significance test + The default alpha-level is stored in the global variable FLAG_implicit_significance + The idea is that the significance must not be assigned explicitely. + This might yield more readable code. + + Choose alpha low enough, because in alpha*100% of the cases, you will + reject the Null hypothesis just by change. For this reason, the default + alpha is 0.01. + + flag_implicit_significance(0.01) + sets the alpha-level for the significance test + + alpha = flag_implicit_significance() + gets default alpha + + flag_implicit_significance(alpha) + sets default alpha-level + + alpha = flag_implicit_significance(alpha) + gets and sets alpha + + features: + - compatible to Matlab and Octave + + see also: CORRCOEF, PARTCORRCOEF + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 + The use of FLAG_IMPLICIT_SIGNIFICANCE is in experimental state. + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +flag_implicit_skip_nan + + +# name: +# type: sq_string +# elements: 1 +# length: 934 + FLAG_IMPLICIT_SKIP_NAN sets and gets default mode for handling NaNs + 1 skips NaN's (the default mode if no mode is set) + 0 NaNs are propagated; input NaN's give NaN's at the output + + FLAG = flag_implicit_skip_nan() + gets current mode + + flag_implicit_skip_nan(FLAG) + sets mode + + prevFLAG = flag_implicit_skip_nan(nextFLAG) + gets previous set FLAG and sets FLAG for the future + flag_implicit_skip_nan(prevFLAG) + resets FLAG to previous mode + + It is used in: + SUMSKIPNAN, MEDIAN, QUANTILES, TRIMEAN + and affects many other functions like: + CENTER, KURTOSIS, MAD, MEAN, MOMENT, RMS, SEM, SKEWNESS, + STATISTIC, STD, VAR, ZSCORE etc. + + The mode is stored in the global variable FLAG_implicit_skip_nan + It is recommended to use flag_implicit_skip_nan(1) as default and + flag_implicit_skip_nan(0) should be used for exceptional cases only. + This feature might disappear without further notice, so you should really not + rely on it. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + FLAG_IMPLICIT_SKIP_NAN sets and gets default mode for handling NaNs + 1 skips Na + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +flag_nans_occured + + +# name: +# type: sq_string +# elements: 1 +# length: 430 + FLAG_NANS_OCCURED checks whether the last call(s) to sumskipnan or covm + contained any not-a-numbers in the input argument. Because many other + functions like mean, std, etc. are also using sumskipnan, + also these functions can be checked for NaN's in the input data. + + A call to FLAG_NANS_OCCURED() resets also the flag whether NaN's occured. + Only sumskipnan or covm can set the flag again. + + see also: SUMSKIPNAN, COVM + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + FLAG_NANS_OCCURED checks whether the last call(s) to sumskipnan or covm + conta + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +fss + + +# name: +# type: sq_string +# elements: 1 +# length: 1739 + FSS - feature subset selection and feature ranking + the method is motivated by the max-relevance-min-redundancy (mRMR) + approach [1]. However, the default method uses partial correlation, + which has been developed from scratch. PCCM [3] describes + a similar idea, but is more complicated. + An alternative method based on FSDD is implemented, too. + + [idx,score] = fss(D,cl) + [idx,score] = fss(D,cl,MODE) + [idx,score] = fss(D,cl,MODE) + + D data - each column represents a feature + cl classlabel + Mode 'Pearson' [default] correlation + 'rank' correlation + 'FSDD' feature selection algorithm based on a distance discriminant [2] + %%% 'MRMR','MID','MIQ' max-relevance, min redundancy [1] - not supported yet. + + score score of the feature + idx ranking of the feature + [tmp,idx]=sort(-score) + + see also: TRAIN_SC, XVAL, ROW_COL_DELETION + + REFERENCES: + [1] Peng, H.C., Long, F., and Ding, C., + Feature selection based on mutual information: criteria of max-dependency, max-relevance, and min-redundancy, + IEEE Transactions on Pattern Analysis and Machine Intelligence, + Vol. 27, No. 8, pp.1226-1238, 2005. + [2] Jianning Liang, Su Yang, Adam Winstanley, + Invariant optimal feature selection: A distance discriminant and feature ranking based solution, + Pattern Recognition, Volume 41, Issue 5, May 2008, Pages 1429-1439. + ISSN 0031-3203, DOI: 10.1016/j.patcog.2007.10.018. + [3] K. Raghuraj Rao and S. Lakshminarayanan + Partial correlation based variable selection approach for multivariate data classification methods + Chemometrics and Intelligent Laboratory Systems + Volume 86, Issue 1, 15 March 2007, Pages 68-81 + http://dx.doi.org/10.1016/j.chemolab.2006.08.007 + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + FSS - feature subset selection and feature ranking + the method is motivated + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +geomean + + +# name: +# type: sq_string +# elements: 1 +# length: 1207 + GEOMEAN calculates the geomentric mean of data elements. + + y = geomean(x [,DIM [,W]]) is the same as + y = mean(x,'G' [,DIM]) + + DIM dimension + 1 STD of columns + 2 STD of rows + default or []: first DIMENSION, with more than 1 element + W weights to compute weighted mean (default: []) + if W=[], all weights are 1. + number of elements in W must match size(x,DIM) + + features: + - can deal with NaN's (missing values) + - weighting of data + - dimension argument also in Octave + - compatible to Matlab and Octave + + see also: SUMSKIPNAN, MEAN, HARMMEAN + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; If not, see . + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 + GEOMEAN calculates the geomentric mean of data elements. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +gscatter + + +# name: +# type: sq_string +# elements: 1 +# length: 471 + GSCATTER scatter plot of groups + + gscatter(x,y,group) + gscatter(x,y,group,clr,sym,siz) + gscatter(x,y,group,clr,sym,siz,doleg) + gscatter(x,y,group,clr,sym,siz,doleg,xname,yname) + h = gscatter(...) + + x,y, group: vectors with equal length + clf: color vector, default 'bgrcmyk' + sym: symbol, default '.' + siz: size of Marker + doleg: 'on' (default) shows legend, 'off' turns of legend + xname, yname: name of axis + + + see also: ecdf, cdfplot + + References: + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 + GSCATTER scatter plot of groups + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +harmmean + + +# name: +# type: sq_string +# elements: 1 +# length: 629 + HARMMEAN calculates the harmonic mean of data elements. + The harmonic mean is the inverse of the mean of the inverse elements. + + y = harmmean(x [,DIM [,W]]) is the same as + y = mean(x,'H' [,DIM [,W]]) + + DIM dimension + 1 STD of columns + 2 STD of rows + default or []: first DIMENSION, with more than 1 element + W weights to compute weighted mean (default: []) + if W=[], all weights are 1. + number of elements in W must match size(x,DIM) + + features: + - can deal with NaN's (missing values) + - weighting of data + - dimension argument also in Octave + - compatible to Matlab and Octave + + see also: SUMSKIPNAN, MEAN, GEOMEAN + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 + HARMMEAN calculates the harmonic mean of data elements. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +hist2res + + +# name: +# type: sq_string +# elements: 1 +# length: 700 + Evaluates Histogram data + [R]=hist2res(H) + + [y]=hist2res(H,fun) + estimates fun-statistic + + fun 'mean' mean + 'std' standard deviation + 'var' variance + 'sem' standard error of the mean + 'rms' root mean square + 'meansq' mean of squares + 'sum' sum + 'sumsq' sum of squares + 'CM#' central moment of order # + 'skewness' skewness + 'kurtosis' excess coefficient (Fisher kurtosis) + + see also: NaN/statistic + + REFERENCES: + [1] C.L. Nikias and A.P. Petropulu "Higher-Order Spectra Analysis" Prentice Hall, 1993. + [2] C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). + [3] http://www.itl.nist.gov/ + [4] http://mathworld.wolfram.com/ + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 + Evaluates Histogram data + [R]=hist2res(H) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +iqr + + +# name: +# type: sq_string +# elements: 1 +# length: 372 + IQR calculates the interquartile range + Missing values (encoded as NaN) are ignored. + + Q = iqr(Y) + Q = iqr(Y,DIM) + returns the IQR along dimension DIM of sample array Y. + + Q = iqr(HIS) + returns the IQR from the histogram HIS. + HIS must be a HISTOGRAM struct as defined in HISTO2 or HISTO3. + + see also: MAD, RANGE, HISTO2, HISTO3, PERCENTILE, QUANTILE + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + IQR calculates the interquartile range + Missing values (encoded as NaN) are + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +kappa + + +# name: +# type: sq_string +# elements: 1 +# length: 1760 + KAPPA estimates Cohen's kappa coefficient + and related statistics + + [...] = kappa(d1,d2); + NaN's are handled as missing values and are ignored + [...] = kappa(d1,d2,'notIgnoreNAN'); + NaN's are handled as just another Label. + [kap,sd,H,z,ACC,sACC,MI] = kappa(...); + X = kappa(...); + + d1 data of scorer 1 + d2 data of scorer 2 + + kap Cohen's kappa coefficient point + se standard error of the kappa estimate + H Concordance matrix, i.e. confusion matrix + z z-score + ACC overall agreement (accuracy) + sACC specific accuracy + MI Mutual information or transfer information (in [bits]) + X is a struct containing all the fields above + For two classes, a number of additional summary statistics including + TPR, FPR, FDR, PPV, NPF, F1, dprime, Matthews Correlation coefficient (MCC) or + Phi coefficient (PHI=MCC), Specificity and Sensitivity + are provided. Note, the positive category must the larger label (in d and c), otherwise + the confusion matrix becomes transposed and the summary statistics are messed up. + + + Reference(s): + [1] Cohen, J. (1960). A coefficient of agreement for nominal scales. Educational and Psychological Measurement, 20, 37-46. + [2] J Bortz, GA Lienert (1998) Kurzgefasste Statistik f|r die klassische Forschung, Springer Berlin - Heidelberg. + Kapitel 6: Uebereinstimmungsmasze fuer subjektive Merkmalsurteile. p. 265-270. + [3] http://www.cmis.csiro.au/Fiona.Evans/personal/msc/html/chapter3.html + [4] Kraemer, H. C. (1982). Kappa coefficient. In S. Kotz and N. L. Johnson (Eds.), + Encyclopedia of Statistical Sciences. New York: John Wiley & Sons. + [5] http://ourworld.compuserve.com/homepages/jsuebersax/kappa.htm + [6] http://en.wikipedia.org/wiki/Receiver_operating_characteristic + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 + KAPPA estimates Cohen's kappa coefficient + and related statistics + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +kurtosis + + +# name: +# type: sq_string +# elements: 1 +# length: 461 + KURTOSIS estimates the kurtosis + + y = kurtosis(x,DIM) + calculates kurtosis of x in dimension DIM + + DIM dimension + 1: STATS of columns + 2: STATS of rows + default or []: first DIMENSION, with more than 1 element + + features: + - can deal with NaN's (missing values) + - dimension argument + - compatible to Matlab and Octave + + see also: SUMSKIPNAN, VAR, STD, VAR, SKEWNESS, MOMENT, STATISTIC, + IMPLICIT_SKIP_NAN + + REFERENCE(S): + http://mathworld.wolfram.com/ + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 + KURTOSIS estimates the kurtosis + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +load_fisheriris + + +# name: +# type: sq_string +# elements: 1 +# length: 446 + LOAD_FISHERIRIS + loads famous iris data set from Fisher, 1936 [1]. + + References: + [1] Fisher,R.A. "The use of multiple measurements in taxonomic problems" + Annual Eugenics, 7, Part II, 179-188 (1936); also in "Contributions to Mathematical Statistics" (John Wiley, NY, 1950). + [2] Duda,R.O., & Hart,P.E. (1973) Pattern Classification and Scene Analysis. + (Q327.D83) John Wiley & Sons. ISBN 0-471-22361-1. See page 218. + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 + LOAD_FISHERIRIS + loads famous iris data set from Fisher, 1936 [1]. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +mad + + +# name: +# type: sq_string +# elements: 1 +# length: 855 + MAD estimates the Mean Absolute deviation + (note that according to [1,2] this is the mean deviation; + not the mean absolute deviation) + + y = mad(x,DIM) + calculates the mean deviation of x in dimension DIM + + DIM dimension + 1: STATS of columns + 2: STATS of rows + default or []: first DIMENSION, with more than 1 element + + features: + - can deal with NaN's (missing values) + - dimension argument + - compatible to Matlab and Octave + + see also: SUMSKIPNAN, VAR, STD, + + REFERENCE(S): + [1] http://mathworld.wolfram.com/MeanDeviation.html + [2] L. Sachs, "Applied Statistics: A Handbook of Techniques", Springer-Verlag, 1984, page 253. + + [3] http://mathworld.wolfram.com/MeanAbsoluteDeviation.html + [4] Kenney, J. F. and Keeping, E. S. "Mean Absolute Deviation." §6.4 in Mathematics of Statistics, Pt. 1, 3rd ed. Princeton, NJ: Van Nostrand, pp. 76-77 1962. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + MAD estimates the Mean Absolute deviation + (note that according to [1,2] this i + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +mahal + + +# name: +# type: sq_string +# elements: 1 +# length: 395 + MAHAL return the Mahalanobis' D-square distance between the + multivariate samples x and y, which must have the same number + of components (columns), but may have a different number of observations (rows). + + d = mahal(X,Y) + + d(k) = (X(k,:)-MU)*inv(SIGMA)*(X(k,:)-MU)' + + where MU and SIGMA are the mean and the covariance matrix of Y + + + see also: TRAIN_SC, TEST_SC, COVM + + References: + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + MAHAL return the Mahalanobis' D-square distance between the + multivariate samp + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +make + + +# name: +# type: sq_string +# elements: 1 +# length: 46 + This make.m is used for Matlab under Windows + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + This make. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +mean + + +# name: +# type: sq_string +# elements: 1 +# length: 735 + MEAN calculates the mean of data elements. + + y = mean(x [,DIM] [,opt] [, W]) + + DIM dimension + 1 MEAN of columns + 2 MEAN of rows + N MEAN of N-th dimension + default or []: first DIMENSION, with more than 1 element + + opt options + 'A' arithmetic mean + 'G' geometric mean + 'H' harmonic mean + + W weights to compute weighted mean (default: []) + if W=[], all weights are 1. + number of elements in W must match size(x,DIM) + + usage: + mean(x) + mean(x,DIM) + mean(x,opt) + mean(x,opt,DIM) + mean(x,DIM,opt) + mean(x,DIM,W) + mean(x,DIM,opt,W); ' + + features: + - can deal with NaN's (missing values) + - weighting of data + - dimension argument also in Octave + - compatible to Matlab and Octave + + see also: SUMSKIPNAN, MEAN, GEOMEAN, HARMMEAN + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 + MEAN calculates the mean of data elements. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +meandev + + +# name: +# type: sq_string +# elements: 1 +# length: 856 + MEANDEV estimates the Mean deviation + (note that according to [1,2] this is the mean deviation; + not the mean absolute deviation) + + y = meandev(x,DIM) + calculates the mean deviation of x in dimension DIM + + DIM dimension + 1: STATS of columns + 2: STATS of rows + default or []: first DIMENSION, with more than 1 element + + features: + - can deal with NaN's (missing values) + - dimension argument + - compatible to Matlab and Octave + + see also: SUMSKIPNAN, VAR, STD, MAD + + REFERENCE(S): + [1] http://mathworld.wolfram.com/MeanDeviation.html + [2] L. Sachs, "Applied Statistics: A Handbook of Techniques", Springer-Verlag, 1984, page 253. + [3] http://mathworld.wolfram.com/MeanAbsoluteDeviation.html + [4] Kenney, J. F. and Keeping, E. S. "Mean Absolute Deviation." §6.4 in Mathematics of Statistics, Pt. 1, 3rd ed. Princeton, NJ: Van Nostrand, pp. 76-77 1962. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + MEANDEV estimates the Mean deviation + (note that according to [1,2] this is the + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +meansq + + +# name: +# type: sq_string +# elements: 1 +# length: 527 + MEANSQ calculates the mean of the squares + + y = meansq(x,DIM,W) + + DIM dimension + 1 STD of columns + 2 STD of rows + N STD of N-th dimension + default or []: first DIMENSION, with more than 1 element + W weights to compute weighted mean (default: []) + if W=[], all weights are 1. + number of elements in W must match size(x,DIM) + + features: + - can deal with NaN's (missing values) + - weighting of data + - dimension argument also in Octave + - compatible to Matlab and Octave + + see also: SUMSQ, SUMSKIPNAN, MEAN, VAR, STD, RMS + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 + MEANSQ calculates the mean of the squares + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +medAbsDev + + +# name: +# type: sq_string +# elements: 1 +# length: 373 + medAbsDev calculates the median absolute deviation + + Usage: D = medAbsDev(X, DIM) + or: [D, M] = medAbsDev(X, DIM) + Input: X : data + DIM: dimension along which mad should be calculated (1=columns, 2=rows) + (optional, default=first dimension with more than 1 element + Output: D : median absolute deviations + M : medians (optional) + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 + medAbsDev calculates the median absolute deviation + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +median + + +# name: +# type: sq_string +# elements: 1 +# length: 366 + MEDIAN data elements, + [y]=median(x [,DIM]) + + DIM dimension + 1: median of columns + 2: median of rows + N: median of N-th dimension + default or []: first DIMENSION, with more than 1 element + + features: + - can deal with NaN's (missing values) + - accepts dimension argument like in Matlab in Octave, too. + - compatible to Matlab and Octave + + see also: SUMSKIPNAN + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 + MEDIAN data elements, + [y]=median(x [,DIM]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +moment + + +# name: +# type: sq_string +# elements: 1 +# length: 627 + MOMENT estimates the p-th moment + + M = moment(x, p [,opt] [,DIM]) + M = moment(H, p [,opt]) + calculates p-th central moment from data x in dimension DIM + of from Histogram H + + p moment of order p + opt 'ac': absolute 'a' and/or central ('c') moment + DEFAULT: '' raw moments are estimated + DIM dimension + 1: STATS of columns + 2: STATS of rows + default or []: first DIMENSION, with more than 1 element + + features: + - can deal with NaN's (missing values) + - dimension argument + - compatible to Matlab and Octave + + see also: STD, VAR, SKEWNESS, KURTOSIS, STATISTIC, + + REFERENCE(S): + http://mathworld.wolfram.com/Moment.html + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + MOMENT estimates the p-th moment + + M = moment(x, p [,opt] [,DIM]) + M = moment + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +nanconv + + +# name: +# type: sq_string +# elements: 1 +# length: 616 + NANCONV computes the convolution for data with missing values. + X and Y can contain missing values encoded with NaN. + NaN's are skipped, NaN do not result in a NaN output. + The output gives NaN only if there are insufficient input data + + [...] = NANCONV(X,Y); + calculates 2-dim convolution between X and Y + [C] = NANCONV(X,Y); + + WARNING: missing values can introduce aliasing - causing unintended results. + Moreover, the behavior of bandpass and highpass filters in case of missing values + is not fully understood, and might contain some pitfalls. + + see also: CONV, NANCONV2, NANFFT, NANFILTER + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 + NANCONV computes the convolution for data with missing values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nanfft + + +# name: +# type: sq_string +# elements: 1 +# length: 618 + NANFFT calculates the Fourier-Transform of X for data with missing values. + NANFFT is the same as FFT but X can contain missing values encoded with NaN. + NaN's are skipped, NaN do not result in a NaN output. + + Y = NANFFT(X) + Y = NANFFT(X,N) + Y = NANFFT(X,[],DIM) + + [Y,N] = NANFFT(...) + returns the number of valid samples N + + + WARNING: missing values can introduce aliasing - causing unintended results. + Moreover, the behavior of bandpass and highpass filters in case of missing values + is not fully understood, and might contain some pitfalls. + + see also: FFT, XCORR, NANCONV, NANFILTER + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 + NANFFT calculates the Fourier-Transform of X for data with missing values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +nanfilter + + +# name: +# type: sq_string +# elements: 1 +# length: 519 + NANFILTER is able to filter data with missing values encoded as NaN. + + [Y,Z] = nanfilter(B,A,X [, Z]); + + If X contains no missing data, NANFILTER should behave like FILTER. + NaN-values are handled gracefully. + + WARNING: missing values can introduce aliasing - causing unintended results. + Moreover, the behavior of bandpass and highpass filters in case of missing values + is not fully understood, and might contain some pitfalls. + + see also: FILTER, SUMSKIPNAN, NANFFT, NANCONV, NANFILTER1UC + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 + NANFILTER is able to filter data with missing values encoded as NaN. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +nanfilter1uc + + +# name: +# type: sq_string +# elements: 1 +# length: 257 + NANFILTER1UC is an adaptive filter for data with missing values encoded as NaN. + + [Y,Z] = nanfilter1uc(uc,X [, Z]); + + if X contains no missing data, NANFILTER behaves like FILTER(uc,[1,uc-1],X[,Z]). + + see also: FILTER, NANFILTER, SUMSKIPNAN + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + NANFILTER1UC is an adaptive filter for data with missing values encoded as NaN. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +naninsttest + + +# name: +# type: sq_string +# elements: 1 +# length: 112 + NANINSTTEST checks whether the functions from NaN-toolbox have been + correctly installed. + + see also: NANTEST + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + NANINSTTEST checks whether the functions from NaN-toolbox have been + correctly + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +nanmean + + +# name: +# type: sq_string +# elements: 1 +# length: 330 + NANMEAN same as SUM but ignores NaN's. + NANMEAN is OBSOLETE; use MEAN instead. NANMEAN is included + to provide backward compatibility + + Y = nanmean(x [,DIM]) + + DIM dimension + 1 sum of columns + 2 sum of rows + default or []: first DIMENSION with more than 1 element + Y resulting mean + + + see also: MEAN, SUMSKIPNAN, NANSUM + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 + NANMEAN same as SUM but ignores NaN's. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nanstd + + +# name: +# type: sq_string +# elements: 1 +# length: 518 + NANSTD same as STD but ignores NaN's. + NANSTD is OBSOLETE; use NaN/STD instead. NANSTD is included + to fix a bug in alternative implementations and to + provide some compatibility. + + Y = nanstd(x, FLAG, [,DIM]) + + x data + FLAG 0: [default] normalizes with (N-1), N = sample size + FLAG 1: normalizes with N, N = sample size + DIM dimension + 1 sum of columns + 2 sum of rows + default or []: first DIMENSION with more than 1 element + Y resulting standard deviation + + see also: SUM, SUMSKIPNAN, NANSUM, STD + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + NANSTD same as STD but ignores NaN's. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nansum + + +# name: +# type: sq_string +# elements: 1 +# length: 333 + NANSUM same as SUM but ignores NaN's. + NANSUM is OBSOLETE; use SUMSKIPNAN instead. NANSUM is included + to fix a bug in some other versions. + + Y = nansum(x [,DIM]) + + DIM dimension + 1 sum of columns + 2 sum of rows + default or []: first DIMENSION with more than 1 element + Y resulting sum + + + see also: SUM, SUMSKIPNAN, NANSUM + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + NANSUM same as SUM but ignores NaN's. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +nantest + + +# name: +# type: sq_string +# elements: 1 +# length: 366 + NANTEST checks several mathematical operations and a few + statistical functions for their correctness related to NaN's. + e.g. it checks norminv, normcdf, normpdf, sort, matrix division and multiplication. + + + see also: NANINSTTEST + + REFERENCE(S): + [1] W. Kahan (1996) Lecture notes on the Status of "IEEE Standard 754 for + Binary Floating-point Arithmetic. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + NANTEST checks several mathematical operations and a few + statistical function + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +normcdf + + +# name: +# type: sq_string +# elements: 1 +# length: 290 + NORMCDF returns normal cumulative distribtion function + + cdf = normcdf(x,m,s); + + Computes the CDF of a the normal distribution + with mean m and standard deviation s + default: m=0; s=1; + x,m,s must be matrices of same size, or any one can be a scalar. + + see also: NORMPDF, NORMINV + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 + NORMCDF returns normal cumulative distribtion function + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +norminv + + +# name: +# type: sq_string +# elements: 1 +# length: 341 + NORMINV returns inverse cumulative function of the normal distribution + + x = norminv(p,m,s); + + Computes the quantile (inverse of the CDF) of a the normal + cumulative distribution with mean m and standard deviation s + default: m=0; s=1; + p,m,s must be matrices of same size, or any one can be a scalar. + + see also: NORMPDF, NORMCDF + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 + NORMINV returns inverse cumulative function of the normal distribution + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +normpdf + + +# name: +# type: sq_string +# elements: 1 +# length: 279 + NORMPDF returns normal probability density + + pdf = normpdf(x,m,s); + + Computes the PDF of a the normal distribution + with mean m and standard deviation s + default: m=0; s=1; + x,m,s must be matrices of same size, or any one can be a scalar. + + see also: NORMCDF, NORMINV + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 + NORMPDF returns normal probability density + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +partcorrcoef + + +# name: +# type: sq_string +# elements: 1 +# length: 2015 + PARTCORRCOEF calculates the partial correlation between X and Y + after removing the influence of Z. + X, Y and Z can contain missing values encoded with NaN. + NaN's are skipped, NaN do not result in a NaN output. + (Its assumed that the occurence of NaN's is uncorrelated) + The output gives NaN, only if there are insufficient input data. + + The partial correlation is defined as + pcc(xy|z)=(cc(x,y)-cc(x,z)*cc(y,z))/sqrt((1-cc(x,y)�)*((1-cc(x,z)�))) + + + PARTCORRCOEF(X [,Mode]); + calculates the (auto-)correlation matrix of X + PARTCORRCOEF(X,Y,Z); + PARTCORRCOEF(X,Y,Z,[]); + PARTCORRCOEF(X,Y,Z,'Pearson'); + PARTCORRCOEF(X,Y,Z,'Rank'); + PARTCORRCOEF(X,Y,Z,'Spearman'); + + Mode=[] [default] + removes from X and Y the part that can be explained by Z + and computes the correlation of the remaining part. + Ideally, this is equivalent to Mode='Pearson', however, in practice + this is more accurate. + Mode='Pearson' or 'parametric' + Mode='Spearman' + Mode='Rank' + computes the partial correlation based on cc(x,y),cc(x,z) and cc(y,z) + with the respective mode. + + [R,p,ci1,ci2] = PARTCORRCOEF(...); + r is the partialcorrelation matrix + r(i,j) is the partial correlation coefficient r between X(:,i) and Y(:,j) + when influence of Z is removed. + p gives the significance of PCC + It tests the null hypothesis that the product moment correlation coefficient is zero + using Student's t-test on the statistic t = r sqrt(N-Nz-2)/sqrt(1-r^2) + where N is the number of samples (Statistics, M. Spiegel, Schaum series). + p > alpha: do not reject the Null hypothesis: "R is zero". + p < alpha: The alternative hypothesis "R2 is larger than zero" is true with probability (1-alpha). + ci1 lower 0.95 confidence interval + ci2 upper 0.95 confidence interval + + see also: SUMSKIPNAN, COVM, COV, COR, SPEARMAN, RANKCORR, RANKS, CORRCOEF + + REFERENCES: + on the partial correlation coefficient + [1] http://www.tufts.edu/~gdallal/partial.htm + [2] http://www.nag.co.uk/numeric/fl/manual/pdf/G02/g02byf.pdf + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + PARTCORRCOEF calculates the partial correlation between X and Y + after removing + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +percentile + + +# name: +# type: sq_string +# elements: 1 +# length: 554 + PERCENTILE calculates the percentiles of histograms and sample arrays. + + Q = percentile(Y,q) + Q = percentile(Y,q,DIM) + returns the q-th percentile along dimension DIM of sample array Y. + size(Q) is equal size(Y) except for dimension DIM which is size(Q,DIM)=length(Q) + + Q = percentile(HIS,q) + returns the q-th percentile from the histogram HIS. + HIS must be a HISTOGRAM struct as defined in HISTO2 or HISTO3. + If q is a vector, the each row of Q returns the q(i)-th percentile + + see also: HISTO2, HISTO3, QUANTILE + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 + PERCENTILE calculates the percentiles of histograms and sample arrays. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +prctile + + +# name: +# type: sq_string +# elements: 1 +# length: 576 + PRCTILE calculates the percentiles of histograms and sample arrays. + (its the same than PERCENTILE.M) + + Q = prctile(Y,q) + Q = prctile(Y,q,DIM) + returns the q-th percentile along dimension DIM of sample array Y. + size(Q) is equal size(Y) except for dimension DIM which is size(Q,DIM)=length(Q) + + Q = prctile(HIS,q) + returns the q-th percentile from the histogram HIS. + HIS must be a HISTOGRAM struct as defined in HISTO2 or HISTO3. + If q is a vector, the each row of Q returns the q(i)-th percentile + + see also: HISTO2, HISTO3, QUANTILE + + + +# name: +# type: sq_string +# elements: 1 +# length: 68 + PRCTILE calculates the percentiles of histograms and sample arrays. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +quantile + + +# name: +# type: sq_string +# elements: 1 +# length: 528 + QUANTILE calculates the quantiles of histograms and sample arrays. + + Q = quantile(Y,q) + Q = quantile(Y,q,DIM) + returns the q-th quantile along dimension DIM of sample array Y. + size(Q) is equal size(Y) except for dimension DIM which is size(Q,DIM)=length(Q) + + Q = quantile(HIS,q) + returns the q-th quantile from the histogram HIS. + HIS must be a HISTOGRAM struct as defined in HISTO2 or HISTO3. + If q is a vector, the each row of Q returns the q(i)-th quantile + + see also: HISTO2, HISTO3, PERCENTILE + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 + QUANTILE calculates the quantiles of histograms and sample arrays. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +range + + +# name: +# type: sq_string +# elements: 1 +# length: 371 + RANGE calculates the range of Y + Missing values (encoded as NaN) are ignored. + + Q = range(Y) + Q = range(Y,DIM) + returns the range along dimension DIM of sample array Y. + + Q = range(HIS) + returns the RANGE from the histogram HIS. + HIS must be a HISTOGRAM struct as defined in HISTO2 or HISTO3. + + see also: IQR, MAD, HISTO2, HISTO3, PERCENTILE, QUANTILE + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + RANGE calculates the range of Y + Missing values (encoded as NaN) are ignored. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +rankcorr + + +# name: +# type: sq_string +# elements: 1 +# length: 668 + RANKCORR calculated the rank correlation coefficient. + This function is replaced by CORRCOEF. + Significance test and confidence intervals can be obtained from CORRCOEF, too. + + R = CORRCOEF(X, [Y, ] 'Rank'); + + The rank correlation r = corrcoef(ranks(x)). + is often confused with Spearman's rank correlation. + Spearman's correlation is defined as + r(x,y) = 1-6*sum((ranks(x)-ranks(y)).^2)/(N*(N*N-1)) + The results are different. Here, the former version is implemented. + + see also: CORRCOEF, SPEARMAN, RANKS + + REFERENCES: + [1] http://mathworld.wolfram.com/SpearmanRankCorrelationCoefficient.html + [2] http://mathworld.wolfram.com/CorrelationCoefficient.html + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 + RANKCORR calculated the rank correlation coefficient. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ranks + + +# name: +# type: sq_string +# elements: 1 +# length: 1062 + RANKS gives the rank of each element in a vector. + This program uses an advanced algorithm with averge effort O(m.n.log(n)) + NaN in the input yields NaN in the output. + + r = ranks(X[,DIM]) + if X is a vector, return the vector of ranks of X adjusted for ties. + if X is matrix, the rank is calculated along dimension DIM. + if DIM is zero or empty, the lowest dimension with more then 1 element is used. + r = ranks(X,DIM,'traditional') + implements the traditional algorithm with O(n^2) computational + and O(n^2) memory effort + r = ranks(X,DIM,'mtraditional') + implements the traditional algorithm with O(n^2) computational + and O(n) memory effort + r = ranks(X,DIM,'advanced ') + implements an advanced algorithm with O(n*log(n)) computational + and O(n.log(n)) memory effort + r = ranks(X,DIM,'advanced-ties') + implements an advanced algorithm with O(n*log(n)) computational + and O(n.log(n)) memory effort + but without correction for ties + This is the fastest algorithm + + see also: CORRCOEF, SPEARMAN, RANKCORR + + REFERENCES: + -- + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 + RANKS gives the rank of each element in a vector. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +rms + + +# name: +# type: sq_string +# elements: 1 +# length: 560 + RMS calculates the root mean square + can deal with complex data. + + y = rms(x,DIM,W) + + DIM dimension + 1 STD of columns + 2 STD of rows + N STD of N-th dimension + default or []: first DIMENSION, with more than 1 element + W weights to compute weighted s.d. (default: []) + if W=[], all weights are 1. + number of elements in W must match size(x,DIM) + + y estimated standard deviation + + features: + - can deal with NaN's (missing values) + - weighting of data + - dimension argument also in Octave + - compatible to Matlab and Octave + + see also: SUMSKIPNAN, MEAN + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 + RMS calculates the root mean square + can deal with complex data. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +row_col_deletion + + +# name: +# type: sq_string +# elements: 1 +# length: 739 + ROW_COL_DELETION selects the rows and columns for removing any missing values. + A heuristic based on maximizing the number of remaining sample values + is used. In other words, if there are more rows than columns, it is + more likely that a row-wise deletion will be applied and vice versa. + + [rix,cix] = row_col_deletion(d) + [rix,cix] = row_col_deletion(d,c,w) + + Input: + d data (each row is a sample, each column a feature) + c classlabels (not really used) [OPTIONAL] + w weight for each sample vector [OPTIONAL] + Output: + rix selected samples + cix selected columns + + d(rix,cix) does not contain any NaN's i.e. missing values + + see also: TRAIN_SC, TEST_SC + + + +# name: +# type: sq_string +# elements: 1 +# length: 79 + ROW_COL_DELETION selects the rows and columns for removing any missing values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +sem + + +# name: +# type: sq_string +# elements: 1 +# length: 695 + SEM calculates the standard error of the mean + + [SE,M] = SEM(x [, DIM [,W]]) + calculates the standard error (SE) in dimension DIM + the default DIM is the first non-single dimension + M returns the mean. + Can deal with complex data, too. + + DIM dimension + 1: SEM of columns + 2: SEM of rows + N: SEM of N-th dimension + default or []: first DIMENSION, with more than 1 element + W weights to compute weighted mean and s.d. (default: []) + if W=[], all weights are 1. + number of elements in W must match size(x,DIM) + + features: + - can deal with NaN's (missing values) + - weighting of data + - dimension argument + - compatible to Matlab and Octave + + see also: SUMSKIPNAN, MEAN, VAR, STD + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + SEM calculates the standard error of the mean + + [SE,M] = SEM(x [, DIM [,W]]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +skewness + + +# name: +# type: sq_string +# elements: 1 +# length: 405 + SKEWNESS estimates the skewness + + y = skewness(x,DIM) + calculates skewness of x in dimension DIM + + DIM dimension + 1: STATS of columns + 2: STATS of rows + default or []: first DIMENSION, with more than 1 element + + features: + - can deal with NaN's (missing values) + - dimension argument + - compatible to Matlab and Octave + + see also: SUMSKIPNAN, STATISTIC + + REFERENCE(S): + http://mathworld.wolfram.com/ + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 + SKEWNESS estimates the skewness + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +spearman + + +# name: +# type: sq_string +# elements: 1 +# length: 683 + SPEARMAN Spearman's rank correlation coefficient. + This function is replaced by CORRCOEF. + Significance test and confidence intervals can be obtained from CORRCOEF. + + [R,p,ci1,ci2] = CORRCOEF(x, [y, ] 'Rank'); + + For some (unknown) reason, in previous versions Spearman's rank correlation + r = corrcoef(ranks(x)). + But according to [1], Spearman's correlation is defined as + r = 1-6*sum((ranks(x)-ranks(y)).^2)/(N*(N*N-1)) + The results are different. Here, the later version is implemented. + + see also: CORRCOEF, RANKCORR + + REFERENCES: + [1] http://mathworld.wolfram.com/SpearmanRankCorrelationCoefficient.html + [2] http://mathworld.wolfram.com/CorrelationCoefficient.html + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 + SPEARMAN Spearman's rank correlation coefficient. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +statistic + + +# name: +# type: sq_string +# elements: 1 +# length: 938 + STATISTIC estimates various statistics at once. + + R = STATISTIC(x,DIM) + calculates all statistic (see list of fun) in dimension DIM + R is a struct with all statistics + + y = STATISTIC(x,fun) + estimate of fun on dimension DIM + y gives the statistic of fun + + DIM dimension + 1: STATS of columns + 2: STATS of rows + N: STATS of N-th dimension + default or []: first DIMENSION, with more than 1 element + + fun 'mean' mean + 'std' standard deviation + 'var' variance + 'sem' standard error of the mean + 'rms' root mean square + 'meansq' mean of squares + 'sum' sum + 'sumsq' sum of squares + 'CM#' central moment of order # + 'skewness' skewness + 'kurtosis' excess coefficient (Fisher kurtosis) + 'mad' mean absolute deviation + + features: + - can deal with NaN's (missing values) + - dimension argument + - compatible to Matlab and Octave + + see also: SUMSKIPNAN + + REFERENCE(S): + [1] http://www.itl.nist.gov/ + [2] http://mathworld.wolfram.com/ + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + STATISTIC estimates various statistics at once. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +std + + +# name: +# type: sq_string +# elements: 1 +# length: 983 + STD calculates the standard deviation. + + [y,v] = std(x [, opt[, DIM [, W]]]) + + opt option + 0: normalizes with N-1 [default] + provides the square root of best unbiased estimator of the variance + 1: normalizes with N, + this provides the square root of the second moment around the mean + otherwise: + best unbiased estimator of the standard deviation (see [1]) + + DIM dimension + N STD of N-th dimension + default or []: first DIMENSION, with more than 1 element + W weights to compute weighted s.d. (default: []) + if W=[], all weights are 1. + number of elements in W must match size(x,DIM) + + y estimated standard deviation + + features: + - provides an unbiased estimation of the S.D. + - can deal with NaN's (missing values) + - weighting of data + - dimension argument also in Octave + - compatible to Matlab and Octave + + see also: RMS, SUMSKIPNAN, MEAN, VAR, MEANSQ, + + + References(s): + [1] http://mathworld.wolfram.com/StandardDeviationDistribution.html + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 + STD calculates the standard deviation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +sumskipnan + + +# name: +# type: sq_string +# elements: 1 +# length: 1234 + SUMSKIPNAN adds all non-NaN values. + + All NaN's are skipped; NaN's are considered as missing values. + SUMSKIPNAN of NaN's only gives O; and the number of valid elements is return. + SUMSKIPNAN is also the elementary function for calculating + various statistics (e.g. MEAN, STD, VAR, RMS, MEANSQ, SKEWNESS, + KURTOSIS, MOMENT, STATISTIC etc.) from data with missing values. + SUMSKIPNAN implements the DIMENSION-argument for data with missing values. + Also the second output argument return the number of valid elements (not NaNs) + + Y = sumskipnan(x [,DIM]) + [Y,N,SSQ] = sumskipnan(x [,DIM]) + [...] = sumskipnan(x, DIM, W) + + x input data + DIM dimension (default: []) + empty DIM sets DIM to first non singleton dimension + W weight vector for weighted sum, numel(W) must fit size(x,DIM) + Y resulting sum + N number of valid (not missing) elements + SSQ sum of squares + + the function FLAG_NANS_OCCURED() returns whether any value in x + is a not-a-number (NaN) + + features: + - can deal with NaN's (missing values) + - implements dimension argument. + - computes weighted sum + - compatible with Matlab and Octave + + see also: FLAG_NANS_OCCURED, SUM, NANSUM, MEAN, STD, VAR, RMS, MEANSQ, + SSQ, MOMENT, SKEWNESS, KURTOSIS, SEM + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 + SUMSKIPNAN adds all non-NaN values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +sumsq + + +# name: +# type: sq_string +# elements: 1 +# length: 391 + SUMSQ calculates the sum of squares. + + [y] = sumsq(x [, DIM]) + + DIM dimension + N STD of N-th dimension + default or []: first DIMENSION, with more than 1 element + + y estimated standard deviation + + features: + - can deal with NaN's (missing values) + - dimension argument also in Octave + - compatible to Matlab and Octave + + see also: RMS, SUMSKIPNAN, MEAN, VAR, MEANSQ, + + + References(s): + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 + SUMSQ calculates the sum of squares. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +tcdf + + +# name: +# type: sq_string +# elements: 1 +# length: 254 + TCDF returns student cumulative distribtion function + + cdf = tcdf(x,DF); + + Computes the CDF of the students distribution + with DF degrees of freedom + x,DF must be matrices of same size, or any one can be a scalar. + + see also: NORMCDF, TPDF, TINV + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 + TCDF returns student cumulative distribtion function + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +test_sc + + +# name: +# type: sq_string +# elements: 1 +# length: 1441 + TEST_SC: apply statistical and SVM classifier to test data + + R = test_sc(CC,D,TYPE [,target_Classlabel]) + R.output output: "signed" distance for each class. + This represents the distances between sample D and the separating hyperplane + The "signed distance" is possitive if it matches the target class, and + and negative if it lays on the opposite side of the separating hyperplane. + R.classlabel class for output data + The target class is optional. If it is provided, the following values are returned. + R.kappa Cohen's kappa coefficient + R.ACC Classification accuracy + R.H Confusion matrix + + The classifier CC is typically obtained by TRAIN_SC. If a statistical + classifier is used, TYPE can be used to modify the classifier. + TYPE = 'MDA' mahalanobis distance based classifier + TYPE = 'MD2' mahalanobis distance based classifier + TYPE = 'MD3' mahalanobis distance based classifier + TYPE = 'GRB' Gaussian radial basis function + TYPE = 'QDA' quadratic discriminant analysis + TYPE = 'LD2' linear discriminant analysis + TYPE = 'LD3', 'LDA', 'FDA, 'FLDA' (Fisher's) linear discriminant analysis + TYPE = 'LD4' linear discriminant analysis + TYPE = 'GDBC' general distance based classifier + + see also: TRAIN_SC + + References: + [1] R. Duda, P. Hart, and D. Stork, Pattern Classification, second ed. + John Wiley & Sons, 2001. + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 + TEST_SC: apply statistical and SVM classifier to test data + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +tiedrank + + +# name: +# type: sq_string +# elements: 1 +# length: 272 + TIEDRANK compute rank of samples, the mean value is used in case of ties + this function is just a wrapper for RANKS, and provided for compatibility + with the statistics toolbox of matlab(tm) + + R = tiedrank(X) + computes the rank R of vector X + + see also: RANKS + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + TIEDRANK compute rank of samples, the mean value is used in case of ties + this + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +tinv + + +# name: +# type: sq_string +# elements: 1 +# length: 330 + TINV returns inverse cumulative function of the student distribution + + x = tinv(p,v); + + Computes the quantile (inverse of the CDF) of a the student + cumulative distribution with mean m and standard deviation s + p,v must be matrices of same size, or any one can be a scalar. + + see also: TPDF, TCDF, NORMPDF, NORMCDF, NORMINV + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 + TINV returns inverse cumulative function of the student distribution + + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +tpdf + + +# name: +# type: sq_string +# elements: 1 +# length: 261 + TPDF returns student probability density + + pdf = tpdf(x,DF); + + Computes the PDF of a the student distribution + with DF degreas of freedom + x,DF must be matrices of same size, or any one can be a scalar. + + see also: TINV, TCDF, NORMPDF, NORMCDF, NORMINV + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 + TPDF returns student probability density + + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +train_lda_sparse + + +# name: +# type: sq_string +# elements: 1 +# length: 1689 + Linear Discriminant Analysis for the Small Sample Size Problem as described in + Algorithm 1 of J. Duintjer Tebbens, P. Schlesinger: 'Improving + Implementation of Linear Discriminant Analysis for the High Dimension/Small Sample Size + Problem', Computational Statistics and Data Analysis, vol. 52, no. 1, pp. 423-437, 2007. + Input: + X ...... (sparse) training data matrix + G ...... group coding matrix of the training data + test ...... (sparse) test data matrix + Gtest ...... group coding matrix of the test data + par ...... if par = 0 then classification exploits sparsity too + tol ...... tolerance to distinguish zero eigenvalues + Output: + err ...... Wrong classification rate (in %) + trafo ...... LDA transformation vectors + + Reference(s): + J. Duintjer Tebbens, P. Schlesinger: 'Improving + Implementation of Linear Discriminant Analysis for the High Dimension/Small Sample Size + Problem', Computational Statistics and Data Analysis, vol. 52, no. 1, + pp. 423-437, 2007. + + Copyright (C) by J. Duintjer Tebbens, Institute of Computer Science of the Academy of Sciences of the Czech Republic, + Pod Vodarenskou vezi 2, 182 07 Praha 8 Liben, 18.July.2006. + This work was supported by the Program Information Society under project + 1ET400300415. + + + Modified for the use with Matlab6.5 by A. Schloegl, 22.Aug.2006 + + $Id$ + This function is part of the NaN-toolbox + http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Linear Discriminant Analysis for the Small Sample Size Problem as described in + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +train_sc + + +# name: +# type: sq_string +# elements: 1 +# length: 7655 + Train a (statistical) classifier + + CC = train_sc(D,classlabel) + CC = train_sc(D,classlabel,MODE) + CC = train_sc(D,classlabel,MODE, W) + weighting D(k,:) with weight W(k) (not all classifiers supported weighting) + + CC contains the model parameters of a classifier which can be applied + to test data using test_sc. + R = test_sc(CC,D,...) + + D training samples (each row is a sample, each column is a feature) + classlabel labels of each sample, must have the same number of rows as D. + Two different encodings are supported: + {-1,1}-encoding (multiple classes with separate columns for each class) or + 1..M encoding. + So [1;2;3;1;4] is equivalent to + [+1,-1,-1,-1; + [-1,+1,-1,-1; + [-1,-1,+1,-1; + [+1,-1,-1,-1] + [-1,-1,-1,+1] + Note, samples with classlabel=0 are ignored. + + The following classifier types are supported MODE.TYPE + 'MDA' mahalanobis distance based classifier [1] + 'MD2' mahalanobis distance based classifier [1] + 'MD3' mahalanobis distance based classifier [1] + 'GRB' Gaussian radial basis function [1] + 'QDA' quadratic discriminant analysis [1] + 'LD2' linear discriminant analysis (see LDBC2) [1] + MODE.hyperparameter.gamma: regularization parameter [default 0] + 'LD3', 'FDA', 'LDA', 'FLDA' + linear discriminant analysis (see LDBC3) [1] + MODE.hyperparameter.gamma: regularization parameter [default 0] + 'LD4' linear discriminant analysis (see LDBC4) [1] + MODE.hyperparameter.gamma: regularization parameter [default 0] + 'LD5' another LDA (motivated by CSP) + MODE.hyperparameter.gamma: regularization parameter [default 0] + 'RDA' regularized discriminant analysis [7] + MODE.hyperparameter.gamma: regularization parameter + MODE.hyperparameter.lambda = + gamma = 0, lambda = 0 : MDA + gamma = 0, lambda = 1 : LDA [default] + Hint: hyperparameter are used only in test_sc.m, testing different + the hyperparameters do not need repetitive calls to train_sc, + it is sufficient to modify CC.hyperparameter before calling test_sc. + 'GDBC' general distance based classifier [1] + '' statistical classifier, requires Mode argument in TEST_SC + '###/DELETION' if the data contains missing values (encoded as NaNs), + a row-wise or column-wise deletion (depending on which method + removes less data values) is applied; + '###/GSVD' GSVD and statistical classifier [2,3], + '###/sparse' sparse [5] + '###' must be 'LDA' or any other classifier + 'PLS' (linear) partial least squares regression + 'REG' regression analysis; + 'WienerHopf' Wiener-Hopf equation + 'NBC' Naive Bayesian Classifier [6] + 'aNBC' Augmented Naive Bayesian Classifier [6] + 'NBPW' Naive Bayesian Parzen Window [9] + + 'PLA' Perceptron Learning Algorithm [11] + MODE.hyperparameter.alpha = alpha [default: 1] + w = w + alpha * e'*x + 'LMS', 'AdaLine' Least mean squares, adaptive line element, Widrow-Hoff, delta rule + MODE.hyperparameter.alpha = alpha [default: 1] + 'Winnow2' Winnow2 algorithm [12] + + 'PSVM' Proximal SVM [8] + MODE.hyperparameter.nu (default: 1.0) + 'LPM' Linear Programming Machine + uses and requires train_LPM of the iLog CPLEX optimizer + MODE.hyperparameter.c_value = + 'CSP' CommonSpatialPattern is very experimental and just a hack + uses a smoothing window of 50 samples. + 'SVM','SVM1r' support vector machines, one-vs-rest + MODE.hyperparameter.c_value = + 'SVM11' support vector machines, one-vs-one + voting + MODE.hyperparameter.c_value = + 'RBF' Support Vector Machines with RBF Kernel + MODE.hyperparameter.c_value = + MODE.hyperparameter.gamma = + 'SVM:LIB' libSVM [default SVM algorithm) + 'SVM:bioinfo' uses and requires svmtrain from the bioinfo toolbox + 'SVM:OSU' uses and requires mexSVMTrain from the OSU-SVM toolbox + 'SVM:LOO' uses and requires svcm_train from the LOO-SVM toolbox + 'SVM:Gunn' uses and requires svc-functios from the Gunn-SVM toolbox + 'SVM:KM' uses and requires svmclass-function from the KM-SVM toolbox + 'SVM:LINz' LibLinear [10] (requires train.mex from LibLinear somewhere in the path) + z=0 (default) LibLinear with -- L2-regularized logistic regression + z=1 LibLinear with -- L2-loss support vector machines (dual) + z=2 LibLinear with -- L2-loss support vector machines (primal) + z=3 LibLinear with -- L1-loss support vector machines (dual) + 'SVM:LIN4' LibLinear with -- multi-class support vector machines by Crammer and Singer + 'DT' decision tree - not implemented yet. + + {'REG','MDA','MD2','QDA','QDA2','LD2','LD3','LD4','LD5','LD6','NBC','aNBC','WienerHopf','LDA/GSVD','MDA/GSVD', 'LDA/sparse','MDA/sparse', 'PLA', 'LMS','LDA/DELETION','MDA/DELETION','NBC/DELETION','RDA/DELETION','REG/DELETION','RDA','GDBC','SVM','RBF','PSVM','SVM11','SVM:LIN4','SVM:LIN0','SVM:LIN1','SVM:LIN2','SVM:LIN3','WINNOW', 'DT'}; + + CC contains the model parameters of a classifier. Some time ago, + CC was a statistical classifier containing the mean + and the covariance of the data of each class (encoded in the + so-called "extended covariance matrices". Nowadays, also other + classifiers are supported. + + see also: TEST_SC, COVM, ROW_COL_DELETION + + References: + [1] R. Duda, P. Hart, and D. Stork, Pattern Classification, second ed. + John Wiley & Sons, 2001. + [2] Peg Howland and Haesun Park, + Generalizing Discriminant Analysis Using the Generalized Singular Value Decomposition + IEEE Transactions on Pattern Analysis and Machine Intelligence, 26(8), 2004. + dx.doi.org/10.1109/TPAMI.2004.46 + [3] http://www-static.cc.gatech.edu/~kihwan23/face_recog_gsvd.htm + [4] Jieping Ye, Ravi Janardan, Cheong Hee Park, Haesun Park + A new optimization criterion for generalized discriminant analysis on undersampled problems. + The Third IEEE International Conference on Data Mining, Melbourne, Florida, USA + November 19 - 22, 2003 + [5] J.D. Tebbens and P. Schlesinger (2006), + Improving Implementation of Linear Discriminant Analysis for the Small Sample Size Problem + Computational Statistics & Data Analysis, vol 52(1): 423-437, 2007 + http://www.cs.cas.cz/mweb/download/publi/JdtSchl2006.pdf + [6] H. Zhang, The optimality of Naive Bayes, + http://www.cs.unb.ca/profs/hzhang/publications/FLAIRS04ZhangH.pdf + [7] J.H. Friedman. Regularized discriminant analysis. + Journal of the American Statistical Association, 84:165–175, 1989. + [8] G. Fung and O.L. Mangasarian, Proximal Support Vector Machine Classifiers, KDD 2001. + Eds. F. Provost and R. Srikant, Proc. KDD-2001: Knowledge Discovery and Data Mining, August 26-29, 2001, San Francisco, CA. + p. 77-86. + [9] Kai Keng Ang, Zhang Yang Chin, Haihong Zhang, Cuntai Guan. + Filter Bank Common Spatial Pattern (FBCSP) in Brain-Computer Interface. + IEEE International Joint Conference on Neural Networks, 2008. IJCNN 2008. (IEEE World Congress on Computational Intelligence). + 1-8 June 2008 Page(s):2390 - 2397 + [10] R.-E. Fan, K.-W. Chang, C.-J. Hsieh, X.-R. Wang, and C.-J. Lin. + LIBLINEAR: A Library for Large Linear Classification, Journal of Machine Learning Research 9(2008), 1871-1874. + Software available at http://www.csie.ntu.edu.tw/~cjlin/liblinear + [11] http://en.wikipedia.org/wiki/Perceptron#Learning_algorithm + [12] Littlestone, N. (1988) + "Learning Quickly When Irrelevant Attributes Abound: A New Linear-threshold Algorithm" + Machine Learning 285-318(2) + http://en.wikipedia.org/wiki/Winnow_(algorithm) + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Train a (statistical) classifier + + CC = train_sc(D,classlabel) + CC = train_s + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +trimean + + +# name: +# type: sq_string +# elements: 1 +# length: 266 + TRIMEAN yields the weighted mean of the median and the quartiles + m = TRIMEAN(y). + + The trimean is m = (Q1+2*MED+Q3)/4 + with quartile Q1 and Q3 and median MED + + N-dimensional data is supported + + REFERENCES: + [1] http://mathworld.wolfram.com/Trimean.html + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + TRIMEAN yields the weighted mean of the median and the quartiles + m = TRIMEA + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +trimmean + + +# name: +# type: sq_string +# elements: 1 +# length: 664 + TRIMMEAN calculates the trimmed mean by removing the fraction of p/2 upper and + p/2 lower samples. Missing values (encoded as NaN) are ignored and not taken into account. + The same number from the upper and lower values are removed, and is compatible to various + spreadsheet programs including GNumeric [1], LibreOffice, OpenOffice and MS Excel. + + Q = trimmean(Y,p) + Q = trimmean(Y,p,DIM) + returns the TRIMMEAN along dimension DIM of sample array Y. + If p is a vector, the TRIMMEAN for each p is computed. + + see also: MAD, RANGE, HISTO2, HISTO3, PERCENTILE, QUANTILE + + References: + [1] http://www.fifi.org/doc/gnumeric-doc/html/C/gnumeric-trimmean.html + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + TRIMMEAN calculates the trimmed mean by removing the fraction of p/2 upper and + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ttest + + +# name: +# type: sq_string +# elements: 1 +# length: 1474 + TTEST (paired) t-test + For a sample X from a normal distribution with unknown mean and + variance, perform a t-test of the null hypothesis `mean (X) == M'. + Under the null, the test statistic T follows a Student + distribution with `DF = length (X) - 1' degrees of freedom. + + TTEST treads NaNs as "Missing values" and ignores these. + + H = ttest(x,m) + tests Null-hypothesis that mean of x is m. + H = ttest(x,y) + size of x and size of y must match, it is tested whether the + difference x-y is significantly different to m=0; + H = ttest(x,y,alpha) + H = ttest(x,y,alpha,tail) + H = ttest(x,y,alpha,tail,DIM) + [H,PVAL] = ttest(...) + + H=1 indicates a rejection of the Null-hypothesis at a significance + level of alpha (default alpha = 0.05). + + With the optional argument string TAIL, the alternative of interest + can be selected. If TAIL is '!=' or '<>' or 'both', the null is tested + against the two-sided Alternative `mean (X) ~= mean (Y)'. If TAIL + is '>' or 'right', the one-sided Alternative `mean (X) > mean (Y)' is used. + Similarly for '<' or 'left', the one-sided Alternative `mean (X) < mean + (Y)' is used. The default is the two-sided case. + + H returns whether the Null-Hypotheses must be rejected. + The p-value of the test is returned in PVAL. + + TTEST works on the first non-singleton dimension or on DIM. + + If no output argument is given, the p-value of the test is + displayed. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + TTEST (paired) t-test + For a sample X from a normal distribution with unkno + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ttest2 + + +# name: +# type: sq_string +# elements: 1 +# length: 1514 + TTEST2 (unpaired) t-test + 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 T follows a Student distribution with DF degrees of + freedom. + + TTEST2 treads NaNs as "Missing values" and ignores these. + + H = ttest2(x,y) + H = ttest2([x;y],C,W) + H = ttest2(x,y,alpha) + H = ttest2(x,y,alpha,tail) + H = ttest2(x,y,alpha,tail,vartype) + H = ttest2(x,y,alpha,tail,vartype,DIM) + [H,PVAL] = ttest2(...) + [h,p,ci,stats] = ttest2(...) + + H=1 indicates a rejection of the Null-hypothesis at a significance + level of alpha (default alpha = 0.05). + + With the optional argument string TAIL, the Alternative of interest + can be selected. If TAIL is '!=' or '<>' or 'both', the null is tested + against the two-sided Alternative `mean (X) ~= mean (Y)'. If TAIL + is '>' or 'right', the one-sided Alternative `mean (X) > mean (Y)' is used. + Similarly for '<' or 'left', the one-sided Alternative `mean (X) < mean + (Y)' is used. The default is the two-sided case. + + vartype support only 'equal' (default value); the value 'unequal' is not supported. + + H returns whether the Null-Hypotheses must be rejected. + The p-value of the test is returned in PVAL. + + TTEST2 works on the first non-singleton dimension or on DIM. + + If no output argument is given, the p-value of the test is + displayed. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + TTEST2 (unpaired) t-test + For two samples x and y from normal distributions + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +var + + +# name: +# type: sq_string +# elements: 1 +# length: 772 + VAR calculates the variance. + + y = var(x [, opt[, DIM]]) + calculates the variance in dimension DIM + the default DIM is the first non-single dimension + + opt 0: normalizes with N-1 [default] + 1: normalizes with N + DIM dimension + 1: VAR of columns + 2: VAR of rows + N: VAR of N-th dimension + default or []: first DIMENSION, with more than 1 element + W weights to compute weighted variance (default: []) + if W=[], all weights are 1. + number of elements in W must match size(x,DIM) + + usage: + var(x) + var(x, opt, DIM) + var(x, [], DIM) + var(x, W, DIM) + var(x, opt, DIM, W) + + features: + - can deal with NaN's (missing values) + - weighting of data + - dimension argument + - compatible to Matlab and Octave + + see also: MEANSQ, SUMSQ, SUMSKIPNAN, MEAN, RMS, STD, + + + +# name: +# type: sq_string +# elements: 1 +# length: 29 + VAR calculates the variance. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +xcovf + + +# name: +# type: sq_string +# elements: 1 +# length: 1059 + XCOVF generates cross-covariance function. + XCOVF is the same as XCORR except + X and Y can contain missing values encoded with NaN. + NaN's are skipped, NaN do not result in a NaN output. + The output gives NaN only if there are insufficient input data + + [C,N,LAGS] = xcovf(X,MAXLAG,SCALEOPT); + calculates the (auto-)correlation function of X + [C,N,LAGS] = xcovf(X,Y,MAXLAG,SCALEOPT); + calculates the crosscorrelation function between X and Y + + SCALEOPT [character string] specifies the type of scaling applied + to the correlation vector (or matrix). is one of: + 'none' return the unscaled correlation, R, + 'biased' return the biased average, R/N, + 'unbiased' return the unbiassed average, R(k)/(N-|k|), + 'coeff' return the correlation coefficient, R/(rms(x).rms(y)), + where "k" is the lag, and "N" is the length of X. + If omitted, the default value is "none". + If Y is supplied but does not have the ame length as X, + scale must be "none". + + + see also: COVM, XCORR + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 + XCOVF generates cross-covariance function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +xptopen + + +# name: +# type: sq_string +# elements: 1 +# length: 723 + XPTOPEN read of several file formats and writing of the SAS Transport Format (*.xpt) + Supported are ARFF, SAS-XPT and STATA files. + XPTOPEN is a mex-file and must be compiled before use. + More detailed help can be obtained by the command + xptopen + without an additional argument + + X = xptopen(filename) + X = xptopen(filename,'r') + read file with filename and return variables in struct X + + X = xptopen(filename,'w',X) + save fields of struct X in filename. + + The fields of X must be column vectors of equal length. + Each vector is either a numeric vector or a cell array of strings. + The SAS-XPT format stores Date/Time as numeric value counting the number of days since 1960-01-01. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + XPTOPEN read of several file formats and writing of the SAS Transport Format (* + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +xval + + +# name: +# type: sq_string +# elements: 1 +# length: 2980 + XVAL is used for crossvalidation + + [R,CC] = xval(D,classlabel) + .. = xval(D,classlabel,CLASSIFIER) + .. = xval(D,classlabel,CLASSIFIER,type) + .. = xval(D,{classlabel,W},CLASSIFIER) + .. = xval(D,{classlabel,W,NG},CLASSIFIER) + + example: + load_fisheriris; %builtin iris dataset + C = species; + K = 5; NG = [1:length(C)]'*K/length(C); + [R,CC] = xval(meas,{C,[],NG},'NBC'); + + Input: + D: data features (one feature per column, one sample per row) + classlabel labels of each sample, must have the same number of rows as D. + Two different encodings are supported: + {-1,1}-encoding (multiple classes with separate columns for each class) or + 1..M encoding. + So [1;2;3;1;4] is equivalent to + [+1,-1,-1,-1; + [-1,+1,-1,-1; + [-1,-1,+1,-1; + [+1,-1,-1,-1] + [-1,-1,-1,+1] + Note, samples with classlabel=0 are ignored. + + CLASSIFIER can be any classifier supported by train_sc (default='LDA') + {'REG','MDA','MD2','QDA','QDA2','LD2','LD3','LD4','LD5','LD6','NBC','aNBC','WienerHopf', 'RDA','GDBC', + 'SVM','RBF','PSVM','SVM11','SVM:LIN4','SVM:LIN0','SVM:LIN1','SVM:LIN2','SVM:LIN3','WINNOW'} + these can be modified by ###/GSVD, ###/sparse and ###/DELETION. + /DELETION removes in case of NaN's either the rows or the columns (which removes less data values) with any NaN + /sparse and /GSVD preprocess the data an reduce it to some lower-dimensional space. + Hyperparameters (like alpha for PLA, gamma/lambda for RDA, c_value for SVM, etc) can be defined as + CLASSIFIER.hyperparameter.alpha, etc. and + CLASSIFIER.TYPE = 'PLA' (as listed above). + See train_sc for details. + W: weights for each sample (row) in D. + default: [] (i.e. all weights are 1) + number of elements in W must match the number of rows of D + NG: used to define the type of cross-valdiation + Leave-One-Out-Method (LOOM): NG = [1:length(classlabel)]' (default) + Leave-K-Out-Method: NG = ceil([1:length(classlabel)]'/K) + K-fold XV: NG = ceil([1:length(classlabel)]'*K/length(classlabel)) + group-wise XV (if samples are not indepentent) can be also defined here + samples from the same group (dependent samples) get the same identifier + samples from different groups get different classifiers + TYPE: defines the type of cross-validation procedure if NG is not specified + 'LOOM' leave-one-out-method + k k-fold crossvalidation + + OUTPUT: + R contains the resulting performance metric + CC contains the classifier + + plota(R) shows the confusion matrix of the results + + see also: TRAIN_SC, TEST_SC, CLASSIFY, PLOTA + + References: + [1] R. Duda, P. Hart, and D. Stork, Pattern Classification, second ed. + John Wiley & Sons, 2001. + [2] A. Schlögl, J. Kronegg, J.E. Huggins, S. G. Mason; + Evaluation criteria in BCI research. + (Eds.) G. Dornhege, J.R. Millan, T. Hinterberger, D.J. McFarland, K.-R.Müller; + Towards Brain-Computer Interfacing, MIT Press, 2007, p.327-342 + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 + XVAL is used for crossvalidation + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +zScoreMedian + + +# name: +# type: sq_string +# elements: 1 +# length: 326 + zScoreMedian removes the median and standardizes by the 1.483*median absolute deviation + + Usage: Z = zScoreMedian(X, DIM) + Input: X : data + DIM: dimension along which z-score should be calculated (1=columns, 2=rows) + (optional, default=first dimension with more than 1 element + Output: Z : z-scores + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 + zScoreMedian removes the median and standardizes by the 1. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +zscore + + +# name: +# type: sq_string +# elements: 1 +# length: 622 + ZSCORE removes the mean and normalizes the data + to a variance of 1. Can be used for Pre-Whitening of the data, too. + + [z,r,m] = zscore(x,DIM) + z z-score of x along dimension DIM + r is the inverse of the standard deviation + m is the mean of x + + The data x can be reconstrated with + x = z*diag(1./r) + repmat(m,size(z)./size(m)) + z = x*diag(r) - repmat(m.*v,size(z)./size(m)) + + DIM dimension + 1: STATS of columns + 2: STATS of rows + default or []: first DIMENSION, with more than 1 element + + see also: SUMSKIPNAN, MEAN, STD, DETREND + + REFERENCE(S): + [1] http://mathworld.wolfram.com/z-Score.html + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 + ZSCORE removes the mean and normalizes the data + to a variance of 1. + + + + + diff --git a/octave_packages/nan-2.5.5/ecdf.m b/octave_packages/nan-2.5.5/ecdf.m new file mode 100644 index 0000000..9109588 --- /dev/null +++ b/octave_packages/nan-2.5.5/ecdf.m @@ -0,0 +1,80 @@ +function [F,X]=ecdf(h,Y) +% ECDF empirical cumulative function +% NaN's are considered Missing values and are ignored. +% +% [F,X] = ecdf(Y) +% calculates empirical cumulative distribution functions (i.e Kaplan-Meier estimate) +% ecdf(Y) +% ecdf(gca,Y) +% without output arguments plots the empirical cdf, in axis gca. +% +% Y input data +% must be a vector or matrix, in case Y is a matrix, the ecdf for every column is computed. +% +% see also: HISTO2, HISTO3, PERCENTILE, QUANTILE + + +% $Id: ecdf.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +if ~isscalar(h) || ~ishandle(h) || isstruct(h), + Y = h; + h = []; +end; + +DIM = []; + + SW = isstruct(Y); + if SW, SW = isfield(Y,'datatype'); end; + if SW, SW = strcmp(Y.datatype,'HISTOGRAM'); end; + if SW, + [yr,yc]=size(Y.H); + if ~isfield(Y,'N'); + Y.N = sum(Y.H,1); + end; + f = [zeros(1,yc);cumsum(Y.H,1)]; + for k=1:yc, + f(:,k)=f(:,k)/Y.N(k); + end; + t = [Y.X(1,:);Y.X]; + + elseif isnumeric(Y), + sz = size(Y); + if isempty(DIM), + DIM = min(find(sz>1)); + if isempty(DIM), DIM = 1; end; + end; + if DIM==2, Y=Y.'; DIM = 1; end; + + t = sort(Y,1); + t = [t(1,:);t]; + N = sum(~isnan(Y),1); + f = zeros(size(Y,1)+1,size(Y,2)); + for k=1:size(Y,2), + f(:,k)=[0:size(Y,1)]'/N(k); + end; + end; + + if nargout<1, + if ~isempty(h), axes(h); end; + stairs(t,f); + else + F = f; + X = t; + end; + diff --git a/octave_packages/nan-2.5.5/flag_accuracy_level.m b/octave_packages/nan-2.5.5/flag_accuracy_level.m new file mode 100644 index 0000000..973d90c --- /dev/null +++ b/octave_packages/nan-2.5.5/flag_accuracy_level.m @@ -0,0 +1,76 @@ +function FLAG = flag_accuracy_level(i) +% FLAG_ACCURACY_LEVEL sets and gets accuracy level +% used in SUMSKIPNAN_MEX and COVM_MEX +% The error margin of the naive summation is N*eps (N is the number of samples), +% the error margin is only 2*eps if Kahan's summation is used [1]. +% +% 0: maximum speed [default] +% accuracy of double (64bit) with naive summation (error = N*2^-52) +% 1: accuracy of extended (80bit) with naive summation (error = N*2^-64) +% 2: accuracy of double (64bit) with Kahan summation (error = 2^-52) +% 3: accuracy of extended (80bit) with Kahan summation (error = 2^-64) +% +% Please note, level 3 might be equally accurate but slower than 1 or 2 on +% some platforms. In order to determine what is good for you, you might want +% to run ACCTEST. +% +% FLAG = flag_accuracy_level() +% gets current level +% flag_accuracy_level(FLAG) +% sets accuracy level +% +% see also: ACCTEST +% +% Reference: +% [1] David Goldberg, +% What Every Computer Scientist Should Know About Floating-Point Arithmetic +% ACM Computing Surveys, Vol 23, No 1, March 1991. + + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +% $Id$ +% Copyright (C) 2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +persistent FLAG_ACCURACY_LEVEL; + +%% if strcmp(version,'3.6'), FLAG_ACCURACY_LEVEL=1; end; %% hack for the use with Freemat3.6 + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% set the default accuracy level for your platform, ACCTEST might help to determine the optimum for your platform. +%% If you use Matlab, use level 0 or 2; 1 and 3 are much slower but do not show a better accuracy +%% Octave seems to be able to use all 4 levels, were the differences of accuracy between succeeding levels become smaller +DEFAULT_ACCURACY_LEVEL = 0; %% maximum speed, accuracy sufficient for most needs. +%% DEFAULT_ACCURACY_LEVEL = 2; %% slower, but better accuracy for: AMDx64 Opteron, Phenom, Intel Pentium +%% DEFAULT_ACCURACY_LEVEL = 1; %% slower, but better accuracy for: Octave on Intel Atom (no improvement with Matlab, just slower) +%% DEFAULT_ACCURACY_LEVEL = 3; %% similar accuracy than 1 or 2 (depending on platform) but even slower. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +%%% set DEFAULT value of FLAG +if isempty(FLAG_ACCURACY_LEVEL), + FLAG_ACCURACY_LEVEL = DEFAULT_ACCURACY_LEVEL; +end; + +if nargin>0, + if (i>3), i=3; end; + if (i<0), i=0; end; + FLAG_ACCURACY_LEVEL = double(i); +end; +FLAG = FLAG_ACCURACY_LEVEL; + diff --git a/octave_packages/nan-2.5.5/flag_implicit_significance.m b/octave_packages/nan-2.5.5/flag_implicit_significance.m new file mode 100644 index 0000000..d598a1f --- /dev/null +++ b/octave_packages/nan-2.5.5/flag_implicit_significance.m @@ -0,0 +1,67 @@ +function alpha=flag_implicit_significance(i) +% The use of FLAG_IMPLICIT_SIGNIFICANCE is in experimental state. +% flag_implicit_significance might even become obsolete. +% +% FLAG_IMPLICIT_SIGNIFICANCE sets and gets default alpha (level) of any significance test +% The default alpha-level is stored in the global variable FLAG_implicit_significance +% The idea is that the significance must not be assigned explicitely. +% This might yield more readable code. +% +% Choose alpha low enough, because in alpha*100% of the cases, you will +% reject the Null hypothesis just by change. For this reason, the default +% alpha is 0.01. +% +% flag_implicit_significance(0.01) +% sets the alpha-level for the significance test +% +% alpha = flag_implicit_significance() +% gets default alpha +% +% flag_implicit_significance(alpha) +% sets default alpha-level +% +% alpha = flag_implicit_significance(alpha) +% gets and sets alpha +% +% features: +% - compatible to Matlab and Octave +% +% see also: CORRCOEF, PARTCORRCOEF + +% $Id: flag_implicit_significance.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2002,2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ +% +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + +persistent FLAG_implicit_significance; +DEFAULT_ALPHA = 0.01; + +%%% check whether FLAG was already defined +if ~exist('FLAG_implicit_significance','var'), + FLAG_implicit_significance = DEFAULT_ALPHA; % default value +end; +if isempty(FLAG_implicit_significance), + FLAG_implicit_significance = DEFAULT_ALPHA; % default value +end; + +if nargin>0, + fprintf(2,'Warning: flag_implicit_significance is in an experimental state\n'); + fprintf(2,'It might become obsolete.\n'); + FLAG_implicit_significance = i; +end; + +alpha = FLAG_implicit_significance; diff --git a/octave_packages/nan-2.5.5/flag_implicit_skip_nan.m b/octave_packages/nan-2.5.5/flag_implicit_skip_nan.m new file mode 100644 index 0000000..7052e14 --- /dev/null +++ b/octave_packages/nan-2.5.5/flag_implicit_skip_nan.m @@ -0,0 +1,65 @@ +function FLAG = flag_implicit_skip_nan(i) +% FLAG_IMPLICIT_SKIP_NAN sets and gets default mode for handling NaNs +% 1 skips NaN's (the default mode if no mode is set) +% 0 NaNs are propagated; input NaN's give NaN's at the output +% +% FLAG = flag_implicit_skip_nan() +% gets current mode +% +% flag_implicit_skip_nan(FLAG) % sets mode +% +% prevFLAG = flag_implicit_skip_nan(nextFLAG) +% gets previous set FLAG and sets FLAG for the future +% flag_implicit_skip_nan(prevFLAG) +% resets FLAG to previous mode +% +% It is used in: +% SUMSKIPNAN, MEDIAN, QUANTILES, TRIMEAN +% and affects many other functions like: +% CENTER, KURTOSIS, MAD, MEAN, MOMENT, RMS, SEM, SKEWNESS, +% STATISTIC, STD, VAR, ZSCORE etc. +% +% The mode is stored in the global variable FLAG_implicit_skip_nan +% It is recommended to use flag_implicit_skip_nan(1) as default and +% flag_implicit_skip_nan(0) should be used for exceptional cases only. +% This feature might disappear without further notice, so you should really not +% rely on it. + + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +% $Id: flag_implicit_skip_nan.m 8351 2011-06-24 17:35:07Z carandraug $ +% Copyright (C) 2001-2003,2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +persistent FLAG_implicit_skip_nan; + +%% if strcmp(version,'3.6'), FLAG_implicit_skip_nan=(1==1); end; %% hack for the use with Freemat3.6 + +%%% set DEFAULT value of FLAG +if isempty(FLAG_implicit_skip_nan), + FLAG_implicit_skip_nan = (1==1); %logical(1); % logical.m not available on 2.0.16 +end; + +FLAG = FLAG_implicit_skip_nan; +if nargin>0, + FLAG_implicit_skip_nan = (i~=0); %logical(i); %logical.m not available in 2.0.16 + if (~i) + warning('flag_implicit_skipnan(0): You are warned!!! You have turned off skipping NaN in sumskipnan. This is not recommended. Make sure you really know what you do.') + end; +end; + diff --git a/octave_packages/nan-2.5.5/flag_nans_occured.m b/octave_packages/nan-2.5.5/flag_nans_occured.m new file mode 100644 index 0000000..f3027c3 --- /dev/null +++ b/octave_packages/nan-2.5.5/flag_nans_occured.m @@ -0,0 +1,41 @@ +function [flag]=flag_nans_occured() +% FLAG_NANS_OCCURED checks whether the last call(s) to sumskipnan or covm +% contained any not-a-numbers in the input argument. Because many other +% functions like mean, std, etc. are also using sumskipnan, +% also these functions can be checked for NaN's in the input data. +% +% A call to FLAG_NANS_OCCURED() resets also the flag whether NaN's occured. +% Only sumskipnan or covm can set the flag again. +% +% see also: SUMSKIPNAN, COVM + +% $Id$ +% Copyright (C) 2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +global FLAG_NANS_OCCURED; + +%%% check whether FLAG was already defined +if isempty(FLAG_NANS_OCCURED), + FLAG_NANS_OCCURED = logical(0); % default value +end; + +flag = FLAG_NANS_OCCURED; % return value + +FLAG_NANS_OCCURED = logical(0); % reset flag + +return; diff --git a/octave_packages/nan-2.5.5/fss.m b/octave_packages/nan-2.5.5/fss.m new file mode 100644 index 0000000..f858b32 --- /dev/null +++ b/octave_packages/nan-2.5.5/fss.m @@ -0,0 +1,144 @@ +function [idx,score] = fss(D,cl,N,MODE) +% FSS - feature subset selection and feature ranking +% the method is motivated by the max-relevance-min-redundancy (mRMR) +% approach [1]. However, the default method uses partial correlation, +% which has been developed from scratch. PCCM [3] describes +% a similar idea, but is more complicated. +% An alternative method based on FSDD is implemented, too. +% +% [idx,score] = fss(D,cl) +% [idx,score] = fss(D,cl,MODE) +% [idx,score] = fss(D,cl,MODE) +% +% D data - each column represents a feature +% cl classlabel +% Mode 'Pearson' [default] correlation +% 'rank' correlation +% 'FSDD' feature selection algorithm based on a distance discriminant [2] +% %%% 'MRMR','MID','MIQ' max-relevance, min redundancy [1] - not supported yet. +% +% score score of the feature +% idx ranking of the feature +% [tmp,idx]=sort(-score) +% +% see also: TRAIN_SC, XVAL, ROW_COL_DELETION +% +% REFERENCES: +% [1] Peng, H.C., Long, F., and Ding, C., +% Feature selection based on mutual information: criteria of max-dependency, max-relevance, and min-redundancy, +% IEEE Transactions on Pattern Analysis and Machine Intelligence, +% Vol. 27, No. 8, pp.1226-1238, 2005. +% [2] Jianning Liang, Su Yang, Adam Winstanley, +% Invariant optimal feature selection: A distance discriminant and feature ranking based solution, +% Pattern Recognition, Volume 41, Issue 5, May 2008, Pages 1429-1439. +% ISSN 0031-3203, DOI: 10.1016/j.patcog.2007.10.018. +% [3] K. Raghuraj Rao and S. Lakshminarayanan +% Partial correlation based variable selection approach for multivariate data classification methods +% Chemometrics and Intelligent Laboratory Systems +% Volume 86, Issue 1, 15 March 2007, Pages 68-81 +% http://dx.doi.org/10.1016/j.chemolab.2006.08.007 + +% $Id: fss.m 9104 2011-11-15 15:14:10Z carandraug $ +% Copyright (C) 2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + if nargin<3 + MODE = []; + N = []; + elseif ischar(N) + MODE = N; + N = []; + elseif nargin<4, + MODE = []; + end + + if isempty(N), N = size(D,2); end + score = repmat(NaN,1,size(D,2)); + + if 0, %strcmpi(MODE,'MRMR') || strcmpi(MODE,'MID') || strcmpi(MODE,'MIQ'); + %% RMRM/MID/MIQ is not supported + %% TODO: FIXME + + [tmp,t] = sort([cl,D]); + cl = t(:,1:size(cl,2)); + D = t(:,1:size(D,2)); + for k = 1:N, + V(k) = mi(cl, D(:,k)); + + for m = 1:N, + W(k,m) = mi(D(:,m), D(:,k)); + end + MID(k) = V(k) - mean(W(k,:)); + MIQ(k) = V(k) / mean(W(k,:)); + end + + if strcmpi(MODE,'MIQ') + [score,idx] = sort(MIQ,[],'descend'); + else + [score,idx] = sort(MID,[],'descend'); + end + + elseif strcmpi(MODE,'FSDD'); + [b,i,j]=unique(cl); + for k=1:length(b) + n(k,1) = sum(j==k); + m(k,:) = mean(D(j==k,:),1); + v(k,:) = var(D(j==k,:),1); + end + m0 = mean(m,1,n); + v0 = var(D,[],1); + s2 = mean(m.^2,1,n) - m0.^2; + score = (s2 - 2*mean(v,1,n)) ./ v0; + [t,idx] = sort(-score); + + elseif isempty(MODE) || strcmpi(MODE,'rank') || strcmpi(MODE,'Pearson') + cl = cat2bin(cl); + if strcmpi(MODE,'rank'), + [tmp,D] = sort(D,1); + end + idx = repmat(NaN,1,N); + for k = 1:N, + f = isnan(score); + + %%%%% compute partial correlation (X,Y|Z) + % r = partcorrcoef(cl, D(:,f), D(:,~f)); % obsolete, not very robust + + %% this is a more robust version + X = cl; Y = D(:,f); Z = D(:,~f); + if (k>1) + X = X-Z*(Z\X); + Y = Y-Z*(Z\Y); + end + r = corrcoef(X,Y); + + [s,ix] = max(sumsq(r,1)); + f = find(f); + idx(k) = f(ix); + score(idx(k)) = s; + end + + end +end + +function I = mi(x,y) + ix = ~any(isnan([x,y]),2); + H = sparse(x(ix),y(ix)); + pij = H./sum(ix); + Iij = pij.*log2(pij./(sum(pij,2)*sum(pij,1))); + Iij(isnan(Iij)) = 0; + I = sum(Iij(:)); +end diff --git a/octave_packages/nan-2.5.5/geomean.m b/octave_packages/nan-2.5.5/geomean.m new file mode 100644 index 0000000..449c377 --- /dev/null +++ b/octave_packages/nan-2.5.5/geomean.m @@ -0,0 +1,53 @@ +function [y] = geomean(x,DIM,W) +% GEOMEAN calculates the geomentric mean of data elements. +% +% y = geomean(x [,DIM [,W]]) is the same as +% y = mean(x,'G' [,DIM]) +% +% DIM dimension +% 1 STD of columns +% 2 STD of rows +% default or []: first DIMENSION, with more than 1 element +% W weights to compute weighted mean (default: []) +% if W=[], all weights are 1. +% number of elements in W must match size(x,DIM) +% +% features: +% - can deal with NaN's (missing values) +% - weighting of data +% - dimension argument also in Octave +% - compatible to Matlab and Octave +% +% see also: SUMSKIPNAN, MEAN, HARMMEAN +% +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + +% $Id: geomean.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2002,2009 by Alois Schloegl +% This is part of the NaN-toolbox. For more details see +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +if nargin<2 + DIM=min(find(size(x)>1)); + if isempty(DIM), DIM=1; end; +end +if nargin<3 + W = []; +end; + +[y, n] = sumskipnan(log(x),DIM,W); +y = exp (y./n); + diff --git a/octave_packages/nan-2.5.5/gscatter.m b/octave_packages/nan-2.5.5/gscatter.m new file mode 100644 index 0000000..0599760 --- /dev/null +++ b/octave_packages/nan-2.5.5/gscatter.m @@ -0,0 +1,98 @@ +function [h] = gscatter(x,y,group,clr,sym,siz,doleg,xname,yname) +% GSCATTER scatter plot of groups +% +% gscatter(x,y,group) +% gscatter(x,y,group,clr,sym,siz) +% gscatter(x,y,group,clr,sym,siz,doleg) +% gscatter(x,y,group,clr,sym,siz,doleg,xname,yname) +% h = gscatter(...) +% +% x,y, group: vectors with equal length +% clf: color vector, default 'bgrcmyk' +% sym: symbol, default '.' +% siz: size of Marker +% doleg: 'on' (default) shows legend, 'off' turns of legend +% xname, yname: name of axis +% +% +% see also: ecdf, cdfplot +% +% References: + +% $Id$ +% Copyright (C) 2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 3 +% of the License, or (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + +[b,i,j] = unique(group); + +if nargin<3 + help gscatter; + error('invalid number of arguments;') +end; +if nargin<4 + clr = []; +end +if nargin<5 + sym = []; +end +if nargin<6 + siz = []; +end +if nargin<7 + doleg = []; +end +if nargin<8 + xname = []; +end +if nargin<9 + yname = []; +end; +if isempty(clr), clr='bgrcmyk'; end; +if isempty(sym), sym='.'; end; +if isempty(doleg), doleg='on'; end; + +for k=1:length(b); + %ix = find(k==j); + c = clr(mod(k-1,length(clr))+1); + s = sym(mod(k-1,length(sym))+1); + hh(k) = plot(x(k==j),y(k==j),[c,s]); + if ~isempty(siz) + z = siz(mod(k-1,length(siz))+1); + set(hh(k),'MarkerSize',z); + end + hold on; +end; +hold off; + +if ~strcmpi(doleg,'off') + if isnumeric(b) + b=num2str(b(:)); + end; + legend(b); +end; +if ~isempty(xname) + xlabel(xname); +end; +if ~isempty(yname) + ylabel(yname); +end; + +if nargout>0, + h = hh; +end; + diff --git a/octave_packages/nan-2.5.5/harmmean.m b/octave_packages/nan-2.5.5/harmmean.m new file mode 100644 index 0000000..5d191aa --- /dev/null +++ b/octave_packages/nan-2.5.5/harmmean.m @@ -0,0 +1,56 @@ +function [y] = harmmean(x,DIM,W) +% HARMMEAN calculates the harmonic mean of data elements. +% The harmonic mean is the inverse of the mean of the inverse elements. +% +% y = harmmean(x [,DIM [,W]]) is the same as +% y = mean(x,'H' [,DIM [,W]]) +% +% DIM dimension +% 1 STD of columns +% 2 STD of rows +% default or []: first DIMENSION, with more than 1 element +% W weights to compute weighted mean (default: []) +% if W=[], all weights are 1. +% number of elements in W must match size(x,DIM) +% +% features: +% - can deal with NaN's (missing values) +% - weighting of data +% - dimension argument also in Octave +% - compatible to Matlab and Octave +% +% see also: SUMSKIPNAN, MEAN, GEOMEAN +% + +% 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 . + + +% $Id: harmmean.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2002,2009 by Alois Schloegl +% This is part of the NaN-toolbox. For more details see +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + + +if nargin<2 + DIM=min(find(size(x)>1)); + if isempty(DIM), DIM=1; end; +end; +if nargin<3 + W = []; +end; + +[y, n] = sumskipnan(1./x,DIM,W); +y = n./y; + diff --git a/octave_packages/nan-2.5.5/hist2res.m b/octave_packages/nan-2.5.5/hist2res.m new file mode 100644 index 0000000..9d805b1 --- /dev/null +++ b/octave_packages/nan-2.5.5/hist2res.m @@ -0,0 +1,147 @@ +function [R]=hist2res(H,fun) +% Evaluates Histogram data +% [R]=hist2res(H) +% +% [y]=hist2res(H,fun) +% estimates fun-statistic +% +% fun 'mean' mean +% 'std' standard deviation +% 'var' variance +% 'sem' standard error of the mean +% 'rms' root mean square +% 'meansq' mean of squares +% 'sum' sum +% 'sumsq' sum of squares +% 'CM#' central moment of order # +% 'skewness' skewness +% 'kurtosis' excess coefficient (Fisher kurtosis) +% +% see also: NaN/statistic +% +% REFERENCES: +% [1] C.L. Nikias and A.P. Petropulu "Higher-Order Spectra Analysis" Prentice Hall, 1993. +% [2] C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). +% [3] http://www.itl.nist.gov/ +% [4] http://mathworld.wolfram.com/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 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, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + +% $Id: hist2res.m 9387 2011-12-15 10:42:14Z schloegl $ +% Copyright (c) 1996-2002,2006 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +if strcmp(H.datatype,'HISTOGRAM'), + +elseif strcmp(H.datatype,'qc:histo') + HDR = H; + if isfield(H,'THRESHOLD'), + TH = H.THRESHOLD; + else + TH = repmat([-inf,inf],HDR.NS,1); + end; + HIS = H.HIS; + + % remove overflowing samples + HIS.N = sumskipnan(HIS.H); + for k = 1:size(HIS.H,2); + t = HIS.X(:,min(k,size(HIS.X,2))); + HIS.H(xor(t<=min(TH(k,:)), t>=max(TH(k,:))),k) = 0; + end; + Nnew = sumskipnan(HIS.H); + R.ratio_lost = 1-Nnew./HIS.N; + HIS.N = Nnew; + + % scale into physical values + if H.FLAG.UCAL, + %t = HIS.X; + %for k=1:length(HDR.InChanSelect), + % HIS.X(:,k) = t(:,min(size(t,2),k))*HDR.Calib(k+1,k)+HDR.Calib(1,k); + %end; + HIS.X = [ones(size(HIS.X,1),1),repmat(HIS.X,1,size(HIS.H,2)./size(HIS.X,2))]*H.Calib; + end; + H = HIS; +else + fprintf(2,'ERROR: arg1 is not a histogram\n'); + return; +end; +if nargin<2, fun=[]; end; + +global FLAG_implicit_unbiased_estimation; +%%% check whether FLAG was already defined +if ~exist('FLAG_implicit_unbiased_estimation','var'), + FLAG_implicit_unbiased_estimation=[]; +end; +%%% set DEFAULT value of FLAG +if isempty(FLAG_implicit_unbiased_estimation), + FLAG_implicit_unbiased_estimation=logical(1); +end; + +sz = size(H.H)./size(H.X); +R.N = sumskipnan(H.H,1); +R.SUM = sumskipnan(H.H.*repmat(H.X,sz),1); +R.SSQ = sumskipnan(H.H.*repmat(H.X.*H.X,sz),1); +%R.S3P = sumskipnan(H.H.*repmat(H.X.^3,sz),1); % sum of 3rd power +R.S4P = sumskipnan(H.H.*repmat(H.X.^4,sz),1); % sum of 4th power +%R.S5P = sumskipnan(H.H.*repmat(H.X.^5,sz),1); % sum of 5th power + +R.MEAN = R.SUM./R.N; +R.MSQ = R.SSQ./R.N; +R.RMS = sqrt(R.MSQ); +R.SSQ0 = R.SSQ-R.SUM.*R.MEAN; % sum square of mean removed + +if FLAG_implicit_unbiased_estimation, + n1 = max(R.N-1,0); % in case of n=0 and n=1, the (biased) variance, STD and STE are INF +else + n1 = R.N; +end; + +R.VAR = R.SSQ0./n1; % variance (unbiased) +R.STD = sqrt(R.VAR); % standard deviation +R.SEM = sqrt(R.SSQ0./(R.N.*n1)); % standard error of the mean +R.SEV = sqrt(n1.*(n1.*R.S4P./R.N+(R.N.^2-2*R.N+3).*(R.SSQ./R.N).^2)./(R.N.^3)); % standard error of the variance +R.Coefficient_of_variation = R.STD./R.MEAN; + +R.CM2 = R.SSQ0./n1; +x = repmat(H.X,sz) - repmat(R.MEAN,size(H.X,1),1); +R.CM3 = sumskipnan(H.H.*(x.^3),1)./n1; +R.CM4 = sumskipnan(H.H.*(x.^4),1)./n1; +%R.CM5 = sumskipnan(H.H.*(x.^5),1)./n1; + +R.SKEWNESS = R.CM3./(R.STD.^3); +R.KURTOSIS = R.CM4./(R.VAR.^2)-3; +R.MAD = sumskipnan(H.H.*abs(x),1)./R.N; % mean absolute deviation + +H.PDF = H.H./H.N(ones(size(H.H,1),1),:); +status=warning('off'); +R.ENTROPY = -sumskipnan(H.PDF.*log2(H.PDF),1); +warning(status); +R.QUANT = repmat(min(diff(H.X,[],1)),1,size(H.H,2)/size(H.X,2)); +R.MAX = max(H.X); +R.MIN = min(H.X); +R.RANGE = R.MAX-R.MIN; + +if ~isempty(fun), + fun=upper(fun); + if strncmp(fun,'CM',2) + oo = str2double(fun(3:length(fun))); + R = sumskipnan(H.PDF.*(x.^oo),1); + else + R = getfield(R,fun); + end; +end; + diff --git a/octave_packages/nan-2.5.5/iqr.m b/octave_packages/nan-2.5.5/iqr.m new file mode 100644 index 0000000..c8e371d --- /dev/null +++ b/octave_packages/nan-2.5.5/iqr.m @@ -0,0 +1,52 @@ +function Q=iqr(Y,DIM) +% IQR calculates the interquartile range +% Missing values (encoded as NaN) are ignored. +% +% Q = iqr(Y) +% Q = iqr(Y,DIM) +% returns the IQR along dimension DIM of sample array Y. +% +% Q = iqr(HIS) +% returns the IQR from the histogram HIS. +% HIS must be a HISTOGRAM struct as defined in HISTO2 or HISTO3. +% +% see also: MAD, RANGE, HISTO2, HISTO3, PERCENTILE, QUANTILE + + +% $Id$ +% Copyright (C) 2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +if nargin<2, + DIM = []; +end; +if isempty(DIM), + DIM = min(find(size(Y)>1)); + if isempty(DIM), DIM = 1; end; +end; + + +if nargin<1, + help iqr + +else + Q = quantile(Y,[1,3]/4,DIM); + Q = diff(Q,[],DIM); +end; + + + diff --git a/octave_packages/nan-2.5.5/kappa.m b/octave_packages/nan-2.5.5/kappa.m new file mode 100644 index 0000000..54ca92c --- /dev/null +++ b/octave_packages/nan-2.5.5/kappa.m @@ -0,0 +1,190 @@ +function [kap,se,H,z,p0,SA,R]=kappa(d,c,arg3,w) +% KAPPA estimates Cohen's kappa coefficient +% and related statistics +% +% [...] = kappa(d1,d2); +% NaN's are handled as missing values and are ignored +% [...] = kappa(d1,d2,'notIgnoreNAN'); +% NaN's are handled as just another Label. +% [kap,sd,H,z,ACC,sACC,MI] = kappa(...); +% X = kappa(...); +% +% d1 data of scorer 1 +% d2 data of scorer 2 +% +% kap Cohen's kappa coefficient point +% se standard error of the kappa estimate +% H Concordance matrix, i.e. confusion matrix +% z z-score +% ACC overall agreement (accuracy) +% sACC specific accuracy +% MI Mutual information or transfer information (in [bits]) +% X is a struct containing all the fields above +% For two classes, a number of additional summary statistics including +% TPR, FPR, FDR, PPV, NPF, F1, dprime, Matthews Correlation coefficient (MCC) or +% Phi coefficient (PHI=MCC), Specificity and Sensitivity +% are provided. Note, the positive category must the larger label (in d and c), otherwise +% the confusion matrix becomes transposed and the summary statistics are messed up. +% +% +% Reference(s): +% [1] Cohen, J. (1960). A coefficient of agreement for nominal scales. Educational and Psychological Measurement, 20, 37-46. +% [2] J Bortz, GA Lienert (1998) Kurzgefasste Statistik f|r die klassische Forschung, Springer Berlin - Heidelberg. +% Kapitel 6: Uebereinstimmungsmasze fuer subjektive Merkmalsurteile. p. 265-270. +% [3] http://www.cmis.csiro.au/Fiona.Evans/personal/msc/html/chapter3.html +% [4] Kraemer, H. C. (1982). Kappa coefficient. In S. Kotz and N. L. Johnson (Eds.), +% Encyclopedia of Statistical Sciences. New York: John Wiley & Sons. +% [5] http://ourworld.compuserve.com/homepages/jsuebersax/kappa.htm +% [6] http://en.wikipedia.org/wiki/Receiver_operating_characteristic + +% $Id: kappa.m 9608 2012-02-10 09:56:25Z schloegl $ +% Copyright (c) 1997-2006,2008,2009,2011 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ +% +% BioSig is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% BioSig is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with BioSig. If not, see . + + +mode.ignoreNAN = 1; +kk = []; +if nargin>2 + if ischar(arg3) + if strcmpi(arg3,'notIgnoreNAN') + mode.ignoreNAN = 0; + end + else + kk = arg3; + end +end; +if nargin<4 + w = []; +end; + +if nargin>1, + d = d(:); + c = c(:); + + tmp = [d;c]; + maxtmp = max(tmp); + tmp(isnan(tmp)) = maxtmp+1; + [X.Label,i,j] = unique(tmp); + c = j(1+numel(d):end); + d = j(1:numel(d)); + kk = max(j); + maxCLASS = kk - any(tmp>maxtmp); + + if mode.ignoreNAN, + if any(j > maxCLASS) +% fprintf(2,'Warning KAPPA: some elements are NaN. These are handled as missing values and are ignored.\n'); +% fprintf(2,'If NaN should be handled as just another label, use kappa(..,''notIgnoreNaN'').\n'); + ix = find((c<=maxCLASS) & (d<=maxCLASS)); + d = d(ix); c=c(ix); + if ~isempty(w), w = w(ix); end; + kk = kk - 1; + end; + X.Label(X.Label>maxtmp) = []; + else + X.Label(X.Label>maxtmp) = NaN; + end; + + if isempty(w) + H = full( sparse (d, c, 1, kk, kk) ); + elseif ~isempty(w), + H = full( sparse (d, c, w, kk, kk) ); + end; + +else + X.Label = 1:min(size(d)); + H = d(X.Label,X.Label); + +end; + +s = warning; +warning('off'); + +N = sum(H(:)); +p0 = sum(diag(H))/N; %accuracy of observed agreement, overall agreement +%OA = sum(diag(H))/N); + +p_i = sum(H,1); +pi_ = sum(H,2)'; + +SA = 2*diag(H)'./(p_i+pi_); % specific agreement + +pe = (p_i*pi_')/(N*N); % estimate of change agreement + +px = sum(p_i.*pi_.*(p_i+pi_))/(N*N*N); + +%standard error +kap = (p0-pe)/(1-pe); +sd = sqrt((pe+pe*pe-px)/(N*(1-pe*pe))); + +%standard error +se = sqrt((p0+pe*pe-px)/N)/(1-pe); +if ~isreal(se), + z = NaN; +else + z = kap/se; +end + +if ((1 < nargout) && (nargout<7)) + warning(s); + return; +end; + +% Nykopp's entropy +pwi = sum(H,2)/N; % p(x_i) +pwj = sum(H,1)/N; % p(y_j) +pji = H./repmat(sum(H,2),1,size(H,2)); % p(y_j | x_i) +R = - sumskipnan(pwj.*log2(pwj)) + sumskipnan(pwi'*(pji.*log2(pji))); + +if (nargout>1), return; end; + +X.kappa = kap; +X.kappa_se = se; +X.data = H; +X.H = X.data; +X.z = z; +X.ACC = p0; +X.sACC = SA; +X.MI = R; +X.datatype = 'confusion'; + +if length(H)==2, + % see http://en.wikipedia.org/wiki/Receiver_operating_characteristic + % Note that the confusion matrix used here is has positive values in + % the 2nd row and column, moreover the true values are indicated by + % rows (transposed). Thus, in summary H(1,1) and H(2,2) are exchanged + % as compared to the wikipedia article. + X.TP = H(2,2); + X.TN = H(1,1); + X.FP = H(1,2); + X.FN = H(2,1); + X.FNR = H(2,1) / sum(H(2,:)); + X.FPR = H(1,2) / sum(H(1,:)); + X.TPR = H(2,2) / sum(H(2,:)); + X.PPV = H(2,2) / sum(H(:,2)); + X.NPV = H(1,1) / sum(H(:,1)); + X.FDR = H(1,2) / sum(H(:,2)); + X.MCC = det(H) / sqrt(prod([sum(H), sum(H')])); + X.PHI = X.MCC; + X.F1 = 2 * X.TP / (sum(H(2,:)) + sum(H(:,2))); + X.Sensitivity = X.TPR; %% hit rate, recall + X.Specificity = 1 - X.FPR; + X.Precision = X.PPV; + X.dprime = norminv(X.TPR) - norminv(X.FDR); +end; + +kap = X; +warning(s); diff --git a/octave_packages/nan-2.5.5/kurtosis.m b/octave_packages/nan-2.5.5/kurtosis.m new file mode 100644 index 0000000..6b5110c --- /dev/null +++ b/octave_packages/nan-2.5.5/kurtosis.m @@ -0,0 +1,66 @@ +function R=kurtosis(i,DIM) +% KURTOSIS estimates the kurtosis +% +% y = kurtosis(x,DIM) +% calculates kurtosis of x in dimension DIM +% +% DIM dimension +% 1: STATS of columns +% 2: STATS of rows +% default or []: first DIMENSION, with more than 1 element +% +% features: +% - can deal with NaN's (missing values) +% - dimension argument +% - compatible to Matlab and Octave +% +% see also: SUMSKIPNAN, VAR, STD, VAR, SKEWNESS, MOMENT, STATISTIC, +% IMPLICIT_SKIP_NAN +% +% REFERENCE(S): +% http://mathworld.wolfram.com/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 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 . + +% $Id: kurtosis.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2003 by Alois Schloegl +% This function is part of the NaN-toolbox for Octave and Matlab +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +if nargin==1, + DIM=min(find(size(i)>1)); + if isempty(DIM), DIM=1; end; +end; + +[R.SUM,R.N,R.SSQ] = sumskipnan(i,DIM); % sum + +R.MEAN = R.SUM./R.N; % mean +R.SSQ0 = R.SSQ - real(R.SUM).*real(R.MEAN) - imag(R.SUM).*imag(R.MEAN); % sum square with mean removed + +%if flag_implicit_unbiased_estim; %% ------- unbiased estimates ----------- + n1 = max(R.N-1,0); % in case of n=0 and n=1, the (biased) variance, STD and SEM are INF +%else +% n1 = R.N; +%end; + +R.VAR = R.SSQ0./n1; % variance (unbiased) +%R.STD = sqrt(R.VAR); % standard deviation + +i = i - repmat(R.MEAN,size(i)./size(R.MEAN)); +%R.CM3 = sumskipnan(i.^3,DIM)./n1; +R.CM4 = sumskipnan(i.^4,DIM)./n1; + +%R.SKEWNESS = R.CM3./(R.STD.^3); +R = R.CM4./(R.VAR.^2)-3; diff --git a/octave_packages/nan-2.5.5/load_fisheriris.m b/octave_packages/nan-2.5.5/load_fisheriris.m new file mode 100644 index 0000000..2b967ee --- /dev/null +++ b/octave_packages/nan-2.5.5/load_fisheriris.m @@ -0,0 +1,44 @@ +% LOAD_FISHERIRIS +% loads famous iris data set from Fisher, 1936 [1]. +% +% References: +% [1] Fisher,R.A. "The use of multiple measurements in taxonomic problems" +% Annual Eugenics, 7, Part II, 179-188 (1936); also in "Contributions to Mathematical Statistics" (John Wiley, NY, 1950). +% [2] Duda,R.O., & Hart,P.E. (1973) Pattern Classification and Scene Analysis. +% (Q327.D83) John Wiley & Sons. ISBN 0-471-22361-1. See page 218. + +% $Id$ +% Copyright (C) 2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 3 +% of the License, or (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + + +if exist('OCTAVE_VERSION','builtin') + if ~exist('iris.data','file') + if strncmp(computer,'PCWIN',5) + fprintf(1,'Download http://archive.ics.uci.edu/ml/machine-learning-databases/iris/iris.data and save in local directory %s\nPress any key to continue ...\n',pwd); + else + unix('wget http://archive.ics.uci.edu/ml/machine-learning-databases/iris/iris.data'); + end; + end; + tmp = fopen('iris.data'); species=fread(tmp,[1,inf],'uint8=>char'); fclose(tmp); + [meas,tmp,species]=str2double(species,','); + meas = meas(:,1:4); + species = species(:,5); +else + load fisheriris; +end; \ No newline at end of file diff --git a/octave_packages/nan-2.5.5/mad.m b/octave_packages/nan-2.5.5/mad.m new file mode 100644 index 0000000..cf174db --- /dev/null +++ b/octave_packages/nan-2.5.5/mad.m @@ -0,0 +1,64 @@ +function R = mad(i,DIM) +% MAD estimates the Mean Absolute deviation +% (note that according to [1,2] this is the mean deviation; +% not the mean absolute deviation) +% +% y = mad(x,DIM) +% calculates the mean deviation of x in dimension DIM +% +% DIM dimension +% 1: STATS of columns +% 2: STATS of rows +% default or []: first DIMENSION, with more than 1 element +% +% features: +% - can deal with NaN's (missing values) +% - dimension argument +% - compatible to Matlab and Octave +% +% see also: SUMSKIPNAN, VAR, STD, +% +% REFERENCE(S): +% [1] http://mathworld.wolfram.com/MeanDeviation.html +% [2] L. Sachs, "Applied Statistics: A Handbook of Techniques", Springer-Verlag, 1984, page 253. +% +% [3] http://mathworld.wolfram.com/MeanAbsoluteDeviation.html +% [4] Kenney, J. F. and Keeping, E. S. "Mean Absolute Deviation." §6.4 in Mathematics of Statistics, Pt. 1, 3rd ed. Princeton, NJ: Van Nostrand, pp. 76-77 1962. + +% $Id: mad.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2002,2010 by Alois Schloegl +% This is part of the NaN-toolbox. For more details see +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% 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 . + +if nargin==1, + DIM = find(size(i)>1,1); + if isempty(DIM), DIM=1; end; +end; + + +[S,N] = sumskipnan(i,DIM); % sum +i = i - repmat(S./N,size(i)./size(S)); % remove mean +[S,N] = sumskipnan(abs(i),DIM); % + +%if flag_implicit_unbiased_estim; %% ------- unbiased estimates ----------- + n1 = max(N-1,0); % in case of n=0 and n=1, the (biased) variance, STD and STE are INF +%else +% n1 = N; +%end; + +R = S./n1; + + diff --git a/octave_packages/nan-2.5.5/mahal.m b/octave_packages/nan-2.5.5/mahal.m new file mode 100644 index 0000000..6587040 --- /dev/null +++ b/octave_packages/nan-2.5.5/mahal.m @@ -0,0 +1,48 @@ +function [d] = mahal(X,Y) +% MAHAL return the Mahalanobis' D-square distance between the +% multivariate samples x and y, which must have the same number +% of components (columns), but may have a different number of observations (rows). +% +% d = mahal(X,Y) +% +% d(k) = (X(k,:)-MU)*inv(SIGMA)*(X(k,:)-MU)' +% +% where MU and SIGMA are the mean and the covariance matrix of Y +% +% +% see also: TRAIN_SC, TEST_SC, COVM +% +% References: + +% $Id: train_sc.m 2140 2009-07-02 12:03:55Z schloegl $ +% Copyright (C) 2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% 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, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + +sx = size(X); +sy = size(Y); + +if sx(2)~=sy(2), + error('number of columns of X and Y do not fit'); +end; + +IR = inv(covm(Y,'E')); +IR(1,1) = IR(1,1)-1; + +D = [ones(size(X,1),1),X]; +d = sum((D*IR).*D,2); + diff --git a/octave_packages/nan-2.5.5/mean.m b/octave_packages/nan-2.5.5/mean.m new file mode 100644 index 0000000..139cb13 --- /dev/null +++ b/octave_packages/nan-2.5.5/mean.m @@ -0,0 +1,125 @@ +function [y]=mean(x,DIM,opt,W) +% MEAN calculates the mean of data elements. +% +% y = mean(x [,DIM] [,opt] [, W]) +% +% DIM dimension +% 1 MEAN of columns +% 2 MEAN of rows +% N MEAN of N-th dimension +% default or []: first DIMENSION, with more than 1 element +% +% opt options +% 'A' arithmetic mean +% 'G' geometric mean +% 'H' harmonic mean +% +% W weights to compute weighted mean (default: []) +% if W=[], all weights are 1. +% number of elements in W must match size(x,DIM) +% +% usage: +% mean(x) +% mean(x,DIM) +% mean(x,opt) +% mean(x,opt,DIM) +% mean(x,DIM,opt) +% mean(x,DIM,W) +% mean(x,DIM,opt,W); ' +% +% features: +% - can deal with NaN's (missing values) +% - weighting of data +% - dimension argument also in Octave +% - compatible to Matlab and Octave +% +% see also: SUMSKIPNAN, MEAN, GEOMEAN, HARMMEAN +% + +% $Id: mean.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2000-2004,2008,2009,2011 by Alois Schloegl +% This is part of the NaN-toolbox. For more details see +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ +% +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +if nargin==1, + %------ case: mean(x) + W = []; + DIM=[]; + opt='a'; +elseif (nargin==2) + W = []; + %if ~isnumeric(DIM), %>=65;%abs('A'), + if (DIM>64) %abs('A'), + %------ case: mean(x,opt) + opt=DIM; + DIM=[]; + else + %------ case: mean(x,DIM) + opt='a'; + end; +elseif (nargin == 3), + if isnumeric(DIM) && isnumeric(opt) + %------ case: mean(x,DIM,W) + W = opt; + opt='a'; + elseif (DIM>64) %abs('A'), + %------ case: mean(x,opt,DIM) + %if ~isnumeric(DIM), %>=65;%abs('A'), + tmp=opt; + opt=DIM; + DIM=tmp; + W = []; + else + %------ case: mean(x,DIM,opt) + W = []; + end; +elseif nargin==4, + %------ case: mean(x,DIM,opt,W) + ; +else + help mean +% fprintf(1,'usage: mean(x) or mean(x,DIM) or mean(x,opt,DIM) or mean(x,DIM,opt) or mean(x,DIM,W) or mean(x,DIM,opt,W); ' +end; + +if isempty(opt) + opt = 'A'; +elseif any(opt=='aAgGhH') + opt = upper(opt); % eliminate old version +else + error('Error MEAN: invalid opt argument'); +end; + +if (opt == 'A') + [y, n] = sumskipnan(x,DIM,W); + y = y./n; +elseif (opt == 'G') + [y, n] = sumskipnan(log(x),DIM,W); + y = exp (y./n); +elseif (opt == 'H') + [y, n] = sumskipnan(1./x,DIM,W); + y = n./y; +else + fprintf (2,'mean: option `%s` not recognized', opt); +end + +%!assert(mean([1,NaN],1),[1,NaN]) +%!assert(mean([1,NaN],2),1) +%!assert(mean([+inf,-inf]),NaN) +%!assert(mean([+0,-0],'h'),NaN) +%!assert(mean([1,4,NaN],'g'),2) + + + diff --git a/octave_packages/nan-2.5.5/meandev.m b/octave_packages/nan-2.5.5/meandev.m new file mode 100644 index 0000000..d095970 --- /dev/null +++ b/octave_packages/nan-2.5.5/meandev.m @@ -0,0 +1,62 @@ +function R = meandev(i,DIM) +% MEANDEV estimates the Mean deviation +% (note that according to [1,2] this is the mean deviation; +% not the mean absolute deviation) +% +% y = meandev(x,DIM) +% calculates the mean deviation of x in dimension DIM +% +% DIM dimension +% 1: STATS of columns +% 2: STATS of rows +% default or []: first DIMENSION, with more than 1 element +% +% features: +% - can deal with NaN's (missing values) +% - dimension argument +% - compatible to Matlab and Octave +% +% see also: SUMSKIPNAN, VAR, STD, MAD +% +% REFERENCE(S): +% [1] http://mathworld.wolfram.com/MeanDeviation.html +% [2] L. Sachs, "Applied Statistics: A Handbook of Techniques", Springer-Verlag, 1984, page 253. +% [3] http://mathworld.wolfram.com/MeanAbsoluteDeviation.html +% [4] Kenney, J. F. and Keeping, E. S. "Mean Absolute Deviation." §6.4 in Mathematics of Statistics, Pt. 1, 3rd ed. Princeton, NJ: Van Nostrand, pp. 76-77 1962. + +% 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 . + +% $Id: meandev.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2002,2010 by Alois Schloegl +% This function is part of the NaN-toolbox for Octave and Matlab +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +if nargin==1, + DIM = find(size(i)>1,1); + if isempty(DIM), DIM=1; end; +end; + +[S,N] = sumskipnan(i,DIM); % sum +i = i - repmat(S./N,size(i)./size(S)); % remove mean +[S,N] = sumskipnan(abs(i),DIM); % + +%if flag_implicit_unbiased_estim; %% ------- unbiased estimates ----------- + n1 = max(N-1,0); % in case of n=0 and n=1, the (biased) variance, STD and STE are INF +%else +% n1 = N; +%end; + +R = S./n1; + + diff --git a/octave_packages/nan-2.5.5/meansq.m b/octave_packages/nan-2.5.5/meansq.m new file mode 100644 index 0000000..4a67220 --- /dev/null +++ b/octave_packages/nan-2.5.5/meansq.m @@ -0,0 +1,53 @@ +function o=meansq(x,DIM,W) +% MEANSQ calculates the mean of the squares +% +% y = meansq(x,DIM,W) +% +% DIM dimension +% 1 STD of columns +% 2 STD of rows +% N STD of N-th dimension +% default or []: first DIMENSION, with more than 1 element +% W weights to compute weighted mean (default: []) +% if W=[], all weights are 1. +% number of elements in W must match size(x,DIM) +% +% features: +% - can deal with NaN's (missing values) +% - weighting of data +% - dimension argument also in Octave +% - compatible to Matlab and Octave +% +% see also: SUMSQ, SUMSKIPNAN, MEAN, VAR, STD, RMS + +% 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 . + +% Copyright (C) 2000-2003,2009 by Alois Schloegl +% $Id: meansq.m 8223 2011-04-20 09:16:06Z schloegl $ +% This function is part of the NaN-toolbox for Octave and Matlab +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +if nargin<3, + W = []; +end; +if nargin<2, + [o,N,ssq] = sumskipnan(x,[],W); +else + [o,N,ssq] = sumskipnan(x,DIM,W); +end; + +o = ssq./N; + + diff --git a/octave_packages/nan-2.5.5/medAbsDev.m b/octave_packages/nan-2.5.5/medAbsDev.m new file mode 100644 index 0000000..71b599c --- /dev/null +++ b/octave_packages/nan-2.5.5/medAbsDev.m @@ -0,0 +1,44 @@ +function [D, M] = medAbsDev(X, DIM) +% medAbsDev calculates the median absolute deviation +% +% Usage: D = medAbsDev(X, DIM) +% or: [D, M] = medAbsDev(X, DIM) +% Input: X : data +% DIM: dimension along which mad should be calculated (1=columns, 2=rows) +% (optional, default=first dimension with more than 1 element +% Output: D : median absolute deviations +% M : medians (optional) + + +% Copyright (C) 2003 Patrick Houweling % Copyright (C) 2009 Alois Schloegl +% $Id: medAbsDev.m 8075 2011-01-27 17:10:36Z schloegl $ +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +% input checks +if any(size(X)==0), + return; +end; + +if nargin<2, + M = median(X); +else + M = median(X, DIM); +end; + +% median absolute deviation: median of absolute deviations to median +D = median(abs(X - repmat(M, size(X)./size(M))), DIM); \ No newline at end of file diff --git a/octave_packages/nan-2.5.5/median.m b/octave_packages/nan-2.5.5/median.m new file mode 100644 index 0000000..bcaa742 --- /dev/null +++ b/octave_packages/nan-2.5.5/median.m @@ -0,0 +1,94 @@ +function [y]=median(x,DIM) +% MEDIAN data elements, +% [y]=median(x [,DIM]) +% +% DIM dimension +% 1: median of columns +% 2: median of rows +% N: median of N-th dimension +% default or []: first DIMENSION, with more than 1 element +% +% features: +% - can deal with NaN's (missing values) +% - accepts dimension argument like in Matlab in Octave, too. +% - compatible to Matlab and Octave +% +% see also: SUMSKIPNAN + +% 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 . + +% $Id: median.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2000-2003,2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +global FLAG_NANS_OCCURED; + +% check dimension of x +sz=size(x); + +% find the dimension for median +if nargin<2, + DIM=min(find(sz>1)); + if isempty(DIM), DIM=1; end; +end; + +if DIM>length(sz), + sz = [sz,ones(1,DIM-length(sz))]; +end; + +D1 = prod(sz(1:DIM-1)); +D2 = sz(DIM); +D3 = prod(sz(DIM+1:length(sz))); +D0 = [sz(1:DIM-1),1,sz(DIM+1:length(sz))]; +y = repmat(nan,D0); +flag_MexKthElement = exist('kth_element','file')==3; + +for k = 0:D1-1, +for l = 0:D3-1, + xi = k + l * D1*sz(DIM) + 1 ; + xo = k + l * D1 + 1; + t = x(xi+(0:sz(DIM)-1)*D1); + t = t(~isnan(t)); + n = length(t); + + if n==0, + y(xo) = nan; + elseif flag_MexKthElement, + if (D1==1) t = t+0.0; end; % make sure a real copy (not just a reference to x) is used + flag_KthE = 0; % fast kth_element can be used, because t does not contain any NaN and there is need to care about in-place sorting + if ~rem(n,2), + y(xo) = sum( kth_element( double(t), n/2 + [0,1], flag_KthE) ) / 2; + elseif rem(n,2), + y(xo) = kth_element(double(t), (n+1)/2, flag_KthE); + end; + else + t = sort(t); + if ~rem(n,2), + y(xo) = (t(n/2) + t(n/2+1)) / 2; + elseif rem(n,2), + y(xo) = t((n+1)/2); + end; + end + + if (n +% This functions is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +if nargin==2, + DIM=[]; + opt=[]; +elseif nargin==3, + DIM=[]; +elseif nargin==4, + +else + fprintf('Error MOMENT: invalid number of arguments\n'); + return; +end; + +if p<=0; + fprintf('Error MOMENT: invalid model order p=%f\n',p); + return; +end; + +if isnumeric(opt) || ~isnumeric(DIM), + tmp = DIM; + DIM = opt; + opt = tmp; +end; +if isempty(opt), + opt='r'; +end; +if isempty(DIM), + DIM = find(size(i)>1,1); + if isempty(DIM), DIM=1; end; +end; + +N = nan; +if isstruct(i), + if isfield(i,'HISTOGRAM'), + sz = size(i.H)./size(i.X); + X = repmat(i.X,sz); + if any(opt=='c'), + N = sumskipnan(i.H,1); % N + N = max(N-1,0); % for unbiased estimation + S = sumskipnan(i.H.*X,1); % sum + X = X - repmat(S./N, size(X)./size(S)); % remove mean + end; + if any(opt=='a'), + X = abs(X); + end; + [M,n] = sumskipnan(X.^p.*i.H,1); + else + warning('invalid datatype') + end; +else + if any(opt=='c'), + [S,N] = sumskipnan(i,DIM); % gemerate N and SUM + N = max(N-1,0); % for unbiased estimation + i = i - repmat(S./N, size(i)./size(S)); % remove mean + end; + if any(opt=='a'), + i = abs(i); + end; + [M,n] = sumskipnan(i.^p,DIM); +end; + +if isnan(N), N=n; end; +M = M./N; diff --git a/octave_packages/nan-2.5.5/nanconv.m b/octave_packages/nan-2.5.5/nanconv.m new file mode 100644 index 0000000..39d46b0 --- /dev/null +++ b/octave_packages/nan-2.5.5/nanconv.m @@ -0,0 +1,59 @@ +function [C,N,c] = nanconv(X,Y,arg3) +% NANCONV computes the convolution for data with missing values. +% X and Y can contain missing values encoded with NaN. +% NaN's are skipped, NaN do not result in a NaN output. +% The output gives NaN only if there are insufficient input data +% +% [...] = NANCONV(X,Y); +% calculates 2-dim convolution between X and Y +% [C] = NANCONV(X,Y); +% +% WARNING: missing values can introduce aliasing - causing unintended results. +% Moreover, the behavior of bandpass and highpass filters in case of missing values +% is not fully understood, and might contain some pitfalls. +% +% see also: CONV, NANCONV2, NANFFT, NANFILTER + +% $Id: conv2nan.m 6973 2010-02-28 20:19:12Z schloegl $ +% Copyright (C) 2000-2005,2010,2011 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ and +% http://octave.svn.sourceforge.net/viewvc/octave/trunk/octave-forge/extra/NaN/inst/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + +warning('NANCONV is experimental. For more details see HELP NANCONV'); + + +if nargin~=2, + fprintf(2,'Error NANCONV2: incorrect number of input arguments\n'); +end; + +m = isnan(X); +n = isnan(Y); + +X(m) = 0; +Y(n) = 0; + +C = conv(X,Y); % 2-dim convolution +N = conv(real(~m),real(~n)); % normalization term +c = conv(ones(size(X)),ones(size(Y))); % correction of normalization + +if nargout==1, + C = C.*c./N; +elseif nargout==2, + N = N./c; +end; + diff --git a/octave_packages/nan-2.5.5/nanfft.m b/octave_packages/nan-2.5.5/nanfft.m new file mode 100644 index 0000000..220d163 --- /dev/null +++ b/octave_packages/nan-2.5.5/nanfft.m @@ -0,0 +1,58 @@ +function [Y,N,N2] = nanfft(X,N,DIM); +% NANFFT calculates the Fourier-Transform of X for data with missing values. +% NANFFT is the same as FFT but X can contain missing values encoded with NaN. +% NaN's are skipped, NaN do not result in a NaN output. +% +% Y = NANFFT(X) +% Y = NANFFT(X,N) +% Y = NANFFT(X,[],DIM) +% +% [Y,N] = NANFFT(...) +% returns the number of valid samples N +% +% +% WARNING: missing values can introduce aliasing - causing unintended results. +% Moreover, the behavior of bandpass and highpass filters in case of missing values +% is not fully understood, and might contain some pitfalls. +% +% see also: FFT, XCORR, NANCONV, NANFILTER + +% $Id$ +% Copyright (C) 2005,2011 by Alois Schloegl +% This function is part of the NaN-toolbox available at +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ and +% http://octave.svn.sourceforge.net/viewvc/octave/trunk/octave-forge/extra/NaN/inst/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +warning('NANFFT is experimental. For more details see HELP NANFFT'); + +NX = isnan(X); +X(NX) = 0; + +if nargin==1, + Y = fft(X); + N2 = sum(1-NX); % + N = fft(NX); +elseif nargin==2, + Y = fft(X,N); + N2 = sum(1-NX); + N = fft(NX); +elseif nargin==3, + Y = fft(X,N,DIM); + N2 = sum(1-NX,DIM); % + N = fft(NX,N,DIM); +end; + diff --git a/octave_packages/nan-2.5.5/nanfilter.m b/octave_packages/nan-2.5.5/nanfilter.m new file mode 100644 index 0000000..19e8077 --- /dev/null +++ b/octave_packages/nan-2.5.5/nanfilter.m @@ -0,0 +1,62 @@ +function [Y,Z] = nanfilter(B,A,X,z); +% NANFILTER is able to filter data with missing values encoded as NaN. +% +% [Y,Z] = nanfilter(B,A,X [, Z]); +% +% If X contains no missing data, NANFILTER should behave like FILTER. +% NaN-values are handled gracefully. +% +% WARNING: missing values can introduce aliasing - causing unintended results. +% Moreover, the behavior of bandpass and highpass filters in case of missing values +% is not fully understood, and might contain some pitfalls. +% +% see also: FILTER, SUMSKIPNAN, NANFFT, NANCONV, NANFILTER1UC + +% $Id$ +% Copyright (C) 2005,2011 by Alois Schloegl +% This function is part of the NaN-toolbox available at +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ and +% http://octave.svn.sourceforge.net/viewvc/octave/trunk/octave-forge/extra/NaN/inst/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +warning('NANFILTER is experimental. For more details see HELP NANFILTER'); + +na = length(A); +nb = length(B); +if any(size(X)==1) + nc = 1; +else + nc = size(X,2); +end; + +if nargin<4, + [t,Z.S] = filter(B,A,zeros(na+nb,nc)); + [t,Z.N] = filter(B,A,zeros(na+nb,nc)); +elseif isnumeric(z), + Z.S = z; + [t, Z.N] = filter(B, A, zeros(na+nb,nc)); +elseif isstruct(z), + Z = z; +end; + +NX = isnan(X); +X(NX) = 0; + +[Y , Z.S] = filter(B, A, X, Z.S); +[NY, Z.N] = filter(B, A, ~NX, Z.N); +Y = (sum(B)/sum(A)) * Y./NY; + diff --git a/octave_packages/nan-2.5.5/nanfilter1uc.m b/octave_packages/nan-2.5.5/nanfilter1uc.m new file mode 100644 index 0000000..181bef7 --- /dev/null +++ b/octave_packages/nan-2.5.5/nanfilter1uc.m @@ -0,0 +1,54 @@ +function [x,z] = nanfilter1uc(uc,x,z); +% NANFILTER1UC is an adaptive filter for data with missing values encoded as NaN. +% +% [Y,Z] = nanfilter1uc(uc,X [, Z]); +% +% if X contains no missing data, NANFILTER behaves like FILTER(uc,[1,uc-1],X[,Z]). +% +% see also: FILTER, NANFILTER, SUMSKIPNAN + +% $Id$ +% Copyright (C) 2010,2011 by Alois Schloegl +% This function is part of the NaN-toolbox available at +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ and +% http://octave.svn.sourceforge.net/viewvc/octave/trunk/octave-forge/extra/NaN/inst/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + + +na = 2; %length(A); +nb = 2; %length(B); +if any(size(x)==1) + nc = 1; +else + nc = size(x,2); +end; + +acN = zeros(1,nc); +if nargin<3, + z = zeros(1,nc); +end; +acc = NaN(1,nc); +for k = 1:size(x,1), + ix = isnan(x(k,:)); + acN = acN.*ix+1; + UC1 = ((1-uc).^acN); + acc(~ix) = (1-UC1(~ix)) .* x(k,~ix) + z(~ix); % / A{1}; + ix = isnan(acc); + acc(ix) = x(k,ix); + z = (1-uc) * acc; + x(k,:) = acc; +end; + diff --git a/octave_packages/nan-2.5.5/naninsttest.m b/octave_packages/nan-2.5.5/naninsttest.m new file mode 100644 index 0000000..567c423 --- /dev/null +++ b/octave_packages/nan-2.5.5/naninsttest.m @@ -0,0 +1,173 @@ +% NANINSTTEST checks whether the functions from NaN-toolbox have been +% correctly installed. +% +% see also: NANTEST + +% $Id: naninsttest.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2003 by Alois Schloegl +% This script is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + +r = zeros(38,2); + +x = [5,NaN,0,1,nan]; + +% run test, k=1: with NaNs, k=2: all NaN's are removed +% the result of both should be the same. + +%FLAG_WARNING = warning; +warning('off'); + +funlist = {'sumskipnan','mean','std','var','skewness','kurtosis','sem','median','mad','zscore','coefficient_of_variation','geomean','harmmean','meansq','moment','rms','','corrcoef','rankcorr','spearman','ranks','center','trimean','min','max','tpdf','tcdf','tinv','normpdf','normcdf','norminv','nansum','nanstd','histo_mex','sumskipnan_mex','covm_mex','svmtrain_mex','train','','','','','','','',''}; +for k=1:2, + if k==2, x(isnan(x))=[]; end; + r(1,k) =sumskipnan(x(1)); + r(2,k) =mean(x); + r(3,k) =std(x); + r(4,k) =var(x); + r(5,k) = skewness(x); + r(6,k) =kurtosis(x); + r(7,k) =sem(x); + r(8,k) =median(x); + r(9,k) =mad(x); + tmp = zscore(x); + r(10,k)=tmp(1); + if exist('coefficient_of_variation','file'), + r(11,k)=coefficient_of_variation(x); + end; + r(12,k)=geomean(x); + r(13,k)=harmmean(x); + if exist('meansq','file'), + r(14,k)=meansq(x); + end; + if exist('moment','file'), + r(15,k)=moment(x,6); + end; + if exist('rms','file'), + r(16,k)=rms(x); + end; + % r(17,k) is currently empty. + tmp=corrcoef(x',(1:length(x))'); + r(18,k)=any(isnan(tmp(:))); + if exist('rankcorr','file'), + tmp=rankcorr(x',(1:length(x))'); + r(19,k)=any(isnan(tmp(:))); + end; + if exist('spearman','file'), + tmp=spearman(x',(1:length(x))'); + r(20,k)=any(isnan(tmp(:))); + end; + if exist('ranks','file'), + r(21,k)=any(isnan(ranks(x')))+k; + end; + if exist('center','file'), + tmp=center(x); + r(22,k)=tmp(1); + end; + if exist('trimean','file'), + r(23,k)=trimean(x); + end; + r(24,k)=min(x); + r(25,k)=max(x); + + r(26,k) = k+isnan(tpdf(x(2),4)); + + try + r(27,k) = k*(~isnan(tcdf(nan,4))); + catch + r(27,k) = k; + end; + + r(28,k) = k*(~isnan(tinv(NaN,4))); + + if exist('normpdf','file'), + fun='normpdf'; + elseif exist('normal_pdf','file'), + fun='normal_pdf'; + end; + r(29,k) = (feval(fun,k,k,0)~=Inf)*k; + if exist('normcdf','file'), + fun='normcdf'; + elseif exist('normal_cdf','file'), + fun='normal_cdf'; + end; + r(30,k) = feval(fun,4,4,0); + if exist('norminv','file'), + fun='norminv'; + elseif exist('normal_inv','file'), + fun='normal_inv'; + end; + r(31,k) = k*any(isnan(feval(fun,[0,1],4,0))); + if exist('nansum','file'), + r(32,k)=k*isnan(nansum(nan)); + end; + if exist('nanstd','file'), + r(33,k)=k*(~isnan(nanstd(0))); + end; + + %%% check mex files + try + histo_mex([1:5]'); + r(34,k)=0; + catch; + r(34,k)=k; + end; + try + sumskipnan_mex([1:5]'); + r(35,k)=0; + catch; + r(35,k)=k; + end; + try + covm_mex([1:5]'); + r(36,k)=0; + catch; + r(36,k)=k; + end; + if ~exist('svmtrain_mex','file'), + r(37,k)=k; + end; + if ~exist('train','file'), + r(38,k)=k; + end; +end; + +% check if result is correct +tmp = abs(r(:,1)-r(:,2)) +% This is part of the NaN-toolbox. For more details see +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ +% +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + +if nargin>1 + [o,n] = sumskipnan(i,DIM); +else + [o,n] = sumskipnan(i); +end; +o=o./n; diff --git a/octave_packages/nan-2.5.5/nanstd.m b/octave_packages/nan-2.5.5/nanstd.m new file mode 100644 index 0000000..226722c --- /dev/null +++ b/octave_packages/nan-2.5.5/nanstd.m @@ -0,0 +1,71 @@ +function [y] = nanstd(x,FLAG,DIM) +% NANSTD same as STD but ignores NaN's. +% NANSTD is OBSOLETE; use NaN/STD instead. NANSTD is included +% to fix a bug in alternative implementations and to +% provide some compatibility. +% +% Y = nanstd(x, FLAG, [,DIM]) +% +% x data +% FLAG 0: [default] normalizes with (N-1), N = sample size +% FLAG 1: normalizes with N, N = sample size +% DIM dimension +% 1 sum of columns +% 2 sum of rows +% default or []: first DIMENSION with more than 1 element +% Y resulting standard deviation +% +% see also: SUM, SUMSKIPNAN, NANSUM, STD + +% $Id: nanstd.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2000-2003,2006,2008,2009,2010 by Alois Schloegl +% This is part of the NaN-toolbox. For more details see +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +if nargin<2, + FLAG = 0; +end; + +if nargin<3, + DIM = []; +end; +if isempty(FLAG), + FLAG = 0; +end; +if isempty(DIM), + DIM = find(size(x)>1,1); + if isempty(DIM), DIM=1; end; +end; + +[y,n,ssq] = sumskipnan(x,DIM); +if all(ssq(:).*n(:) > 2*(y(:).^2)), + %% rounding error is neglectable + y = ssq - y.*y./n; +else + %% rounding error is not neglectable + [y,n] = sumskipnan(center(x,DIM).^2,DIM); +end; + +if (FLAG==1) + y = sqrt(y)./n; % normalize with N +else + % default method + y = sqrt(y./max(n-1,0)); % normalize with N-1 +end; + + +%!assert(nanstd(0),NaN) + diff --git a/octave_packages/nan-2.5.5/nansum.m b/octave_packages/nan-2.5.5/nansum.m new file mode 100644 index 0000000..58ef171 --- /dev/null +++ b/octave_packages/nan-2.5.5/nansum.m @@ -0,0 +1,43 @@ +function [o] = nansum(i,DIM) +% NANSUM same as SUM but ignores NaN's. +% NANSUM is OBSOLETE; use SUMSKIPNAN instead. NANSUM is included +% to fix a bug in some other versions. +% +% Y = nansum(x [,DIM]) +% +% DIM dimension +% 1 sum of columns +% 2 sum of rows +% default or []: first DIMENSION with more than 1 element +% Y resulting sum +% +% +% see also: SUM, SUMSKIPNAN, NANSUM + +% $Id: nansum.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2000-2003,2008 by Alois Schloegl +% This is part of the NaN-toolbox. For more details see +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ +% +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + +if nargin>1 + o = sumskipnan(i,DIM); +else + o = sumskipnan(i); +end; + +%!assert(nansum(NaN),0) + diff --git a/octave_packages/nan-2.5.5/nantest.m b/octave_packages/nan-2.5.5/nantest.m new file mode 100644 index 0000000..29bd51d --- /dev/null +++ b/octave_packages/nan-2.5.5/nantest.m @@ -0,0 +1,290 @@ +% NANTEST checks several mathematical operations and a few +% statistical functions for their correctness related to NaN's. +% e.g. it checks norminv, normcdf, normpdf, sort, matrix division and multiplication. +% +% +% see also: NANINSTTEST +% +% REFERENCE(S): +% [1] W. Kahan (1996) Lecture notes on the Status of "IEEE Standard 754 for +% Binary Floating-point Arithmetic. +% + + +% 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 . + +% $Id: nantest.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2004,2009 by Alois Schloegl +% This script is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +%FLAG_WARNING = warning; +%warning('off'); + +try + x = randn([3,4,5]); + x(~isnan(x)) = 0; +catch + fprintf(1,'WARNING: NANTEST fails for 3-DIM matrices. \n'); +end; +try + [s,n] = sumskipnan([nan,1,4,5]); +catch + fprintf(1,'WARNING: SUMSKIPNAN is not avaible. \n'); +end; + +% check NORMPDF, NORMCDF, NORMINV +x = [-inf,-2,-1,-.5,0,.5,1,2,3,inf,nan]'; +if exist('normpdf','file')==2, + q(1) = sum(isnan(normpdf(x,2,0)))>sum(isnan(x)); + if q(1), + fprintf(1,'NORMPDF cannot handle v=0.\n'); + fprintf(1,'-> NORMPDF should be replaced\n'); + end; +end; + +if exist('normcdf','file')==2, + q(2) = sum(isnan(normcdf(x,2,0)))>sum(isnan(x)); + if q(2), + fprintf(1,'NORMCDF cannot handle v=0.\n'); + fprintf(1,'-> NORMCDF should be replaced\n'); + end; +end; + +if exist('norminv','file')==2, + p = [-inf,-.2,0,.2,.5,1,2,inf,nan]; + q(3) = sum(~isnan(norminv(p,2,0)))<4; + if q(3), + fprintf(1,'NORMINV cannot handle correctly v=0.\n'); + fprintf(1,'-> NORMINV should be replaced\n'); + end; + q(4) = ~isnan(norminv(0,NaN,0)); + q(5) = any(norminv(0.5,[1 2 3],0)~=(1:3)); +end; + +if exist('tpdf','file')==2, + q(6) = ~isnan(tpdf(nan,4)); + if q(6), + fprintf(1,'TPDF(NaN,4) does not return NaN\n'); + fprintf(1,'-> TPDF should be replaced\n'); + end; +end; + +if exist('tcdf','file')==2, + try + q(7) = ~isnan(tcdf(nan,4)); + catch + q(7) = 1; + end; + if q(7), + fprintf(1,'TCDF(NaN,4) does not return NaN\n'); + fprintf(1,'-> TCDF should be replaced\n'); + end; +end; + +if exist('tinv','file')==2, + try + q(8) = ~isnan(tinv(nan,4)); + catch + q(8) = 1; + end; + if q(8), + fprintf(1,'TINV(NaN,4) does not return NaN\n'); + fprintf(1,'-> TINV should be replaced\n'); + end; +end; + +q(9) = isreal(double(2+3i)); +if q(9) + printf('DOUBLE rejects imaginary part\n-> this can affect SUMSKIPNAN\n'); +end; + +try + x = reshape(1:6,3,2); + [cc,nn] = covm(x+i*x,'e'); + q(10) = 0; +catch + q(10) = 1; +end; + +if 0, +%%%%% MOD +if exist('mod')>1, + if (mod(5,0))~=0, + fprintf(1,'WARNING: MOD(x,0) does not return 0.\n'); + end; + if isnan(mod(5,0)), + fprintf(1,'WARNING: MOD(x,0) returns NaN.\n'); + end; + if isnan(mod(5,inf)), + fprintf(1,'WARNING: MOD(x,INF) returns NaN.\n'); + end; +end; +%%%%% REM +if exist('rem')>1, + if (rem(5,0))~=0, + fprintf(1,'WARNING: REM(x,0) does not return 0.\n'); + end; + if isnan(rem(5,0)), + fprintf(1,'WARNING: REM(x,0) returns NaN.\n'); + end; + if isnan(mod(5,inf)), + fprintf(1,'WARNING: REM(x,INF) returns NaN.\n'); + end; +end; +end; + +%%%%% NANSUM(NAN) - this test addresses a problem in Matlab 5.3, 6.1 & 6.5 +if exist('nansum','file'), + if isnan(nansum(nan)), + fprintf(1,'Warning: NANSUM(NaN) returns NaN instead of 0\n'); + fprintf(1,'-> NANSUM should be replaced\n'); + end; +end; +%%%%% NANSUM(NAN) - this test addresses a problem in Matlab 5.3, 6.1 & 6.5 +if exist('nanstd','file'), + if ~isnan(nanstd(0)), + fprintf(1,'Warning: NANSTD(x) with isscalar(x) returns 0 instead of NaN\n'); + fprintf(1,'-> NANSTD should be replaced\n'); + end; +end; +%%%%% GEOMEAN - this test addresses a problem in Octave +if exist('geomean','file'), + if isnan(geomean((0:3)')), + fprintf(1,'Warning: GEOMEAN([0,1,2,3]) NaN instead of 0\n'); + fprintf(1,'-> GEOMEAN should be replaced\n'); + end; +end; +%%%%% HARMMEAN - this test addresses a problem in Octave +if exist('harmmean','file'), + if isnan(harmmean(0:3)), + fprintf(1,'Warning: HARMMEAN([0,1,2,3]) NaN instead of 0\n'); + fprintf(1,'-> HARMMEAN should be replaced\n'); + end; +end; +%%%%% BITAND - this test addresses a problem in Octave +if exist('bitand')>1, + if isnan(bitand(2^33-1,13)), + fprintf(1,'BITAND can return NaN. \n'); + end; +end; +%%%%% BITSHIFT - this test addresses a problem in Octave +if exist('bitshift','file'), + if isnan(bitshift(5,30,32)), + fprintf(1,'BITSHIFT can return NaN.\n'); + end; +end; +%%%%% ALL - this test addresses a problem in some old Octave and FreeMat v3.5 +if any(NaN)==1, + fprintf(1,'WARNING: ANY(NaN) returns 1 instead of 0\n'); +end; +if any([])==1, + fprintf(1,'WARNING: ANY([]) returns 1 instead of 0\n'); +end; +%%%%% ALL - this test addresses a problem in some old Octave and FreeMat v3.5 +if all(NaN)==0, + fprintf(1,'WARNING: ALL(NaN) returns 0 instead of 1\n'); +end; +if all([])==0, + fprintf(1,'WARNING: ALL([]) returns 0 instead of 1\n'); +end; + +%%%%% SORT - this was once a problem in Octave Version < 2.1.36 %%%% +if ~all(isnan(sort([3,4,NaN,3,4,NaN]))==[0,0,0,0,1,1]), + warning('Warning: SORT does not handle NaN.'); +end; + +%%%%% commutativity of 0*NaN %%% This test adresses a problem in Octave +x=[-2:2;4:8]'; +y=x;y(2,1)=nan;y(4,2)=nan; +B=[1,0,2;0,3,1]; +if ~all(all(isnan(y*B)==isnan(B'*y')')), + fprintf(2,'WARNING: 0*NaN within matrix multiplication is not commutative\n'); +end; + +% from Kahan (1996) +tmp = (0-3*i)/inf; +if isnan(tmp) + fprintf(2,'WARNING: (0-3*i)/inf results in NaN instead of 0.\n'); +end; + +%(roots([5,0,0])-[0;0]) +%(roots([2,-10,12])-[3;2]) +%(roots([2e-37,-2,2])-[1e37;1]) +%%%%% check nan/nan %% this test addresses a problem in Matlab 5.3, 6.1 & 6.5 +p = 4; +tmp1 = repmat(nan,p)/repmat(nan,p); +tmp2 = repmat(nan,p)\repmat(nan,p); +tmp3 = repmat(0,p)/repmat(0,p); +tmp4 = repmat(0,p)\repmat(0,p); +tmp5 = repmat(0,p)*repmat(inf,p); +tmp6 = repmat(inf,p)*repmat(0,p); +x = randn(100,1)*ones(1,p); y=x'*x; +tmp7 = y/y; +tmp8 = y\y; + +if ~all(isnan(tmp1(:))), + fprintf(1,'WARNING: matrix division NaN/NaN does not result in NaN\n'); +end; +if ~all(isnan(tmp2(:))), + fprintf(1,'WARNING: matrix division NaN\\NaN does not result in NaN\n'); +end; +if ~all(isnan(tmp3(:))), + fprintf(2,'WARNING: matrix division 0/0 does not result in NaN\n'); +end; +if ~all(isnan(tmp4(:))), + fprintf(2,'WARNING: matrix division 0\\0 does not result in NaN\n'); +end; +if ~all(isnan(tmp5(:))), + fprintf(2,'WARNING: matrix multiplication 0*inf does not result in NaN\n'); +end; +if ~all(isnan(tmp6(:))), + fprintf(2,'WARNING: matrix multiplication inf*0 does not result in NaN\n'); +end; +if any(any(tmp7==inf)); + fprintf(2,'WARNING: right division of two singulare matrices return INF\n'); +end; +if any(any(tmp8==inf)); + fprintf(2,'WARNING: left division of two singulare matrices return INF\n'); +end; + +tmp = [tmp1;tmp2;tmp3;tmp4;tmp5;tmp6;tmp7;tmp8]; + + + +%warning(FLAG_WARNING); + + +%%%%% QUANTILE TEST +d = [1 1 2 2 4 4 10 700]; +q = [-1,0,.05,.1,.25,.49,.5,.51,.75,.8, .999999,1,2]; +r = [ NaN, 1, 1, 1, 1.5, 2, 3, 4, 7, 10, 700, 700, NaN]; +if any( quantile(d, q) - r>0) + fprintf(1,'Quantile(1): failed\n'); +else + fprintf(1,'Quantile(1): OK\n'); +end; +if exist('histo3','file') + H = histo3(d'); +else + H.X = [1;2;4;10;700]; + H.H = [2;2;2;1;1]; + H.datatype = 'HISTOGRAM'; +end; +if any( quantile(H, q)' - r>0) + fprintf(1,'Quantile(2): failed\n'); +else + fprintf(1,'Quantile(2): OK\n'); +end; + diff --git a/octave_packages/nan-2.5.5/normcdf.m b/octave_packages/nan-2.5.5/normcdf.m new file mode 100644 index 0000000..4c0bd4a --- /dev/null +++ b/octave_packages/nan-2.5.5/normcdf.m @@ -0,0 +1,60 @@ +function p = normcdf(x,m,s) +% NORMCDF returns normal cumulative distribtion function +% +% cdf = normcdf(x,m,s); +% +% Computes the CDF of a the normal distribution +% with mean m and standard deviation s +% default: m=0; s=1; +% x,m,s must be matrices of same size, or any one can be a scalar. +% +% see also: NORMPDF, NORMINV + +% Reference(s): + +% $Id: normcdf.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2000-2003,2010,2011 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% 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 . + + +if nargin==1, + m=0; s=1; +elseif nargin==2, + s=1; +end; + +% allocate output memory and check size of arguments +z = (x-m)./s; % if this line causes an error, input arguments do not fit. + +p = (1 + erf(z/sqrt(2)))/2; + +z = (s==0); +p((xm) & z) = 1; + +p(isnan(x) | isnan(m) | isnan(s) | (s<0)) = nan; + +%!assert(sum(isnan(normcdf([-inf,-2,-1,-.5,0,.5,1,2,3,inf,nan]',2,0))),1) + + + + + + diff --git a/octave_packages/nan-2.5.5/norminv.m b/octave_packages/nan-2.5.5/norminv.m new file mode 100644 index 0000000..d5fdf4e --- /dev/null +++ b/octave_packages/nan-2.5.5/norminv.m @@ -0,0 +1,60 @@ +function x = norminv(p,m,s) +% NORMINV returns inverse cumulative function of the normal distribution +% +% x = norminv(p,m,s); +% +% Computes the quantile (inverse of the CDF) of a the normal +% cumulative distribution with mean m and standard deviation s +% default: m=0; s=1; +% p,m,s must be matrices of same size, or any one can be a scalar. +% +% see also: NORMPDF, NORMCDF + +% Reference(s): + +% $Id: norminv.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2000-2003,2010,2011 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% 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 . + +if nargin==1, + m=0; s=1; +elseif nargin==2, + s=1; +end; + +% allocate output memory and check size of arguments +x = sqrt(2)*erfinv(2*p - 1).*s + m; % if this line causes an error, input arguments do not fit. + +x((p>1) | (p<0) | isnan(p) | isnan(m) | isnan(s) | (s<0)) = nan; + +k = (s==0) & ~isnan(m); % temporary variable, reduces number of tests. + +x((p==0) & k) = -inf; + +x((p==1) & k) = +inf; + +k = (p>0) & (p<1) & k; +if numel(m)==1, + x(k) = m; +else + x(k) = m(k); +end; + + +%!assert(sum(~isnan(norminv([-inf,-.2,0,.2,.5,1,2,inf,nan],2,0))),4) + + diff --git a/octave_packages/nan-2.5.5/normpdf.m b/octave_packages/nan-2.5.5/normpdf.m new file mode 100644 index 0000000..de73cdb --- /dev/null +++ b/octave_packages/nan-2.5.5/normpdf.m @@ -0,0 +1,54 @@ +function p = normpdf(x,m,s) +% NORMPDF returns normal probability density +% +% pdf = normpdf(x,m,s); +% +% Computes the PDF of a the normal distribution +% with mean m and standard deviation s +% default: m=0; s=1; +% x,m,s must be matrices of same size, or any one can be a scalar. +% +% see also: NORMCDF, NORMINV + +% Reference(s): + +% $Id: normpdf.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2000-2003,2010,2011 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% 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 . + +if nargin==1, + m=0;s=1; +elseif nargin==2, + s=1; +end; + +% allocate output memory and check size of argument +z = (x-m)./s; % if this line causes an error, input arguments do not fit. + +%p = ((2*pi)^(-1/2))*exp(-z.^2/2)./s; +SQ2PI = 2.5066282746310005024157652848110; +p = exp(-z.^2/2)./(s*SQ2PI); + +p((x==m) & (s==0)) = inf; + +p(isinf(z)~=0) = 0; + +p(isnan(x) | isnan(m) | isnan(s) | (s<0)) = nan; + +%!assert(sum(isnan(normpdf([-inf,-2,-1,-.5,0,.5,1,2,3,inf,nan]',2,0))),1) + + diff --git a/octave_packages/nan-2.5.5/packinfo/DESCRIPTION b/octave_packages/nan-2.5.5/packinfo/DESCRIPTION new file mode 100644 index 0000000..704970c --- /dev/null +++ b/octave_packages/nan-2.5.5/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: NaN +Version: 2.5.5 +Date: 2012-04-03 +Author: Alois Schloegl +Maintainer: Alois Schloegl +Title: The NaN-toolbox +Description: A statistics and machine learning toolbox for Octave and Matlab for data with and w/o missing values. +Depends: octave (> 3.2.0) +License: GPL version 3 or later +Url: http://pub.ist.ac.at/~schloegl/matlab/NaN +Autoload: no diff --git a/octave_packages/nan-2.5.5/packinfo/INDEX b/octave_packages/nan-2.5.5/packinfo/INDEX new file mode 100644 index 0000000..cc9ce9b --- /dev/null +++ b/octave_packages/nan-2.5.5/packinfo/INDEX @@ -0,0 +1,13 @@ +nan >> A statistics and machine learning toolbox +A statistics and machine learning toolbox for data with and w/o missing values + coefficient_of_variation geomean meansq skewness + covm cor cov corrcoef harmmean median statistic + detrend kurtosis moment std mad naninsttest nantest + nansum nanstd nanconv nanfft nanfilter + nanfilter1uc normpdf normcdf norminv meandev + percentile quantile rankcorr ranks rms sumskipnan + var mean sem spearman trimean tpdf tcdf tinv zscore + flag_implicit_significance xcovf train_sc test_sc + xval classify train_lda_sparse decovm gscatter mahal + cdfplot hist2res fss cat2bin ttest ttest2 xptopen + bland_altman cumsumskipnan range diff --git a/octave_packages/nan-2.5.5/partcorrcoef.m b/octave_packages/nan-2.5.5/partcorrcoef.m new file mode 100644 index 0000000..0053bdc --- /dev/null +++ b/octave_packages/nan-2.5.5/partcorrcoef.m @@ -0,0 +1,166 @@ +function [R,sig,ci1,ci2] = partcorrcoef(X,Y,Z,Mode) +% PARTCORRCOEF calculates the partial correlation between X and Y +% after removing the influence of Z. +% X, Y and Z can contain missing values encoded with NaN. +% NaN's are skipped, NaN do not result in a NaN output. +% (Its assumed that the occurence of NaN's is uncorrelated) +% The output gives NaN, only if there are insufficient input data. +% +% The partial correlation is defined as +% pcc(xy|z)=(cc(x,y)-cc(x,z)*cc(y,z))/sqrt((1-cc(x,y)�)*((1-cc(x,z)�))) +% +% +% PARTCORRCOEF(X [,Mode]); +% calculates the (auto-)correlation matrix of X +% PARTCORRCOEF(X,Y,Z); +% PARTCORRCOEF(X,Y,Z,[]); +% PARTCORRCOEF(X,Y,Z,'Pearson'); +% PARTCORRCOEF(X,Y,Z,'Rank'); +% PARTCORRCOEF(X,Y,Z,'Spearman'); +% +% Mode=[] [default] +% removes from X and Y the part that can be explained by Z +% and computes the correlation of the remaining part. +% Ideally, this is equivalent to Mode='Pearson', however, in practice +% this is more accurate. +% Mode='Pearson' or 'parametric' +% Mode='Spearman' +% Mode='Rank' +% computes the partial correlation based on cc(x,y),cc(x,z) and cc(y,z) +% with the respective mode. +% +% [R,p,ci1,ci2] = PARTCORRCOEF(...); +% r is the partialcorrelation matrix +% r(i,j) is the partial correlation coefficient r between X(:,i) and Y(:,j) +% when influence of Z is removed. +% p gives the significance of PCC +% It tests the null hypothesis that the product moment correlation coefficient is zero +% using Student's t-test on the statistic t = r sqrt(N-Nz-2)/sqrt(1-r^2) +% where N is the number of samples (Statistics, M. Spiegel, Schaum series). +% p > alpha: do not reject the Null hypothesis: "R is zero". +% p < alpha: The alternative hypothesis "R2 is larger than zero" is true with probability (1-alpha). +% ci1 lower 0.95 confidence interval +% ci2 upper 0.95 confidence interval +% +% see also: SUMSKIPNAN, COVM, COV, COR, SPEARMAN, RANKCORR, RANKS, CORRCOEF +% +% REFERENCES: +% on the partial correlation coefficient +% [1] http://www.tufts.edu/~gdallal/partial.htm +% [2] http://www.nag.co.uk/numeric/fl/manual/pdf/G02/g02byf.pdf + +% $Id: partcorrcoef.m 8351 2011-06-24 17:35:07Z carandraug $ +% Copyright (C) 2000-2002,2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +% Features: +% + interprets NaN's as missing value +% + Pearson's correlation +% + Spearman's rank correlation +% + Rank correlation (non-parametric, non-Spearman) +% + is fast, using an efficient algorithm O(n.log(n)) for calculating the ranks +% + significance test for null-hypthesis: r=0 +% + confidence interval (0.99) included +% - rank correlation works for cell arrays, too (no check for missing values). +% + compatible with Octave and Matlab + + +if nargin==3 + Mode=[]; +elseif nargin==4, +else + error('Error PARTCORRCOEF: Missing argument(s)\n'); +end; + +if isempty(Z) + R = corrcoef(X,Y,Mode); + +elseif isempty(Mode) + if ~isempty(Z) + for j=1:size(X,2) + ix = ~any(isnan(Z),2) & ~isnan(X(:,j)); + X(:,j) = X(:,j) - Z*(Z(ix,:)\X(ix,j)); + end; + for j=1:size(Y,2) + ix = ~any(isnan(Z),2) & ~isnan(Y(:,j)); + Y(:,j) = Y(:,j) - Z*(Z(ix,:)\Y(ix,j)); + end; + end; + R = corrcoef(X,Y,Mode); + +else + rxy = corrcoef(X,Y,Mode); + rxz = corrcoef(X,Z,Mode); + if isempty(Y), + ryz = rxz; + else + ryz = corrcoef(Y,Z,Mode); + end; + + %rxy,rxz,ryz + R = (rxy-rxz*ryz')./sqrt((1-rxz.^2)*(1-ryz.^2)'); + +end; + +if nargout<2, + return, +end; + +% SIGNIFICANCE TEST +%warning off; % prevent division-by-zero warnings in Matlab. +NN=size(X,1)-size(Z,2); + +tmp = 1 - R.*R; +tmp(tmp<0) = 0; % prevent tmp<0 i.e. imag(t)~=0 +t = R.*sqrt(max(NN-2,0)./tmp); + +if exist('t_cdf','file') + sig = t_cdf(t,NN-2); +elseif exist('tcdf','file') + sig = tcdf(t,NN-2); +else + fprintf('Warning CORRCOEF: significance test not completed because of missing TCDF-function\n') + sig = repmat(nan,size(R)); +end; +sig = 2 * min(sig,1 - sig); + +if nargout<3, + return, +end; + + +% CONFIDENCE INTERVAL +if exist('flag_implicit_significance','file'), + alpha = flag_implicit_significance; +else + alpha = 0.01; +end; + +fprintf(1,'CORRCOEF: confidence interval is based on alpha=%f\n',alpha); + +tmp = R; +%tmp(ix1 | ix2) = nan; % avoid division-by-zero warning +z = log((1+tmp)./(1-tmp))/2; % Fisher's z-transform; +%sz = 1./sqrt(NN-3); % standard error of z +sz = sqrt(2)*erfinv(1-2*alpha)./sqrt(NN-3); % confidence interval for alpha of z + +ci1 = tanh(z-sz); +ci2 = tanh(z+sz); + + + diff --git a/octave_packages/nan-2.5.5/percentile.m b/octave_packages/nan-2.5.5/percentile.m new file mode 100644 index 0000000..cb0f3bd --- /dev/null +++ b/octave_packages/nan-2.5.5/percentile.m @@ -0,0 +1,47 @@ +function Q=percentile(Y,q,DIM) +% PERCENTILE calculates the percentiles of histograms and sample arrays. +% +% Q = percentile(Y,q) +% Q = percentile(Y,q,DIM) +% returns the q-th percentile along dimension DIM of sample array Y. +% size(Q) is equal size(Y) except for dimension DIM which is size(Q,DIM)=length(Q) +% +% Q = percentile(HIS,q) +% returns the q-th percentile from the histogram HIS. +% HIS must be a HISTOGRAM struct as defined in HISTO2 or HISTO3. +% If q is a vector, the each row of Q returns the q(i)-th percentile +% +% see also: HISTO2, HISTO3, QUANTILE + +% $Id: percentile.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 1996-2003,2005,2006,2007 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% 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 . + + +if nargin==2, + Q = quantile(Y,q/100); + +elseif nargin==3, + Q = quantile(Y,q/100,DIM); + +else + help percentile + +end; + + + diff --git a/octave_packages/nan-2.5.5/prctile.m b/octave_packages/nan-2.5.5/prctile.m new file mode 100644 index 0000000..63948d4 --- /dev/null +++ b/octave_packages/nan-2.5.5/prctile.m @@ -0,0 +1,48 @@ +function Q=prctile(Y,q,DIM) +% PRCTILE calculates the percentiles of histograms and sample arrays. +% (its the same than PERCENTILE.M) +% +% Q = prctile(Y,q) +% Q = prctile(Y,q,DIM) +% returns the q-th percentile along dimension DIM of sample array Y. +% size(Q) is equal size(Y) except for dimension DIM which is size(Q,DIM)=length(Q) +% +% Q = prctile(HIS,q) +% returns the q-th percentile from the histogram HIS. +% HIS must be a HISTOGRAM struct as defined in HISTO2 or HISTO3. +% If q is a vector, the each row of Q returns the q(i)-th percentile +% +% see also: HISTO2, HISTO3, QUANTILE + +% $Id$ +% Copyright (C) 1996-2003,2005,2006,2007,2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% 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 . + + +if nargin==2, + Q = quantile(Y,q/100); + +elseif nargin==3, + Q = quantile(Y,q/100,DIM); + +else + help percentile + +end; + + + diff --git a/octave_packages/nan-2.5.5/quantile.m b/octave_packages/nan-2.5.5/quantile.m new file mode 100644 index 0000000..007d608 --- /dev/null +++ b/octave_packages/nan-2.5.5/quantile.m @@ -0,0 +1,151 @@ +function Q=quantile(Y,q,DIM,method) +% QUANTILE calculates the quantiles of histograms and sample arrays. +% +% Q = quantile(Y,q) +% Q = quantile(Y,q,DIM) +% returns the q-th quantile along dimension DIM of sample array Y. +% size(Q) is equal size(Y) except for dimension DIM which is size(Q,DIM)=length(Q) +% +% Q = quantile(HIS,q) +% returns the q-th quantile from the histogram HIS. +% HIS must be a HISTOGRAM struct as defined in HISTO2 or HISTO3. +% If q is a vector, the each row of Q returns the q(i)-th quantile +% +% see also: HISTO2, HISTO3, PERCENTILE + + +% $Id: quantile.m 9601 2012-02-09 14:14:36Z schloegl $ +% Copyright (C) 1996-2003,2005,2006,2007,2009,2011 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +if nargin<3, + DIM = []; +end; +if isempty(DIM), + DIM = find(size(Y)>1,1); + if isempty(DIM), DIM = 1; end; +end; + + +if nargin<2, + help quantile + +else + [q, rix] = sort(q(:)'); % sort quantile values + [tmp,rix] = sort(rix); % generate reverse index + + SW = isstruct(Y); + if SW, SW = isfield(Y,'datatype'); end; + if SW, SW = strcmp(Y.datatype,'HISTOGRAM'); end; + if SW, + [yr, yc] = size(Y.H); + Q = repmat(nan,length(q),yc); + if ~isfield(Y,'N'); + Y.N = sum(Y.H,1); + end; + + for k1 = 1:yc, + tmp = Y.H(:,k1)>0; + h = full(Y.H(tmp,k1)); + t = Y.X(tmp,min(size(Y.X,2),k1)); + + N = Y.N(k1); + t2(1:2:2*length(t)) = t; + t2(2:2:2*length(t)) = t; + x2 = cumsum(h); + x(1)=0; + x(2:2:2*length(t)) = x2; + x(3:2:2*length(t)) = x2(1:end-1); + + % Q(q < 0 | 1 < q,:) = NaN; % already done at initialization + Q(q==0,k1) = t2(1); + Q(q==1,k1) = t2(end); + n = 1; + for k2 = find( (0 < q) & (q < 1) ) + while (q(k2)*N > x(n)), + n=n+1; + end; + + if q(k2)*N==x(n) + % mean of upper and lower bound + Q(k2,k1) = (t2(n)+t2(n+1))/2; + else + Q(k2,k1) = t2(n); + end; + end; + Q = Q(rix,:); % order resulting quantiles according to original input q + end; + + + elseif isnumeric(Y), + sz = size(Y); + if DIM>length(sz), + sz = [sz,ones(1,DIM-length(sz))]; + end; + + f = zeros(1,length(q)); + f( (q < 0) | (1 < q) ) = NaN; + D1 = prod(sz(1:DIM-1)); + D3 = prod(sz(DIM+1:length(sz))); + Q = repmat(nan,[sz(1:DIM-1),length(q),sz(DIM+1:length(sz))]); + for k = 0:D1-1, + for l = 0:D3-1, + xi = k + l * D1*sz(DIM) + 1 ; + xo = k + l * D1*length(q) + 1; + t = Y(xi:D1:xi+D1*sz(DIM)-1); + t = t(~isnan(t)); + N = length(t); + + if (N==0) + f(:) = NaN; + else + t = sort(t); + t2(1:2:2*length(t)) = t; + t2(2:2:2*length(t)) = t; + x = floor((1:2*length(t))/2); + %f(q < 0 | 1 < q) = NaN; % for efficiency its defined outside loop + f(q==0) = t2(1); + f(q==1) = t2(end); + + n = 1; + for k2 = find( (0 < q) & (q < 1) ) + while (q(k2)*N > x(n)), + n = n+1; + end; + + if q(k2)*N==x(n) + % mean of upper and lower bound + f(k2) = (t2(n) + t2(n+1))/2; + else + f(k2) = t2(n); + end; + end; + end; + Q(xo:D1:xo + D1*length(q) - 1) = f(rix); + end; + end; + + else + fprintf(2,'Error QUANTILES: invalid input argument\n'); + return; + end; + +end; + +%!assert(quantile(1:10,[.2,.5]),[2.5, 5.5]) + + diff --git a/octave_packages/nan-2.5.5/range.m b/octave_packages/nan-2.5.5/range.m new file mode 100644 index 0000000..5a271a6 --- /dev/null +++ b/octave_packages/nan-2.5.5/range.m @@ -0,0 +1,66 @@ +function Q=range(Y,DIM) +% RANGE calculates the range of Y +% Missing values (encoded as NaN) are ignored. +% +% Q = range(Y) +% Q = range(Y,DIM) +% returns the range along dimension DIM of sample array Y. +% +% Q = range(HIS) +% returns the RANGE from the histogram HIS. +% HIS must be a HISTOGRAM struct as defined in HISTO2 or HISTO3. +% +% see also: IQR, MAD, HISTO2, HISTO3, PERCENTILE, QUANTILE + + +% $Id$ +% Copyright (C) 2009,2010,2011 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +if nargin<2, + DIM = []; +end; +if isempty(DIM), + DIM = find(size(Y)>1,1); + if isempty(DIM), DIM = 1; end; +end; + + +if nargin<1, + help range + +else + SW = isstruct(Y); + if SW, SW = isfield(Y,'datatype'); end; + if SW, SW = strcmp(Y.datatype,'HISTOGRAM'); end; + if SW, + Q = repmat(NaN,1,size(Y.H,2)); + for k=1:size(Y.H,2); + t = Y.X(find(Y.H(:,k)>0),min(size(Y.X,2),k)); + Q(1,k) = max(t)-min(t); + end; + elseif isnumeric(Y) && nargin==1, + Q = max(Y) - min(Y); + elseif isnumeric(Y) && nargin==2, + Q = max(Y,[],DIM) - min(Y,[],DIM); + else + help range + end; +end; + + + diff --git a/octave_packages/nan-2.5.5/rankcorr.m b/octave_packages/nan-2.5.5/rankcorr.m new file mode 100644 index 0000000..74327d3 --- /dev/null +++ b/octave_packages/nan-2.5.5/rankcorr.m @@ -0,0 +1,45 @@ +function r = rankcorr(X,Y) +% RANKCORR calculated the rank correlation coefficient. +% This function is replaced by CORRCOEF. +% Significance test and confidence intervals can be obtained from CORRCOEF, too. +% +% R = CORRCOEF(X, [Y, ] 'Rank'); +% +% The rank correlation r = corrcoef(ranks(x)). +% is often confused with Spearman's rank correlation. +% Spearman's correlation is defined as +% r(x,y) = 1-6*sum((ranks(x)-ranks(y)).^2)/(N*(N*N-1)) +% The results are different. Here, the former version is implemented. +% +% see also: CORRCOEF, SPEARMAN, RANKS +% +% REFERENCES: +% [1] http://mathworld.wolfram.com/SpearmanRankCorrelationCoefficient.html +% [2] http://mathworld.wolfram.com/CorrelationCoefficient.html + +% $Id: rankcorr.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2003 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% 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 . + + +% warning('RANKCORR might become obsolete; use CORRCOEF(ranks(x)) or CORRCOEF(...,''Rank'') instead'); + +if nargin < 2 + r = corrcoef(ranks(X)); +else + r = corrcoef(ranks(X),ranks(Y)); +end \ No newline at end of file diff --git a/octave_packages/nan-2.5.5/ranks.m b/octave_packages/nan-2.5.5/ranks.m new file mode 100644 index 0000000..5b8db9d --- /dev/null +++ b/octave_packages/nan-2.5.5/ranks.m @@ -0,0 +1,169 @@ +function r = ranks(X,DIM,Mode) +% RANKS gives the rank of each element in a vector. +% This program uses an advanced algorithm with averge effort O(m.n.log(n)) +% NaN in the input yields NaN in the output. +% +% r = ranks(X[,DIM]) +% if X is a vector, return the vector of ranks of X adjusted for ties. +% if X is matrix, the rank is calculated along dimension DIM. +% if DIM is zero or empty, the lowest dimension with more then 1 element is used. +% r = ranks(X,DIM,'traditional') +% implements the traditional algorithm with O(n^2) computational +% and O(n^2) memory effort +% r = ranks(X,DIM,'mtraditional') +% implements the traditional algorithm with O(n^2) computational +% and O(n) memory effort +% r = ranks(X,DIM,'advanced ') +% implements an advanced algorithm with O(n*log(n)) computational +% and O(n.log(n)) memory effort +% r = ranks(X,DIM,'advanced-ties') +% implements an advanced algorithm with O(n*log(n)) computational +% and O(n.log(n)) memory effort +% but without correction for ties +% This is the fastest algorithm +% +% see also: CORRCOEF, SPEARMAN, RANKCORR +% +% REFERENCES: +% -- + + +% $Id: ranks.m 8456 2011-08-10 13:20:17Z schloegl $ +% Copyright (C) 2000-2002,2005,2010 by Alois Schloegl +% This script is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +% Features: +% + is fast, uses an efficient algorithm for the rank correlation +% + computational effort is O(n.log(n)) instead of O(n^2) +% + memory effort is O(n.log(n)), instead of O(n^2). +% Now, the ranks of 8000 elements can be easily calculated +% + NaN's in the input yield NaN in the output +% + compatible with this software and Matlab +% + traditional method is also implemented for comparison. + + +if nargin<2, DIM = 0; end; +if ischar(DIM), + Mode= DIM; + DIM = 0; +elseif (nargin<3), + Mode = ''; +end; +if isempty(Mode), + Mode='advanced '; +end; + +sz = size(X); +if (~DIM) + DIM = find(sz>1,1); +end; +[N,M] = size(X); +if (DIM==2), + X = X'; + [N,M] = size(X); +end; + +if strcmp(Mode(1:min(11,length(Mode))),'traditional'), % traditional, needs O(m.n^2) +% this method was originally implemented by: KH +% Comment of KH: This code is rather ugly, but is there an easy way to get the ranks adjusted for ties from sort? + +r = zeros(size(X)); + for i = 1:M; + p = X(:, i(ones(1,N))); + r(:,i) = (sum (p < p') + (sum (p == p') + 1) / 2)'; + end; + % r(r<1)=NaN; + +elseif strcmp(Mode(1:min(12,length(Mode))),'mtraditional'), + % + memory effort is lower + + r = zeros(size(X)); + for k = 1:N; + for i = 1:M; + r(k,i) = (sum (X(:,i) < X(k,i)) + (sum (X(:,i) == X(k,i)) + 1) / 2); + end; + end; + % r(r<1)=NaN; + +elseif strcmp(Mode(1:min(13,length(Mode))),'advanced-ties'), % advanced + % + uses sorting, hence needs only O(m.n.log(n)) computations + % - does not fix ties + + r = zeros(size(X)); + [sX, ix] = sort(X,1); + for k=1:M, + [tmp,r(:,k)] = sort(ix(:,k),1); % r yields the rank of each element + end; + r(isnan(X)) = nan; + + +elseif strcmp(Mode(1:min(8,length(Mode))),'advanced'), % advanced + % + uses sorting, hence needs only O(m.n.log(n)) computations + + % [tmp,ix] = sort([X,Y]); + % [tmp,r] = sort(ix); % r yields rank. + % but because sort does not work accordingly for cell arrays, + % and DIM argument not supported by Octave + % and DIM argument does not work for cell-arrays in Matlab + % we sort each column separately: + + r = zeros(size(X)); + n = N; + for k = 1:M, + [sX,ix] = sort(X(:,k)); + [tmp,r(:,k)] = sort(ix); % r yields the rank of each element + + % identify multiple occurences (not sure if this important, but implemented to be compatible with traditional version) + if isnumeric(X) + n=sum(~isnan(X(:,k))); + end; + x = [0;find(sX~=[sX(2:N);n])]; % for this reason, cells are not implemented yet. + d = find(diff(x)>1); + + % correct rank of multiple occurring elements + for l = 1:length(d), + t = (x(d(l))+1:x(d(l)+1))'; + r(ix(t),k) = mean(t); + end; + end; + r(isnan(X)) = nan; + +elseif strcmp(Mode,'=='), +% the results of both algorithms are compared for testing. +% +% if the Mode-argument is omitted, both methods are applied and +% the results are compared. Once the advanced algorithm is confirmed, +% it will become the default Mode. + + r = ranks(X,'advanced '); + r(isnan(r)) = 1/2; + + if N>100, + r1 = ranks(X,'mtraditional'); % Memory effort is lower + else + r1 = ranks(X,'traditional'); + end; + if ~all(all(r==r1)), + fprintf(2,'WARNING RANKS: advanced algorithm does not agree with traditional one\n Please report to \n'); + r = r1; + end; + r(isnan(X)) = nan; +end; + +if (DIM==2) + r=r'; +end; diff --git a/octave_packages/nan-2.5.5/rms.m b/octave_packages/nan-2.5.5/rms.m new file mode 100644 index 0000000..29fd06b --- /dev/null +++ b/octave_packages/nan-2.5.5/rms.m @@ -0,0 +1,57 @@ +function o=rms(x,DIM,W) +% RMS calculates the root mean square +% can deal with complex data. +% +% y = rms(x,DIM,W) +% +% DIM dimension +% 1 STD of columns +% 2 STD of rows +% N STD of N-th dimension +% default or []: first DIMENSION, with more than 1 element +% W weights to compute weighted s.d. (default: []) +% if W=[], all weights are 1. +% number of elements in W must match size(x,DIM) +% +% y estimated standard deviation +% +% features: +% - can deal with NaN's (missing values) +% - weighting of data +% - dimension argument also in Octave +% - compatible to Matlab and Octave +% +% see also: SUMSKIPNAN, MEAN + + +% 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 . + + +% $Id: rms.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2003,2008,2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +if nargin<2, + [o,N,ssq] = sumskipnan(x); +elseif nargin<3 + [o,N,ssq] = sumskipnan(x,DIM); +else + [o,N,ssq] = sumskipnan(x,DIM,W); +end; + +o = sqrt(ssq./N); + + \ No newline at end of file diff --git a/octave_packages/nan-2.5.5/row_col_deletion.m b/octave_packages/nan-2.5.5/row_col_deletion.m new file mode 100644 index 0000000..578687b --- /dev/null +++ b/octave_packages/nan-2.5.5/row_col_deletion.m @@ -0,0 +1,113 @@ +function [rix,cix] = row_col_deletion(d,c,w) +% ROW_COL_DELETION selects the rows and columns for removing any missing values. +% A heuristic based on maximizing the number of remaining sample values +% is used. In other words, if there are more rows than columns, it is +% more likely that a row-wise deletion will be applied and vice versa. +% +% [rix,cix] = row_col_deletion(d) +% [rix,cix] = row_col_deletion(d,c,w) +% +% Input: +% d data (each row is a sample, each column a feature) +% c classlabels (not really used) [OPTIONAL] +% w weight for each sample vector [OPTIONAL] +% Output: +% rix selected samples +% cix selected columns +% +% d(rix,cix) does not contain any NaN's i.e. missing values +% +% see also: TRAIN_SC, TEST_SC + +% $Id$ +% Copyright (C) 2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 3 +% of the License, or (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + + +if nargin > 2, + if isempty(w) || all(w==w(1)), + ix = ~isnan(c); + else + ix = ~any(isnan(c) | isnan(w)); + end; + d = d(ix,:); %% ignore samples with invalid c or w + w = w(ix,:); + +elseif nargin > 1, + d = d(~isnan(c),:); %% ignore samples with invalid c or w + w = []; +else + w = []; +end; + + +if 0, + % decides whether row-wise or column-wise deletion removes less data. + % rix and cix are the resulting index vectors + % either row-wise or column-wise deletion, but not a combination of both, is used. + % this is obsolete + + n = numel(d); + cix = find(~any(isnan(d),1)); + rix = find(~any(isnan(d),2)); + nr = length(rix)*size(d,2); % number of elements after row-wise deletion + nc = length(cix)*size(d,1); % number of elements after column-wise deletion + + if (nr>nc) + cix = 1:size(d,2); % select all columns + %fprintf(1,'row-wise deletion (%i,%i,%i)\n',n,nr,nc); + else + rix = 1:size(d,1); % select all rows + %fprintf(1,'column-wise deletion (%i,%i,%i)\n',n,nr,nc); + end; + +else + + %% a mix of row- and column-wise deletion is possible + if ~isempty(w) && (abs(sum(w)-1) > log2(N)*eps || any(w<0) || any(~isfinite(w))) + error('weight vector must contain only non-negative and finite values'); + end; + [N,M] = size(d); + rix = ones(N,1); cix = ones(1,M); + while 1; + e = ~isnan(d(rix>0,cix>0)); + if ~isempty(w), + colCost = mean(e, 1, w(rix>0)/sum(w(rix>0)))'; % cost of deleting columns + else + colCost = mean(e, 1)'; % cost of deleting columns + end; + rowCost = mean(e, 2); % cost of deleting rows + [tmp,ix] = sort([colCost; rowCost]); + + if abs(tmp(1)-1) < log2(N)*eps, break; end; % stopping criterion + + if diff(tmp(1:2))==0, warning('row/col deletion: arbitrary selection [%i,%i]',ix(1:2)); end; + ix = ix(1); + if (ix<=sum(cix)) + tmp = find(cix>0); + cix(tmp(ix)) = 0; + else + tmp = find(rix>0); + rix(tmp(ix-sum(cix))) = 0; + end; + end; + rix = find(rix); + cix = find(cix); + +end + diff --git a/octave_packages/nan-2.5.5/sem.m b/octave_packages/nan-2.5.5/sem.m new file mode 100644 index 0000000..479f5e7 --- /dev/null +++ b/octave_packages/nan-2.5.5/sem.m @@ -0,0 +1,58 @@ +function [SE,M]=sem(x,DIM, W) +% SEM calculates the standard error of the mean +% +% [SE,M] = SEM(x [, DIM [,W]]) +% calculates the standard error (SE) in dimension DIM +% the default DIM is the first non-single dimension +% M returns the mean. +% Can deal with complex data, too. +% +% DIM dimension +% 1: SEM of columns +% 2: SEM of rows +% N: SEM of N-th dimension +% default or []: first DIMENSION, with more than 1 element +% W weights to compute weighted mean and s.d. (default: []) +% if W=[], all weights are 1. +% number of elements in W must match size(x,DIM) +% +% features: +% - can deal with NaN's (missing values) +% - weighting of data +% - dimension argument +% - compatible to Matlab and Octave +% +% see also: SUMSKIPNAN, MEAN, VAR, STD + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +% Copyright (C) 2000-2003,2008,2009 by Alois Schloegl +% $Id: sem.m 8223 2011-04-20 09:16:06Z schloegl $ +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +if nargin>2, + [S,N,SSQ] = sumskipnan(x,DIM,W); +elseif nargin>1, + [S,N,SSQ] = sumskipnan(x,DIM); +else + [S,N,SSQ] = sumskipnan(x); +end + +M = S./N; +SE = (SSQ.*N - real(S).^2 - imag(S).^2)./(N.*N.*(N-1)); +SE(SE<=0) = 0; % prevent negative value caused by round-off error +SE = sqrt(real(SE)); + diff --git a/octave_packages/nan-2.5.5/skewness.m b/octave_packages/nan-2.5.5/skewness.m new file mode 100644 index 0000000..75ceffd --- /dev/null +++ b/octave_packages/nan-2.5.5/skewness.m @@ -0,0 +1,68 @@ +function R = skewness(i,DIM) +% SKEWNESS estimates the skewness +% +% y = skewness(x,DIM) +% calculates skewness of x in dimension DIM +% +% DIM dimension +% 1: STATS of columns +% 2: STATS of rows +% default or []: first DIMENSION, with more than 1 element +% +% features: +% - can deal with NaN's (missing values) +% - dimension argument +% - compatible to Matlab and Octave +% +% see also: SUMSKIPNAN, STATISTIC +% +% REFERENCE(S): +% http://mathworld.wolfram.com/ + +% $Id: skewness.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2003,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + + +% check input arguments + +if nargin==1, + DIM = find(size(i)>1,1); + if isempty(DIM), DIM=1; end; +end; + +[R.SUM,R.N,R.SSQ] = sumskipnan(i,DIM); % sum + +R.MEAN = R.SUM./R.N; % mean +R.SSQ0 = R.SSQ - real(R.SUM).*real(R.MEAN) - imag(R.SUM).*imag(R.MEAN); % sum square with mean removed + +%if flag_implicit_unbiased_estim; %% ------- unbiased estimates ----------- + n1 = max(R.N-1,0); % in case of n=0 and n=1, the (biased) variance, STD and SEM are INF +%else +% n1 = R.N; +%end; + +R.VAR = R.SSQ0./n1; % variance (unbiased) +R.STD = sqrt(R.VAR); % standard deviation + +i = i - repmat(R.MEAN,size(i)./size(R.MEAN)); +R.CM3 = sumskipnan(i.^3,DIM)./n1; +%R.CM4 = sumskipnan(i.^4,DIM)./n1; + +R = R.CM3./(R.STD.^3); +%R = R.CM4./(R.VAR.^2)-3; diff --git a/octave_packages/nan-2.5.5/spearman.m b/octave_packages/nan-2.5.5/spearman.m new file mode 100644 index 0000000..481e921 --- /dev/null +++ b/octave_packages/nan-2.5.5/spearman.m @@ -0,0 +1,45 @@ +function r = spearman(x,y) +% SPEARMAN Spearman's rank correlation coefficient. +% This function is replaced by CORRCOEF. +% Significance test and confidence intervals can be obtained from CORRCOEF. +% +% [R,p,ci1,ci2] = CORRCOEF(x, [y, ] 'Rank'); +% +% For some (unknown) reason, in previous versions Spearman's rank correlation +% r = corrcoef(ranks(x)). +% But according to [1], Spearman's correlation is defined as +% r = 1-6*sum((ranks(x)-ranks(y)).^2)/(N*(N*N-1)) +% The results are different. Here, the later version is implemented. +% +% see also: CORRCOEF, RANKCORR +% +% REFERENCES: +% [1] http://mathworld.wolfram.com/SpearmanRankCorrelationCoefficient.html +% [2] http://mathworld.wolfram.com/CorrelationCoefficient.html + +% $Id: spearman.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2002 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + +% warning('SPEARMAN might become obsolete; use CORRCOEF(...,''Spearman'') instead'); + +if nargin < 2 + r = corrcoef(x,'Spearman'); +else + r = corrcoef(x,y,'Spearman'); +end diff --git a/octave_packages/nan-2.5.5/statistic.m b/octave_packages/nan-2.5.5/statistic.m new file mode 100644 index 0000000..a58973b --- /dev/null +++ b/octave_packages/nan-2.5.5/statistic.m @@ -0,0 +1,173 @@ +function [varargout]=statistic(i,DIM,fun) +% STATISTIC estimates various statistics at once. +% +% R = STATISTIC(x,DIM) +% calculates all statistic (see list of fun) in dimension DIM +% R is a struct with all statistics +% +% y = STATISTIC(x,fun) +% estimate of fun on dimension DIM +% y gives the statistic of fun +% +% DIM dimension +% 1: STATS of columns +% 2: STATS of rows +% N: STATS of N-th dimension +% default or []: first DIMENSION, with more than 1 element +% +% fun 'mean' mean +% 'std' standard deviation +% 'var' variance +% 'sem' standard error of the mean +% 'rms' root mean square +% 'meansq' mean of squares +% 'sum' sum +% 'sumsq' sum of squares +% 'CM#' central moment of order # +% 'skewness' skewness +% 'kurtosis' excess coefficient (Fisher kurtosis) +% 'mad' mean absolute deviation +% +% features: +% - can deal with NaN's (missing values) +% - dimension argument +% - compatible to Matlab and Octave +% +% see also: SUMSKIPNAN +% +% REFERENCE(S): +% [1] http://www.itl.nist.gov/ +% [2] http://mathworld.wolfram.com/ + +% $Id: statistic.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2003,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + + +if nargin==1, + DIM=[]; + fun=[]; +elseif nargin==2, + if ~isnumeric(DIM), + fun=DIM; + DIM=[]; + else + fun=[]; + end +end +if isempty(DIM), + DIM = find(size(i)>1,1); + if isempty(DIM), DIM=1; end; +end; + +%R.N = sumskipnan(~isnan(i),DIM); % number of elements +[R.SUM,R.N,R.SSQ] = sumskipnan(i,DIM); % sum +%R.S3P = sumskipnan(i.^3,DIM); % sum of 3rd power +R.S4P = sumskipnan(i.^4,DIM); % sum of 4th power +%R.S5P = sumskipnan(i.^5,DIM); % sum of 5th power + +R.MEAN = R.SUM./R.N; % mean +R.MSQ = R.SSQ./R.N; % mean square +R.RMS = sqrt(R.MSQ); % root mean square +%R.SSQ0 = R.SSQ-R.SUM.*R.MEAN; % sum square of mean removed +R.SSQ0 = R.SSQ - real(R.SUM).*real(R.MEAN) - imag(R.SUM).*imag(R.MEAN); % sum square of mean removed + +%if flag_implicit_unbiased_estim; %% ------- unbiased estimates ----------- + n1 = max(R.N-1,0); % in case of n=0 and n=1, the (biased) variance, STD and SEM are INF +%else +% n1 = R.N; +%end; + +R.VAR = R.SSQ0./n1; % variance (unbiased) +R.STD = sqrt(R.VAR); % standard deviation +R.SEM = sqrt(R.SSQ0./(R.N.*n1)); % standard error of the mean +R.SEV = sqrt(n1.*(n1.*R.S4P./R.N+(R.N.^2-2*R.N+3).*(R.SSQ./R.N).^2)./(R.N.^3)); % standard error of the variance +R.COEFFICIENT_OF_VARIATION = R.STD./R.MEAN; + +q = quantile(i, (1:3)/4, DIM); + +%sz=size(i);sz(DIM)=1; +%Q0500=repmat(nan,sz); +%Q0250=Q0500; +%Q0750=Q0500; +%MODE=Q0500; +%for k=1:size(i,2), +% tmp = sort(i(:,k)); + %ix = find(~~diff([-inf;tmp;inf])) + %ix2=diff(ix) + %MODE(k)= tmp(max(ix2)==ix2) +% Q0500(k) = flix(tmp,R.N(k)/2 + 0.5); +% Q0250(k) = flix(tmp,R.N(k)/4 + 0.5); +% Q0750(k) = flix(tmp,R.N(k)*3/4 + 0.5); +%end; +%R.MEDIAN = Q0500; +%R.Quartiles = [Q0250; Q0750]; + +%R.Skewness.Fisher = (R.CM3)./(R.STD.^3); %%% same as R.SKEWNESS + +%R.Skewness.Pearson_Mode = (R.MEAN-R.MODE)./R.STD; +%R.Skewness.Pearson_coeff1 = (3*R.MEAN-R.MODE)./R.STD; +%R.Skewness.Pearson_coeff2 = (3*R.MEAN-R.MEDIAN)./R.STD; +%R.Skewness.Bowley = (Q0750+Q0250 - 2*Q0500)./(Q0750-Q0250); % quartile skewness coefficient + +R.CM2 = R.SSQ0./n1; +szi = size(i); szm = [size(R.MEAN),1]; +i = i - repmat(R.MEAN,szi./szm(1:length(szi))); +R.CM3 = sumskipnan(i.^3,DIM)./n1; +R.CM4 = sumskipnan(i.^4,DIM)./n1; +%R.CM5 = sumskipnan(i.^5,DIM)./n1; + +R.SKEWNESS = R.CM3./(R.STD.^3); +R.KURTOSIS = R.CM4./(R.VAR.^2)-3; +[R.MAD,N] = sumskipnan(abs(i),DIM); % mean absolute deviation +R.MAD = R.MAD./n1; + +R.datatype = 'STAT Level 3'; + +tmp = version; +if 0, %str2num(tmp(1))*1000+str2num(tmp(3))*100+str2num(tmp(5:6))<2136, + % ###obsolete: was needed for Octave version < 2.1.36 + if strcmp(fun(1:2),'CM') + oo = str2double(fun(3:length(fun))); + varargout = sumskipnan(i.^oo,DIM)./n1; + elseif isempty(fun) + varargout = R; + else + varargout = getfield(R,upper(fun)); + end; +else + if iscell(fun), + for k=1:length(fun), + if strcmp(fun{k}(1:2),'CM') + oo = str2double(fun{k}(3:length(fun{k}))); + varargout{k} = sumskipnan(i.^oo,DIM)./n1; + else + varargout{k} = getfield(R,upper(fun{k})); + end; + end; + elseif ischar(fun), + if strcmp(fun(1:2),'CM') + oo = str2double(fun(3:length(fun))); + varargout{1} = sumskipnan(i.^oo,DIM)./n1; + else + varargout{1} = getfield(R,upper(fun)); + end; + else + varargout{1} = R; + end; +end; diff --git a/octave_packages/nan-2.5.5/std.m b/octave_packages/nan-2.5.5/std.m new file mode 100644 index 0000000..b199821 --- /dev/null +++ b/octave_packages/nan-2.5.5/std.m @@ -0,0 +1,124 @@ +function [o,v]=std(x,opt,DIM,W) +% STD calculates the standard deviation. +% +% [y,v] = std(x [, opt[, DIM [, W]]]) +% +% opt option +% 0: normalizes with N-1 [default] +% provides the square root of best unbiased estimator of the variance +% 1: normalizes with N, +% this provides the square root of the second moment around the mean +% otherwise: +% best unbiased estimator of the standard deviation (see [1]) +% +% DIM dimension +% N STD of N-th dimension +% default or []: first DIMENSION, with more than 1 element +% W weights to compute weighted s.d. (default: []) +% if W=[], all weights are 1. +% number of elements in W must match size(x,DIM) +% +% y estimated standard deviation +% +% features: +% - provides an unbiased estimation of the S.D. +% - can deal with NaN's (missing values) +% - weighting of data +% - dimension argument also in Octave +% - compatible to Matlab and Octave +% +% see also: RMS, SUMSKIPNAN, MEAN, VAR, MEANSQ, +% +% +% References(s): +% [1] http://mathworld.wolfram.com/StandardDeviationDistribution.html + + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +% $Id: std.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2003,2006,2009,2010 by Alois Schloegl +% This is part of the NaN-toolbox for Octave and Matlab +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +if nargin<4, + W = []; +end; +if nargin<3, + DIM = []; +end; +if isempty(DIM), + DIM = find(size(x)>1,1); + if isempty(DIM), DIM=1; end; +end; + + +[y,n,ssq] = sumskipnan(x,DIM,W); +if all(ssq(:).*n(:) > 2*(y(:).^2)) + %% rounding error is neglectable + y = ssq - y.*y./n; +else + %% rounding error is not neglectable + szx = size(x); + szy = size(y); + if length(szy)1, + v = y.*((max(n-1,0)./(n.*n))-1./(n.*ib.*ib)); % variance of the estimated S.D. ??? needs further checks +end; + + diff --git a/octave_packages/nan-2.5.5/sumskipnan.m b/octave_packages/nan-2.5.5/sumskipnan.m new file mode 100644 index 0000000..6103269 --- /dev/null +++ b/octave_packages/nan-2.5.5/sumskipnan.m @@ -0,0 +1,193 @@ +function [o,count,SSQ] = sumskipnan(x, DIM, W) +% SUMSKIPNAN adds all non-NaN values. +% +% All NaN's are skipped; NaN's are considered as missing values. +% SUMSKIPNAN of NaN's only gives O; and the number of valid elements is return. +% SUMSKIPNAN is also the elementary function for calculating +% various statistics (e.g. MEAN, STD, VAR, RMS, MEANSQ, SKEWNESS, +% KURTOSIS, MOMENT, STATISTIC etc.) from data with missing values. +% SUMSKIPNAN implements the DIMENSION-argument for data with missing values. +% Also the second output argument return the number of valid elements (not NaNs) +% +% Y = sumskipnan(x [,DIM]) +% [Y,N,SSQ] = sumskipnan(x [,DIM]) +% [...] = sumskipnan(x, DIM, W) +% +% x input data +% DIM dimension (default: []) +% empty DIM sets DIM to first non singleton dimension +% W weight vector for weighted sum, numel(W) must fit size(x,DIM) +% Y resulting sum +% N number of valid (not missing) elements +% SSQ sum of squares +% +% the function FLAG_NANS_OCCURED() returns whether any value in x +% is a not-a-number (NaN) +% +% features: +% - can deal with NaN's (missing values) +% - implements dimension argument. +% - computes weighted sum +% - compatible with Matlab and Octave +% +% see also: FLAG_NANS_OCCURED, SUM, NANSUM, MEAN, STD, VAR, RMS, MEANSQ, +% SSQ, MOMENT, SKEWNESS, KURTOSIS, SEM + + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +% $Id: sumskipnan.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2000-2005,2009,2011 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +global FLAG_NANS_OCCURED; + +if nargin<2, + DIM = []; +end; +if nargin<3, + W = []; +end; + +% an efficient implementation in C of the following lines +% could significantly increase performance +% only one loop and only one check for isnan is needed +% An MEX-Implementation is available in sumskipnan.cpp +% +% Outline of the algorithm: +% for { k=1,o=0,count=0; k++; k1,1); + if isempty(DIM), DIM = 1; end; +end +if (DIM<1), DIM = 1; end; %% Hack, because min([])=0 for FreeMat v3.5 + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% non-float data +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if (isempty(W) && (~(isa(x,'float') || isa(x,'double')))) || ~flag_implicit_skip_nan(), %%% skip always NaN's + if ~isempty(W) + error('SUMSKIPNAN: weighted sum of integers not supported, yet'); + end; + x = double(x); + o = sum(x,DIM); + if nargout>1 + sz = size(x); + N = sz(DIM); + sz(DIM) = 1; + count = repmat(N,sz); + if nargout>2 + x = x.*x; + SSQ = sum(x,DIM); + end; + end; + return; +end; + +if (length(size(x))=3), + [o,count,SSQ] = sumskipnan_mex(real(x),DIM,FLAG_NANS_OCCURED,W); + if (~isreal(x)) + [io,icount,iSSQ] = sumskipnan_mex(imag(x),DIM,FLAG_NANS_OCCURED,W); + if any(count(:)-icount(:)) + error('Number of NaNs differ for REAL and IMAG part'); + else + o = o+i*io; + SSQ = SSQ+iSSQ; + end; + end; + return; + end; +end; + +if ~isempty(W) + error('weighted sumskipnan requires sumskipnan_mex'); +end; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% count non-NaN's +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if nargout>1, + count = sum(x==x,DIM); + FLAG_NANS_OCCURED = any(count(:)2, + x = real(x).^2 + imag(x).^2; + SSQ = sum(x,DIM); +end; + +%!assert(sumskipnan([1,2],1),[1,2]) +%!assert(sumskipnan([1,NaN],2),1) +%!assert(sumskipnan([1,NaN],2),1) +%!assert(sumskipnan([nan,1,4,5]),10) +%!assert(sumskipnan([nan,1,4,5]',1,[3;2;1;0]),6) + + + diff --git a/octave_packages/nan-2.5.5/sumsq.m b/octave_packages/nan-2.5.5/sumsq.m new file mode 100644 index 0000000..7ea9edd --- /dev/null +++ b/octave_packages/nan-2.5.5/sumsq.m @@ -0,0 +1,50 @@ +function [o]=sumsq(x,DIM) +% SUMSQ calculates the sum of squares. +% +% [y] = sumsq(x [, DIM]) +% +% DIM dimension +% N STD of N-th dimension +% default or []: first DIMENSION, with more than 1 element +% +% y estimated standard deviation +% +% features: +% - can deal with NaN's (missing values) +% - dimension argument also in Octave +% - compatible to Matlab and Octave +% +% see also: RMS, SUMSKIPNAN, MEAN, VAR, MEANSQ, +% +% +% References(s): + + +% 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 . + +% $Id$ +% Copyright (C) 2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +if nargin<2, + DIM = []; +end; +if isempty(DIM), + DIM = find(size(x)>1,1); + if isempty(DIM), DIM=1; end; +end; + +[s,n,o] = sumskipnan(x,DIM); + diff --git a/octave_packages/nan-2.5.5/tcdf.m b/octave_packages/nan-2.5.5/tcdf.m new file mode 100644 index 0000000..7111264 --- /dev/null +++ b/octave_packages/nan-2.5.5/tcdf.m @@ -0,0 +1,61 @@ +function p = tcdf(x,n) +% TCDF returns student cumulative distribtion function +% +% cdf = tcdf(x,DF); +% +% Computes the CDF of the students distribution +% with DF degrees of freedom +% x,DF must be matrices of same size, or any one can be a scalar. +% +% see also: NORMCDF, TPDF, TINV + +% Reference(s): + +% $Id: tcdf.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2000-2003,2009 by Alois Schloegl +% This is part of the NaN-toolbox. For more details see +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + +% check size of arguments +if all(size(x)==1) + x = repmat(x,size(n)); +elseif all(size(n)==1) + n = repmat(n,size(x)); +elseif all(size(x)==size(n)) + ; %% OK, do nothing +else + error('size of input arguments must be equal or scalar') +end; + +% allocate memory +p = zeros(size(x)); +p((x==Inf) & (n>0)) = 1; + +% workaround for invalid arguments in BETAINC +ix = isnan(x) | ~(n>0); +p(ix)= NaN; + +ix = (x > -Inf) & (x < Inf) & (n > 0); +p(ix) = betainc (n(ix) ./ (n(ix) + x(ix).^2), n(ix)/2, 1/2) / 2; + +ix = find(x>0); +p(ix) = 1 - p(ix); + +% shape output +p = reshape(p,size(x)); + +%!assert(tcdf(NaN,4),NaN) diff --git a/octave_packages/nan-2.5.5/test_sc.m b/octave_packages/nan-2.5.5/test_sc.m new file mode 100644 index 0000000..fc028fb --- /dev/null +++ b/octave_packages/nan-2.5.5/test_sc.m @@ -0,0 +1,296 @@ +function [R]=test_sc(CC,D,mode,classlabel) +% TEST_SC: apply statistical and SVM classifier to test data +% +% R = test_sc(CC,D,TYPE [,target_Classlabel]) +% R.output output: "signed" distance for each class. +% This represents the distances between sample D and the separating hyperplane +% The "signed distance" is possitive if it matches the target class, and +% and negative if it lays on the opposite side of the separating hyperplane. +% R.classlabel class for output data +% The target class is optional. If it is provided, the following values are returned. +% R.kappa Cohen's kappa coefficient +% R.ACC Classification accuracy +% R.H Confusion matrix +% +% The classifier CC is typically obtained by TRAIN_SC. If a statistical +% classifier is used, TYPE can be used to modify the classifier. +% TYPE = 'MDA' mahalanobis distance based classifier +% TYPE = 'MD2' mahalanobis distance based classifier +% TYPE = 'MD3' mahalanobis distance based classifier +% TYPE = 'GRB' Gaussian radial basis function +% TYPE = 'QDA' quadratic discriminant analysis +% TYPE = 'LD2' linear discriminant analysis +% TYPE = 'LD3', 'LDA', 'FDA, 'FLDA' (Fisher's) linear discriminant analysis +% TYPE = 'LD4' linear discriminant analysis +% TYPE = 'GDBC' general distance based classifier +% +% see also: TRAIN_SC +% +% References: +% [1] R. Duda, P. Hart, and D. Stork, Pattern Classification, second ed. +% John Wiley & Sons, 2001. + +% $Id: test_sc.m 9601 2012-02-09 14:14:36Z schloegl $ +% Copyright (C) 2005,2006,2008,2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 3 +% of the License, or (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + +if nargin<3, + mode = []; +end; +[t1,t] = strtok(CC.datatype,':'); +[t2,t] = strtok(t,':'); +[t3] = strtok(t,':'); +if ~strcmp(t1,'classifier'), return; end; + +if isfield(CC,'prewhite') + D = D*CC.prewhite(2:end,:) + CC.prewhite(ones(size(D,1),1),:); + CC = rmfield(CC,'prewhite'); +end; + +POS1 = [strfind(CC.datatype,'/gsvd'),strfind(CC.datatype,'/sparse'),strfind(CC.datatype,'/delet')]; + +if 0, + + +elseif strcmp(CC.datatype,'classifier:nbpw') + error('NBPW not implemented yet') + %%%% Naive Bayesian Parzen Window Classifier %%%% + d = repmat(NaN,size(D,1),size(CC.MEAN,1)); + for k = 1:size(CC.MEAN,1) + z = (D - CC.MEAN(repmat(k,size(D,1),1),:)).^2 ./ (CC.VAR(repmat(k,size(D,1),1),:)); + z = z + log(CC.VAR(repmat(k,size(D,1),1),:)); % + log(2*pi); + d(:,k) = sum(-z/2, 2) + log(mean(CC.N(k,:))); + end; + d = exp(d-log(mean(sum(CC.N,1)))-log(2*pi)/2); + + +elseif strcmp(CC.datatype,'classifier:nbc') + %%%% Naive Bayesian Classifier %%%% + d = repmat(NaN,size(D,1),size(CC.MEAN,1)); + for k = 1:size(CC.MEAN,1) + z = (D - CC.MEAN(repmat(k,size(D,1),1),:)).^2 ./ (CC.VAR(repmat(k,size(D,1),1),:)); + z = z + log(CC.VAR(repmat(k,size(D,1),1),:)); % + log(2*pi); + d(:,k) = sum(-z/2, 2) + log(mean(CC.N(k,:))); + end; + d = exp(d-log(mean(sum(CC.N,1)))-log(2*pi)/2); + + +elseif strcmp(CC.datatype,'classifier:anbc') + %%%% Augmented Naive Bayesian Classifier %%%% + d = repmat(NaN,size(D,1),size(CC.MEAN,1)); + for k = 1:size(CC.MEAN,1) + z = (D*CC.V - CC.MEAN(repmat(k,size(D,1),1),:)).^2 ./ (CC.VAR(repmat(k,size(D,1),1),:)); + z = z + log(CC.VAR(repmat(k,size(D,1),1),:)); % + log(2*pi); + d(:,k) = sum(-z/2, 2) + log(mean(CC.N(k,:))); + end; + d = exp(d-log(mean(sum(CC.N,1)))-log(2*pi)/2); + + +elseif strcmp(CC.datatype,'classifier:statistical:rda') + % Friedman (1989) Regularized Discriminant analysis + if isfield(CC,'hyperparameter') && isfield(CC.hyperparameter,'lambda') && isfield(CC.hyperparameter,'gamma') + D = [ones(size(D,1),1),D]; % add 1-column + lambda = CC.hyperparameter.lambda; + gamma = CC.hyperparameter.gamma; + d = repmat(NaN,size(D,1),size(CC.MD,1)); + ECM = CC.MD./CC.NN; + NC = size(ECM); + ECM0 = squeeze(sum(ECM,3)); %decompose ECM + [M0,sd,COV0] = decovm(ECM0); + for k = 1:NC(3); + [M,sd,s,xc,N] = decovm(squeeze(ECM(:,:,k))); + s = ((1-lambda)*N*s+lambda*COV0)/((1-lambda)*N+lambda); + s = (1-gamma)*s+gamma*(trace(s))/(NC(2)-1)*eye(NC(2)-1); + ir = [-M;eye(NC(2)-1)]*inv(s)*[-M',eye(NC(2)-1)]; % inverse correlation matrix extended by mean + d(:,k) = -sum((D*ir).*D,2); % calculate distance of each data point to each class + end; + else + error('QDA: hyperparamters lambda and/or gamma not defined') + end; + + +elseif strcmp(CC.datatype,'classifier:csp') + d = filtfilt(CC.FiltB,CC.FiltA,(D*CC.csp_w).^2); + R = test_sc(CC.CSP,log(d)); % LDA classifier of + d = R.output; + + +elseif strcmp(CC.datatype,'classifier:svm:lib:1vs1') || strcmp(CC.datatype,'classifier:svm:lib:rbf'); + nr = size(D,1); + [cl] = svmpredict_mex(ones(nr,1), D, CC.model); %Use the classifier + %Create a pseudo tsd matrix for bci4eval + d = full(sparse(1:nr,cl,1,nr,CC.model.nr_class)); + + +elseif isfield(CC,'weights'); %strcmpi(t2,'svm') || (strcmpi(t2,'statistical') & strncmpi(t3,'ld',2)) ; + % linear classifiers like: LDA, SVM, LPM + %d = [ones(size(D,1),1), D] * CC.weights; + d = repmat(NaN,size(D,1),size(CC.weights,2)); + for k = 1:size(CC.weights,2), + d(:,k) = D * CC.weights(2:end,k) + CC.weights(1,k); + end; + + +elseif ~isempty(POS1) % GSVD, sparse & DELETION + CC.datatype = CC.datatype(1:POS1(1)-1); + r = test_sc(CC, D*sparse(CC.G)); + d = r.output; + + +elseif strcmp(t2,'statistical'); + if isempty(mode) + mode.TYPE = upper(t3); + end; + D = [ones(size(D,1),1),D]; % add 1-column + W = repmat(NaN, size(D,2), size(CC.MD,3)); + + if 0, + elseif strcmpi(mode.TYPE,'LD2'), + %d = ldbc2(CC,D); + ECM = CC.MD./CC.NN; + NC = size(ECM); + ECM0 = squeeze(sum(ECM,3)); %decompose ECM + [M0] = decovm(ECM0); + for k = 1:NC(3); + ecm = squeeze(ECM(:,:,k)); + [M1,sd,COV1] = decovm(ECM0-ecm); + [M2,sd,COV2] = decovm(ecm); + w = (COV1+COV2)\(M2'-M1')*2; + w0 = -M0*w; + W(:,k) = [w0; w]; + end; + d = D*W; + elseif strcmpi(mode.TYPE,'LD3') || strcmpi(mode.TYPE,'FLDA'); + %d = ldbc3(CC,D); + ECM = CC.MD./CC.NN; + NC = size(ECM); + ECM0 = squeeze(sum(ECM,3)); %decompose ECM + [M0,sd,COV0] = decovm(ECM0); + for k = 1:NC(3); + ecm = squeeze(ECM(:,:,k)); + [M1] = decovm(ECM0-ecm); + [M2] = decovm(ecm); + w = COV0\(M2'-M1')*2; + w0 = -M0*w; + W(:,k) = [w0; w]; + end; + d = D*W; + elseif strcmpi(mode.TYPE,'LD4'); + %d = ldbc4(CC,D); + ECM = CC.MD./CC.NN; + NC = size(ECM); + ECM0 = squeeze(sum(ECM,3)); %decompose ECM + M0 = decovm(ECM0); + for k = 1:NC(3); + ecm = squeeze(ECM(:,:,k)); + [M1,sd,COV1,xc,N1] = decovm(ECM0-ecm); + [M2,sd,COV2,xc,N2] = decovm(ecm); + w = (COV1*N1+COV2*N2)\((M2'-M1')*(N1+N2)); + w0 = -M0*w; + W(:,k) = [w0; w]; + end; + d = D*W; + elseif strcmpi(mode.TYPE,'MDA'); + d = repmat(NaN,size(D,1),length(CC.IR)); + for k = 1:length(CC.IR); + d(:,k) = -sum((D*CC.IR{k}).*D,2); % calculate distance of each data point to each class + end; + elseif strcmpi(mode.TYPE,'MD2'); + d = repmat(NaN,size(D,1),length(CC.IR)); + for k = 1:length(CC.IR); + d(:,k) = sum((D*CC.IR{k}).*D,2); % calculate distance of each data point to each class + end; + d = -sqrt(d); + elseif strcmpi(mode.TYPE,'GDBC'); + d = repmat(NaN,size(D,1),length(CC.IR)); + for k = 1:length(CC.IR); + d(:,k) = sum((D*CC.IR{k}).*D,2) + CC.logSF7(k); % calculate distance of each data point to each class + end; + d = exp(-d/2); + elseif strcmpi(mode.TYPE,'MD3'); + d = repmat(NaN,size(D,1),length(CC.IR)); + for k = 1:length(CC.IR); + d(:,k) = sum((D*CC.IR{k}).*D,2) + CC.logSF7(k); % calculate distance of each data point to each class + end; + d = exp(-d/2); + d = d./repmat(sum(d,2),1,size(d,2)); % Zuordungswahrscheinlichkeit [1], p.601, equ (18.39) + elseif strcmpi(mode.TYPE,'QDA'); + d = repmat(NaN,size(D,1),length(CC.IR)); + for k = 1:length(CC.IR); + % [1] (18.33) QCF - quadratic classification function + d(:,k) = -(sum((D*CC.IR{k}).*D,2) - CC.logSF5(k)); + end; + elseif strcmpi(mode.TYPE,'QDA2'); + d = repmat(NaN,size(D,1),length(CC.IR)); + for k = 1:length(CC.IR); + % [1] (18.33) QCF - quadratic classification function + d(:,k) = -(sum((D*(CC.IR{k})).*D,2) + CC.logSF4(k)); + end; + elseif strcmpi(mode.TYPE,'GRB'); % Gaussian RBF + d = repmat(NaN,size(D,1),length(CC.IR)); + for k = 1:length(CC.IR); + d(:,k) = sum((D*CC.IR{k}).*D,2); % calculate distance of each data point to each class + end; + d = exp(-sqrt(d)/2); + elseif strcmpi(mode.TYPE,'GRB2'); % Gaussian RBF + d = repmat(NaN,size(D,1),length(CC.IR)); + for k = 1:length(CC.IR); + d(:,k) = sum((D*CC.IR{k}).*D,2); % calculate distance of each data point to each class + end; + d = exp(-d); + elseif strcmpi(mode.TYPE,'MQU'); % Multiquadratic + d = repmat(NaN,size(D,1),length(CC.IR)); + for k = 1:length(CC.IR); + d(:,k) = sum((D*CC.IR{k}).*D,2); % calculate distance of each data point to each class + end; + d = -sqrt(1+d); + elseif strcmpi(mode.TYPE,'IMQ'); % Inverse Multiquadratic + d = repmat(NaN,size(D,1),length(CC.IR)); + for k = 1:length(CC.IR); + d(:,k) = sum((D*CC.IR{k}).*D,2); % calculate distance of each data point to each class + end; + d = (1+d).^(-1/2); + elseif strcmpi(mode.TYPE,'Cauchy'); % Cauchy RBF + d = repmat(NaN,size(D,1),length(CC.IR)); + for k = 1:length(CC.IR); + d(:,k) = sum((D*CC.IR{k}).*D,2); % calculate distance of each data point to each class + end; + d = 1./(1+d); + else + error('Classifier %s not supported. see HELP TRAIN_SC for supported classifiers.',mode.TYPE); + end; +else + fprintf(2,'Error TEST_SC: unknown classifier\n'); + return; +end; + +if size(d,2)>1, + [tmp,cl] = max(d,[],2); + cl = CC.Labels(cl); + cl(isnan(tmp)) = NaN; +elseif size(d,2)==1, + cl = (d<0) + 2*(d>0); + cl(isnan(d)) = NaN; +end; + +R.output = d; +R.classlabel = cl; + +if nargin>3, + [R.kappa,R.sd,R.H,z,R.ACC] = kappa(classlabel(:),cl(:)); +end; diff --git a/octave_packages/nan-2.5.5/tiedrank.m b/octave_packages/nan-2.5.5/tiedrank.m new file mode 100644 index 0000000..de16398 --- /dev/null +++ b/octave_packages/nan-2.5.5/tiedrank.m @@ -0,0 +1,50 @@ +function R=tiedrank(X,DIM) +% TIEDRANK compute rank of samples, the mean value is used in case of ties +% this function is just a wrapper for RANKS, and provided for compatibility +% with the statistics toolbox of matlab(tm) +% +% R = tiedrank(X) +% computes the rank R of vector X +% +% see also: RANKS + + +% $Id: tiedrank.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + +if nargin>1, + error('more than 1 input argument is currently not supported ') +end; + +if nargout>1, + error('more than 1 output argument is currently not supported ') +end; + +if nargin<2, + DIM = []; +end; +if isempty(DIM), + DIM = find(size(X)>1,1); + if isempty(DIM), DIM = 1; end; +end +if (DIM<1), DIM = 1; end; %% Hack, because min([])=0 for FreeMat v3.5 + +R = ranks(X,DIM); + + \ No newline at end of file diff --git a/octave_packages/nan-2.5.5/tinv.m b/octave_packages/nan-2.5.5/tinv.m new file mode 100644 index 0000000..4de8a9f --- /dev/null +++ b/octave_packages/nan-2.5.5/tinv.m @@ -0,0 +1,54 @@ +function y = tinv(x,n) +% TINV returns inverse cumulative function of the student distribution +% +% x = tinv(p,v); +% +% Computes the quantile (inverse of the CDF) of a the student +% cumulative distribution with mean m and standard deviation s +% p,v must be matrices of same size, or any one can be a scalar. +% +% see also: TPDF, TCDF, NORMPDF, NORMCDF, NORMINV + +% Reference(s): + +% $Id: tinv.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2000-2003,2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% 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 . + + +% allocate output memory and check size of arguments +if all(size(x)==1) + x = repmat(x,size(n)); +elseif all(size(n)==1) + n = repmat(n,size(x)); +elseif all(size(x)==size(n)) + ; %% OK, do nothing +else + error('size of input arguments must be equal or scalar') +end; + +y = norminv(x); % do special cases, like x<=0, x>=1, isnan(x), n > 10000; +y(~(n>0)) = NaN; + +ix = find(~isnan(x) & (n>0) & (n<10000)); +if ~isempty(ix) + y(ix) = (sign(x(ix) - 1/2).*sqrt(n(ix)./betainv(2*min(x(ix), 1-x(ix)), n(ix)/2, 1/2) - n(ix))); +end; + +y = reshape(y,size(x)); + +%!assert(tinv(NaN,4),NaN) diff --git a/octave_packages/nan-2.5.5/tpdf.m b/octave_packages/nan-2.5.5/tpdf.m new file mode 100644 index 0000000..7523496 --- /dev/null +++ b/octave_packages/nan-2.5.5/tpdf.m @@ -0,0 +1,49 @@ +function p = tpdf(x,n) +% TPDF returns student probability density +% +% pdf = tpdf(x,DF); +% +% Computes the PDF of a the student distribution +% with DF degreas of freedom +% x,DF must be matrices of same size, or any one can be a scalar. +% +% see also: TINV, TCDF, NORMPDF, NORMCDF, NORMINV + +% Reference(s): + +% $Id: tpdf.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2000-2003,2008,2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% 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 . + +% allocate memory and check size of arguments +p = x+n; % if this line causes an error, size of input arguments do not fit. +ix = (n>0) & (n~=inf) & ~isnan(x); + +% make size of x and n equal +n = x+n-x; +x = x+n-n; + +% workaround for invalid arguments in BETA +if any(ix) +p(ix) = (exp (-(n(ix)+1).*log(1+x(ix).^2./n(ix))/2) ./ (sqrt(n(ix)).* beta(n(ix)/2, 1/2))); +end; +p(~ix)= NaN; + +% shape output +p = reshape(p,size(x)); + +%!assert(tpdf(NaN,4),NaN) diff --git a/octave_packages/nan-2.5.5/train_lda_sparse.m b/octave_packages/nan-2.5.5/train_lda_sparse.m new file mode 100644 index 0000000..458003f --- /dev/null +++ b/octave_packages/nan-2.5.5/train_lda_sparse.m @@ -0,0 +1,145 @@ +function [CC] = train_lda_sparse(X,G,par,tol) +% Linear Discriminant Analysis for the Small Sample Size Problem as described in +% Algorithm 1 of J. Duintjer Tebbens, P. Schlesinger: 'Improving +% Implementation of Linear Discriminant Analysis for the High Dimension/Small Sample Size +% Problem', Computational Statistics and Data Analysis, vol. 52, no. 1, pp. 423-437, 2007. +% Input: +% X ...... (sparse) training data matrix +% G ...... group coding matrix of the training data +% test ...... (sparse) test data matrix +% Gtest ...... group coding matrix of the test data +% par ...... if par = 0 then classification exploits sparsity too +% tol ...... tolerance to distinguish zero eigenvalues +% Output: +% err ...... Wrong classification rate (in %) +% trafo ...... LDA transformation vectors +% +% Reference(s): +% J. Duintjer Tebbens, P. Schlesinger: 'Improving +% Implementation of Linear Discriminant Analysis for the High Dimension/Small Sample Size +% Problem', Computational Statistics and Data Analysis, vol. 52, no. 1, +% pp. 423-437, 2007. +% +% Copyright (C) by J. Duintjer Tebbens, Institute of Computer Science of the Academy of Sciences of the Czech Republic, +% Pod Vodarenskou vezi 2, 182 07 Praha 8 Liben, 18.July.2006. +% This work was supported by the Program Information Society under project +% 1ET400300415. +% +% +% Modified for the use with Matlab6.5 by A. Schloegl, 22.Aug.2006 +% +% $Id$ +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 3 +% of the License, or (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Step (1) +%p = length(X(1,:));n = length(X(:,1));g = length(G(1,:)); +G = sparse(G); +[n,p]=size(X); +g = size(G,2); + +for j=1:g + nj(j) = norm(G(:,j))^2; +end +Dtild = spdiags(nj'.^(-1),0,g,g); +Xtild = X*X'; +Xtild1 = Xtild*ones(n,1); +help = ones(n,1)*Xtild1'/n - (ones(1,n)*Xtild'*ones(n,1))/(n^2); +matrix = Xtild - Xtild1*ones(1,n)/n - help; +% eliminate non-symmetry of matrix due to rounding error: +matrix = (matrix+matrix')/2; +[V0,S] = eig(matrix); +% [s,I] = sort(diag(S),'descend'); +[s,I] = sort(-diag(S)); s = -s; + +cc = sum(s 0 + [Q,R] = qr(V2,0); + matrix = B1*Dhalf*Q; + [V0,S] = eig(matrix'*matrix); + %[s,I] = sort(diag(S),'descend'); + [s,I] = sort(-diag(S)); s = -s; + for j=1:cc + C(:,j) = Q*V0(:,I(j)); + end +end + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% Step (5) +C1 = help2*Dhalf*C; +trafo(:,1:g-1) = X'*C1 - (X'*ones(n,1))*(ones(1,n)*C1/n); +for j=1:g-1 + trafo(:,j) = trafo(:,j)/norm(trafo(:,j)); +end +CC.trafo = trafo; + +if par == 0 +% X2 = full(test*X'); +% [pred] = classifs(C1,M1,X2); + CC.C1 = C1; + CC.M1 = M1; + CC.X = X; +else +% M = Dtild*G'*X; +% [pred] = classifs(trafo,M,test); + CC.C1 = trafo; + CC.M1 = Dtild*G'*X; +end diff --git a/octave_packages/nan-2.5.5/train_sc.m b/octave_packages/nan-2.5.5/train_sc.m new file mode 100644 index 0000000..6d727ea --- /dev/null +++ b/octave_packages/nan-2.5.5/train_sc.m @@ -0,0 +1,942 @@ +function [CC]=train_sc(D,classlabel,MODE,W) +% Train a (statistical) classifier +% +% CC = train_sc(D,classlabel) +% CC = train_sc(D,classlabel,MODE) +% CC = train_sc(D,classlabel,MODE, W) +% weighting D(k,:) with weight W(k) (not all classifiers supported weighting) +% +% CC contains the model parameters of a classifier which can be applied +% to test data using test_sc. +% R = test_sc(CC,D,...) +% +% D training samples (each row is a sample, each column is a feature) +% classlabel labels of each sample, must have the same number of rows as D. +% Two different encodings are supported: +% {-1,1}-encoding (multiple classes with separate columns for each class) or +% 1..M encoding. +% So [1;2;3;1;4] is equivalent to +% [+1,-1,-1,-1; +% [-1,+1,-1,-1; +% [-1,-1,+1,-1; +% [+1,-1,-1,-1] +% [-1,-1,-1,+1] +% Note, samples with classlabel=0 are ignored. +% +% The following classifier types are supported MODE.TYPE +% 'MDA' mahalanobis distance based classifier [1] +% 'MD2' mahalanobis distance based classifier [1] +% 'MD3' mahalanobis distance based classifier [1] +% 'GRB' Gaussian radial basis function [1] +% 'QDA' quadratic discriminant analysis [1] +% 'LD2' linear discriminant analysis (see LDBC2) [1] +% MODE.hyperparameter.gamma: regularization parameter [default 0] +% 'LD3', 'FDA', 'LDA', 'FLDA' +% linear discriminant analysis (see LDBC3) [1] +% MODE.hyperparameter.gamma: regularization parameter [default 0] +% 'LD4' linear discriminant analysis (see LDBC4) [1] +% MODE.hyperparameter.gamma: regularization parameter [default 0] +% 'LD5' another LDA (motivated by CSP) +% MODE.hyperparameter.gamma: regularization parameter [default 0] +% 'RDA' regularized discriminant analysis [7] +% MODE.hyperparameter.gamma: regularization parameter +% MODE.hyperparameter.lambda = +% gamma = 0, lambda = 0 : MDA +% gamma = 0, lambda = 1 : LDA [default] +% Hint: hyperparameter are used only in test_sc.m, testing different +% the hyperparameters do not need repetitive calls to train_sc, +% it is sufficient to modify CC.hyperparameter before calling test_sc. +% 'GDBC' general distance based classifier [1] +% '' statistical classifier, requires Mode argument in TEST_SC +% '###/DELETION' if the data contains missing values (encoded as NaNs), +% a row-wise or column-wise deletion (depending on which method +% removes less data values) is applied; +% '###/GSVD' GSVD and statistical classifier [2,3], +% '###/sparse' sparse [5] +% '###' must be 'LDA' or any other classifier +% 'PLS' (linear) partial least squares regression +% 'REG' regression analysis; +% 'WienerHopf' Wiener-Hopf equation +% 'NBC' Naive Bayesian Classifier [6] +% 'aNBC' Augmented Naive Bayesian Classifier [6] +% 'NBPW' Naive Bayesian Parzen Window [9] +% +% 'PLA' Perceptron Learning Algorithm [11] +% MODE.hyperparameter.alpha = alpha [default: 1] +% w = w + alpha * e'*x +% 'LMS', 'AdaLine' Least mean squares, adaptive line element, Widrow-Hoff, delta rule +% MODE.hyperparameter.alpha = alpha [default: 1] +% 'Winnow2' Winnow2 algorithm [12] +% +% 'PSVM' Proximal SVM [8] +% MODE.hyperparameter.nu (default: 1.0) +% 'LPM' Linear Programming Machine +% uses and requires train_LPM of the iLog CPLEX optimizer +% MODE.hyperparameter.c_value = +% 'CSP' CommonSpatialPattern is very experimental and just a hack +% uses a smoothing window of 50 samples. +% 'SVM','SVM1r' support vector machines, one-vs-rest +% MODE.hyperparameter.c_value = +% 'SVM11' support vector machines, one-vs-one + voting +% MODE.hyperparameter.c_value = +% 'RBF' Support Vector Machines with RBF Kernel +% MODE.hyperparameter.c_value = +% MODE.hyperparameter.gamma = +% 'SVM:LIB' libSVM [default SVM algorithm) +% 'SVM:bioinfo' uses and requires svmtrain from the bioinfo toolbox +% 'SVM:OSU' uses and requires mexSVMTrain from the OSU-SVM toolbox +% 'SVM:LOO' uses and requires svcm_train from the LOO-SVM toolbox +% 'SVM:Gunn' uses and requires svc-functios from the Gunn-SVM toolbox +% 'SVM:KM' uses and requires svmclass-function from the KM-SVM toolbox +% 'SVM:LINz' LibLinear [10] (requires train.mex from LibLinear somewhere in the path) +% z=0 (default) LibLinear with -- L2-regularized logistic regression +% z=1 LibLinear with -- L2-loss support vector machines (dual) +% z=2 LibLinear with -- L2-loss support vector machines (primal) +% z=3 LibLinear with -- L1-loss support vector machines (dual) +% 'SVM:LIN4' LibLinear with -- multi-class support vector machines by Crammer and Singer +% 'DT' decision tree - not implemented yet. +% +% {'REG','MDA','MD2','QDA','QDA2','LD2','LD3','LD4','LD5','LD6','NBC','aNBC','WienerHopf','LDA/GSVD','MDA/GSVD', 'LDA/sparse','MDA/sparse', 'PLA', 'LMS','LDA/DELETION','MDA/DELETION','NBC/DELETION','RDA/DELETION','REG/DELETION','RDA','GDBC','SVM','RBF','PSVM','SVM11','SVM:LIN4','SVM:LIN0','SVM:LIN1','SVM:LIN2','SVM:LIN3','WINNOW', 'DT'}; +% +% CC contains the model parameters of a classifier. Some time ago, +% CC was a statistical classifier containing the mean +% and the covariance of the data of each class (encoded in the +% so-called "extended covariance matrices". Nowadays, also other +% classifiers are supported. +% +% see also: TEST_SC, COVM, ROW_COL_DELETION +% +% References: +% [1] R. Duda, P. Hart, and D. Stork, Pattern Classification, second ed. +% John Wiley & Sons, 2001. +% [2] Peg Howland and Haesun Park, +% Generalizing Discriminant Analysis Using the Generalized Singular Value Decomposition +% IEEE Transactions on Pattern Analysis and Machine Intelligence, 26(8), 2004. +% dx.doi.org/10.1109/TPAMI.2004.46 +% [3] http://www-static.cc.gatech.edu/~kihwan23/face_recog_gsvd.htm +% [4] Jieping Ye, Ravi Janardan, Cheong Hee Park, Haesun Park +% A new optimization criterion for generalized discriminant analysis on undersampled problems. +% The Third IEEE International Conference on Data Mining, Melbourne, Florida, USA +% November 19 - 22, 2003 +% [5] J.D. Tebbens and P. Schlesinger (2006), +% Improving Implementation of Linear Discriminant Analysis for the Small Sample Size Problem +% Computational Statistics & Data Analysis, vol 52(1): 423-437, 2007 +% http://www.cs.cas.cz/mweb/download/publi/JdtSchl2006.pdf +% [6] H. Zhang, The optimality of Naive Bayes, +% http://www.cs.unb.ca/profs/hzhang/publications/FLAIRS04ZhangH.pdf +% [7] J.H. Friedman. Regularized discriminant analysis. +% Journal of the American Statistical Association, 84:165–175, 1989. +% [8] G. Fung and O.L. Mangasarian, Proximal Support Vector Machine Classifiers, KDD 2001. +% Eds. F. Provost and R. Srikant, Proc. KDD-2001: Knowledge Discovery and Data Mining, August 26-29, 2001, San Francisco, CA. +% p. 77-86. +% [9] Kai Keng Ang, Zhang Yang Chin, Haihong Zhang, Cuntai Guan. +% Filter Bank Common Spatial Pattern (FBCSP) in Brain-Computer Interface. +% IEEE International Joint Conference on Neural Networks, 2008. IJCNN 2008. (IEEE World Congress on Computational Intelligence). +% 1-8 June 2008 Page(s):2390 - 2397 +% [10] R.-E. Fan, K.-W. Chang, C.-J. Hsieh, X.-R. Wang, and C.-J. Lin. +% LIBLINEAR: A Library for Large Linear Classification, Journal of Machine Learning Research 9(2008), 1871-1874. +% Software available at http://www.csie.ntu.edu.tw/~cjlin/liblinear +% [11] http://en.wikipedia.org/wiki/Perceptron#Learning_algorithm +% [12] Littlestone, N. (1988) +% "Learning Quickly When Irrelevant Attributes Abound: A New Linear-threshold Algorithm" +% Machine Learning 285-318(2) +% http://en.wikipedia.org/wiki/Winnow_(algorithm) + +% $Id: train_sc.m 9601 2012-02-09 14:14:36Z schloegl $ +% Copyright (C) 2005,2006,2007,2008,2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 3 +% of the License, or (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + + if nargin<2, + error('insufficient input arguments\n\tusage: train_sc(D,C,...)\n'); + end + if nargin<3, MODE = 'LDA'; end + if nargin<4, W = []; end + if ischar(MODE) + tmp = MODE; + clear MODE; + MODE.TYPE = tmp; + elseif ~isfield(MODE,'TYPE') + MODE.TYPE=''; + end + + if isfield(MODE,'hyperparameters') && ~isfield(MODE,'hyperparameter'), + %% for backwards compatibility, this might become obsolete + warning('MODE.hyperparameters are used, You should use MODE.hyperparameter instead!!!'); + MODE.hyperparameter = MODE.hyperparameters; + end + + sz = size(D); + if sz(1)~=size(classlabel,1), + error('length of data and classlabel does not fit'); + end + + % remove all NaN's + if 1, + % several classifier can deal with NaN's, there is no need to remove them. + elseif isempty(W) + %% TODO: some classifiers can deal with NaN's in D. Test whether this can be relaxed. + %ix = any(isnan([classlabel]),2); + ix = any(isnan([D,classlabel]),2); + D(ix,:) = []; + classlabel(ix,:)=[]; + W = []; + else + %ix = any(isnan([classlabel]),2); + ix = any(isnan([D,classlabel]),2); + D(ix,:)=[]; + classlabel(ix,:)=[]; + W(ix,:)=[]; + warning('support for weighting of samples is still experimental'); + end + + sz = size(D); + if sz(1)~=length(classlabel), + error('length of data and classlabel does not fit'); + end + if ~isfield(MODE,'hyperparameter') + MODE.hyperparameter = []; + end + + if 0, + ; + elseif ~isempty(strfind(lower(MODE.TYPE),'/delet')) + POS1 = find(MODE.TYPE=='/'); + [rix,cix] = row_col_deletion(D); + if ~isempty(W), W=W(rix); end + CC = train_sc(D(rix,cix),classlabel(rix,:),MODE.TYPE(1:POS1(1)-1),W); + CC.G = sparse(cix, 1:length(cix), 1, size(D,2), length(cix)); + if isfield(CC,'weights') + W = [CC.weights(1,:); CC.weights(2:end,:)]; + CC.weights = sparse(size(D,2)+1, size(W,2)); + CC.weights([1,cix+1],:) = W; + CC.datatype = ['classifier:statistical:',lower(MODE.TYPE)]; + else + CC.datatype = [CC.datatype,'/delet']; + end + + elseif ~isempty(strfind(lower(MODE.TYPE),'nbpw')) + error('NBPW not implemented yet') + %%%% Naive Bayesian Parzen Window Classifier. + [classlabel,CC.Labels] = CL1M(classlabel); + for k = 1:length(CC.Labels), + [d,CC.MEAN(k,:)] = center(D(classlabel==CC.Labels(k),:),1); + [CC.VAR(k,:),CC.N(k,:)] = sumskipnan(d.^2,1); + h2_opt = (4./(3*CC.N(k,:))).^(2/5).*CC.VAR(k,:); + %%% TODO + end + + + elseif ~isempty(strfind(lower(MODE.TYPE),'nbc')) + %%%% Naive Bayesian Classifier + if ~isempty(strfind(lower(MODE.TYPE),'anbc')) + %%%% Augmented Naive Bayesian classifier. + [CC.V,L] = eig(covm(D,'M',W)); + D = D*CC.V; + else + CC.V = eye(size(D,2)); + end + [classlabel,CC.Labels] = CL1M(classlabel); + for k = 1:length(CC.Labels), + ix = classlabel==CC.Labels(k); + %% [d,CC.MEAN(k,:)] = center(D(ix,:),1); + if ~isempty(W) + [s,n] = sumskipnan(D(ix,:),1,W(ix)); + CC.MEAN(k,:) = s./n; + d = D(ix,:) - CC.MEAN(repmat(k,sum(ix),1),:); + [CC.VAR(k,:),CC.N(k,:)] = sumskipnan(d.^2,1,W(ix)); + else + [s,n] = sumskipnan(D(ix,:),1); + CC.MEAN(k,:) = s./n; + d = D(ix,:) - CC.MEAN(repmat(k,sum(ix),1),:); + [CC.VAR(k,:),CC.N(k,:)] = sumskipnan(d.^2,1); + end + end + CC.VAR = CC.VAR./max(CC.N-1,0); + CC.datatype = ['classifier:',lower(MODE.TYPE)]; + + + elseif ~isempty(strfind(lower(MODE.TYPE),'lpm')) + if ~isempty(W) + error('Error TRAIN_SC: Classifier (%s) does not support weighted samples.',MODE.TYPE); + end + % linear programming machine + % CPLEX optimizer: ILOG solver, ilog cplex 6.5 reference manual http://www.ilog.com + MODE.TYPE = 'LPM'; + if ~isfield(MODE.hyperparameter,'c_value') + MODE.hyperparameter.c_value = 1; + end + [classlabel,CC.Labels] = CL1M(classlabel); + + M = length(CC.Labels); + if M==2, M=1; end % For a 2-class problem, only 1 Discriminant is needed + for k = 1:M, + %LPM = train_LPM(D,(classlabel==CC.Labels(k)),'C',MODE.hyperparameter.c_value); + LPM = train_LPM(D',(classlabel'==CC.Labels(k))); + CC.weights(:,k) = [-LPM.b; LPM.w(:)]; + end + CC.hyperparameter.c_value = MODE.hyperparameter.c_value; + CC.datatype = ['classifier:',lower(MODE.TYPE)]; + + + elseif ~isempty(strfind(lower(MODE.TYPE),'pla')), + % Perceptron Learning Algorithm + + [rix,cix] = row_col_deletion(D); + [CL101,CC.Labels] = cl101(classlabel); + M = size(CL101,2); + weights = sparse(length(cix)+1,M); + + %ix = randperm(size(D,1)); %% randomize samples ??? + if ~isfield(MODE.hyperparameter,'alpha') + if isfield(MODE.hyperparameter,'alpha') + alpha = MODE.hyperparameter.alpha; + else + alpha = 1; + end + for k = rix(:)', + %e = ((classlabel(k)==(1:M))-.5) - sign([1, D(k,cix)] * weights)/2; + e = CL101(k,:) - sign([1, D(k,cix)] * weights); + weights = weights + alpha * [1,D(k,cix)]' * e ; + end + + else %if ~isempty(W) + if isfield(MODE.hyperparameter,'alpha') + W = W*MODE.hyperparameter.alpha; + end + for k = rix(:)', + %e = ((classlabel(k)==(1:M))-.5) - sign([1, D(k,cix)] * weights)/2; + e = CL101(k,:) - sign([1, D(k,cix)] * weights); + weights = weights + W(k) * [1,D(k,cix)]' * e ; + end + end + CC.weights = sparse(size(D,2)+1,M); + CC.weights([1,cix+1],:) = weights; + CC.datatype = ['classifier:',lower(MODE.TYPE)]; + + + elseif ~isempty(strfind(lower(MODE.TYPE),'adaline')) || ~isempty(strfind(lower(MODE.TYPE),'lms')), + % adaptive linear elemente, least mean squares, delta rule, Widrow-Hoff, + + [rix,cix] = row_col_deletion(D); + [CL101,CC.Labels] = cl101(classlabel); + M = size(CL101,2); + weights = sparse(length(cix)+1,M); + + %ix = randperm(size(D,1)); %% randomize samples ??? + if isempty(W) + if isfield(MODE.hyperparameter,'alpha') + alpha = MODE.hyperparameter.alpha; + else + alpha = 1; + end + for k = rix(:)', + %e = (classlabel(k)==(1:M)) - [1, D(k,cix)] * weights; + e = CL101(k,:) - sign([1, D(k,cix)] * weights); + weights = weights + alpha * [1,D(k,cix)]' * e ; + end + + else %if ~isempty(W) + if isfield(MODE.hyperparameter,'alpha') + W = W*MODE.hyperparameter.alpha; + end + for k = rix(:)', + %e = (classlabel(k)==(1:M)) - [1, D(k,cix)] * weights; + e = CL101(k,:) - sign([1, D(k,cix)] * weights); + weights = weights + W(k) * [1,D(k,cix)]' * e ; + end + end + CC.weights = sparse(size(D,2)+1,M); + CC.weights([1,cix+1],:) = weights; + CC.datatype = ['classifier:',lower(MODE.TYPE)]; + + + elseif ~isempty(strfind(lower(MODE.TYPE),'winnow')) + % winnow algorithm + if ~isempty(W) + error('Classifier (%s) does not support weighted samples.',MODE.TYPE); + end + + [rix,cix] = row_col_deletion(D); + [CL101,CC.Labels] = cl101(classlabel); + M = size(CL101,2); + weights = ones(length(cix),M); + theta = size(D,2)/2; + + for k = rix(:)', + e = CL101(k,:) - sign(D(k,cix) * weights - theta); + weights = weights.* 2.^(D(k,cix)' * e); + end + + CC.weights = sparse(size(D,2)+1,M); + CC.weights(cix+1,:) = weights; + CC.datatype = ['classifier:',lower(MODE.TYPE)]; + + elseif ~isempty(strfind(lower(MODE.TYPE),'pls')) || ~isempty(strfind(lower(MODE.TYPE),'reg')) + % 4th version: support for weighted samples - work well with unequally distributed data: + % regression analysis, can handle sparse data, too. + + if nargin<4, + W = []; + end + [rix, cix] = row_col_deletion(D); + wD = [ones(length(rix),1),D(rix,cix)]; + + if ~isempty(W) + %% wD = diag(W)*wD + W = W(:); + for k=1:size(wD,2) + wD(:,k) = W(rix).*wD(:,k); + end + end + [CL101, CC.Labels] = cl101(classlabel(rix,:)); + M = size(CL101,2); + CC.weights = sparse(sz(2)+1,M); + + %[rix, cix] = row_col_deletion(wD); + [q,r] = qr(wD,0); + + if isempty(W) + CC.weights([1,cix+1],:) = r\(q'*CL101); + else + CC.weights([1,cix+1],:) = r\(q'*(W(rix,ones(1,M)).*CL101)); + end + %for k = 1:M, + % CC.weights(cix,k) = r\(q'*(W.*CL101(rix,k))); + %end + CC.datatype = ['classifier:statistical:',lower(MODE.TYPE)]; + + + elseif ~isempty(strfind(MODE.TYPE,'WienerHopf')) + % Q: equivalent to LDA + % equivalent to Regression, except regression can not deal with NaN's + [CL101,CC.Labels] = cl101(classlabel); + M = size(CL101,2); + CC.weights = sparse(size(D,2)+1,M); + cc = covm(D,'E',W); + %c1 = classlabel(~isnan(classlabel)); + %c2 = ones(sum(~isnan(classlabel)),M); + %for k = 1:M, + % c2(:,k) = c1==CC.Labels(k); + %end + %CC.weights = cc\covm([ones(size(c2,1),1),D(~isnan(classlabel),:)],2*real(c2)-1,'M',W); + CC.weights = cc\covm([ones(size(D,1),1),D],CL101,'M',W); + CC.datatype = ['classifier:statistical:',lower(MODE.TYPE)]; + + + elseif ~isempty(strfind(lower(MODE.TYPE),'/gsvd')) + if ~isempty(W) + error('Classifier (%s) does not support weighted samples.',MODE.TYPE); + end + % [2] Peg Howland and Haesun Park, 2004 + % Generalizing Discriminant Analysis Using the Generalized Singular Value Decomposition + % IEEE Transactions on Pattern Analysis and Machine Intelligence, 26(8), 2004. + % dx.doi.org/10.1109/TPAMI.2004.46 + % [3] http://www-static.cc.gatech.edu/~kihwan23/face_recog_gsvd.htm + + [classlabel,CC.Labels] = CL1M(classlabel); + [rix,cix] = row_col_deletion(D); + + Hw = zeros(length(rix)+length(CC.Labels), length(cix)); + Hb = []; + m0 = mean(D(rix,cix)); + K = length(CC.Labels); + N = zeros(1,K); + for k = 1:K, + ix = find(classlabel(rix)==CC.Labels(k)); + N(k) = length(ix); + [Hw(ix,:), mu] = center(D(rix(ix),cix)); + %Hb(k,:) = sqrt(N(k))*(mu(k,:)-m0); + Hw(length(rix)+k,:) = sqrt(N(k))*(mu-m0); % Hb(k,:) + end + try + [P,R,Q] = svd(Hw,'econ'); + catch % needed because SVD(..,'econ') not supported in Matlab 6.x + [P,R,Q] = svd(Hw,0); + end + t = rank(R); + + clear Hw Hb mu; + %[size(D);size(P);size(Q);size(R)] + R = R(1:t,1:t); + %P = P(1:size(D,1),1:t); + %Q = Q(1:t,:); + [U,E,W] = svd(P(1:length(rix),1:t),0); + %[size(U);size(E);size(W)] + clear U E P; + %[size(Q);size(R);size(W)] + + %G = Q(1:t,:)'*[R\W']; + G = Q(:,1:t)*(R\W'); % this works as well and needs only 'econ'-SVD + %G = G(:,1:t); % not needed + + % do not use this, gives very bad results for Medline database + %G = G(:,1:K); this seems to be a typo in [2] and [3]. + CC = train_sc(D(:,cix)*G,classlabel,MODE.TYPE(1:find(MODE.TYPE=='/')-1)); + CC.G = sparse(size(D,2),size(G,2)); + CC.G(cix,:) = G; + if isfield(CC,'weights') + CC.weights = sparse([CC.weights(1,:); CC.G*CC.weights(2:end,:)]); + CC.datatype = ['classifier:statistical:', lower(MODE.TYPE)]; + else + CC.datatype = [CC.datatype,'/gsvd']; + end + + + elseif ~isempty(strfind(lower(MODE.TYPE),'sparse')) + if ~isempty(W) + error('Classifier (%s) does not support weighted samples.',MODE.TYPE); + end + % [5] J.D. Tebbens and P.Schlesinger (2006), + % Improving Implementation of Linear Discriminant Analysis for the Small Sample Size Problem + % http://www.cs.cas.cz/mweb/download/publi/JdtSchl2006.pdf + + [classlabel,CC.Labels] = CL1M(classlabel); + [rix,cix] = row_col_deletion(D); + + warning('sparse LDA is sensitive to linear transformations') + M = length(CC.Labels); + G = sparse([],[],[],length(rix),M,length(rix)); + for k = 1:M, + G(classlabel(rix)==CC.Labels(k),k) = 1; + end + tol = 1e-10; + + G = train_lda_sparse(D(rix,cix),G,1,tol); + CC.datatype = 'classifier:slda'; + POS1 = find(MODE.TYPE=='/'); + %G = v(:,1:size(G.trafo,2)).*G.trafo; + %CC.weights = s * CC.weights(2:end,:) + sparse(1,1:M,CC.weights(1,:),sz(2)+1,M); + + CC = train_sc(D(rix,cix)*G.trafo,classlabel(rix),MODE.TYPE(1:POS1(1)-1)); + CC.G = sparse(size(D,2),size(G.trafo,2)); + CC.G(cix,:) = G.trafo; + if isfield(CC,'weights') + CC.weights = sparse([CC.weights(1,:); CC.G*CC.weights(2:end,:)]); + CC.datatype = ['classifier:statistical:',lower(MODE.TYPE)]; + else + CC.datatype = [CC.datatype,'/sparse']; + end + + elseif ~isempty(strfind(lower(MODE.TYPE),'rbf')) + if ~isempty(W) + error('Classifier (%s) does not support weighted samples.',MODE.TYPE); + end + + % Martin Hieden's RBF-SVM + if exist('svmpredict_mex','file')==3, + MODE.TYPE = 'SVM:LIB:RBF'; + else + error('No SVM training algorithm available. Install LibSVM for Matlab.\n'); + end + CC.options = '-t 2 -q'; %use RBF kernel, set C, set gamma + if isfield(MODE.hyperparameter,'gamma') + CC.options = sprintf('%s -c %g', CC.options, MODE.hyperparameter.c_value); % set C + end + if isfield(MODE.hyperparameter,'c_value') + CC.options = sprintf('%s -g %g', CC.options, MODE.hyperparameter.gamma); % set C + end + + % pre-whitening + [D,r,m]=zscore(D,1); + CC.prewhite = sparse(2:sz(2)+1,1:sz(2),r,sz(2)+1,sz(2),2*sz(2)); + CC.prewhite(1,:) = -m.*r; + + [classlabel,CC.Labels] = CL1M(classlabel); + CC.model = svmtrain_mex(classlabel, D, CC.options); % Call the training mex File + CC.datatype = ['classifier:',lower(MODE.TYPE)]; + + + elseif ~isempty(strfind(lower(MODE.TYPE),'svm11')) + if ~isempty(W) + error('Classifier (%s) does not support weighted samples.',MODE.TYPE); + end + % 1-versus-1 scheme + if ~isfield(MODE.hyperparameter,'c_value') + MODE.hyperparameter.c_value = 1; + end + + CC.options=sprintf('-c %g -t 0 -q',MODE.hyperparameter.c_value); %use linear kernel, set C + CC.hyperparameter.c_value = MODE.hyperparameter.c_value; + + % pre-whitening + [D,r,m]=zscore(D,1); + CC.prewhite = sparse(2:sz(2)+1,1:sz(2),r,sz(2)+1,sz(2),2*sz(2)); + CC.prewhite(1,:) = -m.*r; + + [classlabel,CC.Labels] = CL1M(classlabel); + CC.model = svmtrain_mex(classlabel, D, CC.options); % Call the training mex File + + FUN = 'SVM:LIB:1vs1'; + CC.datatype = ['classifier:',lower(FUN)]; + + + elseif ~isempty(strfind(lower(MODE.TYPE),'psvm')) + if ~isempty(W) + %%% error('Classifier (%s) does not support weighted samples.',MODE.TYPE); + warning('Classifier (%s) in combination with weighted samples is not tested.',MODE.TYPE); + end + if ~isfield(MODE,'hyperparameter') + nu = 1; + elseif isfield(MODE.hyperparameter,'nu') + nu = MODE.hyperparameter.nu; + else + nu = 1; + end + [m,n] = size(D); + [CL101,CC.Labels] = cl101(classlabel); + CC.weights = sparse(n+1,size(CL101,2)); + M = size(CL101,2); + for k = 1:M, + d = sparse(1:m,1:m,CL101(:,k)); + H = d * [ones(m,1),D]; + %%% r = sum(H,1)'; + r = sumskipnan(H,1,W)'; + %%% r = (speye(n+1)/nu + H' * H)\r; %solve (I/nu+H’*H)r=H’*e + [HTH, nn] = covm(H,H,'M',W); + r = (speye(n+1)/nu + HTH)\r; %solve (I/nu+H’*H)r=H’*e + u = nu*(1-(H*r)); + %%% CC.weights(:,k) = u'*H; + [c,nn] = covm(u,H,'M',W); + CC.weights(:,k) = c'; + end + CC.hyperparameter.nu = nu; + CC.datatype = ['classifier:',lower(MODE.TYPE)]; + + elseif ~isempty(strfind(lower(MODE.TYPE),'svm:lin4')) + if ~isfield(MODE.hyperparameter,'c_value') + MODE.hyperparameter.c_value = 1; + end + + [classlabel,CC.Labels] = CL1M(classlabel); + M = length(CC.Labels); + CC.weights = sparse(size(D,2)+1,M); + + [rix,cix] = row_col_deletion(D); + + % pre-whitening + [D,r,m]=zscore(D(rix,cix),1); + sz2 = length(cix); + s = sparse(2:sz2+1,1:sz2,r,sz2+1,sz2,2*sz2); + s(1,:) = -m.*r; + + CC.options = sprintf('-s 4 -B 1 -c %f -q', MODE.hyperparameter.c_value); % C-SVC, C=1, linear kernel, degree = 1, + model = train(W, classlabel, sparse(D), CC.options); % C-SVC, C=1, linear kernel, degree = 1, + weights = model.w([end,1:end-1],:)'; + + CC.weights([1,cix+1],:) = s * weights(2:end,:) + sparse(1,1:M,weights(1,:),sz2+1,M); % include pre-whitening transformation + CC.weights([1,cix+1],:) = s * CC.weights(cix+1,:) + sparse(1,1:M,CC.weights(1,:),sz2+1,M); % include pre-whitening transformation + CC.hyperparameter.c_value = MODE.hyperparameter.c_value; + CC.datatype = ['classifier:',lower(MODE.TYPE)]; + + + elseif ~isempty(strfind(lower(MODE.TYPE),'svm')) + + if ~isfield(MODE.hyperparameter,'c_value') + MODE.hyperparameter.c_value = 1; + end + if any(MODE.TYPE==':'), + % nothing to be done + elseif exist('train','file')==3, + MODE.TYPE = 'SVM:LIN'; %% liblinear + elseif exist('svmtrain_mex','file')==3, + MODE.TYPE = 'SVM:LIB'; + elseif (exist('svmtrain','file')==3), + MODE.TYPE = 'SVM:LIB'; + fprintf(1,'You need to rename %s to svmtrain_mex.mex !! \n Press any key to continue !!!\n',which('svmtrain.mex')); + elseif exist('svmtrain','file')==2, + MODE.TYPE = 'SVM:bioinfo'; + elseif exist('mexSVMTrain','file')==3, + MODE.TYPE = 'SVM:OSU'; + elseif exist('svcm_train','file')==2, + MODE.TYPE = 'SVM:LOO'; + elseif exist('svmclass','file')==2, + MODE.TYPE = 'SVM:KM'; + elseif exist('svc','file')==2, + MODE.TYPE = 'SVM:Gunn'; + else + error('No SVM training algorithm available. Install OSV-SVM, or LOO-SVM, or libSVM for Matlab.\n'); + end + + %%CC = train_svm(D,classlabel,MODE); + [CL101,CC.Labels] = cl101(classlabel); + M = size(CL101,2); + [rix,cix] = row_col_deletion(D); + CC.weights = sparse(sz(2)+1, M); + + % pre-whitening + [D,r,m]=zscore(D(rix,cix),1); + sz2 = length(cix); + s = sparse(2:sz2+1,1:sz2,r,sz2+1,sz2,2*sz2); + s(1,:) = -m.*r; + + for k = 1:M, + cl = CL101(rix,k); + if strncmp(MODE.TYPE, 'SVM:LIN',7); + if isfield(MODE,'options') + CC.options = MODE.options; + else + t = 0; + if length(MODE.TYPE)>7, t=MODE.TYPE(8)-'0'; end + if (t<0 || t>6) t=0; end + CC.options = sprintf('-s %i -B 1 -c %f -q',t, MODE.hyperparameter.c_value); % C-SVC, C=1, linear kernel, degree = 1, + end + model = train(W, cl, sparse(D), CC.options); % C-SVC, C=1, linear kernel, degree = 1, + w = -model.w'; + Bias = -model.bias; + w = -model.w(:,1:end-1)'; + Bias = -model.w(:,end)'; + + elseif strcmp(MODE.TYPE, 'SVM:LIB'); %% tested with libsvm-mat-2.9-1 + if isfield(MODE,'options') + CC.options = MODE.options; + else + CC.options = sprintf('-s 0 -c %f -t 0 -d 1 -q', MODE.hyperparameter.c_value); % C-SVC, C=1, linear kernel, degree = 1, + end + model = svmtrain_mex(cl, D, CC.options); % C-SVC, C=1, linear kernel, degree = 1, + w = cl(1) * model.SVs' * model.sv_coef; %Calculate decision hyperplane weight vector + % ensure correct sign of weight vector and Bias according to class label + Bias = model.rho * cl(1); + + elseif strcmp(MODE.TYPE, 'SVM:bioinfo'); + % SVM classifier from bioinformatics toolbox. + % Settings suggested by Ian Daly, 2011-06-06 + options = optimset('Display','iter','maxiter',20000, 'largescale','off'); + CC.SVMstruct = svmtrain(D, cl, 'AUTOSCALE', 0, 'quadprog_opts', options, 'Method', 'LS', 'kernel_function', 'polynomial'); + Bias = -CC.SVMstruct.Bias; + w = -CC.SVMstruct.Alpha'*CC.SVMstruct.SupportVectors; + + elseif strcmp(MODE.TYPE, 'SVM:OSU'); + [AlphaY, SVs, Bias] = mexSVMTrain(D', cl', [0 1 1 1 MODE.hyperparameter.c_value]); % Linear Kernel, C=1; degree=1, c-SVM + w = -SVs * AlphaY'*cl(1); %Calculate decision hyperplane weight vector + % ensure correct sign of weight vector and Bias according to class label + Bias = -Bias * cl(1); + + elseif strcmp(MODE.TYPE, 'SVM:LOO'); + [a, Bias, g, inds] = svcm_train(D, cl, MODE.hyperparameter.c_value); % C = 1; + w = D(inds,:)' * (a(inds).*cl(inds)) ; + + elseif strcmp(MODE.TYPE, 'SVM:Gunn'); + [nsv, alpha, Bias,svi] = svc(D, cl, 1, MODE.hyperparameter.c_value); % linear kernel, C = 1; + w = D(svi,:)' * alpha(svi) * cl(1); + Bias = mean(D*w); + + elseif strcmp(MODE.TYPE, 'SVM:KM'); + [xsup,w1,Bias,inds] = svmclass(D, cl, MODE.hyperparameter.c_value, 1, 'poly', 1); % C = 1; + w = -D(inds,:)' * w1; + + else + fprintf(2,'Error TRAIN_SVM: no SVM training algorithm available\n'); + return; + end + + CC.weights(1,k) = -Bias; + CC.weights(cix+1,k) = w; + end + CC.weights([1,cix+1],:) = s * CC.weights(cix+1,:) + sparse(1,1:M,CC.weights(1,:),sz2+1,M); % include pre-whitening transformation + CC.hyperparameter.c_value = MODE.hyperparameter.c_value; + CC.datatype = ['classifier:',lower(MODE.TYPE)]; + + + elseif ~isempty(strfind(lower(MODE.TYPE),'csp')) + CC.datatype = ['classifier:',lower(MODE.TYPE)]; + [classlabel,CC.Labels] = CL1M(classlabel); + CC.MD = repmat(NaN,[sz(2)+[1,1],length(CC.Labels)]); + CC.NN = CC.MD; + for k = 1:length(CC.Labels), + %% [CC.MD(k,:,:),CC.NN(k,:,:)] = covm(D(classlabel==CC.Labels(k),:),'E'); + ix = classlabel==CC.Labels(k); + if isempty(W) + [CC.MD(:,:,k),CC.NN(:,:,k)] = covm(D(ix,:), 'E'); + else + [CC.MD(:,:,k),CC.NN(:,:,k)] = covm(D(ix,:), 'E', W(ix)); + end + end + ECM = CC.MD./CC.NN; + W = csp(ECM,'CSP3'); + %%% ### This is a hack ### + CC.FiltA = 50; + CC.FiltB = ones(CC.FiltA,1); + d = filtfilt(CC.FiltB,CC.FiltA,(D*W).^2); + CC.csp_w = W; + CC.CSP = train_sc(log(d),classlabel); + + + else % Linear and Quadratic statistical classifiers + CC.datatype = ['classifier:statistical:',lower(MODE.TYPE)]; + [classlabel,CC.Labels] = CL1M(classlabel); + CC.MD = repmat(NaN,[sz(2)+[1,1],length(CC.Labels)]); + CC.NN = CC.MD; + for k = 1:length(CC.Labels), + ix = classlabel==CC.Labels(k); + if isempty(W) + [CC.MD(:,:,k),CC.NN(:,:,k)] = covm(D(ix,:), 'E'); + else + [CC.MD(:,:,k),CC.NN(:,:,k)] = covm(D(ix,:), 'E', W(ix)); + end + end + + ECM = CC.MD./CC.NN; + NC = size(CC.MD); + if strncmpi(MODE.TYPE,'LD',2) || strncmpi(MODE.TYPE,'FDA',3) || strncmpi(MODE.TYPE,'FLDA',3), + + %if NC(1)==2, NC(1)=1; end % linear two class problem needs only one discriminant + CC.weights = repmat(NaN,NC(2),NC(3)); % memory allocation + type = MODE.TYPE(3)-'0'; + + ECM0 = squeeze(sum(ECM,3)); %decompose ECM + for k = 1:NC(3); + ix = [1:k-1,k+1:NC(3)]; + dM = CC.MD(:,1,k)./CC.NN(:,1,k) - sum(CC.MD(:,1,ix),3)./sum(CC.NN(:,1,ix),3); + switch (type) + case 2 % LD2 + ecm0 = (sum(ECM(:,:,ix),3)/(NC(3)-1) + ECM(:,:,k)); + case 4 % LD4 + ecm0 = 2*(sum(ECM(:,:,ix),3) + ECM(:,:,k))/NC(3); + % ecm0 = sum(CC.MD,3)./sum(CC.NN,3); + case 5 % LD5 + ecm0 = ECM(:,:,k); + case 6 % LD6 + ecm0 = sum(CC.MD(:,:,ix),3)./sum(CC.NN(:,:,ix),3); + otherwise % LD3, LDA, FDA + ecm0 = ECM0; + end + if isfield(MODE.hyperparameter,'gamma') + ecm0 = ecm0 + mean(diag(ecm0))*eye(size(ecm0))*MODE.hyperparameter.gamma; + end + + CC.weights(:,k) = ecm0\dM; + + end + %CC.weights = sparse(CC.weights); + + elseif strcmpi(MODE.TYPE,'RDA'); + if isfield(MODE,'hyperparameter') + CC.hyperparameter = MODE.hyperparameter; + end + % default values + if ~isfield(CC.hyperparameter,'gamma') + CC.hyperparameter.gamma = 0; + end + if ~isfield(CC.hyperparameter,'lambda') + CC.hyperparameter.lambda = 1; + end + else + ECM0 = sum(ECM,3); + nn = ECM0(1,1,1); % number of samples in training set for class k + XC = squeeze(ECM0(:,:,1))/nn; % normalize correlation matrix + M = XC(1,2:NC(2)); % mean + S = XC(2:NC(2),2:NC(2)) - M'*M;% covariance matrix + + try + [v,d]=eig(S); + U0 = v(diag(d)==0,:); + CC.iS2 = U0*U0'; + end + + %M = M/nn; S=S/(nn-1); + ICOV0 = inv(S); + CC.iS0 = ICOV0; + % ICOV1 = zeros(size(S)); + for k = 1:NC(3), + %[M,sd,S,xc,N] = decovm(ECM{k}); %decompose ECM + %c = size(ECM,2); + nn = ECM(1,1,k);% number of samples in training set for class k + XC = squeeze(ECM(:,:,k))/nn;% normalize correlation matrix + M = XC(1,2:NC(2));% mean + S = XC(2:NC(2),2:NC(2)) - M'*M;% covariance matrix + %M = M/nn; S=S/(nn-1); + + %ICOV(1) = ICOV(1) + (XC(2:NC(2),2:NC(2)) - )/nn + + CC.M{k} = M; + CC.IR{k} = [-M;eye(NC(2)-1)]*inv(S)*[-M',eye(NC(2)-1)]; % inverse correlation matrix extended by mean + CC.IR0{k} = [-M;eye(NC(2)-1)]*ICOV0*[-M',eye(NC(2)-1)]; % inverse correlation matrix extended by mean + d = NC(2)-1; + if exist('OCTAVE_VERSION','builtin') + S = full(S); + end + CC.logSF(k) = log(nn) - d/2*log(2*pi) - det(S)/2; + CC.logSF2(k) = -2*log(nn/sum(ECM(:,1,1))); + CC.logSF3(k) = d*log(2*pi) + log(det(S)); + CC.logSF4(k) = log(det(S)) + 2*log(nn); + CC.logSF5(k) = log(det(S)); + CC.logSF6(k) = log(det(S)) - 2*log(nn/sum(ECM(:,1,1))); + CC.logSF7(k) = log(det(S)) + d*log(2*pi) - 2*log(nn/sum(ECM(:,1,1))); + CC.logSF8(k) = sum(log(svd(S))) + log(nn) - log(sum(ECM(:,1,1))); + CC.SF(k) = nn/sqrt((2*pi)^d * det(S)); + %CC.datatype='LLBC'; + end + end + end +end + +function [CL101,Labels] = cl101(classlabel) + %% convert classlabels to {-1,1} encoding + + if (all(classlabel>=0) && all(classlabel==fix(classlabel)) && (size(classlabel,2)==1)) + M = max(classlabel); + if M==2, + CL101 = (classlabel==2)-(classlabel==1); + else + CL101 = zeros(size(classlabel,1),M); + for k=1:M, + %% One-versus-Rest scheme + CL101(:,k) = 2*real(classlabel==k) - 1; + end + end + CL101(isnan(classlabel),:) = NaN; %% or zero ??? + + elseif all((classlabel==1) | (classlabel==-1) | (classlabel==0) ) + CL101 = classlabel; + M = size(CL101,2); + else + classlabel, + error('format of classlabel unsupported'); + end + Labels = 1:M; + return; +end + + +function [cl1m, Labels] = CL1M(classlabel) + %% convert classlabels to 1..M encoding + if (all(classlabel>=0) && all(classlabel==fix(classlabel)) && (size(classlabel,2)==1)) + cl1m = classlabel; + + elseif all((classlabel==1) | (classlabel==-1) | (classlabel==0) ) + CL101 = classlabel; + M = size(classlabel,2); + if any(sum(classlabel==1,2)>1) + warning('invalid format of classlabel - at most one category may have +1'); + end + if (M==1), + cl1m = (classlabel==-1) + 2*(classlabel==+1); + else + [tmp, cl1m] = max(classlabel,[],2); + if any(tmp ~= 1) + warning('some class might not be properly represented - you might what to add another column to classlabel = [max(classlabel,[],2)<1,classlabel]'); + end + cl1m(tmp<1)= 0; %% or NaN ??? + end + else + classlabel + error('format of classlabel unsupported'); + end + Labels = 1:max(cl1m); + return; +end diff --git a/octave_packages/nan-2.5.5/trimean.m b/octave_packages/nan-2.5.5/trimean.m new file mode 100644 index 0000000..fe910fd --- /dev/null +++ b/octave_packages/nan-2.5.5/trimean.m @@ -0,0 +1,79 @@ +function y=trimean(x,DIM) +% TRIMEAN yields the weighted mean of the median and the quartiles +% m = TRIMEAN(y). +% +% The trimean is m = (Q1+2*MED+Q3)/4 +% with quartile Q1 and Q3 and median MED +% +% N-dimensional data is supported +% +% REFERENCES: +% [1] http://mathworld.wolfram.com/Trimean.html + + +% 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 . + +% $Id: trimean.m 9601 2012-02-09 14:14:36Z schloegl $ +% Copyright (C) 1996-2003,2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +global FLAG_NANS_OCCURED; + +% check dimension +sz=size(x); + +% find the dimension +if nargin==1, + DIM = find(size(x)>1,1); + if isempty(DIM), DIM=1; end; +end; + +if DIM>length(sz), + sz = [sz,ones(1,DIM-length(sz))]; +end; + +D1 = prod(sz(1:DIM-1)); +D2 = sz(DIM); +D3 = prod(sz(DIM+1:length(sz))); +D0 = [sz(1:DIM-1),1,sz(DIM+1:length(sz))]; +y = repmat(nan,D0); +q = repmat(nan,3,1); +for k = 0:D1-1, +for l = 0:D3-1, + xi = k + l * D1*sz(DIM) + 1 ; + xo = k + l * D1 + 1; + t = x(xi+(0:sz(DIM)-1)*D1); + t = sort(t(~isnan(t))); + t = t(:); + n = length(t); + if (n +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +if nargin<3, + DIM = []; +end; +if isempty(DIM), + DIM = find(size(Y)>1,1); + if isempty(DIM), DIM = 1; end; +end; + +if nargin<2, + help trimmean + +else + sz = size(Y); + if DIM > length(sz), + sz = [sz,ones(1,DIM-length(sz))]; + end; + + D1 = prod(sz(1:DIM-1)); + D2 = length(p); + D3 = prod(sz(DIM+1:length(sz))); + Q = repmat(nan,[sz(1:DIM-1),D2,sz(DIM+1:length(sz))]); + for k = 0:D1-1, + for l = 0:D3-1, + xi = k + l * D1*sz(DIM) + 1 ; + xo = k + l * D1*D2; + t = Y(xi:D1:xi+D1*sz(DIM)-1); + t = sort(t(~isnan(t))); + N = length(t); + for m=1:D2, + n = floor(N*p(m)/2); + f = sum(t(1+n:N-n))/(N-2*n); + Q(xo + m*D1) = f; + end; + end; + end; +end; + +%!assert(trimmean([11.4, 17.3, 21.3, 25.9, 40.1],.2),23.2) + diff --git a/octave_packages/nan-2.5.5/ttest.m b/octave_packages/nan-2.5.5/ttest.m new file mode 100644 index 0000000..607637c --- /dev/null +++ b/octave_packages/nan-2.5.5/ttest.m @@ -0,0 +1,125 @@ +function [h, pval, ci, stats] = ttest (x, m, alpha, tail, vartype, DIM) +% TTEST (paired) t-test +% For a sample X from a normal distribution with unknown mean and +% variance, perform a t-test of the null hypothesis `mean (X) == M'. +% Under the null, the test statistic T follows a Student +% distribution with `DF = length (X) - 1' degrees of freedom. +% +% TTEST treads NaNs as "Missing values" and ignores these. +% +% H = ttest(x,m) +% tests Null-hypothesis that mean of x is m. +% H = ttest(x,y) +% size of x and size of y must match, it is tested whether the +% difference x-y is significantly different to m=0; +% H = ttest(x,y,alpha) +% H = ttest(x,y,alpha,tail) +% H = ttest(x,y,alpha,tail,DIM) +% [H,PVAL] = ttest(...) +% +% H=1 indicates a rejection of the Null-hypothesis at a significance +% level of alpha (default alpha = 0.05). +% +% With the optional argument string TAIL, the alternative of interest +% can be selected. If TAIL is '!=' or '<>' or 'both', the null is tested +% against the two-sided Alternative `mean (X) ~= mean (Y)'. If TAIL +% is '>' or 'right', the one-sided Alternative `mean (X) > mean (Y)' is used. +% Similarly for '<' or 'left', the one-sided Alternative `mean (X) < mean +% (Y)' is used. The default is the two-sided case. +% +% H returns whether the Null-Hypotheses must be rejected. +% The p-value of the test is returned in PVAL. +% +% TTEST works on the first non-singleton dimension or on DIM. +% +% If no output argument is given, the p-value of the test is +% displayed. +% + +%%% not supported yet +% [h,p,ci] = ttest(...) +% [h,p,ci,stats] = ttest(...) + +% $Id$ +% Copyright (C) 1995, 1996, 1997, 1998, 2000, 2002, 2005, 2006, 2007 +% Kurt Hornik +% Copyright (C) 2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + if ((nargin < 2) || (nargin > 5) || nargout > 4) + print_usage ; + end + + if (nargin == 2) + alt = '~='; + end + if (nargin < 3) || isempty(alpha) + alpha = .05; + end + + if (nargin < 4) || isempty(tail) + tail = '~='; + end + if (~ ischar (tail)) + error ('ttest: tail must be a string'); + end + if (nargin < 5) || isempty(vartype) + vartype = 'equal'; + end + if ~strcmp(vartype,'equal') + error ('test: vartype not supported') + end + if nargin<6, + DIM = find(size(x)>1,1); + end; + if isempty(DIM), DIM=1; end; + + + szx = size(x); + szm = size(m); + szx(DIM) = 1; + szm(DIM) = 1; + if size(m,DIM)==1 + ; + elseif size(x,DIM) == size(m,DIM) + x = x-m; + m = zeros(szm); + else + error ('ttest: dimension of X and Y do not fit'); + end + + [S, N] = sumskipnan(x, DIM); + stats.df = N - 1; + stats.sd = std (x); + stats.tstat = sqrt (N) .* (S./N - m) ./ stats.sd; + cdf = tcdf (stats.tstat, stats.df); + + if (strcmp (tail, '~=') || strcmp (tail, '!=') || strcmp (tail, '<>')) || strcmp(tail,'both'), + pval = 2 * min (cdf, 1 - cdf); + elseif strcmp (tail, '>') || strcmp(tail,'right'), + pval = 1 - cdf; + elseif strcmp (tail, '<') || strcmp(tail,'left'), + pval = cdf; + else + error ('ttest: option %s not recognized', tail); + end + + h = pval < alpha; + if (nargout == 0) + fprintf(1,' pval: %g\n', pval); + end + diff --git a/octave_packages/nan-2.5.5/ttest2.m b/octave_packages/nan-2.5.5/ttest2.m new file mode 100644 index 0000000..51754cf --- /dev/null +++ b/octave_packages/nan-2.5.5/ttest2.m @@ -0,0 +1,137 @@ +function [h, pval, ci, stats, df] = ttest2 (x, y, alpha, tail, vartype, DIM) +% TTEST2 (unpaired) t-test +% 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 T follows a Student distribution with DF degrees of +% freedom. +% +% TTEST2 treads NaNs as "Missing values" and ignores these. +% +% H = ttest2(x,y) +% H = ttest2([x;y],C,W) +% H = ttest2(x,y,alpha) +% H = ttest2(x,y,alpha,tail) +% H = ttest2(x,y,alpha,tail,vartype) +% H = ttest2(x,y,alpha,tail,vartype,DIM) +% [H,PVAL] = ttest2(...) +% [h,p,ci,stats] = ttest2(...) +% +% H=1 indicates a rejection of the Null-hypothesis at a significance +% level of alpha (default alpha = 0.05). +% +% With the optional argument string TAIL, the Alternative of interest +% can be selected. If TAIL is '!=' or '<>' or 'both', the null is tested +% against the two-sided Alternative `mean (X) ~= mean (Y)'. If TAIL +% is '>' or 'right', the one-sided Alternative `mean (X) > mean (Y)' is used. +% Similarly for '<' or 'left', the one-sided Alternative `mean (X) < mean +% (Y)' is used. The default is the two-sided case. +% +% vartype support only 'equal' (default value); the value 'unequal' is not supported. +% +% H returns whether the Null-Hypotheses must be rejected. +% The p-value of the test is returned in PVAL. +% +% TTEST2 works on the first non-singleton dimension or on DIM. +% +% If no output argument is given, the p-value of the test is +% displayed. +% + +%%% not supported yet +% [h,p,ci] = ttest2(...) +% [h,p,ci,stats] = ttest2(...) + +% $Id$ +% Copyright (C) 1995, 1996, 1997, 1998, 2000, 2002, 2005, 2006, 2007 +% Kurt Hornik +% Copyright (C) 2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + if ((nargin < 2) || (nargin > 6) || nargout > 4) + print_usage ; + end + + if (nargin < 3) || isempty(alpha) + alpha = .05; + W = []; + elseif size(x,1)==size(y,1) && size(x,1)==size(alpha,1) && size(y,2)==1 && all(y==1 | y==2) + c = y; + y = x(c==2,:); + x = x(c==1,:); + Wy = alpha(c==2); + Wx = alpha(c==1); + alpha = .05; + end + + if (nargin < 4) || isempty(tail) + tail = '~='; + end + if (~ ischar (tail)) + error ('ttest2: tail must be a string'); + end + if (nargin < 5) || isempty(vartype) + vartype = 'equal'; + end + if ~strcmp(vartype,'equal') + error ('test: vartype not supported') + end + if nargin<6, + DIM = find(size(x)>1,1); + end; + if isempty(DIM), DIM=1; end; + + szx = size(x); + szy = size(y); + szy(DIM) = 1; + szx(DIM) = 1; + + if (any(szx-szy)) + error ('ttest2: dimension of X and Y do not fit'); + end + + [SX, NX] = sumskipnan(x, DIM, Wx); + [SY, NY] = sumskipnan(y, DIM, Wy); + stats.df = NX + NY - 2; + MX = SX ./ NX; + MY = SY ./ NY; + + if any(size(x)==0) || any(size(y)==0) + v = NaN; + else + v = sumsq(x-repmat(MX,size(x)./size(MX))) + sumsq(y-repmat(MY,size(y)./size(MY))); + end; + stats.sd = sqrt(v/stats.df); + stats.tstat = (MX - MY) .* sqrt ((NX .* NY .* stats.df) ./ (v .* (NX + NY))); + cdf = tcdf (stats.tstat, stats.df); + + if (strcmp (tail, '~=') || strcmp (tail, '!=') || strcmp (tail, '<>')) || strcmp(tail,'both'), + pval = 2 * min (cdf, 1 - cdf); + elseif strcmp (tail, '>') || strcmp(tail,'right'), + pval = 1 - cdf; + elseif strcmp (tail, '<') || strcmp(tail,'left'), + pval = cdf; + else + error ('ttest2: option %s not recognized', tail); + end + + h = pval < alpha; + + if (nargout == 0) + fprintf(1,' pval: %g\n', pval); + end + diff --git a/octave_packages/nan-2.5.5/var.m b/octave_packages/nan-2.5.5/var.m new file mode 100644 index 0000000..0c33cf5 --- /dev/null +++ b/octave_packages/nan-2.5.5/var.m @@ -0,0 +1,102 @@ +function y=var(x,opt,DIM,W) +% VAR calculates the variance. +% +% y = var(x [, opt[, DIM]]) +% calculates the variance in dimension DIM +% the default DIM is the first non-single dimension +% +% opt 0: normalizes with N-1 [default] +% 1: normalizes with N +% DIM dimension +% 1: VAR of columns +% 2: VAR of rows +% N: VAR of N-th dimension +% default or []: first DIMENSION, with more than 1 element +% W weights to compute weighted variance (default: []) +% if W=[], all weights are 1. +% number of elements in W must match size(x,DIM) +% +% usage: +% var(x) +% var(x, opt, DIM) +% var(x, [], DIM) +% var(x, W, DIM) +% var(x, opt, DIM, W) +% +% features: +% - can deal with NaN's (missing values) +% - weighting of data +% - dimension argument +% - compatible to Matlab and Octave +% +% see also: MEANSQ, SUMSQ, SUMSKIPNAN, MEAN, RMS, STD, + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +% $Id: var.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2003,2006,2009,2010 by Alois Schloegl +% This is part of the NaN-toolbox for Octave and Matlab +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +if nargin<3, + DIM = []; +end; + +if nargin==1, + W = []; + opt = []; + +elseif any(nargin==[2,3]) + if (numel(opt)<2), + W = []; + else + W = opt; + opt = []; + end; +elseif (nargin==4) && (numel(opt)<2) && (numel(DIM)<2), + ; +else + fprintf(1,'Error VAR: incorrect usage\n'); + help var; + return; +end; + +if isempty(opt), + opt = 0; +end; + +if isempty(DIM), + DIM = find(size(x)>1,1); + if isempty(DIM), DIM=1; end; +end; + +[y,n,ssq] = sumskipnan(x,DIM,W); +if all(ssq(:).*n(:) > 2*(y(:).^2)), + %% rounding error is neglectable + y = ssq - y.*y./n; +else + %% rounding error is not neglectable + szx = size(x); + szy = size(y); + if length(szy) +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +if nargin<2, + Y = []; + MAXLAG = []; + SCALEOPT = 'none'; +elseif ischar(Y), + MAXLAG = Y; + SCALEOPT=MAXLAG; + Y=[]; +elseif all(size(Y)==1), + if nargin<3 + SCALEOPT = 'none'; + else + SCALEOPT = MAXLAG; + end; + MAXLAG = Y; + Y = []; +end; + +if 0, + +elseif isempty(Y) && isempty(MAXLAG) + NX = isnan(X); + X(NX) = 0; + [C,LAGS] = xcorr(X,'none'); + [N,LAGS] = xcorr(1-NX,'none'); +elseif ~isempty(Y) && isempty(MAXLAG) + NX = isnan(X); + NY = isnan(Y); + X(NX) = 0; + Y(NY) = 0; + [C,LAGS] = xcorr(X,Y,'none'); + [N,LAGS] = xcorr(1-NX,1-NY,'none'); +elseif isempty(Y) && ~isempty(MAXLAG) + NX = isnan(X); + X(NX) = 0; + [C,LAGS] = xcorr(X,MAXLAG,'none'); + [N,LAGS] = xcorr(1-NX,MAXLAG,'none'); +elseif ~isempty(Y) && ~isempty(MAXLAG) + NX = isnan(X); + NY = isnan(Y); + X(NX) = 0; + Y(NY) = 0; + [C,LAGS] = xcorr(X,Y,MAXLAG,'none'); + [N,LAGS] = xcorr(1-NX,1-NY,MAXLAG,'none'); +end; + +if 0, + +elseif strcmp(SCALEOPT,'none') + % done + +elseif strcmp(SCALEOPT,'coeff') + ix = find(LAGS==0); + if ~any(size(X)==1), %% ~isvector(X) + c = C(ix,1:size(X,2)+1:end); %% diagonal elements + v = c.^-0.5; % sqrt(1./c(:)); + v = v'*v; + C = C.*repmat(v(:).',size(C,1),1); + elseif isempty(Y) + C = C/C(ix); + else + C = C/sqrt(sumsq(X)*sumsq(Y)); + end; + +elseif strcmp(SCALEOPT,'biased') + C = C./repmat(max(N),size(C,1),1); + +elseif strcmp(SCALEOPT,'unbiased') + C = C./(repmat(max(N),size(C,1),1)-repmat(LAGS,1,size(C,2))); + +else + warning('invalid SCALEOPT - not supported'); +end; + diff --git a/octave_packages/nan-2.5.5/xptopen.m b/octave_packages/nan-2.5.5/xptopen.m new file mode 100644 index 0000000..fd9f614 --- /dev/null +++ b/octave_packages/nan-2.5.5/xptopen.m @@ -0,0 +1,41 @@ +% XPTOPEN read of several file formats and writing of the SAS Transport Format (*.xpt) +% Supported are ARFF, SAS-XPT and STATA files. +% XPTOPEN is a mex-file and must be compiled before use. +% More detailed help can be obtained by the command +% xptopen +% without an additional argument +% +% X = xptopen(filename) +% X = xptopen(filename,'r') +% read file with filename and return variables in struct X +% +% X = xptopen(filename,'w',X) +% save fields of struct X in filename. +% +% The fields of X must be column vectors of equal length. +% Each vector is either a numeric vector or a cell array of strings. +% The SAS-XPT format stores Date/Time as numeric value counting the number of days since 1960-01-01. + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + +% $Id$ +% Copyright (C) 2010,2011,2012 by Alois Schloegl +% This is part of the NaN-toolbox. For more details see +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +if exist('xptopen','file')~=3 + error('xptopen.mex is not compiled') +end; diff --git a/octave_packages/nan-2.5.5/xval.m b/octave_packages/nan-2.5.5/xval.m new file mode 100644 index 0000000..f9708b3 --- /dev/null +++ b/octave_packages/nan-2.5.5/xval.m @@ -0,0 +1,187 @@ +function [R,CC]=xval(D,classlabel,MODE,arg4) +% XVAL is used for crossvalidation +% +% [R,CC] = xval(D,classlabel) +% .. = xval(D,classlabel,CLASSIFIER) +% .. = xval(D,classlabel,CLASSIFIER,type) +% .. = xval(D,{classlabel,W},CLASSIFIER) +% .. = xval(D,{classlabel,W,NG},CLASSIFIER) +% +% example: +% load_fisheriris; %builtin iris dataset +% C = species; +% K = 5; NG = [1:length(C)]'*K/length(C); +% [R,CC] = xval(meas,{C,[],NG},'NBC'); +% +% Input: +% D: data features (one feature per column, one sample per row) +% classlabel labels of each sample, must have the same number of rows as D. +% Two different encodings are supported: +% {-1,1}-encoding (multiple classes with separate columns for each class) or +% 1..M encoding. +% So [1;2;3;1;4] is equivalent to +% [+1,-1,-1,-1; +% [-1,+1,-1,-1; +% [-1,-1,+1,-1; +% [+1,-1,-1,-1] +% [-1,-1,-1,+1] +% Note, samples with classlabel=0 are ignored. +% +% CLASSIFIER can be any classifier supported by train_sc (default='LDA') +% {'REG','MDA','MD2','QDA','QDA2','LD2','LD3','LD4','LD5','LD6','NBC','aNBC','WienerHopf', 'RDA','GDBC', +% 'SVM','RBF','PSVM','SVM11','SVM:LIN4','SVM:LIN0','SVM:LIN1','SVM:LIN2','SVM:LIN3','WINNOW'} +% these can be modified by ###/GSVD, ###/sparse and ###/DELETION. +% /DELETION removes in case of NaN's either the rows or the columns (which removes less data values) with any NaN +% /sparse and /GSVD preprocess the data an reduce it to some lower-dimensional space. +% Hyperparameters (like alpha for PLA, gamma/lambda for RDA, c_value for SVM, etc) can be defined as +% CLASSIFIER.hyperparameter.alpha, etc. and +% CLASSIFIER.TYPE = 'PLA' (as listed above). +% See train_sc for details. +% W: weights for each sample (row) in D. +% default: [] (i.e. all weights are 1) +% number of elements in W must match the number of rows of D +% NG: used to define the type of cross-valdiation +% Leave-One-Out-Method (LOOM): NG = [1:length(classlabel)]' (default) +% Leave-K-Out-Method: NG = ceil([1:length(classlabel)]'/K) +% K-fold XV: NG = ceil([1:length(classlabel)]'*K/length(classlabel)) +% group-wise XV (if samples are not indepentent) can be also defined here +% samples from the same group (dependent samples) get the same identifier +% samples from different groups get different classifiers +% TYPE: defines the type of cross-validation procedure if NG is not specified +% 'LOOM' leave-one-out-method +% k k-fold crossvalidation +% +% OUTPUT: +% R contains the resulting performance metric +% CC contains the classifier +% +% plota(R) shows the confusion matrix of the results +% +% see also: TRAIN_SC, TEST_SC, CLASSIFY, PLOTA +% +% References: +% [1] R. Duda, P. Hart, and D. Stork, Pattern Classification, second ed. +% John Wiley & Sons, 2001. +% [2] A. Schlögl, J. Kronegg, J.E. Huggins, S. G. Mason; +% Evaluation criteria in BCI research. +% (Eds.) G. Dornhege, J.R. Millan, T. Hinterberger, D.J. McFarland, K.-R.Müller; +% Towards Brain-Computer Interfacing, MIT Press, 2007, p.327-342 + +% $Id$ +% Copyright (C) 2008,2009,2010 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or +% modify it under the terms of the GNU General Public License +% as published by the Free Software Foundation; either version 3 +% of the License, or (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA. + +if (nargin<3) || isempty(MODE), + MODE = 'LDA'; +end; +if ischar(MODE) + tmp = MODE; + clear MODE; + MODE.TYPE = tmp; +elseif ~isfield(MODE,'TYPE') + MODE.TYPE=''; +end; + +sz = size(D); +NG = []; +W = []; + +if iscell(classlabel) + [b,i,C] = unique(classlabel{:,1}); + if size(classlabel,2)>1, + W = [classlabel{:,2}]; + end; + if size(classlabel,2)>2, + [Label,tmp1,NG] = unique(classlabel{:,3}); + end; +elseif size(classlabel,2)>1, + %% group-wise classvalidation + C = classlabel(:,1); + W = classlabel(:,2); + if size(classlabel,2)==2, + warning('This option defines W and NG in an ambigous way - use instead xval(D,{C,[],NG},...) or xval(D,{C,W},...)'); + else + [Label,tmp1,NG] = unique(classlabel(:,3)); + end; +else + C = classlabel; +end; +if all(W==1), W = []; end; +if sz(1)~=size(C,1), + error('length of data and classlabel does not fit'); +end; + +% use only valid samples +ix0 = find(~any(isnan(C),2)); + +if isempty(NG) +if (nargin<4) || strcmpi(arg4,'LOOM') + %% LOOM + NG = (1:sz(1))'; + +elseif isnumeric(arg4) + if isscalar(arg4) + % K-fold XV + NG = ceil((1:length(C))'*arg4/length(C)); + elseif length(arg4)==2, + NG = ceil((1:length(C))'*arg4(1)/length(C)); + end; + +end; +end; + +sz = size(D); +if sz(1)~=length(C), + error('length of data and classlabel does not fit'); +end; +if ~isfield(MODE,'hyperparameter') + MODE.hyperparameter = []; +end + +cl = repmat(NaN,size(classlabel,1),1); +for k = 1:max(NG), + ix = ix0(NG(ix0)~=k); + if isempty(W), + CC = train_sc(D(ix,:), C(ix), MODE); + else + CC = train_sc(D(ix,:), C(ix), MODE, W(ix)); + end; + ix = ix0(NG(ix0)==k); + r = test_sc(CC, D(ix,:)); + cl(ix,1) = r.classlabel; +end; + +%R = kappa(C,cl,'notIgnoreNAN',W); +R = kappa(C,cl,[],W); +%R2 = kappa(R.H); + +R.ERR = 1-R.ACC; +if isnumeric(R.Label) + R.Label = cellstr(int2str(R.Label)); +end; + +if nargout>1, + % final classifier + if isempty(W), + CC = train_sc(D,C,MODE); + else + CC = train_sc(D,C,MODE,W); + end; + CC.Labels = 1:max(C); + %CC.Labels = unique(C); +end; diff --git a/octave_packages/nan-2.5.5/zScoreMedian.m b/octave_packages/nan-2.5.5/zScoreMedian.m new file mode 100644 index 0000000..903f771 --- /dev/null +++ b/octave_packages/nan-2.5.5/zScoreMedian.m @@ -0,0 +1,46 @@ +function Z = zScoreMedian(X, DIM) +% zScoreMedian removes the median and standardizes by the 1.483*median absolute deviation +% +% Usage: Z = zScoreMedian(X, DIM) +% Input: X : data +% DIM: dimension along which z-score should be calculated (1=columns, 2=rows) +% (optional, default=first dimension with more than 1 element +% Output: Z : z-scores + +% Copyright (C) 2003 Patrick Houweling +% Copyright (C) 2009 Alois Schloegl +% $Id: zScoreMedian.m 8075 2011-01-27 17:10:36Z schloegl $ +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +% input checks +if any(size(X)==0), + return; +end; + +% robust moment estimators: +% - mean: median +% - standard deviation: 1.483 * median absolute deviation (medAbsDev); +% the factor 1.483 is the ratio of the standard deviation of a normal random variable to its MAD. +if nargin<2, + [D, M] = medAbsDev(X); +else + [D, M] = medAbsDev(X, DIM); +end; + +% z-score: subtract M and divide by 1.483*D +Z = (X - repmat(M, size(X)./size(M))) ./ repmat(1.483*D, size(X)./size(D)); diff --git a/octave_packages/nan-2.5.5/zscore.m b/octave_packages/nan-2.5.5/zscore.m new file mode 100644 index 0000000..cf19b27 --- /dev/null +++ b/octave_packages/nan-2.5.5/zscore.m @@ -0,0 +1,64 @@ +function [i,v,m] = zscore(i,DIM) +% ZSCORE removes the mean and normalizes the data +% to a variance of 1. Can be used for Pre-Whitening of the data, too. +% +% [z,r,m] = zscore(x,DIM) +% z z-score of x along dimension DIM +% r is the inverse of the standard deviation +% m is the mean of x +% +% The data x can be reconstrated with +% x = z*diag(1./r) + repmat(m,size(z)./size(m)) +% z = x*diag(r) - repmat(m.*v,size(z)./size(m)) +% +% DIM dimension +% 1: STATS of columns +% 2: STATS of rows +% default or []: first DIMENSION, with more than 1 element +% +% see also: SUMSKIPNAN, MEAN, STD, DETREND +% +% REFERENCE(S): +% [1] http://mathworld.wolfram.com/z-Score.html + +% 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 . + + +% $Id: zscore.m 8223 2011-04-20 09:16:06Z schloegl $ +% Copyright (C) 2000-2003,2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +if any(size(i)==0); return; end; + +if nargin<2 + DIM=[]; +end +if nargin<3 + W = []; +end +if isempty(DIM), + DIM=min(find(size(i)>1)); + if isempty(DIM), DIM=1; end; +end; + + +% pre-whitening +m = mean(i,DIM,W); +i = i-repmat(m,size(i)./size(m)); % remove mean +v = 1./sqrt(mean(i.^2,DIM,W)); +i = i.*repmat(v,size(i)./size(v)); % scale to var=1 + + \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__analyzerows.m b/octave_packages/nnet-0.1.13/__analyzerows.m new file mode 100644 index 0000000..8a62213 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__analyzerows.m @@ -0,0 +1,117 @@ +## Copyright (C) 2008 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{retmatrix} = __analyzerows(@var{matrix}) +## @code{__analyzerows} takes a matrix as input argument and checks what kind of +## data are contained in the rows. +## a.) binary values? Means the row contains only 0 and 1 +## b.) unique values? +## c.) Min values are several times contained in the row +## d.) Max values are several times contained in the row +## @end deftypefn + +## Author: mds + +function retmatrix = __analyzerows(matrix) + + ## check number of inputs + error(nargchk(1,1,nargin)); + + nRows = size(matrix,1); # get number or rows + retmatrix = zeros(nRows,4); + doneVec = zeros(nRows,1); + + ## now let's check which rows are binary + i = 1; + while (i <= nRows) + vec = matrix(i,:); + n1 = find(vec==1); + n0 = find(vec==0); + if (length(n1)==0 || length(n0)==0) + #do nothing + else + if (length(vec)==(length(n1)+length(n0))) + # in this case, the vector contains only ones and zeros + retmatrix(i,1) = 1; + doneVec(i) = 1; + endif + endif + i += 1; + endwhile + + ## now let's check which rows are unique + i = 1; + while (i <= nRows) + if (doneVec(i)==0) + vec = matrix(i,:); + n1 = find(vec==vec(1)); + if (length(vec)==(length(n1))) + # in this case, the vector contains only unique data + retmatrix(i,2) = 1; + doneVec(i) = 1; + endif + endif + i += 1; + endwhile + + + ## now let's check how often we can find the min value + i = 1; + while (i <= nRows) + if (doneVec(i)==0) + vec = matrix(i,:); + n1 = min(vec); + retmatrix(i,3) = length(find(n1==vec)); + endif + i += 1; + endwhile + + ## now let's check how often we can find the max value + i = 1; + while (i <= nRows) + if (doneVec(i)==0) + vec = matrix(i,:); + n1 = max(vec); + retmatrix(i,4) = length(find(n1==vec)); + endif + i += 1; + endwhile + +endfunction + +%!shared b, retmat +%! disp("testing __analyzerows") +%! b = [1 0 0 1; 1 0 0 0; 1 2 0 1]; +%! retmat = __analyzerows(b); +%!assert(retmat(1,1)==1);#%!assert(retmat(1,1)==1); +%!assert(retmat(2,1)==1); +%!assert(retmat(3,1)==0); +%! b = [1 0 0 2; 1 0 0 0; 1 1 1 1]; +%! retmat = __analyzerows(b); +%!assert(retmat(1,2)==0); +%!assert(retmat(2,2)==0); +%!assert(retmat(3,2)==1); +%! b = [1 0 0 2; 1 0 0 0; 1 1 1 1]; +%! retmat = __analyzerows(b); +%!assert(retmat(1,3)==2); +%!assert(retmat(2,3)==0); +%!assert(retmat(3,3)==0); +%! retmat = __analyzerows(b); +%!assert(retmat(1,4)==1); +%!assert(retmat(2,4)==0); +%!assert(retmat(3,4)==0); diff --git a/octave_packages/nnet-0.1.13/__calcjacobian.m b/octave_packages/nnet-0.1.13/__calcjacobian.m new file mode 100644 index 0000000..25470a2 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__calcjacobian.m @@ -0,0 +1,283 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}@var{Jj} = __calcjacobian (@var{net},@var{Im},@var{Nn},@var{Aa},@var{vE}) +## This function calculates the jacobian matrix. It's used inside the +## Levenberg-Marquardt algorithm of the neural network toolbox. +## PLEASE DO NOT USE IT ELSEWEHRE, it proparly will not work! +## @end deftypefn + +## Author: Michel D. Schmid + + +function [Jj] = __calcjacobian(net,Im,Nn,Aa,vE) + + ## comment: + ## - return value Jj is jacobi matrix + ## for this calculation, see "Neural Network Design; Hagan, Demuth & Beale page 12-45" + + + ## check range of input arguments + error(nargchk(5,5,nargin)) + + ## get signals from inside the network + bias = net.b; + + ## calculate some help matrices + mInputWeight = net.IW{1} * Im; + nLayers = net.numLayers; + for i=2:nLayers + mLayerWeight{i,1} = net.LW{i,i-1} * Aa{i-1,1}; + endfor + + ## calculate number of columns and rows in jacobi matrix + ## firstly, number of columns + a = ones(nLayers+1,1); # +1 is for the input + a(1) = net.inputs{1}.size; + for iLayers = 1:nLayers + a(iLayers+1) = net.layers{iLayers}.size; + endfor + nColumnsJacobiMatrix = 0; + for iLayers = 1:nLayers + nColumnsJacobiMatrix = (a(iLayers)+1)*a(iLayers+1) + nColumnsJacobiMatrix; + endfor + ## secondly, number of rows + ve = vE{nLayers,1}; + nRowsJacobiMatrix = length(ve(:)); + + + ## FIRST STEP ----------------------------------------------------- + ## calculate the neuron outputs without the transfer function + ## - n1_1 = W^1*a_1^0+b^1: the ^x factor defined the xth train data set + ## the _x factor defines the layer + ## ********** this datas should be hold in Nn + ## ********** should be calculated in "__calcperf" + ## ********** so Nn{1} means hidden layer + ## ********** so Nn{2} means second hidden layer or output layer + ## ********** and so on ... + ## END FIRST STEP ------------------------------------------------- + + ## now we can rerange the signals ... this will be done only for + ## matrix calculation ... + [nRowsError nColumnsError] = size(ve); + errorSize = size(ve(:),1); # this will calculate, if only one row + # of errors exist... in other words... two rows will be reranged to + # one row with the same number of elements. + rerangeIndex = floor([0:(errorSize-1)]/nRowsError)+1; + nLayers = net.numLayers; + + for i = 1:nLayers + Nn{i,1} = Nn{i,1}(:,rerangeIndex); + Aa{i,1} = Aa{i,1}(:,rerangeIndex); + [nRows nColumns] = size(Nn{i,1}); + bTemp = bias{i,1}; + bias{i,1} = repmat(bTemp,1,nColumns); + bias{i,1} = bias{i,1}(:,rerangeIndex); + endfor + mInputWeight = mInputWeight(:,rerangeIndex); + for i=2:nLayers + mLayerWeight{i,1} = mLayerWeight{i,1}(:,rerangeIndex); + endfor + Im = Im(:,rerangeIndex); + + ## define how the errors are connected + ## ATTENTION! this happens in row order... + numTargets = net.numTargets; + mIdentity = -eye(numTargets); + cols = size(mIdentity,2); + mIdentity = mIdentity(:,rem(0:(cols*nColumnsError-1),cols)+1); + errorConnect = cell(net.numLayers,1); + startPos = 0; + for i=net.numLayers + targSize = net.layers{i}.size; + errorConnect{i} = mIdentity(startPos+[1:targSize],:); + startPos = startPos + targSize; + endfor + + ## SECOND STEP ---------------------------------------------- + ## define and calculate the derivative matrix dF + ## - this is "done" by the two first derivative functions + ## of the transfer functions + ## e.g. __dpureline, __dtansig, __dlogsig and so on ... + + ## calculate the sensitivity matrix tildeS + ## start at the end layer, this means of course the output layer, + ## the transfer function is selectable + + ## for calculating the last layer + ## this should happen like following: + ## tildeSx = -dFx(n_x^x) + ## use mIdentity to calculate the number of targets correctly + ## for all other layers, use instead: + ## tildeSx(-1) = dF1(n_x^(x-1))(W^x)' * tildeSx; + + for iLayers = nLayers:-1:1 # this will count from the last + # layer to the first layer ... + n = Nn{iLayers}; # nLayers holds the value of the last layer... + ## which transfer function should be used? + if (iLayers==nLayers) + switch(net.layers{iLayers}.transferFcn) + case "radbas" + tildeSxTemp = __dradbas(n); + case "purelin" + tildeSxTemp = __dpurelin(n); + case "tansig" + n = tansig(n); + tildeSxTemp = __dtansig(n); + case "logsig" + n = logsig(n); + tildeSxTemp = __dlogsig(n); + otherwise + error(["transfer function argument: " net.layers{iLayers}.transferFcn " is not valid!"]) + endswitch + tildeSx{iLayers,1} = tildeSxTemp .* mIdentity; + n = bias{nLayers,1}; + switch(net.layers{iLayers}.transferFcn) + case "radbas" + tildeSbxTemp = __dradbas(n); + case "purelin" + tildeSbxTemp = __dpurelin(n); + case "tansig" + n = tansig(n); + tildeSbxTemp = __dtansig(n); + case "logsig" + n = logsig(n); + tildeSbxTemp = __dlogsig(n); + otherwise + error(["transfer function argument: " net.layers{iLayers}.transferFcn " is not valid!"]) + endswitch + tildeSbx{iLayers,1} = tildeSbxTemp .* mIdentity; + endif + + if (iLayers double of rows in the + ## jacobi matrix ... 3 targets --> three times the number of rows like + ## with one target and so on. + + ## now calculate jacobi matrix + ## to do this, define first the transposed of it + ## this makes it easier to calculate on the "batch" way, means all inputs + ## at the same time... + ## and it makes it easier to use the matrix calculation way.. + + JjTrans = zeros(nRowsJacobiMatrix,nColumnsJacobiMatrix)'; # transposed jacobi matrix + + ## Weight Gradients + for i=1:net.numLayers + if i==1 + newInputs = Im; + newTemps = tildeSx{i,1}; + gIW{i,1} = copyRows(newTemps,net.inputs{i}.size) .* copyRowsInt(newInputs,net.layers{i}.size); + endif + if i>1 + Ad = cell2mat(Aa(i-1,1)'); + newInputs = Ad; + newTemps = tildeSx{i,1}; + gLW{i,1} = copyRows(newTemps,net.layers{i-1}.size) .* copyRowsInt(newInputs,net.layers{i}.size); + endif + endfor + + for i=1:net.numLayers + [nRows, nColumns] = size(Im); + if (i==1) + nWeightElements = a(i)*a(i+1); # n inputs * n hidden neurons + JjTrans(1:nWeightElements,:) = gIW{i}(1:nWeightElements,:); + nWeightBias = a(i+1); + start = nWeightElements; + JjTrans(start+1:start+nWeightBias,:) = tildeSbx{i,1}; + start = start+nWeightBias; + endif + if (i>1) + nLayerElements = a(i)*a(i+1); # n hidden neurons * n output neurons + JjTrans(start+1:start+nLayerElements,:)=gLW{i}(1:nLayerElements,:); + start = start + nLayerElements; + nLayerBias = a(i+1); + JjTrans(start+1:start+nLayerBias,:) = tildeSbx{i,1}; + start = start + nLayerBias; + endif + endfor + Jj = JjTrans'; + ## END THIRD STEP ------------------------------------------------- + + +#======================================================= +# +# additional functions +# +#======================================================= + + function k = copyRows(k,m) + # make copies of the ROWS of Aa matrix + + mRows = size(k,1); + k = k(rem(0:(mRows*m-1),mRows)+1,:); + endfunction + +# ------------------------------------------------------- + + function k = copyRowsInt(k,m) + # make copies of the ROWS of matrix with elements INTERLEAVED + + mRows = size(k,1); + k = k(floor([0:(mRows*m-1)]/m)+1,:); + endfunction + +# ===================================================================== +# +# END additional functions +# +# ===================================================================== + +endfunction diff --git a/octave_packages/nnet-0.1.13/__calcperf.m b/octave_packages/nnet-0.1.13/__calcperf.m new file mode 100644 index 0000000..a768e54 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__calcperf.m @@ -0,0 +1,110 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{perf}, @var{Ee}, @var{Aa}, @var{Nn}] = __calcperf (@var{net},@var{xx},@var{Im},@var{Tt}) +## @code{__calcperf} calculates the performance of a multi-layer neural network. +## PLEASE DON'T USE IT ELSEWHERE, it proparly won't work. +## @end deftypefn + +## Author: Michel D. Schmid + + +function [perf,Ee,Aa,Nn] = __calcperf(net,xx,Im,Tt) + + ## comment: + ## perf, net performance.. from input to output through the hidden layers + ## Aa, output values of the hidden and last layer (output layer) + ## is used for NEWFF network types + + ## calculate bias terms + ## must have the same number of columns like the input matrix Im + [nRows, nColumns] = size(Im); + Btemp = cell(net.numLayers,1); # Btemp: bias matrix + ones1xQ = ones(1,nColumns); + for i= 1:net.numLayers + Btemp{i} = net.b{i}(:,ones1xQ); + endfor + + ## shortcuts + IWtemp = cell(net.numLayers,net.numInputs,1);# IW: input weights ... + LWtemp = cell(net.numLayers,net.numLayers,1);# LW: layer weights ... + Aa = cell(net.numLayers,1);# Outputs hidden and output layer + Nn = cell(net.numLayers,1);# outputs before the transfer function + IW = net.IW; # input weights + LW = net.LW; # layer weights + + ## calculate the whole network till outputs are reached... + for iLayers = 1:net.numLayers + + ## calculate first input weights to weighted inputs.. + ## this can be done with matrix calculation... + ## called "dotprod" + ## to do this, there must be a special matrix ... + ## e.g. IW = [1 2 3 4 5; 6 7 8 9 10] * [ 1 2 3; 4 5 6; 7 8 9; 10 11 12; 1 2 3]; + if (iLayers==1) + IWtemp{iLayers,1} = IW{iLayers,1} * Im; + onlyTempVar = [IWtemp(iLayers,1) Btemp(iLayers)]; + else + IWtemp{iLayers,1} = []; + endif + + ## now calculate layer weights to weighted layer outputs + if (iLayers>1) + Ad = Aa{iLayers-1,1}; + LWtemp{iLayers,1} = LW{iLayers,iLayers-1} * Ad; + onlyTempVar = [LWtemp(iLayers,1) Btemp(iLayers)]; + else + LWtemp{iLayers,1} = []; + endif + + Nn{iLayers,1} = onlyTempVar{1}; + for k=2:length(onlyTempVar) + Nn{iLayers,1} = Nn{iLayers,1} + onlyTempVar{k}; + endfor + + ## now calculate with the transfer functions the layer output + switch net.layers{iLayers}.transferFcn + case "purelin" + Aa{iLayers,1} = purelin(Nn{iLayers,1}); + case "tansig" + Aa{iLayers,1} = tansig(Nn{iLayers,1}); + case "logsig" + Aa{iLayers,1} = logsig(Nn{iLayers,1}); + otherwise + error(["Transfer function: " net.layers{iLayers}.transferFcn " doesn't exist!"]) + endswitch + + endfor # iLayers = 1:net.numLayers + + ## now calc network error + Ee = cell(net.numLayers,1); + + for i=net.numLayers + Ee{i,1} = Tt{i,1} - Aa{i,1};# Tt: target + # Ee will be the error vector cell array + endfor + + ## now calc network performance + switch(net.performFcn) + case "mse" + perf = __mse(Ee); + otherwise + error("for performance functions, only mse is currently valid!") + endswitch + +endfunction diff --git a/octave_packages/nnet-0.1.13/__checknetstruct.m b/octave_packages/nnet-0.1.13/__checknetstruct.m new file mode 100644 index 0000000..cb900cc --- /dev/null +++ b/octave_packages/nnet-0.1.13/__checknetstruct.m @@ -0,0 +1,49 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{isTrue}] = __checknetstruct (@var{net}) +## This function will check if a valid structure seems to be a neural network +## structure +## +## @noindent +## +## left side arguments: +## @noindent +## +## right side arguments: +## @noindent +## +## +## @noindent +## are equivalent. +## @end deftypefn + +## @seealso{newff,prestd,trastd} + +## Author: Michel D. Schmid + + +function isTrue = __checknetstruct(net) + + isTrue = 0; + ## first check, if it's a structure + if (isstruct(net) && isfield(net,"networkType")) + isTrue = 1; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__copycoltopos1.m b/octave_packages/nnet-0.1.13/__copycoltopos1.m new file mode 100644 index 0000000..65e51d8 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__copycoltopos1.m @@ -0,0 +1,45 @@ +## Copyright (C) 2008 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{retmatrix} = __copycoltopos1(@var{matrix},@var{colIndex}) +## @code{__copycoltopos1} copies the column of position colIndex to the first position. +## Moves the rest of the matrix one position to the right. +## @end deftypefn + +## Author: mds + +function retmatrix = __copycoltopos1(matrix,colIndex) + + ## check number of inputs + error(nargchk(2,2,nargin)); + + temp = matrix(:,colIndex); + matrix(:,colIndex) = []; # delete col + retmatrix = [temp matrix ]; + +endfunction + +%!shared a, retmat +%! disp("testing __copycoltopos1") +%! a = [0 1 2 3 4; 5 6 7 8 9]; +%! retmat = __copycoltopos1(a,3); +%!assert(retmat(1,1)==2); +%!assert(retmat(2,1)==7); +%! retmat = __copycoltopos1(a,5); +%!assert(retmat(1,1)==4); +%!assert(retmat(2,1)==9); diff --git a/octave_packages/nnet-0.1.13/__dlogsig.m b/octave_packages/nnet-0.1.13/__dlogsig.m new file mode 100644 index 0000000..49fadba --- /dev/null +++ b/octave_packages/nnet-0.1.13/__dlogsig.m @@ -0,0 +1,32 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{a} = __dlogsig (@var{n}) +## +## @end deftypefn + +## @seealso{__dpurelin,__dtansig} + +## Author: Michel D. Schmid + + +function a = __dlogsig(n) + + a = n.*(1-n); + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__dpurelin.m b/octave_packages/nnet-0.1.13/__dpurelin.m new file mode 100644 index 0000000..6064d7d --- /dev/null +++ b/octave_packages/nnet-0.1.13/__dpurelin.m @@ -0,0 +1,35 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{a} = __dpurelin (@var{n}) +## @code{dpurelin}, first derivative of purelin +## @example +## +## purelin is a linear transfer function used by neural networks +## @end example +## +## @end deftypefn + +## Author: Michel D. Schmid + +function a = __dpurelin(n) + + [nRows, nColumns] = size(n); + a = ones(nRows,nColumns); + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__dradbas.m b/octave_packages/nnet-0.1.13/__dradbas.m new file mode 100644 index 0000000..5bb6e34 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__dradbas.m @@ -0,0 +1,44 @@ +## Copyright (C) 2010 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __dradbas (@var{n}) +## First derivative of the radial basis transfer function. +## +## @code{__dradbas(n) = exp(-n^2)*-2*x} +## +## @end deftypefn + +## Author: Michel D. Schmid + + +function retval = __dradbas (n) + + if (nargin != 1) + print_usage (); + else + retval = exp (-n^2)*(-2)*x; + # the derivative of exp(-n^2) must be calculated + # with help of the chain-rule! + # d/dx of e^x = e^x + # d/dx of -x^2 = -2x + # now calculate the product of both + endif +endfunction + + +#%!assert (radbas (3), exp (-3^2)); diff --git a/octave_packages/nnet-0.1.13/__dtansig.m b/octave_packages/nnet-0.1.13/__dtansig.m new file mode 100644 index 0000000..839a619 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__dtansig.m @@ -0,0 +1,38 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{n} = __dtansig (@var{n}) +## first derivative of @code{tansig} +## +## @example +## +## tansig is a symmetric non linear transfer function +## used by neural networks. +## Input n must be calculated with "n = tansig(n)". +## @end example +## +## @end deftypefn + +## Author: Michel D. Schmid + + +function a = __dtansig(n) + + a = 1-(n.*n); + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__getx.m b/octave_packages/nnet-0.1.13/__getx.m new file mode 100644 index 0000000..33ca4bb --- /dev/null +++ b/octave_packages/nnet-0.1.13/__getx.m @@ -0,0 +1,54 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program ; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{x} = __getx (@var{net}) +## @code{__getx} will rerange the weights in one columns vector. +## +## +## @noindent +## @end deftypefn + + +## Author: Michel D. Schmid + +function x = __getx(net) + + ## check number of inputs + error(nargchk(1,1,nargin)); + + ## check input args + ## check "net", must be a net structure + if !__checknetstruct(net) + error("Structure doesn't seem to be a neural network") + endif + + ## inputs + x = net.IW{1,1}(:); + x = [x; net.b{1}(:)]; + + nNumLayers = net.numLayers; + for iLayers = 2:nNumLayers # 1 would be the input layer + + ## layers + x = [x; net.LW{iLayers,iLayers-1}(:)]; + x = [x; net.b{iLayers}(:)]; + + endfor + + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__init.m b/octave_packages/nnet-0.1.13/__init.m new file mode 100644 index 0000000..3105883 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__init.m @@ -0,0 +1,84 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{net} = __init (@var{net}) +## @code{__init} initializes a neural network. This will be done +## with the function @code{rand} from octave. +## +## @example +## net = __init(net); +## @end example +## +## This function takes the octave function "rand" to init the +## neural network weights. +## +## @noindent +## @end deftypefn + + +## Author: Michel D. Schmid + +function net=__init(net) + + ## check number of inputs + error(nargchk(1,1,nargin)); + + ## check input + if ( !__checknetstruct(net) ) + error("__init: wrong argument type, must be a structure!"); + endif + + + if (strcmp(net.networkType,"newff")) + + ## init with random numbers between +-1 + ## input weight layer + mRand = rand(net.layers{1}.size,net.inputs{1}.size); + net.IW{1} = mRand*2-1; + + ## hidden layers + nLayers = net.numLayers; + for i=2:nLayers + mRand = rand(net.layers{i}.size,net.layers{i-1}.size); + net.LW{i,i-1} = mRand*2-1; + endfor + for i=1:nLayers + mRand = rand(net.biases{i}.size,1); + net.b{i} = mRand*2-1; + endfor + elseif (strcmp(net.networkType,"newp")) + + ## init with zeros + inputRows = size(net.inputs{1,1}.range,1); + net.IW{1} = zeros(inputRows,1); + net.b{1} = zeros(1,1); + endif + + ## warn user of constant inputs + for i=1:net.numInputs + prange = net.inputs{i}.range; + if (any(prange(:,1) == prange(:,2))) + fprintf("\n") + fprintf("** Warning in INIT\n") + fprintf("** Network net.inputs{%g}.range has a row with equal min and max values.\n",i) + fprintf("** Constant inputs do not provide useful information.\n") + fprintf("\n") + end + end + +endfunction diff --git a/octave_packages/nnet-0.1.13/__mae.m b/octave_packages/nnet-0.1.13/__mae.m new file mode 100644 index 0000000..ab06bdc --- /dev/null +++ b/octave_packages/nnet-0.1.13/__mae.m @@ -0,0 +1,54 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, write to the Free +## Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301, USA. + +## -*- texinfo -*- +## @deftypefn {Function File} {}@var{perf} = __mae (@var{E}) +## @code{__mse} returns the Mean-Square-Error of a vector E +## +## @example +## +## This function is used to calculate the perceptron performance +## @end example +## +## @end deftypefn + +## @seealso{__mse} + +## Author: Michel D. Schmid + +function perf = __mae(E) + + ## check number of inputs + error(nargchk(1,1,nargin)); + + if iscell(E) + perf = 0; + elements = 0; + for i=1:size(E,1) + for j=1:size(E,2) + perf = perf + sum(sum(E{i,j}.^2)); + elements = elements + prod(size(E{i,j})); + endfor + endfor + perf = perf / elements; + else + error("Error vector should be a cell array!") + endif + + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__mse.m b/octave_packages/nnet-0.1.13/__mse.m new file mode 100644 index 0000000..b9d8fc2 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__mse.m @@ -0,0 +1,53 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}@var{perf} = __mse (@var{E}) +## @code{__mse} returns the Mean-Square-Error of a vector E +## +## @example +## +## This function is used to calculate the network performance +## @end example +## +## @end deftypefn + +## @seealso{__mae} + +## Author: Michel D. Schmid + +function perf = __mse(E) + + ## check number of inputs + error(nargchk(1,1,nargin)); + + if iscell(E) + perf = 0; + elements = 0; + for i=1:size(E,1) + for j=1:size(E,2) + perf = perf + sum(sum(E{i,j}.^2)); + elements = elements + prod(size(E{i,j})); + endfor + endfor + perf = perf / elements; + else + error("Error vector should be a cell array!") + endif + + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__newnetwork.m b/octave_packages/nnet-0.1.13/__newnetwork.m new file mode 100644 index 0000000..27796bd --- /dev/null +++ b/octave_packages/nnet-0.1.13/__newnetwork.m @@ -0,0 +1,195 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}{@var{net}} = __newnetwork(@var{numInputs},@var{numLayers},@var{numOutputs},@var{networkType}) +## @code{__newnetwork} create a custom 'zero'-network +## +## +## @example +## net = __newnetwork(numInputs,numLayers,numOutputs,networkType) +## +## numInputs : number of input vectors, actually only 1 allowed +## numLayers : number of layers +## numOutputs: number of output vectors, actually only 1 allowed +## networkType: e.g. feed-forward-network "newff" +## @end example +## +## @example +## net = __newnetwork(1,2,1,"newff") +## 1 input layer, two hidden layers, one output layer +## and the network type +## @end example +## +## @noindent +## @end deftypefn + +## Author: Michel D. Schmid + +function net = __newnetwork(numInputs,numLayers,numOutputs,networkType) + + ## check range of input arguments + error(nargchk(4,4,nargin)) + + ## check input args + if ( !isposint(numInputs) ) + error("network: at least 1 input must be defined! ") + # this can't happen actually, only one is allowed and this + # one is hard coded + elseif ( !isposint(numLayers) ) + error("network: at least 1 hidden- and one output layer must be defined! ") + endif + ## second check for numLayers... must be at least "2" for the + ## newff, this means at least 1 hidden and 1 output layer + if (strcmp(networkType,"newff") && (numLayers<2)) + error("network: not enough layers are defined! ") + endif + + ## define network type + net.networkType = networkType; + + ## ZERO NETWORK + net.numInputs = 0; + net.numLayers = 0; + net.numInputDelays = 0; + net.numLayerDelays = 0; + # the next five parameters aren't used till now, they are used + # only for matlab nnet type compatibility ==> saveMLPStruct + net.biasConnect = []; # not used parameter till now + net.inputConnect = []; # not used parameter till now + net.layerConnect = []; # not used parameter till now + net.outputConnect = []; # not used parameter till now + net.targetConnect = []; # not used parameter till now + net.numOutputs = 0; + net.numTargets = 0; + net.inputs = cell(0,1); + net.layers = cell(0,1); + net.biases = cell(0,1); + net.inputWeights = cell(0,0); + net.layerWeights = cell(0,0); + net.outputs = cell(1,0); + net.targets = cell(1,0); + net.performFcn = ""; + net.performParam = []; + net.trainFcn = ""; + net.trainParam = []; + net.IW = {}; + net.LW = {}; + net.b = cell(0,1); + net.userdata.note = "Put your custom network information here."; + + + ## ARCHITECTURE + + ## define everything with "inputs" + net.numInputs = numInputs; + ## actually, it's only possible to have "one" input vector + net.inputs{1,1}.range = [0 0]; + net.inputs{1,1}.size = 0; + net.inputs{1,1}.userdata = "Put your custom informations here!"; + + ## define everything with "layers" + net.numLayers = numLayers; + net = newLayers(net,numLayers); + + ## define unused variables, must be defined for saveMLPStruct + net.biasConnect = [0; 0]; + net.inputConnect = [0; 0]; + net.layerConnect = [0 0; 0 0]; + net.outputConnect = [0 0]; + net.targetConnect = [0 0]; + net.numInputDelays = 0; + net.numLayerDelays = 0; + + ## define everything with "outputs" + net.numOutputs = numOutputs; + net.outputs = cell(1,numLayers); + for i=1:numLayers + if (i==numLayers) + net.outputs{i}.size = 1; # nothing else allowed till now + net.outputs{i}.userdata = "Put your custom informations here!"; + else + net.outputs{i} = []; + endif + endfor + + ## define everything with "biases" + net = newBiases(net,numLayers); + + + +#===================================================== +# +# Additional ARCHITECTURE Functions +# +#===================================================== + function net = newLayers(net,numLayers) + + ## check range of input arguments + error(nargchk(2,2,nargin)) + + ## check type of arguments + if ( !isscalar(numLayers) || !isposint(numLayers) ) + error("second argument must be a positive integer scalar value!") + endif + if ( !__checknetstruct(net) ) + error("first argument must be a network structure!") + endif + + for iRuns=1:numLayers + net.layers{iRuns,1}.dimension = 0; + net.layers{iRuns,1}.netInputFcn = ""; + net.layers{iRuns,1}.size = 0; +### TODO: test with newff net.layers{iRuns,1}.transferFcn = "tansig"; + net.layers{iRuns,1}.transferFcn = ""; + net.layers{iRuns,1}.userdata = "Put your custom informations here!"; + endfor + + endfunction + +#----------------------------------------------------- + + function net = newBiases(net,numLayers) + + ## check range of input arguments + error(nargchk(2,2,nargin)) + + ## check type of arguments + if ( !isscalar(numLayers) || !isposint(numLayers) ) + error("second argument must be a positive integer scalar value!") + endif + if ( !isstruct(net) ) + error("first argument must be a network structure!") + endif + + for iRuns=1:numLayers + net.biases{iRuns,1}.learn = 1; + net.biases{iRuns,1}.learnFcn = ""; + net.biases{iRuns,1}.learnParam = "undefined..."; + net.biases{iRuns,1}.size = 0; + net.biases{iRuns,1}.userdata = "Put your custom informations here!"; + endfor + + endfunction + +# ================================================================ +# +# END Additional ARCHITECTURE Functions +# +# ================================================================ + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__optimizedatasets.m b/octave_packages/nnet-0.1.13/__optimizedatasets.m new file mode 100644 index 0000000..1a9efad --- /dev/null +++ b/octave_packages/nnet-0.1.13/__optimizedatasets.m @@ -0,0 +1,89 @@ +## Copyright (C) 2008 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{retmatrix} = __optimizedatasets (@var{matrix},@var{nTrainSets},@var{nTargets},@var{bRand}) +## @code{__optimizedatasets} reranges the data sets depending on the input arguments. +## @code{matrix} is the data set matrix containing inputs and outputs (targets) in row order. +## This means for example: the first three rows are inputs and the fourth row is an output row. +## The second argument is used in the optimizing algorithm. All cols with min and max values must +## be in the range of the train data sets. The third argument defines how much rows are equal to the +## neural network targets. These rows must be at the end of the data set! +## The fourth arguemnt is optional and defines if the data sets have to be randomised before +## optimizing. +## Default value for bRand is 1, means randomise the columns. +## @end deftypefn + +## Author: mds + +function retmatrix = __optimizedatasets(matrix,nTrainSets,nTargets,bRand) + + ## check number of inputs + error(nargchk(3,4,nargin)); + + # set default values + bRandomise = 1; + + if (nargin==4) + bRandomise = bRand; + endif + + # if needed, randomise the cols + if (bRandomise) + matrix = __randomisecols(matrix); + endif + + # analyze matrix, which row contains what kind of data? + # a.) binary values? Means the row contains only 0 and 1 + # b.) unique values? + # c.) Min values are several times contained in the row + # d.) Max values are several times contained in the row + matrix1 = matrix(1:end-nTargets,:); + analyzeMatrix = __analyzerows(matrix1); + + # now sort "matrix" with help of analyzeMatrix + # following conditions must be kept: + # a.) rows containing unique values aren't sorted! + # b.) sort first rows which contains min AND max values only once + # c.) sort secondly rows which contains min OR max values only once + # d.) at last, sort binary data if still needed! + retmatrix = __rerangecolumns(matrix,analyzeMatrix,nTrainSets); + + +endfunction + +%!shared retmatrix, matrix +%! disp("testing __optimizedatasets") +%! matrix = [1 2 3 2 1 2 3 0 5 4 3 2 2 2 2 2 2; \ +%! 0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0; \ +%! -1 3 2 4 9 1 1 1 1 1 9 1 1 1 9 9 0; \ +%! 2 3 2 3 2 2 2 2 3 3 3 3 1 1 1 1 1]; +%! ## The last row is equal to the neural network targets +%! retmatrix = __optimizedatasets(matrix,9,1); +%! ## the above statement can't be tested with assert! +%! ## it contains random values! So pass a "success" message +%!assert(1==1); +%! matrix = [1 2 3 2 1 2 3 0 5 4 3 2 2 2 2 2 2; \ +%! 0 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0; \ +%! -1 3 2 4 9 1 1 1 1 1 9 1 1 1 9 9 0; \ +%! 2 3 2 3 2 2 2 2 3 3 3 3 1 1 1 1 1]; +%! ## The last row is equal to the neural network targets +%! retmatrix = __optimizedatasets(matrix,9,1,0); +%!assert(retmatrix(1,1)==5); +%!assert(retmatrix(2,1)==0); +%!assert(retmatrix(3,1)==1); +%!assert(retmatrix(4,1)==3); \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printAdaptFcn.m b/octave_packages/nnet-0.1.13/__printAdaptFcn.m new file mode 100644 index 0000000..074dc86 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printAdaptFcn.m @@ -0,0 +1,35 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## 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, or (at your option) +## any later version. +## +## This software is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this software; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printAdaptFcn (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printAdaptFcn(fid,net) + + if isfield(net,"adaptFcn") + if isempty(net.adaptFcn) + fprintf(fid," adaptFcn: '%s'\n","empty"); + else + fprintf(fid," adaptFcn: '%s'\n",net.adaptFcn); + endif + endif + +endfunction diff --git a/octave_packages/nnet-0.1.13/__printAdaptParam.m b/octave_packages/nnet-0.1.13/__printAdaptParam.m new file mode 100644 index 0000000..8f566de --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printAdaptParam.m @@ -0,0 +1,36 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printAdaptParam (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printAdaptParam(fid,net) + + if isfield(net,"adaptParam") + if isempty(net.adaptParam) + fprintf(fid," adaptParam: '%s'\n","not yet used item"); + else + fprintf(fid," adaptParam: '%s'\n",net.adaptParam); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printB.m b/octave_packages/nnet-0.1.13/__printB.m new file mode 100644 index 0000000..8e16146 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printB.m @@ -0,0 +1,48 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printB (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printB(fid,net) + + if isfield(net,"b") + nBiases = 0; + # check if it's cell array + if iscell(net.b) + [nRows, nColumns] = size(net.b); + for i=1:nRows + for k=1:nColumns + if !isempty(net.b{i,k}) + nBiases = nBiases+1; + endif + endfor + endfor + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," b: {%dx%d cell} containing %d bias vectors\n",nRows,nColumns,nBiases); + else + fprintf(fid,"unsure if this is possible\n") + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printBiasConnect.m b/octave_packages/nnet-0.1.13/__printBiasConnect.m new file mode 100644 index 0000000..a92a477 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printBiasConnect.m @@ -0,0 +1,60 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printBiasConnect (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + + +function __printBiasConnect(fid,net) + + if isfield(net,"biasConnect") + # net.biasConnect can be a matrix..! + # check if it's a matrix + if isscalar(net.biasConnect) + error("unsure if this is possible..") + elseif isnumeric(net.biasConnect) + if ismatrix(net.biasConnect) + if issquare(net.biasConnect) + # nothing prgrammed till now + elseif isvector(net.biasConnect) + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + # print bracket for open + fprintf(fid," biasConnect: ["); + [nRows nColumns] = size(net.biasConnect); + for k = 1:1:nRows + for i = 1:1:nColumns + fprintf(fid,"%d",net.biasConnect(i*k)); + endfor + if k!=nRows + #print ; for newline in matrix + fprintf(fid,";"); + endif + endfor + # print last bracket + fprintf(fid,"] not yet used item\n"); + endif # if issquare.. + endif #if ismatrix + endif # isscalar(net.biasConnect) + endif # if isfield(...) + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printBiases.m b/octave_packages/nnet-0.1.13/__printBiases.m new file mode 100644 index 0000000..18a4845 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printBiases.m @@ -0,0 +1,40 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printBiases (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printBiases(fid,net) + + if isfield(net,"biases") + # check if it's cell array + if iscell(net.biases) + [nRows, nColumns] = size(net.biases); + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," biases: {%dx%d cell} containing %d biases\n",nRows,nColumns,length(net.biases)); + else + fprintf(fid,"unsure if this is possible\n"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printIW.m b/octave_packages/nnet-0.1.13/__printIW.m new file mode 100644 index 0000000..b9deff1 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printIW.m @@ -0,0 +1,48 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printIW (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printIW(fid,net) + + if isfield(net,"IW") + nInputs = 0; + # check if it's cell array + if iscell(net.IW) + [nRows, nColumns] = size(net.IW); + for i=1:nRows + for k=1:nColumns + if !isempty(net.IW{i,k}) + nInputs = nInputs+1; + endif + endfor + endfor + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," IW: {%dx%d cell} containing %d input weight matrix\n",nRows,nColumns,nInputs); + else + fprintf(fid,"unsure if this is possible\n"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printInitFcn.m b/octave_packages/nnet-0.1.13/__printInitFcn.m new file mode 100644 index 0000000..deb85d4 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printInitFcn.m @@ -0,0 +1,37 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printInitFcn (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + + +function __printInitFcn(fid,net) + + if isfield(net,"initFcn") + if isempty(net.initFcn) + fprintf(fid," initFcn: '%s'\n","empty"); + else + fprintf(fid," initFcn: '%s'\n",net.initFcn); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printInitParam.m b/octave_packages/nnet-0.1.13/__printInitParam.m new file mode 100644 index 0000000..4347bc4 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printInitParam.m @@ -0,0 +1,36 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printInitParam (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printInitParam(fid,net) + + if isfield(net,"initParam") + if isempty(net.initParam) + fprintf(fid," initParam: '%s'\n","not yet used item"); + else + fprintf(fid," initParam: '%s'\n",net.initParam); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printInputConnect.m b/octave_packages/nnet-0.1.13/__printInputConnect.m new file mode 100644 index 0000000..1e898c4 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printInputConnect.m @@ -0,0 +1,59 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printInputConnect (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printInputConnect(fid,net) + + if isfield(net,"inputConnect") + # net.inputConnect can be a matrix..! + # check if it's a matrix + if isscalar(net.inputConnect) + error("unsure if this is possible..") + elseif isnumeric(net.inputConnect) + if ismatrix(net.inputConnect) + if issquare(net.inputConnect) + # nothing prgrammed till now + elseif isvector(net.inputConnect) + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + # print bracket for open + fprintf(fid," inputConnect: ["); + [nRows nColumns] = size(net.inputConnect); + for k = 1:1:nRows + for i = 1:1:nColumns + fprintf(fid,"%d",net.inputConnect(i*k)); + endfor + if k!=nRows + #print ; for newline in matrix + fprintf(fid,";"); + endif + endfor + # print last bracket + fprintf(fid,"] not yet used item\n"); + endif # if issquare.. + endif #if ismatrix + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printInputWeights.m b/octave_packages/nnet-0.1.13/__printInputWeights.m new file mode 100644 index 0000000..a927993 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printInputWeights.m @@ -0,0 +1,42 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printInputsWeights (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printInputWeights(fid,net) + + if isfield(net,"inputweights") + # check if it's cell array + if iscell(net.inputweights) + [nRows, nColumns] = size(net.inputweights); + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," inputweights: {%dx%d cell} containing xx input weight\n",nRows,nColumns); + else + fprintf(fid,"unsure if this is possible\n"); + endif + else + fprintf(fid,"field inputweights not found & not yet used item\n"); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printInputs.m b/octave_packages/nnet-0.1.13/__printInputs.m new file mode 100644 index 0000000..f584215 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printInputs.m @@ -0,0 +1,51 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printInputs (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printInputs(fid,net) + + if isfield(net,"inputs") + # check if it's cell array + if iscell(net.inputs) + [nRows, nColumns] = size(net.inputs); + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," inputs: {%dx%d cell} of inputs\n",nRows,nColumns); + else + fprintf(fid,"unsure if this is possible\n"); + endif + + endif + +endfunction + + + + + + + + + + diff --git a/octave_packages/nnet-0.1.13/__printLW.m b/octave_packages/nnet-0.1.13/__printLW.m new file mode 100644 index 0000000..bd20f7c --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printLW.m @@ -0,0 +1,48 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printLW (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printLW(fid,net) + + if isfield(net,"LW") + nLayers = 0; + # check if it's cell array + if iscell(net.LW) + [nRows, nColumns] = size(net.LW); + for i=1:nRows + for k=1:nColumns + if !isempty(net.LW{i,k}) + nLayers = nLayers+1; + endif + endfor + endfor + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," LW: {%dx%d cell} containing %d layer weight matrix\n",nRows,nColumns,nLayers); + else + fprintf(fid,"unsure if this is possible\n"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printLayerConnect.m b/octave_packages/nnet-0.1.13/__printLayerConnect.m new file mode 100644 index 0000000..c9d2344 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printLayerConnect.m @@ -0,0 +1,79 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printLayerConnect (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printLayerConnect(fid,net) + + if isfield(net,"layerConnect") + # net.layerConnect can be a matrix..! + # check if it's a matrix + if isscalar(net.layerConnect) + error("unsure if this is possible..") + elseif isnumeric(net.layerConnect) + if ismatrix(net.layerConnect) + if issquare(net.layerConnect) + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," layerConnect: ["); + [nRows nColumns] = size(net.layerConnect); + for k = 1:1:nRows + for i = 1:1:nColumns + if i +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printLayerWeights (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printLayerWeights(fid,net) + + if isfield(net,"layerweights") + # check if it's cell array + if iscell(net.layerweights) + [nRows, nColumns] = size(net.layerweights); + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," layerweights: {%dx%d cell} containing xx layer weight\n",nRows,nColumns); + else + fprintf(fid,"layerweights:unsure if this is possible\n"); + endif + else + fprintf(fid,"field layerweights not found & not yet used item\n"); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printLayers.m b/octave_packages/nnet-0.1.13/__printLayers.m new file mode 100644 index 0000000..962e439 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printLayers.m @@ -0,0 +1,40 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printLayers (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printLayers(fid,net) + + if isfield(net,"layers") + # check if it's cell array + if iscell(net.layers) + [nRows, nColumns] = size(net.layers); + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," layers: {%dx%d cell} of layers\n",nRows,nColumns); + else + fprintf(fid,"unsure if this is possible\n"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printMLPHeader.m b/octave_packages/nnet-0.1.13/__printMLPHeader.m new file mode 100644 index 0000000..8a49dcd --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printMLPHeader.m @@ -0,0 +1,43 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printMLPHeader (@var{fid}) +## @code{__printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printMLPHeader(fid) + + # one empty row + fprintf(fid,"\n"); + # write "net=" + fprintf(fid,"net=\n"); + # next empty row + fprintf(fid,"\n"); + # write "Neural Network object:", insert two spaces.. + fprintf(fid," Neural Network object:\n"); + # next empty row + fprintf(fid,"\n"); + # write "architecture:", insert two spaces.. + fprintf(fid," architecture:\n"); + # one more time an empty row + fprintf(fid,"\n"); + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printNetworkType.m b/octave_packages/nnet-0.1.13/__printNetworkType.m new file mode 100644 index 0000000..f8d36e3 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printNetworkType.m @@ -0,0 +1,36 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printMLPHeader (@var{fid}) +## @code{__printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printNetworkType(fid,net) + + if isfield(net,"networkType") + if strcmp(net.networkType,"newff") + fprintf(fid," Network type: '%s'\n","Feed forward multi-layer network"); + else + fprintf(fid," Network type: '%s'\n","error: undefined network type"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printNumInputDelays.m b/octave_packages/nnet-0.1.13/__printNumInputDelays.m new file mode 100644 index 0000000..9ab6933 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printNumInputDelays.m @@ -0,0 +1,42 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printNumInputDelays (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + + +function __printNumInputDelays(fid,net) + + ## now check the structure fields.. + cellNetFields = fieldnames(net); + # search for numInputDelays + if isfield(net,"numInputDelays") + # test on scalar + if isscalar(net.numInputDelays) + fprintf(fid," numInputDelays: %d (read-only)\n",net.numInputDelays); + # net.numInputDelays must be an integer... till now, 11-01-2006 + else + error("numInputDelays must be a scalar value!"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printNumInputs.m b/octave_packages/nnet-0.1.13/__printNumInputs.m new file mode 100644 index 0000000..3464357 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printNumInputs.m @@ -0,0 +1,44 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printNumInputs (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + + +function __printNumInputs(fid,net) + + ## now check the structure fields.. + cellNetFields = fieldnames(net); + # search for numInputs + if isfield(net,"numInputs") + # test on scalar + if isscalar(net.numInputs) + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," numInputs: %d\n",net.numInputs); + # net.numInputs must be an integer... till now, 11-01-2006 + else + error("numInputs must be a scalar value!"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printNumLayerDelays.m b/octave_packages/nnet-0.1.13/__printNumLayerDelays.m new file mode 100644 index 0000000..dd89b95 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printNumLayerDelays.m @@ -0,0 +1,43 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printNumLayerDelays (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printNumLayerDelays(fid,net) + + ## now check the structure fields.. + cellNetFields = fieldnames(net); + # search for numLayerDelays + if isfield(net,"numLayerDelays") + # test on scalar + if isscalar(net.numLayerDelays) + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," numLayerDelays: %d (read-only)\n",net.numLayerDelays); + # net.numLayerDelays must be an integer... till now, 11-01-2006 + else + error("numLayerDelays must be a scalar value!"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printNumLayers.m b/octave_packages/nnet-0.1.13/__printNumLayers.m new file mode 100644 index 0000000..034c58e --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printNumLayers.m @@ -0,0 +1,39 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printNumLayers (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printNumLayers(fid,net) + + if isfield(net,"numLayers") + if isscalar(net.numLayers) + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," numLayers: %d\n",net.numLayers); + # net.numLayers must be an integer... till now, 11-01-2006 + else + error("numLayers must be a scalar value!"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printNumOutputs.m b/octave_packages/nnet-0.1.13/__printNumOutputs.m new file mode 100644 index 0000000..2c6f5d4 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printNumOutputs.m @@ -0,0 +1,43 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printNumOutputs (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printNumOutputs(fid,net) + + ## now check the structure fields.. + cellNetFields = fieldnames(net); + # search for numOutputs + if isfield(net,"numOutputs") + # test on scalar + if isscalar(net.numOutputs) + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," numOutputs: %d (read-only)\n",net.numOutputs); + # net.numOutputs must be an integer... till now, 11-01-2006 + else + error("numOutputs must be a scalar value!"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printNumTargets.m b/octave_packages/nnet-0.1.13/__printNumTargets.m new file mode 100644 index 0000000..e59efd3 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printNumTargets.m @@ -0,0 +1,43 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printNumTargets (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printNumTargets(fid,net) + + ## now check the structure fields.. + cellNetFields = fieldnames(net); + # search for numTargets + if isfield(net,"numTargets") + # test on scalar + if isscalar(net.numTargets) + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," numTargets: %d (read-only)\n",net.numTargets); + # net.numTargets must be an integer... till now, 11-01-2006 + else + error("numTargets must be a scalar value!"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printOutputConnect.m b/octave_packages/nnet-0.1.13/__printOutputConnect.m new file mode 100644 index 0000000..76e1580 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printOutputConnect.m @@ -0,0 +1,81 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printOutputConnect (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printOutputConnect(fid,net) + + if isfield(net,"outputConnect") + # net.outputConnect can be a matrix..! + # check if it's a matrix + if isscalar(net.outputConnect) + error("unsure if this is possible..") + elseif isnumeric(net.outputConnect) + if ismatrix(net.outputConnect) + if issquare(net.outputConnect) + fprintf(fid," outputConnect: ["); + [nRows nColumns] = size(net.outputConnect); + for k = 1:1:nRows + for i = 1:1:nColumns + if i +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printOutputs (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + + +function __printOutputs(fid,net) + + if isfield(net,"outputs") + # check if it's cell array + if iscell(net.outputs) + [nRows, nColumns] = size(net.outputs); + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + if (net.numOutputs>1) + fprintf(fid," outputs: {%dx%d cell} containing %d output\n",nRows,nColumns,net.numOutputs); + else + fprintf(fid," outputs: {%dx%d cell} containing %d output\n",nRows,nColumns,net.numOutputs); + endif + else + fprintf(fid,"unsure if this is possible\n"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printPerformFcn.m b/octave_packages/nnet-0.1.13/__printPerformFcn.m new file mode 100644 index 0000000..830ea17 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printPerformFcn.m @@ -0,0 +1,36 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printPerformFcn (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printPerformFcn(fid,net) + + if isfield(net,"performFcn") + if isempty(net.performFcn) + fprintf(fid," performFcn: '%s'\n","empty"); + else + fprintf(fid," performFcn: '%s'\n",net.performFcn); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printPerformParam.m b/octave_packages/nnet-0.1.13/__printPerformParam.m new file mode 100644 index 0000000..a6d7f98 --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printPerformParam.m @@ -0,0 +1,36 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} printInputs (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printPerformParam(fid,net) + + if isfield(net,"performParam") + if isempty(net.performParam) + fprintf(fid," performParam: '%s'\n","not yet used item"); + else + fprintf(fid," performParam: '%s'\n",net.performParam); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printTargetConnect.m b/octave_packages/nnet-0.1.13/__printTargetConnect.m new file mode 100644 index 0000000..dedd23b --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printTargetConnect.m @@ -0,0 +1,84 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printTargetConnect (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printTargetConnect(fid,net) + + if isfield(net,"targetConnect") + # net.targetConnect can be a matrix..! + # check if it's a matrix + if isscalar(net.targetConnect) + error("unsure if this is possible..") + elseif isnumeric(net.targetConnect) + if ismatrix(net.targetConnect) + if issquare(net.targetConnect) + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," targetConnect: ["); + [nRows nColumns] = size(net.targetConnect); + for k = 1:1:nRows + for i = 1:1:nColumns + if i +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printTargets (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printTargets(fid,net) + + if isfield(net,"targets") + # check if it's cell array + if iscell(net.targets) + [nRows, nColumns] = size(net.targets); + # insert enough spaces to put ":" to position 20 + # insert 2 spaces for distance between ":" and "%" + fprintf(fid," targets: {%dx%d cell} containing %d targets\n",nRows,nColumns,net.numTargets); + else + fprintf(fid,"unsure if this is possible\n"); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printTrainFcn.m b/octave_packages/nnet-0.1.13/__printTrainFcn.m new file mode 100644 index 0000000..d3ae4ca --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printTrainFcn.m @@ -0,0 +1,37 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printTrainFcn (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + + +function __printTrainFcn(fid,net) + + if isfield(net,"trainFcn") + if isempty(net.trainFcn) + fprintf(fid," trainFcn: '%s'\n","empty"); + else + fprintf(fid," trainFcn: '%s'\n",net.trainFcn); + endif + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__printTrainParam.m b/octave_packages/nnet-0.1.13/__printTrainParam.m new file mode 100644 index 0000000..c9a7e6a --- /dev/null +++ b/octave_packages/nnet-0.1.13/__printTrainParam.m @@ -0,0 +1,61 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __printTrainParam (@var{fid}) +## @code{printMLPHeader} saves the header of a neural network structure +## to a *.txt file with identification @code{fid}. +## @end deftypefn + +## Author: Michel D. Schmid + +function __printTrainParam(fid,net) + + if isfield(net,"trainParam") + str2 = ""; + str3 = ""; + if isempty(net.trainParam) + fprintf(fid," trainParam: '%s'\n","not yet used item"); + else + cellFieldNames = fieldnames(net.trainParam); + [nRows, nColumns] = size(cellFieldNames); + if (nRows<4) + else + for iRuns = 1:nRows + if (iRuns==1) + str1 = ["." char(cellFieldNames(iRuns,1)) ", "]; + endif + if (iRuns<=4 & iRuns>1) + str1 = [str1 "." char(cellFieldNames(iRuns,1)) ", "]; + endif + if (iRuns>4 & iRuns<=8) + str2 = [str2 "." char(cellFieldNames(iRuns,1)) ", "]; + endif + if (iRuns>8) + str3 = [str3 "." char(cellFieldNames(iRuns,1)) ", "]; + endif + endfor + fprintf(fid," trainParam: %s\n",str1); + fprintf(fid," %s\n",str2); + fprintf(fid," %s\n",str3); + endif + endif + else + fprintf(fid,"field trainparam not found\n"); + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__randomisecols.m b/octave_packages/nnet-0.1.13/__randomisecols.m new file mode 100644 index 0000000..c78cdcf --- /dev/null +++ b/octave_packages/nnet-0.1.13/__randomisecols.m @@ -0,0 +1,44 @@ +## Copyright (C) 2008 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{retmatrix} = __randomisecols (@var{matrix}) +## @code{__randomisecols} takes a matrix as input argument and changes the order +## of the columns. The rows aren't affected. +## @end deftypefn + +## Author: mds + +function [retmatrix] = __randomisecols(matrix) + + ## check number of inputs + error(nargchk(1,1,nargin)); + + # get number of cols + nCols = size(matrix,2); + + # now create random column order + colOrder = randperm(nCols); + + # now sort the matrix new + retmatrix = matrix(:,[colOrder]); + + +endfunction + +%!# no test possible, contains randperm which is using +%!# some randome functions diff --git a/octave_packages/nnet-0.1.13/__rerangecolumns.m b/octave_packages/nnet-0.1.13/__rerangecolumns.m new file mode 100644 index 0000000..342bcfa --- /dev/null +++ b/octave_packages/nnet-0.1.13/__rerangecolumns.m @@ -0,0 +1,168 @@ +## Copyright (C) 2008 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{retmatrix} = __rerangecolumns (@var{matrix},@var{analyzeMatrix},@var{nTrainSets}) +## @code{__rerangecolumns} reranges the data sets depending on the input arguments. +## @code{matrix} is the data set matrix containing inputs and outputs (targets) in row order. +## This means for example: the first three rows are inputs and the fourth row is an output row. +## The second argument is used in the optimizing algorithm. This matrix contains informations about +## the description of the rows data of matrix. +## The third argument is used to be sure, rerange all the columns to the correct position. +## @end deftypefn + +## Author: mds + +function retmatrix = __rerangecolumns(matrix,analyzeMatrix,nTrainSets) + + ## check number of inputs + error(nargchk(3,3,nargin)); + + # set default values + + # now sort "matrix" with help of analyzeMatrix + # following conditions must be kept: + # a.) rows containing unique values aren't sorted! + # b.) sort first rows which contains min AND max values only once + # c.) sort secondly rows which contains min OR max values only once + # d.) at last, sort binary data if still needed! + + nRows = size(analyzeMatrix,1); # get number of rows + + ## create i-vector + i = 1; + iVec = []; + while (i <= nRows) + if ( (analyzeMatrix(i,3)==1) && (analyzeMatrix(i,4)==1) ) + iVec = [iVec i]; + endif + i += 1; + endwhile + i = 1; + while (i <= nRows) + if ( (analyzeMatrix(i,3)>1) || (analyzeMatrix(i,4)>1) ) + iVec = [iVec i]; + endif + i += 1; + endwhile + i = 1; + while (i <= nRows) + if (analyzeMatrix(i,1)==1) + iVec = [iVec i]; + endif + i += 1; + endwhile + + + ## now do main loop + j = 1; + i = iVec(j); + nRows = length(iVec); + while (j < nRows) + if (analyzeMatrix(i,2)==1) + # easiest case, nothing to do + else + + # now let's see if min AND max values are only once in the row + if ( (analyzeMatrix(i,3)==1) && (analyzeMatrix(i,4)==1) ) + # search at which index the min value is + minVal = min(matrix(i,:)); + [rowInd, colInd] = find(matrix(i,:)==minVal);# colInd is searched + if (colInd >= nTrainSets ) # move column + matrix = __copycoltopos1(matrix,colInd); + endif + # search at which index the max value is + maxVal = max(matrix(i,:)); + [rowInd, colInd] = find(matrix(i,:)==maxVal);# colInd is searched + if (colInd >= nTrainSets ) # move column + matrix = __copycoltopos1(matrix,colInd); + endif + + else + + # now here, we have to copy the rows, if min OR max values are more than once in a row + if ( (analyzeMatrix(i,3)>=1) || (analyzeMatrix(i,4)>=1) ) + + # search at which index the min value is + minVal = min(matrix(i,:)); + [rowInd, colInd] = find(matrix(i,:)==minVal);# colInd is searched + if (colInd(1) >= nTrainSets ) # move column + matrix = __copycoltopos1(matrix,colInd(1)); + endif + + # search at which index the max value is + maxVal = max(matrix(i,:)); + [rowInd, colInd] = find(matrix(i,:) == maxVal);# colInd is searched + if (colInd(1) >= nTrainSets ) # move column + matrix = __copycoltopos1(matrix,colInd(1)); + endif + + else + # now sort binary data, if needed + + # search at which index the 0-value is + [rowInd, colInd] = find(matrix(i,:)==0);# colInd is searched + if (colInd(1) >= nTrainSets ) # move column + matrix = __copycoltopos1(matrix,colInd(1)); + endif + # search at which index the 1-value is + [rowInd, colInd] = find(matrix(i,:)==1);# colInd is searched + if (colInd(1) >= nTrainSets ) # move column + matrix = __copycoltopos1(matrix,colInd(1)); + endif + + endif# END OF if ( (analyzeMatrix(i,3)>=1) || (analyzeMatrix(i,4)>=1) ) + + endif # END OF if ( (analyzeMatrix(i,3)==1) AND (analyzeMatrix(i,4)==1) ) + + endif # END OF if (analyzeMatrix(i,2)==1) + j += 1; + i = iVec(j); + endwhile + retmatrix = matrix; +endfunction + +%!shared matrix,analyzeMatrix,nTrainSets, returnmatrix +%! disp("testing __rerangecolumns") +%! matrix = [0 1 0 0 0 0 1 0 1 1; \ +%! 4 4 4 4 4 4 4 4 4 4; \ +%! -1.1 -1.1 2 3 4 3.2 1 8 9 10; \ +%! 0 1.1 3 4 5 2 10 10 2 3; \ +%! -1 1 1 1 1 2 3 4 1 5]; +%! analyzeMatrix = [1 0 0 0; 0 1 0 0; 0 0 2 1; 0 0 1 2; 0 0 1 1]; +%! nTrainSets = 8; +%! returnmatrix = __rerangecolumns(matrix,analyzeMatrix,nTrainSets); +%!assert(returnmatrix(1,1)==1); +%!assert(returnmatrix(2,1)==4); +%!assert(returnmatrix(3,1)==1); +%!assert(returnmatrix(4,1)==10); +%!assert(returnmatrix(5,1)==3); +%! matrix = [0 1 0 0 0 0 1 0 1 1; \ +%! 4 4 4 4 4 4 4 4 4 4; \ +%! -1.1 -1.1 2 3 4 3.2 1 8 9 10; \ +%! 0 1.1 3 4 5 2 10 10 2 3; \ +%! -1 1 1 1 1 2 3 4 1 5; \ +%! 0 1 2 1 2 1 2 3 4 5;]; # the last row is euqal to the nnet targets +%! analyzeMatrix = [1 0 0 0; 0 1 0 0; 0 0 2 1; 0 0 1 2; 0 0 1 1]; +%! nTrainSets = 8; +%! returnmatrix = __rerangecolumns(matrix,analyzeMatrix,nTrainSets); +%!assert(returnmatrix(1,1)==1); +%!assert(returnmatrix(2,1)==4); +%!assert(returnmatrix(3,1)==1); +%!assert(returnmatrix(4,1)==10); +%!assert(returnmatrix(5,1)==3); +%!assert(returnmatrix(6,1)==2); \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__setx.m b/octave_packages/nnet-0.1.13/__setx.m new file mode 100644 index 0000000..3ba85ae --- /dev/null +++ b/octave_packages/nnet-0.1.13/__setx.m @@ -0,0 +1,61 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{net} = __setx (@var{net},@var{X2}) +## @code{__setx} sets the new weights to the neural network structure +## @end deftypefn + +## @seealso{getx} + +## Author: Michel D. Schmid + +function net = __setx(net,xx) + + ## check number of inputs + error(nargchk(2,2,nargin)); + + ## check input args + ## check "net", must be a net structure + if !__checknetstruct(net) + error("Structure doesn't seem to be a neural network") + endif + + ## inputs + [nRows, nColumns] = size(net.IW{1,1}); + nElementsIW = nRows*nColumns; + net.IW{1,1}(:) = xx(1:nElementsIW); + + [nRows, nColumns] = size(net.b{1,1}); + nElementsB1 = nRows*nColumns; + net.b{1,1}(:) = xx(1+nElementsIW:nElementsIW+nElementsB1); + start = nElementsIW + nElementsB1; + + ## layers + nLayers = net.numLayers; + for i = 2:nLayers + [nRows, nColumns] = size(net.LW{i,i-1}); + nElementsLW = nRows*nColumns; + net.LW{i,i-1}(:) = xx(1+start:start+nElementsLW); + + [nRows, nColumns] = size(net.b{i,1}); + nElementsBx = nRows*nColumns; + net.b{i,1}(:) = xx(1+start+nElementsLW:start+nElementsLW+nElementsBx); + start = start + nElementsLW + nElementsBx; + endfor + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/__trainlm.m b/octave_packages/nnet-0.1.13/__trainlm.m new file mode 100644 index 0000000..7320c8e --- /dev/null +++ b/octave_packages/nnet-0.1.13/__trainlm.m @@ -0,0 +1,361 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{netOut}] = __trainlm (@var{net},@var{mInputN},@var{mOutput},@var{[]},@var{[]},@var{VV}) +## A neural feed-forward network will be trained with @code{__trainlm} +## +## @example +## [netOut,tr,out,E] = __trainlm(net,mInputN,mOutput,[],[],VV); +## @end example +## @noindent +## +## left side arguments: +## @example +## netOut: the trained network of the net structure @code{MLPnet} +## tr : +## out: +## E : Error +## @end example +## @noindent +## +## right side arguments: +## @example +## net : the untrained network, created with @code{newff} +## mInputN: normalized input matrix +## mOutput: output matrix +## [] : unused parameter +## [] : unused parameter +## VV : validize structure +## out: +## E : Error +## @end example +## @noindent +## +## +## @noindent +## are equivalent. +## @end deftypefn + +## @seealso{newff,prestd,trastd} + +## Author: Michel D. Schmid + +## Comments: see in "A neural network toolbox for Octave User's Guide" [4] +## for variable naming... there have inputs or targets only one letter, +## e.g. for inputs is P written. To write a program, this is stupid, you can't +## search for 1 letter variable... that's why it is written here like Pp, or Tt +## instead only P or T. + +function [net] = __trainlm(net,Im,Pp,Tt,VV) + + ## check range of input arguments + error(nargchk(5,5,nargin)) + + ## Initialize + ##------------ + + ## get parameters for training + epochs = net.trainParam.epochs; + goal = net.trainParam.goal; + maxFail = net.trainParam.max_fail; + minGrad = net.trainParam.min_grad; + mu = net.trainParam.mu; + muInc = net.trainParam.mu_inc; + muDec = net.trainParam.mu_dec; + muMax = net.trainParam.mu_max; + show = net.trainParam.show; + time = net.trainParam.time; + + ## parameter checking + checkParameter(epochs,goal,maxFail,minGrad,mu,\ + muInc,muDec,muMax,show,time); + + ## Constants + shortStr = "TRAINLM"; # TODO: shortStr is longer as TRAINLM !!!!!!!!!!! + doValidation = !isempty(VV); + stop = ""; + + + #startTime = clock(); # TODO: maybe this row can be placed + # some rows later + + ## the weights are used in column vector format + xx = __getx(net); # x is the variable with respect to, but no + # variables with only one letter!! + ## define identity matrix + muI = eye(length(xx)); + + startTime = clock(); # if the next some tests are OK, I can delete + # startTime = clock(); 9 rows above.. + + ## calc performance of the actual net + [perf,vE,Aa,Nn] = __calcperf(net,xx,Im,Tt); + if (doValidation) + ## calc performance if validation is used + VV.net = net; # save the actual net in the validate + # structure... if no train loop will show better validate + # performance, this will be the returned net + vperf = __calcperf(net,xx,VV.Im,VV.Tt); + VV.perf = vperf; + VV.numFail = 0; # one of the stop criterias + endif + + nLayers = net.numLayers; + for iEpochs = 0:epochs # longest loop & one of the stop criterias + ve = vE{nLayers,1}; + ## calc jacobian + ## Jj is jacobian matrix + [Jj] = __calcjacobian(net,Im,Nn,Aa,vE); + + ## rerange error vector for jacobi matrix + ve = ve(:); + + Jjve = (Jj' * ve); # will be used to calculate the gradient + + normGradX = sqrt(Jjve'*Jjve); + + ## record training progress for later plotting + ## if requested + trainRec.perf(iEpochs+1) = perf; + trainRec.mu(iEpochs+1) = mu; + if (doValidation) + trainRec.vperf(iEpochs+1) = VV.perf; + endif + + ## stoping criteria + [stop,currentTime] = stopifnecessary(stop,startTime,perf,goal,\ + iEpochs,epochs,time,normGradX,minGrad,mu,muMax,\ + doValidation,VV,maxFail); + + ## show train progress + showtrainprogress(show,stop,iEpochs,epochs,time,currentTime, \ + goal,perf,minGrad,normGradX,shortStr,net); + + ## show performance plot, if needed + if !isnan(show) # if no performance plot is needed + ## now make it possible to define after how much loops the + ## performance plot should be updated + if (mod(iEpochs,show)==0) + plot(1:length(trainRec.perf),trainRec.perf); + if (doValidation) + hold on; + plot(1:length(trainRec.vperf),trainRec.vperf,"--g"); + endif + endif + endif # if !(strcmp(show,"NaN")) +# legend("Training","Validation"); + + ## stop if one of the criterias is reached. + if length(stop) + if (doValidation) + net = VV.net; + endif + break + endif + + ## calculate DeltaX + while (mu <= muMax) + ## calculate change in x + ## see [4], page 12-21 + dx = -((Jj' * Jj) + (muI*mu)) \ Jjve; + + ## add changes in x to actual x values (xx) + x1 = xx + dx; + ## now add x1 to a new network to see if performance will be better + net1 = __setx(net,x1); + ## calc now new performance with the new net + [perf1,vE1,Aa1,N1] = __calcperf(net1,x1,Im,Tt); + + if (perf1 < perf) + ## this means, net performance with new weight values is better... + ## so save the new values + xx = x1; + net = net1; + Nn = N1; + Aa = Aa1; + vE = vE1; + perf = perf1; + + mu = mu * muDec; + if (mu < 1e-20) # 1e-20 is properly the hard coded parameter in MATLAB(TM) + mu = 1e-20; + endif + break + endif + mu = mu * muInc; + endwhile + + ## validate with DeltaX + if (doValidation) + vperf = __calcperf(net,xx,VV.Im,VV.Tt); + if (vperf < VV.perf) + VV.perf = vperf; + VV.net = net; + ## if actual validation performance is better, + ## set numFail to zero again + VV.numFail = 0; + elseif (vperf > VV.perf) + VV.numFail = VV.numFail + 1; + endif + endif + + endfor #for iEpochs = 0:epochs + +#======================================================= +# +# additional functions +# +#======================================================= + function checkParameter(epochs,goal,maxFail,minGrad,mu,\ + muInc, muDec, muMax, show, time) + ## Parameter Checking + + ## epochs must be a positive integer + if ( !isposint(epochs) ) + error("Epochs is not a positive integer.") + endif + + ## goal can be zero or a positive double + if ( (goal<0) || !(isa(goal,"double")) ) + error("Goal is not zero or a positive real value.") + endif + + ## maxFail must be also a positive integer + if ( !isposint(maxFail) ) # this will be used, to see if validation can + # break the training + error("maxFail is not a positive integer.") + endif + + if (!isa(minGrad,"double")) || (!isreal(minGrad)) || (!isscalar(minGrad)) || \ + (minGrad < 0) + error("minGrad is not zero or a positive real value.") + end + + ## mu must be a positive real value. this parameter is responsible + ## for moving from stepest descent to quasi newton + if ((!isa(mu,"double")) || (!isreal(mu)) || (any(size(mu)) != 1) || (mu <= 0)) + error("mu is not a positive real value.") + endif + + ## muDec defines the decrement factor + if ((!isa(muDec,"double")) || (!isreal(muDec)) || (any(size(muDec)) != 1) || \ + (muDec < 0) || (muDec > 1)) + error("muDec is not a real value between 0 and 1.") + endif + + ## muInc defines the increment factor + if (~isa(muInc,"double")) || (!isreal(muInc)) || (any(size(muInc)) != 1) || \ + (muInc < 1) + error("muInc is not a real value greater than 1.") + endif + + ## muMax is the upper boundary for the mu value + if (!isa(muMax,"double")) || (!isreal(muMax)) || (any(size(muMax)) != 1) || \ + (muMax <= 0) + error("muMax is not a positive real value.") + endif + + ## check for actual mu value + if (mu > muMax) + error("mu is greater than muMax.") + end + + ## check if show is activated + if (!isnan(show)) + if (!isposint(show)) + error(["Show is not " "NaN" " or a positive integer."]) + endif + endif + + ## check at last the time argument, must be zero or a positive real value + if (!isa(time,"double")) || (!isreal(time)) || (any(size(time)) != 1) || \ + (time < 0) + error("Time is not zero or a positive real value.") + end + + endfunction # parameter checking + +# +# ----------------------------------------------------------------------------- +# + + function showtrainprogress(show,stop,iEpochs,epochs,time,currentTime, \ + goal,perf,minGrad,normGradX,shortStr,net) + + ## check number of inputs + error(nargchk(12,12,nargin)); + + ## show progress + if isfinite(show) && (!rem(iEpochs,show) || length(stop)) + fprintf(shortStr); # outputs the training algorithm + if isfinite(epochs) + fprintf(", Epoch %g/%g",iEpochs, epochs); + endif + if isfinite(time) + fprintf(", Time %4.1f%%",currentTime/time*100); # \todo: Time wird nicht ausgegeben + endif + if isfinite(goal) + fprintf(", %s %g/%g",upper(net.performFcn),perf,goal); # outputs the performance function + endif + if isfinite(minGrad) + fprintf(", Gradient %g/%g",normGradX,minGrad); + endif + fprintf("\n") + if length(stop) + fprintf("%s, %s\n\n",shortStr,stop); + endif + fflush(stdout); # writes output to stdout as soon as output messages are available + endif + endfunction + +# +# ----------------------------------------------------------------------------- +# + + function [stop,currentTime] = stopifnecessary(stop,startTime,perf,goal,\ + iEpochs,epochs,time,normGradX,minGrad,mu,muMax,\ + doValidation,VV,maxFail) + + ## check number of inputs + error(nargchk(14,14,nargin)); + + currentTime = etime(clock(),startTime); + if (perf <= goal) + stop = "Performance goal met."; + elseif (iEpochs == epochs) + stop = "Maximum epoch reached, performance goal was not met."; + elseif (currentTime > time) + stop = "Maximum time elapsed, performance goal was not met."; + elseif (normGradX < minGrad) + stop = "Minimum gradient reached, performance goal was not met."; + elseif (mu > muMax) + stop = "Maximum MU reached, performance goal was not met."; + elseif (doValidation) + if (VV.numFail > maxFail) + stop = "Validation stop."; + endif + endif + endfunction + +# ===================================================================== +# +# END additional functions +# +# ===================================================================== + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/dhardlim.m b/octave_packages/nnet-0.1.13/dhardlim.m new file mode 100644 index 0000000..458f91d --- /dev/null +++ b/octave_packages/nnet-0.1.13/dhardlim.m @@ -0,0 +1,31 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, write to the Free +## Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301, USA. + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{a} = dhardlim (@var{n}) +## +## @end deftypefn + +## Author: Michel D. Schmid + + +function a = dhardlim(n) + + a = 0; + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/dividerand.m b/octave_packages/nnet-0.1.13/dividerand.m new file mode 100644 index 0000000..3e3d748 --- /dev/null +++ b/octave_packages/nnet-0.1.13/dividerand.m @@ -0,0 +1,74 @@ +## Copyright (C) 2009 Luiz Angelo Daros de Luca +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{trainVectors},@var{validationVectors},@var{testVectors},@var{indexOfTrain},@var{indexOfValidation},@var{indexOfTest}] = dividerand (@var{allCases},@var{trainRatio},@var{valRatio},@var{testRatio}) +## Divide the vectors in training, validation and test group according to +## the informed ratios +## +## +## @example +## +## [trainVectors,validationVectors,testVectors,indexOfTrain,indexOfValidatio +## n,indexOfTest] = dividerand(allCases,trainRatio,valRatio,testRatio) +## +## The ratios are normalized. This way: +## +## dividerand(xx,1,2,3) == dividerand(xx,10,20,30) +## +## @end example +## +## @end deftypefn + + +function [trainVectors,validationVectors,testVectors,indexOfTrain,indexOfValidation,indexOfTest] = dividerand(allCases,trainRatio,valRatio,testRatio) + # + # Divide the vectors in training, validation and test group according to + # the informed ratios + # + # [trainVectors,validationVectors,testVectors,indexOfTrain,indexOfValidatio + # n,indexOfTest] = dividerand(allCases,trainRatio,valRatio,testRatio) + # + # The ratios are normalized. This way: + # + # dividerand(xx,1,2,3) == dividerand(xx,10,20,30) + # + + ## Normalize ratios + total = trainRatio + valRatio + testRatio; + #trainRatio = trainRatio / total; not used + validationRatio = valRatio / total; + testRatio = testRatio / total; + + ## Calculate the number of cases for each type + numerOfCases = size(allCases,2); + numberOfValidation = floor(validationRatio*numerOfCases); + numberOfTest = floor(testRatio*numerOfCases); + numberOfTrain = numerOfCases - numberOfValidation - numberOfTest; + + ## Find their indexes + indexOfAll=randperm(numerOfCases); + indexOfValidation=sort(indexOfAll(1:numberOfValidation)); + indexOfTest=sort(indexOfAll((1:numberOfTest)+numberOfValidation)); + indexOfTrain=sort(indexOfAll((1:numberOfTrain)+numberOfTest+numberOfValidation)); + + ## Return vectors + trainVectors = allCases(:,indexOfTrain); + testVectors = allCases(:,indexOfTest); + validationVectors = allCases(:,indexOfValidation); +endfunction + diff --git a/octave_packages/nnet-0.1.13/doc-cache b/octave_packages/nnet-0.1.13/doc-cache new file mode 100644 index 0000000..5ccf123 --- /dev/null +++ b/octave_packages/nnet-0.1.13/doc-cache @@ -0,0 +1,905 @@ +# Created by Octave 3.6.1, Sun Apr 01 17:24:32 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 28 +# name: +# type: sq_string +# elements: 1 +# length: 8 +dhardlim + + +# name: +# type: sq_string +# elements: 1 +# length: 39 + -- Function File: [A = dhardlim (N) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 0 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +dividerand + + +# name: +# type: sq_string +# elements: 1 +# length: 556 + -- Function File: [ + TRAINVECTORS,VALIDATIONVECTORS,TESTVECTORS,INDEXOFTRAIN,INDEXOFVALIDATION,INDEXOFTEST] + = dividerand (ALLCASES,TRAINRATIO,VALRATIO,TESTRATIO) + Divide the vectors in training, validation and test group + according to the informed ratios + + + [trainVectors,validationVectors,testVectors,indexOfTrain,indexOfValidatio + n,indexOfTest] = dividerand(allCases,trainRatio,valRatio,testRatio) + + The ratios are normalized. This way: + + dividerand(xx,1,2,3) == dividerand(xx,10,20,30) + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Divide the vectors in training, validation and test group according to +the infor + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +dposlin + + +# name: +# type: sq_string +# elements: 1 +# length: 117 + -- Function File: A= poslin (N) + `poslin' is a positive linear transfer function used by neural + networks + + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 +`poslin' is a positive linear transfer function used by neural networks + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +dsatlin + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + -- Function File: [A = dsatlin (N) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 0 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +dsatlins + + +# name: +# type: sq_string +# elements: 1 +# length: 105 + -- Function File: [A = satlins (N) + A neural feed-forward network will be trained with `trainlm' + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +A neural feed-forward network will be trained with `trainlm' + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +hardlim + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + -- Function File: [A = hardlim (N) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 0 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +hardlims + + +# name: +# type: sq_string +# elements: 1 +# length: 39 + -- Function File: [A = hardlims (N) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 0 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +ind2vec + + +# name: +# type: sq_string +# elements: 1 +# length: 256 + -- Function File: VEC = ind2vec (IND) + `vec2ind' convert indices to vector + + EXAMPLE 1 + vec = [1 2 3; 4 5 6; 7 8 9]; + + ind = vec2ind(vec) + The prompt output will be: + ans = + 1 2 3 1 2 3 1 2 3 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +`vec2ind' convert indices to vector + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +isposint + + +# name: +# type: sq_string +# elements: 1 +# length: 293 + -- Function File: F = isposint(N) + `isposint' returns true for positive integer values. + + isposint(1) # this returns TRUE + isposint(0.5) # this returns FALSE + isposint(0) # this also return FALSE + isposint(-1) # this also returns FALSE + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +`isposint' returns true for positive integer values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +logsig + + +# name: +# type: sq_string +# elements: 1 +# length: 224 + -- Function File: A = logsig (N) + `logsig' is a non-linear transfer function used to train neural + networks. This function can be used in newff(...) to create a new + feed forward multi-layer neural network. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 +`logsig' is a non-linear transfer function used to train neural +networks. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +mapstd + + +# name: +# type: sq_string +# elements: 1 +# length: 1273 + -- Function File: [ YY,PS] = mapstd (XX,YMEAN,YSTD) + Map values to mean 0 and standard derivation to 1. + + [YY,PS] = mapstd(XX,ymean,ystd) + + Apply the conversion and returns YY as (YY-ymean)/ystd. + + [YY,PS] = mapstd(XX,FP) + + Apply the conversion but using an struct to inform target mean/stddev. + This is the same of [YY,PS]=mapstd(XX,FP.ymean, FP.ystd). + + YY = mapstd('apply',XX,PS) + + Reapply the conversion based on a previous operation data. + PS stores the mean and stddev of the first XX used. + + XX = mapstd('reverse',YY,PS) + + Reverse a conversion of a previous applied operation. + + dx_dy = mapstd('dx',XX,YY,PS) + + Returns the derivative of Y with respect to X. + + dx_dy = mapstd('dx',XX,[],PS) + + Returns the derivative (less efficient). + + name = mapstd('name'); + + Returns the name of this convesion process. + + FP = mapstd('pdefaults'); + + Returns the default process parameters. + + names = mapstd('pnames'); + + Returns the description of the process parameters. + + mapstd('pcheck',FP); + + Raises an error if FP has some inconsistent. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Map values to mean 0 and standard derivation to 1. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +min_max + + +# name: +# type: sq_string +# elements: 1 +# length: 267 + -- Function File: PR = min_max (PP) + `min_max' returns variable Pr with range of matrix rows + + PR - R x 2 matrix of min and max values for R input elements + + Pp = [1 2 3; -1 -0.5 -3] + pr = min_max(Pp); + pr = [1 3; -0.5 -3]; + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 +`min_max' returns variable Pr with range of matrix rows + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +newff + + +# name: +# type: sq_string +# elements: 1 +# length: 820 + -- Function File: NET = newff (PR,SS,TRF,BTF,BLF,PF) + `newff' create a feed-forward backpropagation network + + Pr - R x 2 matrix of min and max values for R input elements + Ss - 1 x Ni row vector with size of ith layer, for N layers + trf - 1 x Ni list with transfer function of ith layer, + default = "tansig" + btf - Batch network training function, + default = "trainlm" + blf - Batch weight/bias learning function, + default = "learngdm" + pf - Performance function, + default = "mse". + + EXAMPLE 1 + Pr = [0.1 0.8; 0.1 0.75; 0.01 0.8]; + it's a 3 x 2 matrix, this means 3 input neurons + + net = newff(Pr, [4 1], {"tansig","purelin"}, "trainlm", "learngdm", "mse"); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +`newff' create a feed-forward backpropagation network + + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +newp + + +# name: +# type: sq_string +# elements: 1 +# length: 545 + -- Function File: NET = newp (PR,SS,TRANSFUNC,LEARNFUNC) + `newp' create a perceptron + + PLEASE DON'T USE THIS FUNCTIONS, IT'S STILL NOT FINISHED! + ========================================================= + + Pr - R x 2 matrix of min and max values for R input elements + ss - a scalar value with the number of neurons + transFunc - a string with the transfer function + default = "hardlim" + learnFunc - a string with the learning function + default = "learnp" + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 +`newp' create a perceptron + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +poslin + + +# name: +# type: sq_string +# elements: 1 +# length: 117 + -- Function File: A= poslin (N) + `poslin' is a positive linear transfer function used by neural + networks + + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 +`poslin' is a positive linear transfer function used by neural networks + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +poststd + + +# name: +# type: sq_string +# elements: 1 +# length: 153 + -- Function File: [PP,TT] = poststd(PN,MEANP,,STDP,TN,MEANT,STDT) + `poststd' postprocesses the data which has been preprocessed by + `prestd'. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 +`poststd' postprocesses the data which has been preprocessed by +`prestd'. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +prestd + + +# name: +# type: sq_string +# elements: 1 +# length: 160 + -- Function File: [PN,MEANP,STDP,TN,MEANT,STDT] =prestd(P,T) + `prestd' preprocesses the data so that the mean is 0 and the + standard deviation is 1. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +`prestd' preprocesses the data so that the mean is 0 and the standard +deviation + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +purelin + + +# name: +# type: sq_string +# elements: 1 +# length: 105 + -- Function File: A= purelin (N) + `purelin' is a linear transfer function used by neural networks + + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 +`purelin' is a linear transfer function used by neural networks + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +radbas + + +# name: +# type: sq_string +# elements: 1 +# length: 100 + -- Function File: radbas (N) + Radial basis transfer function. + + `radbas(n) = exp(-n^2)' + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 +Radial basis transfer function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +satlin + + +# name: +# type: sq_string +# elements: 1 +# length: 104 + -- Function File: [A = satlin (N) + A neural feed-forward network will be trained with `trainlm' + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +A neural feed-forward network will be trained with `trainlm' + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +satlins + + +# name: +# type: sq_string +# elements: 1 +# length: 105 + -- Function File: [A = satlins (N) + A neural feed-forward network will be trained with `trainlm' + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +A neural feed-forward network will be trained with `trainlm' + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +saveMLPStruct + + +# name: +# type: sq_string +# elements: 1 +# length: 119 + -- Function File: saveMLPStruct (NET,STRFILENAME) + `saveStruct' saves a neural network structure to *.txt files + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +`saveStruct' saves a neural network structure to *. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +sim + + +# name: +# type: sq_string +# elements: 1 +# length: 215 + -- Function File: NETOUTPUT = sim (NET, MINPUT) + `sim' is usuable to simulate a before defined neural network. + `net' is created with newff(...) and MINPUT should be the + corresponding input data set! + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +`sim' is usuable to simulate a before defined neural network. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +subset + + +# name: +# type: sq_string +# elements: 1 +# length: 1632 + -- Function File: [MTRAIN, MTEST, MVALI] = subset + (MDATA,NTARGETS,IOPTI,FTEST,FVALI) + `subset' splits the main data matrix which contains inputs and + targets into 2 or 3 subsets depending on the parameters. + + The first parameter MDATA must be in row order. This means if the + network contains three inputs, the matrix must be have 3 rows and + x columns to define the data for the inputs. And some more rows + for the outputs (targets), e.g. a neural network with three inputs + and two outputs must have 5 rows with x columns! The second + parameter NTARGETS defines the number or rows which contains the + target values! The third argument `iOpti' is optional and can + have three status: 0: no optimization 1: will + randomise the column order and order the columns containing min + and max values to be in the train set 2: will NOT randomise + the column order, but order the columns containing min and max + values to be in the train set default value is `1' The + fourth argument `fTest' is also optional and defines how much data + sets will be in the test set. Default value is `1/3' The fifth + parameter `fTrain' is also optional and defines how much data sets + will be in the train set. Default value is `1/6' So we have 50% of + all data sets which are for training with the default values. + + [mTrain, mTest] = subset(mData,1) + returns three subsets of the complete matrix + with randomized and optimized columns! + + [mTrain, mTest] = subset(mData,1,) + returns two subsets + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +`subset' splits the main data matrix which contains inputs and targets +into 2 or + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +tansig + + +# name: +# type: sq_string +# elements: 1 +# length: 224 + -- Function File: A = tansig (N) + `tansig' is a non-linear transfer function used to train neural + networks. This function can be used in newff(...) to create a new + feed forward multi-layer neural network. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 +`tansig' is a non-linear transfer function used to train neural +networks. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +train + + +# name: +# type: sq_string +# elements: 1 +# length: 614 + -- Function File: [NET] = train (MLPNET,MINPUTN,MOUTPUT,[],[],VV) + A neural feed-forward network will be trained with `train' + + [net,tr,out,E] = train(MLPnet,mInputN,mOutput,[],[],VV); + + left side arguments: + net: the trained network of the net structure `MLPnet' + + right side arguments: + MLPnet : the untrained network, created with `newff' + mInputN: normalized input matrix + mOutput: output matrix (normalized or not) + [] : unused parameter + [] : unused parameter + VV : validize structure + + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 +A neural feed-forward network will be trained with `train' + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +trastd + + +# name: +# type: sq_string +# elements: 1 +# length: 447 + -- Function File: PN = trastd (P,MEANP,STDP) + `trastd' preprocess additional data for neural network simulation. + + `p' : test input data + `meanp': vector with standardization parameters of prestd(...) + `stdp' : vector with standardization parameters of prestd(...) + + meanp = [2.5; 6.5]; + stdp = [1.2910; 1.2910]; + p = [1 4; 2 5]; + + pn = trastd(p,meanp,stdp); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +`trastd' preprocess additional data for neural network simulation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +vec2ind + + +# name: +# type: sq_string +# elements: 1 +# length: 260 + -- Function File: IND = vec2ind (VECTOR) + `vec2ind' convert vectors to indices + + EXAMPLE 1 + vec = [1 2 3; 4 5 6; 7 8 9]; + + ind = vec2ind(vec) + The prompt output will be: + ans = + 1 2 3 1 2 3 1 2 3 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 +`vec2ind' convert vectors to indices + + + + + + diff --git a/octave_packages/nnet-0.1.13/dposlin.m b/octave_packages/nnet-0.1.13/dposlin.m new file mode 100644 index 0000000..dc1bafa --- /dev/null +++ b/octave_packages/nnet-0.1.13/dposlin.m @@ -0,0 +1,35 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, write to the Free +## Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301, USA. + +## -*- texinfo -*- +## @deftypefn {Function File} {}@var{a}= poslin (@var{n}) +## @code{poslin} is a positive linear transfer function used +## by neural networks +## @end deftypefn + +## Author: Michel D. Schmid + +function a = dposlin(n) + + if (n<0) + a = 0; + else + a = 1; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/dsatlin.m b/octave_packages/nnet-0.1.13/dsatlin.m new file mode 100644 index 0000000..c4ffeb4 --- /dev/null +++ b/octave_packages/nnet-0.1.13/dsatlin.m @@ -0,0 +1,41 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, write to the Free +## Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301, USA. + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{a} = dsatlin (@var{n}) +## +## @end deftypefn + +## @seealso{dpurelin,dtansig,dlogsig} + +## Author: Michel D. Schmid + + +function a = dsatlin(n) + + + # the derivative of satlin is easy: + # where satlin is constant, the derivative is 0 + # else, because without variable n, the derivative is 1 + if (n>=0 && n<=1) + a = 1; + else + a = 0; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/dsatlins.m b/octave_packages/nnet-0.1.13/dsatlins.m new file mode 100644 index 0000000..1ad1896 --- /dev/null +++ b/octave_packages/nnet-0.1.13/dsatlins.m @@ -0,0 +1,41 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, write to the Free +## Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301, USA. + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{a} = satlins (@var{n}) +## A neural feed-forward network will be trained with @code{trainlm} +## +## @end deftypefn + +## @seealso{purelin,tansig,logsig,satlin,hardlim,hardlims} + +## Author: Michel D. Schmid + + +function a = dsatlins(n) + + # comment see dsatlin + # a = 1 if (n>=-1 && n<=1), + # 0 otherwise + if (n>=-1 && n<=1) + a = 1; + else + a = 0; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/hardlim.m b/octave_packages/nnet-0.1.13/hardlim.m new file mode 100644 index 0000000..6c07a89 --- /dev/null +++ b/octave_packages/nnet-0.1.13/hardlim.m @@ -0,0 +1,34 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, write to the Free +## Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301, USA. + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{a} = hardlim (@var{n}) +## +## @end deftypefn + +## @seealso{purelin,tansig} + +## Author: Michel D. Schmid + + +function a = hardlim(n) + + # a=1 if n>=0, a=0 otherwise + a = (n>=0); + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/hardlims.m b/octave_packages/nnet-0.1.13/hardlims.m new file mode 100644 index 0000000..f3bdc14 --- /dev/null +++ b/octave_packages/nnet-0.1.13/hardlims.m @@ -0,0 +1,38 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, write to the Free +## Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301, USA. + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{a} = hardlims (@var{n}) +## +## @end deftypefn + +## @seealso{purelin,tansig,hardlim} + +## Author: Michel D. Schmid + + +function a = hardlims(n) + + # a=1 if n>0, a=-1 otherwise + if n>=0 + a=1; + else + a=-1; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/ind2vec.m b/octave_packages/nnet-0.1.13/ind2vec.m new file mode 100644 index 0000000..ab8bef3 --- /dev/null +++ b/octave_packages/nnet-0.1.13/ind2vec.m @@ -0,0 +1,43 @@ +## Copyright (C) 2009 Luiz Angelo Daros de Luca +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{vec}} = ind2vec (@var{ind}) +## @code{vec2ind} convert indices to vector +## +## +## @example +## EXAMPLE 1 +## vec = [1 2 3; 4 5 6; 7 8 9]; +## +## ind = vec2ind(vec) +## The prompt output will be: +## ans = +## 1 2 3 1 2 3 1 2 3 +## @end example +## +## @end deftypefn + +## @seealso{vec2ind} + +function [vector]=ind2vec(ind) + # Converts indices to vectors + # + # + vectors = length(ind); + vector = sparse(ind,1:vectors,ones(1,vectors)); +endfunction diff --git a/octave_packages/nnet-0.1.13/isposint.m b/octave_packages/nnet-0.1.13/isposint.m new file mode 100644 index 0000000..a41ae5e --- /dev/null +++ b/octave_packages/nnet-0.1.13/isposint.m @@ -0,0 +1,61 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{f} = isposint(@var{n}) +## @code{isposint} returns true for positive integer values. +## +## @example +## isposint(1) # this returns TRUE +## isposint(0.5) # this returns FALSE +## isposint(0) # this also return FALSE +## isposint(-1) # this also returns FALSE +## @end example +## +## +## @end deftypefn + +## Author: Michel D. Schmid + +function f = isposint(n) + + ## check range of input arguments + error(nargchk(1,1,nargin)) + + ## check input arg + if (length(n)>1) + error("Input argument must not be a vector, only scalars are allowed!") + endif + + f = 1; + if ( (!isreal(n)) || (n<=0) || (round(n) != n) ) + f = 0; + endif + + +endfunction + +%!shared +%! disp("testing isposint") +%!assert(isposint(1)) # this should pass +%!assert(isposint(0.5),0) # should return zero +%!assert(isposint(-1),0) # should return zero +%!assert(isposint(-1.5),0) # should return zero +%!assert(isposint(0),0) # should return zero +%!fail("isposint([0 0])","Input argument must not be a vector, only scalars are allowed!") +%!fail("isposint('testString')","Input argument must not be a vector, only scalars are allowed!") + diff --git a/octave_packages/nnet-0.1.13/logsig.m b/octave_packages/nnet-0.1.13/logsig.m new file mode 100644 index 0000000..a21cf4c --- /dev/null +++ b/octave_packages/nnet-0.1.13/logsig.m @@ -0,0 +1,41 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}@var{a} = logsig (@var{n}) +## @code{logsig} is a non-linear transfer function used to train +## neural networks. +## This function can be used in newff(...) to create a new feed forward +## multi-layer neural network. +## +## @end deftypefn + +## @seealso{purelin,tansig} + +## Author: Michel D. Schmid + + +function a = logsig(n) + + + a = 1 ./ (1 + exp(-n)); + ## attention with critical values ==> infinite values + ## must be set to 1! Still the same problem as in "tansig" + i = find(!finite(a)); + a(i) = sign(n(i)); + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/mapstd.m b/octave_packages/nnet-0.1.13/mapstd.m new file mode 100644 index 0000000..bccf290 --- /dev/null +++ b/octave_packages/nnet-0.1.13/mapstd.m @@ -0,0 +1,329 @@ +## Copyright (C) 2009 Luiz Angelo Daros de Luca +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{YY},@var{PS}] = mapstd (@var{XX},@var{ymean},@var{ystd}) +## Map values to mean 0 and standard derivation to 1. +## +## @example +## [YY,PS] = mapstd(XX,ymean,ystd) +## +## Apply the conversion and returns YY as (YY-ymean)/ystd. +## +## [YY,PS] = mapstd(XX,FP) +## +## Apply the conversion but using an struct to inform target mean/stddev. +## This is the same of [YY,PS]=mapstd(XX,FP.ymean, FP.ystd). +## +## YY = mapstd('apply',XX,PS) +## +## Reapply the conversion based on a previous operation data. +## PS stores the mean and stddev of the first XX used. +## +## XX = mapstd('reverse',YY,PS) +## +## Reverse a conversion of a previous applied operation. +## +## dx_dy = mapstd('dx',XX,YY,PS) +## +## Returns the derivative of Y with respect to X. +## +## dx_dy = mapstd('dx',XX,[],PS) +## +## Returns the derivative (less efficient). +## +## name = mapstd('name'); +## +## Returns the name of this convesion process. +## +## FP = mapstd('pdefaults'); +## +## Returns the default process parameters. +## +## names = mapstd('pnames'); +## +## Returns the description of the process parameters. +## +## mapstd('pcheck',FP); +## +## Raises an error if FP has some inconsistent. +## @end example +## +## @end deftypefn + +function [out1,out2]=mapstd(in1,in2,in3,in4) + # + # Map values to mean 0 and standard derivation to 1. + # + # [YY,PS] = mapstd(XX,ymean,ystd) + # + # Apply the conversion and returns YY as (YY-ymean)/ystd. + # + # [YY,PS] = mapstd(XX,FP) + # + # Apply the conversion but using an struct to inform target mean/stddev. + # This is the same of [YY,PS]=mapstd(XX,FP.ymean, FP.ystd). + # + # YY = mapstd('apply',XX,PS) + # + # Reapply the conversion based on a previous operation data. + # PS stores the mean and stddev of the first XX used. + # + # XX = mapstd('reverse',YY,PS) + # + # Reverse a conversion of a previous applied operation. + # + # dx_dy = mapstd('dx',XX,YY,PS) + # + # Returns the derivative of Y with respect to X. + # + # dx_dy = mapstd('dx',XX,[],PS) + # + # Returns the derivative (less efficient). + # + # name = mapstd('name'); + # + # Returns the name of this convesion process. + # + # FP = mapstd('pdefaults'); + # + # Returns the default process parameters. + # + # names = mapstd('pnames'); + # + # Returns the description of the process parameters. + # + # mapstd('pcheck',FP); + # + # Raises an error if FP has some inconsistent. + # + + if nargin==0 + error("Not enough arguments.") + endif + + # Defaults + ps.name="mapstd"; + ps.ymean=0; + ps.ystd=1; + + if ischar(in1) + switch in1 + case "name" + if nargout>1 + error("Too many output arguments"); + endif + if nargin>1 + error("Too many input arguments"); + endif + out1="Map Mean and Standard Deviation"; + return; + case "pdefaults" + if nargout>1 + error("Too many output arguments"); + endif + if nargin>1 + error("Too many input arguments"); + endif + out1=ps; + case "pcheck" + if nargout>1 + error("Too many output arguments"); + endif + if nargin<2 + error("Not enough input arguments"); + endif + if nargin>2 + error("Too many input arguments"); + endif + + fp=in2; + if ~isstruct(fp) + error("FP must be a struct") + elseif ~isfield(fp,"ymean") + error("FP must include ymean field") + elseif ~isfield(fp,"ystd") + error("FP must include ystd field") + elseif isdouble(fp.ymean) + error("FP.ymean must be a real scalar value") + elseif isdouble(fp.ystd) + error("FP.ystd must be a real scalar value") + else + out1=''; + endif + return; + # MATLAB uses pnames but documents as pdesc (that does not work) + case "pnames" + if nargout>1 + error("Too many output arguments"); + endif + if nargin>1 + error("Too many input arguments"); + endif + # MATLAB seems to be buggy in the second element + #out1={'Mean value for each row of Y.','Maximum value for each + #row of Y.'}; + out1={"Mean value for each row of Y.","Standart deviation value for each row of Y."}; + case "apply" + if nargin<3 + error("Not enough input arguments"); + endif + if nargin>3 + error("Too many input arguments"); + endif + if nargout>1 + error("Too many output arguments"); + endif + xx=in2; + ps=in3; + yy=apply(xx,ps); + out1=yy; + out2=ps; + return; + case "reverse" + if nargin<3 + error("Not enough input arguments"); + endif + if nargin>3 + error("Too many input arguments"); + endif + if nargout>1 + error("Too many output arguments"); + endif + yy=in2; + ps=in3; + xx=reverse(yy,ps); + out1=xx; + out2=ps; + return; + case "dx" + if nargin<3 + error("Not enough input arguments"); + endif + if nargin>3 + error("Too many input arguments"); + endif + if nargout>1 + error("Too many output arguments"); + endif + xx=in2; + yy=in3; + ps=in4; + xx_yy=derivate(xx,yy,ps); + out1=xx_yy; + return; + endswitch + else + xx=in1; + ps.xrows=size(xx,1); + ps.yrows=size(xx,1); + ps.xmean=mean(xx,2); + ps.xstd=std(xx,0,2); + + if nargin==1 + # All correct + elseif nargin==2 + if isstruct(in2) + ps.ymean=in2.ymean; + ps.ystd=in2.ystd; + else + ps.ymean=in2; + endif + elseif nargin == 3 + ps.ymean=in2; + ps.ystd=in3; + else + error("Too many input arguments"); + endif + + out1=apply(xx,ps); + out2=ps; + endif + + # Verify args + function checkargs(values,ps) + # check xx is matrix + if ~isnumeric(values) + error("Just numeric values are accepted") + endif + # check ps is struct + if ~isstruct(ps) + error("PS should be a struct") + endif + # check ymean,ystd + if ~isa(ps.ymean,"double") + error("PS.ymean should be a double") + endif + if ~isa(ps.ystd,"double") + error("PS.ystd should be a double") + endif + if ~all(size(ps.ymean)==[1 1]) + error("PS.ymean should be a scalar") + endif + if ~all(size(ps.ystd)==[1 1]) + error("PS.ystd should be a scalar") + endif + # check xmean,ystd + if ~isnumeric(ps.xmean) + error("PS.xmean should be a numeric") + endif + if ~isnumeric(ps.xstd) + error("PS.xstd should be a numeric") + endif + if ~all(size(ps.xmean)==size(ps.xstd)) + error("Size of PS.xmean and PS.xstd must match") + endif + endfunction + + # Apply the mapping operation + function [yy]=apply(xx,ps) + checkargs(xx,ps) + + if ~all(size(xx,1)==size(ps.xmean,1)) + error("Size of XX rows should match PS.xmean and PS.xstd") + endif + # Avoid multiply/division by zero + ps.xstd(ps.xstd == 0) = 1; + yy=(xx - (ps.xmean*ones(1,size(xx,2)))) ./ (ps.xstd*ones(1,size(xx,2))); + yy=(yy + ps.ymean) .* ps.ystd; + endfunction + + # Reverse the mapping operation + function [xx]=reverse(yy,ps) + checkargs(yy,ps) + if ~all(size(yy,1)==size(ps.xmean,1)) + error("Size of YY rows should match PS.xmean and PS.xstd") + endif + # Avoid multiply/division by zero + ps.xstd(ps.xstd == 0) = 1; + yy=(yy ./ ps.ystd) - ps.ymean; + xx=(yy .* (ps.xstd*ones(1,size(yy,2)))) + (ps.xmean*ones(1,size(yy,2))); + endfunction + + # I don't know why this exists but matlab implements it + function [dy_dx]=derivate(xx,yy,ps) + checkargs(yy,ps) + checkargs(xx,ps) + + cols = size(xx,2); + diagonal = diag(ps.ystd ./ ps.xstd); + dy_dx = diagonal(:,:,ones(1,cols)); + endfunction + +#end + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/min_max.m b/octave_packages/nnet-0.1.13/min_max.m new file mode 100644 index 0000000..afa9cdd --- /dev/null +++ b/octave_packages/nnet-0.1.13/min_max.m @@ -0,0 +1,62 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{Pr} = min_max (@var{Pp}) +## @code{min_max} returns variable Pr with range of matrix rows +## +## @example +## PR - R x 2 matrix of min and max values for R input elements +## @end example +## +## @example +## Pp = [1 2 3; -1 -0.5 -3] +## pr = min_max(Pp); +## pr = [1 3; -0.5 -3]; +## @end example +## @end deftypefn + +## Author: Michel D. Schmid + +function Pr = min_max(Pp) + + ## check number of input args + error(nargchk(1,1,nargin)) + + Pr = []; # returns an empty matrix + #if ismatrix(Pp) + if (!(size(Pp,1)==1) && !(size(Pp,2)==1)) # ismatrix(1) will return 1!!! + if isreal(Pp) # be sure, this is no complex matrix + Pr = [min(Pp,[],2) max(Pp,[],2)]; + else + error("Argument has illegal type.") + endif + else + error("Argument must be a matrix.") + endif + +endfunction + +%!shared +%! disp("testing min_max") +%!test fail("min_max(1)","Argument must be a matrix.") +%!test fail("min_max('testString')","Argument must be a matrix.") +%!test fail("min_max(cellA{1}=1)","Argument must be a matrix.") +%!test fail("min_max([1+1i, 2+2i])","Argument must be a matrix.") +%!test fail("min_max([1+1i, 2+2i; 3+1i, 4+2i])","Argument has illegal type.") + + diff --git a/octave_packages/nnet-0.1.13/newff.m b/octave_packages/nnet-0.1.13/newff.m new file mode 100644 index 0000000..81b1d8a --- /dev/null +++ b/octave_packages/nnet-0.1.13/newff.m @@ -0,0 +1,279 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{net}} = newff (@var{Pr},@var{ss},@var{trf},@var{btf},@var{blf},@var{pf}) +## @code{newff} create a feed-forward backpropagation network +## +## @example +## Pr - R x 2 matrix of min and max values for R input elements +## Ss - 1 x Ni row vector with size of ith layer, for N layers +## trf - 1 x Ni list with transfer function of ith layer, +## default = "tansig" +## btf - Batch network training function, +## default = "trainlm" +## blf - Batch weight/bias learning function, +## default = "learngdm" +## pf - Performance function, +## default = "mse". +## @end example +## +## @example +## EXAMPLE 1 +## Pr = [0.1 0.8; 0.1 0.75; 0.01 0.8]; +## it's a 3 x 2 matrix, this means 3 input neurons +## +## net = newff(Pr, [4 1], @{"tansig","purelin"@}, "trainlm", "learngdm", "mse"); +## @end example +## +## @end deftypefn + +## @seealso{sim, init, train} + +## Author: Michel D. Schmid + +function net = newff(Pr,ss,transFunc,trainFunc,notUsed,performFunc) + + ## initial descriptipn + ## newff(Pr,ss,transfunc,trainFunc,notUsed,performFunc) + ## * Pr is a nx2 matrix with min and max values of standardized inputs + ## Pr means: p-range + ## * ss is a row vector, the first element describes the number + ## of hidden neurons, the second element describes the number + ## of output neurons + ## * transFunc is a cell array of transfer function, standard is "tansig" + ## * trainFunc is the training algorithm + ## * notUsed exist only because we have only one train algorithm which doesn't + ## need a weight learning function + ## * performFunc is written for the performance function, standard is "mse" + + ## check range of input arguments + error(nargchk(2,6,nargin)) + + ## get number of layers (without input layer) + nLayers = length(ss); + + ## set defaults + if (nargin <3) + # the number of transfer functions depends on the number of + # hidden layers, so we have to create a loop here 30.09.09 (dd.mm.yy) + for i=1:nLayers + if (i==nLayers) + transFunc{i,1} = "purelin"; + else + transFunc{i,1}= "tansig"; + endif + endfor + endif + if (nargin <4) + trainFunc = "trainlm"; + endif + if (nargin <5) + notUsed = "noSense"; + endif + if (nargin==5) + ## it doesn't matter what nargin 5 is ...! + ## it won't be used ... it's only for matlab compatibility + notUsed = "noSense" + endif + if (nargin <6) + performFunc = "mse"; + endif + + ## check input args + checkInputArgs(Pr,ss); + + ## Standard architecture of neural network + net = __newnetwork(1,nLayers,1,"newff"); + ## description: + ## first argument: number of inputs, nothing else allowed till now + ## it's not the same like the number of neurons in this input + ## second argument: number of layers, including output layer + ## third argument: number of outputs, nothing else allowed till now + ## it's not the same like the number of neurons in this output + + ## set inputs with limit of only ONE input + net.inputs{1}.range = Pr; + [nRows, nColumns] = size(Pr); + net.inputs{1}.size = nRows; + + ## set size of IW + net.IW{1,1} = zeros(1,nRows); + ## set more needed empty cells + for iLayers = 2:nLayers + net.IW{iLayers,1} = []; + # net.IW{2:nLayers,1} = []; # old code + endfor + ## set number of bias, one per layer + for iBiases = 1:nLayers + net.b{iBiases,1} = 0; + endfor + + ## set rest of layers + + ## set size of LayerWeights LW + ## the numbers of rows and columns depends on the + ## number of hidden neurons and output neurons... + ## 2 hidden neurons match 2 columns ... + ## 2 output neurons match 2 rows ... + for i=2:nLayers + net.LW{i,i-1} = zeros(ss(i),ss(i-1)); + endfor + for iLayers = 1:nLayers + net.layers{iLayers}.size = ss(iLayers); + net.layers{iLayers}.transferFcn = transFunc{iLayers}; + endfor + + ## define everything with "targets" + net.numTargets = ss(end); + net.targets = cell(1,nLayers); + for i=1:nLayers + if (i==nLayers) + net.targets{i}.size = ss(end); + ## next row of code is only for MATLAB(TM) compatibility + ## I never used this the last 4 years ... + net.targets{i}.userdata = "Put your custom informations here!"; + else + net.targets{i} = []; + endif + endfor + + ## Performance + net.performFcn = performFunc; + + ## Adaption + for i=1:nLayers +# net.biases{i}.learnFcn = blf; +# net.layerWeights{i,:}.learnFcn = blf; + net.biases{i}.size = ss(i); + endfor + + ## Training + net.trainFcn = trainFunc; # actually, only trainlm will exist + net = setTrainParam(net); + ## Initialization + net = __init(net); + +# ====================================================== +# +# additional check functions... +# +# ====================================================== + function checkInputArgs(Pr,ss) + + ## check if Pr has correct format + if !isreal(Pr) || (size(Pr,2)!=2) + error("Input ranges must be a two column matrix!") + endif + if any(Pr(:,1) > Pr(:,2)) # check if numbers in the second column are larger as in the first one + error("Input ranges has values in the second column larger as in the same row of the first column.") + endif + + ## check if ss has correct format, must be 1xR row vector + if (size(ss,1)!=1) + error("Layer sizes is not a row vector.") + endif + if (size(ss,2)<2) + error("There must be at least one hidden layer and one output layer!") + endif + for k=1:length(ss) + sk = ss(k); + if !isreal(sk) || any(sk<1) || any(round(sk)!=sk) + error("Layer sizes is not a row vector of positive integers.") + endif + endfor + + endfunction +# ====================================================== +# +# additional set functions... +# +# ====================================================== + function net = setTrainParam(net) + + trainFunc = net.trainFcn; + switch(trainFunc) + + case "trainlm" + net.trainParam.epochs = 100; + net.trainParam.goal = 0; + net.trainParam.max_fail = 5; + net.trainParam.mem_reduc = 1; + net.trainParam.min_grad = 1.0000e-010; + net.trainParam.mu = 0.0010; + net.trainParam.mu_dec = 0.1; + net.trainParam.mu_inc = 10; + net.trainParam.mu_max = 1.0000e+010; + net.trainParam.show = 50; + net.trainParam.time = Inf; + otherwise + error("newff:setTrainParam: this train algorithm isn't available till now!") + endswitch + + endfunction +# ======================================================== + + +endfunction + +%!shared +%! disp("testing newff") + +# if input range Pr has only one column +%!test +%! Pr = [1;2]; +%! fail("newff(Pr,[1 1],{'tansig','purelin'},'trainlm','unused','mse')","Input ranges must be a two column matrix!") + +# if input range Pr has two columns +%!test +%! Pr = [1 2 ; 4 6]; +%! assert(__checknetstruct(newff(Pr,[1 1],{'tansig','purelin'},'trainlm','unused','mse'))) + ## __checknetstruct returns TRUE is input arg is a network structure ... + +# if input range Pr has three columns +%!test +%! Pr = [1 2 3; 4 5 6]; +%! fail("newff(Pr,[1 1],{'tansig','purelin'},'trainlm','unused','mse')","Input ranges must be a two column matrix!") + +# if input range has in the second col greater values as in the first col ... +%!test +%! Pr = [5 3; 4 5]; +%! fail("newff(Pr,[1 1],{'tansig','purelin'},'trainlm','unused','mse')",\ +%! "Input ranges has values in the second column larger as in the same row of the first column.") + +# check if ss has correct format +%!test +%! Pr = [1 2 ; 4 6]; +%! fail("newff(Pr,[1 1; 2 3],{'tansig','purelin'},'trainlm','unused','mse')",\ +%! "Layer sizes is not a row vector.") + +# check if ss has correct format +%!test +%! Pr = [1 2 ; 4 6]; +%! assert(__checknetstruct(newff(Pr,[ 2 3],{'tansig','purelin'},'trainlm','unused','mse'))) + +# check if ss has correct format +%!test +%! Pr = [1 2 ; 4 6]; +%! fail("newff(Pr,[1],{'tansig','purelin'},'trainlm','unused','mse')",\ +%! "There must be at least one hidden layer and one output layer!") + +# check if ss has correct format +%!test +%! Pr = [1 2 ; 4 6]; +%! fail("newff(Pr,[-1 1],{'tansig','purelin'},'trainlm','unused','mse')",\ +%! "Layer sizes is not a row vector of positive integers.") diff --git a/octave_packages/nnet-0.1.13/newp.m b/octave_packages/nnet-0.1.13/newp.m new file mode 100644 index 0000000..7fb089d --- /dev/null +++ b/octave_packages/nnet-0.1.13/newp.m @@ -0,0 +1,145 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, write to the Free +## Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301, USA. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{net}} = newp (@var{Pr},@var{ss},@var{transFunc},@var{learnFunc}) +## @code{newp} create a perceptron +## +## @example +## PLEASE DON'T USE THIS FUNCTIONS, IT'S STILL NOT FINISHED! +## ========================================================= +## @end example +## @example +## Pr - R x 2 matrix of min and max values for R input elements +## ss - a scalar value with the number of neurons +## transFunc - a string with the transfer function +## default = "hardlim" +## learnFunc - a string with the learning function +## default = "learnp" +## @end example +## +## +## @end deftypefn + +## @seealso{} + +## Author: Michel D. Schmid + +function net = newp(Pr,ss,transFunc,learnFunc) + + ## initial descriptipn + ## newp(Pr,ss,transFunc,learnFunc) + ## * Pr is a nx2 matrix with min and max values of standardized inputs + ## Pr means: p-range + ## * ss is a scalar value which describes the number of neurons + ## of output neurons + ## * transFunc is the transfer function, standard is "hardlim" + ## * learnFunc is the learning function, standard is "learnp" + + ## check range of input arguments + error(nargchk(1,4,nargin)) + + ## set defaults + if (nargin <2) + ss = 1; # means one neuron + endif + if (nargin <3) + transFunc = "hardlim"; + endif + if (nargin <4) + learnFunc = "learnp"; + endif + + ## check input args + checkInputArgs(Pr,ss); + +# ## get number of layers (without input layer) +# nLayers = length(ss); + + ## Standard architecture of neural network + net = __newnetwork(1,1,1,"newp"); + ## description: + ## first argument: number of inputs, nothing else allowed till now + ## it's not the same like the number of neurons in this input + ## second argument: number of layers, including output layer + ## third argument: number of outputs, nothing else allowed till now + ## it's not the same like the number of neurons in this output + ## fourth argument: network type + + + ## set inputs with limit of only ONE input + net.inputs{1}.range = Pr; + [nRows, nColumns] = size(Pr); + net.inputs{1}.size = nRows; + + ## set size of IW + net.IW{1,1} = zeros(1,nRows); + ## set number of bias, one per layer + net.b{iBiases,1} = 0; + + ## define everything with "layers" + net.numLayers = ss(end); + net.layers = cell(1,1); + net.layers{1}.size = ss(end); + net.layers{1}.transFcn = transFunc; + ## next row of code is only for MATLAB(TM) compatibility + ## I never used this the last 4 years ... + net.targets{i}.userdata = "Put your custom informations here!"; + + ## performance function + net.performFnc = "mae"; + + ## learning + net.biases{1}.learnFcn = learnFunc; + net.inputWeights{1,1}.learnFcn = learnFunc; + + ## adaption + net.adaptFcn = "trains"; + + ## Training + net.trainFcn = "trainc"; + + ## Initialization + net = __init(net); + +# ====================================================== +# +# additional check functions... +# +# ====================================================== + function checkInputArgs(Pr,ss) + + ## check if Pr has correct format + if !isreal(Pr) | (size(Pr,2)!=2) + error("Input ranges must be a two column matrix!") + endif + if any(Pr(:,1) > Pr(:,2)) # check if numbers in the second column are larger as in the first one + error("Input ranges has values in the second column larger as in the same row of the first column.") + endif + + ## check if ss has correct format, must be a scalar value + if ( (size(ss,1)!=1) || (size(ss,2)!=1)) + error("Layer sizes is not a scalar value.") + endif + + endfunction + +# ======================================================== + + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/packinfo/.autoload b/octave_packages/nnet-0.1.13/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/nnet-0.1.13/packinfo/DESCRIPTION b/octave_packages/nnet-0.1.13/packinfo/DESCRIPTION new file mode 100644 index 0000000..66427e2 --- /dev/null +++ b/octave_packages/nnet-0.1.13/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: nnet +Version: 0.1.13 +Date: 2010-12-02 +Author: Michael Schmid +Maintainer: Michael Schmid +Title: Neural Networks +Description: A feed forward multi-layer neural network. +Depends: octave (>= 3.0.0) +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net +Url: http://octnnettb.sourceforge.net diff --git a/octave_packages/nnet-0.1.13/packinfo/INDEX b/octave_packages/nnet-0.1.13/packinfo/INDEX new file mode 100644 index 0000000..9af084a --- /dev/null +++ b/octave_packages/nnet-0.1.13/packinfo/INDEX @@ -0,0 +1,31 @@ +nnet >> Neural Networks + +Creation + newff + +Data preprocessing & postprocessing + mapstd + prestd + poststd + trastd + +Simulation + sim + +Training + train + +Transfer functions + logsig + purelin + radbas + tansig + +Utility + dividerand + ind2vec + isposint + min_max + saveMLPStruct + subset + vec2ind \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/poslin.m b/octave_packages/nnet-0.1.13/poslin.m new file mode 100644 index 0000000..596c74b --- /dev/null +++ b/octave_packages/nnet-0.1.13/poslin.m @@ -0,0 +1,35 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, write to the Free +## Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301, USA. + +## -*- texinfo -*- +## @deftypefn {Function File} {}@var{a}= poslin (@var{n}) +## @code{poslin} is a positive linear transfer function used +## by neural networks +## @end deftypefn + +## Author: Michel D. Schmid + +function a = poslin(n) + + if (n<0) + a = 0; + else + a = n; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/poststd.m b/octave_packages/nnet-0.1.13/poststd.m new file mode 100644 index 0000000..ec4685c --- /dev/null +++ b/octave_packages/nnet-0.1.13/poststd.m @@ -0,0 +1,80 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{Pp},@var{Tt}] = poststd(@var{Pn},@var{meanp},,@var{stdP},@var{Tn},@var{meanT},@var{stdT}) +## @code{poststd} postprocesses the data which has been preprocessed by @code{prestd}. +## @end deftypefn + +## @seealso{prestd,trastd} + +## Author: Michel D. Schmid + +function [Pp,Tt] = poststd(Pn,meanp,stdp,Tn,meant,stdt) + + ## check range of input arguments + error(nargchk(3,6,nargin)) + if (nargin==4) + error("4 input arguments are not allowed!"); + endif + if (nargin==5) + error("5 input arguments are not allowed!"); + endif + + ## do first inputs + ## set all standard deviations which are zero to 1 + [nRowsII, nColumnsII] = size(Pn); + rowZeros = zeros(nRowsII,1); + findZeros = find(stdp==0); + rowZeros(findZeros)=1; + nequal = !rowZeros; + if (sum(rowZeros) != 0) + warning("Some standard deviations are zero. Those inputs won't be transformed."); + meanpZero = meanp.*nequal; + stdpZero = stdp.*nequal + 1*rowZeros; + else + meanpZero = meanp; + stdpZero = stdp; + endif + + ## calculate the postprocessed inputs + nColumnsIIone = ones(1,nColumnsII); + Pp = (stdpZero*nColumnsIIone).*Pn + meanpZero*nColumnsIIone; + + ## do also targets + if ( nargin==6 ) + # now set all standard deviations which are zero to 1 + [nRowsIII, nColumnsIII] = size(stdt); + rowZeros = zeros(nRowsIII,1); + findZeros = find(stdt==0); + rowZeros(findZeros)=1; + nequal = !rowZeros; + if (sum(rowZeros) != 0) + warning("Some standard deviations are zero. Those targets won't be transformed."); + meantZero = meant.*nequal; + stdtZero = stdt.*nequal + 1*rowZeros; + else + meantZero = meant; + stdtZero = stdt; + endif + + ## calculate the postprocessed targets + nColumnsIIIone = ones(1,nColumnsIII); + Tt = (stdtZero*nColumnsIIIone).*Tn + meantZero*nColumnsIIIone; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/prestd.m b/octave_packages/nnet-0.1.13/prestd.m new file mode 100644 index 0000000..325bd87 --- /dev/null +++ b/octave_packages/nnet-0.1.13/prestd.m @@ -0,0 +1,100 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{pn},@var{meanp},@var{stdp},@var{tn},@var{meant},@var{stdt}] =prestd(@var{p},@var{t}) +## @code{prestd} preprocesses the data so that the mean is 0 and the standard deviation is 1. +## @end deftypefn + +## @seealso{trastd} + +## Author: Michel D. Schmid + +function [pn,meanp,stdp,tn,meant,stdt] = prestd(Pp,Tt) + + ## inital description + ## prestd(p,t) + ## * p are the general descriptions for the inputs of + ## neural networks + ## * t is written for "targets" and these are the outputs + ## of a neural network + + ## some more detailed description: + ## for more informations about this + ## formula programmed in this file, see: + ## 1. http://en.wikipedia.org/wiki/Standard_score + ## 2. http://www.statsoft.com/textbook/stathome.html + ## choose "statistical glossary", choose "standardization" + + ## check range of input arguments + error(nargchk(1,2,nargin)) + + ## do first inputs + meanp = mean(Pp')'; + stdp = std(Pp')'; + [nRows,nColumns]=size(Pp); + rowOnes = ones(1,nColumns); + + ## now set all standard deviations which are zero to 1 + [nRowsII, nColumnsII] = size(stdp); + rowZeros = zeros(nRowsII,1); # returning a row containing only zeros + findZeros = find(stdp==0); # returning a vector containing index where zeros are + rowZeros(findZeros)=1; # + nequal = !rowZeros; + if (sum(rowZeros) != 0) + warning("Some standard deviations are zero. Those inputs won't be transformed."); + meanpZero = meanp.*nequal; + stdpZero = stdp.*nequal + 1*rowZeros; + else + meanpZero = meanp; + stdpZero = stdp; + endif + + ## calculate the standardized inputs + pn = (Pp-meanpZero*rowOnes)./(stdpZero*rowOnes); + + ## do also targets + if ( nargin==2 ) + meant = mean(Tt')'; + stdt = std(Tt')'; + + ## now set all standard deviations which are zero to 1 + [nRowsIII, nColumnsIII] = size(stdt); + rowZeros = zeros(nRowsIII,1); + findZeros = find(stdt==0); + rowZeros(findZeros)=1; + nequal = !rowZeros; + if (sum(rowZeros) != 0) + warning("Some standard deviations are zero. Those targets won't be transformed."); + meantZero = meant.*nequal; + stdtZero = stdt.*nequal + 1*rowZeros; + else + meantZero = meant; + stdtZero = stdt; + endif + + ## calculate the standardized targets + tn = (Tt-meantZero*rowOnes)./(stdtZero*rowOnes); + endif +endfunction + + +%!shared Pp, Tt, pn +%! Pp = [1 2 3 4; -1 3 2 -1]; +%! Tt = [3 4 5 6]; +%! [pn,meanp,stdp] = prestd(Pp); +%!assert(pn,[-1.16190 -0.38730 0.38730 1.16190; -0.84887 1.09141 0.60634 -0.84887],0.00001); \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/purelin.m b/octave_packages/nnet-0.1.13/purelin.m new file mode 100644 index 0000000..a1e6e85 --- /dev/null +++ b/octave_packages/nnet-0.1.13/purelin.m @@ -0,0 +1,37 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}@var{a}= purelin (@var{n}) +## @code{purelin} is a linear transfer function used +## by neural networks +## @end deftypefn + +## Author: Michel D. Schmid + +function a = purelin(n) + + a = n; + +endfunction + +%!assert(purelin(2),2); +%!assert(purelin(-2),-2); +%!assert(purelin(0),0); + +%!error # this test must throw an error! +%! assert(purelin(2),1); \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/radbas.m b/octave_packages/nnet-0.1.13/radbas.m new file mode 100644 index 0000000..2810f91 --- /dev/null +++ b/octave_packages/nnet-0.1.13/radbas.m @@ -0,0 +1,39 @@ +## Copyright (C) 2009 Luca Favatella +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} radbas (@var{n}) +## Radial basis transfer function. +## +## @code{radbas(n) = exp(-n^2)} +## +## @end deftypefn + +## Author: Luca Favatella +## Version: 0.1 + +function retval = radbas (n) + + if (nargin != 1) + print_usage (); + else + retval = exp (-n^2); + endif +endfunction + + +%!assert (radbas (3), exp (-3^2)); diff --git a/octave_packages/nnet-0.1.13/satlin.m b/octave_packages/nnet-0.1.13/satlin.m new file mode 100644 index 0000000..385f4a0 --- /dev/null +++ b/octave_packages/nnet-0.1.13/satlin.m @@ -0,0 +1,40 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, write to the Free +## Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301, USA. + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{a} = satlin (@var{n}) +## A neural feed-forward network will be trained with @code{trainlm} +## +## @end deftypefn + +## @seealso{purelin,tansig,logsig} + +## Author: Michel D. Schmid + + +function a = satlin(n) + + if (n<0) + a = 0; + elseif (n>=0 && n<=1) + a = n; + else + a = 1; # if n>1 + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/satlins.m b/octave_packages/nnet-0.1.13/satlins.m new file mode 100644 index 0000000..065a606 --- /dev/null +++ b/octave_packages/nnet-0.1.13/satlins.m @@ -0,0 +1,40 @@ +## Copyright (C) 2007 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, write to the Free +## Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301, USA. + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{a} = satlins (@var{n}) +## A neural feed-forward network will be trained with @code{trainlm} +## +## @end deftypefn + +## @seealso{purelin,tansig,logsig,satlin,hardlim,hardlims} + +## Author: Michel D. Schmid + + +function a = satlins(n) + + if (n<-1) + a = -1; + elseif (n>=-1 && n<=1) + a = n; + else + a = 1; # if n>1 + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/saveMLPStruct.m b/octave_packages/nnet-0.1.13/saveMLPStruct.m new file mode 100644 index 0000000..0f661f9 --- /dev/null +++ b/octave_packages/nnet-0.1.13/saveMLPStruct.m @@ -0,0 +1,187 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} saveMLPStruct (@var{net},@var{strFileName}) +## @code{saveStruct} saves a neural network structure to *.txt files +## @end deftypefn + +## Author: Michel D. Schmid + +function saveMLPStruct(net,strFileName) + + ## the variable net holds the neural network structure.. + # check if "net" is a structure type + if !__checknetstruct(net) + error("Structure doesn't seem to be a neural network") + endif + + # open the first level file + fid1 = fopen(strFileName,"w+t","ieee-le"); + + if (fid1 < 0) + error ("Can not open %s", strFileName); + endif + + ## print header +# try ## wird nicht mehr benötigt.. + __printMLPHeader(fid1); +# catch +# ## Add saveMLPStructure directory to the path and try again +# addpath ([fileparts(mfilename()),"/saveMLPStructure"]); +# __printMLPHeader(fid1); +# end_try_catch + + ## check for field "networkType" + __printNetworkType(fid1,net); + + ## check for field "numInputs" + __printNumInputs(fid1,net); + + ## check for field "numLayers" + __printNumLayers(fid1,net) + + ## check for field "biasConnect" + __printBiasConnect(fid1,net) + + ## check for field "inputConnect" + __printInputConnect(fid1,net) + + ## check for field "layerConnect" + __printLayerConnect(fid1,net) + + ## check for field "outputConnect" + __printOutputConnect(fid1,net) + + ## check for field "targetConnect" + __printTargetConnect(fid1,net) + + ## print one empty line + fprintf(fid1,"\n"); + + ## check for numOutputs + __printNumOutputs(fid1,net); + + ## check for numTargets + __printNumTargets(fid1,net); + + ## check for numInputDelays + __printNumInputDelays(fid1,net); + + ## check for numLayerDelays + __printNumLayerDelays(fid1,net); + + ## print one empty line + fprintf(fid1,"\n"); + + ## print subobject structures: + fprintf(fid1," subobject structures:\n"); + + ## print one empty line + fprintf(fid1,"\n"); + + ## print inputs + __printInputs(fid1,net); + + ## print layers + __printLayers(fid1,net); + + ## print outputs + __printOutputs(fid1,net); + + ## print targets + __printTargets(fid1,net); + + ## print biases + __printBiases(fid1,net); + + ## print inputweights + __printInputWeights(fid1,net); + + ## print layerweights + __printLayerWeights(fid1,net); + + ## print one empty line + fprintf(fid1,"\n"); + + ## print subobject structures: + fprintf(fid1," functions:\n"); + + ## print one empty line + fprintf(fid1,"\n"); + + ## print adaptFcn + __printAdaptFcn(fid1,net); + + ## print initFcn + __printInitFcn(fid1,net); + + ## print performFcn + __printPerformFcn(fid1,net); + + ## print performFcn + __printTrainFcn(fid1,net); + + ## print one empty line + fprintf(fid1,"\n"); + + ## print subobject structures: + fprintf(fid1," parameters:\n"); + + ## print one empty line + fprintf(fid1,"\n"); + + ## print adaptParam + __printAdaptParam(fid1,net); + + ## print initParam + __printInitParam(fid1,net); + + ## print performParam + __printPerformParam(fid1,net); + + ## print trainParam + __printTrainParam(fid1,net); + + ## print one empty line + fprintf(fid1,"\n"); + + ## print subobject structures: + fprintf(fid1," weight & bias values:\n"); + + ## print one empty line + fprintf(fid1,"\n"); + + ## print IW + __printIW(fid1,net); + + ## print LW + __printLW(fid1,net); + + ## print b + __printB(fid1,net); + + ## print one empty line + fprintf(fid1,"\n"); + + ## print subobject structures: + fprintf(fid1," other:\n"); + + + fclose(fid1); + +endfunction diff --git a/octave_packages/nnet-0.1.13/sim.m b/octave_packages/nnet-0.1.13/sim.m new file mode 100644 index 0000000..1c637f3 --- /dev/null +++ b/octave_packages/nnet-0.1.13/sim.m @@ -0,0 +1,84 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{netoutput} =} sim (@var{net}, @var{mInput}) +## @code{sim} is usuable to simulate a before defined neural network. +## @code{net} is created with newff(@dots{}) and @var{mInput} should be the +## corresponding input data set! +## @end deftypefn + +## Author: Michel D. Schmid + + +## Comments: see in "A neural network toolbox for Octave User's Guide" [4] +## for variable naming... there have inputs or targets only one letter, +## e.g. for inputs is written P. To write a program, this is stupid, you can't +## search for 1 letter variable... that's why it is written here like Pp, or Tt +## instead only P or T. + +function [netoutput] = sim(net,mInput) + + ## check range of input arguments + error(nargchk(2,2,nargin)) + + ## check input args + ## check "net", must be a net structure + if !__checknetstruct(net) + error("Structure doesn't seem to be a neural network") + endif + ## check "mInput", must have defined size + [nRows, nColumns] = size(mInput); + if (nRows != net.inputs{1}.size) + error(["Simulation input data must have: " num2str(net.inputs{1}.size) " rows."]) + endif + + ## first get weights... + IW = net.IW{1}; + b1 = net.b{1}; + b1 = repmat(b1,1,size(mInput,2)); + nLoops = net.numLayers; + for i=1:nLoops + + trf = net.layers{i}.transferFcn; + ## calculate the outputs for each layer from input to output + + if i==1 + Nn{i,1} = IW*mInput + b1; + else + LWx = net.LW{i,i-1}; + bx = net.b{i}; + bx = repmat(bx,1,size(Aa{i-1,1},2)); + Nn{i,1} = LWx*Aa{i-1,1} + bx; + endif + + switch(trf) + case "tansig" + Aa{i,1} = tansig(Nn{i,1}); + case "purelin" + Aa{i,1} = purelin(Nn{i,1}); + case "logsig" + Aa{i,1} = logsig(Nn{i,1}); + otherwise + error(["sim:Unknown transfer fucntion: " trf "!"]); + endswitch + endfor + + netoutput = Aa{i,1}; + +endfunction + diff --git a/octave_packages/nnet-0.1.13/subset.m b/octave_packages/nnet-0.1.13/subset.m new file mode 100644 index 0000000..1558efc --- /dev/null +++ b/octave_packages/nnet-0.1.13/subset.m @@ -0,0 +1,212 @@ +## Copyright (C) 2008 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{mTrain}, @var{mTest}, @var{mVali}] = subset (@var{mData},@var{nTargets},@var{iOpti},@var{fTest},@var{fVali}) +## @code{subset} splits the main data matrix which contains inputs and targets into 2 or 3 subsets +## depending on the parameters. +## +## The first parameter @var{mData} must be in row order. This means if the network +## contains three inputs, the matrix must be have 3 rows and x columns to define the +## data for the inputs. And some more rows for the outputs (targets), e.g. a neural network +## with three inputs and two outputs must have 5 rows with x columns! +## The second parameter @var{nTargets} defines the number or rows which contains the target values! +## The third argument @code{iOpti} is optional and can have three status: +## 0: no optimization +## 1: will randomise the column order and order the columns containing min and max values to be in the train set +## 2: will NOT randomise the column order, but order the columns containing min and max values to be in the train set +## default value is @code{1} +## The fourth argument @code{fTest} is also optional and defines how +## much data sets will be in the test set. Default value is @code{1/3} +## The fifth parameter @code{fTrain} is also optional and defines how +## much data sets will be in the train set. Default value is @code{1/6} +## So we have 50% of all data sets which are for training with the default values. +## +## @example +## [mTrain, mTest] = subset(mData,1) +## returns three subsets of the complete matrix +## with randomized and optimized columns! +## @end example +## @example +## [mTrain, mTest] = subset(mData,1,) +## returns two subsets +## @end example +## +## @end deftypefn + +## Author: Michel D. Schmid + + +function [mTrain, mTest, mVali] = subset(mData,nTargets,iOpti,fTest,fVali) + + ## check range of input arguments + error(nargchk(2,5,nargin)) + + ## check the input arguments ...! + if (nTargets==0) + error("No TARGETS defined! This doesn't make any sense for feed-forward neural networks! Please define at least one row of targets") + endif + + ## set default values + if (nargin==2) + iOpti = 1; + fTest = 1/3; + fVali = 1/6; + elseif (nargin==3) + fTest = 1/3; + fVali = 1/6; + elseif (nargin==4) + ## if fTest is set and nothing is set + ## for fVali I assume that fVali is not used! + fVali = 0; + endif + + ## calculate the number of train, test and validation sets + fTrain = 1-fTest-fVali; + nTrainSets = floor(size(mData,2)*fTrain); + diffRestSets = size(mData,2)-nTrainSets; + nTestSets = floor(size(mData,2)*fTest); + nValiSets = size(mData,2)-nTrainSets-nTestSets; + + + ## now let's see if matrix must be optimized! + bOptiAgain = 1; + while (bOptiAgain) + if (iOpti == 1) + # check that only one optimizing run is enough!! + # maybe it's necessary to do it twice ..! + # check that all min and max values are in the train set ...! + mData = __optimizedatasets(mData,nTrainSets,nTargets,iOpti); + mTrain = mData(:,1:nTrainSets); + iRuns = size(mTrain,1); + i = 1; + j = 1; + while (i < iRuns) + if ( max(mTrain(i,:)) == max(mData(i,:)) ) + j += 1; + endif + i +=1; + endwhile + if (i==j) + bOptiAgain = 0; + endif + elseif (iOpti == 2) + # check that only one optimizing run is enough!! + # maybe it's necessary to do it twice ..! + # check that all min and max values are in the train set ...! + mData = __optimizedatasets(mData,nTrainSets,nTargets,iOpti); + mTrain = mData(:,1:nTrainSets); + iRuns = size(mTrain,1); + j = 1; + i = 1; + while (i < iRuns) + if (max(mTrain(i,:))==max(mData(i,:))) + j += 1; + endif + i += 1; + endwhile + if (i==j) + bOptiAgain = 0; + endif + else + ## in this case, iOpti must be 0 ==> nothing todo + bOptiAgain = 0; + endif + endwhile #END OF while(bOptiAgain) + + ## now split up + if (nargout==1) + mTrain = mData; + elseif (nargout==2); + mTrain = mData(:,1:nTrainSets); + mTest = mData(:,nTrainSets+1:nTrainSets+nTestSets); + elseif (nargout==3) + mTrain = mData(:,1:nTrainSets); + mTest = mData(:,nTrainSets+1:nTrainSets+nTestSets); + mVali = mData(:,nTrainSets+nTestSets+1:end); + endif + +endfunction + +%!shared matrix, nTargets, mTrain, mTest, mVali +%! disp("testing subset") +%! matrix = [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 18 20; \ +%! 0 2 4 1 3 5 3 4 1 -1 -2 -9 -1 10 12 20 11 11 11 11; \ +%! -2 2 2 2 2 0 0 0 0 0 10 12 13 12 13 44 33 32 98 11; \ +%! 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 1 0 0; \ +%! 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4; \ +%! 1 2 3 4 5 6 7 8 9 10 11 12 13 33 44 55 66 77 88 99]; +%! nTargets = 1; # the last row is equivalent to the target values. +%! [mTrain, mTest, mVali] = subset(matrix,nTargets); ############################ +%!assert(size(mTrain,2)==10);# 50% of 20 +%!assert(size(mTest,2)==6);# 1/3 of 20 = 6 (floor) +%!assert(size(mVali,2)==4);# 1/6 of 20 = 4 (floor) +%! # It's not possible to test the column order with this call! +%! # randomizing is used! But all max and min values should be +%! # in the training set +%!assert(max(mTrain(1,:))==max(matrix(1,:))); +%!assert(min(mTrain(1,:))==min(matrix(1,:))); +%!assert(max(mTrain(2,:))==max(matrix(2,:))); +%!assert(min(mTrain(2,:))==min(matrix(2,:))); +%!assert(max(mTrain(3,:))==max(matrix(3,:))); +%!assert(min(mTrain(3,:))==min(matrix(3,:))); +%!assert(max(mTrain(4,:))==max(matrix(4,:))); +%!assert(min(mTrain(4,:))==min(matrix(4,:))); +%! +%! +%! [mTrain, mTest, mVali] = subset(matrix,nTargets,0); ############################ +%!assert(size(mTrain,2)==10);# 50% of 20 +%!assert(size(mTest,2)==6);# 1/3 of 20 = 6 (floor) +%!assert(size(mVali,2)==4);# 1/6 of 20 = 4 (floor) +%!assert(mTrain==matrix(:,1:10)); +%!assert(mTest==matrix(:,11:16)); +%!assert(mVali==matrix(:,17:20)); +%! +%! +%! [mTrain, mTest, mVali] = subset(matrix,nTargets,2); ############################ +%!assert(size(mTrain,2)==10);# 50% of 20 +%!assert(size(mTest,2)==6);# 1/3 of 20 = 6 (floor) +%!assert(size(mVali,2)==4);# 1/6 of 20 = 4 (floor) +%!assert(max(mTrain(1,:))==max(matrix(1,:))); +%!assert(min(mTrain(1,:))==min(matrix(1,:))); +%!assert(max(mTrain(2,:))==max(matrix(2,:))); +%!assert(min(mTrain(2,:))==min(matrix(2,:))); +%!assert(max(mTrain(3,:))==max(matrix(3,:))); +%!assert(min(mTrain(3,:))==min(matrix(3,:))); +%!assert(max(mTrain(4,:))==max(matrix(4,:))); +%!assert(min(mTrain(4,:))==min(matrix(4,:))); +%! +%! +%! ## next test ... optimize twice +%! matrix = [1 2 3 4 5 6 7 20 8 10 11 12 13 14 15 16 17 18 18 9; \ +%! 0 2 4 1 3 5 3 4 1 -1 -2 -9 -1 10 12 20 11 11 11 11; \ +%! -2 2 2 2 2 0 0 0 0 0 10 12 13 12 13 44 33 32 98 11; \ +%! 0 0 0 0 1 1 1 1 0 0 1 1 1 0 0 1 1 1 0 0; \ +%! 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4; \ +%! 1 2 3 4 5 6 7 8 9 10 11 12 13 33 44 55 66 77 88 99]; +%! [mTrain, mTest, mVali] = subset(matrix,nTargets,2); ############################ +%!assert(max(mTrain(1,:))==max(matrix(1,:))); +%!assert(min(mTrain(1,:))==min(matrix(1,:))); +%!assert(max(mTrain(2,:))==max(matrix(2,:))); +%!assert(min(mTrain(2,:))==min(matrix(2,:))); +%!assert(max(mTrain(3,:))==max(matrix(3,:))); +%!assert(min(mTrain(3,:))==min(matrix(3,:))); +%!assert(max(mTrain(4,:))==max(matrix(4,:))); +%!assert(min(mTrain(4,:))==min(matrix(4,:))); + +## \todo, a lot of tests to be sure, everything is working OK!! +## all combinations of arguments must be testet! diff --git a/octave_packages/nnet-0.1.13/tansig.m b/octave_packages/nnet-0.1.13/tansig.m new file mode 100644 index 0000000..3f14d42 --- /dev/null +++ b/octave_packages/nnet-0.1.13/tansig.m @@ -0,0 +1,41 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}@var{a} = tansig (@var{n}) +## @code{tansig} is a non-linear transfer function used to train +## neural networks. +## This function can be used in newff(...) to create a new feed forward +## multi-layer neural network. +## +## @end deftypefn + +## @seealso{purelin, logsig} + +## Author: Michel D. Schmid + + +function a = tansig(n) + + ## see MATLAB(TM) online help + a = 2 ./ (1 + exp(-2*n)) - 1; + ## attention with critical values ==> infinite values + ## must be set to 1 + i = find(!finite(a)); + a(i) = sign(n(i)); + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/train.m b/octave_packages/nnet-0.1.13/train.m new file mode 100644 index 0000000..c7a069d --- /dev/null +++ b/octave_packages/nnet-0.1.13/train.m @@ -0,0 +1,217 @@ +## Copyright (C) 2006 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}[@var{net}] = train (@var{MLPnet},@var{mInputN},@var{mOutput},@var{[]},@var{[]},@var{VV}) +## A neural feed-forward network will be trained with @code{train} +## +## @example +## [net,tr,out,E] = train(MLPnet,mInputN,mOutput,[],[],VV); +## @end example +## @noindent +## +## @example +## left side arguments: +## net: the trained network of the net structure @code{MLPnet} +## @end example +## @noindent +## +## @example +## right side arguments: +## MLPnet : the untrained network, created with @code{newff} +## mInputN: normalized input matrix +## mOutput: output matrix (normalized or not) +## [] : unused parameter +## [] : unused parameter +## VV : validize structure +## @end example +## @end deftypefn + +## @seealso{newff,prestd,trastd} + +## Author: Michel D. Schmid + +## Comments: see in "A neural network toolbox for Octave User's Guide" [4] +## for variable naming... there have inputs or targets only one letter, +## e.g. for inputs is P written. To write a program, this is stupid, you can't +## search for 1 letter variable... that's why it is written here like Pp, or Tt +## instead only P or T. + +function [net] = train(net,Pp,Tt,notUsed1,notUsed2,VV) + + ## check range of input arguments + error(nargchk(3,6,nargin)) + + ## set defaults + doValidation = 0; + if nargin==6 + # doValidation=1; + ## check if VV is in MATLAB(TM) notation + [VV, doValidation] = checkVV(VV); + endif + + ## check input args + checkInputArgs(net,Pp,Tt) + + ## nargin ... + switch(nargin) + case 3 + [Pp,Tt] = trainArgs(net,Pp,Tt); + VV = []; + case 6 + [Pp,Tt] = trainArgs(net,Pp,Tt); + if isempty(VV) + VV = []; + else + if !isfield(VV,"Pp") + error("VV.Pp must be defined or VV must be [].") + endif + if !isfield(VV,"Tt") + error("VV.Tt must be defined or VV must be [].") + endif + [VV.Pp,VV.Tt] = trainArgs(net,VV.Pp,VV.Tt); + endif + otherwise + error("train: impossible code execution in switch(nargin)") + endswitch + + + ## so now, let's start training the network + ##=========================================== + + ## first let's check if a train function is defined ... + if isempty(net.trainFcn) + error("train:net.trainFcn not defined") + endif + + ## calculate input matrix Im + [nRowsInputs, nColumnsInputs] = size(Pp); + Im = ones(nRowsInputs,nColumnsInputs).*Pp{1,1}; + + if (doValidation) + [nRowsVal, nColumnsVal] = size(VV.Pp); + VV.Im = ones(nRowsVal,nColumnsVal).*VV.Pp{1,1}; + endif + + ## make it MATLAB(TM) compatible + nLayers = net.numLayers; + Tt{nLayers,1} = Tt{1,1}; + Tt{1,1} = []; + if (!isempty(VV)) + VV.Tt{nLayers,1} = VV.Tt{1,1}; + VV.Tt{1,1} = []; + endif + + ## which training algorithm should be used + switch(net.trainFcn) + case "trainlm" + if !strcmp(net.performFcn,"mse") + error("Levenberg-Marquardt algorithm is defined with the MSE performance function, so please set MSE in NEWFF!") + endif + net = __trainlm(net,Im,Pp,Tt,VV); + otherwise + error("train algorithm argument is not valid!") + endswitch + + +# ======================================================= +# +# additional check functions... +# +# ======================================================= + + function checkInputArgs(net,Pp,Tt) + + ## check "net", must be a net structure + if !__checknetstruct(net) + error("Structure doesn't seem to be a neural network!") + endif + + ## check Pp (inputs) + nInputSize = net.inputs{1}.size; #only one exists + [nRowsPp, nColumnsPp] = size(Pp); + if ( (nColumnsPp>0) ) + if ( nInputSize==nRowsPp ) + # seems to be everything i.o. + else + error("Number of rows must be the same, like in net.inputs.size defined!") + endif + else + error("At least one column must exist") + endif + + ## check Tt (targets) + [nRowsTt, nColumnsTt] = size(Tt); + if ( (nRowsTt | nColumnsTt)==0 ) + error("No targets defined!") + elseif ( nColumnsTt!=nColumnsPp ) + error("Inputs and targets must have the same number of data sets (columns).") + elseif ( net.layers{net.numLayers}.size!=nRowsTt ) + error("Defined number of output neurons are not identically to targets data sets!") + endif + + endfunction +# ------------------------------------------------------- + function [Pp,Tt] = trainArgs(net,Pp,Tt); + + ## check number of arguments + error(nargchk(3,3,nargin)); + + [PpRows, PpColumns] = size(Pp); + Pp = mat2cell(Pp,PpRows,PpColumns); # mat2cell is the reason + # why octave-2.9.5 doesn't work + # octave-2.9.x with x>=6 should be + # ok + [TtRows, TtColumns] = size(Tt); + Tt = mat2cell(Tt,TtRows,TtColumns); + + endfunction + +# ------------------------------------------------------- + + function [VV, doValidation] = checkVV(VV) + + ## check number of arguments + error(nargchk(1,1,nargin)); + + if (isempty(VV)) + doValidation = 0; + else + doValidation = 1; + ## check if MATLAB(TM) naming convention is used + if isfield(VV,"P") + VV.Pp = VV.P; + VV.P = []; + elseif !isfield(VV,"Pp") + error("VV is defined but inside exist no VV.P or VV.Pp") + endif + + if isfield(VV,"T") + VV.Tt = VV.T; + VV.T = []; + elseif !isfield(VV,"Tt") + error("VV is defined but inside exist no VV.TP or VV.Tt") + endif + + endif + + + endfunction + +# ============================================================ + +endfunction \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/trastd.m b/octave_packages/nnet-0.1.13/trastd.m new file mode 100644 index 0000000..d4e0a2e --- /dev/null +++ b/octave_packages/nnet-0.1.13/trastd.m @@ -0,0 +1,91 @@ +## Copyright (C) 2005 Michel D. Schmid +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {}@var{pn} = trastd (@var{p},@var{meanp},@var{stdp}) +## @code{trastd} preprocess additional data for neural network simulation. +## +## @example +## @code{p} : test input data +## @code{meanp}: vector with standardization parameters of prestd(...) +## @code{stdp} : vector with standardization parameters of prestd(...) +## +## meanp = [2.5; 6.5]; +## stdp = [1.2910; 1.2910]; +## p = [1 4; 2 5]; +## +## pn = trastd(p,meanp,stdp); +## @end example +## @noindent +## @end deftypefn + +## @seealso{prestd, poststd} + +## Author: Michel D. Schmid + +function [Pn] = trastd(Pp,meanp,stdp) + + ## check number of inputs + error(nargchk(3,3,nargin)); + + + [nRows,nColumns]=size(Pp); + rowOnes = ones(1,nColumns); + + ## now set all standard deviations which are zero to 1 + [nRowsII, nColumnsII] = size(stdp); + rowZeros = zeros(nRowsII,1); + findZeros = find(stdp==0); + rowZeros(findZeros)=1; + equal = rowZeros; + nequal = !equal; + if ( sum(equal) != 0 ) + warning("Some standard deviations are zero. Those inputs won't be transformed."); + meanp = meanp.*nequal; + stdp = stdp.*nequal + 1*equal; + end + + Pn = (Pp-meanp*rowOnes)./(stdp*rowOnes); + +endfunction + +## +## >> mInput = [1 2 3 4; 5 6 7 8] +## +## mInput = +## +## 1 2 3 4 +## 5 6 7 8 +## +## >> [pn,meanp,stdp] = prestd(mInput) +## +## pn = +## +## -1.1619 -0.3873 0.3873 1.1619 +## -1.1619 -0.3873 0.3873 1.1619 +## +## +## meanp = +## +## 2.5000 +## 6.5000 +## +## +## stdp = +## +## 1.2910 +## 1.2910 \ No newline at end of file diff --git a/octave_packages/nnet-0.1.13/vec2ind.m b/octave_packages/nnet-0.1.13/vec2ind.m new file mode 100644 index 0000000..ac6f377 --- /dev/null +++ b/octave_packages/nnet-0.1.13/vec2ind.m @@ -0,0 +1,44 @@ +## Copyright (C) 2009 Luiz Angelo Daros de Luca +## +## +## 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, or (at your option) +## any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{ind}} = vec2ind (@var{vector}) +## @code{vec2ind} convert vectors to indices +## +## +## @example +## EXAMPLE 1 +## vec = [1 2 3; 4 5 6; 7 8 9]; +## +## ind = vec2ind(vec) +## The prompt output will be: +## ans = +## 1 2 3 1 2 3 1 2 3 +## @end example +## +## @end deftypefn + +## @seealso{ind2vec} + + +function [ind]=vec2ind(vector) + # Convert vectors to indices + # + # + [ind,col,vals] = find(vector); + ind=ind'; +endfunction diff --git a/octave_packages/nurbs-1.3.6/basisfun.m b/octave_packages/nurbs-1.3.6/basisfun.m new file mode 100644 index 0000000..281b48a --- /dev/null +++ b/octave_packages/nurbs-1.3.6/basisfun.m @@ -0,0 +1,87 @@ +function B = basisfun (iv, uv, p, U) + +% BASISFUN: Basis function for B-Spline +% +% Calling Sequence: +% +% N = basisfun(iv,uv,p,U) +% +% INPUT: +% +% iv - knot span ( from FindSpan() ) +% uv - parametric points +% p - spline degree +% U - knot sequence +% +% OUTPUT: +% +% N - Basis functions vector(numel(uv)*(p+1)) +% +% Adapted from Algorithm A2.2 from 'The NURBS BOOK' pg70. +% +% Copyright (C) 2000 Mark Spink +% Copyright (C) 2007 Daniel Claxton +% Copyright (C) 2009 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 . + +B = zeros(numel(uv), p+1); + +for jj = 1:numel(uv) + + i = iv(jj) + 1; %% findspan uses 0-based numbering + u = uv(jj); + + left = zeros(p+1,1); + right = zeros(p+1,1); + + N(1) = 1; + for j=1:p + left(j+1) = u - U(i+1-j); + right(j+1) = U(i+j) - u; + saved = 0; + + for r=0:j-1 + temp = N(r+1)/(right(r+2) + left(j-r+1)); + N(r+1) = saved + right(r+2)*temp; + saved = left(j-r+1)*temp; + end + + N(j+1) = saved; + end + + B (jj, :) = N; + +end + +end + +%!test +%! n = 3; +%! U = [0 0 0 1/2 1 1 1]; +%! p = 2; +%! u = linspace (0, 1, 10); +%! s = findspan (n, p, u, U); +%! Bref = [1.00000 0.00000 0.00000 +%! 0.60494 0.37037 0.02469 +%! 0.30864 0.59259 0.09877 +%! 0.11111 0.66667 0.22222 +%! 0.01235 0.59259 0.39506 +%! 0.39506 0.59259 0.01235 +%! 0.22222 0.66667 0.11111 +%! 0.09877 0.59259 0.30864 +%! 0.02469 0.37037 0.60494 +%! 0.00000 0.00000 1.00000]; +%! B = basisfun (s, u, p, U); +%! assert (B, Bref, 1e-5); diff --git a/octave_packages/nurbs-1.3.6/basisfunder.m b/octave_packages/nurbs-1.3.6/basisfunder.m new file mode 100644 index 0000000..c6f0a89 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/basisfunder.m @@ -0,0 +1,151 @@ +function dersv = basisfunder (ii, pl, uu, u_knotl, nders) + +% BASISFUNDER: B-Spline Basis function derivatives. +% +% Calling Sequence: +% +% ders = basisfunder (ii, pl, uu, k, nd) +% +% INPUT: +% +% ii - knot span index (see findspan) +% pl - degree of curve +% uu - parametric points +% k - knot vector +% nd - number of derivatives to compute +% +% OUTPUT: +% +% ders - ders(n, i, :) (i-1)-th derivative at n-th point +% +% Adapted from Algorithm A2.3 from 'The NURBS BOOK' pg72. +% +% Copyright (C) 2009,2011 Rafael Vazquez +% +% 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 . + + dersv = zeros(numel(uu), nders+1, pl+1); + + for jj = 1:numel(uu) + + i = ii(jj)+1; %% convert to base-1 numbering of knot spans + u = uu(jj); + + ders = zeros(nders+1,pl+1); + ndu = zeros(pl+1,pl+1); + left = zeros(pl+1); + right = zeros(pl+1); + a = zeros(2,pl+1); + ndu(1,1) = 1; + for j = 1:pl + left(j+1) = u - u_knotl(i+1-j); + right(j+1) = u_knotl(i+j) - u; + saved = 0; + for r = 0:j-1 + ndu(j+1,r+1) = right(r+2) + left(j-r+1); + temp = ndu(r+1,j)/ndu(j+1,r+1); + ndu(r+1,j+1) = saved + right(r+2)*temp; + saved = left(j-r+1)*temp; + end + ndu(j+1,j+1) = saved; + end + for j = 0:pl + ders(1,j+1) = ndu(j+1,pl+1); + end + for r = 0:pl + s1 = 0; + s2 = 1; + a(1,1) = 1; + for k = 1:nders %compute kth derivative + d = 0; + rk = r-k; + pk = pl-k; + if (r >= k) + a(s2+1,1) = a(s1+1,1)/ndu(pk+2,rk+1); + d = a(s2+1,1)*ndu(rk+1,pk+1); + end + if (rk >= -1) + j1 = 1; + else + j1 = -rk; + end + if ((r-1) <= pk) + j2 = k-1; + else + j2 = pl-r; + end + for j = j1:j2 + a(s2+1,j+1) = (a(s1+1,j+1) - a(s1+1,j))/ndu(pk+2,rk+j+1); + d = d + a(s2+1,j+1)*ndu(rk+j+1,pk+1); + end + if (r <= pk) + a(s2+1,k+1) = -a(s1+1,k)/ndu(pk+2,r+1); + d = d + a(s2+1,k+1)*ndu(r+1,pk+1); + end + ders(k+1,r+1) = d; + j = s1; + s1 = s2; + s2 = j; + end + end + r = pl; + for k = 1:nders + for j = 0:pl + ders(k+1,j+1) = ders(k+1,j+1)*r; + end + r = r*(pl-k); + end + + dersv(jj, :, :) = ders; + + end + +end + +%!test +%! k = [0 0 0 0 1 1 1 1]; +%! p = 3; +%! u = rand (1); +%! i = findspan (numel(k)-p-2, p, u, k); +%! ders = basisfunder (i, p, u, k, 1); +%! sumders = sum (squeeze(ders), 2); +%! assert (sumders(1), 1, 1e-15); +%! assert (sumders(2:end), 0, 1e-15); + +%!test +%! k = [0 0 0 0 1/3 2/3 1 1 1 1]; +%! p = 3; +%! u = rand (1); +%! i = findspan (numel(k)-p-2, p, u, k); +%! ders = basisfunder (i, p, u, k, 7); +%! sumders = sum (squeeze(ders), 2); +%! assert (sumders(1), 1, 1e-15); +%! assert (sumders(2:end), zeros(rows(squeeze(ders))-1, 1), 1e-13); + +%!test +%! k = [0 0 0 0 1/3 2/3 1 1 1 1]; +%! p = 3; +%! u = rand (100, 1); +%! i = findspan (numel(k)-p-2, p, u, k); +%! ders = basisfunder (i, p, u, k, 7); +%! for ii=1:10 +%! sumders = sum (squeeze(ders(ii,:,:)), 2); +%! assert (sumders(1), 1, 1e-15); +%! assert (sumders(2:end), zeros(rows(squeeze(ders(ii,:,:)))-1, 1), 1e-13); +%! end +%! assert (ders(:, (p+2):end, :), zeros(numel(u), 8-p-1, p+1), 1e-13) +%! assert (all(all(ders(:, 1, :) <= 1)), true) + + + diff --git a/octave_packages/nurbs-1.3.6/bspdegelev.m b/octave_packages/nurbs-1.3.6/bspdegelev.m new file mode 100644 index 0000000..5c68c0b --- /dev/null +++ b/octave_packages/nurbs-1.3.6/bspdegelev.m @@ -0,0 +1,296 @@ +function [ic,ik] = bspdegelev(d,c,k,t) + +% BSPDEGELEV: Degree elevate a univariate B-Spline. +% +% Calling Sequence: +% +% [ic,ik] = bspdegelev(d,c,k,t) +% +% INPUT: +% +% d - Degree of the B-Spline. +% c - Control points, matrix of size (dim,nc). +% k - Knot sequence, row vector of size nk. +% t - Raise the B-Spline degree t times. +% +% OUTPUT: +% +% ic - Control points of the new B-Spline. +% ik - Knot vector of the new B-Spline. +% +% Copyright (C) 2000 Mark Spink, 2007 Daniel Claxton +% +% 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 . + +[mc,nc] = size(c); + % + % int bspdegelev(int d, double *c, int mc, int nc, double *k, int nk, + % int t, int *nh, double *ic, double *ik) + % { + % int row,col; + % + % int ierr = 0; + % int i, j, q, s, m, ph, ph2, mpi, mh, r, a, b, cind, oldr, mul; + % int n, lbz, rbz, save, tr, kj, first, kind, last, bet, ii; + % double inv, ua, ub, numer, den, alf, gam; + % double **bezalfs, **bpts, **ebpts, **Nextbpts, *alfs; + % + % double **ctrl = vec2mat(c, mc, nc); +% ic = zeros(mc,nc*(t)); % double **ictrl = vec2mat(ic, mc, nc*(t+1)); + % +n = nc - 1; % n = nc - 1; + % +bezalfs = zeros(d+1,d+t+1); % bezalfs = matrix(d+1,d+t+1); +bpts = zeros(mc,d+1); % bpts = matrix(mc,d+1); +ebpts = zeros(mc,d+t+1); % ebpts = matrix(mc,d+t+1); +Nextbpts = zeros(mc,d+1); % Nextbpts = matrix(mc,d+1); +alfs = zeros(d,1); % alfs = (double *) mxMalloc(d*sizeof(double)); + % +m = n + d + 1; % m = n + d + 1; +ph = d + t; % ph = d + t; +ph2 = floor(ph / 2); % ph2 = ph / 2; + % + % // compute bezier degree elevation coefficeients +bezalfs(1,1) = 1; % bezalfs[0][0] = bezalfs[ph][d] = 1.0; +bezalfs(d+1,ph+1) = 1; % + +for i=1:ph2 % for (i = 1; i <= ph2; i++) { + inv = 1/bincoeff(ph,i); % inv = 1.0 / bincoeff(ph,i); + mpi = min(d,i); % mpi = min(d,i); + % + for j=max(0,i-t):mpi % for (j = max(0,i-t); j <= mpi; j++) + bezalfs(j+1,i+1) = inv*bincoeff(d,j)*bincoeff(t,i-j); % bezalfs[i][j] = inv * bincoeff(d,j) * bincoeff(t,i-j); + end +end % } + % +for i=ph2+1:ph-1 % for (i = ph2+1; i <= ph-1; i++) { + mpi = min(d,i); % mpi = min(d, i); + for j=max(0,i-t):mpi % for (j = max(0,i-t); j <= mpi; j++) + bezalfs(j+1,i+1) = bezalfs(d-j+1,ph-i+1); % bezalfs[i][j] = bezalfs[ph-i][d-j]; + end +end % } + % +mh = ph; % mh = ph; +kind = ph+1; % kind = ph+1; +r = -1; % r = -1; +a = d; % a = d; +b = d+1; % b = d+1; +cind = 1; % cind = 1; +ua = k(1); % ua = k[0]; + % +for ii=0:mc-1 % for (ii = 0; ii < mc; ii++) + ic(ii+1,1) = c(ii+1,1); % ictrl[0][ii] = ctrl[0][ii]; +end % +for i=0:ph % for (i = 0; i <= ph; i++) + ik(i+1) = ua; % ik[i] = ua; +end % + % // initialise first bezier seg +for i=0:d % for (i = 0; i <= d; i++) + for ii=0:mc-1 % for (ii = 0; ii < mc; ii++) + bpts(ii+1,i+1) = c(ii+1,i+1); % bpts[i][ii] = ctrl[i][ii]; + end +end % + % // big loop thru knot vector +while b < m % while (b < m) { + i = b; % i = b; + while b < m && k(b+1) == k(b+2) % while (b < m && k[b] == k[b+1]) + b = b + 1; % b++; + end % + mul = b - i + 1; % mul = b - i + 1; + mh = mh + mul + t; % mh += mul + t; + ub = k(b+1); % ub = k[b]; + oldr = r; % oldr = r; + r = d - mul; % r = d - mul; + % + % // insert knot u(b) r times + if oldr > 0 % if (oldr > 0) + lbz = floor((oldr+2)/2); % lbz = (oldr+2) / 2; + else % else + lbz = 1; % lbz = 1; + end % + + if r > 0 % if (r > 0) + rbz = ph - floor((r+1)/2); % rbz = ph - (r+1)/2; + else % else + rbz = ph; % rbz = ph; + end % + + if r > 0 % if (r > 0) { + % // insert knot to get bezier segment + numer = ub - ua; % numer = ub - ua; + for q=d:-1:mul+1 % for (q = d; q > mul; q--) + alfs(q-mul) = numer / (k(a+q+1)-ua); % alfs[q-mul-1] = numer / (k[a+q]-ua); + end + + for j=1:r % for (j = 1; j <= r; j++) { + save = r - j; % save = r - j; + s = mul + j; % s = mul + j; + % + for q=d:-1:s % for (q = d; q >= s; q--) + for ii=0:mc-1 % for (ii = 0; ii < mc; ii++) + tmp1 = alfs(q-s+1)*bpts(ii+1,q+1); + tmp2 = (1-alfs(q-s+1))*bpts(ii+1,q); + bpts(ii+1,q+1) = tmp1 + tmp2; % bpts[q][ii] = alfs[q-s]*bpts[q][ii]+(1.0-alfs[q-s])*bpts[q-1][ii]; + end + end % + + for ii=0:mc-1 % for (ii = 0; ii < mc; ii++) + Nextbpts(ii+1,save+1) = bpts(ii+1,d+1); % Nextbpts[save][ii] = bpts[d][ii]; + end + end % } + end % } + % // end of insert knot + % + % // degree elevate bezier + for i=lbz:ph % for (i = lbz; i <= ph; i++) { + for ii=0:mc-1 % for (ii = 0; ii < mc; ii++) + ebpts(ii+1,i+1) = 0; % ebpts[i][ii] = 0.0; + end + mpi = min(d, i); % mpi = min(d, i); + for j=max(0,i-t):mpi % for (j = max(0,i-t); j <= mpi; j++) + for ii=0:mc-1 % for (ii = 0; ii < mc; ii++) + tmp1 = ebpts(ii+1,i+1); + tmp2 = bezalfs(j+1,i+1)*bpts(ii+1,j+1); + ebpts(ii+1,i+1) = tmp1 + tmp2; % ebpts[i][ii] = ebpts[i][ii] + bezalfs[i][j]*bpts[j][ii]; + end + end + end % } + % // end of degree elevating bezier + % + if oldr > 1 % if (oldr > 1) { + % // must remove knot u=k[a] oldr times + first = kind - 2; % first = kind - 2; + last = kind; % last = kind; + den = ub - ua; % den = ub - ua; + bet = floor((ub-ik(kind)) / den); % bet = (ub-ik[kind-1]) / den; + % + % // knot removal loop + for tr=1:oldr-1 % for (tr = 1; tr < oldr; tr++) { + i = first; % i = first; + j = last; % j = last; + kj = j - kind + 1; % kj = j - kind + 1; + while j-i > tr % while (j - i > tr) { + % // loop and compute the new control points + % // for one removal step + if i < cind % if (i < cind) { + alf = (ub-ik(i+1))/(ua-ik(i+1)); % alf = (ub-ik[i])/(ua-ik[i]); + for ii=0:mc-1 % for (ii = 0; ii < mc; ii++) + tmp1 = alf*ic(ii+1,i+1); + tmp2 = (1-alf)*ic(ii+1,i); + ic(ii+1,i+1) = tmp1 + tmp2; % ictrl[i][ii] = alf * ictrl[i][ii] + (1.0-alf) * ictrl[i-1][ii]; + end + end % } + if j >= lbz % if (j >= lbz) { + if j-tr <= kind-ph+oldr % if (j-tr <= kind-ph+oldr) { + gam = (ub-ik(j-tr+1)) / den; % gam = (ub-ik[j-tr]) / den; + for ii=0:mc-1 % for (ii = 0; ii < mc; ii++) + tmp1 = gam*ebpts(ii+1,kj+1); + tmp2 = (1-gam)*ebpts(ii+1,kj+2); + ebpts(ii+1,kj+1) = tmp1 + tmp2; % ebpts[kj][ii] = gam*ebpts[kj][ii] + (1.0-gam)*ebpts[kj+1][ii]; + end % } + else % else { + for ii=0:mc-1 % for (ii = 0; ii < mc; ii++) + tmp1 = bet*ebpts(ii+1,kj+1); + tmp2 = (1-bet)*ebpts(ii+1,kj+2); + ebpts(ii+1,kj+1) = tmp1 + tmp2; % ebpts[kj][ii] = bet*ebpts[kj][ii] + (1.0-bet)*ebpts[kj+1][ii]; + end + end % } + end % } + i = i + 1; % i++; + j = j - 1; % j--; + kj = kj - 1; % kj--; + end % } + % + first = first - 1; % first--; + last = last + 1; % last++; + end % } + end % } + % // end of removing knot n=k[a] + % + % // load the knot ua + if a ~= d % if (a != d) + for i=0:ph-oldr-1 % for (i = 0; i < ph-oldr; i++) { + ik(kind+1) = ua; % ik[kind] = ua; + kind = kind + 1; % kind++; + end + end % } + % + % // load ctrl pts into ic + for j=lbz:rbz % for (j = lbz; j <= rbz; j++) { + for ii=0:mc-1 % for (ii = 0; ii < mc; ii++) + ic(ii+1,cind+1) = ebpts(ii+1,j+1); % ictrl[cind][ii] = ebpts[j][ii]; + end + cind = cind + 1; % cind++; + end % } + % + if b < m % if (b < m) { + % // setup for next pass thru loop + for j=0:r-1 % for (j = 0; j < r; j++) + for ii=0:mc-1 % for (ii = 0; ii < mc; ii++) + bpts(ii+1,j+1) = Nextbpts(ii+1,j+1); % bpts[j][ii] = Nextbpts[j][ii]; + end + end + for j=r:d % for (j = r; j <= d; j++) + for ii=0:mc-1 % for (ii = 0; ii < mc; ii++) + bpts(ii+1,j+1) = c(ii+1,b-d+j+1); % bpts[j][ii] = ctrl[b-d+j][ii]; + end + end + a = b; % a = b; + b = b+1; % b++; + ua = ub; % ua = ub; + % } + else % else + % // end knot + for i=0:ph % for (i = 0; i <= ph; i++) + ik(kind+i+1) = ub; % ik[kind+i] = ub; + end + end +end % } +% End big while loop % // end while loop + % + % *nh = mh - ph - 1; + % + % freevec2mat(ctrl); + % freevec2mat(ictrl); + % freematrix(bezalfs); + % freematrix(bpts); + % freematrix(ebpts); + % freematrix(Nextbpts); + % mxFree(alfs); + % + % return(ierr); +end % } + + +function b = bincoeff(n,k) +% Computes the binomial coefficient. +% +% ( n ) n! +% ( ) = -------- +% ( k ) k!(n-k)! +% +% b = bincoeff(n,k) +% +% Algorithm from 'Numerical Recipes in C, 2nd Edition' pg215. + + % double bincoeff(int n, int k) + % { +b = floor(0.5+exp(factln(n)-factln(k)-factln(n-k))); % return floor(0.5+exp(factln(n)-factln(k)-factln(n-k))); +end % } + +function f = factln(n) +% computes ln(n!) +if n <= 1, f = 0; return, end +f = gammaln(n+1); %log(factorial(n)); +end \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/bspderiv.m b/octave_packages/nurbs-1.3.6/bspderiv.m new file mode 100644 index 0000000..8f455d5 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/bspderiv.m @@ -0,0 +1,67 @@ +function [dc,dk] = bspderiv(d,c,k) + +% BSPDERIV: B-Spline derivative. +% +% MATLAB SYNTAX: +% +% [dc,dk] = bspderiv(d,c,k) +% +% INPUT: +% +% d - degree of the B-Spline +% c - control points double matrix(mc,nc) +% k - knot sequence double vector(nk) +% +% OUTPUT: +% +% dc - control points of the derivative double matrix(mc,nc) +% dk - knot sequence of the derivative double vector(nk) +% +% Modified version of Algorithm A3.3 from 'The NURBS BOOK' pg98. +% +% Copyright (C) 2000 Mark Spink, 2007 Daniel Claxton +% +% 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 . + +[mc,nc] = size(c); +nk = numel(k); + % + % int bspderiv(int d, double *c, int mc, int nc, double *k, int nk, double *dc, + % double *dk) + % { + % int ierr = 0; + % int i, j, tmp; + % + % // control points + % double **ctrl = vec2mat(c,mc,nc); + % + % // control points of the derivative +dc = zeros(mc,nc-1); % double **dctrl = vec2mat(dc,mc,nc-1); + % +for i=0:nc-2 % for (i = 0; i < nc-1; i++) { + tmp = d / (k(i+d+2) - k(i+2)); % tmp = d / (k[i+d+1] - k[i+1]); + for j=0:mc-1 % for (j = 0; j < mc; j++) { + dc(j+1,i+1) = tmp*(c(j+1,i+2) - c(j+1,i+1)); % dctrl[i][j] = tmp * (ctrl[i+1][j] - ctrl[i][j]); + end % } +end % } + % +dk = zeros(1,nk-2); % j = 0; +for i=1:nk-2 % for (i = 1; i < nk-1; i++) + dk(i) = k(i+1); % dk[j++] = k[i]; +end % + % freevec2mat(dctrl); + % freevec2mat(ctrl); + % + % return ierr; +end % } diff --git a/octave_packages/nurbs-1.3.6/bspeval.m b/octave_packages/nurbs-1.3.6/bspeval.m new file mode 100644 index 0000000..5a3ed9e --- /dev/null +++ b/octave_packages/nurbs-1.3.6/bspeval.m @@ -0,0 +1,72 @@ +function p = bspeval(d,c,k,u) + +% BSPEVAL: Evaluate B-Spline at parametric points. +% +% Calling Sequence: +% +% p = bspeval(d,c,k,u) +% +% INPUT: +% +% d - Degree of the B-Spline. +% c - Control Points, matrix of size (dim,nc). +% k - Knot sequence, row vector of size nk. +% u - Parametric evaluation points, row vector of size nu. +% +% OUTPUT: +% +% p - Evaluated points, matrix of size (dim,nu) +% +% Copyright (C) 2000 Mark Spink, 2007 Daniel Claxton, 2010 C. 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 . + +nu = numel(u); +[mc,nc] = size(c); + % int bspeval(int d, double *c, int mc, int nc, double *k, int nk, double *u,int nu, double *p){ + % int ierr = 0; + % int i, s, tmp1, row, col; + % double tmp2; + % + % // Construct the control points + % double **ctrl = vec2mat(c,mc,nc); + % + % // Contruct the evaluated points +p = zeros(mc,nu); % double **pnt = vec2mat(p,mc,nu); + % + % // space for the basis functions +%N = zeros(d+1,1); % double *N = (double*) mxMalloc((d+1)*sizeof(double)); + % + % // for each parametric point i +%for col=1:nu % for (col = 0; col < nu; col++) { + % // find the span of u[col] + s = findspan(nc-1, d, u(:), k); % s = findspan(nc-1, d, u[col], k); + N = basisfun(s,u(:),d,k); % basisfun(s, u[col], d, k, N); + % + tmp1 = s - d + 1; % tmp1 = s - d; + %for row=1:mc % for (row = 0; row < mc; row++) { + p = zeros (mc, nu); % tmp2 = 0.0; + for i=0:d % for (i = 0; i <= d; i++) + p = p + repmat (N(:,i+1)', mc, 1).*c(:,tmp1+i); % tmp2 += N[i] * ctrl[tmp1+i][row]; + end % + %p(row,:) = tmp2; % pnt[col][row] = tmp2; + %end % } +%end % } + % + % mxFree(N); + % freevec2mat(pnt); + % freevec2mat(ctrl); + % + % return ierr; +end % } diff --git a/octave_packages/nurbs-1.3.6/bspkntins.m b/octave_packages/nurbs-1.3.6/bspkntins.m new file mode 100644 index 0000000..5f47b80 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/bspkntins.m @@ -0,0 +1,112 @@ +function [ic,ik] = bspkntins(d,c,k,u) + +% BSPKNTINS: Insert knots into a B-Spline +% +% Calling Sequence: +% +% [ic,ik] = bspkntins(d,c,k,u) +% +% INPUT: +% +% d - spline degree integer +% c - control points double matrix(mc,nc) +% k - knot sequence double vector(nk) +% u - new knots double vector(nu) +% +% OUTPUT: +% +% ic - new control points double matrix(mc,nc+nu) +% ik - new knot sequence double vector(nk+nu) +% +% Modified version of Algorithm A5.4 from 'The NURBS BOOK' pg164. +% +% Copyright (C) 2000 Mark Spink, 2007 Daniel Claxton, 2010 Rafael Vazquez +% +% 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 . + +[mc,nc] = size(c); +u = sort(u); +nu = numel(u); +nk = numel(k); + % + % int bspkntins(int d, double *c, int mc, int nc, double *k, int nk, + % double *u, int nu, double *ic, double *ik) + % { + % int ierr = 0; + % int a, b, r, l, i, j, m, n, s, q, ind; + % double alfa; + % + % double **ctrl = vec2mat(c, mc, nc); +ic = zeros(mc,nc+nu); % double **ictrl = vec2mat(ic, mc, nc+nu); +ik = zeros(1,nk+nu); + % +n = size(c,2) - 1; % n = nc - 1; +r = length(u) - 1; % r = nu - 1; + % +m = n + d + 1; % m = n + d + 1; +a = findspan(n, d, u(1), k); % a = findspan(n, d, u[0], k); +b = findspan(n, d, u(r+1), k); % b = findspan(n, d, u[r], k); +b = b+1; % ++b; + % +for q=0:mc-1 % for (q = 0; q < mc; q++) { + for j=0:a-d, ic(q+1,j+1) = c(q+1,j+1); end % for (j = 0; j <= a-d; j++) ictrl[j][q] = ctrl[j][q]; + for j=b-1:n, ic(q+1,j+r+2) = c(q+1,j+1); end % for (j = b-1; j <= n; j++) ictrl[j+r+1][q] = ctrl[j][q]; +end % } + +for j=0:a, ik(j+1) = k(j+1); end % for (j = 0; j <= a; j++) ik[j] = k[j]; +for j=b+d:m, ik(j+r+2) = k(j+1); end % for (j = b+d; j <= m; j++) ik[j+r+1] = k[j]; + % +i = b + d - 1; % i = b + d - 1; +s = b + d + r; % s = b + d + r; + +for j=r:-1:0 % for (j = r; j >= 0; j--) { + while u(j+1) <= k(i+1) && i > a % while (u[j] <= k[i] && i > a) { + for q=0:mc-1 % for (q = 0; q < mc; q++) + ic(q+1,s-d) = c(q+1,i-d); % ictrl[s-d-1][q] = ctrl[i-d-1][q]; + end + ik(s+1) = k(i+1); % ik[s] = k[i]; + s = s - 1; % --s; + i = i - 1; % --i; + end % } + + for q=0:mc-1 % for (q = 0; q < mc; q++) + ic(q+1,s-d) = ic(q+1,s-d+1); % ictrl[s-d-1][q] = ictrl[s-d][q]; + end + + for l=1:d % for (l = 1; l <= d; l++) { + ind = s - d + l; % ind = s - d + l; + alfa = ik(s+l+1) - u(j+1); % alfa = ik[s+l] - u[j]; + if abs(alfa) == 0 % if (fabs(alfa) == 0.0) + for q=0:mc-1 % for (q = 0; q < mc; q++) + ic(q+1,ind) = ic(q+1,ind+1); % ictrl[ind-1][q] = ictrl[ind][q]; + end + else % else { + alfa = alfa/(ik(s+l+1) - k(i-d+l+1)); % alfa /= (ik[s+l] - k[i-d+l]); + for q=0:mc-1 % for (q = 0; q < mc; q++) + tmp = (1-alfa)*ic(q+1,ind+1); + ic(q+1,ind) = alfa*ic(q+1,ind) + tmp; % ictrl[ind-1][q] = alfa*ictrl[ind-1][q]+(1.0-alfa)*ictrl[ind][q]; + end + end % } + end % } + % + ik(s+1) = u(j+1); % ik[s] = u[j]; + s = s - 1; % --s; +end % } + % + % freevec2mat(ctrl); + % freevec2mat(ictrl); + % + % return ierr; +end % } + diff --git a/octave_packages/nurbs-1.3.6/curvederivcpts.m b/octave_packages/nurbs-1.3.6/curvederivcpts.m new file mode 100644 index 0000000..8e7db09 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/curvederivcpts.m @@ -0,0 +1,60 @@ +function pk = curvederivcpts (n, p, U, P, d, r1, r2) +% Compute control points of n-th derivatives of a B-spline curve. +% +% usage: pk = curvederivcpts (n, p, U, P, d) +% pk = curvederivcpts (n, p, U, P, d, r1, r2) +% +% If r1, r2 are not given, all the control points are computed. +% +% INPUT: +% n+1 = number of control points +% p = degree of the spline +% d = maximum derivative order (d<=p) +% U = knots +% P = control points +% r1 = first control point to compute +% r2 = auxiliary index for the last control point to compute +% OUTPUT: +% pk(k,i) = i-th control point of (k-1)-th derivative, r1 <= i <= r2-k +% +% Adaptation of algorithm A3.3 from the NURBS book, pg98. +% +% Copyright (C) 2009 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 . + + if (nargin <= 5) + r1 = 0; + r2 = n; + end + + r = r2 - r1; + for i=0:r + pk(1, i+1) = P(r1+i+1); + end + + for k=1:d + tmp = p - k + 1; + for i=0:r-k + pk (k+1, i+1) = tmp * (pk(k,i+2)-pk(k,i+1)) / ... + (U(r1+i+p+2)-U(r1+i+k+1)); + end + end +end + +%!test +%! line = nrbmak([0.0 1.5; 0.0 3.0],[0.0 0.0 1.0 1.0]); +%! pk = curvederivcpts (line.number-1, line.order-1, line.knots,... +%! line.coefs(1,:), 2); +%! assert (pk, [0 3/2; 3/2 0], 100*eps); diff --git a/octave_packages/nurbs-1.3.6/curvederiveval.m b/octave_packages/nurbs-1.3.6/curvederiveval.m new file mode 100644 index 0000000..6a43c09 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/curvederiveval.m @@ -0,0 +1,67 @@ +function ck = curvederiveval (n, p, U, P, u, d) +% +% CURVEDERIVEVAL: Compute the derivatives of a B-spline curve. +% +% usage: ck = curvederiveval (n, p, U, P, u, d) +% +% INPUT: +% +% n+1 = number of control points +% p = spline order +% U = knots +% P = control points +% u = evaluation point +% d = derivative order +% +% OUTPUT: +% +% ck (k+1) = curve differentiated k times +% +% Adaptation of algorithm A3.4 from the NURBS book, pg99 +% +% Copyright (C) 2009 Carlo de Falco +% Copyright (C) 2010 Rafael Vazquez +% +% 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 . + + ck = zeros (d+1, 1); + du = min (d, p); + + span = findspan (n, p, u, U); + for ip=0:p + N(1:ip+1,ip+1) = basisfun (span, u, ip, U)'; + end + + pk = curvederivcpts (n, p, U, P, du, span-p, span); + + for k = 0:du + for j = 0:p-k + ck(k+1) = ck(k+1) + N(j+1,p-k+1)*pk(k+1,j+1); + end + end + +end + +%!test +%! k = [0 0 0 1 1 1]; +%! coefs(:,1) = [0;0;0;1]; +%! coefs(:,2) = [1;0;1;1]; +%! coefs(:,3) = [1;1;1;1]; +%! crv = nrbmak (coefs, k); +%! ck = curvederiveval (crv.number-1, crv.order-1, crv.knots, squeeze (crv.coefs(1,:,:)), 0.5, 2); +%! assert(ck, [0.75; 1; -2]); +%! ck = curvederiveval (crv.number-1, crv.order-1, crv.knots, squeeze (crv.coefs(2,:,:)), 0.5, 2); +%! assert(ck, [0.25; 1; 2]); +%! ck = curvederiveval (crv.number-1, crv.order-1, crv.knots, squeeze (crv.coefs(3,:,:)), 0.5, 2); +%! assert(ck, [0.75; 1; -2]); diff --git a/octave_packages/nurbs-1.3.6/deg2rad.m b/octave_packages/nurbs-1.3.6/deg2rad.m new file mode 100644 index 0000000..b9344fa --- /dev/null +++ b/octave_packages/nurbs-1.3.6/deg2rad.m @@ -0,0 +1,44 @@ +function rad = deg2rad(deg) + +% DEG2RAD: Convert degrees to radians. +% +% Calling Sequence: +% +% rad = deg2rad(deg); +% +% INPUT: +% +% deg : Angle in degrees. +% +% OUTPUT: +% +% rad : Angle in radians. +% +% Description: +% +% Convenient utility function for converting degrees to radians, which are +% often the required angular units for functions in the NURBS toolbox. +% +% Examples: +% +% // Convert 35 degrees to radians +% rad = deg2rad(35); +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +rad = pi*deg/180.0; + +end \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/doc-cache b/octave_packages/nurbs-1.3.6/doc-cache new file mode 100644 index 0000000..5645683 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/doc-cache @@ -0,0 +1,3555 @@ +# Created by Octave 3.6.1, Wed Apr 04 09:02:21 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 61 +# name: +# type: sq_string +# elements: 1 +# length: 8 +basisfun + + +# name: +# type: sq_string +# elements: 1 +# length: 722 + BASISFUN: Basis function for B-Spline + + Calling Sequence: + + N = basisfun(iv,uv,p,U) + + INPUT: + + iv - knot span ( from FindSpan() ) + uv - parametric points + p - spline degree + U - knot sequence + + OUTPUT: + + N - Basis functions vector(numel(uv)*(p+1)) + + Adapted from Algorithm A2.2 from 'The NURBS BOOK' pg70. + + Copyright (C) 2000 Mark Spink + Copyright (C) 2007 Daniel Claxton + Copyright (C) 2009 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 + BASISFUN: Basis function for B-Spline + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +basisfunder + + +# name: +# type: sq_string +# elements: 1 +# length: 745 + BASISFUNDER: B-Spline Basis function derivatives. + + Calling Sequence: + + ders = basisfunder (ii, pl, uu, k, nd) + + INPUT: + + ii - knot span index (see findspan) + pl - degree of curve + uu - parametric points + k - knot vector + nd - number of derivatives to compute + + OUTPUT: + + ders - ders(n, i, :) (i-1)-th derivative at n-th point + + Adapted from Algorithm A2.3 from 'The NURBS BOOK' pg72. + + Copyright (C) 2009,2011 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 + BASISFUNDER: B-Spline Basis function derivatives. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +bspdegelev + + +# name: +# type: sq_string +# elements: 1 +# length: 703 + BSPDEGELEV: Degree elevate a univariate B-Spline. + + Calling Sequence: + + [ic,ik] = bspdegelev(d,c,k,t) + + INPUT: + + d - Degree of the B-Spline. + c - Control points, matrix of size (dim,nc). + k - Knot sequence, row vector of size nk. + t - Raise the B-Spline degree t times. + + OUTPUT: + + ic - Control points of the new B-Spline. + ik - Knot vector of the new B-Spline. + + Copyright (C) 2000 Mark Spink, 2007 Daniel Claxton + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 + BSPDEGELEV: Degree elevate a univariate B-Spline. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +bspderiv + + +# name: +# type: sq_string +# elements: 1 +# length: 766 + BSPDERIV: B-Spline derivative. + + MATLAB SYNTAX: + + [dc,dk] = bspderiv(d,c,k) + + INPUT: + + d - degree of the B-Spline + c - control points double matrix(mc,nc) + k - knot sequence double vector(nk) + + OUTPUT: + + dc - control points of the derivative double matrix(mc,nc) + dk - knot sequence of the derivative double vector(nk) + + Modified version of Algorithm A3.3 from 'The NURBS BOOK' pg98. + + Copyright (C) 2000 Mark Spink, 2007 Daniel Claxton + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 + BSPDERIV: B-Spline derivative. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +bspeval + + +# name: +# type: sq_string +# elements: 1 +# length: 713 + BSPEVAL: Evaluate B-Spline at parametric points. + + Calling Sequence: + + p = bspeval(d,c,k,u) + + INPUT: + + d - Degree of the B-Spline. + c - Control Points, matrix of size (dim,nc). + k - Knot sequence, row vector of size nk. + u - Parametric evaluation points, row vector of size nu. + + OUTPUT: + + p - Evaluated points, matrix of size (dim,nu) + + Copyright (C) 2000 Mark Spink, 2007 Daniel Claxton, 2010 C. 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 + BSPEVAL: Evaluate B-Spline at parametric points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +bspkntins + + +# name: +# type: sq_string +# elements: 1 +# length: 855 + BSPKNTINS: Insert knots into a B-Spline + + Calling Sequence: + + [ic,ik] = bspkntins(d,c,k,u) + + INPUT: + + d - spline degree integer + c - control points double matrix(mc,nc) + k - knot sequence double vector(nk) + u - new knots double vector(nu) + + OUTPUT: + + ic - new control points double matrix(mc,nc+nu) + ik - new knot sequence double vector(nk+nu) + + Modified version of Algorithm A5.4 from 'The NURBS BOOK' pg164. + + Copyright (C) 2000 Mark Spink, 2007 Daniel Claxton, 2010 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 + BSPKNTINS: Insert knots into a B-Spline + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +curvederivcpts + + +# name: +# type: sq_string +# elements: 1 +# length: 970 + Compute control points of n-th derivatives of a B-spline curve. + + usage: pk = curvederivcpts (n, p, U, P, d) + pk = curvederivcpts (n, p, U, P, d, r1, r2) + + If r1, r2 are not given, all the control points are computed. + + INPUT: + n+1 = number of control points + p = degree of the spline + d = maximum derivative order (d<=p) + U = knots + P = control points + r1 = first control point to compute + r2 = auxiliary index for the last control point to compute + OUTPUT: + pk(k,i) = i-th control point of (k-1)-th derivative, r1 <= i <= r2-k + + Adaptation of algorithm A3.3 from the NURBS book, pg98. + + Copyright (C) 2009 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 + Compute control points of n-th derivatives of a B-spline curve. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +curvederiveval + + +# name: +# type: sq_string +# elements: 1 +# length: 754 + + CURVEDERIVEVAL: Compute the derivatives of a B-spline curve. + + usage: ck = curvederiveval (n, p, U, P, u, d) + + INPUT: + + n+1 = number of control points + p = spline order + U = knots + P = control points + u = evaluation point + d = derivative order + + OUTPUT: + + ck (k+1) = curve differentiated k times + + Adaptation of algorithm A3.4 from the NURBS book, pg99 + + Copyright (C) 2009 Carlo de Falco + Copyright (C) 2010 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 + + CURVEDERIVEVAL: Compute the derivatives of a B-spline curve. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +deg2rad + + +# name: +# type: sq_string +# elements: 1 +# length: 696 + DEG2RAD: Convert degrees to radians. + + Calling Sequence: + + rad = deg2rad(deg); + + INPUT: + + deg : Angle in degrees. + + OUTPUT: + + rad : Angle in radians. + + Description: + + Convenient utility function for converting degrees to radians, which are + often the required angular units for functions in the NURBS toolbox. + + Examples: + + // Convert 35 degrees to radians + rad = deg2rad(35); + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 + DEG2RAD: Convert degrees to radians. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +findspan + + +# name: +# type: sq_string +# elements: 1 +# length: 634 + FINDSPAN Find the span of a B-Spline knot vector at a parametric point + + Calling Sequence: + + s = findspan(n,p,u,U) + + INPUT: + + n - number of control points - 1 + p - spline degree + u - parametric point + U - knot sequence + + OUTPUT: + + s - knot span index + + Modification of Algorithm A2.1 from 'The NURBS BOOK' pg68 + + Copyright (C) 2010 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 + FINDSPAN Find the span of a B-Spline knot vector at a parametric point + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +kntbrkdegmult + + +# name: +# type: sq_string +# elements: 1 +# length: 917 + KNTBRKDEGMULT: Construct an open knot vector by giving the sequence of + knots, the degree and the multiplicity. + + knots = kntbrkdegreg (breaks, degree) + knots = kntbrkdegreg (breaks, degree, mult) + + INPUT: + + breaks: sequence of knots. + degree: polynomial degree of the splines associated to the knot vector. + mult: multiplicity of the knots. + + OUTPUT: + + knots: knot vector. + + If MULT has as many entries as BREAKS, or as the number of interior + knots, a different multiplicity will be assigned to each knot. If + MULT is not present, it will be taken equal to 1. + + Copyright (C) 2010 Carlo de Falco, Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + KNTBRKDEGMULT: Construct an open knot vector by giving the sequence of + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +kntbrkdegreg + + +# name: +# type: sq_string +# elements: 1 +# length: 939 + KNTBRKDEGREG: Construct an open knot vector by giving the sequence of + knots, the degree and the regularity. + + knots = kntbrkdegreg (breaks, degree) + knots = kntbrkdegreg (breaks, degree, regularity) + + INPUT: + + breaks: sequence of knots. + degree: polynomial degree of the splines associated to the knot vector. + regularity: splines regularity. + + OUTPUT: + + knots: knot vector. + + If REGULARITY has as many entries as BREAKS, or as the number of interior + knots, a different regularity will be assigned to each knot. If + REGULARITY is not present, it will be taken equal to DEGREE-1. + + Copyright (C) 2010 Carlo de Falco, Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + KNTBRKDEGREG: Construct an open knot vector by giving the sequence of + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +kntrefine + + +# name: +# type: sq_string +# elements: 1 +# length: 1327 + KNTREFINE: Refine a given knot vector by dividing each interval uniformly, + maintaining the continuity in previously existing knots. + + [rknots] = kntrefine (knots, n_sub, degree, regularity) + [rknots, zeta] = kntrefine (knots, n_sub, degree, regularity) + [rknots, zeta, new_knots] = kntrefine (knots, n_sub, degree, regularity) + + INPUT: + + knots: initial knot vector. + n_sub: number of new knots to be added in each interval. + degree: polynomial degree of the refined knot vector + regularity: maximum global regularity + + OUTPUT: + + rknots: refined knot vector + zeta: refined knot vector without repetitions + new_knots: new knots, to apply the knot insertion + + The regularity at the new inserted knots is the one given by the user. + At previously existing knots, the regularity is the minimum + between the previous regularity, and the one given by the user. + This ensures optimal convergence rates in the context of IGA. + + Copyright (C) 2010 Carlo de Falco, Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + KNTREFINE: Refine a given knot vector by dividing each interval uniformly, + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +kntuniform + + +# name: +# type: sq_string +# elements: 1 +# length: 716 + KNTUNIFORM: generate uniform open knot vectors in the reference domain. + + [csi, zeta] = kntuniform (num, degree, regularity) + + INPUT: + + num: number of breaks (in each direction) + degree: polynomial degree (in each direction) + regularity: global regularity (in each direction) + + OUTPUT: + + csi: knots + zeta: breaks = knots without repetitions + + Copyright (C) 2009, 2010 Carlo de Falco + Copyright (C) 2011 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 + KNTUNIFORM: generate uniform open knot vectors in the reference domain. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +nrb4surf + + +# name: +# type: sq_string +# elements: 1 +# length: 1088 + + NRB4SURF: Constructs a NURBS bilinear surface. + + Calling Sequence: + + srf = nrb4surf(p11,p12,p21,p22) + + INPUT: + + p11 : Cartesian coordinate of the lhs bottom corner point. + + p12 : Cartesian coordinate of the rhs bottom corner point. + + p21 : Cartesian coordinate of the lhs top corner point. + + p22 : Cartesian coordinate of the rhs top corner point. + + OUTPUT: + + srf : NURBS bilinear surface, see nrbmak. + + Description: + + Constructs a bilinear surface defined by four coordinates. + + The position of the corner points + + ^ V direction + | + ---------------- + |p21 p22| + | | + | SRF | + | | + |p11 p12| + -------------------> U direction + + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 + + NRB4SURF: Constructs a NURBS bilinear surface. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +nrbbasisfun + + +# name: +# type: sq_string +# elements: 1 +# length: 974 + NRBBASISFUN: Basis functions for NURBS + + Calling Sequence: + + B = nrbbasisfun (u, crv) + B = nrbbasisfun ({u, v}, srf) + [B, N] = nrbbasisfun ({u, v}, srf) + [B, N] = nrbbasisfun (p, srf) + + INPUT: + + u or p(1,:,:) - parametric points along u direction + v or p(2,:,:) - parametric points along v direction + crv - NURBS curve + srf - NURBS surface + + OUTPUT: + + B - Value of the basis functions at the points + size(B)=[numel(u),(p+1)] for curves + or [numel(u)*numel(v), (p+1)*(q+1)] for surfaces + + N - Indices of the basis functions that are nonvanishing at each + point. size(N) == size(B) + + + Copyright (C) 2009 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 + NRBBASISFUN: Basis functions for NURBS + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +nrbbasisfunder + + +# name: +# type: sq_string +# elements: 1 +# length: 1227 + NRBBASISFUNDER: NURBS basis functions derivatives + + Calling Sequence: + + Bu = nrbbasisfunder (u, crv) + [Bu, N] = nrbbasisfunder (u, crv) + [Bu, Bv] = nrbbasisfunder ({u, v}, srf) + [Bu, Bv, N] = nrbbasisfunder ({u, v}, srf) + [Bu, Bv, N] = nrbbasisfunder (p, srf) + + INPUT: + + u or p(1,:,:) - parametric points along u direction + v or p(2,:,:) - parametric points along v direction + crv - NURBS curve + srf - NURBS surface + + OUTPUT: + + Bu - Basis functions derivatives WRT direction u + size(Bu)=[numel(u),(p+1)] for curves + or [numel(u)*numel(v), (p+1)*(q+1)] for surfaces + + Bv - Basis functions derivatives WRT direction v + size(Bv)=[numel(v),(p+1)] for curves + or [numel(u)*numel(v), (p+1)*(q+1)] for surfaces + + N - Indices of the basis functions that are nonvanishing at each + point. size(N) == size(B) + + Copyright (C) 2009 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 + NRBBASISFUNDER: NURBS basis functions derivatives + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +nrbcirc + + +# name: +# type: sq_string +# elements: 1 +# length: 999 + + NRBCIRC: Construct a circular arc. + + Calling Sequence: + + crv = nrbcirc() + crv = nrbcirc(radius) + crv = nrbcirc(radius,center) + crv = nrbcirc(radius,center,sang,eang) + + INPUT: + + radius : Radius of the circle, default 1.0 + + center : Center of the circle, default (0,0,0) + + sang : Start angle, default 0 radians (0 degrees) + + eang : End angle, default 2*pi radians (360 degrees) + + OUTPUT: + + crv : NURBS curve for a circular arc. + + Description: + + Constructs NURBS data structure for a circular arc in the x-y plane. If + no rhs arguments are supplied a unit circle with center (0.0,0.0) is + constructed. + + Angles are defined as positive in the anti-clockwise direction. + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 + + NRBCIRC: Construct a circular arc. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +nrbcoons + + +# name: +# type: sq_string +# elements: 1 +# length: 2143 + + NRBCOONS: Construction of a Coons patch. + + Calling Sequence: + + srf = nrbcoons(ucrv1, ucrv2, vcrv1, vcrv2) + + INPUT: + + ucrv1 : NURBS curve defining the bottom U direction boundary of + the constructed NURBS surface. + + ucrv2 : NURBS curve defining the top U direction boundary of + the constructed NURBS surface. + + vcrv1 : NURBS curve defining the bottom V direction boundary of + the constructed NURBS surface. + + vcrv2 : NURBS curve defining the top V direction boundary of + the constructed NURBS surface. + + OUTPUT: + + srf : Coons NURBS surface patch. + + Description: + + Construction of a bilinearly blended Coons surface patch from four NURBS + curves that define the boundary. + + The orientation of the four NURBS boundary curves. + + ^ V direction + | + | ucrv2 + ------->-------- + | | + | | + vcrv1 ^ Surface ^ vcrv2 + | | + | | + ------->-----------> U direction + ucrv1 + + + Examples: + + // Define four NURBS curves and construct a Coons surface patch. + pnts = [ 0.0 3.0 4.5 6.5 8.0 10.0; + 0.0 0.0 0.0 0.0 0.0 0.0; + 2.0 2.0 7.0 4.0 7.0 9.0]; + crv1 = nrbmak(pnts, [0 0 0 1/3 0.5 2/3 1 1 1]); + + pnts= [ 0.0 3.0 5.0 8.0 10.0; + 10.0 10.0 10.0 10.0 10.0; + 3.0 5.0 8.0 6.0 10.0]; + crv2 = nrbmak(pnts, [0 0 0 1/3 2/3 1 1 1]); + + pnts= [ 0.0 0.0 0.0 0.0; + 0.0 3.0 8.0 10.0; + 2.0 0.0 5.0 3.0]; + crv3 = nrbmak(pnts, [0 0 0 0.5 1 1 1]); + + pnts= [ 10.0 10.0 10.0 10.0 10.0; + 0.0 3.0 5.0 8.0 10.0; + 9.0 7.0 7.0 10.0 10.0]; + crv4 = nrbmak(pnts, [0 0 0 0.25 0.75 1 1 1]); + + srf = nrbcoons(crv1, crv2, crv3, crv4); + nrbplot(srf,[20 20],220,45); + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 + + NRBCOONS: Construction of a Coons patch. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +nrbcrvderiveval + + +# name: +# type: sq_string +# elements: 1 +# length: 753 + + NRBCRVDERIVEVAL: Evaluate n-th order derivatives of a NURBS curve. + + usage: skl = nrbcrvderiveval (crv, u, d) + + INPUT: + + crv : NURBS curve structure, see nrbmak + + u : parametric coordinate of the points where we compute the derivatives + + d : number of partial derivatives to compute + + + OUTPUT: + + ck (i, j, l) = i-th component derived j-1 times at the l-th point. + + Adaptation of algorithm A4.2 from the NURBS book, pg127 + + Copyright (C) 2010 Carlo de Falco, Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 68 + + NRBCRVDERIVEVAL: Evaluate n-th order derivatives of a NURBS curve. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +nrbctrlplot + + +# name: +# type: sq_string +# elements: 1 +# length: 662 + NRBCTRLPLOT: Plot a NURBS entity along with its control points. + + Calling Sequence: + + nrbctrlplot (nurbs) + + INPUT: + + nurbs: NURBS curve or surface, see nrbmak. + + Example: + + Plot the test curve and test surface with their control polygon and + control net, respectively + + nrbctrlplot(nrbtestcrv) + nrbctrlplot(nrbtestsrf) + + See also: + + nrbkntplot + + Copyright (C) 2011 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 + NRBCTRLPLOT: Plot a NURBS entity along with its control points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +nrbcylind + + +# name: +# type: sq_string +# elements: 1 +# length: 988 + + NRBCYLIND: Construct a cylinder or cylindrical patch. + + Calling Sequence: + + srf = nrbcylind() + srf = nrbcylind(height) + srf = nrbcylind(height,radius) + srf = nrbcylind(height,radius,center) + srf = nrbcylind(height,radius,center,sang,eang) + + INPUT: + + height : Height of the cylinder along the axis, default 1.0 + + radius : Radius of the cylinder, default 1.0 + + center : Center of the cylinder, default (0,0,0) + + sang : Start angle relative to the origin, default 0. + + eang : End angle relative to the origin, default 2*pi. + + OUTPUT: + + srf : cylindrical surface patch + + Description: + + Construct a cylinder or cylindrical patch by extruding a circular arc. + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 + + NRBCYLIND: Construct a cylinder or cylindrical patch. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +nrbdegelev + + +# name: +# type: sq_string +# elements: 1 +# length: 1358 + + NRBDEGELEV: Elevate the degree of the NURBS curve, surface or volume. + + Calling Sequence: + + ecrv = nrbdegelev(crv,utimes); + esrf = nrbdegelev(srf,[utimes,vtimes]); + evol = nrbdegelev(vol,[utimes,vtimes,wtimes]); + + INPUT: + + crv : NURBS curve, see nrbmak. + + srf : NURBS surface, see nrbmak. + + vol : NURBS volume, see nrbmak. + + utimes : Increase the degree along U direction utimes. + + vtimes : Increase the degree along V direction vtimes. + + wtimes : Increase the degree along W direction vtimes. + + OUTPUT: + + ecrv : new NURBS structure for a curve with degree elevated. + + esrf : new NURBS structure for a surface with degree elevated. + + evol : new NURBS structure for a volume with degree elevated. + + + Description: + + Degree elevates the NURBS curve or surface. This function uses the + B-Spline function bspdegelev, which interface to an internal 'C' + routine. + + Examples: + + Increase the NURBS surface twice along the V direction. + esrf = nrbdegelev(srf, [0, 2]); + + See also: + + bspdegelev + + Copyright (C) 2000 Mark Spink, 2010 Rafel Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 + + NRBDEGELEV: Elevate the degree of the NURBS curve, surface or volume. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +nrbderiv + + +# name: +# type: sq_string +# elements: 1 +# length: 1370 + + NRBDERIV: Construct the first and second derivative representation of a + NURBS curve, surface or volume. + + Calling Sequence: + + ders = nrbderiv (nrb); + [ders, ders2] = nrbderiv (nrb); + + INPUT: + + nrb : NURBS data structure, see nrbmak. + + OUTPUT: + + ders: A data structure that represents the first + derivatives of a NURBS curve, surface or volume. + ders2: A data structure that represents the second + derivatives of a NURBS curve, surface or volume. + + Description: + + The derivatives of a B-Spline are themselves a B-Spline of lower degree, + giving an efficient means of evaluating multiple derivatives. However, + although the same approach can be applied to NURBS, the situation for + NURBS is more complex. We have followed in this function the same idea + that was already used for the first derivative in the function nrbderiv. + The second derivative data structure can be evaluated later with the + function nrbdeval. + + See also: + + nrbdeval + + Copyright (C) 2000 Mark Spink + Copyright (C) 2010 Carlo de Falco + Copyright (C) 2010, 2011 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + NRBDERIV: Construct the first and second derivative representation of a + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +nrbdeval + + +# name: +# type: sq_string +# elements: 1 +# length: 1418 + NRBDEVAL: Evaluation of the derivative and second derivatives of NURBS curve, surface or volume. + + [pnt, jac] = nrbdeval (crv, dcrv, tt) + [pnt, jac] = nrbdeval (srf, dsrf, {tu tv}) + [pnt, jac] = nrbdeval (vol, dvol, {tu tv tw}) + [pnt, jac, hess] = nrbdeval (crv, dcrv, dcrv2, tt) + [pnt, jac, hess] = nrbdeval (srf, dsrf, dsrf2, {tu tv}) + [pnt, jac, hess] = nrbdeval (vol, dvol, {tu tv tw}) + + INPUTS: + + crv, srf, vol - original NURBS curve, surface or volume. + dcrv, dsrf, dvol - NURBS derivative representation of crv, srf + or vol (see nrbderiv2) + dcrv2, dsrf2, dvol2 - NURBS second derivative representation of crv, + srf or vol (see nrbderiv2) + tt - parametric evaluation points + If the nurbs is a surface or a volume then tt is a cell + {tu, tv} or {tu, tv, tw} are the parametric coordinates + + OUTPUT: + + pnt - evaluated points. + jac - evaluated first derivatives (Jacobian). + hess - evaluated second derivatives (Hessian). + + Copyright (C) 2000 Mark Spink + Copyright (C) 2010 Carlo de Falco + Copyright (C) 2010, 2011 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + NRBDEVAL: Evaluation of the derivative and second derivatives of NURBS curve, s + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +nrbeval + + +# name: +# type: sq_string +# elements: 1 +# length: 1803 + + NRBEVAL: Evaluate a NURBS at parametric points. + + Calling Sequences: + + [p,w] = nrbeval(crv,ut) + [p,w] = nrbeval(srf,{ut,vt}) + [p,w] = nrbeval(vol,{ut,vt,wt}) + [p,w] = nrbeval(srf,pts) + + INPUT: + + crv : NURBS curve, see nrbmak. + + srf : NURBS surface, see nrbmak. + + vol : NURBS volume, see nrbmak. + + ut : Parametric evaluation points along U direction. + + vt : Parametric evaluation points along V direction. + + wt : Parametric evaluation points along W direction. + + pts : Array of scattered points in parametric domain + + OUTPUT: + + p : Evaluated points on the NURBS curve, surface or volume as + Cartesian coordinates (x,y,z). If w is included on the lhs argument + list the points are returned as homogeneous coordinates (wx,wy,wz). + + w : Weights of the homogeneous coordinates of the evaluated + points. Note inclusion of this argument changes the type + of coordinates returned in p (see above). + + Description: + + Evaluation of NURBS curves, surfaces or volume at parametric points along + the U, V and W directions. Either homogeneous coordinates are returned + if the weights are requested in the lhs arguments, or as Cartesian coordinates. + This function utilises the 'C' interface bspeval. + + Examples: + + Evaluate the NURBS circle at twenty points from 0.0 to 1.0 + + nrb = nrbcirc; + ut = linspace(0.0,1.0,20); + p = nrbeval(nrb,ut); + + See also: + + bspeval + + Copyright (C) 2000 Mark Spink + Copyright (C) 2010 Carlo de Falco + Copyright (C) 2010, 2011 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 + + NRBEVAL: Evaluate a NURBS at parametric points. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +nrbexport + + +# name: +# type: sq_string +# elements: 1 +# length: 690 + + NRBEXPORT: export NURBS geometries to a format compatible with the one used in GeoPDEs (version 0.6). + + Calling Sequence: + + nrbexport (nurbs, filename); + + INPUT: + + nurbs : NURBS curve, surface or volume, see nrbmak. + filename : name of the output file. + + + Description: + + The data of the nurbs structure is written in the file, in a format + that can be read by GeoPDEs. + + Copyright (C) 2011 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + NRBEXPORT: export NURBS geometries to a format compatible with the one used in + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +nrbextract + + +# name: +# type: sq_string +# elements: 1 +# length: 1011 + + NRBEXTRACT: construct NURBS curves by extracting the boundaries of a NURBS surface, or NURBS surfaces by extracting the boundary of a NURBS volume. + + Calling Sequence: + + crvs = nrbextract(surf); + + INPUT: + + surf : NURBS surface or volume, see nrbmak. + + OUTPUT: + + crvs : array of NURBS curves or NURBS surfaces extracted. + + Description: + + Constructs either an array of four NURBS curves, by extracting the boundaries + of a NURBS surface, or an array of six surfaces, by extracting the boundaries + of a NURBS volume. The new entities are ordered in the following way + + 1: U = 0 + 2: U = 1 + 3: V = 0 + 4: V = 1 + 5: W = 0 (only for volumes) + 6: W = 1 (only for volumes) + + Copyright (C) 2010 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + NRBEXTRACT: construct NURBS curves by extracting the boundaries of a NURBS sur + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +nrbextrude + + +# name: +# type: sq_string +# elements: 1 +# length: 1243 + + NRBEXTRUDE: Construct a NURBS surface by extruding a NURBS curve, or + construct a NURBS volume by extruding a NURBS surface. + + Calling Sequence: + + srf = nrbextrude(crv,vec); + + INPUT: + + crv : NURBS curve or surface to extrude, see nrbmak. + + vec : Vector along which the entity is extruded. + + OUTPUT: + + srf : NURBS surface or volume constructed. + + Description: + + Constructs either a NURBS surface by extruding a NURBS curve along a + defined vector, or a NURBS volume by extruding a NURBS surface. In the + first case, the NURBS curve forms the U direction of the surface edge, and + is extruded along the vector in the V direction. In the second case, the + original surface forms the U and V direction of the volume, and is extruded + along the W direction. + + Examples: + + Form a hollow cylinder by extruding a circle along the z-axis. + + srf = nrbextrude(nrbcirc, [0,0,1]); + + Copyright (C) 2000 Mark Spink + Copyright (C) 2010 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + NRBEXTRUDE: Construct a NURBS surface by extruding a NURBS curve, or + constr + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +nrbkntins + + +# name: +# type: sq_string +# elements: 1 +# length: 1961 + + NRBKNTINS: Insert a single or multiple knots into a NURBS curve, + surface or volume. + + Calling Sequence: + + icrv = nrbkntins(crv,iuknots); + isrf = nrbkntins(srf,{iuknots ivknots}); + ivol = nrbkntins(vol,{iuknots ivknots iwknots}); + + INPUT: + + crv : NURBS curve, see nrbmak. + + srf : NURBS surface, see nrbmak. + + srf : NURBS volume, see nrbmak. + + iuknots : Knots to be inserted along U direction. + + ivknots : Knots to be inserted along V direction. + + iwknots : Knots to be inserted along W direction. + + OUTPUT: + + icrv : new NURBS structure for a curve with knots inserted. + + isrf : new NURBS structure for a surface with knots inserted. + + ivol : new NURBS structure for a volume with knots inserted. + + Description: + + Inserts knots into the NURBS data structure, these can be knots at + new positions or at the location of existing knots to increase the + multiplicity. Note that the knot multiplicity cannot be increased + beyond the order of the spline. Knots along the V direction can only + inserted into NURBS surfaces, not curve that are always defined along + the U direction. This function use the B-Spline function bspkntins, + which interfaces to an internal 'C' routine. + + Examples: + + Insert two knots into a curve, one at 0.3 and another + twice at 0.4 + + icrv = nrbkntins(crv, [0.3 0.4 0.4]) + + Insert into a surface two knots as (1) into the U knot + sequence and one knot into the V knot sequence at 0.5. + + isrf = nrbkntins(srf, {[0.3 0.4 0.4] [0.5]}) + + See also: + + bspkntins + + Note: + + No knot multiplicity will be increased beyond the order of the spline. + + Copyright (C) 2000 Mark Spink, 2010 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + NRBKNTINS: Insert a single or multiple knots into a NURBS curve, + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +nrbkntplot + + +# name: +# type: sq_string +# elements: 1 +# length: 582 + NRBKNTPLOT: Plot a NURBS entity with the knots subdivision. + + Calling Sequence: + + nrbkntplot(nurbs) + + INPUT: + + nurbs: NURBS curve, surface or volume, see nrbmak. + + Example: + + Plot the test surface with its knot vector + + nrbkntplot(nrbtestsrf) + + See also: + + nrbctrlplot + + Copyright (C) 2011 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 + NRBKNTPLOT: Plot a NURBS entity with the knots subdivision. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +nrbline + + +# name: +# type: sq_string +# elements: 1 +# length: 762 + + NRBLINE: Construct a straight line. + + Calling Sequence: + + crv = nrbline() + crv = nrbline(p1,p2) + + INPUT: + + p1 : 2D or 3D cartesian coordinate of the start point. + + p2 : 2D or 3D cartesian coordinate of the end point. + + OUTPUT: + + crv : NURBS curve for a straight line. + + Description: + + Constructs NURBS data structure for a straight line. If no rhs + coordinates are included the function returns a unit straight + line along the x-axis. + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + + NRBLINE: Construct a straight line. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nrbmak + + +# name: +# type: sq_string +# elements: 1 +# length: 3867 + + NRBMAK: Construct the NURBS structure given the control points + and the knots. + + Calling Sequence: + + nurbs = nrbmak(cntrl,knots); + + INPUT: + + cntrl : Control points, these can be either Cartesian or + homogeneous coordinates. + + For a curve the control points are represented by a + matrix of size (dim,nu), for a surface a multidimensional + array of size (dim,nu,nv), for a volume a multidimensional array + of size (dim,nu,nv,nw). Where nu is number of points along + the parametric U direction, nv the number of points along + the V direction and nw the number of points along the W direction. + dim is the dimension. Valid options + are + 2 .... (x,y) 2D Cartesian coordinates + 3 .... (x,y,z) 3D Cartesian coordinates + 4 .... (wx,wy,wz,w) 4D homogeneous coordinates + + knots : Non-decreasing knot sequence spanning the interval + [0.0,1.0]. It's assumed that the geometric entities + are clamped to the start and end control points by knot + multiplicities equal to the spline order (open knot vector). + For curve knots form a vector and for surfaces (volumes) + the knots are stored by two (three) vectors for U and V (and W) + in a cell structure {uknots vknots} ({uknots vknots wknots}). + + OUTPUT: + + nurbs : Data structure for representing a NURBS entity + + NURBS Structure: + + Both curves and surfaces are represented by a structure that is + compatible with the Spline Toolbox from Mathworks + + nurbs.form .... Type name 'B-NURBS' + nurbs.dim .... Dimension of the control points + nurbs.number .... Number of Control points + nurbs.coefs .... Control Points + nurbs.order .... Order of the spline + nurbs.knots .... Knot sequence + + Note: the control points are always converted and stored within the + NURBS structure as 4D homogeneous coordinates. A curve is always stored + along the U direction, and the vknots element is an empty matrix. For + a surface the spline order is a vector [du,dv] containing the order + along the U and V directions respectively. For a volume the order is + a vector [du dv dw]. Recall that order = degree + 1. + + Description: + + This function is used as a convenient means of constructing the NURBS + data structure. Many of the other functions in the toolbox rely on the + NURBS structure been correctly defined as shown above. The nrbmak not + only constructs the proper structure, but also checks for consistency. + The user is still free to build his own structure, in fact a few + functions in the toolbox do this for convenience. + + Examples: + + Construct a 2D line from (0.0,0.0) to (1.5,3.0). + For a straight line a spline of order 2 is required. + Note that the knot sequence has a multiplicity of 2 at the + start (0.0,0.0) and end (1.0 1.0) in order to clamp the ends. + + line = nrbmak([0.0 1.5; 0.0 3.0],[0.0 0.0 1.0 1.0]); + nrbplot(line, 2); + + Construct a surface in the x-y plane i.e + + ^ (0.0,1.0) ------------ (1.0,1.0) + | | | + | V | | + | | Surface | + | | | + | | | + | (0.0,0.0) ------------ (1.0,0.0) + | + |------------------------------------> + U + + coefs = cat(3,[0 0; 0 1],[1 1; 0 1]); + knots = {[0 0 1 1] [0 0 1 1]} + plane = nrbmak(coefs,knots); + nrbplot(plane, [2 2]); + + Copyright (C) 2000 Mark Spink, 2010 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + NRBMAK: Construct the NURBS structure given the control points + and + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +nrbnumbasisfun + + +# name: +# type: sq_string +# elements: 1 +# length: 797 + + NRBNUMBASISFUN: Numbering of basis functions for NURBS + + Calling Sequence: + + N = nrbnumbasisfun (u, crv) + N = nrbnumbasisfun ({u, v}, srf) + N = nrbnumbasisfun (p, srf) + + INPUT: + + u or p(1,:,:) - parametric points along u direction + v or p(2,:,:) - parametric points along v direction + crv - NURBS curve + srf - NURBS surface + + OUTPUT: + + N - Indices of the basis functions that are nonvanishing at each + point. size(N) == size(B) + + Copyright (C) 2009 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 + + NRBNUMBASISFUN: Numbering of basis functions for NURBS + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +nrbplot + + +# name: +# type: sq_string +# elements: 1 +# length: 1117 + + NRBPLOT: Plot a NURBS curve or surface, or the boundary of a NURBS volume. + + Calling Sequence: + + nrbplot (nrb, subd) + nrbplot (nrb, subd, p, v) + + INPUT: + + nrb : NURBS curve, surface or volume, see nrbmak. + + npnts : Number of evaluation points, for a surface or volume, a row + vector with the number of points along each direction. + + [p,v] : property/value options + + Valid property/value pairs include: + + Property Value/{Default} + ----------------------------------- + light {off} | on + colormap {'copper'} + + Example: + + Plot the test surface with 20 points along the U direction + and 30 along the V direction + + nrbplot(nrbtestsrf, [20 30]) + + Copyright (C) 2000 Mark Spink + Copyright (C) 2010 Carlo de Falco, Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 77 + + NRBPLOT: Plot a NURBS curve or surface, or the boundary of a NURBS volume. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +nrbrect + + +# name: +# type: sq_string +# elements: 1 +# length: 854 + + NRBRECT: Construct NURBS representation of a rectangular curve. + + Calling Sequence: + + crv = nrbrect() + crv = nrbrect(size) + crv = nrbrect(width, height) + + INPUT: + + size : Size of the square (width = height). + + width : Width of the rectangle (along x-axis). + + height : Height of the rectangle (along y-axis). + + OUTPUT: + + crv : NURBS curve, see nrbmak. + + + Description: + + Construct a rectangle or square in the x-y plane with the bottom + lhs corner at (0,0,0). If no rhs arguments provided the function + constructs a unit square. + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 + + NRBRECT: Construct NURBS representation of a rectangular curve. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +nrbreverse + + +# name: +# type: sq_string +# elements: 1 +# length: 618 + + NRBREVERSE: Reverse the evaluation direction of a NURBS curve or surface. + + Calling Sequence: + + rnrb = nrbreverse(nrb); + + INPUT: + + nrb : NURBS data structure, see nrbmak. + + OUTPUT: + + rnrb : Reversed NURBS. + + Description: + + Utility function to reverse the evaluation direction of a NURBS + curve or surface. + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 + + NRBREVERSE: Reverse the evaluation direction of a NURBS curve or surface. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +nrbrevolve + + +# name: +# type: sq_string +# elements: 1 +# length: 1710 + + NRBREVOLVE: Construct a NURBS surface by revolving a NURBS curve, or + construct a NURBS volume by revolving a NURBS surface. + + Calling Sequence: + + srf = nrbrevolve(crv,pnt,vec[,ang]) + + INPUT: + + crv : NURBS curve or surface to revolve, see nrbmak. + + pnt : Coordinates of the point used to define the axis + of rotation. + + vec : Vector defining the direction of the rotation axis. + + ang : Angle to revolve the curve, default 2*pi + + OUTPUT: + + srf : constructed surface or volume + + Description: + + Construct a NURBS surface by revolving the profile NURBS curve around + an axis defined by a point and vector. + + Examples: + + Construct a sphere by rotating a semicircle around a x-axis. + + crv = nrbcirc(1.0,[0 0 0],0,pi); + srf = nrbrevolve(crv,[0 0 0],[1 0 0]); + nrbplot(srf,[20 20]); + + NOTE: + + The algorithm: + + 1) vectrans the point to the origin (0,0,0) + 2) rotate the vector into alignment with the z-axis + + for each control point along the curve + + 3) determine the radius and angle of control + point to the z-axis + 4) construct a circular arc in the x-y plane with + this radius and start angle and sweep angle theta + 5) combine the arc and profile, coefs and weights. + + next control point + + 6) rotate and vectrans the surface back into position + by reversing 1 and 2. + + + Copyright (C) 2000 Mark Spink + Copyright (C) 2010 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + NRBREVOLVE: Construct a NURBS surface by revolving a NURBS curve, or + constr + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +nrbruled + + +# name: +# type: sq_string +# elements: 1 +# length: 892 + NRBRULED: Construct a ruled surface between two NURBS curves. + + Calling Sequence: + + srf = nrbruled(crv1, crv2) + + INPUT: + + crv1 : First NURBS curve, see nrbmak. + + crv2 : Second NURBS curve, see nrbmak. + + OUTPUT: + + srf : Ruled NURBS surface. + + Description: + + Constructs a ruled surface between two NURBS curves. The ruled surface is + ruled along the V direction. + + Examples: + + Construct a ruled surface between a semicircle and a straight line. + + cir = nrbcirc(1,[0 0 0],0,pi); + line = nrbline([-1 0.5 1],[1 0.5 1]); + srf = nrbruled(cir,line); + nrbplot(srf,[20 20]); + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 + NRBRULED: Construct a ruled surface between two NURBS curves. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +nrbsurfderiveval + + +# name: +# type: sq_string +# elements: 1 +# length: 772 + + NRBSURFDERIVEVAL: Evaluate n-th order derivatives of a NURBS surface + + usage: skl = nrbsurfderiveval (srf, [u; v], d) + + INPUT: + + srf : NURBS surface structure, see nrbmak + + u, v : parametric coordinates of the point where we compute the + derivatives + + d : number of partial derivatives to compute + + + OUTPUT: + + skl (i, j, k, l) = i-th component derived j-1,k-1 times at the + l-th point. + + Adaptation of algorithm A4.4 from the NURBS book, pg137 + + Copyright (C) 2009 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 + + NRBSURFDERIVEVAL: Evaluate n-th order derivatives of a NURBS surface + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +nrbtestcrv + + +# name: +# type: sq_string +# elements: 1 +# length: 338 + NRBTESTCRV: Constructs a simple test curve. + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 + NRBTESTCRV: Constructs a simple test curve. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +nrbtestsrf + + +# name: +# type: sq_string +# elements: 1 +# length: 339 + NRBTESTSRF: Constructs a simple test surface. + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 + NRBTESTSRF: Constructs a simple test surface. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +nrbtform + + +# name: +# type: sq_string +# elements: 1 +# length: 1287 + + NRBTFORM: Apply transformation matrix to the NURBS. + + Calling Sequence: + + tnurbs = nrbtform(nurbs,tmatrix); + + INPUT: + + nurbs : NURBS data structure (see nrbmak for details). + + tmatrix : Transformation matrix, a matrix of size (4,4) defining + a single or multiple transformations. + + OUTPUT: + + tnurbs : The return transformed NURBS data structure. + + Description: + + The NURBS is transform as defined a transformation matrix of size (4,4), + such as a rotation, translation or change in scale. The transformation + matrix can define a single transformation or multiple series of + transformations. The matrix can be simple constructed by the functions + vecscale, vectrans, vecrotx, vecroty, and vecrotz. + + Examples: + + Rotate a square by 45 degrees about the z axis. + + rsqr = nrbtform(nrbrect(), vecrotz(deg2rad(45))); + nrbplot(rsqr, 1000); + + See also: + + vecscale, vectrans, vecrotx, vecroty, vecrotz + + Copyright (C) 2000 Mark Spink + Copyright (C) 2010 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 + + NRBTFORM: Apply transformation matrix to the NURBS. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +nrbtransp + + +# name: +# type: sq_string +# elements: 1 +# length: 673 + + NRBTRANSP: Transpose a NURBS surface, by swapping U and V directions. + + Calling Sequence: + + tsrf = nrbtransp(srf) + + INPUT: + + srf : NURBS surface, see nrbmak. + + OUTPUT: + + tsrf : NURBS surface with U and V diretions transposed. + + Description: + + Utility function that transposes a NURBS surface, by swapping U and + V directions. NURBS curves cannot be transposed. + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 + + NRBTRANSP: Transpose a NURBS surface, by swapping U and V directions. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +numbasisfun + + +# name: +# type: sq_string +# elements: 1 +# length: 626 + NUMBASISFUN: List non-zero Basis functions for B-Spline in a given knot-span + + Calling Sequence: + + N = numbasisfun(i,u,p,U) + + INPUT: + + i - knot span ( from FindSpan() ) + u - parametric point + p - spline degree + U - knot sequence + + OUTPUT: + + N - Basis functions (numel(u)x(p+1)) + + Copyright (C) 2009 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 79 + NUMBASISFUN: List non-zero Basis functions for B-Spline in a given knot-span + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +rad2deg + + +# name: +# type: sq_string +# elements: 1 +# length: 697 + + RAD2DEG: Convert radians to degrees. + + Calling Sequence: + + rad = rad2deg(deg); + + INPUT: + + rad : Angle in radians. + + OUTPUT: + + deg : Angle in degrees. + + Description: + + Convenient utility function for converting radians to degrees, which are + often the required angular units for functions in the NURBS toolbox. + + Examples: + + Convert 0.3 radians to degrees + + rad = deg2rad(0.3); + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 + + RAD2DEG: Convert radians to degrees. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +surfderivcpts + + +# name: +# type: sq_string +# elements: 1 +# length: 933 + + SURFDERIVCPTS: Compute control points of n-th derivatives of a NURBS surface. + + usage: pkl = surfderivcpts (n, p, U, m, q, V, P, d) + + INPUT: + + n+1, m+1 = number of control points + p, q = spline order + U, V = knots + P = control points + d = derivative order + + OUTPUT: + + pkl (k+1, l+1, i+1, j+1) = i,jth control point + of the surface differentiated k + times in the u direction and l + times in the v direction + + Adaptation of algorithm A3.7 from the NURBS book, pg114 + + Copyright (C) 2009 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 79 + + SURFDERIVCPTS: Compute control points of n-th derivatives of a NURBS surface. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +surfderiveval + + +# name: +# type: sq_string +# elements: 1 +# length: 870 + + SURFDERIVEVAL: Compute the derivatives of a B-spline surface + + usage: skl = surfderiveval (n, p, U, m, q, V, P, u, v, d) + + INPUT: + + n+1, m+1 = number of control points + p, q = spline order + U, V = knots + P = control points + u,v = evaluation points + d = derivative order + + OUTPUT: + + skl (k+1, l+1) = surface differentiated k + times in the u direction and l + times in the v direction + + Adaptation of algorithm A3.8 from the NURBS book, pg115 + + Copyright (C) 2009 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + SURFDERIVEVAL: Compute the derivatives of a B-spline surface + + usage: skl = s + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +tbasisfun + + +# name: +# type: sq_string +# elements: 1 +# length: 925 + + TBASISFUN: Compute a B- or T-Spline basis function, and its derivatives, from its local knot vector. + + usage: + + [N, Nder] = tbasisfun (u, p, U) + [N, Nder] = tbasisfun ([u; v], [p q], {U, V}) + [N, Nder] = tbasisfun ([u; v; w], [p q r], {U, V, W}) + + INPUT: + + u or [u; v] : points in parameter space where the basis function is to be + evaluated + + U or {U, V} : local knot vector + + p or [p q] : polynomial order of the basis function + + OUTPUT: + + N : basis function evaluated at the given parametric points + Nder : basis function gradient evaluated at the given parametric points + + Copyright (C) 2009 Carlo de Falco + Copyright (C) 2012 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + TBASISFUN: Compute a B- or T-Spline basis function, and its derivatives, from + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +vecangle + + +# name: +# type: sq_string +# elements: 1 +# length: 920 + + VECANGLE: An alternative to atan, returning an arctangent in the + range 0 to 2*pi. + + Calling Sequence: + + ang = vecmag2(num,dum) + + INPUT: + + num : Numerator, vector of size (1,nv). + dem : Denominator, vector of size (1,nv). + + OUTPUT: + ang : Arctangents, row vector of angles. + + Description: + + The components of the vector ang are the arctangent of the corresponding + enties of num./dem. This function is an alternative for + atan, returning an angle in the range 0 to 2*pi. + + Examples: + + Find the atan(1.2,2.0) and atan(1.5,3.4) using vecangle + + ang = vecangle([1.2 1.5], [2.0 3.4]); + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + VECANGLE: An alternative to atan, returning an arctangent in the + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +veccross + + +# name: +# type: sq_string +# elements: 1 +# length: 967 + + VECCROSS: The cross product of two vectors. + + Calling Sequence: + + cross = veccross(vec1,vec2); + + INPUT: + + vec1 : An array of column vectors represented by a matrix of + vec2 size (dim,nv), where is the dimension of the vector and + nv the number of vectors. + + OUTPUT: + + cross : Array of column vectors, each element is corresponding + to the cross product of the respective components in vec1 + and vec2. + + Description: + + Cross product of two vectors. + + Examples: + + Determine the cross products of: + (2.3,3.4,5.6) and (1.2,4.5,1.2) + (5.1,0.0,2.3) and (2.5,3.2,4.0) + + cross = veccross([2.3 5.1; 3.4 0.0; 5.6 2.3],[1.2 2.5; 4.5 3.2; 1.2 4.0]); + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 + + VECCROSS: The cross product of two vectors. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +vecdot + + +# name: +# type: sq_string +# elements: 1 +# length: 946 + + VECDOT: The dot product of two vectors. + + Calling Sequence: + + dot = vecdot(vec1,vec2); + + INPUT: + + vec1 : An array of column vectors represented by a matrix of + vec2 size (dim,nv), where is the dimension of the vector and + nv the number of vectors. + + OUTPUT: + + dot : Row vector of scalars, each element corresponding to + the dot product of the respective components in vec1 and + vec2. + + Description: + + Scalar dot product of two vectors. + + Examples: + + Determine the dot product of + (2.3,3.4,5.6) and (1.2,4.5,1.2) + (5.1,0.0,2.3) and (2.5,3.2,4.0) + + dot = vecdot([2.3 5.1; 3.4 0.0; 5.6 2.3],[1.2 2.5; 4.5 3.2; 1.2 4.0]); + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 + + VECDOT: The dot product of two vectors. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +vecmag + + +# name: +# type: sq_string +# elements: 1 +# length: 807 + + VECMAG: Magnitude of the vectors. + + Calling Sequence: + + mvec = vecmag(vec) + + INPUT: + + vec : An array of column vectors represented by a matrix of + size (dim,nv), where is the dimension of the vector and + nv the number of vectors. + + OUTPUT: + + mvec : Magnitude of the vectors, vector of size (1,nv). + + Description: + + Determines the magnitude of the vectors. + + Examples: + + Find the magnitude of the two vectors (0.0,2.0,1.3) and (1.5,3.4,2.3) + + mvec = vecmag([0.0 1.5; 2.0 3.4; 1.3 2.3]); + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 + + VECMAG: Magnitude of the vectors. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +vecmag2 + + +# name: +# type: sq_string +# elements: 1 +# length: 855 + + VECMAG2: Squared magnitude of a set of vectors. + + Calling Sequence: + + mvec = vecmag2(vec) + + INPUT: + + vec : An array of column vectors represented by a matrix of + size (dim,nv), where dim is the dimension of the vector and + nv the number of vectors. + + OUTPUT: + + mvec : Squared magnitude of the vectors, vector of size (1,nv). + + Description: + + Determines the squared magnitude of the vectors. + + Examples: + + Find the squared magnitude of the two vectors (0.0,2.0,1.3) + and (1.5,3.4,2.3) + + mvec = vecmag2([0.0 1.5; 2.0 3.4; 1.3 2.3]); + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 + + VECMAG2: Squared magnitude of a set of vectors. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +vecnorm + + +# name: +# type: sq_string +# elements: 1 +# length: 817 + + VECNORM: Normalise the vectors. + + Calling Sequence: + + nvec = vecnorn(vec); + + INPUT: + + vec : An array of column vectors represented by a matrix of + size (dim,nv), where is the dimension of the vector and + nv the number of vectors. + + OUTPUT: + + nvec : Normalised vectors, matrix the smae size as vec. + + Description: + + Normalises the array of vectors, returning the unit vectors. + + Examples: + + Normalise the two vectors (0.0,2.0,1.3) and (1.5,3.4,2.3) + + nvec = vecnorm([0.0 1.5; 2.0 3.4; 1.3 2.3]); + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 + + VECNORM: Normalise the vectors. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +vecrot + + +# name: +# type: sq_string +# elements: 1 +# length: 737 + + VECROT: Transformation matrix for a rotation around the axis given by a vector. + + Calling Sequence: + + rx = vecrot (angle, vector); + + INPUT: + + angle : rotation angle defined in radians + vector : vector defining the rotation axis + + OUTPUT: + + rx : (4x4) Transformation matrix. + + + Description: + + Return the (4x4) Transformation matrix for a rotation about the x axis + by the defined angle. + + See also: + + nrbtform + + Copyright (C) 2011 Rafael Vazquez + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + VECROT: Transformation matrix for a rotation around the axis given by a vecto + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +vecrotx + + +# name: +# type: sq_string +# elements: 1 +# length: 1098 + + VECROTX: Transformation matrix for a rotation around the x axis. + + Calling Sequence: + + rx = vecrotx(angle); + + INPUT: + + angle : rotation angle defined in radians + + OUTPUT: + + rx : (4x4) Transformation matrix. + + + Description: + + Return the (4x4) Transformation matrix for a rotation about the x axis + by the defined angle. + + The matrix is: + + [ 1 0 0 0] + [ 0 cos(angle) -sin(angle) 0] + [ 0 sin(angle) cos(angle) 0] + [ 0 0 0 1] + + Examples: + + Rotate the NURBS line (0.0 0.0 0.0) - (3.0 3.0 3.0) by 45 degrees + around the x-axis + + line = nrbline([0.0 0.0 0.0],[3.0 3.0 3.0]); + trans = vecrotx(%pi/4); + rline = nrbtform(line, trans); + + See also: + + nrbtform + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 + + VECROTX: Transformation matrix for a rotation around the x axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +vecroty + + +# name: +# type: sq_string +# elements: 1 +# length: 1138 + + VECROTY: Transformation matrix for a rotation around the y axis. + + Calling Sequence: + + ry = vecroty(angle); + + INPUT: + + angle : rotation angle defined in radians + + OUTPUT: + + ry : (4x4) Transformation matrix. + + + Description: + + Return the (4x4) Transformation matrix for a rotation about the y axis + by the defined angle. + + The matrix is: + + [ cos(angle) 0 sin(angle) 0] + [ 0 1 0 0] + [ -sin(angle) 0 cos(angle) 0] + [ 0 0 0 1] + + Examples: + + Rotate the NURBS line (0.0 0.0 0.0) - (3.0 3.0 3.0) by 45 degrees + around the y-axis + + line = nrbline([0.0 0.0 0.0],[3.0 3.0 3.0]); + trans = vecroty(%pi/4); + rline = nrbtform(line, trans); + + See also: + + nrbtform + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 + + VECROTY: Transformation matrix for a rotation around the y axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +vecrotz + + +# name: +# type: sq_string +# elements: 1 +# length: 1125 + + VECROTZ: Transformation matrix for a rotation around the z axis. + + Calling Sequence: + + rz = vecrotz(angle); + + INPUT: + + angle : rotation angle defined in radians + + OUTPUT: + + rz : (4x4) Transformation matrix. + + + Description: + + Return the (4x4) Transformation matrix for a rotation about the z axis + by the defined angle. + + The matrix is: + + [ cos(angle) -sin(angle) 0 0] + [ -sin(angle) cos(angle) 0 0] + [ 0 0 1 0] + [ 0 0 0 1] + + Examples: + + Rotate the NURBS line (0.0 0.0 0.0) - (3.0 3.0 3.0) by 45 degrees + around the z-axis + + line = nrbline([0.0 0.0 0.0],[3.0 3.0 3.0]); + trans = vecrotz(%pi/4); + rline = nrbtform(line, trans); + + See also: + + nrbtform + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 + + VECROTZ: Transformation matrix for a rotation around the z axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +vecscale + + +# name: +# type: sq_string +# elements: 1 +# length: 1061 + + VECSCALE: Transformation matrix for a scaling. + + Calling Sequence: + + ss = vecscale(svec) + + INPUT: + + svec : A vectors defining the scaling along the x,y and z axes. + i.e. [sx, sy, sy] + + OUTPUT: + + ss : Scaling Transformation Matrix + + Description: + + Returns a (4x4) Transformation matrix for scaling. + + The matrix is: + + [ sx 0 0 0] + [ 0 sy 0 0] + [ 0 0 sz 0] + [ 0 0 0 1] + + Example: + + Scale up the NURBS line (0.0,0.0,0.0) - (1.0,1.0,1.0) by 3 along + the x-axis, 2 along the y-axis and 4 along the z-axis. + + line = nrbline([0.0 0.0 0.0],[1.0 1.0 1.0]); + trans = vecscale([3.0 2.0 4.0]); + sline = nrbtform(line, trans); + + See also: + + nrbtform + + Copyright (C) 2000 Mark Spink, 2007 Daniel Claxton + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + + VECSCALE: Transformation matrix for a scaling. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +vectrans + + +# name: +# type: sq_string +# elements: 1 +# length: 1066 + + VECTRANS: Transformation matrix for a translation. + + Calling Sequence: + + st = vectrans(tvec) + + INPUT: + + tvec : A vectors defining the translation along the x,y and + z axes. i.e. [tx, ty, ty] + + OUTPUT: + + st : Translation Transformation Matrix + + Description: + + Returns a (4x4) Transformation matrix for translation. + + The matrix is: + + [ 1 0 0 tx ] + [ 0 1 0 ty ] + [ 0 0 1 tz ] + [ 0 0 0 1 ] + + Examples: + + Translate the NURBS line (0.0,0.0,0.0) - (1.0,1.0,1.0) by 3 along + the x-axis, 2 along the y-axis and 4 along the z-axis. + + line = nrbline([0.0 0.0 0.0],[1.0 1.0 1.0]); + trans = vectrans([3.0 2.0 4.0]); + tline = nrbtform(line, trans); + + See also: + + nrbtform + + Copyright (C) 2000 Mark Spink + + 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. + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 + + VECTRANS: Transformation matrix for a translation. + + + + + diff --git a/octave_packages/nurbs-1.3.6/findspan.m b/octave_packages/nurbs-1.3.6/findspan.m new file mode 100644 index 0000000..e0db51e --- /dev/null +++ b/octave_packages/nurbs-1.3.6/findspan.m @@ -0,0 +1,61 @@ +function s = findspan(n,p,u,U) +% FINDSPAN Find the span of a B-Spline knot vector at a parametric point +% +% Calling Sequence: +% +% s = findspan(n,p,u,U) +% +% INPUT: +% +% n - number of control points - 1 +% p - spline degree +% u - parametric point +% U - knot sequence +% +% OUTPUT: +% +% s - knot span index +% +% Modification of Algorithm A2.1 from 'The NURBS BOOK' pg68 +% +% Copyright (C) 2010 Rafael Vazquez +% +% 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 . + +if (max(u(:))>U(end) || min(u(:))= U,1,'last')-1; +end + +end + +%!test +%! n = 3; +%! U = [0 0 0 1/2 1 1 1]; +%! p = 2; +%! u = linspace(0, 1, 10); +%! s = findspan (n, p, u, U); +%! assert (s, [2*ones(1, 5) 3*ones(1, 5)]); + +%!test +%! p = 2; m = 7; n = m - p - 1; +%! U = [zeros(1,p) linspace(0,1,m+1-2*p) ones(1,p)]; +%! u = [ 0 0.11880 0.55118 0.93141 0.40068 0.35492 0.44392 0.88360 0.35414 0.92186 0.83085 1]; +%! s = [2 2 3 4 3 3 3 4 3 4 4 4]; +%! assert (findspan (n, p, u, U), s, 1e-10); diff --git a/octave_packages/nurbs-1.3.6/kntbrkdegmult.m b/octave_packages/nurbs-1.3.6/kntbrkdegmult.m new file mode 100644 index 0000000..7ab0078 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/kntbrkdegmult.m @@ -0,0 +1,122 @@ +% KNTBRKDEGMULT: Construct an open knot vector by giving the sequence of +% knots, the degree and the multiplicity. +% +% knots = kntbrkdegreg (breaks, degree) +% knots = kntbrkdegreg (breaks, degree, mult) +% +% INPUT: +% +% breaks: sequence of knots. +% degree: polynomial degree of the splines associated to the knot vector. +% mult: multiplicity of the knots. +% +% OUTPUT: +% +% knots: knot vector. +% +% If MULT has as many entries as BREAKS, or as the number of interior +% knots, a different multiplicity will be assigned to each knot. If +% MULT is not present, it will be taken equal to 1. +% +% Copyright (C) 2010 Carlo de Falco, Rafael Vazquez +% +% 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 . + +function knots = kntbrkdegmult (breaks, degree, mult) + + if (iscell (breaks)) + if (nargin == 2) + mult = 1; + end + + if (numel(breaks)~=numel(degree) || numel(breaks)~=numel(mult)) + error('kntbrkdegmult: degree and multiplicity must have the same length as the number of knot vectors') + end + + degree = num2cell (degree); + + if (~iscell (mult)) + mult = num2cell (mult); + end + + knots = cellfun (@do_kntbrkdegmult, breaks, degree, mult, 'uniformoutput', false); + + else + + if (nargin == 2) + mult = 1; + end + + knots = do_kntbrkdegmult (breaks, degree, mult); + end +end + + +function knots = do_kntbrkdegmult (breaks, degree, mult) + +if (numel (breaks) < 2) + error ('kntbrkdegmult: the knots sequence should contain at least two points') +end + +if (numel (mult) == 1) + mults = [degree+1, mult(ones (1, numel (breaks) - 2)), degree+1]; +elseif (numel (mult) == numel (breaks)) + mults = [degree+1 mult(2:end-1) degree+1]; +elseif (numel (mult) == numel (breaks) - 2) + mults = [degree+1 mult degree+1]; +else + error('kntbrkdegmult: the length of mult should be equal to one or the number of knots') +end + +if (any (mults > degree+1)) + warning ('kntbrkdegmult: some knots have higher multiplicity than the degree+1') +end + +breaks = sort (breaks); + +lm = numel (mults); +sm = sum (mults); + +mm = zeros (1,sm); +mm (cumsum ([1 reshape(mults (1:end-1), 1, lm-1)])) = ones (1,lm); +knots = breaks (cumsum (mm)); + +end + +%!test +%! breaks = [0 1 2 3 4]; +%! degree = 3; +%! knots = kntbrkdegmult (breaks, degree); +%! assert (knots, [0 0 0 0 1 2 3 4 4 4 4]) + +%!test +%! breaks = [0 1 2 3 4]; +%! degree = 3; +%! mult = 2; +%! knots = kntbrkdegmult (breaks, degree, mult); +%! assert (knots, [0 0 0 0 1 1 2 2 3 3 4 4 4 4]) + +%!test +%! breaks = [0 1 2 3 4]; +%! degree = 3; +%! mult = [1 2 3]; +%! knots = kntbrkdegmult (breaks, degree, mult); +%! assert (knots, [0 0 0 0 1 2 2 3 3 3 4 4 4 4]) + +%!test +%! breaks = {[0 1 2 3 4] [0 1 2 3]}; +%! degree = [3 2]; +%! mult = {[1 2 3] 2}; +%! knots = kntbrkdegmult (breaks, degree, mult); +%! assert (knots, {[0 0 0 0 1 2 2 3 3 3 4 4 4 4] [0 0 0 1 1 2 2 3 3 3]}) diff --git a/octave_packages/nurbs-1.3.6/kntbrkdegreg.m b/octave_packages/nurbs-1.3.6/kntbrkdegreg.m new file mode 100644 index 0000000..a3a12f6 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/kntbrkdegreg.m @@ -0,0 +1,117 @@ +% KNTBRKDEGREG: Construct an open knot vector by giving the sequence of +% knots, the degree and the regularity. +% +% knots = kntbrkdegreg (breaks, degree) +% knots = kntbrkdegreg (breaks, degree, regularity) +% +% INPUT: +% +% breaks: sequence of knots. +% degree: polynomial degree of the splines associated to the knot vector. +% regularity: splines regularity. +% +% OUTPUT: +% +% knots: knot vector. +% +% If REGULARITY has as many entries as BREAKS, or as the number of interior +% knots, a different regularity will be assigned to each knot. If +% REGULARITY is not present, it will be taken equal to DEGREE-1. +% +% Copyright (C) 2010 Carlo de Falco, Rafael Vazquez +% +% 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 . + +function knots = kntbrkdegreg (breaks, degree, reg) + +if (iscell (breaks)) + if (nargin == 2) + reg = degree - 1; + end + + if (numel(breaks)~=numel(degree) || numel(breaks)~=numel(reg)) + error('kntbrkdegreg: degree and regularity must have the same length as the number of knot vectors') + end + + degree = num2cell (degree); + + if (~iscell (reg)) + reg = num2cell (reg); + end + + knots = cellfun (@do_kntbrkdegreg, breaks, degree, reg, 'uniformoutput', false); +else + + if (nargin == 2) + reg = degree - 1; + end + + knots = do_kntbrkdegreg (breaks, degree, reg); +end + +end + +function knots = do_kntbrkdegreg (breaks, degree, reg) + +if (numel (breaks) < 2) + error ('kntbrkdegreg: the knots sequence should contain at least two points') +end + +if (numel (reg) == 1) + mults = [-1, (degree (ones (1, numel (breaks) - 2)) - reg), -1]; +elseif (numel (reg) == numel (breaks)) + mults = degree - reg; +elseif (numel (reg) == numel (breaks) - 2) + mults = [-1 degree-reg -1]; +else + error('kntbrkdegreg: the length of mult should be equal to one or the number of knots') +end + +if (any (reg < -1)) + warning ('kntbrkdegreg: for some knots the regularity is lower than -1') +elseif (any (reg > degree-1)) + error('kntbrkdegreg: the regularity should be lower than the degree') +end + +knots = kntbrkdegmult (breaks, degree, mults); + +end + +%!test +%! breaks = [0 1 2 3 4]; +%! degree = 3; +%! knots = kntbrkdegreg (breaks, degree); +%! assert (knots, [0 0 0 0 1 2 3 4 4 4 4]) + +%!test +%! breaks = [0 1 2 3 4]; +%! degree = 3; +%! reg = 1; +%! knots = kntbrkdegreg (breaks, degree, reg); +%! assert (knots, [0 0 0 0 1 1 2 2 3 3 4 4 4 4]) + +%!test +%! breaks = [0 1 2 3 4]; +%! degree = 3; +%! reg = [0 1 2]; +%! knots = kntbrkdegreg (breaks, degree, reg); +%! assert (knots, [0 0 0 0 1 1 1 2 2 3 4 4 4 4]) + +%!test +%! breaks = {[0 1 2 3 4] [0 1 2 3]}; +%! degree = [3 2]; +%! reg = {[0 1 2] 0}; +%! knots = kntbrkdegreg (breaks, degree, reg); +%! assert (knots, {[0 0 0 0 1 1 1 2 2 3 4 4 4 4] [0 0 0 1 1 2 2 3 3 3]}) + diff --git a/octave_packages/nurbs-1.3.6/kntrefine.m b/octave_packages/nurbs-1.3.6/kntrefine.m new file mode 100644 index 0000000..d1f9d63 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/kntrefine.m @@ -0,0 +1,158 @@ +% KNTREFINE: Refine a given knot vector by dividing each interval uniformly, +% maintaining the continuity in previously existing knots. +% +% [rknots] = kntrefine (knots, n_sub, degree, regularity) +% [rknots, zeta] = kntrefine (knots, n_sub, degree, regularity) +% [rknots, zeta, new_knots] = kntrefine (knots, n_sub, degree, regularity) +% +% INPUT: +% +% knots: initial knot vector. +% n_sub: number of new knots to be added in each interval. +% degree: polynomial degree of the refined knot vector +% regularity: maximum global regularity +% +% OUTPUT: +% +% rknots: refined knot vector +% zeta: refined knot vector without repetitions +% new_knots: new knots, to apply the knot insertion +% +% The regularity at the new inserted knots is the one given by the user. +% At previously existing knots, the regularity is the minimum +% between the previous regularity, and the one given by the user. +% This ensures optimal convergence rates in the context of IGA. +% +% Copyright (C) 2010 Carlo de Falco, Rafael Vazquez +% +% 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 . + +function varargout = kntrefine (knots, n_sub, degree, regularity) + + if (iscell(knots)) + if (numel(n_sub)~=numel(degree) || numel(n_sub)~=numel(regularity) || ... + numel(n_sub)~=numel(knots)) + error('kntrefine: n_sub, degree and regularity must have the same length as the number of knot vectors') + end + aux_knots = knots; + else + if (numel(n_sub)~=numel(degree) || numel(n_sub)~=numel(regularity) || ... + numel(n_sub)~=1) + error('kntrefine: n_sub, degree and regularity must have the same length as the number of knot vectors') + end + aux_knots = {knots}; + end + + if (nargout == 3) + for idim = 1:numel(n_sub) + if (degree(idim)+1 ~= sum (aux_knots{idim}==aux_knots{idim}(1))) + error ('kntrefine: new_knots is only computed when the degree is maintained'); + end + end + for idim = 1:numel(n_sub) + min_mult = degree(idim) - regularity(idim); + z = unique (aux_knots{idim}); + nz = numel (z); + deg = sum (aux_knots{idim} == z(1)) - 1; + rknots{idim} = z(ones(1, degree(idim)+1)); + new_knots{idim} = []; + + for ik = 2:nz + insk = linspace (z(ik-1), z(ik), n_sub(idim) + 2); + insk = vec (repmat (insk(2:end-1), min_mult, 1))'; + old_mult = sum (aux_knots{idim} == z(ik)); + mult = max (min_mult, degree(idim) - deg + old_mult); + rknots{idim} = [rknots{idim}, insk, z(ik*ones(1, mult))]; + new_knots{idim} = [new_knots{idim}, insk, z(ik*ones(1, mult-old_mult))]; + end + zeta{idim} = unique (rknots{idim}); + end + if (~iscell(knots)) + rknots = rknots{1}; + zeta = zeta{1}; + new_knots = new_knots{1}; + end + varargout{1} = rknots; + varargout{2} = zeta; + varargout{3} = new_knots; + else + for idim = 1:numel(n_sub) + min_mult = degree(idim) - regularity(idim); + z = unique (aux_knots{idim}); + nz = numel (z); + deg = sum (aux_knots{idim} == z(1)) - 1; + rknots{idim} = z(ones(1, degree(idim)+1)); + + for ik = 2:nz + insk = linspace (z(ik-1), z(ik), n_sub(idim) + 2); + insk = vec (repmat (insk(2:end-1), min_mult, 1))'; + old_mult = sum (aux_knots{idim} == z(ik)); + mult = max (min_mult, degree(idim) - deg + old_mult); + rknots{idim} = [rknots{idim}, insk, z(ik*ones(1, mult))]; + end + zeta{idim} = unique (rknots{idim}); + end + if (~iscell(knots)) + rknots = rknots{1}; + zeta = zeta{1}; + end + varargout{1} = rknots; + if (nargout == 2) + varargout{2} = zeta; + end + end +end + +function v = vec (in) + v = in(:); +end + +%!shared nrbs +%!test +%! knots = {[0 0 1 1] [0 0 0 1 1 1]}; +%! coefs(1,:,:) = [1 sqrt(2)/2 0; 2 sqrt(2) 0]; +%! coefs(2,:,:) = [0 sqrt(2)/2 1; 0 sqrt(2) 2]; +%! coefs(4,:,:) = [1 sqrt(2)/2 1; 1 sqrt(2)/2 1]; +%! nrbs = nrbmak (coefs, knots); +%! nrbs = nrbkntins (nrbs, {[] [0.5 0.6 0.6]}); +%! nrbs = nrbdegelev (nrbs, [0 1]); +%! nrbs = nrbkntins (nrbs, {[] [0.4]}); +%! rknots = kntrefine (nrbs.knots, [1 1], [1 1], [0 0]); +%! assert (rknots{1} == [0 0 0.5 1 1]); +%! assert (rknots{2} == [0 0 0.2 0.4 0.45 0.5 0.55 0.6 0.8 1 1]); +%! +%!test +%! rknots = kntrefine (nrbs.knots, [1 1], [3 3], [0 0]); +%! assert (rknots{1}, [0 0 0 0 0.5 0.5 0.5 1 1 1 1]); +%! assert (rknots{2}, [0 0 0 0 0.2 0.2 0.2 0.4 0.4 0.4 0.45 0.45 0.45 0.5 0.5 0.5 0.55 0.55 0.55 0.6 0.6 0.6 0.8 0.8 0.8 1 1 1 1]); +%! +%!test +%! rknots = kntrefine (nrbs.knots, [1 1], [3 3], [2 2]); +%! assert (rknots{1}, [0 0 0 0 0.5 1 1 1 1]); +%! assert (rknots{2}, [0 0 0 0 0.2 0.4 0.45 0.5 0.5 0.55 0.6 0.6 0.6 0.8 1 1 1 1]); +%! +%!test +%! rknots = kntrefine (nrbs.knots, [1 1], [4 4], [0 0]); +%! assert (rknots{1}, [0 0 0 0 0 0.5 0.5 0.5 0.5 1 1 1 1 1]); +%! assert (rknots{2}, [0 0 0 0 0 0.2 0.2 0.2 0.2 0.4 0.4 0.4 0.4 0.45 0.45 0.45 0.45 0.5 0.5 0.5 0.5 0.55 0.55 0.55 0.55 0.6 0.6 0.6 0.6 0.8 0.8 0.8 0.8 1 1 1 1 1]); +%! +%!test +%! rknots = kntrefine (nrbs.knots, [1 1], [4 4], [3 3]); +%! assert (rknots{1}, [0 0 0 0 0 0.5 1 1 1 1 1]); +%! assert (rknots{2}, [0 0 0 0 0 0.2 0.4 0.4 0.45 0.5 0.5 0.5 0.55 0.6 0.6 0.6 0.6 0.8 1 1 1 1 1]); +%! +%!test +%! knots = [0 0 0 0 0.4 0.5 0.5 0.6 0.6 0.6 1 1 1 1]; +%! rknots = kntrefine (knots, 1, 4, 3); +%! assert (rknots, [0 0 0 0 0 0.2 0.4 0.4 0.45 0.5 0.5 0.5 0.55 0.6 0.6 0.6 0.6 0.8 1 1 1 1 1]); diff --git a/octave_packages/nurbs-1.3.6/kntuniform.m b/octave_packages/nurbs-1.3.6/kntuniform.m new file mode 100644 index 0000000..2e6df46 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/kntuniform.m @@ -0,0 +1,52 @@ +% KNTUNIFORM: generate uniform open knot vectors in the reference domain. +% +% [csi, zeta] = kntuniform (num, degree, regularity) +% +% INPUT: +% +% num: number of breaks (in each direction) +% degree: polynomial degree (in each direction) +% regularity: global regularity (in each direction) +% +% OUTPUT: +% +% csi: knots +% zeta: breaks = knots without repetitions +% +% Copyright (C) 2009, 2010 Carlo de Falco +% Copyright (C) 2011 Rafael Vazquez +% +% 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 . + +function [csi, zeta] = kntuniform (num, degree, regularity) + + if (numel(num)~=numel(degree) || numel(num)~=numel(regularity)) + error('kntuniform: num, degree and regularity must have the same length') + else + for idim=1:numel(num) + zeta{idim} = linspace (0, 1, num(idim)); + rep = degree(idim) - regularity(idim); + if (rep > 0) + csi{idim} = [zeros(1, degree(idim)+1-rep)... + reshape(repmat(zeta{idim}, rep, 1), 1, []) ones(1, degree(idim)+1-rep)]; + else + error ('kntuniform: regularity requested is too high') + end + end + if (numel(num) == 1) + csi = csi{1}; + zeta = zeta{1}; + end + end +end diff --git a/octave_packages/nurbs-1.3.6/nrb4surf.m b/octave_packages/nurbs-1.3.6/nrb4surf.m new file mode 100644 index 0000000..2ae2410 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrb4surf.m @@ -0,0 +1,74 @@ +function srf = nrb4surf(p11,p12,p21,p22) +% +% NRB4SURF: Constructs a NURBS bilinear surface. +% +% Calling Sequence: +% +% srf = nrb4surf(p11,p12,p21,p22) +% +% INPUT: +% +% p11 : Cartesian coordinate of the lhs bottom corner point. +% +% p12 : Cartesian coordinate of the rhs bottom corner point. +% +% p21 : Cartesian coordinate of the lhs top corner point. +% +% p22 : Cartesian coordinate of the rhs top corner point. +% +% OUTPUT: +% +% srf : NURBS bilinear surface, see nrbmak. +% +% Description: +% +% Constructs a bilinear surface defined by four coordinates. +% +% The position of the corner points +% +% ^ V direction +% | +% ---------------- +% |p21 p22| +% | | +% | SRF | +% | | +% |p11 p12| +% -------------------> U direction +% +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +if nargin ~= 4 + error('Four corner points must be defined'); +end + +coefs = cat (1, zeros (3,2,2), ones (1,2,2)); +coefs(1:length(p11),1,1) = p11(:); +coefs(1:length(p12),2,1) = p12(:); +coefs(1:length(p21),1,2) = p21(:); +coefs(1:length(p22),2,2) = p22(:); + +knots = {[0 0 1 1] [0 0 1 1]}; +srf = nrbmak(coefs, knots); + +end + +%!demo +%! srf = nrb4surf([0.0 0.0 0.5],[1.0 0.0 -0.5],[0.0 1.0 -0.5],[1.0 1.0 0.5]); +%! nrbplot(srf,[10,10]); +%! title('Construction of a bilinear surface.'); +%! hold off diff --git a/octave_packages/nurbs-1.3.6/nrbbasisfun.m b/octave_packages/nurbs-1.3.6/nrbbasisfun.m new file mode 100644 index 0000000..b398a6f --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbbasisfun.m @@ -0,0 +1,137 @@ +function [B, id] = nrbbasisfun (points, nrb) + +% NRBBASISFUN: Basis functions for NURBS +% +% Calling Sequence: +% +% B = nrbbasisfun (u, crv) +% B = nrbbasisfun ({u, v}, srf) +% [B, N] = nrbbasisfun ({u, v}, srf) +% [B, N] = nrbbasisfun (p, srf) +% +% INPUT: +% +% u or p(1,:,:) - parametric points along u direction +% v or p(2,:,:) - parametric points along v direction +% crv - NURBS curve +% srf - NURBS surface +% +% OUTPUT: +% +% B - Value of the basis functions at the points +% size(B)=[numel(u),(p+1)] for curves +% or [numel(u)*numel(v), (p+1)*(q+1)] for surfaces +% +% N - Indices of the basis functions that are nonvanishing at each +% point. size(N) == size(B) +% +% +% Copyright (C) 2009 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 . + + if ( (nargin<2) ... + || (nargout>2) ... + || (~isstruct(nrb)) ... + || (iscell(points) && ~iscell(nrb.knots)) ... + || (~iscell(points) && iscell(nrb.knots) && (size(points,1)~=2)) ... + || (~iscell(nrb.knots) && (nargout>1)) ... + ) + error('Incorrect input arguments in nrbbasisfun'); + end + + if (~iscell(nrb.knots)) %% NURBS curve + + [B, id] = nrb_crv_basisfun__ (points, nrb); + + elseif size(nrb.knots,2) == 2 %% NURBS surface + if (iscell(points)) + [v, u] = meshgrid(points{2}, points{1}); + p = [u(:), v(:)]'; + else + p = points; + end + + [B, id] = nrb_srf_basisfun__ (p, nrb); + + else %% NURBS volume + error('The function nrbbasisfun is not yet ready for volumes') + end +end + +%!demo +%! U = [0 0 0 0 1 1 1 1]; +%! x = [0 1/3 2/3 1] ; +%! y = [0 0 0 0]; +%! w = [1 1 1 1]; +%! nrb = nrbmak ([x;y;y;w], U); +%! u = linspace(0, 1, 30); +%! B = nrbbasisfun (u, nrb); +%! xplot = sum(bsxfun(@(x,y) x.*y, B, x),2); +%! plot(xplot, B) +%! title('Cubic Bernstein polynomials') +%! hold off + +%!test +%! U = [0 0 0 0 1 1 1 1]; +%! x = [0 1/3 2/3 1] ; +%! y = [0 0 0 0]; +%! w = rand(1,4); +%! nrb = nrbmak ([x;y;y;w], U); +%! u = linspace(0, 1, 30); +%! B = nrbbasisfun (u, nrb); +%! xplot = sum(bsxfun(@(x,y) x.*y, B, x),2); +%! +%! yy = y; yy(1) = 1; +%! nrb2 = nrbmak ([x.*w;yy;y;w], U); +%! aux = nrbeval(nrb2,u); +%! %figure, plot(xplot, B(:,1), aux(1,:).', w(1)*aux(2,:).') +%! assert(B(:,1), w(1)*aux(2,:).', 1e-6) +%! +%! yy = y; yy(2) = 1; +%! nrb2 = nrbmak ([x.*w;yy;y;w], U); +%! aux = nrbeval(nrb2, u); +%! %figure, plot(xplot, B(:,2), aux(1,:).', w(2)*aux(2,:).') +%! assert(B(:,2), w(2)*aux(2,:).', 1e-6) +%! +%! yy = y; yy(3) = 1; +%! nrb2 = nrbmak ([x.*w;yy;y;w], U); +%! aux = nrbeval(nrb2,u); +%! %figure, plot(xplot, B(:,3), aux(1,:).', w(3)*aux(2,:).') +%! assert(B(:,3), w(3)*aux(2,:).', 1e-6) +%! +%! yy = y; yy(4) = 1; +%! nrb2 = nrbmak ([x.*w;yy;y;w], U); +%! aux = nrbeval(nrb2,u); +%! %figure, plot(xplot, B(:,4), aux(1,:).', w(4)*aux(2,:).') +%! assert(B(:,4), w(4)*aux(2,:).', 1e-6) + +%!test +%! p = 2; q = 3; m = 4; n = 5; +%! Lx = 1; Ly = 1; +%! nrb = nrb4surf ([0 0], [1 0], [0 1], [1 1]); +%! nrb = nrbdegelev (nrb, [p-1, q-1]); +%! aux1 = linspace(0,1,m); aux2 = linspace(0,1,n); +%! nrb = nrbkntins (nrb, {aux1(2:end-1), aux2(2:end-1)}); +%! u = rand (1, 30); v = rand (1, 10); +%! u = u - min (u); u = u / max (u); +%! v = v - min (v); v = v / max (v); +%! [B, N] = nrbbasisfun ({u, v}, nrb); +%! assert (sum(B, 2), ones(300, 1), 1e-6) +%! assert (all (all (B<=1)), true) +%! assert (all (all (B>=0)), true) +%! assert (all (all (N>0)), true) +%! assert (all (all (N <= prod (nrb.number))), true) +%! assert (max (max (N)),prod (nrb.number)) +%! assert (min (min (N)),1) \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/nrbbasisfunder.m b/octave_packages/nurbs-1.3.6/nrbbasisfunder.m new file mode 100644 index 0000000..737f534 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbbasisfunder.m @@ -0,0 +1,123 @@ +function varargout = nrbbasisfunder (points, nrb) + +% NRBBASISFUNDER: NURBS basis functions derivatives +% +% Calling Sequence: +% +% Bu = nrbbasisfunder (u, crv) +% [Bu, N] = nrbbasisfunder (u, crv) +% [Bu, Bv] = nrbbasisfunder ({u, v}, srf) +% [Bu, Bv, N] = nrbbasisfunder ({u, v}, srf) +% [Bu, Bv, N] = nrbbasisfunder (p, srf) +% +% INPUT: +% +% u or p(1,:,:) - parametric points along u direction +% v or p(2,:,:) - parametric points along v direction +% crv - NURBS curve +% srf - NURBS surface +% +% OUTPUT: +% +% Bu - Basis functions derivatives WRT direction u +% size(Bu)=[numel(u),(p+1)] for curves +% or [numel(u)*numel(v), (p+1)*(q+1)] for surfaces +% +% Bv - Basis functions derivatives WRT direction v +% size(Bv)=[numel(v),(p+1)] for curves +% or [numel(u)*numel(v), (p+1)*(q+1)] for surfaces +% +% N - Indices of the basis functions that are nonvanishing at each +% point. size(N) == size(B) +% +% Copyright (C) 2009 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 . + + + if ( (nargin<2) ... + || (nargout>3) ... + || (~isstruct(nrb)) ... + || (iscell(points) && ~iscell(nrb.knots)) ... + || (~iscell(points) && iscell(nrb.knots) && (size(points,1)~=2)) ... + || (~iscell(nrb.knots) && (nargout>2)) ... + ) + error('Incorrect input arguments in nrbbasisfun'); + end + + if (~iscell(nrb.knots)) %% NURBS curve + + [varargout{1}, varargout{2}] = nrb_crv_basisfun_der__ (points, nrb); + + elseif size(nrb.knots,2) == 2 %% NURBS surface + + if (iscell(points)) + [v, u] = meshgrid(points{2}, points{1}); + p = [u(:), v(:)]'; + else + p = points; + end + + [varargout{1}, varargout{2}, varargout{3}] = nrb_srf_basisfun_der__ (p, nrb); + + else %% NURBS volume + error('The function nrbbasisfunder is not yet ready for volumes') + end +end + +%!demo +%! U = [0 0 0 0 1 1 1 1]; +%! x = [0 1/3 2/3 1] ; +%! y = [0 0 0 0]; +%! w = [1 1 1 1]; +%! nrb = nrbmak ([x;y;y;w], U); +%! u = linspace(0, 1, 30); +%! [Bu, id] = nrbbasisfunder (u, nrb); +%! plot(u, Bu) +%! title('Derivatives of the cubic Bernstein polynomials') +%! hold off + +%!test +%! U = [0 0 0 0 1 1 1 1]; +%! x = [0 1/3 2/3 1] ; +%! y = [0 0 0 0]; +%! w = rand(1,4); +%! nrb = nrbmak ([x;y;y;w], U); +%! u = linspace(0, 1, 30); +%! [Bu, id] = nrbbasisfunder (u, nrb); +%! #plot(u, Bu) +%! assert (sum(Bu, 2), zeros(numel(u), 1), 1e-10), + +%!test +%! U = [0 0 0 0 1/2 1 1 1 1]; +%! x = [0 1/4 1/2 3/4 1] ; +%! y = [0 0 0 0 0]; +%! w = rand(1,5); +%! nrb = nrbmak ([x;y;y;w], U); +%! u = linspace(0, 1, 300); +%! [Bu, id] = nrbbasisfunder (u, nrb); +%! assert (sum(Bu, 2), zeros(numel(u), 1), 1e-10) + +%!test +%! p = 2; q = 3; m = 4; n = 5; +%! Lx = 1; Ly = 1; +%! nrb = nrb4surf ([0 0], [1 0], [0 1], [1 1]); +%! nrb = nrbdegelev (nrb, [p-1, q-1]); +%! aux1 = linspace(0,1,m); aux2 = linspace(0,1,n); +%! nrb = nrbkntins (nrb, {aux1(2:end-1), aux2(2:end-1)}); +%! nrb.coefs (4,:,:) = nrb.coefs(4,:,:) + rand (size (nrb.coefs (4,:,:))); +%! [Bu, Bv, N] = nrbbasisfunder ({rand(1, 20), rand(1, 20)}, nrb); +%! #plot3(squeeze(u(1,:,:)), squeeze(u(2,:,:)), reshape(Bu(:,10), 20, 20),'o') +%! assert (sum (Bu, 2), zeros(20^2, 1), 1e-10) + diff --git a/octave_packages/nurbs-1.3.6/nrbcirc.m b/octave_packages/nurbs-1.3.6/nrbcirc.m new file mode 100644 index 0000000..435ef91 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbcirc.m @@ -0,0 +1,123 @@ +function curve = nrbcirc(radius,center,sang,eang) +% +% NRBCIRC: Construct a circular arc. +% +% Calling Sequence: +% +% crv = nrbcirc() +% crv = nrbcirc(radius) +% crv = nrbcirc(radius,center) +% crv = nrbcirc(radius,center,sang,eang) +% +% INPUT: +% +% radius : Radius of the circle, default 1.0 +% +% center : Center of the circle, default (0,0,0) +% +% sang : Start angle, default 0 radians (0 degrees) +% +% eang : End angle, default 2*pi radians (360 degrees) +% +% OUTPUT: +% +% crv : NURBS curve for a circular arc. +% +% Description: +% +% Constructs NURBS data structure for a circular arc in the x-y plane. If +% no rhs arguments are supplied a unit circle with center (0.0,0.0) is +% constructed. +% +% Angles are defined as positive in the anti-clockwise direction. +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +if nargin < 1 + radius = 1; +end + +if nargin < 2 + center = []; +end + +if nargin < 4 + sang = 0; + eang = 2*pi; +end + +sweep = eang - sang; % sweep angle of arc +if sweep < 0 + sweep = 2*pi + sweep; +end + +if abs(sweep) <= pi/2 + narcs = 1; % number of arc segments + knots = [0 0 0 1 1 1]; +elseif abs(sweep) <= pi + narcs = 2; + knots = [0 0 0 0.5 0.5 1 1 1]; +elseif abs(sweep) <= 3*pi/2 + narcs = 3; + knots = [0 0 0 1/3 1/3 2/3 2/3 1 1 1]; +else + narcs = 4; + knots = [0 0 0 0.25 0.25 0.5 0.5 0.75 0.75 1 1 1]; +end + +dsweep = sweep/(2*narcs); % arc segment sweep angle/2 + +% determine middle control point and weight +wm = cos(dsweep); +x = radius*wm; +y = radius*sin(dsweep); +xm = x+y*tan(dsweep); + +% arc segment control points +ctrlpt = [ x wm*xm x; % w*x - coordinate + -y 0 y; % w*y - coordinate + 0 0 0; % w*z - coordinate + 1 wm 1]; % w - coordinate + +% build up complete arc from rotated segments +coefs = zeros(4,2*narcs+1); % nurbs control points of arc +xx = vecrotz(sang + dsweep); +coefs(:,1:3) = xx*ctrlpt; % rotate to start angle +xx = vecrotz(2*dsweep); +for n = 2:narcs + m = 2*n+[0 1]; + coefs(:,m) = xx*coefs(:,m-2); +end + +% vectrans arc if necessary +if ~isempty(center) + xx = vectrans(center); + coefs = xx*coefs; +end + +curve = nrbmak(coefs,knots); + +end + +%!demo +%! for r = 1:9 +%! crv = nrbcirc(r,[],deg2rad(45),deg2rad(315)); +%! nrbplot(crv,50); +%! hold on; +%! end +%! hold off; +%! axis equal; +%! title('NURBS construction of several 2D arcs.'); diff --git a/octave_packages/nurbs-1.3.6/nrbcoons.m b/octave_packages/nurbs-1.3.6/nrbcoons.m new file mode 100644 index 0000000..bdbadeb --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbcoons.m @@ -0,0 +1,181 @@ +function srf = nrbcoons(u1, u2, v1, v2) +% +% NRBCOONS: Construction of a Coons patch. +% +% Calling Sequence: +% +% srf = nrbcoons(ucrv1, ucrv2, vcrv1, vcrv2) +% +% INPUT: +% +% ucrv1 : NURBS curve defining the bottom U direction boundary of +% the constructed NURBS surface. +% +% ucrv2 : NURBS curve defining the top U direction boundary of +% the constructed NURBS surface. +% +% vcrv1 : NURBS curve defining the bottom V direction boundary of +% the constructed NURBS surface. +% +% vcrv2 : NURBS curve defining the top V direction boundary of +% the constructed NURBS surface. +% +% OUTPUT: +% +% srf : Coons NURBS surface patch. +% +% Description: +% +% Construction of a bilinearly blended Coons surface patch from four NURBS +% curves that define the boundary. +% +% The orientation of the four NURBS boundary curves. +% +% ^ V direction +% | +% | ucrv2 +% ------->-------- +% | | +% | | +% vcrv1 ^ Surface ^ vcrv2 +% | | +% | | +% ------->-----------> U direction +% ucrv1 +% +% +% Examples: +% +% // Define four NURBS curves and construct a Coons surface patch. +% pnts = [ 0.0 3.0 4.5 6.5 8.0 10.0; +% 0.0 0.0 0.0 0.0 0.0 0.0; +% 2.0 2.0 7.0 4.0 7.0 9.0]; +% crv1 = nrbmak(pnts, [0 0 0 1/3 0.5 2/3 1 1 1]); +% +% pnts= [ 0.0 3.0 5.0 8.0 10.0; +% 10.0 10.0 10.0 10.0 10.0; +% 3.0 5.0 8.0 6.0 10.0]; +% crv2 = nrbmak(pnts, [0 0 0 1/3 2/3 1 1 1]); +% +% pnts= [ 0.0 0.0 0.0 0.0; +% 0.0 3.0 8.0 10.0; +% 2.0 0.0 5.0 3.0]; +% crv3 = nrbmak(pnts, [0 0 0 0.5 1 1 1]); +% +% pnts= [ 10.0 10.0 10.0 10.0 10.0; +% 0.0 3.0 5.0 8.0 10.0; +% 9.0 7.0 7.0 10.0 10.0]; +% crv4 = nrbmak(pnts, [0 0 0 0.25 0.75 1 1 1]); +% +% srf = nrbcoons(crv1, crv2, crv3, crv4); +% nrbplot(srf,[20 20],220,45); +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +if nargin ~= 4 + error('Incorrect number of input arguments'); +end + +r1 = nrbruled(u1, u2); +r2 = nrbtransp(nrbruled(v1, v2)); +t = nrb4surf(u1.coefs(:,1), u1.coefs(:,end), u2.coefs(:,1), u2.coefs(:,end)); + +% raise all surfaces to a common degree +du = max([r1.order(1), r2.order(1), t.order(1)]); +dv = max([r1.order(2), r2.order(2), t.order(2)]); +r1 = nrbdegelev(r1, [du - r1.order(1), dv - r1.order(2)]); +r2 = nrbdegelev(r2, [du - r2.order(1), dv - r2.order(2)]); +t = nrbdegelev(t, [du - t.order(1), dv - t.order(2)]); + +% merge the knot vectors, to obtain a common knot vector + +% U knots +k1 = r1.knots{1}; +k2 = r2.knots{1}; +k3 = t.knots{1}; +k = unique([k1 k2 k3]); +n = length(k); +kua = []; +kub = []; +kuc = []; +for i = 1:n + i1 = length(find(k1 == k(i))); + i2 = length(find(k2 == k(i))); + i3 = length(find(k3 == k(i))); + m = max([i1, i2, i3]); + kua = [kua k(i)*ones(1,m-i1)]; + kub = [kub k(i)*ones(1,m-i2)]; + kuc = [kuc k(i)*ones(1,m-i3)]; +end + +% V knots +k1 = r1.knots{2}; +k2 = r2.knots{2}; +k3 = t.knots{2}; +k = unique([k1 k2 k3]); +n = length(k); +kva = []; +kvb = []; +kvc = []; +for i = 1:n + i1 = length(find(k1 == k(i))); + i2 = length(find(k2 == k(i))); + i3 = length(find(k3 == k(i))); + m = max([i1, i2, i3]); + kva = [kva k(i)*ones(1,m-i1)]; + kvb = [kvb k(i)*ones(1,m-i2)]; + kvc = [kvc k(i)*ones(1,m-i3)]; +end + +r1 = nrbkntins(r1, {kua, kva}); +r2 = nrbkntins(r2, {kub, kvb}); +t = nrbkntins(t, {kuc, kvc}); + +% combine coefficient to construct Coons surface +coefs(1,:,:) = r1.coefs(1,:,:) + r2.coefs(1,:,:) - t.coefs(1,:,:); +coefs(2,:,:) = r1.coefs(2,:,:) + r2.coefs(2,:,:) - t.coefs(2,:,:); +coefs(3,:,:) = r1.coefs(3,:,:) + r2.coefs(3,:,:) - t.coefs(3,:,:); +coefs(4,:,:) = r1.coefs(4,:,:) + r2.coefs(4,:,:) - t.coefs(4,:,:); +srf = nrbmak(coefs, r1.knots); + +end + +%!demo +%! pnts = [ 0.0 3.0 4.5 6.5 8.0 10.0; +%! 0.0 0.0 0.0 0.0 0.0 0.0; +%! 2.0 2.0 7.0 4.0 7.0 9.0]; +%! crv1 = nrbmak(pnts, [0 0 0 1/3 0.5 2/3 1 1 1]); +%! +%! pnts= [ 0.0 3.0 5.0 8.0 10.0; +%! 10.0 10.0 10.0 10.0 10.0; +%! 3.0 5.0 8.0 6.0 10.0]; +%! crv2 = nrbmak(pnts, [0 0 0 1/3 2/3 1 1 1]); +%! +%! pnts= [ 0.0 0.0 0.0 0.0; +%! 0.0 3.0 8.0 10.0; +%! 2.0 0.0 5.0 3.0]; +%! crv3 = nrbmak(pnts, [0 0 0 0.5 1 1 1]); +%! +%! pnts= [ 10.0 10.0 10.0 10.0 10.0; +%! 0.0 3.0 5.0 8.0 10.0; +%! 9.0 7.0 7.0 10.0 10.0]; +%! crv4 = nrbmak(pnts, [0 0 0 0.25 0.75 1 1 1]); +%! +%! srf = nrbcoons(crv1, crv2, crv3, crv4); +%! +%! nrbplot(srf,[20 20]); +%! title('Construction of a bilinearly blended Coons surface.'); +%! hold off diff --git a/octave_packages/nurbs-1.3.6/nrbcrvderiveval.m b/octave_packages/nurbs-1.3.6/nrbcrvderiveval.m new file mode 100644 index 0000000..dc74c12 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbcrvderiveval.m @@ -0,0 +1,79 @@ +function ck = nrbcrvderiveval (crv, u, d) + +% +% NRBCRVDERIVEVAL: Evaluate n-th order derivatives of a NURBS curve. +% +% usage: skl = nrbcrvderiveval (crv, u, d) +% +% INPUT: +% +% crv : NURBS curve structure, see nrbmak +% +% u : parametric coordinate of the points where we compute the derivatives +% +% d : number of partial derivatives to compute +% +% +% OUTPUT: +% +% ck (i, j, l) = i-th component derived j-1 times at the l-th point. +% +% Adaptation of algorithm A4.2 from the NURBS book, pg127 +% +% Copyright (C) 2010 Carlo de Falco, Rafael Vazquez +% +% 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 . + + ck = zeros (3, d+1, numel(u)); + + for iu = 1:numel(u); + wders = squeeze (curvederiveval (crv.number-1, crv.order-1, ... + crv.knots, squeeze (crv.coefs(4, :)), u(iu), d)); + + for idim = 1:3 + Aders = squeeze (curvederiveval (crv.number-1, crv.order-1, ... + crv.knots, squeeze (crv.coefs(idim, :)), u(iu), d)); + for k=0:d + v = Aders(k+1); + for i=1:k + v = v - nchoosek(k,i)*wders(i+1)*ck(idim, k-i+1, iu); + end + ck(idim, k+1, iu) = v/wders(1); + end + end + end +end + +%!test +%! knots = [0 0 0 1 1 1]; +%! coefs(:,1) = [0; 0; 0; 1]; +%! coefs(:,2) = [1; 0; 1; 1]; +%! coefs(:,3) = [1; 1; 1; 2]; +%! crv = nrbmak (coefs, knots); +%! u = linspace (0, 1, 10); +%! ck = nrbcrvderiveval (crv, u, 2); +%! w = @(x) 1 + x.^2; +%! dw = @(x) 2*x; +%! F1 = @(x) (2*x - x.^2)./w(x); +%! F2 = @(x) x.^2./w(x); +%! F3 = @(x) (2*x - x.^2)./w(x); +%! dF1 = @(x) (2 - 2*x)./w(x) - 2*(2*x - x.^2).*x./w(x).^2; +%! dF2 = @(x) 2*x./w(x) - 2*x.^3./w(x).^2; +%! dF3 = @(x) (2 - 2*x)./w(x) - 2*(2*x - x.^2).*x./w(x).^2; +%! d2F1 = @(x) -2./w(x) - 2*x.*(2-2*x)./w(x).^2 - (8*x-6*x.^2)./w(x).^2 + 8*x.^2.*(2*x-x.^2)./w(x).^3; +%! d2F2 = @(x) 2./w(x) - 4*x.^2./w(x).^2 - 6*x.^2./w(x).^2 + 8*x.^4./w(x).^3; +%! d2F3 = @(x) -2./w(x) - 2*x.*(2-2*x)./w(x).^2 - (8*x-6*x.^2)./w(x).^2 + 8*x.^2.*(2*x-x.^2)./w(x).^3; +%! assert ([F1(u); F2(u); F3(u)], squeeze(ck(:, 1, :)), 1e2*eps); +%! assert ([dF1(u); dF2(u); dF3(u)], squeeze(ck(:, 2, :)), 1e2*eps); +%! assert ([d2F1(u); d2F2(u); d2F3(u)], squeeze(ck(:, 3, :)), 1e2*eps); diff --git a/octave_packages/nurbs-1.3.6/nrbctrlplot.m b/octave_packages/nurbs-1.3.6/nrbctrlplot.m new file mode 100644 index 0000000..5b976ba --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbctrlplot.m @@ -0,0 +1,104 @@ +function nrbctrlplot (nurbs) + +% NRBCTRLPLOT: Plot a NURBS entity along with its control points. +% +% Calling Sequence: +% +% nrbctrlplot (nurbs) +% +% INPUT: +% +% nurbs: NURBS curve or surface, see nrbmak. +% +% Example: +% +% Plot the test curve and test surface with their control polygon and +% control net, respectively +% +% nrbctrlplot(nrbtestcrv) +% nrbctrlplot(nrbtestsrf) +% +% See also: +% +% nrbkntplot +% +% Copyright (C) 2011 Rafael Vazquez +% +% 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 . + +if (nargin < 1) + error ('nrbctrlplot: Need a NURBS to plot!'); +end + +% Default values +light='on'; +cmap='summer'; + +colormap (cmap); + +hold_flag = ishold; + +if (iscell (nurbs.knots)) + if (size (nurbs.knots,2) == 3) + error ('nrbctrlplot: not implemented for NURBS volumes'); + elseif (size (nurbs.knots,2) == 2) % plot a NURBS surface + + nsub = 100; + nrbplot (nurbs, [nsub nsub], 'light', light, 'colormap', cmap); + hold on + +% And plot the control net + for ii = 1:size (nurbs.coefs, 2) + coefs = reshape (nurbs.coefs(1:3,ii,:), 3, []); + weights = reshape (nurbs.coefs(4,ii,:), 1, []); + plot3 (coefs(1,:)./weights, coefs(2,:)./weights, coefs(3,:)./weights,'k--') + plot3 (coefs(1,:)./weights, coefs(2,:)./weights, coefs(3,:)./weights,'r.','MarkerSize',20) + end + for jj = 1:size (nurbs.coefs, 3) + coefs = reshape (nurbs.coefs(1:3,:,jj), 3, []); + weights = reshape (nurbs.coefs(4,:,jj), 1, []); + plot3 (coefs(1,:)./weights, coefs(2,:)./weights, coefs(3,:)./weights,'k--') + plot3 (coefs(1,:)./weights, coefs(2,:)./weights, coefs(3,:)./weights,'r.','MarkerSize',20) + end + end +else % plot a NURBS curve + nsub = 1000; + nrbplot (nurbs, nsub); + hold on + +% And plot the control polygon + coefs = nurbs.coefs(1:3,:); + weights = nurbs.coefs(4,:); + plot3 (coefs(1,:)./weights, coefs(2,:)./weights, coefs(3,:)./weights,'k--') + plot3 (coefs(1,:)./weights, coefs(2,:)./weights, coefs(3,:)./weights,'r.','MarkerSize',20) +end + +if (~hold_flag) + hold off +end + +end + +%!demo +%! crv = nrbtestcrv; +%! nrbctrlplot(crv) +%! title('Test curve') +%! hold off + +%!demo +%! srf = nrbtestsrf; +%! nrbctrlplot(srf) +%! title('Test surface') +%! hold off + diff --git a/octave_packages/nurbs-1.3.6/nrbcylind.m b/octave_packages/nurbs-1.3.6/nrbcylind.m new file mode 100644 index 0000000..a75aa08 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbcylind.m @@ -0,0 +1,74 @@ +function surf = nrbcylind(height,radius,center,sang,eang) +% +% NRBCYLIND: Construct a cylinder or cylindrical patch. +% +% Calling Sequence: +% +% srf = nrbcylind() +% srf = nrbcylind(height) +% srf = nrbcylind(height,radius) +% srf = nrbcylind(height,radius,center) +% srf = nrbcylind(height,radius,center,sang,eang) +% +% INPUT: +% +% height : Height of the cylinder along the axis, default 1.0 +% +% radius : Radius of the cylinder, default 1.0 +% +% center : Center of the cylinder, default (0,0,0) +% +% sang : Start angle relative to the origin, default 0. +% +% eang : End angle relative to the origin, default 2*pi. +% +% OUTPUT: +% +% srf : cylindrical surface patch +% +% Description: +% +% Construct a cylinder or cylindrical patch by extruding a circular arc. +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +if nargin < 1 + height = 1; +end + +if nargin < 2 + radius = 1; +end + +if nargin < 3 + center = []; +end + +if nargin < 5 + sang = 0; + eang = 2*pi; +end + +surf = nrbextrude(nrbcirc(radius,center,sang,eang),[0.0 0.0 height]); + +end + +%!demo +%! srf = nrbcylind(3,1,[],deg2rad(270),deg2rad(180)); +%! nrbplot(srf,[20,20]); +%! axis equal; +%! title('Cylinderical section by extrusion of a circular arc.'); +%! hold off \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/nrbdegelev.m b/octave_packages/nurbs-1.3.6/nrbdegelev.m new file mode 100644 index 0000000..c58c56f --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbdegelev.m @@ -0,0 +1,173 @@ +function inurbs = nrbdegelev(nurbs, ntimes) +% +% NRBDEGELEV: Elevate the degree of the NURBS curve, surface or volume. +% +% Calling Sequence: +% +% ecrv = nrbdegelev(crv,utimes); +% esrf = nrbdegelev(srf,[utimes,vtimes]); +% evol = nrbdegelev(vol,[utimes,vtimes,wtimes]); +% +% INPUT: +% +% crv : NURBS curve, see nrbmak. +% +% srf : NURBS surface, see nrbmak. +% +% vol : NURBS volume, see nrbmak. +% +% utimes : Increase the degree along U direction utimes. +% +% vtimes : Increase the degree along V direction vtimes. +% +% wtimes : Increase the degree along W direction vtimes. +% +% OUTPUT: +% +% ecrv : new NURBS structure for a curve with degree elevated. +% +% esrf : new NURBS structure for a surface with degree elevated. +% +% evol : new NURBS structure for a volume with degree elevated. +% +% +% Description: +% +% Degree elevates the NURBS curve or surface. This function uses the +% B-Spline function bspdegelev, which interface to an internal 'C' +% routine. +% +% Examples: +% +% Increase the NURBS surface twice along the V direction. +% esrf = nrbdegelev(srf, [0, 2]); +% +% See also: +% +% bspdegelev +% +% Copyright (C) 2000 Mark Spink, 2010 Rafel Vazquez +% +% 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 . + +if nargin < 2 + error('Input argument must include the NURBS and degree increment.'); +end + +if ~isstruct(nurbs) + error('NURBS representation is not structure!'); +end + +if ~strcmp(nurbs.form,'B-NURBS') + error('Not a recognised NURBS representation'); +end + +degree = nurbs.order-1; + +if iscell(nurbs.knots) + if size(nurbs.knots,2) == 3 + % NURBS represents a volume + [dim,num1,num2,num3] = size(nurbs.coefs); + + % Degree elevate along the w direction + if ntimes(3) == 0 + coefs = nurbs.coefs; + knots{3} = nurbs.knots{3}; + else + coefs = reshape(nurbs.coefs,4*num1*num2,num3); + [coefs,knots{3}] = bspdegelev(degree(3),coefs,nurbs.knots{3},ntimes(3)); + num3 = size(coefs,2); + coefs = reshape(coefs,[4 num1 num2 num3]); + end + + % Degree elevate along the v direction + if ntimes(2) == 0 + knots{2} = nurbs.knots{2}; + else + coefs = permute(coefs,[1 2 4 3]); + coefs = reshape(coefs,4*num1*num3,num2); + [coefs,knots{2}] = bspdegelev(degree(2),coefs,nurbs.knots{2},ntimes(2)); + num2 = size(coefs,2); + coefs = reshape(coefs,[4 num1 num3 num2]); + coefs = permute(coefs,[1 2 4 3]); + end + + % Degree elevate along the u direction + if ntimes(1) == 0 + knots{1} = nurbs.knots{1}; + else + coefs = permute(coefs,[1 3 4 2]); + coefs = reshape(coefs,4*num2*num3,num1); + [coefs,knots{1}] = bspdegelev(degree(1),coefs,nurbs.knots{1},ntimes(1)); + coefs = reshape(coefs,[4 num2 num3 size(coefs,2)]); + coefs = permute(coefs,[1 4 2 3]); + end + + elseif size(nurbs.knots,2) == 2 + % NURBS represents a surface + [dim,num1,num2] = size(nurbs.coefs); + + % Degree elevate along the v direction + if ntimes(2) == 0 + coefs = nurbs.coefs; + knots{2} = nurbs.knots{2}; + else + coefs = reshape(nurbs.coefs,4*num1,num2); + [coefs,knots{2}] = bspdegelev(degree(2),coefs,nurbs.knots{2},ntimes(2)); + num2 = size(coefs,2); + coefs = reshape(coefs,[4 num1 num2]); + end + + % Degree elevate along the u direction + if ntimes(1) == 0 + knots{1} = nurbs.knots{1}; + else + coefs = permute(coefs,[1 3 2]); + coefs = reshape(coefs,4*num2,num1); + [coefs,knots{1}] = bspdegelev(degree(1),coefs,nurbs.knots{1},ntimes(1)); + coefs = reshape(coefs,[4 num2 size(coefs,2)]); + coefs = permute(coefs,[1 3 2]); + end + end +else + + % NURBS represents a curve + if isempty(ntimes) + coefs = nurbs.coefs; + knots = nurbs.knots; + else + [coefs,knots] = bspdegelev(degree,nurbs.coefs,nurbs.knots,ntimes); + end + +end + +% construct new NURBS +inurbs = nrbmak(coefs,knots); + +end + +%!demo +%! crv = nrbtestcrv; +%! plot(crv.coefs(1,:),crv.coefs(2,:),'bo') +%! title('Degree elevation along test curve: curve and control polygons.'); +%! hold on; +%! plot(crv.coefs(1,:),crv.coefs(2,:),'b--'); +%! nrbplot(crv,48); +%! +%! icrv = nrbdegelev(crv, 1); +%! +%! plot(icrv.coefs(1,:),icrv.coefs(2,:),'ro') +%! plot(icrv.coefs(1,:),icrv.coefs(2,:),'r--'); +%! +%! hold off; diff --git a/octave_packages/nurbs-1.3.6/nrbderiv.m b/octave_packages/nurbs-1.3.6/nrbderiv.m new file mode 100644 index 0000000..ab58908 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbderiv.m @@ -0,0 +1,503 @@ +function varargout = nrbderiv (nurbs) +% +% NRBDERIV: Construct the first and second derivative representation of a +% NURBS curve, surface or volume. +% +% Calling Sequence: +% +% ders = nrbderiv (nrb); +% [ders, ders2] = nrbderiv (nrb); +% +% INPUT: +% +% nrb : NURBS data structure, see nrbmak. +% +% OUTPUT: +% +% ders: A data structure that represents the first +% derivatives of a NURBS curve, surface or volume. +% ders2: A data structure that represents the second +% derivatives of a NURBS curve, surface or volume. +% +% Description: +% +% The derivatives of a B-Spline are themselves a B-Spline of lower degree, +% giving an efficient means of evaluating multiple derivatives. However, +% although the same approach can be applied to NURBS, the situation for +% NURBS is more complex. We have followed in this function the same idea +% that was already used for the first derivative in the function nrbderiv. +% The second derivative data structure can be evaluated later with the +% function nrbdeval. +% +% See also: +% +% nrbdeval +% +% Copyright (C) 2000 Mark Spink +% Copyright (C) 2010 Carlo de Falco +% Copyright (C) 2010, 2011 Rafael Vazquez +% +% 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 . + +if (~isstruct(nurbs)) + error('NURBS representation is not structure!'); +end + +if (~strcmp(nurbs.form,'B-NURBS')) + error('Not a recognised NURBS representation'); +end + +% We raise the degree to avoid errors in the computation of the second +% derivative +if (iscell (nurbs.knots)) + ndim = size(nurbs.knots, 2); +else + ndim = 1; +end + +if (nargout == 2) + degelev = max (2*ones(1, ndim) - (nurbs.order-1), 0); + nurbs = nrbdegelev (nurbs, degelev); +end + +degree = nurbs.order - 1; + +if (ndim == 3) +% NURBS structure represents a volume + num1 = nurbs.number(1); + num2 = nurbs.number(2); + num3 = nurbs.number(3); + +% taking derivatives along the u direction + dknots = nurbs.knots; + dcoefs = permute (nurbs.coefs,[1 3 4 2]); + dcoefs = reshape (dcoefs,4*num2*num3,num1); + [dcoefs,dknots{1}] = bspderiv (degree(1),dcoefs,nurbs.knots{1}); + dcoefs = permute (reshape (dcoefs,[4 num2 num3 size(dcoefs,2)]),[1 4 2 3]); + dnurbs{1} = nrbmak (dcoefs, dknots); + + if (nargout == 2) +% taking second derivative along the u direction (duu) + dknots2 = dknots; + dcoefs2 = permute (dcoefs, [1 3 4 2]); + dcoefs2 = reshape (dcoefs2, 4*num2*num3, []); + [dcoefs2, dknots2{1}] = bspderiv (degree(1)-1, dcoefs2, dknots{1}); + dcoefs2 = permute (reshape (dcoefs2, 4, num2, num3, []), [1 4 2 3]); + dnurbs2{1,1} = nrbmak (dcoefs2, dknots2); + +% taking second derivative along the v direction (duv and dvu) + dknots2 = dknots; + dcoefs2 = permute (dcoefs,[1 2 4 3]); + dcoefs2 = reshape (dcoefs2, 4*(num1-1)*num3, num2); + [dcoefs2, dknots2{2}] = bspderiv (degree(2), dcoefs2, dknots{2}); + dcoefs2 = permute (reshape (dcoefs2, 4, num1-1, num3, []), [1 2 4 3]); + dnurbs2{1,2} = nrbmak (dcoefs2, dknots2); + dnurbs2{2,1} = dnurbs2{1,2}; + +% taking second derivative along the w direction (duw and dwu) + dknots2 = dknots; + dcoefs2 = reshape (dcoefs, 4*(num1-1)*num2, num3); + [dcoefs2, dknots2{3}] = bspderiv (degree(3), dcoefs2, dknots{3}); + dcoefs2 = reshape (dcoefs2, 4, num1-1, num2, []); + dnurbs2{1,3} = nrbmak (dcoefs2, dknots2); + dnurbs2{3,1} = dnurbs2{1,3}; + end + +% taking derivatives along the v direction + dknots = nurbs.knots; + dcoefs = permute (nurbs.coefs,[1 2 4 3]); + dcoefs = reshape (dcoefs,4*num1*num3,num2); + [dcoefs,dknots{2}] = bspderiv (degree(2),dcoefs,nurbs.knots{2}); + dcoefs = permute (reshape (dcoefs,[4 num1 num3 size(dcoefs,2)]),[1 2 4 3]); + dnurbs{2} = nrbmak (dcoefs, dknots); + + if (nargout == 2) +% taking second derivative along the v direction (dvv) + dknots2 = dknots; + dcoefs2 = permute (dcoefs,[1 2 4 3]); + dcoefs2 = reshape (dcoefs2, 4*num1*num3, num2-1); + [dcoefs2, dknots2{2}] = bspderiv (degree(2)-1, dcoefs2, dknots{2}); + dcoefs2 = permute (reshape (dcoefs2, 4, num1, num3, []), [1 2 4 3]); + dnurbs2{2,2} = nrbmak (dcoefs2, dknots2); + +% taking second derivative along the w direction (dvw and dwv) + dknots2 = dknots; + dcoefs2 = reshape (dcoefs, 4*num1*(num2-1), num3); + [dcoefs2, dknots2{3}] = bspderiv (degree(3), dcoefs2, dknots{3}); + dcoefs2 = reshape (dcoefs2, 4, num1, num2-1, []); + dnurbs2{2,3} = nrbmak (dcoefs2, dknots2); + dnurbs2{3,2} = dnurbs2{2,3}; + end + +% taking derivatives along the w direction + dknots = nurbs.knots; + dcoefs = reshape (nurbs.coefs,4*num1*num2,num3); + [dcoefs,dknots{3}] = bspderiv (degree(3),dcoefs,nurbs.knots{3}); + dcoefs = reshape (dcoefs,[4 num1 num2 size(dcoefs,2)]); + dnurbs{3} = nrbmak (dcoefs, dknots); + + if (nargout == 2) +% taking second derivative along the w direction (dww) + dknots2 = dknots; + dcoefs2 = reshape (dcoefs, 4*num1*num2, num3-1); + [dcoefs2, dknots2{3}] = bspderiv (degree(3)-1, dcoefs2, dknots{3}); + dcoefs2 = reshape (dcoefs2, 4, num1, num2, []); + dnurbs2{3,3} = nrbmak (dcoefs2, dknots2); + end + +elseif (ndim == 2) +% NURBS structure represents a surface + num1 = nurbs.number(1); + num2 = nurbs.number(2); + +% taking first derivative along the u direction + dknots = nurbs.knots; + dcoefs = permute (nurbs.coefs,[1 3 2]); + dcoefs = reshape (dcoefs,4*num2,num1); + [dcoefs,dknots{1}] = bspderiv (degree(1),dcoefs,nurbs.knots{1}); + dcoefs = permute (reshape (dcoefs,[4 num2 size(dcoefs,2)]),[1 3 2]); + dnurbs{1} = nrbmak (dcoefs, dknots); + + if (nargout == 2) +% taking second derivative along the u direction (duu) + dknots2 = dknots; + dcoefs2 = permute (dcoefs, [1 3 2]); + dcoefs2 = reshape (dcoefs2, 4*num2, []); + [dcoefs2, dknots2{1}] = bspderiv (degree(1)-1, dcoefs2, dknots{1}); + dcoefs2 = permute (reshape (dcoefs2, 4, num2, []), [1 3 2]); + dnurbs2{1,1} = nrbmak (dcoefs2, dknots2); + +% taking second derivative along the v direction (duv and dvu) + dknots2 = dknots; + dcoefs2 = reshape (dcoefs, 4*(num1-1), num2); + [dcoefs2, dknots2{2}] = bspderiv (degree(2), dcoefs2, dknots{2}); + dcoefs2 = reshape (dcoefs2, 4, num1-1, []); + dnurbs2{1,2} = nrbmak (dcoefs2, dknots2); + dnurbs2{2,1} = dnurbs2{1,2}; + end + +% taking first derivative along the v direction + dknots = nurbs.knots; + dcoefs = reshape (nurbs.coefs,4*num1,num2); + [dcoefs,dknots{2}] = bspderiv (degree(2),dcoefs,nurbs.knots{2}); + dcoefs = reshape (dcoefs,[4 num1 size(dcoefs,2)]); + dnurbs{2} = nrbmak (dcoefs, dknots); + + if (nargout == 2) +% taking second derivative along the v direction (dvv) + dknots2 = dknots; + dcoefs2 = reshape (dcoefs, 4*num1, num2-1); + [dcoefs2, dknots2{2}] = bspderiv (degree(2)-1, dcoefs2, dknots{2}); + dcoefs2 = reshape (dcoefs2, 4, num1, []); + dnurbs2{2,2} = nrbmak (dcoefs2, dknots2); + end + +else + % NURBS structure represents a curve + [dcoefs,dknots] = bspderiv (degree, nurbs.coefs, nurbs.knots); + dnurbs = nrbmak (dcoefs, dknots); + if (nargout == 2) + [dcoefs2,dknots2] = bspderiv (degree-1, dcoefs, dknots); + dnurbs2 = nrbmak (dcoefs2, dknots2); + end +end + +varargout{1} = dnurbs; +if (nargout == 2) + varargout{2} = dnurbs2; +end + +end + +%!demo +%! crv = nrbtestcrv; +%! nrbplot(crv,48); +%! title('First derivatives along a test curve.'); +%! +%! tt = linspace(0.0,1.0,9); +%! +%! dcrv = nrbderiv(crv); +%! +%! [p1, dp] = nrbdeval(crv,dcrv,tt); +%! +%! p2 = vecnorm(dp); +%! +%! hold on; +%! plot(p1(1,:),p1(2,:),'ro'); +%! h = quiver(p1(1,:),p1(2,:),p2(1,:),p2(2,:),0); +%! set(h,'Color','black'); +%! hold off; + +%!demo +%! srf = nrbtestsrf; +%! p = nrbeval(srf,{linspace(0.0,1.0,20) linspace(0.0,1.0,20)}); +%! h = surf(squeeze(p(1,:,:)),squeeze(p(2,:,:)),squeeze(p(3,:,:))); +%! set(h,'FaceColor','blue','EdgeColor','blue'); +%! title('First derivatives over a test surface.'); +%! +%! npts = 5; +%! tt = linspace(0.0,1.0,npts); +%! dsrf = nrbderiv(srf); +%! +%! [p1, dp] = nrbdeval(srf, dsrf, {tt, tt}); +%! +%! up2 = vecnorm(dp{1}); +%! vp2 = vecnorm(dp{2}); +%! +%! hold on; +%! plot3(p1(1,:),p1(2,:),p1(3,:),'ro'); +%! h1 = quiver3(p1(1,:),p1(2,:),p1(3,:),up2(1,:),up2(2,:),up2(3,:)); +%! h2 = quiver3(p1(1,:),p1(2,:),p1(3,:),vp2(1,:),vp2(2,:),vp2(3,:)); +%! set(h1,'Color','black'); +%! set(h2,'Color','black'); +%! +%! hold off; + +%!test +%! knots = [0 0 0 0.5 1 1 1]; +%! coefs(1,:) = [0 2 4 2]; +%! coefs(2,:) = [0 2 2 0]; +%! coefs(3,:) = [0 4 2 0]; +%! coefs(4,:) = [1 2 2 1]; +%! nrb = nrbmak (coefs, knots); +%! [dnrb, dnrb2] = nrbderiv (nrb); +%! x = linspace (0, 1, 10); +%! [pnt, jac, hess] = nrbdeval (nrb, dnrb, dnrb2, x); +%! w = -4*x.^2 + 4*x + 1; +%! F = zeros (3,numel(x)); DF = zeros (3, numel(x)); D2F = zeros (3, numel(x)); +%! F(1,:) = (-4*x.*(x-2)./w) .* (x<0.5) + ((4*x - 5)./w + 3) .* (x>0.5); +%! F(2,:) = (2-2./w); +%! F(3,:) = (-4*x.*(5*x-4)./w) .* (x<0.5) + (-4*(x.^2 - 1)./w) .* (x>0.5); +%! DF(1,:) = (8*(2*x.^2-x+1)./w.^2) .* (x<0.5) + (8*(2*x-3).*(x-1)./w.^2) .* (x>0.5); +%! DF(2,:) = -8*(2*x-1)./w.^2; +%! DF(3,:) = -(8*(2*x.^2+5*x-2)./w.^2) .* (x<0.5) - (8*(2*x.^2-3*x+2)./w.^2) .* (x>0.5); +%! D2F(1,:) = 8*(16*x.^3-12*x.^2+24*x-9)./w.^3 .* (x<0.5) + 8*(16*x.^3-60*x.^2+72*x-29)./w.^3 .* (x>0.5); +%! D2F(2,:) = -16*(12*x.^2-12*x+5)./w.^3; +%! D2F(3,:) = -8*(16*x.^3+60*x.^2-48*x+21)./w.^3 .* (x<0.5) -8*(16*x.^3-36*x.^2+48*x-19)./w.^3 .* (x>0.5); +%! assert (F, pnt, 1e3*eps) +%! assert (DF, jac, 1e3*eps) +%! assert (D2F, hess, 1e3*eps) + +%!test +%! knots = {[0 0 0 1 1 1], [0 0 0 0.5 1 1 1]}; +%! coefs = ones (4,3,4); +%! coefs(1,:,:) = reshape ([0 0 0 0; 1 1 1 1; 2 2 4 2], 1, 3, 4); +%! coefs(2,:,:) = reshape ([0 1 2 3; 0 1 2 3; 0 1 4 3], 1, 3, 4); +%! coefs(3,:,:) = reshape ([0 1 0 0; 0 0 0 0; 0 0 0 0], 1, 3, 4); +%! coefs(4,:,:) = reshape ([1 1 1 1; 1 1 1 1; 1 1 2 1], 1, 3, 4); +%! nrb = nrbmak (coefs, knots); +%! [dnrb, dnrb2] = nrbderiv (nrb); +%! X = linspace (0, 1, 4); Y = linspace (0, 1, 4); +%! [pnt, jac, hess] = nrbdeval (nrb, dnrb, dnrb2, {X Y}); +%! [y, x] = meshgrid (X, Y); +%! w = (2*x.^2.*y.^2 + 1) .* (y < 0.5) + (-6*x.^2.*y.^2 + 8*x.^2.*y - 2*x.^2 + 1) .* (y > 0.5); +%! F = zeros ([3,size(x)]); +%! F(1,:,:) = ((2*x - 2) ./w + 2) .* (y<0.5) + (2 + (2*x-2)./w) .* (y > 0.5); +%! F(2,:,:) = (2 - (2*(y-1).^2)./w).*(y<0.5) + ... +%! ((-12*x.^2.*y.^2 + 16*x.^2.*y - 4*x.^2 + 2*y.^2 + 1)./w).*(y>0.5); +%! F(3,:,:) = (-2*y.*(3*y - 2).*(x - 1).^2./w) .* (y<0.5) + ... +%! (2*(x - 1).^2.*(y - 1).^2./w) .* (y>0.5); +%! dFdu = zeros ([3,size(x)]); +%! dFdu(1,:,:) = (((8*x - 4*x.^2).*y.^2 + 2)./w.^2).*(y<0.5) + ... +%! (((12*y.^2 - 16*y + 4).*x.^2 + (-24*y.^2 + 32*y - 8).*x + 2)./w.^2).*(y>0.5); +%! dFdu(2,:,:) = (8*x.*y.^2.*(y - 1).^2./w.^2).*(y<0.5) + ... +%! ((4*x.*(3*y - 1).*(2*y.^2 - 1).*(y - 1))./w.^2).*(y>0.5); +%! dFdu(3,:,:) = (-4*y.*(2.*x.*y.^2 + 1).*(3*y - 2).*(x - 1)./w.^2).*(y<0.5) + ... +%! ((-4*(x - 1).*(y - 1).^2.*(6*x.*y.^2 - 8*x.*y + 2*x - 1))./w.^2).*(y>0.5); +%! dFdv = zeros ([3,size(x)]); +%! dFdv(1,:,:) = (-8*x.^2.*y.*(x - 1)./w.^2).*(y<0.5) + ... +%! (8*x.^2.*(3*y - 2).*(x - 1)./w.^2).*(y>0.5); +%! dFdv(2,:,:) = (-4*(2*y.*x.^2 + 1).*(y - 1)./w.^2).*(y<0.5) + ... +%! (((16*y.^2 - 20*y + 8).*x.^2 + 4*y)./w.^2).*(y>0.5); +%! dFdv(3,:,:) = (-4*(x - 1).^2.*(2*x.^2.*y.^2 + 3*y - 1)./w.^2).*(y<0.5) + ... +%! (4*(x - 1).^2.*(y - 1).*(2*x.^2 - 2*x.^2.*y + 1)./w.^2).*(y>0.5); +%! d2Fduu = zeros ([3, size(x)]); +%! d2Fduu(1,:,:) = (-((48*x.^2 - 16*x.^3).*y.^4 + (24*x - 8).*y.^2)./w.^3).*(y<0.5) + ... +%! (((32*(3*y - 1).*(x - 1).*(y - 1))-(8*(3*y - 1).*(x - 3).*(y - 1).*w))./w.^3).*(y>0.5); +%! d2Fduu(2,:,:) = (-(8*y.^2.*(6*x.^2.*y.^2 - 1).*(y - 1).^2)./w.^3).*(y<0.5) + ... +%! ((4*(3*y - 1).*(2*y.^2 - 1).*(y - 1).*(18*x.^2.*y.^2 - 24*x.^2.*y + 6*x.^2 + 1))./w.^3).*(y>0.5); +%! d2Fduu(3,:,:) = ((4*y.*(3*y - 2).*(8*x.^3.*y.^4 - 12*x.^2.*y.^4 + 6*x.^2.*y.^2 - 12*x.*y.^2 + 2*y.^2 - 1))./w.^3).*(y<0.5) + ... +%! ((4*(y - 1).^2.*(6*y.^2 - 8*y + 3) - 4*x.^3.*(y - 1).^2.*(72*y.^4 - 192*y.^3 + 176*y.^2 - 64*y + 8) + 4*x.^2.*(y - 1).^2.*(108*y.^4 - 288*y.^3 + 282*y.^2 - 120*y + 18) - 4*x.*(y - 1).^2.*(36*y.^2 - 48*y + 12))./w.^3) .* (y>0.5); +%! d2Fdvv = zeros ([3, size(x)]); +%! d2Fdvv(1,:,:) = (8*x.^2.*(6*x.^2.*y.^2 - 1).*(x - 1)./w.^3) .* (y<0.5) + ... +%! (8*x.^2.*(x - 1).*(54*x.^2.*y.^2 - 72*x.^2.*y + 26*x.^2 + 3)./w.^3) .* (y>0.5); +%! d2Fdvv(2,:,:) = (-((48*y.^2 - 32*y.^3).*x.^4 + (- 24*y.^2 + 48*y - 8).*x.^2 + 4)./w.^3) .*(y<0.5) + ... +%! (((192*y.^3 - 360*y.^2 + 288*y - 88).*x.^4 + (72*y.^2 - 28).*x.^2 + 4)./w.^3) .* (y>0.5); +%! d2Fdvv(3,:,:) = (4*(x - 1).^2.*(8*x.^4.*y.^3 + 18*x.^2.*y.^2 - 12*x.^2.*y - 3))./w.^3 .* (y<0.5) + ... +%! ((4*(x - 1).^2.*(24*x.^4 + 18*x.^2 + 1) + 4*y.^2.*(72*x.^4 + 18*x.^2).*(x - 1).^2 - 96*x.^4.*y.^3.*(x - 1).^2 - 4*y.*(72*x.^4 + 36*x.^2).*(x - 1).^2)./w.^3) .* (y>0.5); +%! d2Fduv = zeros ([3, size(x)]); +%! d2Fduv(1,:,:) = (-(y.^3.*(32*x.^3 - 16*x.^4) - y.*(16*x - 24*x.^2))./w.^3) .* (y<0.5) + ... +%! (-(-8*(3*y - 2).*(6*y.^2 - 8*y + 2).*x.^4 + 8*(3*y - 2).*(12*y.^2 - 16*y + 4).*x.^3 + (48 - 72*y).*x.^2 + (48*y - 32).*x)./w.^3) .* (y>0.5); +%! d2Fduv(2,:,:) = (16*x.*y.*(y - 1).*(2*x.^2.*y.^2 + 2*y - 1)./w.^3) .* (y<0.5) + ... +%! (-(8*x.*(4*y.^2 - 5*y + 2))./w.^2 + (16*x.*(3*y - 2).*(2*y.^2 - 1))./w.^3) .* (y>0.5); +%! d2Fduv(3,:,:) = (-(8*(x - 1).*(4*x.^3.*y.^4 - 6*x.^2.*y.^3 + 6*x.^2.*y.^2 + 12*x.*y.^3 - 6*x.*y.^2 + 3*y - 1))./w.^3) .* (y<0.5) + ... +%! ((8*(x - 1).*(y - 1).*(12*x.^3.*y.^3 - 28*x.^3.*y.^2 + 20*x.^3.*y - 4*x.^3 + 6*x.^2.*y.^2 - 12*x.^2.*y + 6*x.^2 - 12*x.*y.^2 + 18*x.*y - 6*x + 1))./w.^3) .* (y>0.5); +%! assert (F, pnt, 1e3*eps) +%! assert (dFdu, jac{1}, 1e3*eps) +%! assert (dFdv, jac{2}, 1e3*eps) +%! assert (d2Fduu, hess{1,1}, 1e3*eps) +%! assert (d2Fduv, hess{1,2}, 1e3*eps) +%! assert (d2Fduv, hess{2,1}, 1e3*eps) +%! assert (d2Fdvv, hess{2,2}, 1e3*eps) + +%!test +%! knots = {[0 0 0 1 1 1], [0 0 0 0.5 1 1 1]}; +%! coefs = ones (4,3,4); +%! coefs(1,:,:) = reshape ([0 0 0 0; 1 1 1 1; 2 2 4 2], 1, 3, 4); +%! coefs(2,:,:) = reshape ([0 1 2 3; 0 1 2 3; 0 1 4 3], 1, 3, 4); +%! coefs(3,:,:) = reshape ([0 1 0 0; 0 0 0 0; 0 0 0 0], 1, 3, 4); +%! coefs(4,:,:) = reshape ([1 1 1 1; 1 1 1 1; 1 1 2 1], 1, 3, 4); +%! nrb = nrbmak (coefs, knots); +%! nrb = nrbdegelev (nrbextrude (nrb, [0.4 0.6 2]), [0 0 1]); +%! nrb.coefs(4,2,3,3) = 1.5; +%! [dnrb, dnrb2] = nrbderiv (nrb); +%! X = linspace (0, 1, 4); Y = linspace (0, 1, 4); Z = linspace (0, 1, 4); +%! [pnt, jac, hess] = nrbdeval (nrb, dnrb, dnrb2, {X Y Z}); +%! [y, x, z] = meshgrid (X, Y, Z); +%! w = (-2*x.^2.*y.^2.*z.^2 + 2*x.^2.*y.^2 + 2*x.*y.^2.*z.^2 + 1) .* (y < 0.5) + ... +%! (6*x.^2.*y.^2.*z.^2 - 6*x.^2.*y.^2 - 8*x.^2.*y.*z.^2 + 8*x.^2.*y + 2*x.^2.*z.^2 - 2*x.^2 - 6*x.*y.^2.*z.^2 + 8*x.*y.*z.^2 - 2*x.*z.^2 + 1) .* (y > 0.5); +%! F = zeros ([3,size(x)]); +%! F(1,:,:,:) = ((10*x + 20*x.^2.*y.^2 + z.*(4*x.^2.*y.^2 + 2))./(5*w)) .* (y<0.5) + ... +%! (60*x.^2.*y.^2 - 10*x + z.*(12*x.^2.*y.^2 - 16*x.^2.*y + 4*x.^2 - 2) - 80*x.^2.*y + 20*x.^2)./(-5*w) .* (y > 0.5); +%! F(2,:,:,:) = ((20*y + 20*x.^2.*y.^2 + z.*(6*x.^2.*y.^2 + 3) - 10*y.^2)./(5*w)).*(y<0.5) + ... +%! ((60*x.^2.*y.^2 + z.*(18*x.^2.*y.^2 - 24*x.^2.*y + 6*x.^2 - 3) - 80*x.^2.*y + 20*x.^2 - 10*y.^2 - 5)./(-5*w)).*(y>0.5); +%! F(3,:,:,:) = ((4*y - 6*x.^2.*y.^2 + z.*(4*x.^2.*y.^2 + 2) - 8*x.*y + 12*x.*y.^2 + 4*x.^2.*y - 6*y.^2)./w) .* (y<0.5) + ... +%! ((2*z - 4*y - 4*x + 2*x.^2.*y.^2 + 8*x.*y - 4*x.*y.^2 - 4*x.^2.*y - 4*x.^2.*z + 2*x.^2 + 2*y.^2 + 16*x.^2.*y.*z - 12*x.^2.*y.^2.*z + 2)./w) .* (y>0.5); +%! dFdu = zeros ([3,size(x)]); +%! dFdu(1,:,:,:) = ((x.*((8*y.^2.*z.^3)/5 + 8*y.^2) - (4*y.^2.*z.^3)/5 + x.^2.*(z.^2.*(8*y.^4 + 4*y.^2) + (8*y.^4.*z.^3)/5 - 4*y.^2) + 2)./w.^2).*(y<0.5) + ... +%! ((z.^3.*(x.^2.*((72*y.^4)/5 - (192*y.^3)/5 + (176*y.^2)/5 - (64*y)/5 + 8/5) - (16*y)/5 - x.*((24*y.^2)/5 - (32*y)/5 + 8/5) + (12*y.^2)/5 + 4/5) - x.*(24*y.^2 - 32*y + 8) + x.^2.*(12*y.^2 - 16*y + 4) + x.^2.*z.^2.*(72*y.^4 - 192*y.^3 + 164*y.^2 - 48*y + 4) + 2)./w.^2).*(y>0.5); +%! dFdu(2,:,:,:) = ((z.^2.*(8*x.^2.*y.^4 - y.^2.*(8*y - 4*y.^2) + (2*x.*y.^2.*(40*y - 20*y.^2))/5) + z.^3.*((12*x.^2.*y.^4)/5 + (12*x.*y.^2)/5 - (6*y.^2)/5) + (2*x.*y.^2.*(20*y.^2 - 40*y + 20))/5)./w.^2).*(y<0.5) + ... +%! (((2*(3*y.^2 - 4*y + 1).*(18*x.^2.*y.^2 - 24*x.^2.*y + 6*x.^2 - 6*x + 3).*z.^3)/5 + (2*(3*y.^2 - 4*y + 1).*(60*x.^2.*y.^2 - 80*x.^2.*y + 20*x.^2 - 20*x.*y.^2 - 10*x + 10*y.^2 + 5).*z.^2)/5 - (2*(10*x - 20*x.*y.^2).*(3*y.^2 - 4*y + 1))/5)./w.^2).*(y>0.5); +%! dFdu(3,:,:,:) = ((4*y.*(3*y - 2) + z.^3.*(8*x.^2.*y.^4 + 8*x.*y.^2 - 4*y.^2) - z.^2.*(4*y.*(2*y.^2 - 3*y.^3).*x.^2 - 4*y.*(4*y.^2 - 6*y.^3).*x + 4*y.*(2*y.^2 - 3*y.^3)) + 4*x.^2.*y.*(4*y.^2 - 6*y.^3) - 4*x.*y.*(- 6*y.^3 + 4*y.^2 + 3*y - 2)) ./w.^2).*(y<0.5) + ... +%! ((z.^2.*(4*(y - 1).*(3*y.^3 - 7*y.^2 + 5*y - 1).*x.^2 - 4*(y - 1).*(6*y.^3 - 14*y.^2 + 10*y - 2).*x + 4*(y - 1).*(3*y.^3 - 7*y.^2 + 5*y - 1)) - 4*(y - 1).^2 + z.^3.*(4*(y - 1).*(18*y.^3 - 30*y.^2 + 14*y - 2).*x.^2 - 4*(6*y - 2).*(y - 1).*x + 4*(3*y - 1).*(y - 1)) + 4*x.*(y - 1).*(6*y.^3 - 14*y.^2 + 11*y - 3) - 4*x.^2.*(y - 1).*(6*y.^3 - 14*y.^2 + 10*y - 2))./w.^2) .* (y > 0.5); +%! dFdv = zeros ([3,size(x)]); +%! dFdv(1,:,:,:) = ((8*x.*y.*(x - 1).*(z.^3 + 5*x.*z.^2 - 5*x))/5./w.^2).*(y<0.5) + ... +%! (-(8*x.*(3*y - 2).*(x - 1).*(z.^3 + 5*x.*z.^2 - 5*x))/5./w.^2).*(y>0.5); +%! dFdv(2,:,:,:) = (-((8*x.*z.^2 - x.^2.*(8*z.^2 - 8)).*y.^2 + ((12*x.*z.^3)/5 - x.^2.*((12*z.^3)/5 + 8) + 4).*y - 4)./w.^2).*(y<0.5) + ... +%! ((4*y + z.^3.*(x.*((36*y)/5 - 24/5) - x.^2.*((36*y)/5 - 24/5)) + z.^2.*(x.*(16*y.^2 + 4*y - 8) - x.^2.*(16*y.^2 + 4*y - 8)) + x.^2.*(16*y.^2 - 20*y + 8))./w.^2).*(y>0.5); +%! dFdv(3,:,:,:) = ((4*(x - 1).^2 - y.*(4*(3*x - 3).*(x - 1) - 8*x.*z.^3.*(x - 1)) + y.^2.*(4*(x - 1).*(2*x.^3 - 4*x.^2 + 2*x).*z.^2 + 4*(2*x.^2 - 2*x.^3).*(x - 1)))./w.^2).*(y<0.5) + ... +%! ((y.^2.*(4*(x - 1).*(2*x.^3 - 4*x.^2 + 2*x).*z.^2 + 4*(2*x.^2 - 2*x.^3).*(x - 1)) - 4*(x - 1).*(2*x.^3 - 2*x.^2 + x - 1) - y.*(24*x.*(x - 1).*z.^3 + 4*(x - 1).*(4*x.^3 - 8*x.^2 + 4*x).*z.^2 - 4*(x - 1).*(4*x.^3 - 4*x.^2 + x - 1)) + 16*x.*z.^3.*(x - 1) + 4*z.^2.*(x - 1).*(2*x.^3 - 4*x.^2 + 2*x))./w.^2).*(y>0.5); +%! dFdw = zeros ([3,size(x)]); +%! dFdw(1,:,:,:) = ((4*x.^2.*y.^2 + 2)./(- 10*x.^2.*y.^2.*z.^2 + 10*x.^2.*y.^2 + 10*x.*y.^2.*z.^2 + 5) - ((20*x.*y.^2.*z - 20*x.^2.*y.^2.*z).*(10*x + 20*x.^2.*y.^2 + z.*(4*x.^2.*y.^2 + 2)))./(5*w).^2).*(y<0.5) + ... +%! ((12*x.^2.*y.^2 - 16*x.^2.*y + 4*x.^2 - 2)./(- 30*x.^2.*y.^2.*z.^2 + 30*x.^2.*y.^2 + 40*x.^2.*y.*z.^2 - 40*x.^2.*y - 10*x.^2.*z.^2 + 10*x.^2 + 30*x.*y.^2.*z.^2 - 40*x.*y.*z.^2 + 10*x.*z.^2 - 5) - ((60*x.^2.*y.^2 - 10*x + z.*(12*x.^2.*y.^2 - 16*x.^2.*y + 4*x.^2 - 2) - 80*x.^2.*y + 20*x.^2).*(- 60*z.*x.^2.*y.^2 + 80*z.*x.^2.*y - 20*z.*x.^2 + 60*z.*x.*y.^2 - 80*z.*x.*y + 20*z.*x))./(5*w).^2).*(y>0.5); +%! dFdw(2,:,:,:) = ((6*x.^2.*y.^2 + 3)./(- 10*x.^2.*y.^2.*z.^2 + 10*x.^2.*y.^2 + 10*x.*y.^2.*z.^2 + 5) - ((20*x.*y.^2.*z - 20*x.^2.*y.^2.*z).*(20*y + 20*x.^2.*y.^2 + z.*(6*x.^2.*y.^2 + 3) - 10*y.^2))./(5*w).^2).*(y<0.5) + ... +%! ((18*x.^2.*y.^2 - 24*x.^2.*y + 6*x.^2 - 3)./(- 30*x.^2.*y.^2.*z.^2 + 30*x.^2.*y.^2 + 40*x.^2.*y.*z.^2 - 40*x.^2.*y - 10*x.^2.*z.^2 + 10*x.^2 + 30*x.*y.^2.*z.^2 - 40*x.*y.*z.^2 + 10*x.*z.^2 - 5) - ((- 60*z.*x.^2.*y.^2 + 80*z.*x.^2.*y - 20*z.*x.^2 + 60*z.*x.*y.^2 - 80*z.*x.*y + 20*z.*x).*(60*x.^2.*y.^2 + z.*(18*x.^2.*y.^2 - 24*x.^2.*y + 6*x.^2 - 3) - 80*x.^2.*y + 20*x.^2 - 10*y.^2 - 5))./(5*w).^2).*(y>0.5); +%! dFdw(3,:,:,:) = ((4*x.^2.*y.^2 + 2)./(2*x.^2.*y.^2 - z.^2.*(2*x.^2.*y.^2 - 2*x.*y.^2) + 1) + (2*z.*(2*x.^2.*y.^2 - 2*x.*y.^2).*(4*y - 6*x.^2.*y.^2 + z.*(4*x.^2.*y.^2 + 2) - 8*x.*y + 12*x.*y.^2 + 4*x.^2.*y - 6*y.^2))./w.^2).*(y<0.5) + ... +%! ((12*x.^2.*y.^2 - 16*x.^2.*y + 4*x.^2 - 2)./(6*x.^2.*y.^2 + z.^2.*(- 6*x.^2.*y.^2 + 8*x.^2.*y - 2*x.^2 + 6*x.*y.^2 - 8*x.*y + 2*x) - 8*x.^2.*y + 2*x.^2 - 1) + (2*z.*(- 6*x.^2.*y.^2 + 8*x.^2.*y - 2*x.^2 + 6*x.*y.^2 - 8*x.*y + 2*x).*(2*z - 4*y - 4*x + 2*x.^2.*y.^2 + 8*x.*y - 4*x.*y.^2 - 4*x.^2.*y - 4*x.^2.*z + 2*x.^2 + 2*y.^2 + 16*x.^2.*y.*z - 12*x.^2.*y.^2.*z + 2))./w.^2).*(y>0.5); +%! d2Fduu = zeros ([3, size(x)]); +%! d2Fduu(1,:,:,:) = (((8*y.^2.*z.^3)/5 + 2*x.*(z.^2.*(8*y.^4 + 4*y.^2) + (8*y.^4.*z.^3)/5 - 4*y.^2) + 8*y.^2)./w.^2 - (2*(2*y.^2.*z.^2 + 4*x.*y.^2 - 4*x.*y.^2.*z.^2).*(x.*((8*y.^2.*z.^3)/5 + 8*y.^2) - (4*y.^2.*z.^3)/5 + x.^2.*(z.^2.*(8*y.^4 + 4*y.^2) + (8*y.^4.*z.^3)/5 - 4*y.^2) + 2))./w.^3).*(y<0.5) + ... +%! ((32*y + 2*x.*(12*y.^2 - 16*y + 4) + z.^3.*((32*y)/5 + 2*x.*((72*y.^4)/5 - (192*y.^3)/5 + (176*y.^2)/5 - (64*y)/5 + 8/5) - (24*y.^2)/5 - 8/5) - 24*y.^2 + 2*x.*z.^2.*(72*y.^4 - 192*y.^3 + 164*y.^2 - 48*y + 4) - 8)./w.^2 - (2*(z.^3.*(x.^2.*((72*y.^4)/5 - (192*y.^3)/5 + (176*y.^2)/5 - (64*y)/5 + 8/5) - (16*y)/5 - x.*((24*y.^2)/5 - (32*y)/5 + 8/5) + (12*y.^2)/5 + 4/5) - x.*(24*y.^2 - 32*y + 8) + x.^2.*(12*y.^2 - 16*y + 4) + x.^2.*z.^2.*(72*y.^4 - 192*y.^3 + 164*y.^2 - 48*y + 4) + 2).*(4*x + 6*y.^2.*z.^2 - 16*x.*y + 12*x.*y.^2 - 4*x.*z.^2 - 8*y.*z.^2 + 2*z.^2 + 16*x.*y.*z.^2 - 12*x.*y.^2.*z.^2))./(-w).^3).*(y>0.5); +%! d2Fduu(2,:,:,:) = ((z.^3.*((24*x.*y.^4)/5 + (12*y.^2)/5) + (2*y.^2.*(20*y.^2 - 40*y + 20))/5 + z.^2.*((2*y.^2.*(40*y - 20*y.^2))/5 + 16*x.*y.^4))./w.^2 - (2*(z.^2.*(8*x.^2.*y.^4 - y.^2.*(8*y - 4*y.^2) + (2*x.*y.^2.*(40*y - 20*y.^2))/5) + z.^3.*((12*x.^2.*y.^4)/5 + (12*x.*y.^2)/5 - (6*y.^2)/5) + (2*x.*y.^2.*(20*y.^2 - 40*y + 20))/5).*(2*y.^2.*z.^2 + 4*x.*y.^2 - 4*x.*y.^2.*z.^2))./w.^3).*(y<0.5) + ... +%! (((2*(3*y.^2 - 4*y + 1).*(36*x.*y.^2 - 48*x.*y + 12*x - 6).*z.^3)/5 - (2*(3*y.^2 - 4*y + 1).*(160*x.*y - 40*x - 120*x.*y.^2 + 20*y.^2 + 10).*z.^2)/5 + (2*(20*y.^2 - 10).*(3*y.^2 - 4*y + 1))/5)./w.^2 - (2*((2*(3*y.^2 - 4*y + 1).*(18*x.^2.*y.^2 - 24*x.^2.*y + 6*x.^2 - 6*x + 3).*z.^3)/5 + (2*(3*y.^2 - 4*y + 1).*(60*x.^2.*y.^2 - 80*x.^2.*y + 20*x.^2 - 20*x.*y.^2 - 10*x + 10*y.^2 + 5).*z.^2)/5 - (2*(10*x - 20*x.*y.^2).*(3*y.^2 - 4*y + 1))/5).*(4*x + 6*y.^2.*z.^2 - 16*x.*y + 12*x.*y.^2 - 4*x.*z.^2 - 8*y.*z.^2 + 2*z.^2 + 16*x.*y.*z.^2 - 12*x.*y.^2.*z.^2))./(-w).^3).*(y>0.5); +%! d2Fduu(3,:,:,:) = (((16*x.*y.^4 + 8*y.^2).*z.^3 + (4*y.*(4*y.^2 - 6*y.^3) - 8*x.*y.*(2*y.^2 - 3*y.^3)).*z.^2 - 4*y.*(- 6*y.^3 + 4*y.^2 + 3*y - 2) + 8*x.*y.*(4*y.^2 - 6*y.^3))./w.^2 - (2*(2*y.^2.*z.^2 + 4*x.*y.^2 - 4*x.*y.^2.*z.^2).*(4*y.*(3*y - 2) + z.^3.*(8*x.^2.*y.^4 + 8*x.*y.^2 - 4*y.^2) - z.^2.*(4*y.*(2*y.^2 - 3*y.^3).*x.^2 - 4*y.*(4*y.^2 - 6*y.^3).*x + 4*y.*(2*y.^2 - 3*y.^3)) + 4*x.^2.*y.*(4*y.^2 - 6*y.^3) - 4*x.*y.*(- 6*y.^3 + 4*y.^2 + 3*y - 2)))./w.^3).*(y<0.5) + ... +%! (-((4*(6*y - 2).*(y - 1) - 8*x.*(y - 1).*(18*y.^3 - 30*y.^2 + 14*y - 2)).*z.^3 + (4*(y - 1).*(6*y.^3 - 14*y.^2 + 10*y - 2) - 8*x.*(y - 1).*(3*y.^3 - 7*y.^2 + 5*y - 1)).*z.^2 - 4*(y - 1).*(6*y.^3 - 14*y.^2 + 11*y - 3) + 8*x.*(y - 1).*(6*y.^3 - 14*y.^2 + 10*y - 2))./w.^2 - (2*(z.^2.*(4*(y - 1).*(3*y.^3 - 7*y.^2 + 5*y - 1).*x.^2 - 4*(y - 1).*(6*y.^3 - 14*y.^2 + 10*y - 2).*x + 4*(y - 1).*(3*y.^3 - 7*y.^2 + 5*y - 1)) - 4*(y - 1).^2 + z.^3.*(4*(y - 1).*(18*y.^3 - 30*y.^2 + 14*y - 2).*x.^2 - 4*(6*y - 2).*(y - 1).*x + 4*(3*y - 1).*(y - 1)) + 4*x.*(y - 1).*(6*y.^3 - 14*y.^2 + 11*y - 3) - 4*x.^2.*(y - 1).*(6*y.^3 - 14*y.^2 + 10*y - 2)).*(4*x + 6*y.^2.*z.^2 - 16*x.*y + 12*x.*y.^2 - 4*x.*z.^2 - 8*y.*z.^2 + 2*z.^2 + 16*x.*y.*z.^2 - 12*x.*y.^2.*z.^2))./(-w).^3) .* (y>0.5); +%! d2Fduv = zeros ([3, size(x)]); +%! d2Fduv(1,:,:,:) = ((((8.*x.^2.*(6.*z.^3 - 6.*z.^5))/5 + (8.*x.^4.*(10.*z.^4 - 20.*z.^2 + 10))/5 - (8.*x.^3.*(- 4.*z.^5 + 10.*z.^4 + 4.*z.^3 - 30.*z.^2 + 20))/5 + (16.*x.*z.^5)/5).*y.^3 + ((8.*x.*(2.*z.^3 - 10.*z.^2 + 10))/5 + (8.*x.^2.*(15.*z.^2 - 15))/5 - (8.*z.^3)/5).*y)./w.^3) .* (y<0.5) + ... +%! (-(x.^4.*((8.*(3.*y - 2).*(30.*y.^2 - 40.*y + 10).*z.^4)/5 - (8.*(3.*y - 2).*(60.*y.^2 - 80.*y + 20).*z.^2)/5 + (8.*(3.*y - 2).*(30.*y.^2 - 40.*y + 10))/5) - x.^3.*(- (8.*(3.*y - 2).*(12.*y.^2 - 16.*y + 4).*z.^5)/5 + (8.*(3.*y - 2).*(30.*y.^2 - 40.*y + 10).*z.^4)/5 + (8.*(3.*y - 2).*(12.*y.^2 - 16.*y + 4).*z.^3)/5 - (8.*(3.*y - 2).*(90.*y.^2 - 120.*y + 30).*z.^2)/5 + (8.*(3.*y - 2).*(60.*y.^2 - 80.*y + 20))/5) + z.^3.*((24.*y)/5 - 16/5) - x.^2.*((8.*(3.*y - 2).*(18.*y.^2 - 24.*y + 6).*z.^5)/5 - (8.*(3.*y - 2).*(18.*y.^2 - 24.*y + 6).*z.^3)/5 + (72.*y - 48).*z.^2 - 72.*y + 48) + x.*((8.*(3.*y - 2).*(6.*y.^2 - 8.*y + 2).*z.^5)/5 + (32/5 - (48.*y)/5).*z.^3 + (48.*y - 32).*z.^2 - 48.*y + 32))./(-w).^3) .* (y>0.5); +%! d2Fduv(2,:,:,:) = ((((4.*x.^2.*(60.*z.^2 - 60.*z.^4))/5 + (4.*x.^3.*(40.*z.^4 - 80.*z.^2 + 40))/5 + 16.*x.*z.^4).*y.^4 + ((4.*x.^2.*(18.*z.^3 - 18.*z.^5))/5 + (4.*x.^3.*(12.*z.^5 - 12.*z.^3 + 40.*z.^2 - 40))/5 + (4.*x.*(6.*z.^5 - 40.*z.^2 + 40))/5 + 16.*z.^2).*y.^3 + ((4.*x.*(60.*z.^2 - 60))/5 - 24.*z.^2).*y.^2 + ((4.*x.*(6.*z.^3 + 20))/5 - (12.*z.^3)/5).*y)./w.^3) .* (y<0.5) + ... +%! ((z.^3.*(((432.*y.^3)/5 - (864.*y.^2)/5 + (528.*y)/5 - 96/5).*x.^3 + (- (648.*y.^3)/5 + (1296.*y.^2)/5 - (792.*y)/5 + 144/5).*x.^2 + ((72.*y)/5 - 48/5).*x - (36.*y)/5 + 24/5) - x.^3.*(192.*y.^4 - 496.*y.^3 + 480.*y.^2 - 208.*y + 32) + z.^4.*((- 192.*y.^4 + 208.*y.^3 + 96.*y.^2 - 144.*y + 32).*x.^3 + (288.*y.^4 - 312.*y.^3 - 144.*y.^2 + 216.*y - 48).*x.^2 + (- 96.*y.^4 + 104.*y.^3 + 48.*y.^2 - 72.*y + 16).*x) + x.*(- 96.*y.^3 + 96.*y.^2 + 8.*y - 16) + z.^2.*(x.^2.*(- 288.*y.^4 + 312.*y.^3 + 144.*y.^2 - 216.*y + 48) - 20.*y - x.^3.*(- 384.*y.^4 + 704.*y.^3 - 384.*y.^2 + 64.*y) + x.*(96.*y.^3 - 96.*y.^2 + 40.*y - 16) + 48.*y.^2 - 48.*y.^3 + 8) - z.^5.*(((432.*y.^3)/5 - (864.*y.^2)/5 + (528.*y)/5 - 96/5).*x.^3 + (- (648.*y.^3)/5 + (1296.*y.^2)/5 - (792.*y)/5 + 144/5).*x.^2 + ((216.*y.^3)/5 - (432.*y.^2)/5 + (264.*y)/5 - 48/5).*x))./(-w).^3) .* (y>0.5); +%! d2Fduv(3,:,:,:) = (((x.^2.*(48.*z.^2 - 48.*z.^4) - x.^4.*(16.*z.^4 - 48.*z.^2 + 32) + x.^3.*(48.*z.^4 - 96.*z.^2 + 32) + 16.*x.*z.^4).*y.^4 + (x.^2.*(- 48.*z.^5 + 48.*z.^3 + 144.*z.^2 - 144) - x.^3.*(- 32.*z.^5 + 32.*z.^3 + 48.*z.^2 - 48) + x.*(16.*z.^5 - 144.*z.^2 + 96) + 48.*z.^2).*y.^3 + (x.*(96.*z.^2 - 48) + x.^3.*(48.*z.^2 - 48) - x.^2.*(120.*z.^2 - 96) - 24.*z.^2).*y.^2 + (x.*(16.*z.^3 - 24) - 8.*z.^3 + 24).*y + 8.*x - 8)./w.^3) .* (y<0.5) + ... +%! ((8.*y - x.^4.*(96.*y.^4 - 320.*y.^3 + 384.*y.^2 - 192.*y + 32) + x.^3.*(96.*y.^4 - 368.*y.^3 + 528.*y.^2 - 336.*y + 80) + z.^3.*((288.*y.^3 - 576.*y.^2 + 352.*y - 64).*x.^3 + (- 432.*y.^3 + 864.*y.^2 - 528.*y + 96).*x.^2 + (48.*y - 32).*x - 24.*y + 16) - x.*(96.*y.^3 - 240.*y.^2 + 200.*y - 56) - z.^4.*((48.*y.^4 - 160.*y.^3 + 192.*y.^2 - 96.*y + 16).*x.^4 + (- 144.*y.^4 + 480.*y.^3 - 576.*y.^2 + 288.*y - 48).*x.^3 + (144.*y.^4 - 480.*y.^3 + 576.*y.^2 - 288.*y + 48).*x.^2 + (- 48.*y.^4 + 160.*y.^3 - 192.*y.^2 + 96.*y - 16).*x) + z.^2.*(x.^4.*(144.*y.^4 - 480.*y.^3 + 576.*y.^2 - 288.*y + 48) - 96.*y + x.^2.*(144.*y.^4 - 624.*y.^3 + 984.*y.^2 - 672.*y + 168) - x.^3.*(288.*y.^4 - 1008.*y.^3 + 1296.*y.^2 - 720.*y + 144) + x.*(144.*y.^3 - 384.*y.^2 + 336.*y - 96) + 120.*y.^2 - 48.*y.^3 + 24) - z.^5.*((288.*y.^3 - 576.*y.^2 + 352.*y - 64).*x.^3 + (- 432.*y.^3 + 864.*y.^2 - 528.*y + 96).*x.^2 + (144.*y.^3 - 288.*y.^2 + 176.*y - 32).*x) + x.^2.*(144.*y.^3 - 384.*y.^2 + 336.*y - 96) - 8)./(-w).^3) .* (y>0.5); +%! d2Fduw = zeros ([3, size(x)]); +%! d2Fduw(1,:,:,:) = ((x.^2.*((24.*y.^4.*z.^2)/5 + 2.*z.*(8.*y.^4 + 4.*y.^2)) - (12.*y.^2.*z.^2)/5 + (24.*x.*y.^2.*z.^2)/5)./w.^2 - (2.*(4.*x.*y.^2.*z - 4.*x.^2.*y.^2.*z).*(x.*((8.*y.^2.*z.^3)/5 + 8.*y.^2) - (4.*y.^2.*z.^3)/5 + x.^2.*(z.^2.*(8.*y.^4 + 4.*y.^2) + (8.*y.^4.*z.^3)/5 - 4.*y.^2) + 2))./w.^3) .* (y<0.5) + ... +%! (-((- (4.*(3.*y - 1).*(y - 1).*(36.*y.^4 - 96.*y.^3 + 88.*y.^2 - 32.*y + 4).*x.^4)/5 + (4.*(3.*y - 1).*(y - 1).*(36.*y.^4 - 96.*y.^3 + 100.*y.^2 - 48.*y + 8).*x.^3)/5 - (4.*(3.*y - 1).*(y - 1).*(18.*y.^2 - 24.*y + 6).*x.^2)/5 + (4.*(3.*y - 1).*(y - 1).*(6.*y.^2 - 8.*y + 2).*x)/5).*z.^4 + ((4.*x.^3.*(3.*y - 1).*(y - 1).*(360.*y.^4 - 960.*y.^3 + 820.*y.^2 - 240.*y + 20))/5 - (4.*x.^4.*(3.*y - 1).*(y - 1).*(360.*y.^4 - 960.*y.^3 + 820.*y.^2 - 240.*y + 20))/5).*z.^3 + (- (4.*(3.*y - 1).*(y - 1).*(108.*y.^4 - 288.*y.^3 + 264.*y.^2 - 96.*y + 12).*x.^4)/5 + (4.*(3.*y - 1).*(y - 1).*(36.*y.^2 - 48.*y + 12).*x.^3)/5 - (24.*(3.*y - 1).*(y - 1).*x)/5 + (12.*(3.*y - 1).*(y - 1))/5).*z.^2 + (- (4.*(3.*y - 1).*(y - 1).*(360.*y.^4 - 960.*y.^3 + 940.*y.^2 - 400.*y + 60).*x.^4)/5 + (4.*(3.*y - 1).*(y - 1).*(360.*y.^2 - 480.*y + 120).*x.^3)/5 - (4.*(3.*y - 1).*(y - 1).*(180.*y.^2 - 240.*y + 90).*x.^2)/5 + 16.*(3.*y - 1).*(y - 1).*x).*z)./(-w).^3) .* (y>0.5); +%! d2Fduw(2,:,:,:) = ((2.*z.*(8.*x.^2.*y.^4 - y.^2.*(8.*y - 4.*y.^2) + (2.*x.*y.^2.*(40.*y - 20.*y.^2))/5) + 3.*z.^2.*((12.*x.^2.*y.^4)/5 + (12.*x.*y.^2)/5 - (6.*y.^2)/5))./w.^2 - (2.*(4.*x.*y.^2.*z - 4.*x.^2.*y.^2.*z).*(z.^2.*(8.*x.^2.*y.^4 - y.^2.*(8.*y - 4.*y.^2) + (2.*x.*y.^2.*(40.*y - 20.*y.^2))/5) + z.^3.*((12.*x.^2.*y.^4)/5 + (12.*x.*y.^2)/5 - (6.*y.^2)/5) + (2.*x.*y.^2.*(20.*y.^2 - 40.*y + 20))/5))./w.^3) .* (y<0.5) + ... +%! (((6.*(3.*y.^2 - 4.*y + 1).*(18.*x.^2.*y.^2 - 24.*x.^2.*y + 6.*x.^2 - 6.*x + 3).*z.^2)/5 + (4.*(3.*y.^2 - 4.*y + 1).*(60.*x.^2.*y.^2 - 80.*x.^2.*y + 20.*x.^2 - 20.*x.*y.^2 - 10.*x + 10.*y.^2 + 5).*z)/5)./w.^2 - (2.*((2.*(3.*y.^2 - 4.*y + 1).*(18.*x.^2.*y.^2 - 24.*x.^2.*y + 6.*x.^2 - 6.*x + 3).*z.^3)/5 + (2.*(3.*y.^2 - 4.*y + 1).*(60.*x.^2.*y.^2 - 80.*x.^2.*y + 20.*x.^2 - 20.*x.*y.^2 - 10.*x + 10.*y.^2 + 5).*z.^2)/5 - (2.*(10.*x - 20.*x.*y.^2).*(3.*y.^2 - 4.*y + 1))/5).*(- 12.*z.*x.^2.*y.^2 + 16.*z.*x.^2.*y - 4.*z.*x.^2 + 12.*z.*x.*y.^2 - 16.*z.*x.*y + 4.*z.*x))./(-w).^3) .* (y>0.5); +%! d2Fduw(3,:,:,:) = (- (2.*z.*(4.*y.*(2.*y.^2 - 3.*y.^3).*x.^2 - 4.*y.*(4.*y.^2 - 6.*y.^3).*x + 4.*y.*(2.*y.^2 - 3.*y.^3)) - 3.*z.^2.*(8.*x.^2.*y.^4 + 8.*x.*y.^2 - 4.*y.^2))./w.^2 - (2.*(4.*x.*y.^2.*z - 4.*x.^2.*y.^2.*z).*(4.*y.*(3.*y - 2) + z.^3.*(8.*x.^2.*y.^4 + 8.*x.*y.^2 - 4.*y.^2) - z.^2.*(4.*y.*(2.*y.^2 - 3.*y.^3).*x.^2 - 4.*y.*(4.*y.^2 - 6.*y.^3).*x + 4.*y.*(2.*y.^2 - 3.*y.^3)) + 4.*x.^2.*y.*(4.*y.^2 - 6.*y.^3) - 4.*x.*y.*(- 6.*y.^3 + 4.*y.^2 + 3.*y - 2)))./w.^3) .* (y<0.5) + ... +%! ((2.*z.*(4.*(y - 1).*(3.*y.^3 - 7.*y.^2 + 5.*y - 1).*x.^2 - 4.*(y - 1).*(6.*y.^3 - 14.*y.^2 + 10.*y - 2).*x + 4.*(y - 1).*(3.*y.^3 - 7.*y.^2 + 5.*y - 1)) + 3.*z.^2.*(4.*(y - 1).*(18.*y.^3 - 30.*y.^2 + 14.*y - 2).*x.^2 - 4.*(6.*y - 2).*(y - 1).*x + 4.*(3.*y - 1).*(y - 1)))./w.^2 - (2.*(z.^2.*(4.*(y - 1).*(3.*y.^3 - 7.*y.^2 + 5.*y - 1).*x.^2 - 4.*(y - 1).*(6.*y.^3 - 14.*y.^2 + 10.*y - 2).*x + 4.*(y - 1).*(3.*y.^3 - 7.*y.^2 + 5.*y - 1)) - 4.*(y - 1).^2 + z.^3.*(4.*(y - 1).*(18.*y.^3 - 30.*y.^2 + 14.*y - 2).*x.^2 - 4.*(6.*y - 2).*(y - 1).*x + 4.*(3.*y - 1).*(y - 1)) + 4.*x.*(y - 1).*(6.*y.^3 - 14.*y.^2 + 11.*y - 3) - 4.*x.^2.*(y - 1).*(6.*y.^3 - 14.*y.^2 + 10.*y - 2)).*(- 12.*z.*x.^2.*y.^2 + 16.*z.*x.^2.*y - 4.*z.*x.^2 + 12.*z.*x.*y.^2 - 16.*z.*x.*y + 4.*z.*x))./(-w).^3) .* (y>0.5); +%! d2Fdvv = zeros ([3, size(x)]); +%! d2Fdvv(1,:,:,:) = (-(8.*x.*(x - 1).*(z.^3 + 5.*x.*z.^2 - 5.*x).*(- 6.*x.^2.*y.^2.*z.^2 + 6.*x.^2.*y.^2 + 6.*x.*y.^2.*z.^2 - 1))/5./w.^3) .* (y<0.5) + ... +%! ((8.*x.*(x - 1).*(z.^3 + 5.*x.*z.^2 - 5.*x).*(- 54.*x.^2.*y.^2.*z.^2 + 54.*x.^2.*y.^2 + 72.*x.^2.*y.*z.^2 - 72.*x.^2.*y - 26.*x.^2.*z.^2 + 26.*x.^2 + 54.*x.*y.^2.*z.^2 - 72.*x.*y.*z.^2 + 26.*x.*z.^2 + 3))/5./(-w).^3) .* (y>0.5); +%! d2Fdvv(2,:,:,:) = ((2.*((8.*x.*z.^2 - x.^2.*(8.*z.^2 - 8)).*y.^2 + ((12.*x.*z.^3)/5 - x.^2.*((12.*z.^3)/5 + 8) + 4).*y - 4).*(- 4.*y.*x.^2.*z.^2 + 4.*y.*x.^2 + 4.*y.*x.*z.^2))./w.^3 - ((12.*x.*z.^3)/5 + 2.*y.*(8.*x.*z.^2 - x.^2.*(8.*z.^2 - 8)) - x.^2.*((12.*z.^3)/5 + 8) + 4)./w.^2) .* (y<0.5) + ... +%! ((z.^2.*(x.*(32.*y + 4) - x.^2.*(32.*y + 4)) + x.^2.*(32.*y - 20) + z.^3.*((36.*x)/5 - (36.*x.^2)/5) + 4)./w.^2 - (2.*(4.*y + z.^3.*(x.*((36.*y)/5 - 24/5) - x.^2.*((36.*y)/5 - 24/5)) + z.^2.*(x.*(16.*y.^2 + 4.*y - 8) - x.^2.*(16.*y.^2 + 4.*y - 8)) + x.^2.*(16.*y.^2 - 20.*y + 8)).*(8.*x.^2.*z.^2 + 12.*x.^2.*y - 8.*x.*z.^2 - 8.*x.^2 + 12.*x.*y.*z.^2 - 12.*x.^2.*y.*z.^2))./(-w).^3) .* (y>0.5); +%! d2Fdvv(3,:,:,:) = ((2.*y.*(4.*(x - 1).*(2.*x.^3 - 4.*x.^2 + 2.*x).*z.^2 + 4.*(2.*x.^2 - 2.*x.^3).*(x - 1)) - 4.*(3.*x - 3).*(x - 1) + 8.*x.*z.^3.*(x - 1))./w.^2 - (2.*(4.*(x - 1).^2 - y.*(4.*(3.*x - 3).*(x - 1) - 8.*x.*z.^3.*(x - 1)) + y.^2.*(4.*(x - 1).*(2.*x.^3 - 4.*x.^2 + 2.*x).*z.^2 + 4.*(2.*x.^2 - 2.*x.^3).*(x - 1))).*(- 4.*y.*x.^2.*z.^2 + 4.*y.*x.^2 + 4.*y.*x.*z.^2))./w.^3) .* (y<0.5) + ... +%! ((4.*(x - 1).*(4.*x.^3 - 4.*x.^2 + x - 1) + 2.*y.*(4.*(x - 1).*(2.*x.^3 - 4.*x.^2 + 2.*x).*z.^2 + 4.*(2.*x.^2 - 2.*x.^3).*(x - 1)) - 24.*x.*z.^3.*(x - 1) - 4.*z.^2.*(x - 1).*(4.*x.^3 - 8.*x.^2 + 4.*x))./w.^2 - (2.*(y.^2.*(4.*(x - 1).*(2.*x.^3 - 4.*x.^2 + 2.*x).*z.^2 + 4.*(2.*x.^2 - 2.*x.^3).*(x - 1)) - 4.*(x - 1).*(2.*x.^3 - 2.*x.^2 + x - 1) - y.*(24.*x.*(x - 1).*z.^3 + 4.*(x - 1).*(4.*x.^3 - 8.*x.^2 + 4.*x).*z.^2 - 4.*(x - 1).*(4.*x.^3 - 4.*x.^2 + x - 1)) + 16.*x.*z.^3.*(x - 1) + 4.*z.^2.*(x - 1).*(2.*x.^3 - 4.*x.^2 + 2.*x)).*(8.*x.^2.*z.^2 + 12.*x.^2.*y - 8.*x.*z.^2 - 8.*x.^2 + 12.*x.*y.*z.^2 - 12.*x.^2.*y.*z.^2))./(-w).^3) .* (y>0.5); +%! d2Fdvw = zeros ([3, size(x)]); +%! d2Fdvw(1,:,:,:) = (((8.*x.*z.*(x - 1).*(20.*x.^3.*z.^2 - 20.*x.^3 + 2.*x.^2.*z.^3 - 20.*x.^2.*z.^2 + 6.*x.^2.*z + 40.*x.^2 - 2.*x.*z.^3).*y.^3)/5 + (8.*x.*z.*(10.*x + 3.*z).*(x - 1).*y)/5)./w.^3) .* (y<0.5) + ... +%! (((8.*x.*(3.*y - 2).*(x - 1).*(- 6.*x.^2.*y.^2 + 8.*x.^2.*y - 2.*x.^2 + 6.*x.*y.^2 - 8.*x.*y + 2.*x).*z.^4)/5 + (8.*x.*(3.*y - 2).*(x - 1).*(- 60.*x.^3.*y.^2 + 80.*x.^3.*y - 20.*x.^3 + 60.*x.^2.*y.^2 - 80.*x.^2.*y + 20.*x.^2).*z.^3)/5 - (8.*x.*(3.*y - 2).*(x - 1).*(18.*x.^2.*y.^2 - 24.*x.^2.*y + 6.*x.^2 - 3).*z.^2)/5 + (8.*x.*(3.*y - 2).*(x - 1).*(60.*x.^3.*y.^2 - 80.*x.^3.*y + 20.*x.^3 - 120.*x.^2.*y.^2 + 160.*x.^2.*y - 40.*x.^2 + 10.*x).*z)/5)./(-w).^3) .* (y>0.5); +%! d2Fdvw(2,:,:,:) = ((4.*x.*y.*z.*(x - 1).*(40.*x.^2.*y.^3.*z.^2 - 40.*x.^2.*y.^3 + 6.*x.^2.*y.^2.*z.^3 + 18.*x.^2.*y.^2.*z + 80.*x.^2.*y.^2 - 40.*x.*y.^3.*z.^2 - 6.*x.*y.^2.*z.^3 - 40.*y.^2 + 60.*y + 9.*z))/5./w.^3) .* (y<0.5) + ... +%! (-((4.*x.*(x - 1).*(54.*x.^2.*y.^3 - 108.*x.^2.*y.^2 + 66.*x.^2.*y - 12.*x.^2 - 54.*x.*y.^3 + 108.*x.*y.^2 - 66.*x.*y + 12.*x).*z.^4)/5 + (4.*x.*(x - 1).*(240.*x.^2.*y.^4 - 260.*x.^2.*y.^3 - 120.*x.^2.*y.^2 + 180.*x.^2.*y - 40.*x.^2 - 240.*x.*y.^4 + 260.*x.*y.^3 + 120.*x.*y.^2 - 180.*x.*y + 40.*x).*z.^3)/5 - (4.*x.*(x - 1).*(- 162.*x.^2.*y.^3 + 324.*x.^2.*y.^2 - 198.*x.^2.*y + 36.*x.^2 + 27.*y - 18).*z.^2)/5 - (4.*x.*(x - 1).*(240.*x.^2.*y.^4 - 980.*x.^2.*y.^3 + 1320.*x.^2.*y.^2 - 700.*x.^2.*y + 120.*x.^2 + 120.*y.^3 - 120.*y.^2 + 50.*y - 20).*z)/5)./(-w).^3) .* (y>0.5); +%! d2Fdvw(3,:,:,:) = (-(y.^3.*(8.*x.*z.*(x - 1).*(12.*x.^2 - 24.*x + 12) - 48.*x.^3.*z.^2.*(x - 1) + 8.*x.*z.^4.*(2.*x - 2.*x.^2).*(x - 1)) + y.^4.*(8.*x.*(x - 1).*(- 4.*x.^4 + 12.*x.^3 - 12.*x.^2 + 4.*x).*z.^3 + 8.*x.*(x - 1).*(4.*x.^4 - 8.*x.^3 + 4.*x.^2).*z) - 24.*x.*y.*z.^2.*(x - 1) - 8.*x.*y.^2.*z.*(x - 1).*(6.*x.^2 - 12.*x + 6))./w.^3) .* (y<0.5) + ... +%! ((8.*z.*(x - 1).*(2.*x.^3 - 4.*x.^2 + 2.*x) - y.*(72.*x.*(x - 1).*z.^2 + 8.*(x - 1).*(4.*x.^3 - 8.*x.^2 + 4.*x).*z) + 48.*x.*z.^2.*(x - 1) + 8.*y.^2.*z.*(x - 1).*(2.*x.^3 - 4.*x.^2 + 2.*x))./w.^2 - (2.*(y.^2.*(4.*(x - 1).*(2.*x.^3 - 4.*x.^2 + 2.*x).*z.^2 + 4.*(2.*x.^2 - 2.*x.^3).*(x - 1)) - 4.*(x - 1).*(2.*x.^3 - 2.*x.^2 + x - 1) - y.*(24.*x.*(x - 1).*z.^3 + 4.*(x - 1).*(4.*x.^3 - 8.*x.^2 + 4.*x).*z.^2 - 4.*(x - 1).*(4.*x.^3 - 4.*x.^2 + x - 1)) + 16.*x.*z.^3.*(x - 1) + 4.*z.^2.*(x - 1).*(2.*x.^3 - 4.*x.^2 + 2.*x)).*(- 12.*z.*x.^2.*y.^2 + 16.*z.*x.^2.*y - 4.*z.*x.^2 + 12.*z.*x.*y.^2 - 16.*z.*x.*y + 4.*z.*x))./(-w).^3) .* (y>0.5); +%! d2Fdww = zeros ([3, size(x)]); +%! d2Fdww(1,:,:,:) = ((32.*x.*y.^2.*(2.*x.^2.*y.^2 + 1).*(x - 1).*(5.*x + z + 10.*x.^2.*y.^2 + 2.*x.^2.*y.^2.*z))./(5.*w.^3) - (8.*x.*y.^2.*(x - 1).*(15.*x + z + 30.*x.^2.*y.^2 + 2.*x.^2.*y.^2.*z))/5./w.^2) .* (y<0.5) + ... +%! (((8.*x.*(3.*y - 1).*(x - 1).*(y - 1).*(36.*x.^4.*y.^4 - 96.*x.^4.*y.^3 + 88.*x.^4.*y.^2 - 32.*x.^4.*y + 4.*x.^4 - 36.*x.^3.*y.^4 + 96.*x.^3.*y.^3 - 88.*x.^3.*y.^2 + 32.*x.^3.*y - 4.*x.^3 - 6.*x.^2.*y.^2 + 8.*x.^2.*y - 2.*x.^2 + 6.*x.*y.^2 - 8.*x.*y + 2.*x).*z.^3)/5 + (8.*x.*(3.*y - 1).*(x - 1).*(y - 1).*(540.*x.^4.*y.^4 - 1440.*x.^4.*y.^3 + 1320.*x.^4.*y.^2 - 480.*x.^4.*y + 60.*x.^4 - 540.*x.^3.*y.^4 + 1440.*x.^3.*y.^3 - 1410.*x.^3.*y.^2 + 600.*x.^3.*y - 90.*x.^3 + 90.*x.^2.*y.^2 - 120.*x.^2.*y + 30.*x.^2).*z.^2)/5 + (8.*x.*(3.*y - 1).*(x - 1).*(y - 1).*(108.*x.^4.*y.^4 - 288.*x.^4.*y.^3 + 264.*x.^4.*y.^2 - 96.*x.^4.*y + 12.*x.^4 - 36.*x.^2.*y.^2 + 48.*x.^2.*y - 12.*x.^2 + 3).*z)/5 + (8.*x.*(3.*y - 1).*(x - 1).*(y - 1).*(180.*x.^4.*y.^4 - 480.*x.^4.*y.^3 + 440.*x.^4.*y.^2 - 160.*x.^4.*y + 20.*x.^4 - 30.*x.^3.*y.^2 + 40.*x.^3.*y - 10.*x.^3 - 30.*x.^2.*y.^2 + 40.*x.^2.*y - 10.*x.^2 + 5.*x))/5)./(-w).^3) .* (y>0.5); +%! d2Fdww(2,:,:,:) = ((16.*x.*y.^2.*(2.*x.^2.*y.^2 + 1).*(x - 1).*(20.*y + 3.*z + 20.*x.^2.*y.^2 - 10.*y.^2 + 6.*x.^2.*y.^2.*z))./(5.*w.^3) - (12.*x.*y.^2.*(x - 1).*(20.*y + z + 20.*x.^2.*y.^2 - 10.*y.^2 + 2.*x.^2.*y.^2.*z))/5./w.^2) .* (y<0.5) + ... +%! (((4.*x.*(3.*y - 1).*(x - 1).*(y - 1).*(108.*x.^4.*y.^4 - 288.*x.^4.*y.^3 + 264.*x.^4.*y.^2 - 96.*x.^4.*y + 12.*x.^4 - 108.*x.^3.*y.^4 + 288.*x.^3.*y.^3 - 264.*x.^3.*y.^2 + 96.*x.^3.*y - 12.*x.^3 - 18.*x.^2.*y.^2 + 24.*x.^2.*y - 6.*x.^2 + 18.*x.*y.^2 - 24.*x.*y + 6.*x).*z.^3)/5 + (4.*x.*(3.*y - 1).*(x - 1).*(y - 1).*(1080.*x.^4.*y.^4 - 2880.*x.^4.*y.^3 + 2640.*x.^4.*y.^2 - 960.*x.^4.*y + 120.*x.^4 - 1080.*x.^3.*y.^4 + 2880.*x.^3.*y.^3 - 2640.*x.^3.*y.^2 + 960.*x.^3.*y - 120.*x.^3 - 180.*x.^2.*y.^4 + 240.*x.^2.*y.^3 - 150.*x.^2.*y.^2 + 120.*x.^2.*y - 30.*x.^2 + 180.*x.*y.^4 - 240.*x.*y.^3 + 150.*x.*y.^2 - 120.*x.*y + 30.*x).*z.^2)/5 + (4.*x.*(3.*y - 1).*(x - 1).*(y - 1).*(324.*x.^4.*y.^4 - 864.*x.^4.*y.^3 + 792.*x.^4.*y.^2 - 288.*x.^4.*y + 36.*x.^4 - 108.*x.^2.*y.^2 + 144.*x.^2.*y - 36.*x.^2 + 9).*z)/5 + (4.*x.*(3.*y - 1).*(x - 1).*(y - 1).*(360.*x.^4.*y.^4 - 960.*x.^4.*y.^3 + 880.*x.^4.*y.^2 - 320.*x.^4.*y + 40.*x.^4 - 60.*x.^2.*y.^4 + 80.*x.^2.*y.^3 - 110.*x.^2.*y.^2 + 120.*x.^2.*y - 30.*x.^2 + 10.*y.^2 + 5))/5)./(-w).^3) .* (y>0.5); +%! d2Fdww(3,:,:,:) = ((32.*x.*y.^2.*(2.*x.^2.*y.^2 + 1).*(x - 1).*(2.*y + z - 3.*x.^2.*y.^2 - 4.*x.*y + 6.*x.*y.^2 + 2.*x.^2.*y - 3.*y.^2 + 2.*x.^2.*y.^2.*z))./w.^3 - (8.*x.*y.^2.*(x - 1).*(6.*y + z - 9.*x.^2.*y.^2 - 12.*x.*y + 18.*x.*y.^2 + 6.*x.^2.*y - 9.*y.^2 + 2.*x.^2.*y.^2.*z))./w.^2) .* (y<0.5) + ... +%! ((2.*(- 6.*x.^2.*y.^2 + 8.*x.^2.*y - 2.*x.^2 + 6.*x.*y.^2 - 8.*x.*y + 2.*x).*(2.*z - 4.*y - 4.*x + 2.*x.^2.*y.^2 + 8.*x.*y - 4.*x.*y.^2 - 4.*x.^2.*y - 4.*x.^2.*z + 2.*x.^2 + 2.*y.^2 + 16.*x.^2.*y.*z - 12.*x.^2.*y.^2.*z + 2))./w.^2 - (8.*z.^2.*(- 6.*x.^2.*y.^2 + 8.*x.^2.*y - 2.*x.^2 + 6.*x.*y.^2 - 8.*x.*y + 2.*x).^2.*(2.*z - 4.*y - 4.*x + 2.*x.^2.*y.^2 + 8.*x.*y - 4.*x.*y.^2 - 4.*x.^2.*y - 4.*x.^2.*z + 2.*x.^2 + 2.*y.^2 + 16.*x.^2.*y.*z - 12.*x.^2.*y.^2.*z + 2))./(-w).^3 - (4.*z.*(12.*x.^2.*y.^2 - 16.*x.^2.*y + 4.*x.^2 - 2).*(- 6.*x.^2.*y.^2 + 8.*x.^2.*y - 2.*x.^2 + 6.*x.*y.^2 - 8.*x.*y + 2.*x))./w.^2) .* (y>0.5); +%! assert (F, pnt, 1e3*eps) +%! assert (dFdu, jac{1}, 1e3*eps) +%! assert (dFdv, jac{2}, 1e3*eps) +%! assert (dFdw, jac{3}, 1e3*eps) +%! assert (d2Fduu, hess{1,1}, 1e3*eps) +%! assert (d2Fduv, hess{1,2}, 1e3*eps) +%! assert (d2Fduw, hess{1,3}, 1e3*eps) +%! assert (d2Fduv, hess{2,1}, 1e3*eps) +%! assert (d2Fdvv, hess{2,2}, 1e3*eps) +%! assert (d2Fdvw, hess{2,3}, 1e3*eps) +%! assert (d2Fduw, hess{3,1}, 1e3*eps) +%! assert (d2Fdvw, hess{3,2}, 1e3*eps) +%! assert (d2Fdww, hess{3,3}, 1e3*eps) + + + +%!test +%! nrb = nrbextrude (nrb4surf ([0 0], [1 0], [0 1], [1 1]), [0 0 1]); +%! nrb = nrbdegelev (nrb, [1 1 1]); +%! nrb.coefs (4,2,2,2) = 1.1; +%! [dnrb, dnrb2] = nrbderiv (nrb); +%! X = linspace (0, 1, 24); Y = linspace (0, 1, 24); Z = linspace (0, 1, 24); +%! [pnt, jac, hess] = nrbdeval (nrb, dnrb, dnrb2, {X Y Z}); +%! [y, x, z] = meshgrid (X, Y, Z); +%! F = zeros ([3, size(x)]); +%! F(1,:,:,:) = (5.*x)./((- 4.*x.^2.*y.^2 + 4.*x.^2.*y + 4.*x.*y.^2 - 4.*x.*y).*z.^2 + (4.*x.^2.*y.^2 - 4.*x.^2.*y - 4.*x.*y.^2 + 4.*x.*y).*z + 5); +%! F(2,:,:,:) = (5.*y)./((- 4.*x.^2.*y.^2 + 4.*x.^2.*y + 4.*x.*y.^2 - 4.*x.*y).*z.^2 + (4.*x.^2.*y.^2 - 4.*x.^2.*y - 4.*x.*y.^2 + 4.*x.*y).*z + 5); +%! F(3,:,:,:) = (5.*z)./((- 4.*x.^2.*y.^2 + 4.*x.^2.*y + 4.*x.*y.^2 - 4.*x.*y).*z.^2 + (4.*x.^2.*y.^2 - 4.*x.^2.*y - 4.*x.*y.^2 + 4.*x.*y).*z + 5); +%! dFdu = zeros ([3, size(x)]); +%! dFdu(1,:,:,:) = ((z.*(20.*y - 20.*y.^2) - z.^2.*(20.*y - 20.*y.^2)).*x.^2 + 25)./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^2; +%! dFdu(2,:,:,:) = (y.^2.*(5.*z.*(8.*x - 4) - 5.*z.^2.*(8.*x - 4)) - y.^3.*(5.*z.*(8.*x - 4) - 5.*z.^2.*(8.*x - 4)))./((- 4.*x.^2.*y.^2 + 4.*x.^2.*y + 4.*x.*y.^2 - 4.*x.*y).*z.^2 + (4.*x.^2.*y.^2 - 4.*x.^2.*y - 4.*x.*y.^2 + 4.*x.*y).*z + 5).^2; +%! dFdu(3,:,:,:) = (z.^2.*(5.*y.*(8.*x - 4) - 5.*y.^2.*(8.*x - 4)) - z.^3.*(5.*y.*(8.*x - 4) - 5.*y.^2.*(8.*x - 4)))./((- 4.*x.^2.*y.^2 + 4.*x.^2.*y + 4.*x.*y.^2 - 4.*x.*y).*z.^2 + (4.*x.^2.*y.^2 - 4.*x.^2.*y - 4.*x.*y.^2 + 4.*x.*y).*z + 5).^2; +%! dFdv = zeros ([3, size(x)]); +%! dFdv(1,:,:,:) = (x.^2.*(5.*z.*(8.*y - 4) - 5.*z.^2.*(8.*y - 4)) - x.^3.*(5.*z.*(8.*y - 4) - 5.*z.^2.*(8.*y - 4)))./((- 4.*x.^2.*y.^2 + 4.*x.^2.*y + 4.*x.*y.^2 - 4.*x.*y).*z.^2 + (4.*x.^2.*y.^2 - 4.*x.^2.*y - 4.*x.*y.^2 + 4.*x.*y).*z + 5).^2; +%! dFdv(2,:,:,:) = ((z.*(20.*x - 20.*x.^2) - z.^2.*(20.*x - 20.*x.^2)).*y.^2 + 25)./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^2; +%! dFdv(3,:,:,:) = (z.^2.*(5.*x.*(8.*y - 4) - 5.*x.^2.*(8.*y - 4)) - z.^3.*(5.*x.*(8.*y - 4) - 5.*x.^2.*(8.*y - 4)))./((- 4.*x.^2.*y.^2 + 4.*x.^2.*y + 4.*x.*y.^2 - 4.*x.*y).*z.^2 + (4.*x.^2.*y.^2 - 4.*x.^2.*y - 4.*x.*y.^2 + 4.*x.*y).*z + 5).^2; +%! dFdw = zeros ([3, size(x)]); +%! dFdw(1,:,:,:) = (x.^2.*(y.*(40.*z - 20) - y.^2.*(40.*z - 20)) - x.^3.*(y.*(40.*z - 20) - y.^2.*(40.*z - 20)))./((- 4.*x.^2.*y.^2 + 4.*x.^2.*y + 4.*x.*y.^2 - 4.*x.*y).*z.^2 + (4.*x.^2.*y.^2 - 4.*x.^2.*y - 4.*x.*y.^2 + 4.*x.*y).*z + 5).^2; +%! dFdw(2,:,:,:) = (y.^2.*(x.*(40.*z - 20) - x.^2.*(40.*z - 20)) - y.^3.*(x.*(40.*z - 20) - x.^2.*(40.*z - 20)))./((- 4.*x.^2.*y.^2 + 4.*x.^2.*y + 4.*x.*y.^2 - 4.*x.*y).*z.^2 + (4.*x.^2.*y.^2 - 4.*x.^2.*y - 4.*x.*y.^2 + 4.*x.*y).*z + 5).^2; +%! dFdw(3,:,:,:) = ((y.*(20.*x - 20.*x.^2) - y.^2.*(20.*x - 20.*x.^2)).*z.^2 + 25)./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^2; +%! d2Fduu = zeros ([3, size(x)]); +%! d2Fduu(1,:,:,:) = (40.*y.*z.*(y - 1).*(z - 1).*(4.*x.^3.*y.^2.*z.^2 - 4.*x.^3.*y.^2.*z - 4.*x.^3.*y.*z.^2 + 4.*x.^3.*y.*z + 15.*x - 5))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fduu(2,:,:,:) = (40.*y.^2.*z.*(y - 1).*(z - 1).*(4.*y.^2.*z.^2 - 4.*y.^2.*z - 4.*y.*z.^2 + 4.*y.*z + 5) - 40.*x.*y.^2.*z.*(y - 1).*(z - 1).*(12.*y.^2.*z.^2 - 12.*y.^2.*z - 12.*y.*z.^2 + 12.*y.*z) + 40.*x.^2.*y.^2.*z.*(y - 1).*(z - 1).*(12.*y.^2.*z.^2 - 12.*y.^2.*z - 12.*y.*z.^2 + 12.*y.*z))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fduu(3,:,:,:) = (40.*y.*z.^2.*(y - 1).*(z - 1).*(4.*y.^2.*z.^2 - 4.*y.^2.*z - 4.*y.*z.^2 + 4.*y.*z + 5) - 40.*x.*y.*z.^2.*(y - 1).*(z - 1).*(12.*y.^2.*z.^2 - 12.*y.^2.*z - 12.*y.*z.^2 + 12.*y.*z) + 40.*x.^2.*y.*z.^2.*(y - 1).*(z - 1).*(12.*y.^2.*z.^2 - 12.*y.^2.*z - 12.*y.*z.^2 + 12.*y.*z))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fduv = zeros ([3, size(x)]); +%! d2Fduv(1,:,:,:) = (20.*x.*z.*(2.*y - 1).*(z - 1).*(4.*x.^3.*y.^2.*z.^2 - 4.*x.^3.*y.^2.*z - 4.*x.^3.*y.*z.^2 + 4.*x.^3.*y.*z - 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 15.*x - 10))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fduv(2,:,:,:) = (20.*y.*z.*(2.*x - 1).*(z - 1).*(4.*x.^2.*y.^3.*z.^2 - 4.*x.^2.*y.^3.*z - 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z - 4.*x.*y.^3.*z.^2 + 4.*x.*y.^3.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z + 15.*y - 10))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fduv(3,:,:,:) = (20.*z.^2.*(2.*x - 1).*(2.*y - 1).*(z - 1).*(4.*x.^2.*y.^2.*z.^2 - 4.*x.^2.*y.^2.*z - 4.*x.^2.*y.*z.^2 + 4.*x.^2.*y.*z - 4.*x.*y.^2.*z.^2 + 4.*x.*y.^2.*z + 4.*x.*y.*z.^2 - 4.*x.*y.*z + 5))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fduw = zeros ([3, size(x)]); +%! d2Fduw(1,:,:,:) = (20.*x.*y.*(2.*z - 1).*(y - 1).*(4.*x.^3.*y.^2.*z.^2 - 4.*x.^3.*y.^2.*z - 4.*x.^3.*y.*z.^2 + 4.*x.^3.*y.*z - 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 15.*x - 10))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fduw(2,:,:,:) = (20.*y.^2.*(2.*x - 1).*(2.*z - 1).*(y - 1).*(4.*x.^2.*y.^2.*z.^2 - 4.*x.^2.*y.^2.*z - 4.*x.^2.*y.*z.^2 + 4.*x.^2.*y.*z - 4.*x.*y.^2.*z.^2 + 4.*x.*y.^2.*z + 4.*x.*y.*z.^2 - 4.*x.*y.*z + 5))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fduw(3,:,:,:) = (20.*y.*z.*(2.*x - 1).*(y - 1).*(4.*x.^2.*y.^2.*z.^3 - 4.*x.^2.*y.^2.*z.^2 - 4.*x.^2.*y.*z.^3 + 4.*x.^2.*y.*z.^2 - 4.*x.*y.^2.*z.^3 + 4.*x.*y.^2.*z.^2 + 4.*x.*y.*z.^3 - 4.*x.*y.*z.^2 + 15.*z - 10))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fdvv = zeros ([3, size(x)]); +%! d2Fdvv(1,:,:,:) = (40.*x.^2.*z.*(x - 1).*(z - 1).*(4.*x.^2.*z.^2 - 4.*x.^2.*z - 4.*x.*z.^2 + 4.*x.*z + 5) + 40.*x.^2.*y.^2.*z.*(x - 1).*(z - 1).*(12.*x.^2.*z.^2 - 12.*x.^2.*z - 12.*x.*z.^2 + 12.*x.*z) - 40.*x.^2.*y.*z.*(x - 1).*(z - 1).*(12.*x.^2.*z.^2 - 12.*x.^2.*z - 12.*x.*z.^2 + 12.*x.*z))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fdvv(2,:,:,:) = (40.*x.*z.*(x - 1).*(z - 1).*(4.*x.^2.*y.^3.*z.^2 - 4.*x.^2.*y.^3.*z - 4.*x.*y.^3.*z.^2 + 4.*x.*y.^3.*z + 15.*y - 5))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fdvv(3,:,:,:) = (40.*x.*z.^2.*(x - 1).*(z - 1).*(4.*x.^2.*z.^2 - 4.*x.^2.*z - 4.*x.*z.^2 + 4.*x.*z + 5) + 40.*x.*y.^2.*z.^2.*(x - 1).*(z - 1).*(12.*x.^2.*z.^2 - 12.*x.^2.*z - 12.*x.*z.^2 + 12.*x.*z) - 40.*x.*y.*z.^2.*(x - 1).*(z - 1).*(12.*x.^2.*z.^2 - 12.*x.^2.*z - 12.*x.*z.^2 + 12.*x.*z))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fdvw = zeros ([3, size(x)]); +%! d2Fdvw(1,:,:,:) = (20.*x.^2.*(2.*y - 1).*(2.*z - 1).*(x - 1).*(4.*x.^2.*y.^2.*z.^2 - 4.*x.^2.*y.^2.*z - 4.*x.^2.*y.*z.^2 + 4.*x.^2.*y.*z - 4.*x.*y.^2.*z.^2 + 4.*x.*y.^2.*z + 4.*x.*y.*z.^2 - 4.*x.*y.*z + 5))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fdvw(2,:,:,:) = (20.*x.*y.*(2.*z - 1).*(x - 1).*(4.*x.^2.*y.^3.*z.^2 - 4.*x.^2.*y.^3.*z - 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z - 4.*x.*y.^3.*z.^2 + 4.*x.*y.^3.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z + 15.*y - 10))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fdvw(3,:,:,:) = (20.*x.*z.*(2.*y - 1).*(x - 1).*(4.*x.^2.*y.^2.*z.^3 - 4.*x.^2.*y.^2.*z.^2 - 4.*x.^2.*y.*z.^3 + 4.*x.^2.*y.*z.^2 - 4.*x.*y.^2.*z.^3 + 4.*x.*y.^2.*z.^2 + 4.*x.*y.*z.^3 - 4.*x.*y.*z.^2 + 15.*z - 10))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fdww = zeros ([3, size(x)]); +%! d2Fdww(1,:,:,:) = (40.*x.^2.*y.*(x - 1).*(y - 1).*(4.*x.^2.*y.^2 - 4.*x.^2.*y - 4.*x.*y.^2 + 4.*x.*y + 5) + 40.*x.^2.*y.*z.^2.*(x - 1).*(y - 1).*(12.*x.^2.*y.^2 - 12.*x.^2.*y - 12.*x.*y.^2 + 12.*x.*y) - 40.*x.^2.*y.*z.*(x - 1).*(y - 1).*(12.*x.^2.*y.^2 - 12.*x.^2.*y - 12.*x.*y.^2 + 12.*x.*y))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fdww(2,:,:,:) = (40.*x.*y.^2.*(x - 1).*(y - 1).*(4.*x.^2.*y.^2 - 4.*x.^2.*y - 4.*x.*y.^2 + 4.*x.*y + 5) + 40.*x.*y.^2.*z.^2.*(x - 1).*(y - 1).*(12.*x.^2.*y.^2 - 12.*x.^2.*y - 12.*x.*y.^2 + 12.*x.*y) - 40.*x.*y.^2.*z.*(x - 1).*(y - 1).*(12.*x.^2.*y.^2 - 12.*x.^2.*y - 12.*x.*y.^2 + 12.*x.*y))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; +%! d2Fdww(3,:,:,:) = (40.*x.*y.*(x - 1).*(y - 1).*(4.*x.^2.*y.^2.*z.^3 - 4.*x.^2.*y.*z.^3 - 4.*x.*y.^2.*z.^3 + 4.*x.*y.*z.^3 + 15.*z - 5))./(- 4.*x.^2.*y.^2.*z.^2 + 4.*x.^2.*y.^2.*z + 4.*x.^2.*y.*z.^2 - 4.*x.^2.*y.*z + 4.*x.*y.^2.*z.^2 - 4.*x.*y.^2.*z - 4.*x.*y.*z.^2 + 4.*x.*y.*z + 5).^3; diff --git a/octave_packages/nurbs-1.3.6/nrbdeval.m b/octave_packages/nurbs-1.3.6/nrbdeval.m new file mode 100644 index 0000000..fed0ed9 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbdeval.m @@ -0,0 +1,272 @@ +function varargout = nrbdeval (nurbs, dnurbs, varargin) + +% NRBDEVAL: Evaluation of the derivative and second derivatives of NURBS curve, surface or volume. +% +% [pnt, jac] = nrbdeval (crv, dcrv, tt) +% [pnt, jac] = nrbdeval (srf, dsrf, {tu tv}) +% [pnt, jac] = nrbdeval (vol, dvol, {tu tv tw}) +% [pnt, jac, hess] = nrbdeval (crv, dcrv, dcrv2, tt) +% [pnt, jac, hess] = nrbdeval (srf, dsrf, dsrf2, {tu tv}) +% [pnt, jac, hess] = nrbdeval (vol, dvol, {tu tv tw}) +% +% INPUTS: +% +% crv, srf, vol - original NURBS curve, surface or volume. +% dcrv, dsrf, dvol - NURBS derivative representation of crv, srf +% or vol (see nrbderiv2) +% dcrv2, dsrf2, dvol2 - NURBS second derivative representation of crv, +% srf or vol (see nrbderiv2) +% tt - parametric evaluation points +% If the nurbs is a surface or a volume then tt is a cell +% {tu, tv} or {tu, tv, tw} are the parametric coordinates +% +% OUTPUT: +% +% pnt - evaluated points. +% jac - evaluated first derivatives (Jacobian). +% hess - evaluated second derivatives (Hessian). +% +% Copyright (C) 2000 Mark Spink +% Copyright (C) 2010 Carlo de Falco +% Copyright (C) 2010, 2011 Rafael Vazquez +% +% 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 . + +if (nargin == 3) + tt = varargin{1}; +elseif (nargin == 4) + dnurbs2 = varargin{1}; + tt = varargin{2}; +else + error ('nrbrdeval: wrong number of input parameters') +end + +if (~isstruct(nurbs)) + error('NURBS representation is not structure!'); +end + +if (~strcmp(nurbs.form,'B-NURBS')) + error('Not a recognised NURBS representation'); +end + +[cp,cw] = nrbeval(nurbs, tt); + +if (iscell(nurbs.knots)) + if (size(nurbs.knots,2) == 3) + % NURBS structure represents a volume + temp = cw(ones(3,1),:,:,:); + pnt = cp./temp; + + [cup,cuw] = nrbeval (dnurbs{1}, tt); + tempu = cuw(ones(3,1),:,:,:); + jac{1} = (cup-tempu.*pnt)./temp; + + [cvp,cvw] = nrbeval (dnurbs{2}, tt); + tempv = cvw(ones(3,1),:,:,:); + jac{2} = (cvp-tempv.*pnt)./temp; + + [cwp,cww] = nrbeval (dnurbs{3}, tt); + tempw = cww(ones(3,1),:,:,:); + jac{3} = (cwp-tempw.*pnt)./temp; + +% second derivatives + if (nargout == 3) + if (exist ('dnurbs2')) + [cuup, cuuw] = nrbeval (dnurbs2{1,1}, tt); + tempuu = cuuw(ones(3,1),:,:,:); + hess{1,1} = (cuup - (2*cup.*tempu + cp.*tempuu)./temp + 2*cp.*tempu.^2./temp.^2)./temp; + clear cuup cuuw tempuu + + [cvvp, cvvw] = nrbeval (dnurbs2{2,2}, tt); + tempvv = cvvw(ones(3,1),:,:,:); + hess{2,2} = (cvvp - (2*cvp.*tempv + cp.*tempvv)./temp + 2*cp.*tempv.^2./temp.^2)./temp; + clear cvvp cvvw tempvv + + [cwwp, cwww] = nrbeval (dnurbs2{3,3}, tt); + tempww = cwww(ones(3,1),:,:,:); + hess{3,3} = (cwwp - (2*cwp.*tempw + cp.*tempww)./temp + 2*cp.*tempw.^2./temp.^2)./temp; + clear cwwp cwww tempww + + [cuvp, cuvw] = nrbeval (dnurbs2{1,2}, tt); + tempuv = cuvw(ones(3,1),:,:,:); + hess{1,2} = (cuvp - (cup.*tempv + cvp.*tempu + cp.*tempuv)./temp + 2*cp.*tempu.*tempv./temp.^2)./temp; + hess{2,1} = hess{1,2}; + clear cuvp cuvw tempuv + + [cuwp, cuww] = nrbeval (dnurbs2{1,3}, tt); + tempuw = cuww(ones(3,1),:,:,:); + hess{1,3} = (cuwp - (cup.*tempw + cwp.*tempu + cp.*tempuw)./temp + 2*cp.*tempu.*tempw./temp.^2)./temp; + hess{3,1} = hess{1,3}; + clear cuwp cuww tempuw + + [cvwp, cvww] = nrbeval (dnurbs2{2,3}, tt); + tempvw = cvww(ones(3,1),:,:,:); + hess{2,3} = (cvwp - (cvp.*tempw + cwp.*tempv + cp.*tempvw)./temp + 2*cp.*tempv.*tempw./temp.^2)./temp; + hess{3,2} = hess{2,3}; + clear cvwp cvww tempvw + else + warning ('nrbdeval: dnurbs2 missing. The second derivative is not computed'); + hess = []; + end + end + + elseif (size(nurbs.knots,2) == 2) + % NURBS structure represents a surface + temp = cw(ones(3,1),:,:); + pnt = cp./temp; + + [cup,cuw] = nrbeval (dnurbs{1}, tt); + tempu = cuw(ones(3,1),:,:); + jac{1} = (cup-tempu.*pnt)./temp; + + [cvp,cvw] = nrbeval (dnurbs{2}, tt); + tempv = cvw(ones(3,1),:,:); + jac{2} = (cvp-tempv.*pnt)./temp; + +% second derivatives + if (nargout == 3) + if (exist ('dnurbs2')) + [cuup, cuuw] = nrbeval (dnurbs2{1,1}, tt); + tempuu = cuuw(ones(3,1),:,:); + hess{1,1} = (cuup - (2*cup.*tempu + cp.*tempuu)./temp + 2*cp.*tempu.^2./temp.^2)./temp; + + [cvvp, cvvw] = nrbeval (dnurbs2{2,2}, tt); + tempvv = cvvw(ones(3,1),:,:); + hess{2,2} = (cvvp - (2*cvp.*tempv + cp.*tempvv)./temp + 2*cp.*tempv.^2./temp.^2)./temp; + + [cuvp, cuvw] = nrbeval (dnurbs2{1,2}, tt); + tempuv = cuvw(ones(3,1),:,:); + hess{1,2} = (cuvp - (cup.*tempv + cvp.*tempu + cp.*tempuv)./temp + 2*cp.*tempu.*tempv./temp.^2)./temp; + hess{2,1} = hess{1,2}; + else + warning ('nrbdeval: dnurbs2 missing. The second derivative is not computed'); + hess = []; + end + end + + end +else + + % NURBS is a curve + temp = cw(ones(3,1),:); + pnt = cp./temp; + + % first derivative + [cup,cuw] = nrbeval (dnurbs,tt); + temp1 = cuw(ones(3,1),:); + jac = (cup-temp1.*pnt)./temp; + + % second derivative + if (nargout == 3 && exist ('dnurbs2')) + [cuup,cuuw] = nrbeval (dnurbs2, tt); + temp2 = cuuw(ones(3,1),:); + hess = (cuup - (2*cup.*temp1 + cp.*temp2)./temp + 2*cp.*temp1.^2./temp.^2)./temp; + end + +end + +varargout{1} = pnt; +varargout{2} = jac; +if (nargout == 3) + varargout{3} = hess; +end + +end + +%!demo +%! crv = nrbtestcrv; +%! nrbplot(crv,48); +%! title('First derivatives along a test curve.'); +%! +%! tt = linspace(0.0,1.0,9); +%! +%! dcrv = nrbderiv(crv); +%! +%! [p1, dp] = nrbdeval(crv,dcrv,tt); +%! +%! p2 = vecnorm(dp); +%! +%! hold on; +%! plot(p1(1,:),p1(2,:),'ro'); +%! h = quiver(p1(1,:),p1(2,:),p2(1,:),p2(2,:),0); +%! set(h,'Color','black'); +%! hold off; + +%!demo +%! srf = nrbtestsrf; +%! p = nrbeval(srf,{linspace(0.0,1.0,20) linspace(0.0,1.0,20)}); +%! h = surf(squeeze(p(1,:,:)),squeeze(p(2,:,:)),squeeze(p(3,:,:))); +%! set(h,'FaceColor','blue','EdgeColor','blue'); +%! title('First derivatives over a test surface.'); +%! +%! npts = 5; +%! tt = linspace(0.0,1.0,npts); +%! dsrf = nrbderiv(srf); +%! +%! [p1, dp] = nrbdeval(srf, dsrf, {tt, tt}); +%! +%! up2 = vecnorm(dp{1}); +%! vp2 = vecnorm(dp{2}); +%! +%! hold on; +%! plot3(p1(1,:),p1(2,:),p1(3,:),'ro'); +%! h1 = quiver3(p1(1,:),p1(2,:),p1(3,:),up2(1,:),up2(2,:),up2(3,:)); +%! h2 = quiver3(p1(1,:),p1(2,:),p1(3,:),vp2(1,:),vp2(2,:),vp2(3,:)); +%! set(h1,'Color','black'); +%! set(h2,'Color','black'); +%! +%! hold off; + +%!test +%! knots{1} = [0 0 0 1 1 1]; +%! knots{2} = [0 0 0 .5 1 1 1]; +%! knots{3} = [0 0 0 0 1 1 1 1]; +%! cx = [0 0.5 1]; nx = length(cx); +%! cy = [0 0.25 0.75 1]; ny = length(cy); +%! cz = [0 1/3 2/3 1]; nz = length(cz); +%! coefs(1,:,:,:) = repmat(reshape(cx,nx,1,1),[1 ny nz]); +%! coefs(2,:,:,:) = repmat(reshape(cy,1,ny,1),[nx 1 nz]); +%! coefs(3,:,:,:) = repmat(reshape(cz,1,1,nz),[nx ny 1]); +%! coefs(4,:,:,:) = 1; +%! nurbs = nrbmak(coefs, knots); +%! x = rand(5,1); y = rand(5,1); z = rand(5,1); +%! tt = [x y z]'; +%! ders = nrbderiv(nurbs); +%! [points,jac] = nrbdeval(nurbs,ders,tt); +%! assert(points,tt,1e-10) +%! assert(jac{1}(1,:,:),ones(size(jac{1}(1,:,:))),1e-12) +%! assert(jac{2}(2,:,:),ones(size(jac{2}(2,:,:))),1e-12) +%! assert(jac{3}(3,:,:),ones(size(jac{3}(3,:,:))),1e-12) +%! +%!test +%! knots{1} = [0 0 0 1 1 1]; +%! knots{2} = [0 0 0 0 1 1 1 1]; +%! knots{3} = [0 0 0 1 1 1]; +%! cx = [0 0 1]; nx = length(cx); +%! cy = [0 0 0 1]; ny = length(cy); +%! cz = [0 0.5 1]; nz = length(cz); +%! coefs(1,:,:,:) = repmat(reshape(cx,nx,1,1),[1 ny nz]); +%! coefs(2,:,:,:) = repmat(reshape(cy,1,ny,1),[nx 1 nz]); +%! coefs(3,:,:,:) = repmat(reshape(cz,1,1,nz),[nx ny 1]); +%! coefs(4,:,:,:) = 1; +%! coefs = coefs([2 1 3 4],:,:,:); +%! nurbs = nrbmak(coefs, knots); +%! x = rand(5,1); y = rand(5,1); z = rand(5,1); +%! tt = [x y z]'; +%! dnurbs = nrbderiv(nurbs); +%! [points, jac] = nrbdeval(nurbs,dnurbs,tt); +%! assert(points,[y.^3 x.^2 z]',1e-10); +%! assert(jac{2}(1,:,:),3*y'.^2,1e-12) +%! assert(jac{1}(2,:,:),2*x',1e-12) +%! assert(jac{3}(3,:,:),ones(size(z')),1e-12) \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/nrbeval.m b/octave_packages/nurbs-1.3.6/nrbeval.m new file mode 100644 index 0000000..2cfa4bf --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbeval.m @@ -0,0 +1,304 @@ +function [p,w] = nrbeval(nurbs,tt) +% +% NRBEVAL: Evaluate a NURBS at parametric points. +% +% Calling Sequences: +% +% [p,w] = nrbeval(crv,ut) +% [p,w] = nrbeval(srf,{ut,vt}) +% [p,w] = nrbeval(vol,{ut,vt,wt}) +% [p,w] = nrbeval(srf,pts) +% +% INPUT: +% +% crv : NURBS curve, see nrbmak. +% +% srf : NURBS surface, see nrbmak. +% +% vol : NURBS volume, see nrbmak. +% +% ut : Parametric evaluation points along U direction. +% +% vt : Parametric evaluation points along V direction. +% +% wt : Parametric evaluation points along W direction. +% +% pts : Array of scattered points in parametric domain +% +% OUTPUT: +% +% p : Evaluated points on the NURBS curve, surface or volume as +% Cartesian coordinates (x,y,z). If w is included on the lhs argument +% list the points are returned as homogeneous coordinates (wx,wy,wz). +% +% w : Weights of the homogeneous coordinates of the evaluated +% points. Note inclusion of this argument changes the type +% of coordinates returned in p (see above). +% +% Description: +% +% Evaluation of NURBS curves, surfaces or volume at parametric points along +% the U, V and W directions. Either homogeneous coordinates are returned +% if the weights are requested in the lhs arguments, or as Cartesian coordinates. +% This function utilises the 'C' interface bspeval. +% +% Examples: +% +% Evaluate the NURBS circle at twenty points from 0.0 to 1.0 +% +% nrb = nrbcirc; +% ut = linspace(0.0,1.0,20); +% p = nrbeval(nrb,ut); +% +% See also: +% +% bspeval +% +% Copyright (C) 2000 Mark Spink +% Copyright (C) 2010 Carlo de Falco +% Copyright (C) 2010, 2011 Rafael Vazquez +% +% 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 . + +if (nargin < 2) + error('Not enough input arguments'); +end + +foption = 1; % output format 3D cartesian coordinates +if (nargout == 2) + foption = 0; % output format 4D homogenous coordinates +end + +if (~isstruct(nurbs)) + error('NURBS representation is not structure!'); +end + +if (~strcmp(nurbs.form,'B-NURBS')) + error('Not a recognised NURBS representation'); +end + +if (iscell(nurbs.knots)) + if (size(nurbs.knots,2) == 3) + %% NURBS structure represents a volume + + num1 = nurbs.number(1); + num2 = nurbs.number(2); + num3 = nurbs.number(3); + degree = nurbs.order-1; + + if (iscell(tt)) + nt1 = numel (tt{1}); + nt2 = numel (tt{2}); + nt3 = numel (tt{3}); + + %% evaluate along the w direction + val = reshape (nurbs.coefs, 4*num1*num2, num3); + val = bspeval (degree(3), val, nurbs.knots{3}, tt{3}); + val = reshape (val, [4 num1 num2 nt3]); + + %% Evaluate along the v direction + val = permute (val, [1 2 4 3]); + val = reshape (val, 4*num1*nt3, num2); + val = bspeval (degree(2), val, nurbs.knots{2}, tt{2}); + val = reshape (val, [4 num1 nt3 nt2]); + val = permute (val, [1 2 4 3]); + + %% Evaluate along the u direction + val = permute (val, [1 3 4 2]); + val = reshape (val, 4*nt2*nt3, num1); + val = bspeval (degree(1), val, nurbs.knots{1}, tt{1}); + val = reshape (val, [4 nt2 nt3 nt1]); + val = permute (val, [1 4 2 3]); + pnts = val; + + p = pnts(1:3,:,:,:); + w = pnts(4,:,:,:); + if (foption) + p = p./repmat(w,[3 1 1 1]); + end + + else + + %% Evaluate at scattered points + %% tt(1,:) represents the u direction + %% tt(2,:) represents the v direction + %% tt(3,:) represents the w direction + + %% evaluate along the w direction + nt = size(tt,2); + val = reshape(nurbs.coefs,4*num1*num2,num3); + val = bspeval(degree(3),val,nurbs.knots{3},tt(3,:)); + val = reshape(val,[4 num1 num2 nt]); + + %% evaluate along the v direction + val2 = zeros(4*num1,nt); + for v = 1:nt + coefs = reshape(val(:,:,:,v),4*num1,num2); + val2(:,v) = bspeval(degree(2),coefs,nurbs.knots{2},tt(2,v)); + end + val2 = reshape(val2,[4 num1 nt]); + + %% evaluate along the u direction + pnts = zeros(4,nt); + for v = 1:nt + coefs = reshape (val2(:,:,v), [4 num1]); + pnts(:,v) = bspeval(degree(1),coefs,nurbs.knots{1},tt(1,v)); + end + + w = pnts(4,:); + p = pnts(1:3,:); + if (foption) + p = p./repmat(w,[3, 1]); + end + end + + elseif (size(nurbs.knots,2) == 2) + %% NURBS structure represents a surface + + num1 = nurbs.number(1); + num2 = nurbs.number(2); + degree = nurbs.order-1; + + if (iscell(tt)) + %% Evaluate over a [u,v] grid + %% tt{1} represents the u direction + %% tt{2} represents the v direction + + nt1 = length(tt{1}); + nt2 = length(tt{2}); + + %% Evaluate along the v direction + val = reshape(nurbs.coefs,4*num1,num2); + val = bspeval(degree(2),val,nurbs.knots{2},tt{2}); + val = reshape(val,[4 num1 nt2]); + + %% Evaluate along the u direction + val = permute(val,[1 3 2]); + val = reshape(val,4*nt2,num1); + val = bspeval(degree(1),val,nurbs.knots{1},tt{1}); + val = reshape(val,[4 nt2 nt1]); + val = permute(val,[1 3 2]); + + w = val(4,:,:); + p = val(1:3,:,:); + if (foption) + p = p./repmat(w,[3 1 1]); + end + + else + + %% Evaluate at scattered points + %% tt(1,:) represents the u direction + %% tt(2,:) represents the v direction + + nt = size(tt,2); + + val = reshape(nurbs.coefs,4*num1,num2); + val = bspeval(degree(2),val,nurbs.knots{2},tt(2,:)); + val = reshape(val,[4 num1 nt]); + + + %% evaluate along the u direction + pnts = zeros(4,nt); + for v = 1:nt + coefs = reshape (val(:,:,v), [4 num1]); + pnts(:,v) = bspeval(degree(1),coefs,nurbs.knots{1},tt(1,v)); + end + + w = pnts(4,:); + p = pnts(1:3,:); + if (foption) + p = p./repmat(w,[3, 1]); + end + + end + + end +else + + %% NURBS structure represents a curve + %% tt represent a vector of parametric points in the u direction + + val = bspeval(nurbs.order-1,nurbs.coefs,nurbs.knots,tt); + + w = val(4,:); + p = val(1:3,:); + if foption + p = p./repmat(w,3,1); + end + +end + +end + +%!demo +%! srf = nrbtestsrf; +%! p = nrbeval(srf,{linspace(0.0,1.0,20) linspace(0.0,1.0,20)}); +%! h = surf(squeeze(p(1,:,:)),squeeze(p(2,:,:)),squeeze(p(3,:,:))); +%! title('Test surface.'); +%! hold off + +%!test +%! knots{1} = [0 0 0 1 1 1]; +%! knots{2} = [0 0 0 .5 1 1 1]; +%! knots{3} = [0 0 0 0 1 1 1 1]; +%! cx = [0 0.5 1]; nx = length(cx); +%! cy = [0 0.25 0.75 1]; ny = length(cy); +%! cz = [0 1/3 2/3 1]; nz = length(cz); +%! coefs(1,:,:,:) = repmat(reshape(cx,nx,1,1),[1 ny nz]); +%! coefs(2,:,:,:) = repmat(reshape(cy,1,ny,1),[nx 1 nz]); +%! coefs(3,:,:,:) = repmat(reshape(cz,1,1,nz),[nx ny 1]); +%! coefs(4,:,:,:) = 1; +%! nurbs = nrbmak(coefs, knots); +%! x = rand(5,1); y = rand(5,1); z = rand(5,1); +%! tt = [x y z]'; +%! points = nrbeval(nurbs,tt); +%! +%! assert(points,tt,1e-10) +%! +%!test +%! knots{1} = [0 0 0 1 1 1]; +%! knots{2} = [0 0 0 0 1 1 1 1]; +%! knots{3} = [0 0 1 1]; +%! cx = [0 0 1]; nx = length(cx); +%! cy = [0 0 0 1]; ny = length(cy); +%! cz = [0 1]; nz = length(cz); +%! coefs(1,:,:,:) = repmat(reshape(cx,nx,1,1),[1 ny nz]); +%! coefs(2,:,:,:) = repmat(reshape(cy,1,ny,1),[nx 1 nz]); +%! coefs(3,:,:,:) = repmat(reshape(cz,1,1,nz),[nx ny 1]); +%! coefs(4,:,:,:) = 1; +%! nurbs = nrbmak(coefs, knots); +%! x = rand(5,1); y = rand(5,1); z = rand(5,1); +%! tt = [x y z]'; +%! points = nrbeval(nurbs,tt); +%! assert(points,[x.^2 y.^3 z]',1e-10); +%! +%!test +%! knots{1} = [0 0 0 1 1 1]; +%! knots{2} = [0 0 0 0 1 1 1 1]; +%! knots{3} = [0 0 1 1]; +%! cx = [0 0 1]; nx = length(cx); +%! cy = [0 0 0 1]; ny = length(cy); +%! cz = [0 1]; nz = length(cz); +%! coefs(1,:,:,:) = repmat(reshape(cx,nx,1,1),[1 ny nz]); +%! coefs(2,:,:,:) = repmat(reshape(cy,1,ny,1),[nx 1 nz]); +%! coefs(3,:,:,:) = repmat(reshape(cz,1,1,nz),[nx ny 1]); +%! coefs(4,:,:,:) = 1; +%! coefs = coefs([2 1 3 4],:,:,:); +%! nurbs = nrbmak(coefs, knots); +%! x = rand(5,1); y = rand(5,1); z = rand(5,1); +%! tt = [x y z]'; +%! points = nrbeval(nurbs,tt); +%! [y.^3 x.^2 z]'; +%! assert(points,[y.^3 x.^2 z]',1e-10); diff --git a/octave_packages/nurbs-1.3.6/nrbexport.m b/octave_packages/nurbs-1.3.6/nrbexport.m new file mode 100644 index 0000000..b53057c --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbexport.m @@ -0,0 +1,80 @@ +function nrbexport (nurbs, filename) + +% +% NRBEXPORT: export NURBS geometries to a format compatible with the one used in GeoPDEs (version 0.6). +% +% Calling Sequence: +% +% nrbexport (nurbs, filename); +% +% INPUT: +% +% nurbs : NURBS curve, surface or volume, see nrbmak. +% filename : name of the output file. +% +% +% Description: +% +% The data of the nurbs structure is written in the file, in a format +% that can be read by GeoPDEs. +% +% Copyright (C) 2011 Rafael Vazquez +% +% 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 . + +fid = fopen (filename, 'w'); +if (fid < 0) + error ('nrbexport: cannot open file %s', filename); +end + +ndim = numel (nurbs(1).order); +npatch = numel (nurbs); +fprintf (fid, '%s\n', '# nurbs mesh v.0.7'); +fprintf (fid, '%s\n', '#'); +fprintf (fid, '%s\n', ['# ' date]); +fprintf (fid, '%s\n', '#'); + +fprintf (fid, '%2i', ndim, 1); +fprintf (fid, '\n'); +for iptc = 1:npatch + fprintf (fid, '%s %i', 'PATCH', iptc); + fprintf (fid, '\n'); + fprintf (fid, '%2i', nurbs(iptc).order-1); + fprintf (fid, '\n'); + fprintf (fid, '%2i', nurbs(iptc).number); + fprintf (fid, '\n'); + for ii = 1:ndim + fprintf (fid, '%1.7f ', nurbs(iptc).knots{ii}); + fprintf (fid, '\n'); + end + + if (ndim == 2) + for ii = 1:ndim + fprintf (fid, '%1.15f ', nurbs(iptc).coefs(ii,:,:)); + fprintf (fid, '\n'); + end + fprintf (fid, '%1.15f ', nurbs(iptc).coefs(4,:,:)); + fprintf (fid, '\n'); + elseif (ndim == 3) + for ii = 1:ndim + fprintf (fid, '%1.15f ', nurbs(iptc).coefs(ii,:,:,:)); + fprintf (fid, '\n'); + end + fprintf (fid, '%1.15f ', nurbs(iptc).coefs(4,:,:,:)); + fprintf (fid, '\n'); + end +end + +fclose (fid); +end diff --git a/octave_packages/nurbs-1.3.6/nrbextract.m b/octave_packages/nurbs-1.3.6/nrbextract.m new file mode 100644 index 0000000..69e01c1 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbextract.m @@ -0,0 +1,87 @@ +function crvs = nrbextract(srf) + +% +% NRBEXTRACT: construct NURBS curves by extracting the boundaries of a NURBS surface, or NURBS surfaces by extracting the boundary of a NURBS volume. +% +% Calling Sequence: +% +% crvs = nrbextract(surf); +% +% INPUT: +% +% surf : NURBS surface or volume, see nrbmak. +% +% OUTPUT: +% +% crvs : array of NURBS curves or NURBS surfaces extracted. +% +% Description: +% +% Constructs either an array of four NURBS curves, by extracting the boundaries +% of a NURBS surface, or an array of six surfaces, by extracting the boundaries +% of a NURBS volume. The new entities are ordered in the following way +% +% 1: U = 0 +% 2: U = 1 +% 3: V = 0 +% 4: V = 1 +% 5: W = 0 (only for volumes) +% 6: W = 1 (only for volumes) +% +% Copyright (C) 2010 Rafael Vazquez +% +% 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 . + +if (~iscell (srf.knots)) + error('The boundary information is only extracted for NURBS surfaces or volumes'); +end + +if (numel (srf.knots) == 2) + for ind = 1:2 + ind2 = mod (ind, 2) + 1; %ind2 = [2 1]; + bnd1 = (ind - 1) * 2 + 1; + bnd2 = (ind - 1) * 2 + 2; + if (ind == 1) + coefs1 = squeeze (srf.coefs(:,1,:)); + coefs2 = squeeze (srf.coefs(:,end,:)); + elseif (ind == 2) + coefs1 = squeeze (srf.coefs(:,:,1)); + coefs2 = squeeze (srf.coefs(:,:,end)); + end + crvs(bnd1) = nrbmak (coefs1, srf.knots{ind2}); + crvs(bnd2) = nrbmak (coefs2, srf.knots{ind2}); + end +elseif (numel (srf.knots) == 3) + for ind = 1:3 + inds = setdiff (1:3, ind); + bnd1 = (ind - 1) * 2 + 1; + bnd2 = (ind - 1) * 2 + 2; + if (ind == 1) + coefs1 = squeeze (srf.coefs(:,1,:,:)); + coefs2 = squeeze (srf.coefs(:,end,:,:)); + elseif (ind == 2) + coefs1 = squeeze (srf.coefs(:,:,1,:)); + coefs2 = squeeze (srf.coefs(:,:,end,:)); + elseif (ind == 3) + coefs1 = squeeze (srf.coefs(:,:,:,1)); + coefs2 = squeeze (srf.coefs(:,:,:,end)); + end + crvs(bnd1) = nrbmak (coefs1, {srf.knots{inds(1)} srf.knots{inds(2)}}); + crvs(bnd2) = nrbmak (coefs2, {srf.knots{inds(1)} srf.knots{inds(2)}}); + end +else + error ('The entity is not a surface nor a volume') +end + +end diff --git a/octave_packages/nurbs-1.3.6/nrbextrude.m b/octave_packages/nurbs-1.3.6/nrbextrude.m new file mode 100644 index 0000000..63d9e58 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbextrude.m @@ -0,0 +1,92 @@ +function srf = nrbextrude(curve,vector) + +% +% NRBEXTRUDE: Construct a NURBS surface by extruding a NURBS curve, or +% construct a NURBS volume by extruding a NURBS surface. +% +% Calling Sequence: +% +% srf = nrbextrude(crv,vec); +% +% INPUT: +% +% crv : NURBS curve or surface to extrude, see nrbmak. +% +% vec : Vector along which the entity is extruded. +% +% OUTPUT: +% +% srf : NURBS surface or volume constructed. +% +% Description: +% +% Constructs either a NURBS surface by extruding a NURBS curve along a +% defined vector, or a NURBS volume by extruding a NURBS surface. In the +% first case, the NURBS curve forms the U direction of the surface edge, and +% is extruded along the vector in the V direction. In the second case, the +% original surface forms the U and V direction of the volume, and is extruded +% along the W direction. +% +% Examples: +% +% Form a hollow cylinder by extruding a circle along the z-axis. +% +% srf = nrbextrude(nrbcirc, [0,0,1]); +% +% Copyright (C) 2000 Mark Spink +% Copyright (C) 2010 Rafael Vazquez +% +% 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 . + +if (nargin < 2) + error('Error too few input arguments!'); +end + +if (iscell (curve.knots)) + if (numel (curve.knots) == 3) + error('Nurbs volumes cannot be extruded!'); + end + for ii = 1:size(curve.coefs,3) + coefs(:,:,ii) = vectrans(vector) * squeeze (curve.coefs(:,:,ii)); + end + coefs = cat(4,curve.coefs,coefs); + srf = nrbmak(coefs,{curve.knots{:}, [0 0 1 1]}); +else + coefs = cat(3,curve.coefs,vectrans(vector)*curve.coefs); + srf = nrbmak(coefs,{curve.knots, [0 0 1 1]}); +end + +end + +%!demo +%! crv = nrbtestcrv; +%! srf = nrbextrude(crv,[0 0 5]); +%! nrbplot(srf,[40 10]); +%! title('Extrusion of a test curve along the z-axis'); +%! hold off +% +%!demo +%! crv1 = nrbcirc (1, [0 0], 0, pi/2); +%! crv2 = nrbcirc (2, [0 0], 0, pi/2); +%! srf = nrbruled (crv1, crv2); +%! vol = nrbextrude (srf, [0 0 1]); +%! nrbplot (vol, [30 10 10]) +%! title ('Extrusion of the quarter of a ring') +% +%!demo +%! srf = nrbtestsrf; +%! vol = nrbextrude(srf, [0 0 10]); +%! nrbplot(vol,[20 20 20]); +%! title('Extrusion of a test surface along the z-axis'); +%! hold off diff --git a/octave_packages/nurbs-1.3.6/nrbkntins.m b/octave_packages/nurbs-1.3.6/nrbkntins.m new file mode 100644 index 0000000..d7c2c08 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbkntins.m @@ -0,0 +1,190 @@ +function inurbs = nrbkntins(nurbs,iknots) +% +% NRBKNTINS: Insert a single or multiple knots into a NURBS curve, +% surface or volume. +% +% Calling Sequence: +% +% icrv = nrbkntins(crv,iuknots); +% isrf = nrbkntins(srf,{iuknots ivknots}); +% ivol = nrbkntins(vol,{iuknots ivknots iwknots}); +% +% INPUT: +% +% crv : NURBS curve, see nrbmak. +% +% srf : NURBS surface, see nrbmak. +% +% srf : NURBS volume, see nrbmak. +% +% iuknots : Knots to be inserted along U direction. +% +% ivknots : Knots to be inserted along V direction. +% +% iwknots : Knots to be inserted along W direction. +% +% OUTPUT: +% +% icrv : new NURBS structure for a curve with knots inserted. +% +% isrf : new NURBS structure for a surface with knots inserted. +% +% ivol : new NURBS structure for a volume with knots inserted. +% +% Description: +% +% Inserts knots into the NURBS data structure, these can be knots at +% new positions or at the location of existing knots to increase the +% multiplicity. Note that the knot multiplicity cannot be increased +% beyond the order of the spline. Knots along the V direction can only +% inserted into NURBS surfaces, not curve that are always defined along +% the U direction. This function use the B-Spline function bspkntins, +% which interfaces to an internal 'C' routine. +% +% Examples: +% +% Insert two knots into a curve, one at 0.3 and another +% twice at 0.4 +% +% icrv = nrbkntins(crv, [0.3 0.4 0.4]) +% +% Insert into a surface two knots as (1) into the U knot +% sequence and one knot into the V knot sequence at 0.5. +% +% isrf = nrbkntins(srf, {[0.3 0.4 0.4] [0.5]}) +% +% See also: +% +% bspkntins +% +% Note: +% +% No knot multiplicity will be increased beyond the order of the spline. +% +% Copyright (C) 2000 Mark Spink, 2010 Rafael Vazquez +% +% 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 . + +if nargin < 2 + error('Input argument must include the NURBS and knots to be inserted'); +end + +if ~isstruct(nurbs) + error('NURBS representation is not structure!'); +end + +if ~strcmp(nurbs.form,'B-NURBS') + error('Not a recognised NURBS representation'); +end + +degree = nurbs.order-1; + +if iscell(nurbs.knots) + if size(nurbs.knots,2)==3 + % NURBS represents a volume + num1 = nurbs.number(1); + num2 = nurbs.number(2); + num3 = nurbs.number(3); + + % Insert knots along the w direction + if isempty(iknots{3}) + coefs = nurbs.coefs; + knots{3} = nurbs.knots{3}; + else + coefs = reshape(nurbs.coefs,4*num1*num2,num3); + [coefs,knots{3}] = bspkntins(degree(3),coefs,nurbs.knots{3},iknots{3}); + num3 = size(coefs,2); + coefs = reshape(coefs,[4 num1 num2 num3]); + end + + % Insert knots along the v direction + if isempty(iknots{2}) + knots{2} = nurbs.knots{2}; + else + coefs = permute(coefs,[1 2 4 3]); + coefs = reshape(coefs,4*num1*num3,num2); + [coefs,knots{2}] = bspkntins(degree(2),coefs,nurbs.knots{2},iknots{2}); + num2 = size(coefs,2); + coefs = reshape(coefs,[4 num1 num3 num2]); + coefs = permute(coefs,[1 2 4 3]); + end + + % Insert knots along the u direction + if isempty(iknots{1}) + knots{1} = nurbs.knots{1}; + else + coefs = permute(coefs,[1 3 4 2]); + coefs = reshape(coefs,4*num2*num3,num1); + [coefs,knots{1}] = bspkntins(degree(1),coefs,nurbs.knots{1},iknots{1}); + coefs = reshape(coefs,[4 num2 num3 size(coefs,2)]); + coefs = permute(coefs,[1 4 2 3]); + end + + elseif size(nurbs.knots,2)==2 + % NURBS represents a surface + num1 = nurbs.number(1); + num2 = nurbs.number(2); + + % Insert knots along the v direction + if isempty(iknots{2}) + coefs = nurbs.coefs; + knots{2} = nurbs.knots{2}; + else + coefs = reshape(nurbs.coefs,4*num1,num2); + [coefs,knots{2}] = bspkntins(degree(2),coefs,nurbs.knots{2},iknots{2}); + num2 = size(coefs,2); + coefs = reshape(coefs,[4 num1 num2]); + end + + % Insert knots along the u direction + if isempty(iknots{1}) + knots{1} = nurbs.knots{1}; + else + coefs = permute(coefs,[1 3 2]); + coefs = reshape(coefs,4*num2,num1); + [coefs,knots{1}] = bspkntins(degree(1),coefs,nurbs.knots{1},iknots{1}); + coefs = reshape(coefs,[4 num2 size(coefs,2)]); + coefs = permute(coefs,[1 3 2]); + end + end +else + + % NURBS represents a curve + if isempty(iknots) + coefs = nurbs.coefs; + knots = nurbs.knots; + else + [coefs,knots] = bspkntins(degree,nurbs.coefs,nurbs.knots,iknots); + end + +end + +% construct new NURBS +inurbs = nrbmak(coefs,knots); + +end + +%!demo +%! crv = nrbtestcrv; +%! plot(crv.coefs(1,:),crv.coefs(2,:),'bo') +%! title('Knot insertion along test curve: curve and control polygons.'); +%! hold on; +%! plot(crv.coefs(1,:),crv.coefs(2,:),'b--'); +%! +%! nrbplot(crv,48); +%! +%! icrv = nrbkntins(crv,[0.125 0.375 0.625 0.875] ); +%! plot(icrv.coefs(1,:),icrv.coefs(2,:),'ro') +%! plot(icrv.coefs(1,:),icrv.coefs(2,:),'r--'); +%! hold off \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/nrbkntplot.m b/octave_packages/nurbs-1.3.6/nrbkntplot.m new file mode 100644 index 0000000..758021f --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbkntplot.m @@ -0,0 +1,238 @@ +function nrbkntplot (nurbs) + +% NRBKNTPLOT: Plot a NURBS entity with the knots subdivision. +% +% Calling Sequence: +% +% nrbkntplot(nurbs) +% +% INPUT: +% +% nurbs: NURBS curve, surface or volume, see nrbmak. +% +% Example: +% +% Plot the test surface with its knot vector +% +% nrbkntplot(nrbtestsrf) +% +% See also: +% +% nrbctrlplot +% +% Copyright (C) 2011 Rafael Vazquez +% +% 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 . + +if (nargin < 1) + error ('nrbkntplot: Need a NURBS to plot!'); +end + +% Default values +light='on'; +cmap='summer'; + +colormap (cmap); + +hold_flag = ishold; + +if (iscell (nurbs.knots)) + if (size (nurbs.knots,2) == 2) % plot a NURBS surface + nsub = 100; + nrbplot (nurbs, [nsub nsub], 'light', light, 'colormap', cmap); + hold on + + % And plot the knots + knt1 = unique (nurbs.knots{1}); + knt2 = unique (nurbs.knots{2}); + p1 = nrbeval (nurbs, {knt1, linspace(0.0,1.0,nsub)}); + p2 = nrbeval (nurbs, {linspace(0.0,1.0,nsub), knt2}); + + if (any (nurbs.coefs(3,:))) + % surface in a 3D space + for ii = 1:numel(knt1) + plot3 (squeeze(p1(1,ii,:)), squeeze(p1(2,ii,:)), squeeze(p1(3,ii,:))); + end + for ii = 1:numel(knt2) + plot3 (squeeze(p2(1,:,ii)), squeeze(p2(2,:,ii)), squeeze(p2(3,:,ii))); + end + else + % plain surface + for ii = 1:numel(knt1) + plot (squeeze(p1(1,ii,:)), squeeze (p1(2,ii,:))); + end + for ii = 1:numel(knt2) + plot (p2(1,:,ii),p2(2,:,ii)); + end + end + + + + elseif (size (nurbs.knots,2) == 3) % plot a NURBS volume + nsub = 30; + nrbplot (nurbs, [nsub nsub nsub], 'light', light, 'colormap', cmap); + hold on + + % And plot the knots + knt1 = unique (nurbs.knots{1}); + knt2 = unique (nurbs.knots{2}); + knt3 = unique (nurbs.knots{3}); + kv_face1 = nrbeval (nurbs, {0, knt2, linspace(0.0,1.0,nsub)}); + kw_face1 = nrbeval (nurbs, {0, linspace(0.0,1.0,nsub), knt3}); + kv_face2 = nrbeval (nurbs, {1, knt2, linspace(0.0,1.0,nsub)}); + kw_face2 = nrbeval (nurbs, {1, linspace(0.0,1.0,nsub), knt3}); + ku_face3 = nrbeval (nurbs, {knt1, 0, linspace(0.0,1.0,nsub)}); + kw_face3 = nrbeval (nurbs, {linspace(0.0,1.0,nsub), 0, knt3}); + ku_face4 = nrbeval (nurbs, {knt1, 1, linspace(0.0,1.0,nsub)}); + kw_face4 = nrbeval (nurbs, {linspace(0.0,1.0,nsub), 1, knt3}); + ku_face5 = nrbeval (nurbs, {knt1, linspace(0.0,1.0,nsub), 0}); + kv_face5 = nrbeval (nurbs, {linspace(0.0,1.0,nsub), knt2, 0}); + ku_face6 = nrbeval (nurbs, {knt1, linspace(0.0,1.0,nsub), 1}); + kv_face6 = nrbeval (nurbs, {linspace(0.0,1.0,nsub), knt2, 1}); + + for ii = 1:numel(knt1) + plot3 (squeeze (ku_face3(1,ii,:,:)), squeeze (ku_face3(2,ii,:,:)), squeeze (ku_face3(3,ii,:,:))); + plot3 (squeeze (ku_face4(1,ii,:,:)), squeeze (ku_face4(2,ii,:,:)), squeeze (ku_face4(3,ii,:,:))); + plot3 (squeeze (ku_face5(1,ii,:,:)), squeeze (ku_face5(2,ii,:,:)), squeeze (ku_face5(3,ii,:,:))); + plot3 (squeeze (ku_face6(1,ii,:,:)), squeeze (ku_face6(2,ii,:,:)), squeeze (ku_face6(3,ii,:,:))); + end + for ii = 1:numel(knt2) + plot3 (squeeze (kv_face1(1,:,ii,:)), squeeze (kv_face1(2,:,ii,:)), squeeze (kv_face1(3,:,ii,:))); + plot3 (squeeze (kv_face2(1,:,ii,:)), squeeze (kv_face2(2,:,ii,:)), squeeze (kv_face2(3,:,ii,:))); + plot3 (squeeze (kv_face5(1,:,ii,:)), squeeze (kv_face5(2,:,ii,:)), squeeze (kv_face5(3,:,ii,:))); + plot3 (squeeze (kv_face6(1,:,ii,:)), squeeze (kv_face6(2,:,ii,:)), squeeze (kv_face6(3,:,ii,:))); + end + for ii = 1:numel(knt3) + plot3 (squeeze (kw_face1(1,:,:,ii)), squeeze(kw_face1(2,:,:,ii)), squeeze (kw_face1(3,:,:,ii))); + plot3 (squeeze (kw_face2(1,:,:,ii)), squeeze(kw_face2(2,:,:,ii)), squeeze (kw_face2(3,:,:,ii))); + plot3 (squeeze (kw_face3(1,:,:,ii)), squeeze(kw_face3(2,:,:,ii)), squeeze (kw_face3(3,:,:,ii))); + plot3 (squeeze (kw_face4(1,:,:,ii)), squeeze(kw_face4(2,:,:,ii)), squeeze (kw_face4(3,:,:,ii))); + end + end + +else % plot a NURBS curve + nsub = 1000; + nrbplot (nurbs, nsub); + hold on + + % And plot the knots + p = nrbeval (nurbs, unique (nurbs.knots)); + + if (any (nurbs.coefs(3,:))) % plot a 3D curve + plot3 (p(1,:), p(2,:), p(3,:), 'x'); + else % plot a 2D curve + plot (p(1,:), p(2,:), 'x'); + end + +end + +if (~hold_flag) + hold off +end + +end +%!demo +%! crv = nrbtestcrv; +%! nrbkntplot(crv) +%! title('Test curve') +%! hold off + +%!demo +%! sphere = nrbrevolve(nrbcirc(1,[],0.0,pi),[0.0 0.0 0.0],[1.0 0.0 0.0]); +%! nrbkntplot(sphere); +%! title('Ball and torus - surface construction by revolution'); +%! hold on; +%! torus = nrbrevolve(nrbcirc(0.2,[0.9 1.0]),[0.0 0.0 0.0],[1.0 0.0 0.0]); +%! nrbkntplot(torus); +%! hold off + +%!demo +%! knots = {[0 0 0 1/2 1 1 1] [0 0 0 1 1 1]... +%! [0 0 0 1/6 2/6 1/2 1/2 4/6 5/6 1 1 1]}; +%! +%! coefs = [-1.0000 -0.9734 -0.7071 1.4290 1.0000 3.4172 +%! 0 2.4172 0 0.0148 -2.0000 -1.9734 +%! 0 2.0000 4.9623 9.4508 4.0000 2.0000 +%! 1.0000 1.0000 0.7071 1.0000 1.0000 1.0000 +%! -0.8536 0 -0.6036 1.9571 1.2071 3.5000 +%! 0.3536 2.5000 0.2500 0.5429 -1.7071 -1.0000 +%! 0 2.0000 4.4900 8.5444 3.4142 2.0000 +%! 0.8536 1.0000 0.6036 1.0000 0.8536 1.0000 +%! -0.3536 -4.0000 -0.2500 -1.2929 1.7071 1.0000 +%! 0.8536 0 0.6036 -2.7071 -1.2071 -5.0000 +%! 0 2.0000 4.4900 10.0711 3.4142 2.0000 +%! 0.8536 1.0000 0.6036 1.0000 0.8536 1.0000 +%! 0 -4.0000 0 0.7071 2.0000 5.0000 +%! 1.0000 4.0000 0.7071 -0.7071 -1.0000 -5.0000 +%! 0 2.0000 4.9623 14.4142 4.0000 2.0000 +%! 1.0000 1.0000 0.7071 1.0000 1.0000 1.0000 +%! -2.5000 -4.0000 -1.7678 0.7071 1.0000 5.0000 +%! 0 4.0000 0 -0.7071 -3.5000 -5.0000 +%! 0 2.0000 6.0418 14.4142 4.0000 2.0000 +%! 1.0000 1.0000 0.7071 1.0000 1.0000 1.0000 +%! -2.4379 0 -1.7238 2.7071 1.9527 5.0000 +%! 0.9527 4.0000 0.6737 1.2929 -3.4379 -1.0000 +%! 0 2.0000 6.6827 10.0711 4.0000 2.0000 +%! 1.0000 1.0000 0.7071 1.0000 1.0000 1.0000 +%! -0.9734 -1.0000 -0.6883 0.7071 3.4172 1.0000 +%! 2.4172 0 1.7092 -1.4142 -1.9734 -2.0000 +%! 0 4.0000 6.6827 4.9623 4.0000 0 +%! 1.0000 1.0000 0.7071 0.7071 1.0000 1.0000 +%! 0 -0.8536 0 0.8536 3.5000 1.2071 +%! 2.5000 0.3536 1.7678 -1.2071 -1.0000 -1.7071 +%! 0 3.4142 6.0418 4.4900 4.0000 0 +%! 1.0000 0.8536 0.7071 0.6036 1.0000 0.8536 +%! -4.0000 -0.3536 -2.8284 1.2071 1.0000 1.7071 +%! 0 0.8536 0 -0.8536 -5.0000 -1.2071 +%! 0 3.4142 7.1213 4.4900 4.0000 0 +%! 1.0000 0.8536 0.7071 0.6036 1.0000 0.8536 +%! -4.0000 0 -2.8284 1.4142 5.0000 2.0000 +%! 4.0000 1.0000 2.8284 -0.7071 -5.0000 -1.0000 +%! 0 4.0000 10.1924 4.9623 4.0000 0 +%! 1.0000 1.0000 0.7071 0.7071 1.0000 1.0000 +%! -4.0000 -2.5000 -2.8284 0.7071 5.0000 1.0000 +%! 4.0000 0 2.8284 -2.4749 -5.0000 -3.5000 +%! 0 4.0000 10.1924 6.0418 4.0000 0 +%! 1.0000 1.0000 0.7071 0.7071 1.0000 1.0000 +%! 0 -2.4379 0 1.3808 5.0000 1.9527 +%! 4.0000 0.9527 2.8284 -2.4309 -1.0000 -3.4379 +%! 0 4.0000 7.1213 6.6827 4.0000 0 +%! 1.0000 1.0000 0.7071 0.7071 1.0000 1.0000 +%! -1.0000 -0.9734 0.2071 2.4163 1.0000 3.4172 +%! 0 2.4172 -1.2071 -1.3954 -2.0000 -1.9734 +%! 2.0000 4.0000 7.0178 6.6827 2.0000 0 +%! 1.0000 1.0000 1.0000 0.7071 1.0000 1.0000 +%! -0.8536 0 0.3536 2.4749 1.2071 3.5000 +%! 0.3536 2.5000 -0.8536 -0.7071 -1.7071 -1.0000 +%! 1.7071 4.0000 6.3498 6.0418 1.7071 0 +%! 0.8536 1.0000 0.8536 0.7071 0.8536 1.0000 +%! -0.3536 -4.0000 0.8536 0.7071 1.7071 1.0000 +%! 0.8536 0 -0.3536 -3.5355 -1.2071 -5.0000 +%! 1.7071 4.0000 6.3498 7.1213 1.7071 0 +%! 0.8536 1.0000 0.8536 0.7071 0.8536 1.0000 +%! 0 -4.0000 1.2071 3.5355 2.0000 5.0000 +%! 1.0000 4.0000 -0.2071 -3.5355 -1.0000 -5.0000 +%! 2.0000 4.0000 7.0178 10.1924 2.0000 0 +%! 1.0000 1.0000 1.0000 0.7071 1.0000 1.0000 +%! -2.5000 -4.0000 -0.5429 3.5355 1.0000 5.0000 +%! 0 4.0000 -1.9571 -3.5355 -3.5000 -5.0000 +%! 2.0000 4.0000 8.5444 10.1924 2.0000 0 +%! 1.0000 1.0000 1.0000 0.7071 1.0000 1.0000 +%! -2.4379 0 -0.0355 3.5355 1.9527 5.0000 +%! 0.9527 4.0000 -1.4497 -0.7071 -3.4379 -1.0000 +%! 2.0000 4.0000 9.4508 7.1213 2.0000 0 +%! 1.0000 1.0000 1.0000 0.7071 1.0000 1.0000]; +%! coefs = reshape (coefs, 4, 4, 3, 9); +%! horseshoe = nrbmak (coefs, knots); +%! nrbkntplot (horseshoe); diff --git a/octave_packages/nurbs-1.3.6/nrbline.m b/octave_packages/nurbs-1.3.6/nrbline.m new file mode 100644 index 0000000..53cf218 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbline.m @@ -0,0 +1,59 @@ +function curve = nrbline(p1,p2) +% +% NRBLINE: Construct a straight line. +% +% Calling Sequence: +% +% crv = nrbline() +% crv = nrbline(p1,p2) +% +% INPUT: +% +% p1 : 2D or 3D cartesian coordinate of the start point. +% +% p2 : 2D or 3D cartesian coordinate of the end point. +% +% OUTPUT: +% +% crv : NURBS curve for a straight line. +% +% Description: +% +% Constructs NURBS data structure for a straight line. If no rhs +% coordinates are included the function returns a unit straight +% line along the x-axis. +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +coefs = [zeros(3,2); ones(1,2)]; + +if nargin < 2 + coefs(1,2) = 1.0; +else + coefs(1:length(p1),1) = p1(:); + coefs(1:length(p2),2) = p2(:); +end + +curve = nrbmak(coefs, [0 0 1 1]); + +end + +%!demo +%! crv = nrbline([0.0 0.0 0.0]',[5.0 4.0 2.0]'); +%! nrbplot(crv,1); +%! grid on; +%! title('3D straight line.'); +%! hold off diff --git a/octave_packages/nurbs-1.3.6/nrbmak.m b/octave_packages/nurbs-1.3.6/nrbmak.m new file mode 100644 index 0000000..dd10ce0 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbmak.m @@ -0,0 +1,245 @@ +function nurbs = nrbmak(coefs,knots) +% +% NRBMAK: Construct the NURBS structure given the control points +% and the knots. +% +% Calling Sequence: +% +% nurbs = nrbmak(cntrl,knots); +% +% INPUT: +% +% cntrl : Control points, these can be either Cartesian or +% homogeneous coordinates. +% +% For a curve the control points are represented by a +% matrix of size (dim,nu), for a surface a multidimensional +% array of size (dim,nu,nv), for a volume a multidimensional array +% of size (dim,nu,nv,nw). Where nu is number of points along +% the parametric U direction, nv the number of points along +% the V direction and nw the number of points along the W direction. +% dim is the dimension. Valid options +% are +% 2 .... (x,y) 2D Cartesian coordinates +% 3 .... (x,y,z) 3D Cartesian coordinates +% 4 .... (wx,wy,wz,w) 4D homogeneous coordinates +% +% knots : Non-decreasing knot sequence spanning the interval +% [0.0,1.0]. It's assumed that the geometric entities +% are clamped to the start and end control points by knot +% multiplicities equal to the spline order (open knot vector). +% For curve knots form a vector and for surfaces (volumes) +% the knots are stored by two (three) vectors for U and V (and W) +% in a cell structure {uknots vknots} ({uknots vknots wknots}). +% +% OUTPUT: +% +% nurbs : Data structure for representing a NURBS entity +% +% NURBS Structure: +% +% Both curves and surfaces are represented by a structure that is +% compatible with the Spline Toolbox from Mathworks +% +% nurbs.form .... Type name 'B-NURBS' +% nurbs.dim .... Dimension of the control points +% nurbs.number .... Number of Control points +% nurbs.coefs .... Control Points +% nurbs.order .... Order of the spline +% nurbs.knots .... Knot sequence +% +% Note: the control points are always converted and stored within the +% NURBS structure as 4D homogeneous coordinates. A curve is always stored +% along the U direction, and the vknots element is an empty matrix. For +% a surface the spline order is a vector [du,dv] containing the order +% along the U and V directions respectively. For a volume the order is +% a vector [du dv dw]. Recall that order = degree + 1. +% +% Description: +% +% This function is used as a convenient means of constructing the NURBS +% data structure. Many of the other functions in the toolbox rely on the +% NURBS structure been correctly defined as shown above. The nrbmak not +% only constructs the proper structure, but also checks for consistency. +% The user is still free to build his own structure, in fact a few +% functions in the toolbox do this for convenience. +% +% Examples: +% +% Construct a 2D line from (0.0,0.0) to (1.5,3.0). +% For a straight line a spline of order 2 is required. +% Note that the knot sequence has a multiplicity of 2 at the +% start (0.0,0.0) and end (1.0 1.0) in order to clamp the ends. +% +% line = nrbmak([0.0 1.5; 0.0 3.0],[0.0 0.0 1.0 1.0]); +% nrbplot(line, 2); +% +% Construct a surface in the x-y plane i.e +% +% ^ (0.0,1.0) ------------ (1.0,1.0) +% | | | +% | V | | +% | | Surface | +% | | | +% | | | +% | (0.0,0.0) ------------ (1.0,0.0) +% | +% |------------------------------------> +% U +% +% coefs = cat(3,[0 0; 0 1],[1 1; 0 1]); +% knots = {[0 0 1 1] [0 0 1 1]} +% plane = nrbmak(coefs,knots); +% nrbplot(plane, [2 2]); +% +% Copyright (C) 2000 Mark Spink, 2010 Rafael Vazquez +% +% 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 . + +nurbs.form = 'B-NURBS'; +nurbs.dim = 4; +np = size(coefs); +dim = np(1); +if iscell(knots) + if size(knots,2) == 3 + if (numel(np) == 3) + np(4) = 1; + elseif (numel(np)==2) + np(3:4) = 1; + end + % constructing a volume + nurbs.number = np(2:4); + if (dim < 4) + nurbs.coefs = repmat([0.0 0.0 0.0 1.0]',[1 np(2:4)]); + nurbs.coefs(1:dim,:,:) = coefs; + else + nurbs.coefs = coefs; + end + uorder = size(knots{1},2)-np(2); + vorder = size(knots{2},2)-np(3); + worder = size(knots{3},2)-np(4); + uknots = sort(knots{1}); + vknots = sort(knots{2}); + wknots = sort(knots{3}); + uknots = (uknots-uknots(1))/(uknots(end)-uknots(1)); + vknots = (vknots-vknots(1))/(vknots(end)-vknots(1)); + wknots = (wknots-wknots(1))/(wknots(end)-wknots(1)); + nurbs.knots = {uknots vknots wknots}; + nurbs.order = [uorder vorder worder]; + + elseif size(knots,2) == 2 + if (numel(np)==2); np(3) = 1; end + % constructing a surface + nurbs.number = np(2:3); + if (dim < 4) + nurbs.coefs = repmat([0.0 0.0 0.0 1.0]',[1 np(2:3)]); + nurbs.coefs(1:dim,:,:) = coefs; + else + nurbs.coefs = coefs; + end + uorder = size(knots{1},2)-np(2); + vorder = size(knots{2},2)-np(3); + uknots = sort(knots{1}); + vknots = sort(knots{2}); + uknots = (uknots-uknots(1))/(uknots(end)-uknots(1)); + vknots = (vknots-vknots(1))/(vknots(end)-vknots(1)); + nurbs.knots = {uknots vknots}; + nurbs.order = [uorder vorder]; + + end + +else + + % constructing a curve + nurbs.number = np(2); + if (dim < 4) + nurbs.coefs = repmat([0.0 0.0 0.0 1.0]',[1 np(2)]); + nurbs.coefs(1:dim,:) = coefs; + else + nurbs.coefs = coefs; + end + nurbs.order = size(knots,2)-np(2); + knots = sort(knots); + nurbs.knots = (knots-knots(1))/(knots(end)-knots(1)); + +end + +end + +%!demo +%! pnts = [0.5 1.5 4.5 3.0 7.5 6.0 8.5; +%! 3.0 5.5 5.5 1.5 1.5 4.0 4.5; +%! 0.0 0.0 0.0 0.0 0.0 0.0 0.0]; +%! crv = nrbmak(pnts,[0 0 0 1/4 1/2 3/4 3/4 1 1 1]); +%! nrbplot(crv,100) +%! title('Test curve') +%! hold off + +%!demo +%! pnts = [0.5 1.5 4.5 3.0 7.5 6.0 8.5; +%! 3.0 5.5 5.5 1.5 1.5 4.0 4.5; +%! 0.0 0.0 0.0 0.0 0.0 0.0 0.0]; +%! crv = nrbmak(pnts,[0 0 0 0.1 1/2 3/4 3/4 1 1 1]); +%! nrbplot(crv,100) +%! title('Test curve with a slight variation of the knot vector') +%! hold off + +%!demo +%! pnts = zeros(3,5,5); +%! pnts(:,:,1) = [ 0.0 3.0 5.0 8.0 10.0; +%! 0.0 0.0 0.0 0.0 0.0; +%! 2.0 2.0 7.0 7.0 8.0]; +%! pnts(:,:,2) = [ 0.0 3.0 5.0 8.0 10.0; +%! 3.0 3.0 3.0 3.0 3.0; +%! 0.0 0.0 5.0 5.0 7.0]; +%! pnts(:,:,3) = [ 0.0 3.0 5.0 8.0 10.0; +%! 5.0 5.0 5.0 5.0 5.0; +%! 0.0 0.0 5.0 5.0 7.0]; +%! pnts(:,:,4) = [ 0.0 3.0 5.0 8.0 10.0; +%! 8.0 8.0 8.0 8.0 8.0; +%! 5.0 5.0 8.0 8.0 10.0]; +%! pnts(:,:,5) = [ 0.0 3.0 5.0 8.0 10.0; +%! 10.0 10.0 10.0 10.0 10.0; +%! 5.0 5.0 8.0 8.0 10.0]; +%! +%! knots{1} = [0 0 0 1/3 2/3 1 1 1]; +%! knots{2} = [0 0 0 1/3 2/3 1 1 1]; +%! +%! srf = nrbmak(pnts,knots); +%! nrbplot(srf,[20 20]) +%! title('Test surface') +%! hold off + +%!demo +%! coefs =[ 6.0 0.0 6.0 1; +%! -5.5 0.5 5.5 1; +%! -5.0 1.0 -5.0 1; +%! 4.5 1.5 -4.5 1; +%! 4.0 2.0 4.0 1; +%! -3.5 2.5 3.5 1; +%! -3.0 3.0 -3.0 1; +%! 2.5 3.5 -2.5 1; +%! 2.0 4.0 2.0 1; +%! -1.5 4.5 1.5 1; +%! -1.0 5.0 -1.0 1; +%! 0.5 5.5 -0.5 1; +%! 0.0 6.0 0.0 1]'; +%! knots = [0 0 0 0 .1 .2 .3 .4 .5 .6 .7 .8 .9 1 1 1 1]; +%! +%! crv = nrbmak(coefs,knots); +%! nrbplot(crv,100); +%! grid on; +%! title('3D helical curve.'); +%! hold off + diff --git a/octave_packages/nurbs-1.3.6/nrbnumbasisfun.m b/octave_packages/nurbs-1.3.6/nrbnumbasisfun.m new file mode 100644 index 0000000..22e692a --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbnumbasisfun.m @@ -0,0 +1,87 @@ +function idx = nrbnumbasisfun (points, nrb) +% +% NRBNUMBASISFUN: Numbering of basis functions for NURBS +% +% Calling Sequence: +% +% N = nrbnumbasisfun (u, crv) +% N = nrbnumbasisfun ({u, v}, srf) +% N = nrbnumbasisfun (p, srf) +% +% INPUT: +% +% u or p(1,:,:) - parametric points along u direction +% v or p(2,:,:) - parametric points along v direction +% crv - NURBS curve +% srf - NURBS surface +% +% OUTPUT: +% +% N - Indices of the basis functions that are nonvanishing at each +% point. size(N) == size(B) +% +% Copyright (C) 2009 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 . + + if ( (nargin<2) ... + || (nargout>1) ... + || (~isstruct(nrb)) ... + || (iscell(points) && ~iscell(nrb.knots)) ... + || (~iscell(points) && iscell(nrb.knots) && (size(points,1)~=2)) ... + ) + error('Incorrect input arguments in nrbnumbasisfun'); + end + + + if (~iscell(nrb.knots)) %% NURBS curve + + iv = findspan (nrb.number-1, nrb.order-1, points, nrb.knots); + idx = numbasisfun (iv, points, nrb.order-1, nrb.knots); + + elseif size(nrb.knots,2) == 2 %% NURBS surface + + if (iscell(points)) + [v, u] = meshgrid(points{2}, points{1}); + p(1,:,:) = u; + p(2,:,:) = v; + p = reshape(p, 2, []); + else + p = points; + end + + idx = nrb_srf_numbasisfun__ (p, nrb); + else + error('The function nrbnumbasisfun is not yet ready for volumes') + end + +end + + +%!test +%! p = 2; q = 3; m = 4; n = 5; +%! Lx = 1; Ly = 1; +%! nrb = nrb4surf ([0 0], [1 0], [0 1], [1 1]); +%! nrb = nrbdegelev (nrb, [p-1, q-1]); +%! ikx = linspace(0,1,m); iky = linspace(0,1,n); +%! nrb = nrbkntins (nrb, {ikx(2:end-1), iky(2:end-1)}); +%! nrb.coefs (4,:,:) = nrb.coefs (4,:,:) + rand (size (nrb.coefs (4,:,:))); +%! u = rand (1, 30); v = rand (1, 10); +%! u = (u-min (u))/max (u-min (u)); +%! v = (v-min (v))/max (v-min (v)); +%! N = nrbnumbasisfun ({u, v}, nrb); +%! assert (all (all (N>0)), true) +%! assert (all (all (N <= prod (nrb.number))), true) +%! assert (max (max (N)), prod (nrb.number)) +%! assert (min (min (N)), 1) \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/nrbplot.m b/octave_packages/nurbs-1.3.6/nrbplot.m new file mode 100644 index 0000000..5103d1c --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbplot.m @@ -0,0 +1,278 @@ +function nrbplot (nurbs, subd, varargin) +% +% NRBPLOT: Plot a NURBS curve or surface, or the boundary of a NURBS volume. +% +% Calling Sequence: +% +% nrbplot (nrb, subd) +% nrbplot (nrb, subd, p, v) +% +% INPUT: +% +% nrb : NURBS curve, surface or volume, see nrbmak. +% +% npnts : Number of evaluation points, for a surface or volume, a row +% vector with the number of points along each direction. +% +% [p,v] : property/value options +% +% Valid property/value pairs include: +% +% Property Value/{Default} +% ----------------------------------- +% light {off} | on +% colormap {'copper'} +% +% Example: +% +% Plot the test surface with 20 points along the U direction +% and 30 along the V direction +% +% nrbplot(nrbtestsrf, [20 30]) +% +% Copyright (C) 2000 Mark Spink +% Copyright (C) 2010 Carlo de Falco, Rafael Vazquez +% +% 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 . + +nargs = nargin; +if nargs < 2 + error ('Need a NURBS to plot and the number of subdivisions!'); +elseif rem(nargs+2,2) + error ('Param value pairs expected') +end + +% Default values +light='off'; +cmap='summer'; + +% Recover Param/Value pairs from argument list +for i=1:2:nargs-2 + Param = varargin{i}; + Value = varargin{i+1}; + if (~ischar (Param)) + error ('Parameter must be a string') + elseif size(Param,1)~=1 + error ('Parameter must be a non-empty single row string.') + end + switch lower (Param) + case 'light' + light = lower (Value); + if (~ischar (light)) + error ('light must be a string.') + elseif ~(strcmp(light,'off') | strcmp(light,'on')) + error ('light must be off | on') + end + case 'colormap' + if ischar (Value) + cmap = lower(Value); + elseif size (Value, 2) ~= 3 + error ('colormap must be a string or have exactly three columns.') + else + cmap=Value; + end + otherwise + error ('Unknown parameter: %s', Param) + end +end + +colormap (cmap); + +% convert the number of subdivisions in number of points +subd = subd+1; + +% plot the curve or surface +if (iscell (nurbs.knots)) + if (size (nurbs.knots,2) == 2) % plot a NURBS surface + p = nrbeval (nurbs, {linspace(0.0,1.0,subd(1)) linspace(0.0,1.0,subd(2))}); + if (strcmp (light,'on')) + % light surface + surfl (squeeze(p(1,:,:)), squeeze(p(2,:,:)), squeeze(p(3,:,:))); + shading interp; + else + surf (squeeze (p(1,:,:)), squeeze (p(2,:,:)), squeeze (p(3,:,:))); + shading faceted; + end + elseif (size (nurbs.knots,2) == 3) % plot the boundaries of a NURBS volume + hold_flag = ishold; + px = nrbeval (nurbs, {[0 1] linspace(0.0,1.0,subd(2)) linspace(0.0,1.0,subd(3))}); + py = nrbeval (nurbs, {linspace(0.0,1.0,subd(1)) [0 1] linspace(0.0,1.0,subd(3))}); + pz = nrbeval (nurbs, {linspace(0.0,1.0,subd(1)) linspace(0.0,1.0,subd(2)) [0 1]}); + if (strcmp (light, 'on')) + surfl (squeeze (pz(1,:,:,1)), squeeze (pz(2,:,:,1)), squeeze (pz(3,:,:,1))); + hold on + surfl (squeeze (pz(1,:,:,2)), squeeze (pz(2,:,:,2)), squeeze (pz(3,:,:,2))); + surfl (squeeze (py(1,:,1,:)), squeeze (py(2,:,1,:)), squeeze (py(3,:,1,:))); + surfl (squeeze (py(1,:,2,:)), squeeze (py(2,:,2,:)), squeeze (py(3,:,2,:))); + surfl (squeeze (px(1,1,:,:)), squeeze (px(2,1,:,:)), squeeze (px(3,1,:,:))); + surfl (squeeze (px(1,2,:,:)), squeeze (px(2,2,:,:)), squeeze (px(3,2,:,:))); + shading interp; + else + surf (squeeze (pz(1,:,:,1)), squeeze (pz(2,:,:,1)), squeeze (pz(3,:,:,1))); + hold on + surf (squeeze (pz(1,:,:,2)), squeeze (pz(2,:,:,2)), squeeze (pz(3,:,:,2))); + surf (squeeze (py(1,:,1,:)), squeeze (py(2,:,1,:)), squeeze (py(3,:,1,:))); + surf (squeeze (py(1,:,2,:)), squeeze (py(2,:,2,:)), squeeze (py(3,:,2,:))); + surf (squeeze (px(1,1,:,:)), squeeze (px(2,1,:,:)), squeeze (px(3,1,:,:))); + surf (squeeze (px(1,2,:,:)), squeeze (px(2,2,:,:)), squeeze (px(3,2,:,:))); + shading faceted; + end + + if (~hold_flag) + hold off + end + + else + error ('nrbplot: some argument is not correct') + end +else + % plot a NURBS curve + p = nrbeval (nurbs, linspace (0.0, 1.0, subd)); + + if (any (nurbs.coefs(3,:))) + % 3D curve + plot3 (p(1,:), p(2,:), p(3,:)); + grid on; + else + % 2D curve + plot (p(1,:), p(2,:)); + end +end +axis equal; + +end + +% plot the control surface +% hold on; +% mesh(squeeze(pnts(1,:,:)),squeeze(pnts(2,:,:)),squeeze(pnts(3,:,:))); +% hold off; + +%!demo +%! crv = nrbtestcrv; +%! nrbplot(crv,100) +%! title('Test curve') +%! hold off + +%!demo +%! coefs = [0.0 7.5 15.0 25.0 35.0 30.0 27.5 30.0; +%! 0.0 2.5 0.0 -5.0 5.0 15.0 22.5 30.0]; +%! knots = [0.0 0.0 0.0 1/6 1/3 1/2 2/3 5/6 1.0 1.0 1.0]; +%! +%! geom = [ +%! nrbmak(coefs,knots) +%! nrbline([30.0 30.0],[20.0 30.0]) +%! nrbline([20.0 30.0],[20.0 20.0]) +%! nrbcirc(10.0,[10.0 20.0],1.5*pi,0.0) +%! nrbline([10.0 10.0],[0.0 10.0]) +%! nrbline([0.0 10.0],[0.0 0.0]) +%! nrbcirc(5.0,[22.5 7.5]) +%! ]; +%! +%! ng = length(geom); +%! for i = 1:ng +%! nrbplot(geom(i),500); +%! hold on; +%! end +%! hold off; +%! axis equal; +%! title('2D Geometry formed by a series of NURBS curves'); + +%!demo +%! sphere = nrbrevolve(nrbcirc(1,[],0.0,pi),[0.0 0.0 0.0],[1.0 0.0 0.0]); +%! nrbplot(sphere,[40 40],'light','on'); +%! title('Ball and torus - surface construction by revolution'); +%! hold on; +%! torus = nrbrevolve(nrbcirc(0.2,[0.9 1.0]),[0.0 0.0 0.0],[1.0 0.0 0.0]); +%! nrbplot(torus,[40 40],'light','on'); +%! hold off + +%!demo +%! knots = {[0 0 0 1/2 1 1 1] [0 0 0 1 1 1]... +%! [0 0 0 1/6 2/6 1/2 1/2 4/6 5/6 1 1 1]}; +%! +%! coefs = [-1.0000 -0.9734 -0.7071 1.4290 1.0000 3.4172 +%! 0 2.4172 0 0.0148 -2.0000 -1.9734 +%! 0 2.0000 4.9623 9.4508 4.0000 2.0000 +%! 1.0000 1.0000 0.7071 1.0000 1.0000 1.0000 +%! -0.8536 0 -0.6036 1.9571 1.2071 3.5000 +%! 0.3536 2.5000 0.2500 0.5429 -1.7071 -1.0000 +%! 0 2.0000 4.4900 8.5444 3.4142 2.0000 +%! 0.8536 1.0000 0.6036 1.0000 0.8536 1.0000 +%! -0.3536 -4.0000 -0.2500 -1.2929 1.7071 1.0000 +%! 0.8536 0 0.6036 -2.7071 -1.2071 -5.0000 +%! 0 2.0000 4.4900 10.0711 3.4142 2.0000 +%! 0.8536 1.0000 0.6036 1.0000 0.8536 1.0000 +%! 0 -4.0000 0 0.7071 2.0000 5.0000 +%! 1.0000 4.0000 0.7071 -0.7071 -1.0000 -5.0000 +%! 0 2.0000 4.9623 14.4142 4.0000 2.0000 +%! 1.0000 1.0000 0.7071 1.0000 1.0000 1.0000 +%! -2.5000 -4.0000 -1.7678 0.7071 1.0000 5.0000 +%! 0 4.0000 0 -0.7071 -3.5000 -5.0000 +%! 0 2.0000 6.0418 14.4142 4.0000 2.0000 +%! 1.0000 1.0000 0.7071 1.0000 1.0000 1.0000 +%! -2.4379 0 -1.7238 2.7071 1.9527 5.0000 +%! 0.9527 4.0000 0.6737 1.2929 -3.4379 -1.0000 +%! 0 2.0000 6.6827 10.0711 4.0000 2.0000 +%! 1.0000 1.0000 0.7071 1.0000 1.0000 1.0000 +%! -0.9734 -1.0000 -0.6883 0.7071 3.4172 1.0000 +%! 2.4172 0 1.7092 -1.4142 -1.9734 -2.0000 +%! 0 4.0000 6.6827 4.9623 4.0000 0 +%! 1.0000 1.0000 0.7071 0.7071 1.0000 1.0000 +%! 0 -0.8536 0 0.8536 3.5000 1.2071 +%! 2.5000 0.3536 1.7678 -1.2071 -1.0000 -1.7071 +%! 0 3.4142 6.0418 4.4900 4.0000 0 +%! 1.0000 0.8536 0.7071 0.6036 1.0000 0.8536 +%! -4.0000 -0.3536 -2.8284 1.2071 1.0000 1.7071 +%! 0 0.8536 0 -0.8536 -5.0000 -1.2071 +%! 0 3.4142 7.1213 4.4900 4.0000 0 +%! 1.0000 0.8536 0.7071 0.6036 1.0000 0.8536 +%! -4.0000 0 -2.8284 1.4142 5.0000 2.0000 +%! 4.0000 1.0000 2.8284 -0.7071 -5.0000 -1.0000 +%! 0 4.0000 10.1924 4.9623 4.0000 0 +%! 1.0000 1.0000 0.7071 0.7071 1.0000 1.0000 +%! -4.0000 -2.5000 -2.8284 0.7071 5.0000 1.0000 +%! 4.0000 0 2.8284 -2.4749 -5.0000 -3.5000 +%! 0 4.0000 10.1924 6.0418 4.0000 0 +%! 1.0000 1.0000 0.7071 0.7071 1.0000 1.0000 +%! 0 -2.4379 0 1.3808 5.0000 1.9527 +%! 4.0000 0.9527 2.8284 -2.4309 -1.0000 -3.4379 +%! 0 4.0000 7.1213 6.6827 4.0000 0 +%! 1.0000 1.0000 0.7071 0.7071 1.0000 1.0000 +%! -1.0000 -0.9734 0.2071 2.4163 1.0000 3.4172 +%! 0 2.4172 -1.2071 -1.3954 -2.0000 -1.9734 +%! 2.0000 4.0000 7.0178 6.6827 2.0000 0 +%! 1.0000 1.0000 1.0000 0.7071 1.0000 1.0000 +%! -0.8536 0 0.3536 2.4749 1.2071 3.5000 +%! 0.3536 2.5000 -0.8536 -0.7071 -1.7071 -1.0000 +%! 1.7071 4.0000 6.3498 6.0418 1.7071 0 +%! 0.8536 1.0000 0.8536 0.7071 0.8536 1.0000 +%! -0.3536 -4.0000 0.8536 0.7071 1.7071 1.0000 +%! 0.8536 0 -0.3536 -3.5355 -1.2071 -5.0000 +%! 1.7071 4.0000 6.3498 7.1213 1.7071 0 +%! 0.8536 1.0000 0.8536 0.7071 0.8536 1.0000 +%! 0 -4.0000 1.2071 3.5355 2.0000 5.0000 +%! 1.0000 4.0000 -0.2071 -3.5355 -1.0000 -5.0000 +%! 2.0000 4.0000 7.0178 10.1924 2.0000 0 +%! 1.0000 1.0000 1.0000 0.7071 1.0000 1.0000 +%! -2.5000 -4.0000 -0.5429 3.5355 1.0000 5.0000 +%! 0 4.0000 -1.9571 -3.5355 -3.5000 -5.0000 +%! 2.0000 4.0000 8.5444 10.1924 2.0000 0 +%! 1.0000 1.0000 1.0000 0.7071 1.0000 1.0000 +%! -2.4379 0 -0.0355 3.5355 1.9527 5.0000 +%! 0.9527 4.0000 -1.4497 -0.7071 -3.4379 -1.0000 +%! 2.0000 4.0000 9.4508 7.1213 2.0000 0 +%! 1.0000 1.0000 1.0000 0.7071 1.0000 1.0000]; +%! coefs = reshape (coefs, 4, 4, 3, 9); +%! horseshoe = nrbmak (coefs, knots); +%! nrbplot (horseshoe, [6, 6, 50], 'light', 'on'); diff --git a/octave_packages/nurbs-1.3.6/nrbrect.m b/octave_packages/nurbs-1.3.6/nrbrect.m new file mode 100644 index 0000000..2c650a2 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbrect.m @@ -0,0 +1,70 @@ +function curve = nrbrect(w,h) +% +% NRBRECT: Construct NURBS representation of a rectangular curve. +% +% Calling Sequence: +% +% crv = nrbrect() +% crv = nrbrect(size) +% crv = nrbrect(width, height) +% +% INPUT: +% +% size : Size of the square (width = height). +% +% width : Width of the rectangle (along x-axis). +% +% height : Height of the rectangle (along y-axis). +% +% OUTPUT: +% +% crv : NURBS curve, see nrbmak. +% +% +% Description: +% +% Construct a rectangle or square in the x-y plane with the bottom +% lhs corner at (0,0,0). If no rhs arguments provided the function +% constructs a unit square. +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +if nargin < 1 + w = 1; + h = 1; +end + +if nargin < 2 + h = w; +end + +coefs = [0 w w w w 0 0 0; + 0 0 0 h h h h 0; + 0 0 0 0 0 0 0 0; + 1 1 1 1 1 1 1 1]; + +knots = [0 0 0.25 0.25 0.5 0.5 0.75 0.75 1 1]; + +curve = nrbmak(coefs, knots); + +end + +%!demo +%! crv = nrbtform(nrbrect(2,1), vecrotz(deg2rad(35))); +%! nrbplot(crv,4); +%! axis equal +%! title('Construction and rotation of a rectangular curve.'); +%! hold off \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/nrbreverse.m b/octave_packages/nurbs-1.3.6/nrbreverse.m new file mode 100644 index 0000000..ff5f465 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbreverse.m @@ -0,0 +1,78 @@ +function rnrb = nrbreverse(nrb) +% +% NRBREVERSE: Reverse the evaluation direction of a NURBS curve or surface. +% +% Calling Sequence: +% +% rnrb = nrbreverse(nrb); +% +% INPUT: +% +% nrb : NURBS data structure, see nrbmak. +% +% OUTPUT: +% +% rnrb : Reversed NURBS. +% +% Description: +% +% Utility function to reverse the evaluation direction of a NURBS +% curve or surface. +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +if nargin ~= 1 + error('Incorrect number of input arguments'); +end + +if iscell(nrb.knots) + if size(nrb.knots,2) == 3 + error('The function nrbreverse is not yet ready for volumes') + else + % reverse a NURBS surface + coefs = nrb.coefs(:,:,end:-1:1); + rnrb = nrbmak(coefs(:,end:-1:1,:), {1.0-fliplr(nrb.knots{1}),... + 1.0-fliplr(nrb.knots{2})}); + end + +else + + % reverse a NURBS curve + rnrb = nrbmak(fliplr(nrb.coefs), 1.0-fliplr(nrb.knots)); + +end + +end + +%!demo +%! pnts = [0.5 1.5 3.0 7.5 8.5; +%! 3.0 5.5 1.5 4.0 4.5; +%! 0.0 0.0 0.0 0.0 0.0]; +%! crv1 = nrbmak(pnts,[0 0 0 1/2 3/4 1 1 1]); +%! crv2 = nrbreverse(crv1); +%! fprintf('Knots of the original curve\n') +%! disp(crv1.knots) +%! fprintf('Knots of the reversed curve\n') +%! disp(crv2.knots) +%! fprintf('Control points of the original curve\n') +%! disp(crv1.coefs(1:2,:)) +%! fprintf('Control points of the reversed curve\n') +%! disp(crv2.coefs(1:2,:)) +%! nrbplot(crv1,100) +%! hold on +%! nrbplot(crv2,100) +%! title('The curve and its reverse are the same') +%! hold off \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/nrbrevolve.m b/octave_packages/nurbs-1.3.6/nrbrevolve.m new file mode 100644 index 0000000..b63abdd --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbrevolve.m @@ -0,0 +1,180 @@ +function surf = nrbrevolve(curve,pnt,vec,theta) + +% +% NRBREVOLVE: Construct a NURBS surface by revolving a NURBS curve, or +% construct a NURBS volume by revolving a NURBS surface. +% +% Calling Sequence: +% +% srf = nrbrevolve(crv,pnt,vec[,ang]) +% +% INPUT: +% +% crv : NURBS curve or surface to revolve, see nrbmak. +% +% pnt : Coordinates of the point used to define the axis +% of rotation. +% +% vec : Vector defining the direction of the rotation axis. +% +% ang : Angle to revolve the curve, default 2*pi +% +% OUTPUT: +% +% srf : constructed surface or volume +% +% Description: +% +% Construct a NURBS surface by revolving the profile NURBS curve around +% an axis defined by a point and vector. +% +% Examples: +% +% Construct a sphere by rotating a semicircle around a x-axis. +% +% crv = nrbcirc(1.0,[0 0 0],0,pi); +% srf = nrbrevolve(crv,[0 0 0],[1 0 0]); +% nrbplot(srf,[20 20]); +% +% NOTE: +% +% The algorithm: +% +% 1) vectrans the point to the origin (0,0,0) +% 2) rotate the vector into alignment with the z-axis +% +% for each control point along the curve +% +% 3) determine the radius and angle of control +% point to the z-axis +% 4) construct a circular arc in the x-y plane with +% this radius and start angle and sweep angle theta +% 5) combine the arc and profile, coefs and weights. +% +% next control point +% +% 6) rotate and vectrans the surface back into position +% by reversing 1 and 2. +% +% +% Copyright (C) 2000 Mark Spink +% Copyright (C) 2010 Rafael Vazquez +% +% 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 . + +if (nargin < 3) + error('Not enough arguments to construct revolved surface'); +end + +if (nargin < 4) + theta = 2.0*pi; +end + +if (iscell (curve.knots) && numel(curve.knots) == 3) + error('The function nrbrevolve is not yet ready to create volumes') +end + +% Translate curve the center point to the origin +if isempty(pnt) + pnt = zeros(3,1); +end + +if length(pnt) ~= 3 + error('All point and vector coordinates must be 3D'); +end + +% Translate and rotate the original curve or surface into alignment with the z-axis +T = vectrans(-pnt); +angx = vecangle(vec(1),vec(3)); +RY = vecroty(-angx); +vectmp = RY*[vecnorm(vec(:));1.0]; +angy = vecangle(vectmp(2),vectmp(3)); +RX = vecrotx(angy); +curve = nrbtform(curve,RX*RY*T); + +% Construct an arc +arc = nrbcirc(1.0,[],0.0,theta); + +if (iscell (curve.knots)) +% Construct the revolved volume + coefs = zeros([4 arc.number curve.number]); + angle = squeeze (vecangle(curve.coefs(2,:,:),curve.coefs(1,:,:))); + radius = squeeze (vecmag(curve.coefs(1:2,:,:))); + for i = 1:curve.number(1) + for j = 1:curve.number(2) + coefs(:,:,i,j) = vecrotz(angle(i,j))*vectrans([0.0 0.0 curve.coefs(3,i,j)])*... + vecscale([radius(i,j) radius(i,j)])*arc.coefs; + coefs(4,:,i,j) = coefs(4,:,i,j)*curve.coefs(4,i,j); + end + end + surf = nrbmak(coefs,{arc.knots, curve.knots{:}}); +else +% Construct the revolved surface + coefs = zeros(4, arc.number, curve.number); + angle = vecangle(curve.coefs(2,:),curve.coefs(1,:)); + radius = vecmag(curve.coefs(1:2,:)); + for i = 1:curve.number + coefs(:,:,i) = vecrotz(angle(i))*vectrans([0.0 0.0 curve.coefs(3,i)])*... + vecscale([radius(i) radius(i)])*arc.coefs; + coefs(4,:,i) = coefs(4,:,i)*curve.coefs(4,i); + end + surf = nrbmak(coefs,{arc.knots, curve.knots}); +end + +% Rotate and vectrans the surface back into position +T = vectrans(pnt); +RX = vecrotx(-angy); +RY = vecroty(angx); +surf = nrbtform(surf,T*RY*RX); + +end + +%!demo +%! sphere = nrbrevolve(nrbcirc(1,[],0.0,pi),[0.0 0.0 0.0],[1.0 0.0 0.0]); +%! nrbplot(sphere,[40 40],'light','on'); +%! title('Ball and tori - surface construction by revolution'); +%! hold on; +%! torus = nrbrevolve(nrbcirc(0.2,[0.9 1.0]),[0.0 0.0 0.0],[1.0 0.0 0.0]); +%! nrbplot(torus,[40 40],'light','on'); +%! nrbplot(nrbtform(torus,vectrans([-1.8])),[20 10],'light','on'); +%! hold off; + +%!demo +%! pnts = [3.0 5.5 5.5 1.5 1.5 4.0 4.5; +%! 0.0 0.0 0.0 0.0 0.0 0.0 0.0; +%! 0.5 1.5 4.5 3.0 7.5 6.0 8.5]; +%! crv = nrbmak(pnts,[0 0 0 1/4 1/2 3/4 3/4 1 1 1]); +%! +%! xx = vecrotz(deg2rad(25))*vecroty(deg2rad(15))*vecrotx(deg2rad(20)); +%! nrb = nrbtform(crv,vectrans([5 5])*xx); +%! +%! pnt = [5 5 0]'; +%! vec = xx*[0 0 1 1]'; +%! srf = nrbrevolve(nrb,pnt,vec(1:3)); +%! +%! p = nrbeval(srf,{linspace(0.0,1.0,100) linspace(0.0,1.0,100)}); +%! surfl(squeeze(p(1,:,:)),squeeze(p(2,:,:)),squeeze(p(3,:,:))); +%! title('Construct of a 3D surface by revolution of a curve.'); +%! shading interp; +%! colormap(copper); +%! axis equal; +%! hold off + +%!demo +%! crv1 = nrbcirc(1,[0 0],0, pi/2); +%! crv2 = nrbcirc(2,[0 0],0, pi/2); +%! srf = nrbruled (crv1, crv2); +%! srf = nrbtform (srf, [1 0 0 0; 0 1 0 1; 0 0 1 0; 0 0 0 1]); +%! vol = nrbrevolve (srf, [0 0 0], [1 0 0], pi/2); +%! nrbplot(vol, [30 30 30], 'light', 'on') diff --git a/octave_packages/nurbs-1.3.6/nrbruled.m b/octave_packages/nurbs-1.3.6/nrbruled.m new file mode 100644 index 0000000..285943c --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbruled.m @@ -0,0 +1,89 @@ +function srf = nrbruled (crv1, crv2) + +% NRBRULED: Construct a ruled surface between two NURBS curves. +% +% Calling Sequence: +% +% srf = nrbruled(crv1, crv2) +% +% INPUT: +% +% crv1 : First NURBS curve, see nrbmak. +% +% crv2 : Second NURBS curve, see nrbmak. +% +% OUTPUT: +% +% srf : Ruled NURBS surface. +% +% Description: +% +% Constructs a ruled surface between two NURBS curves. The ruled surface is +% ruled along the V direction. +% +% Examples: +% +% Construct a ruled surface between a semicircle and a straight line. +% +% cir = nrbcirc(1,[0 0 0],0,pi); +% line = nrbline([-1 0.5 1],[1 0.5 1]); +% srf = nrbruled(cir,line); +% nrbplot(srf,[20 20]); +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +if (iscell(crv1.knots) || iscell(crv2.knots)) + error ('Both NURBS must be curves'); +end + +% ensure both curves have a common degree +d = max ([crv1.order, crv2.order]); +crv1 = nrbdegelev (crv1, d - crv1.order); +crv2 = nrbdegelev (crv2, d - crv2.order); + +% merge the knot vectors, to obtain a common knot vector +k1 = crv1.knots; +k2 = crv2.knots; +ku = unique ([k1 k2]); +n = length (ku); +ka = []; +kb = []; +for i = 1:n + i1 = length (find (k1 == ku(i))); + i2 = length (find (k2 == ku(i))); + m = max (i1, i2); + ka = [ka ku(i)*ones(1,m-i1)]; + kb = [kb ku(i)*ones(1,m-i2)]; +end +crv1 = nrbkntins (crv1, ka); +crv2 = nrbkntins (crv2, kb); + +coefs(:,:,1) = crv1.coefs; +coefs(:,:,2) = crv2.coefs; +srf = nrbmak (coefs, {crv1.knots, [0 0 1 1]}); + +end + +%!demo +%! pnts = [0.5 1.5 4.5 3.0 7.5 6.0 8.5; +%! 3.0 5.5 5.5 1.5 1.5 4.0 4.5; +%! 0.0 0.0 0.0 0.0 0.0 0.0 0.0]; +%! crv1 = nrbmak (pnts,[0 0 0 1/4 1/2 3/4 3/4 1 1 1]); +%! crv2 = nrbtform (nrbcirc (4,[4.5;0],pi,0.0),vectrans([0.0 4.0 -4.0])); +%! srf = nrbruled (crv1,crv2); +%! nrbplot (srf,[40 20]); +%! title ('Ruled surface construction from two NURBS curves.'); +%! hold off \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/nrbsurfderiveval.m b/octave_packages/nurbs-1.3.6/nrbsurfderiveval.m new file mode 100644 index 0000000..052a97c --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbsurfderiveval.m @@ -0,0 +1,294 @@ +function skl = nrbsurfderiveval (srf, uv, d) + +% +% NRBSURFDERIVEVAL: Evaluate n-th order derivatives of a NURBS surface +% +% usage: skl = nrbsurfderiveval (srf, [u; v], d) +% +% INPUT: +% +% srf : NURBS surface structure, see nrbmak +% +% u, v : parametric coordinates of the point where we compute the +% derivatives +% +% d : number of partial derivatives to compute +% +% +% OUTPUT: +% +% skl (i, j, k, l) = i-th component derived j-1,k-1 times at the +% l-th point. +% +% Adaptation of algorithm A4.4 from the NURBS book, pg137 +% +% Copyright (C) 2009 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 . + + skl = zeros (3, d+1, d+1, size (uv, 2)); + + for iu = 1:size(uv, 2); + wders = squeeze (surfderiveval (srf.number(1)-1, srf.order(1)-1, ... + srf.knots{1}, srf.number(2)-1, ... + srf.order(2)-1, srf.knots{2}, ... + squeeze (srf.coefs(4, :, :)), uv(1,iu), ... + uv(2,iu), d)); + + for idim = 1:3 + Aders = squeeze (surfderiveval (srf.number(1)-1, srf.order(1)-1, ... + srf.knots{1}, srf.number(2)-1, ... + srf.order(2)-1, srf.knots{2}, ... + squeeze (srf.coefs(idim, :, :)), uv(1,iu),... + uv(2,iu), d)); + + for k=0:d + for l=0:d-k + v = Aders(k+1, l+1); + for j=1:l + v = v - nchoosek(l,j)*wders(1,j+1)*skl(idim, k+1, l-j+1,iu); + end + for i=1:k + v = v - nchoosek(k,i)*wders(i+1,1)*skl(idim, k-i+1, l+1, iu); + v2 =0; + for j=1:l + v2 = v2 + nchoosek(l,j)*wders(i+1,j+1)*skl(idim, k-i+1, l-j+1, iu); + end + v = v - nchoosek(k,i)*v2; + end + skl(idim, k+1, l+1, iu) = v/wders(1,1); + end + end + end + + end + +end + +%!test +%! k = [0 0 1 1]; +%! c = [0 1]; +%! [coef(2,:,:), coef(1,:,:)] = meshgrid (c, c); +%! coef(3,:,:) = coef(1,:,:); +%! srf = nrbmak (coef, {k, k}); +%! [u, v] = meshgrid (linspace(0,1,11)); +%! uv = [u(:)';v(:)']; +%! skl = nrbsurfderiveval (srf, uv, 0); +%! aux = nrbeval(srf,uv); +%! assert (squeeze (skl (1:2,1,1,:)), aux(1:2,:), 1e3*eps) + + +%!test +%! k = [0 0 1 1]; +%! c = [0 1]; +%! [coef(2,:,:), coef(1,:,:)] = meshgrid (c, c); +%! coef(3,:,:) = coef(1,:,:); +%! srf = nrbmak (coef, {k, k}); +%! srf = nrbkntins (srf, {[], rand(2,1)}); +%! [u, v] = meshgrid (linspace(0,1,11)); +%! uv = [u(:)';v(:)']; +%! skl = nrbsurfderiveval (srf, uv, 0); +%! aux = nrbeval(srf,uv); +%! assert (squeeze (skl (1:2,1,1,:)), aux(1:2,:), 1e3*eps) + +%!shared srf, uv +%!test +%! k = [0 0 0 1 1 1]; +%! c = [0 1/2 1]; +%! [coef(1,:,:), coef(2,:,:)] = meshgrid (c, c); +%! coef(3,:,:) = coef(1,:,:); +%! srf = nrbmak (coef, {k, k}); +%! ders= nrbderiv (srf); +%! [u, v] = meshgrid (linspace(0,1,11)); +%! uv = [u(:)';v(:)']; +%! skl = nrbsurfderiveval (srf, uv, 1); +%! [fun, der] = nrbdeval (srf, ders, uv); +%! assert (squeeze (skl (1:2,1,1,:)), fun(1:2,:), 1e3*eps) +%! assert (squeeze (skl (1:2,2,1,:)), der{1}(1:2,:), 1e3*eps) +%! assert (squeeze (skl (1:2,1,2,:)), der{2}(1:2,:), 1e3*eps) +%! +%!test +%! srf = nrbdegelev (srf, [3, 1]); +%! ders= nrbderiv (srf); +%! [fun, der] = nrbdeval (srf, ders, uv); +%! skl = nrbsurfderiveval (srf, uv, 1); +%! assert (squeeze (skl (1:2,1,1,:)), fun(1:2,:), 1e3*eps) +%! assert (squeeze (skl (1:2,2,1,:)), der{1}(1:2,:), 1e3*eps) +%! assert (squeeze (skl (1:2,1,2,:)), der{2}(1:2,:), 1e3*eps) + +%!shared uv +%!test +%! k = [0 0 0 1 1 1]; +%! c = [0 1/2 1]; +%! [coef(2,:,:), coef(1,:,:)] = meshgrid (c, c); +%! coef(3,:,:) = coef(1,:,:); +%! srf = nrbmak (coef, {k, k}); +%! ders= nrbderiv (srf); +%! [u, v] = meshgrid (linspace(0,1,11)); +%! uv = [u(:)';v(:)']; +%! skl = nrbsurfderiveval (srf, uv, 1); +%! [fun, der] = nrbdeval (srf, ders, uv); +%! assert (squeeze (skl (1:2,1,1,:)), fun(1:2,:), 1e3*eps) +%! assert (squeeze (skl (1:2,2,1,:)), der{1}(1:2,:), 1e3*eps) +%! assert (squeeze (skl (1:2,1,2,:)), der{2}(1:2,:), 1e3*eps) +%! +%!test +%! p = 3; q = 3; +%! mcp = 5; ncp = 5; +%! Lx = 10*rand(1); Ly = Lx; +%! srf = nrbdegelev (nrb4surf ([0 0], [Lx, 0], [0 Ly], [Lx Ly]), [p-1, q-1]); +%! %%srf = nrbkntins (srf, {linspace(0,1,mcp-p+2)(2:end-1), linspace(0,1,ncp-q+2)(2:end-1)}); +%! %%srf.coefs = permute (srf.coefs, [1 3 2]); +%! ders= nrbderiv (srf); +%! [fun, der] = nrbdeval (srf, ders, uv); +%! skl = nrbsurfderiveval (srf, uv, 1); +%! assert (squeeze (skl (1:2,1,1,:)), fun(1:2,:), 1e3*eps) +%! assert (squeeze (skl (1:2,2,1,:)), der{1}(1:2,:), 1e3*eps) +%! assert (squeeze (skl (1:2,1,2,:)), der{2}(1:2,:), 1e3*eps) + +%!shared srf, uv, P, dPdx, d2Pdx2, c1, c2 +%!test +%! [u, v] = meshgrid (linspace(0,1,10)); +%! uv = [u(:)';v(:)']; +%! c1 = nrbmak([0 1/2 1; 0 1 0],[0 0 0 1 1 1]); +%! c1 = nrbtform (c1, vecrotx (pi/2)); +%! c2 = nrbtform(c1, vectrans([0 1 0])); +%! srf = nrbdegelev (nrbruled (c1, c2), [3, 1]); +%! skl = nrbsurfderiveval (srf, uv, 2); +%! P = squeeze(skl(:,1,1,:)); +%! dPdx = squeeze(skl(:,2,1,:)); +%! d2Pdx2 = squeeze(skl(:,3,1,:)); +%!assert(P(3,:), 2*(P(1,:)-P(1,:).^2),100*eps) +%!assert(dPdx(3,:), 2-4*P(1,:), 100*eps) +%!assert(d2Pdx2(3,:), -4+0*P(1,:), 100*eps) +%! srf = nrbdegelev (nrbruled (c1, c2), [5, 6]); +%! skl = nrbsurfderiveval (srf, uv, 2); +%! P = squeeze(skl(:,1,1,:)); +%! dPdx = squeeze(skl(:,2,1,:)); +%! d2Pdx2 = squeeze(skl(:,3,1,:)); +%! aux = nrbeval(srf,uv); +%! assert (squeeze (skl (1:2,1,1,:)), aux(1:2,:), 1e3*eps) +%!assert(P(3,:), 2*(P(1,:)-P(1,:).^2),100*eps) +%!assert(dPdx(3,:), 2-4*P(1,:), 100*eps) +%!assert(d2Pdx2(3,:), -4+0*P(1,:), 100*eps) +%! +%!test +%! skl = nrbsurfderiveval (srf, uv, 0); +%! aux = nrbeval (srf, uv); +%! assert (squeeze (skl (1:2,1,1,:)), aux(1:2,:), 1e3*eps) + +%!shared dPdu, d2Pdu2, P, srf, uv +%!test +%! [u, v] = meshgrid (linspace(0,1,10)); +%! uv = [u(:)';v(:)']; +%! c1 = nrbmak([0 1/2 1; 0.1 1.6 1.1; 0 0 0],[0 0 0 1 1 1]); +%! c2 = nrbmak([0 1/2 1; 0.1 1.6 1.1; 1 1 1],[0 0 0 1 1 1]); +%! srf = nrbdegelev (nrbruled (c1, c2), [0, 1]); +%! skl = nrbsurfderiveval (srf, uv, 2); +%! P = squeeze(skl(:,1,1,:)); +%! dPdu = squeeze(skl(:,2,1,:)); +%! dPdv = squeeze(skl(:,1,2,:)); +%! d2Pdu2 = squeeze(skl(:,3,1,:)); +%! aux = nrbeval(srf,uv); +%! assert (squeeze (skl (1:2,1,1,:)), aux(1:2,:), 1e3*eps) +%!assert(dPdu(2,:), 3-4*P(1,:),100*eps) +%!assert(d2Pdu2(2,:), -4+0*P(1,:),100*eps) +%! +%!test +%! skl = nrbsurfderiveval (srf, uv, 0); +%! aux = nrbeval(srf,uv); +%! assert (squeeze (skl (1:2,1,1,:)), aux(1:2,:), 1e3*eps) + +%!test +%! srf = nrb4surf([0 0], [1 0], [0 1], [1 1]); +%! geo = nrbdegelev (srf, [3 3]); +%1 geo.coefs (4, 2:end-1, 2:end-1) = geo.coefs (4, 2:end-1, 2:end-1) + .1 * rand (1, geo.number(1)-2, geo.number(2)-2); +%! geo = nrbkntins (geo, {[.1:.1:.9], [.2:.2:.8]}); +%! [u, v] = meshgrid (linspace(0,1,10)); +%! uv = [u(:)';v(:)']; +%! skl = nrbsurfderiveval (geo, uv, 2); +%! dgeo = nrbderiv (geo); +%! [pnts, ders] = nrbdeval (geo, dgeo, uv); +%! assert (ders{1}, squeeze(skl(:,2,1,:)), 1e-9) +%! assert (ders{2}, squeeze(skl(:,1,2,:)), 1e-9) + +%!test +%! crv = nrbline ([1 0], [2 0]); +%! srf = nrbrevolve (crv, [0 0 0], [0 0 1], pi/2); +%! srf = nrbtransp (srf); +%! [v, u] = meshgrid (linspace (0, 1, 11)); +%! uv = [u(:)'; v(:)']; +%! skl = nrbsurfderiveval (srf, uv, 2); +%! c = sqrt(2); +%! w = @(x, y) (2 - c)*y.^2 + (c-2)*y + 1; +%! dwdy = @(x, y) 2*(2-c)*y + c - 2; +%! d2wdy2 = @(x, y) 2*(2-c); +%! F1 = @(x, y) (x+1) .* ((1-y).^2 + c*y.*(1-y)) ./ w(x,y); +%! F2 = @(x, y) (x+1) .* (y.^2 + c*y.*(1-y)) ./ w(x,y); +%! dF1dx = @(x, y) ((1-y).^2 + c*y.*(1-y)) ./ w(x,y); +%! dF2dx = @(x, y) (y.^2 + c*y.*(1-y)) ./ w(x,y); +%! dF1dy = @(x, y) (x+1) .* ((2 - 2*c)*y + c - 2) ./ w(x,y) - (x+1) .* ((1-y).^2 + c*y.*(1-y)) .* dwdy(x,y) ./ w(x,y).^2; +%! dF2dy = @(x, y) (x+1) .* ((2 - 2*c)*y + c) ./ w(x,y) - (x+1) .* (y.^2 + c*y.*(1-y)) .* dwdy(x,y) ./ w(x,y).^2; +%! d2F1dx2 = @(x, y) zeros (size (x)); +%! d2F2dx2 = @(x, y) zeros (size (x)); +%! d2F1dxdy = @(x, y) ((2 - 2*c)*y + c - 2) ./ w(x,y) - ((1-y).^2 + c*y.*(1-y)) .* dwdy(x,y) ./ w(x,y).^2; +%! d2F2dxdy = @(x, y) ((2 - 2*c)*y + c) ./ w(x,y) - (y.^2 + c*y.*(1-y)) .* dwdy(x,y) ./ w(x,y).^2; +%! d2F1dy2 = @(x, y) (x+1)*(2 - 2*c) ./ w(x,y) - 2*(x+1) .* ((2 - 2*c)*y + c - 2) .* dwdy(x,y) ./ w(x,y).^2 - ... +%! (x+1) .* ((1-y).^2 + c*y.*(1-y)) * d2wdy2(x,y) ./ w(x,y).^2 + ... +%! 2 * (x+1) .* ((1-y).^2 + c*y.*(1-y)) .* w(x,y) .*dwdy(x,y).^2 ./ w(x,y).^4; +%! d2F2dy2 = @(x, y) (x+1)*(2 - 2*c) ./ w(x,y) - 2*(x+1) .* ((2 - 2*c)*y + c) .* dwdy(x,y) ./ w(x,y).^2 - ... +%! (x+1) .* (y.^2 + c*y.*(1-y)) * d2wdy2(x,y) ./ w(x,y).^2 + ... +%! 2 * (x+1) .* (y.^2 + c*y.*(1-y)) .* w(x,y) .*dwdy(x,y).^2 ./ w(x,y).^4; +%! assert ([F1(u(:),v(:)), F2(u(:),v(:))], squeeze(skl(1:2,1,1,:))', 1e2*eps); +%! assert ([dF1dx(u(:),v(:)), dF2dx(u(:),v(:))], squeeze(skl(1:2,2,1,:))', 1e2*eps); +%! assert ([dF1dy(u(:),v(:)), dF2dy(u(:),v(:))], squeeze(skl(1:2,1,2,:))', 1e2*eps); +%! assert ([d2F1dx2(u(:),v(:)), d2F2dx2(u(:),v(:))], squeeze(skl(1:2,3,1,:))', 1e2*eps); +%! assert ([d2F1dxdy(u(:),v(:)), d2F2dxdy(u(:),v(:))], squeeze(skl(1:2,2,2,:))', 1e2*eps); +%! assert ([d2F1dy2(u(:),v(:)), d2F2dy2(u(:),v(:))], squeeze(skl(1:2,1,3,:))', 1e2*eps); + +%!test +%! knots = {[0 0 1 1] [0 0 1 1]}; +%! coefs(:,1,1) = [0;0;0;1]; +%! coefs(:,2,1) = [1;0;0;1]; +%! coefs(:,1,2) = [0;1;0;1]; +%! coefs(:,2,2) = [1;1;1;2]; +%! srf = nrbmak (coefs, knots); +%! [v, u] = meshgrid (linspace (0, 1, 3)); +%! uv = [u(:)'; v(:)']; +%! skl = nrbsurfderiveval (srf, uv, 2); +%! w = @(x, y) x.*y + 1; +%! F1 = @(x, y) x ./ w(x,y); +%! F2 = @(x, y) y ./ w(x,y); +%! F3 = @(x, y) x .* y ./ w(x,y); +%! dF1dx = @(x, y) 1./w(x,y) - x.*y./w(x,y).^2; +%! dF1dy = @(x, y) - x.^2./w(x,y).^2; +%! dF2dx = @(x, y) - y.^2./w(x,y).^2; +%! dF2dy = @(x, y) 1./w(x,y) - x.*y./w(x,y).^2; +%! dF3dx = @(x, y) y./w(x,y) - x.*(y./w(x,y)).^2; +%! dF3dy = @(x, y) x./w(x,y) - y.*(x./w(x,y)).^2; +%! d2F1dx2 = @(x, y) -2*y./w(x,y).^2 + 2*x.*y.^2./w(x,y).^3; +%! d2F1dy2 = @(x, y) 2*x.^3./w(x,y).^3; +%! d2F1dxdy = @(x, y) -x./w(x,y).^2 - x./w(x,y).^2 + 2*x.^2.*y./w(x,y).^3; +%! d2F2dx2 = @(x, y) 2*y.^3./w(x,y).^3; +%! d2F2dy2 = @(x, y) -2*x./w(x,y).^2 + 2*y.*x.^2./w(x,y).^3; +%! d2F2dxdy = @(x, y) -y./w(x,y).^2 - y./w(x,y).^2 + 2*y.^2.*x./w(x,y).^3; +%! d2F3dx2 = @(x, y) -2*y.^2./w(x,y).^2 + 2*x.*y.^3./w(x,y).^3; +%! d2F3dy2 = @(x, y) -2*x.^2./w(x,y).^2 + 2*y.*x.^3./w(x,y).^3; +%! d2F3dxdy = @(x, y) 1./w(x,y) - 3*x.*y./w(x,y).^2 + 2*(x.*y).^2./w(x,y).^3; +%! assert ([F1(u(:),v(:)), F2(u(:),v(:)), F3(u(:),v(:))], squeeze(skl(1:3,1,1,:))', 1e2*eps); +%! assert ([dF1dx(u(:),v(:)), dF2dx(u(:),v(:)), dF3dx(u(:),v(:))], squeeze(skl(1:3,2,1,:))', 1e2*eps); +%! assert ([dF1dy(u(:),v(:)), dF2dy(u(:),v(:)), dF3dy(u(:),v(:))], squeeze(skl(1:3,1,2,:))', 1e2*eps); +%! assert ([d2F1dx2(u(:),v(:)), d2F2dx2(u(:),v(:)), d2F3dx2(u(:),v(:))], squeeze(skl(1:3,3,1,:))', 1e2*eps); +%! assert ([d2F1dy2(u(:),v(:)), d2F2dy2(u(:),v(:)), d2F3dy2(u(:),v(:))], squeeze(skl(1:3,1,3,:))', 1e2*eps); +%! assert ([d2F1dxdy(u(:),v(:)), d2F2dxdy(u(:),v(:)), d2F3dxdy(u(:),v(:))], squeeze(skl(1:3,2,2,:))', 1e2*eps); diff --git a/octave_packages/nurbs-1.3.6/nrbtestcrv.m b/octave_packages/nurbs-1.3.6/nrbtestcrv.m new file mode 100644 index 0000000..c372b5d --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbtestcrv.m @@ -0,0 +1,31 @@ +function crv = nrbtestcrv +% NRBTESTCRV: Constructs a simple test curve. +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +pnts = [0.5 1.5 4.5 3.0 7.5 6.0 8.5; + 3.0 5.5 5.5 1.5 1.5 4.0 4.5; + 0.0 0.0 0.0 0.0 0.0 0.0 0.0]; +crv = nrbmak(pnts,[0 0 0 1/4 1/2 3/4 3/4 1 1 1]); + +end + +%!demo +%! crv = nrbtestcrv; +%! nrbplot(crv,100) +%! title('Test curve') +%! hold off + diff --git a/octave_packages/nurbs-1.3.6/nrbtestsrf.m b/octave_packages/nurbs-1.3.6/nrbtestsrf.m new file mode 100644 index 0000000..71a97db --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbtestsrf.m @@ -0,0 +1,61 @@ +function srf = nrbtestsrf +% NRBTESTSRF: Constructs a simple test surface. +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +% allocate multi-dimensional array of control points +pnts = zeros(3,5,5); + +% define a grid of control points +% in this case a regular grid of u,v points +% pnts(3,u,v) +% + +pnts(:,:,1) = [ 0.0 3.0 5.0 8.0 10.0; % w*x + 0.0 0.0 0.0 0.0 0.0; % w*y + 2.0 2.0 7.0 7.0 8.0]; % w*z + +pnts(:,:,2) = [ 0.0 3.0 5.0 8.0 10.0; + 3.0 3.0 3.0 3.0 3.0; + 0.0 0.0 5.0 5.0 7.0]; + +pnts(:,:,3) = [ 0.0 3.0 5.0 8.0 10.0; + 5.0 5.0 5.0 5.0 5.0; + 0.0 0.0 5.0 5.0 7.0]; + +pnts(:,:,4) = [ 0.0 3.0 5.0 8.0 10.0; + 8.0 8.0 8.0 8.0 8.0; + 5.0 5.0 8.0 8.0 10.0]; + +pnts(:,:,5) = [ 0.0 3.0 5.0 8.0 10.0; + 10.0 10.0 10.0 10.0 10.0; + 5.0 5.0 8.0 8.0 10.0]; + +% knots +knots{1} = [0 0 0 1/3 2/3 1 1 1]; % knots along u +knots{2} = [0 0 0 1/3 2/3 1 1 1]; % knots along v + +% make and draw nurbs surface +srf = nrbmak(pnts,knots); + +end + +%!demo +%! srf = nrbtestsrf; +%! nrbplot(srf,[20 30]) +%! title('Test surface') +%! hold off + diff --git a/octave_packages/nurbs-1.3.6/nrbtform.m b/octave_packages/nurbs-1.3.6/nrbtform.m new file mode 100644 index 0000000..550dc07 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbtform.m @@ -0,0 +1,82 @@ +function nurbs = nrbtform(nurbs,tmat) +% +% NRBTFORM: Apply transformation matrix to the NURBS. +% +% Calling Sequence: +% +% tnurbs = nrbtform(nurbs,tmatrix); +% +% INPUT: +% +% nurbs : NURBS data structure (see nrbmak for details). +% +% tmatrix : Transformation matrix, a matrix of size (4,4) defining +% a single or multiple transformations. +% +% OUTPUT: +% +% tnurbs : The return transformed NURBS data structure. +% +% Description: +% +% The NURBS is transform as defined a transformation matrix of size (4,4), +% such as a rotation, translation or change in scale. The transformation +% matrix can define a single transformation or multiple series of +% transformations. The matrix can be simple constructed by the functions +% vecscale, vectrans, vecrotx, vecroty, and vecrotz. +% +% Examples: +% +% Rotate a square by 45 degrees about the z axis. +% +% rsqr = nrbtform(nrbrect(), vecrotz(deg2rad(45))); +% nrbplot(rsqr, 1000); +% +% See also: +% +% vecscale, vectrans, vecrotx, vecroty, vecrotz +% +% Copyright (C) 2000 Mark Spink +% Copyright (C) 2010 Rafael Vazquez +% +% 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 . + +if nargin < 2 + error('Not enough input arguments!'); +end; + +if iscell(nurbs.knots) + if size(nurbs.knots,2) == 2 + % NURBS is a surface + [dim,nu,nv] = size(nurbs.coefs); + nurbs.coefs = reshape(tmat*reshape(nurbs.coefs,dim,nu*nv),[dim nu nv]); + elseif size(nurbs.knots,2) == 3 + % NURBS is a volume + [dim,nu,nv,nw] = size(nurbs.coefs); + nurbs.coefs = reshape(tmat*reshape(nurbs.coefs,dim,nu*nv*nw),[dim nu nv nw]); + end +else + % NURBS is a curve + nurbs.coefs = tmat*nurbs.coefs; +end + +end + +%!demo +%! xx = vectrans([2.0 1.0])*vecroty(pi/8)*vecrotx(pi/4)*vecscale([1.0 2.0]); +%! c0 = nrbtform(nrbcirc, xx); +%! nrbplot(c0,50); +%! grid on +%! title('Construction of an ellipse by transforming a unit circle.'); +%! hold off \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/nrbtransp.m b/octave_packages/nurbs-1.3.6/nrbtransp.m new file mode 100644 index 0000000..31e07ab --- /dev/null +++ b/octave_packages/nurbs-1.3.6/nrbtransp.m @@ -0,0 +1,55 @@ +function tsrf = nrbtransp(srf) +% +% NRBTRANSP: Transpose a NURBS surface, by swapping U and V directions. +% +% Calling Sequence: +% +% tsrf = nrbtransp(srf) +% +% INPUT: +% +% srf : NURBS surface, see nrbmak. +% +% OUTPUT: +% +% tsrf : NURBS surface with U and V diretions transposed. +% +% Description: +% +% Utility function that transposes a NURBS surface, by swapping U and +% V directions. NURBS curves cannot be transposed. +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +if ~iscell(srf.knots) + error(' A NURBS curve cannot be transposed.'); +elseif size(srf.knots,2) == 3 + error('The transposition of NURBS volumes has not been implemented.'); +end + +tsrf = nrbmak(permute(srf.coefs,[1 3 2]), fliplr(srf.knots)); + +end + +%!demo +%! srf = nrb4surf([0 0 0], [1 0 1], [0 1 1], [1 1 2]); +%! nrbplot(srf,[20 5]); +%! title('Plane surface and its transposed (translated)') +%! hold on +%! srf.coefs(3,:,:) = srf.coefs(3,:,:) + 10; +%! srf = nrbtransp(srf); +%! nrbplot(srf,[20 5]); +%! hold off \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/numbasisfun.m b/octave_packages/nurbs-1.3.6/numbasisfun.m new file mode 100644 index 0000000..a33a070 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/numbasisfun.m @@ -0,0 +1,49 @@ +function B = numbasisfun (iv, uv, p, U) + +% NUMBASISFUN: List non-zero Basis functions for B-Spline in a given knot-span +% +% Calling Sequence: +% +% N = numbasisfun(i,u,p,U) +% +% INPUT: +% +% i - knot span ( from FindSpan() ) +% u - parametric point +% p - spline degree +% U - knot sequence +% +% OUTPUT: +% +% N - Basis functions (numel(u)x(p+1)) +% +% Copyright (C) 2009 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 . + +B = bsxfun (@(a, b) a+b,iv-p, (0:p).').'; + +end + +%!test +%! n = 3; +%! U = [0 0 0 1/2 1 1 1]; +%! p = 2; +%! u = linspace (0, 1, 10); +%! s = findspan (n, p, u, U); +%! Bref = [0 0 0 0 0 1 1 1 1 1; ... +%! 1 1 1 1 1 2 2 2 2 2; ... +%! 2 2 2 2 2 3 3 3 3 3].'; +%! B = numbasisfun (s, u, p, U); +%! assert (B, Bref) \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/packinfo/.autoload b/octave_packages/nurbs-1.3.6/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/nurbs-1.3.6/packinfo/DESCRIPTION b/octave_packages/nurbs-1.3.6/packinfo/DESCRIPTION new file mode 100644 index 0000000..cdbc69c --- /dev/null +++ b/octave_packages/nurbs-1.3.6/packinfo/DESCRIPTION @@ -0,0 +1,14 @@ +Name: Nurbs +Version: 1.3.6 +Date: 2012-03-17 +Author: Mark Spink, Daniel Claxton, Carlo de Falco, Rafael Vazquez +Maintainer: Carlo de Falco and Rafael Vazquez +Title: Nurbs. +Description: Collection of routines for the creation, and manipulation of Non-Uniform Rational B-Splines (NURBS), based on the NURBS toolbox by Mark Spink. +Categories: splines +Depends: octave (>= 3.2) +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net +SVNRelease: 9939 + diff --git a/octave_packages/nurbs-1.3.6/packinfo/INDEX b/octave_packages/nurbs-1.3.6/packinfo/INDEX new file mode 100644 index 0000000..a4f1138 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/packinfo/INDEX @@ -0,0 +1,70 @@ +nurbs >> Nurbs +Basic operations for NURBS curves, surfaces and volumes + nrbmak + nrbkntins + nrbdegelev + nrbderiv + nrbdeval + nrbeval +Operations for constructing NURBS curves and surfaces + nrbtform + nrbreverse + nrbtransp + nrbline + nrbcirc + nrbrect + nrb4surf + nrbcylind + nrbextract + nrbextrude + nrbrevolve + nrbruled + nrbcoons + nrbplot + nrbctrlplot + nrbkntplot + nrbexport + nrbtestcrv + nrbtestsrf +B-Spline functions + bspeval + bspderiv + bspkntins + bspdegelev + basisfun + basisfunder + findspan + numbasisfun + tbasisfun +B-splines geometric entities + curvederivcpts + curvederiveval + surfderivcpts + surfderiveval +NURBS geometric entities and functions + nrbbasisfun + nrbbasisfunder + nrbnumbasisfun + nrbcrvderiveval + nrbsurfderiveval +Knots construction and refinement + kntuniform + kntrefine + kntbrkdegreg + kntbrkdegmult +Vector and Transformation Utilities + vecnorm + vecmag + vecmag2 + vecangle + vecdot + veccross + vecrotx + vecroty + vecrotz + vecrot + vecscale + vectrans +Misc Utilities + deg2rad + rad2deg diff --git a/octave_packages/nurbs-1.3.6/private/nrb_crv_basisfun__.m b/octave_packages/nurbs-1.3.6/private/nrb_crv_basisfun__.m new file mode 100644 index 0000000..8278e4b --- /dev/null +++ b/octave_packages/nurbs-1.3.6/private/nrb_crv_basisfun__.m @@ -0,0 +1,20 @@ + function [B, nbfu] = nrb_crv_basisfun__ (points, nrb); +% __NRB_CRV_BASISFUN__: Undocumented internal function +% +% Copyright (C) 2009 Carlo de Falco +% This software comes with ABSOLUTELY NO WARRANTY; see the file +% COPYING for details. This is free software, and you are welcome +% to distribute it under the conditions laid out in COPYING. + n = size (nrb.coefs, 2) -1; + p = nrb.order -1; + u = points; + U = nrb.knots; + w = nrb.coefs(4,:); + + spu = findspan (n, p, u, U); + nbfu = numbasisfun (spu, u, p, U); + + N = w(nbfu+1) .* basisfun (spu, u, p, U); + B = bsxfun (@(x,y) x./y, N, sum (N,2)); + + end diff --git a/octave_packages/nurbs-1.3.6/private/nrb_crv_basisfun_der__.m b/octave_packages/nurbs-1.3.6/private/nrb_crv_basisfun_der__.m new file mode 100644 index 0000000..8857dc2 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/private/nrb_crv_basisfun_der__.m @@ -0,0 +1,32 @@ + function [Bu, nbfu] = nrb_crv_basisfun_der__ (points, nrb); +% __NRB_CRV_BASISFUN_DER__: Undocumented internal function +% +% Copyright (C) 2009 Carlo de Falco +% This software comes with ABSOLUTELY NO WARRANTY; see the file +% COPYING for details. This is free software, and you are welcome +% to distribute it under the conditions laid out in COPYING. + n = size (nrb.coefs, 2) -1; + p = nrb.order -1; + u = points; + U = nrb.knots; + w = nrb.coefs(4,:); + + spu = findspan (n, p, u, U); + nbfu = numbasisfun (spu, u, p, U); + + N = basisfun (spu, u, p, U); + + Nprime = basisfunder (spu, p, u, U, 1); + Nprime = squeeze(Nprime(:,2,:)); + + + [Dpc, Dpk] = bspderiv (p, w, U); + D = bspeval (p, w, U, u); + Dprime = bspeval (p-1, Dpc, Dpk, u); + + + Bu1 = bsxfun (@(np, d) np/d , Nprime.', D); + Bu2 = bsxfun (@(n, dp) n*dp, N.', Dprime./D.^2); + Bu = w(nbfu+1) .* (Bu1 - Bu2).'; + + end diff --git a/octave_packages/nurbs-1.3.6/private/nrb_srf_basisfun__.m b/octave_packages/nurbs-1.3.6/private/nrb_srf_basisfun__.m new file mode 100644 index 0000000..b7856c8 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/private/nrb_srf_basisfun__.m @@ -0,0 +1,41 @@ +function [B, N] = nrb_srf_basisfun__ (points, nrb); + +% __NRB_SRF_BASISFUN__: Undocumented internal function +% +% Copyright (C) 2009 Carlo de Falco +% This software comes with ABSOLUTELY NO WARRANTY; see the file +% COPYING for details. This is free software, and you are welcome +% to distribute it under the conditions laid out in COPYING. + + m = size (nrb.coefs, 2) -1; + n = size (nrb.coefs, 3) -1; + + p = nrb.order(1) -1; + q = nrb.order(2) -1; + + u = points(1,:); + v = points(2,:); + npt = length(u); + + U = nrb.knots{1}; + V = nrb.knots{2}; + + w = squeeze(nrb.coefs(4,:,:)); + + spu = findspan (m, p, u, U); + spv = findspan (n, q, v, V); + NuIkuk = basisfun (spu, u, p, U); + NvJkvk = basisfun (spv, v, q, V); + + indIkJk = nrbnumbasisfun (points, nrb); + + for k=1:npt + wIkaJkb(1:p+1, 1:q+1) = reshape (w(indIkJk(k, :)), p+1, q+1); + NuIkukaNvJkvk(1:p+1, 1:q+1) = (NuIkuk(k, :).' * NvJkvk(k, :)); + RIkJk(k, :) = reshape((NuIkukaNvJkvk .* wIkaJkb ./ sum(sum(NuIkukaNvJkvk .* wIkaJkb))),1,[]); + end + + B = RIkJk; + N = indIkJk; + + end \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/private/nrb_srf_basisfun_der__.m b/octave_packages/nurbs-1.3.6/private/nrb_srf_basisfun_der__.m new file mode 100644 index 0000000..9524f91 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/private/nrb_srf_basisfun_der__.m @@ -0,0 +1,52 @@ +function [Bu, Bv, N] = nrb_srf_basisfun_der__ (points, nrb); + +% __NRB_SRF_BASISFUN_DER__: Undocumented internal function +% +% Copyright (C) 2009 Carlo de Falco +% This software comes with ABSOLUTELY NO WARRANTY; see the file +% COPYING for details. This is free software, and you are welcome +% to distribute it under the conditions laid out in COPYING. + + m = size (nrb.coefs, 2) -1; + n = size (nrb.coefs, 3) -1; + + p = nrb.order(1) -1; + q = nrb.order(2) -1; + + u = points(1,:); + v = points(2,:); + npt = length(u); + + U = nrb.knots{1}; + V = nrb.knots{2}; + + w = squeeze(nrb.coefs(4,:,:)); + + spu = findspan (m, p, u, U); + spv = findspan (n, q, v, V); + N = nrbnumbasisfun (points, nrb); + + NuIkuk = basisfun (spu, u, p, U); + NvJkvk = basisfun (spv, v, q, V); + + NuIkukprime = basisfunder (spu, p, u, U, 1); + NuIkukprime = reshape (NuIkukprime(:,2,:), npt, []); + + NvJkvkprime = basisfunder (spv, q, v, V, 1); + NvJkvkprime = reshape (NvJkvkprime(:,2,:), npt, []); + + for k=1:npt + wIkaJkb(1:p+1, 1:q+1) = reshape (w(N(k, :)), p+1, q+1); + + Num = (NuIkuk(k, :).' * NvJkvk(k, :)) .* wIkaJkb; + Num_du = (NuIkukprime(k, :).' * NvJkvk(k, :)) .* wIkaJkb; + Num_dv = (NuIkuk(k, :).' * NvJkvkprime(k, :)) .* wIkaJkb; + Denom = sum(sum(Num)); + Denom_du = sum(sum(Num_du)); + Denom_dv = sum(sum(Num_dv)); + + Bu(k, :) = reshape((Num_du/Denom - Denom_du.*Num/Denom.^2),1,[]); + Bv(k, :) = reshape((Num_dv/Denom - Denom_dv.*Num/Denom.^2),1,[]); + end + +end \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/private/nrb_srf_numbasisfun__.m b/octave_packages/nurbs-1.3.6/private/nrb_srf_numbasisfun__.m new file mode 100644 index 0000000..3dd0e8b --- /dev/null +++ b/octave_packages/nurbs-1.3.6/private/nrb_srf_numbasisfun__.m @@ -0,0 +1,34 @@ +function idx = nrb_srf_numbasisfun__ (points, nrb) + +% __NRB_SRF_NUMBASISFUN__: Undocumented internal function +% +% Copyright (C) 2009 Carlo de Falco +% This software comes with ABSOLUTELY NO WARRANTY; see the file +% COPYING for details. This is free software, and you are welcome +% to distribute it under the conditions laid out in COPYING. + + m = nrb.number(1)-1; + n = nrb.number(2)-1; + + npt = size(points,2); + u = points(1,:); + v = points(2,:); + + U = nrb.knots{1}; + V = nrb.knots{2}; + + p = nrb.order(1)-1; + q = nrb.order(2)-1; + + spu = findspan (m, p, u, U); + Ik = numbasisfun (spu, u, p, U); + + spv = findspan (n, q, v, V); + Jk = numbasisfun (spv, v, q, V); + + for k=1:npt + [Jkb, Ika] = meshgrid(Jk(k, :), Ik(k, :)); + idx(k, :) = sub2ind([m+1, n+1], Ika(:)+1, Jkb(:)+1); + end + +end diff --git a/octave_packages/nurbs-1.3.6/private/onebasisfun__.m b/octave_packages/nurbs-1.3.6/private/onebasisfun__.m new file mode 100644 index 0000000..bbd1764 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/private/onebasisfun__.m @@ -0,0 +1,56 @@ +function Nip = onebasisfun__ (u, p, U) + +% __ONEBASISFUN__: Undocumented internal function +% +% Adapted from Algorithm A2.4 from 'The NURBS BOOK' pg74. +% +% Copyright (C) 2009 Carlo de Falco +% Copyright (C) 2012 Rafael Vazquez +% This software comes with ABSOLUTELY NO WARRANTY; see the file +% COPYING for details. This is free software, and you are welcome +% to distribute it under the conditions laid out in COPYING. + + Nip = zeros (size (u)); + N = zeros (p+1, 1); + + for ii = 1:numel(u) + if ((u(ii) == U(1)) && (U(1) == U(end-1)) || ... + (u(ii) == U(end)) && (U(end) == U(2))) + Nip(ii) = 1; + continue + end + if (~ any (U <= u(ii))) || (~ any (U > u(ii))) + continue; + end + for jj = 1:p+1 % Initialize zero-th degree functions + if (u(ii) > U(jj) && u(ii) < U(jj+1)) + N(jj) = 1; + else + N(jj) = 0; + end + end + for k = 1:p + if (N(1) == 0) + saved = 0; + else + saved = (u(ii) - U(1))*N(1) / (U(k+1)-U(1)); + end + + for jj = 1:p-k+1 + Uleft = U(1+jj); + Uright = U(1+jj+k); + if (N(jj+1) == 0) + N(jj) = saved; + saved = 0; + else + temp = N(jj+1)/(Uright-Uleft); + N(jj) = saved + (Uright - u(ii))*temp; + saved = (u(ii) - Uleft)*temp; + end + end + end + Nip(ii) = N(1); + end + + +end diff --git a/octave_packages/nurbs-1.3.6/private/onebasisfunder__.m b/octave_packages/nurbs-1.3.6/private/onebasisfunder__.m new file mode 100644 index 0000000..b397d10 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/private/onebasisfunder__.m @@ -0,0 +1,39 @@ +function [N, Nder] = onebasisfunder__ (u, p, U) + +% __ONEBASISFUNDER__: Undocumented internal function +% +% Copyright (C) 2012 Rafael Vazquez +% This software comes with ABSOLUTELY NO WARRANTY; see the file +% COPYING for details. This is free software, and you are welcome +% to distribute it under the conditions laid out in COPYING. + + N = zeros (size (u)); + Nder = zeros (size (u)); + + for ii = 1:numel (u) + if (~ any (U <= u(ii))) || (~ any (U > u(ii))) + continue; + elseif (p == 0) + N(ii) = 1; + Nder(ii) = 0; + continue; + else + ln = u(ii) - U(1); + ld = U(end-1) - U(1); + if (ld ~= 0) + aux = onebasisfun__ (u(ii), p-1, U(1:end-1))/ ld; + N(ii) = N(ii) + ln * aux; + Nder(ii) = Nder(ii) + p * aux; + end + + dn = U(end) - u(ii); + dd = U(end) - U(2); + if (dd ~= 0) + aux = onebasisfun__ (u(ii), p-1, U(2:end))/ dd; + N(ii) = N(ii) + dn * aux; + Nder(ii) = Nder(ii) - p * aux; + end + end + end + +end diff --git a/octave_packages/nurbs-1.3.6/rad2deg.m b/octave_packages/nurbs-1.3.6/rad2deg.m new file mode 100644 index 0000000..3e5388d --- /dev/null +++ b/octave_packages/nurbs-1.3.6/rad2deg.m @@ -0,0 +1,45 @@ +function deg = rad2deg(rad) +% +% RAD2DEG: Convert radians to degrees. +% +% Calling Sequence: +% +% rad = rad2deg(deg); +% +% INPUT: +% +% rad : Angle in radians. +% +% OUTPUT: +% +% deg : Angle in degrees. +% +% Description: +% +% Convenient utility function for converting radians to degrees, which are +% often the required angular units for functions in the NURBS toolbox. +% +% Examples: +% +% Convert 0.3 radians to degrees +% +% rad = deg2rad(0.3); +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +deg = 180.0*rad/pi; + +end diff --git a/octave_packages/nurbs-1.3.6/surfderivcpts.m b/octave_packages/nurbs-1.3.6/surfderivcpts.m new file mode 100644 index 0000000..2717354 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/surfderivcpts.m @@ -0,0 +1,79 @@ +function pkl = surfderivcpts (n, p, U, m, q, V, P, d, r1, r2, s1, s2) +% +% SURFDERIVCPTS: Compute control points of n-th derivatives of a NURBS surface. +% +% usage: pkl = surfderivcpts (n, p, U, m, q, V, P, d) +% +% INPUT: +% +% n+1, m+1 = number of control points +% p, q = spline order +% U, V = knots +% P = control points +% d = derivative order +% +% OUTPUT: +% +% pkl (k+1, l+1, i+1, j+1) = i,jth control point +% of the surface differentiated k +% times in the u direction and l +% times in the v direction +% +% Adaptation of algorithm A3.7 from the NURBS book, pg114 +% +% Copyright (C) 2009 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 . + + if (nargin <= 8) + r1 = 0; r2 = n; + s1 = 0; s2 = m; + end + r = r2-r1; + s = s2-s1; + + du = min (d, p); dv = min (d, q); + + for j=s1:s2 + temp = curvederivcpts (n, p, U, P(:,j+1:end), du, r1, r2); + for k=0:du + for i=0:r-k + pkl (k+1, 1, i+1, j-s1+1) = temp (k+1, i+1); + end + end + end + + for k=0:du + for i=0:r-k + dd = min (d-k, dv); + temp = curvederivcpts (m, q, V(s1+1:end), pkl(k+1, 1, i+1, :), ... + dd, 0, s); + for l=1:dd + for j=0:s-l + pkl (k+1, l+1, i+1, j+1) = temp (l+1, j+1); + end + end + end + end + +end + +%!test +%! coefs = cat(3,[0 0; 0 1],[1 1; 0 1]); +%! knots = {[0 0 1 1] [0 0 1 1]}; +%! plane = nrbmak(coefs,knots); +%! pkl = surfderivcpts (plane.number(1)-1, plane.order(1)-1,... +%! plane.knots{1}, plane.number(2)-1,... +%! plane.order(2)-1, plane.knots{2}, ... +%! squeeze (plane.coefs(1,:,:)), 1); diff --git a/octave_packages/nurbs-1.3.6/surfderiveval.m b/octave_packages/nurbs-1.3.6/surfderiveval.m new file mode 100644 index 0000000..b51e414 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/surfderiveval.m @@ -0,0 +1,95 @@ +function skl = surfderiveval (n, p, U, m, q, V, P, u, v, d) +% +% SURFDERIVEVAL: Compute the derivatives of a B-spline surface +% +% usage: skl = surfderiveval (n, p, U, m, q, V, P, u, v, d) +% +% INPUT: +% +% n+1, m+1 = number of control points +% p, q = spline order +% U, V = knots +% P = control points +% u,v = evaluation points +% d = derivative order +% +% OUTPUT: +% +% skl (k+1, l+1) = surface differentiated k +% times in the u direction and l +% times in the v direction +% +% Adaptation of algorithm A3.8 from the NURBS book, pg115 +% +% Copyright (C) 2009 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 . + + skl = zeros (d+1, d+1); + du = min (d, p); + dv = min (d, q); + + uspan = findspan (n, p, u, U); + for ip=0:p + Nu(1:ip+1,ip+1) = basisfun (uspan, u, ip, U)'; + end + + vspan = findspan (m, q, v, V); + for ip=0:q + Nv(1:ip+1,ip+1) = basisfun (vspan, v, ip, V)'; + end + + pkl = surfderivcpts (n, p, U, m, q, V, P, d, uspan-p, uspan, ... + vspan-q, vspan); + + for k = 0:du + dd = min (d-k, dv); + for l = 0:dd + skl(k+1,l+1) =0; + for i=0:q-l + tmp = 0; + for j = 0:p-k + tmp = tmp + Nu(j+1,p-k+1) * pkl(k+1,l+1,j+1,i+1); + end + skl(k+1,l+1) = skl(k+1,l+1) + Nv(i+1,q-l+1)*tmp; + end + end + end + +end + +%!shared srf +%!test +%! k = [0 0 0 1 1 1]; +%! c = [0 1/2 1]; +%! [coef(2,:,:), coef(1,:,:)] = meshgrid (c, c); +%! srf = nrbmak (coef, {k, k}); +%! skl = surfderiveval (srf.number(1)-1, ... +%! srf.order(1)-1, ... +%! srf.knots{1}, ... +%! srf.number(2)-1, ... +%! srf.order(2)-1, ... +%! srf.knots{2},... +%! squeeze(srf.coefs(1,:,:)), .5, .5, 1) ; +%! assert (skl, [.5 0; 1 0]) +%!test +%! srf = nrbkntins (srf, {[], rand(1,2)}); +%! skl = surfderiveval (srf.number(1)-1,... +%! srf.order(1)-1, ... +%! srf.knots{1},... +%! srf.number(2)-1,... +%! srf.order(2)-1, ... +%! srf.knots{2},... +%! squeeze(srf.coefs(1,:,:)), .5, .5, 1) ; +%! assert (skl, [.5 0; 1 0], 100*eps) \ No newline at end of file diff --git a/octave_packages/nurbs-1.3.6/tbasisfun.m b/octave_packages/nurbs-1.3.6/tbasisfun.m new file mode 100644 index 0000000..10d3d80 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/tbasisfun.m @@ -0,0 +1,131 @@ +function [N, Nder] = tbasisfun (u, p, U) +% +% TBASISFUN: Compute a B- or T-Spline basis function, and its derivatives, from its local knot vector. +% +% usage: +% +% [N, Nder] = tbasisfun (u, p, U) +% [N, Nder] = tbasisfun ([u; v], [p q], {U, V}) +% [N, Nder] = tbasisfun ([u; v; w], [p q r], {U, V, W}) +% +% INPUT: +% +% u or [u; v] : points in parameter space where the basis function is to be +% evaluated +% +% U or {U, V} : local knot vector +% +% p or [p q] : polynomial order of the basis function +% +% OUTPUT: +% +% N : basis function evaluated at the given parametric points +% Nder : basis function gradient evaluated at the given parametric points +% +% Copyright (C) 2009 Carlo de Falco +% Copyright (C) 2012 Rafael Vazquez +% +% 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 . + + if (~ iscell (U)) + U = sort (U); + if (numel (U) ~= p+2) + error ('tbasisfun: knot vector and degree do not correspond') + end + + if (nargout == 1) + N = onebasisfun__ (u, p, U); + else + [N, Nder] = onebasisfunder__ (u, p, U); + end + + elseif (size(U,2) == 2) + U{1} = sort(U{1}); U{2} = sort(U{2}); + if (numel(U{1}) ~= p(1)+2 || numel(U{2}) ~= p(2)+2) + error ('tbasisfun: knot vector and degree do not correspond') + end + + if (nargout == 1) + Nu = onebasisfun__ (u(1,:), p(1), U{1}); + Nv = onebasisfun__ (u(2,:), p(2), U{2}); + + N = Nu.*Nv; + elseif (nargout == 2) + [Nu, Ndu] = onebasisfunder__ (u(1,:), p(1), U{1}); + [Nv, Ndv] = onebasisfunder__ (u(2,:), p(2), U{2}); + + N = Nu.*Nv; + Nder(1,:) = Ndu.*Nv; + Nder(2,:) = Nu.*Ndv; + end + + elseif (size(U,2) == 3) + U{1} = sort(U{1}); U{2} = sort(U{2}); U{3} = sort(U{3}); + if (numel(U{1}) ~= p(1)+2 || numel(U{2}) ~= p(2)+2 || numel(U{3}) ~= p(3)+2) + error ('tbasisfun: knot vector and degree do not correspond') + end + + if (nargout == 1) + Nu = onebasisfun__ (u(1,:), p(1), U{1}); + Nv = onebasisfun__ (u(2,:), p(2), U{2}); + Nw = onebasisfun__ (u(3,:), p(3), U{3}); + + N = Nu.*Nv.*Nw; + else + [Nu, Ndu] = onebasisfunder__ (u(1,:), p(1), U{1}); + [Nv, Ndv] = onebasisfunder__ (u(2,:), p(2), U{2}); + [Nw, Ndw] = onebasisfunder__ (u(3,:), p(3), U{3}); + + N = Nu.*Nv.*Nw; + Nder(1,:) = Ndu.*Nv.*Nw; + Nder(2,:) = Nu.*Ndv.*Nw; + Nder(3,:) = Nu.*Nv.*Ndw; + end + end + +end + +%!demo +%! U = {[0 0 1/2 1 1], [0 0 0 1 1]}; +%! p = [3, 3]; +%! [X, Y] = meshgrid (linspace(0, 1, 30)); +%! u = [X(:), Y(:)]'; +%! N = tbasisfun (u, p, U); +%! surf (X, Y, reshape (N, size(X))) +%! title('Basis function associated to a local knot vector') +%! hold off + +%!test +%! U = [0 1/2 1]; +%! p = 1; +%! u = [0.3 0.4 0.6 0.7]; +%! [N, Nder] = tbasisfun (u, p, U); +%! assert (N, [0.6 0.8 0.8 0.6], 1e-12); +%! assert (Nder, [2 2 -2 -2], 1e-12); + +%!test +%! U = {[0 1/2 1] [0 1/2 1]}; +%! p = [1 1]; +%! u = [0.3 0.4 0.6 0.7; 0.3 0.4 0.6 0.7]; +%! [N, Nder] = tbasisfun (u, p, U); +%! assert (N, [0.36 0.64 0.64 0.36], 1e-12); +%! assert (Nder, [1.2 1.6 -1.6 -1.2; 1.2 1.6 -1.6 -1.2], 1e-12); + +%!test +%! U = {[0 1/2 1] [0 1/2 1] [0 1/2 1]}; +%! p = [1 1 1]; +%! u = [0.4 0.4 0.6 0.6; 0.4 0.4 0.6 0.6; 0.4 0.6 0.4 0.6]; +%! [N, Nder] = tbasisfun (u, p, U); +%! assert (N, [0.512 0.512 0.512 0.512], 1e-12); +%! assert (Nder, [1.28 1.28 -1.28 -1.28; 1.28 1.28 -1.28 -1.28; 1.28 -1.28 1.28 -1.28], 1e-12); diff --git a/octave_packages/nurbs-1.3.6/vecangle.m b/octave_packages/nurbs-1.3.6/vecangle.m new file mode 100644 index 0000000..8d65002 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/vecangle.m @@ -0,0 +1,50 @@ +function ang = vecangle(num,den) + +% +% VECANGLE: An alternative to atan, returning an arctangent in the +% range 0 to 2*pi. +% +% Calling Sequence: +% +% ang = vecmag2(num,dum) +% +% INPUT: +% +% num : Numerator, vector of size (1,nv). +% dem : Denominator, vector of size (1,nv). +% +% OUTPUT: +% ang : Arctangents, row vector of angles. +% +% Description: +% +% The components of the vector ang are the arctangent of the corresponding +% enties of num./dem. This function is an alternative for +% atan, returning an angle in the range 0 to 2*pi. +% +% Examples: +% +% Find the atan(1.2,2.0) and atan(1.5,3.4) using vecangle +% +% ang = vecangle([1.2 1.5], [2.0 3.4]); +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +ang = atan2(num,den); +index = find(ang < 0.0); +ang(index) = 2*pi+ang(index); + +end diff --git a/octave_packages/nurbs-1.3.6/veccross.m b/octave_packages/nurbs-1.3.6/veccross.m new file mode 100644 index 0000000..877c0fa --- /dev/null +++ b/octave_packages/nurbs-1.3.6/veccross.m @@ -0,0 +1,59 @@ +function cross = veccross(vec1,vec2) +% +% VECCROSS: The cross product of two vectors. +% +% Calling Sequence: +% +% cross = veccross(vec1,vec2); +% +% INPUT: +% +% vec1 : An array of column vectors represented by a matrix of +% vec2 size (dim,nv), where is the dimension of the vector and +% nv the number of vectors. +% +% OUTPUT: +% +% cross : Array of column vectors, each element is corresponding +% to the cross product of the respective components in vec1 +% and vec2. +% +% Description: +% +% Cross product of two vectors. +% +% Examples: +% +% Determine the cross products of: +% (2.3,3.4,5.6) and (1.2,4.5,1.2) +% (5.1,0.0,2.3) and (2.5,3.2,4.0) +% +% cross = veccross([2.3 5.1; 3.4 0.0; 5.6 2.3],[1.2 2.5; 4.5 3.2; 1.2 4.0]); +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +if size(vec1,1) == 2 + % 2D vector + cross = zeros(size(vec1)); + cross(3,:) = vec1(1,:).*vec2(2,:)-vec1(2,:).*vec2(1,:); +else + % 3D vector + cross = [vec1(2,:).*vec2(3,:)-vec1(3,:).*vec2(2,:); + vec1(3,:).*vec2(1,:)-vec1(1,:).*vec2(3,:); + vec1(1,:).*vec2(2,:)-vec1(2,:).*vec2(1,:)]; +end + +end diff --git a/octave_packages/nurbs-1.3.6/vecdot.m b/octave_packages/nurbs-1.3.6/vecdot.m new file mode 100644 index 0000000..ad67005 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/vecdot.m @@ -0,0 +1,50 @@ +function dot = vecdot(vec1,vec2) +% +% VECDOT: The dot product of two vectors. +% +% Calling Sequence: +% +% dot = vecdot(vec1,vec2); +% +% INPUT: +% +% vec1 : An array of column vectors represented by a matrix of +% vec2 size (dim,nv), where is the dimension of the vector and +% nv the number of vectors. +% +% OUTPUT: +% +% dot : Row vector of scalars, each element corresponding to +% the dot product of the respective components in vec1 and +% vec2. +% +% Description: +% +% Scalar dot product of two vectors. +% +% Examples: +% +% Determine the dot product of +% (2.3,3.4,5.6) and (1.2,4.5,1.2) +% (5.1,0.0,2.3) and (2.5,3.2,4.0) +% +% dot = vecdot([2.3 5.1; 3.4 0.0; 5.6 2.3],[1.2 2.5; 4.5 3.2; 1.2 4.0]); +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +dot = sum(vec1.*vec2); + +end diff --git a/octave_packages/nurbs-1.3.6/vecmag.m b/octave_packages/nurbs-1.3.6/vecmag.m new file mode 100644 index 0000000..a33211a --- /dev/null +++ b/octave_packages/nurbs-1.3.6/vecmag.m @@ -0,0 +1,46 @@ +function mag = vecmag(vec) +% +% VECMAG: Magnitude of the vectors. +% +% Calling Sequence: +% +% mvec = vecmag(vec) +% +% INPUT: +% +% vec : An array of column vectors represented by a matrix of +% size (dim,nv), where is the dimension of the vector and +% nv the number of vectors. +% +% OUTPUT: +% +% mvec : Magnitude of the vectors, vector of size (1,nv). +% +% Description: +% +% Determines the magnitude of the vectors. +% +% Examples: +% +% Find the magnitude of the two vectors (0.0,2.0,1.3) and (1.5,3.4,2.3) +% +% mvec = vecmag([0.0 1.5; 2.0 3.4; 1.3 2.3]); +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +mag = sqrt(sum(vec.^2)); + +end diff --git a/octave_packages/nurbs-1.3.6/vecmag2.m b/octave_packages/nurbs-1.3.6/vecmag2.m new file mode 100644 index 0000000..bba6f74 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/vecmag2.m @@ -0,0 +1,47 @@ +function mag = vecmag2(vec) +% +% VECMAG2: Squared magnitude of a set of vectors. +% +% Calling Sequence: +% +% mvec = vecmag2(vec) +% +% INPUT: +% +% vec : An array of column vectors represented by a matrix of +% size (dim,nv), where dim is the dimension of the vector and +% nv the number of vectors. +% +% OUTPUT: +% +% mvec : Squared magnitude of the vectors, vector of size (1,nv). +% +% Description: +% +% Determines the squared magnitude of the vectors. +% +% Examples: +% +% Find the squared magnitude of the two vectors (0.0,2.0,1.3) +% and (1.5,3.4,2.3) +% +% mvec = vecmag2([0.0 1.5; 2.0 3.4; 1.3 2.3]); +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +mag = sum(vec.^2); + +end diff --git a/octave_packages/nurbs-1.3.6/vecnorm.m b/octave_packages/nurbs-1.3.6/vecnorm.m new file mode 100644 index 0000000..3fae3cc --- /dev/null +++ b/octave_packages/nurbs-1.3.6/vecnorm.m @@ -0,0 +1,46 @@ +function nvec = vecnorm(vec) +% +% VECNORM: Normalise the vectors. +% +% Calling Sequence: +% +% nvec = vecnorn(vec); +% +% INPUT: +% +% vec : An array of column vectors represented by a matrix of +% size (dim,nv), where is the dimension of the vector and +% nv the number of vectors. +% +% OUTPUT: +% +% nvec : Normalised vectors, matrix the smae size as vec. +% +% Description: +% +% Normalises the array of vectors, returning the unit vectors. +% +% Examples: +% +% Normalise the two vectors (0.0,2.0,1.3) and (1.5,3.4,2.3) +% +% nvec = vecnorm([0.0 1.5; 2.0 3.4; 1.3 2.3]); +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +nvec = vec./repmat(sqrt(sum(vec.^2)),[size(vec,1) ones(1,ndims(vec)-1)]); + +end diff --git a/octave_packages/nurbs-1.3.6/vecrot.m b/octave_packages/nurbs-1.3.6/vecrot.m new file mode 100644 index 0000000..d8ed20d --- /dev/null +++ b/octave_packages/nurbs-1.3.6/vecrot.m @@ -0,0 +1,53 @@ +function rx = vecrot(angle, vector) +% +% VECROT: Transformation matrix for a rotation around the axis given by a vector. +% +% Calling Sequence: +% +% rx = vecrot (angle, vector); +% +% INPUT: +% +% angle : rotation angle defined in radians +% vector : vector defining the rotation axis +% +% OUTPUT: +% +% rx : (4x4) Transformation matrix. +% +% +% Description: +% +% Return the (4x4) Transformation matrix for a rotation about the x axis +% by the defined angle. +% +% See also: +% +% nrbtform +% +% Copyright (C) 2011 Rafael Vazquez +% +% 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 . + +% Normalize the vector +vec = vector / norm (vector); + +sn = sin (angle); +cn = cos (angle); +rx = [cn+vec(1)^2*(1-cn), vec(1)*vec(2)*(1-cn)-vec(3)*sn, vec(1)*vec(3)*(1-cn)+vec(2)*sn, 0; + vec(1)*vec(2)*(1-cn)+vec(3)*sn, cn+vec(2)^2*(1-cn), vec(2)*vec(3)*(1-cn)-vec(1)*sn, 0; + vec(1)*vec(3)*(1-cn)-vec(2)*sn, vec(2)*vec(3)*(1-cn)+vec(1)*sn, cn+vec(3)^2*(1-cn), 0; + 0 0 0 1]; + +end diff --git a/octave_packages/nurbs-1.3.6/vecrotx.m b/octave_packages/nurbs-1.3.6/vecrotx.m new file mode 100644 index 0000000..8b03721 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/vecrotx.m @@ -0,0 +1,62 @@ +function rx = vecrotx(angle) +% +% VECROTX: Transformation matrix for a rotation around the x axis. +% +% Calling Sequence: +% +% rx = vecrotx(angle); +% +% INPUT: +% +% angle : rotation angle defined in radians +% +% OUTPUT: +% +% rx : (4x4) Transformation matrix. +% +% +% Description: +% +% Return the (4x4) Transformation matrix for a rotation about the x axis +% by the defined angle. +% +% The matrix is: +% +% [ 1 0 0 0] +% [ 0 cos(angle) -sin(angle) 0] +% [ 0 sin(angle) cos(angle) 0] +% [ 0 0 0 1] +% +% Examples: +% +% Rotate the NURBS line (0.0 0.0 0.0) - (3.0 3.0 3.0) by 45 degrees +% around the x-axis +% +% line = nrbline([0.0 0.0 0.0],[3.0 3.0 3.0]); +% trans = vecrotx(%pi/4); +% rline = nrbtform(line, trans); +% +% See also: +% +% nrbtform +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +sn = sin(angle); +cn = cos(angle); +rx = [1 0 0 0; 0 cn -sn 0; 0 sn cn 0; 0 0 0 1]; + +end diff --git a/octave_packages/nurbs-1.3.6/vecroty.m b/octave_packages/nurbs-1.3.6/vecroty.m new file mode 100644 index 0000000..3ac9370 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/vecroty.m @@ -0,0 +1,62 @@ +function ry = vecroty(angle) +% +% VECROTY: Transformation matrix for a rotation around the y axis. +% +% Calling Sequence: +% +% ry = vecroty(angle); +% +% INPUT: +% +% angle : rotation angle defined in radians +% +% OUTPUT: +% +% ry : (4x4) Transformation matrix. +% +% +% Description: +% +% Return the (4x4) Transformation matrix for a rotation about the y axis +% by the defined angle. +% +% The matrix is: +% +% [ cos(angle) 0 sin(angle) 0] +% [ 0 1 0 0] +% [ -sin(angle) 0 cos(angle) 0] +% [ 0 0 0 1] +% +% Examples: +% +% Rotate the NURBS line (0.0 0.0 0.0) - (3.0 3.0 3.0) by 45 degrees +% around the y-axis +% +% line = nrbline([0.0 0.0 0.0],[3.0 3.0 3.0]); +% trans = vecroty(%pi/4); +% rline = nrbtform(line, trans); +% +% See also: +% +% nrbtform +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +sn = sin(angle); +cn = cos(angle); +ry = [cn 0 sn 0; 0 1 0 0; -sn 0 cn 0; 0 0 0 1]; + +end diff --git a/octave_packages/nurbs-1.3.6/vecrotz.m b/octave_packages/nurbs-1.3.6/vecrotz.m new file mode 100644 index 0000000..d1d2c04 --- /dev/null +++ b/octave_packages/nurbs-1.3.6/vecrotz.m @@ -0,0 +1,62 @@ +function rz = vecrotz(angle) +% +% VECROTZ: Transformation matrix for a rotation around the z axis. +% +% Calling Sequence: +% +% rz = vecrotz(angle); +% +% INPUT: +% +% angle : rotation angle defined in radians +% +% OUTPUT: +% +% rz : (4x4) Transformation matrix. +% +% +% Description: +% +% Return the (4x4) Transformation matrix for a rotation about the z axis +% by the defined angle. +% +% The matrix is: +% +% [ cos(angle) -sin(angle) 0 0] +% [ -sin(angle) cos(angle) 0 0] +% [ 0 0 1 0] +% [ 0 0 0 1] +% +% Examples: +% +% Rotate the NURBS line (0.0 0.0 0.0) - (3.0 3.0 3.0) by 45 degrees +% around the z-axis +% +% line = nrbline([0.0 0.0 0.0],[3.0 3.0 3.0]); +% trans = vecrotz(%pi/4); +% rline = nrbtform(line, trans); +% +% See also: +% +% nrbtform +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + +sn = sin(angle); +cn = cos(angle); +rz = [cn -sn 0 0; sn cn 0 0; 0 0 1 0; 0 0 0 1]; + +end diff --git a/octave_packages/nurbs-1.3.6/vecscale.m b/octave_packages/nurbs-1.3.6/vecscale.m new file mode 100644 index 0000000..4e050ec --- /dev/null +++ b/octave_packages/nurbs-1.3.6/vecscale.m @@ -0,0 +1,65 @@ +function ss = vecscale(vector) + +% +% VECSCALE: Transformation matrix for a scaling. +% +% Calling Sequence: +% +% ss = vecscale(svec) +% +% INPUT: +% +% svec : A vectors defining the scaling along the x,y and z axes. +% i.e. [sx, sy, sy] +% +% OUTPUT: +% +% ss : Scaling Transformation Matrix +% +% Description: +% +% Returns a (4x4) Transformation matrix for scaling. +% +% The matrix is: +% +% [ sx 0 0 0] +% [ 0 sy 0 0] +% [ 0 0 sz 0] +% [ 0 0 0 1] +% +% Example: +% +% Scale up the NURBS line (0.0,0.0,0.0) - (1.0,1.0,1.0) by 3 along +% the x-axis, 2 along the y-axis and 4 along the z-axis. +% +% line = nrbline([0.0 0.0 0.0],[1.0 1.0 1.0]); +% trans = vecscale([3.0 2.0 4.0]); +% sline = nrbtform(line, trans); +% +% See also: +% +% nrbtform +% +% Copyright (C) 2000 Mark Spink, 2007 Daniel Claxton +% +% 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 . + +if nargin < 1 + error('Scaling vector not specified'); +end + +s = [vector(:);0;0]; +ss = [s(1) 0 0 0; 0 s(2) 0 0; 0 0 s(3) 0; 0 0 0 1]; + +end diff --git a/octave_packages/nurbs-1.3.6/vectrans.m b/octave_packages/nurbs-1.3.6/vectrans.m new file mode 100644 index 0000000..91a634c --- /dev/null +++ b/octave_packages/nurbs-1.3.6/vectrans.m @@ -0,0 +1,65 @@ +function dd = vectrans(vector) +% +% VECTRANS: Transformation matrix for a translation. +% +% Calling Sequence: +% +% st = vectrans(tvec) +% +% INPUT: +% +% tvec : A vectors defining the translation along the x,y and +% z axes. i.e. [tx, ty, ty] +% +% OUTPUT: +% +% st : Translation Transformation Matrix +% +% Description: +% +% Returns a (4x4) Transformation matrix for translation. +% +% The matrix is: +% +% [ 1 0 0 tx ] +% [ 0 1 0 ty ] +% [ 0 0 1 tz ] +% [ 0 0 0 1 ] +% +% Examples: +% +% Translate the NURBS line (0.0,0.0,0.0) - (1.0,1.0,1.0) by 3 along +% the x-axis, 2 along the y-axis and 4 along the z-axis. +% +% line = nrbline([0.0 0.0 0.0],[1.0 1.0 1.0]); +% trans = vectrans([3.0 2.0 4.0]); +% tline = nrbtform(line, trans); +% +% See also: +% +% nrbtform +% +% Copyright (C) 2000 Mark Spink +% +% 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 . + + +if nargin < 1 + error('Translation vector required'); +end + +v = [vector(:);0;0]; +dd = [1 0 0 v(1); 0 1 0 v(2); 0 0 1 v(3); 0 0 0 1]; + +end diff --git a/octave_packages/ocs-0.1.3/asm/asm_build_system.m b/octave_packages/ocs-0.1.3/asm/asm_build_system.m new file mode 100644 index 0000000..5152fd2 --- /dev/null +++ b/octave_packages/ocs-0.1.3/asm/asm_build_system.m @@ -0,0 +1,112 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco, Culpo Massimiliano +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco +## author: culpo@math.uni-wuppertal.de + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{A},@var{Jac},@var{res}] =}@ +## asm_build_system(@var{instruct},@var{x},@var{t}) +## +## Cycle through the circuit description structure @var{instruct} +## to build the system matrices @var{A}, @var{Jac}, @var{res} for +## the current step of the Newton method. +## +## @var{x} is the current value of the state variables, while @var{t} is the current time point. +## +## See the @cite{IFF file format specifications} for details about +## the output matrices. +## +## @seealso{asm_initialize_system,prs_iff} +## +## @end deftypefn + +function [A,Jac,res] = asm_build_system(instruct,x,t); + + ## Check input + if nargin != 3 + error("asm_build_system: wrong number of input parameters."); + elseif !(isstruct(instruct) && isfield(instruct,"LCR") && + isfield(instruct,"NLC")) + error("asm_build_system: first input is not a valid structure."); + elseif !isvector(x) + error("asm_build_system: second input is not a valid vector."); + elseif !isscalar(t) + error("asm_build_system: third input is not a valid scalar."); + endif + + n = instruct.totextvar + instruct.totintvar; + A = sparse(n,n); + Jac = sparse(n,n); + res = sparse(n,1); + + + ## NLC section + nblocks = length(instruct.NLC); + + for ibl = 1:nblocks + for iel = 1:instruct.NLC(ibl).nrows + + ## Evaluate element + if instruct.NLC(ibl).nintvar(iel) + intvars = instruct.totextvar+instruct.NLC(ibl).osintvar(iel) + \ + [1:instruct.NLC(ibl).nintvar(iel)]'; + else + intvars=[]; + endif + + il = instruct.NLC(ibl).vnmatrix(iel,:)'; + nzil = find(il!=0); + + y = zeros(size(il)); + y(nzil) = x(il(nzil)); + + z = x(intvars); + + [a,b,c] = feval(instruct.NLC(ibl).func,\ + instruct.NLC(ibl).section,\ + instruct.NLC(ibl).pvmatrix(iel,:),\ + instruct.NLC(ibl).parnames,\ + y,z,t); + + ## Assemble matrices + + ## Global indexing + vars = [il(nzil);intvars]; + + ## Local indexing + lclvars = [nzil; instruct.NLC(ibl).nextvar + (1:length(intvars))' ]; + + ## Reshaping sparse stamps + a = a(lclvars,lclvars); + b = b(lclvars,lclvars); + c = reshape(c(lclvars),[],1); + + [na,ma,va] = find(a); + [nb,mb,vb] = find(b); + [nc,mc,vc] = find(c); + + ## Stamping + A += sparse(vars(na),vars(ma),va,n,n); + Jac += sparse(vars(nb),vars(mb),vb,n,n); + res += sparse(vars(nc),1,vc,n,1); + + endfor + endfor + +endfunction \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/asm/asm_initialize_system.m b/octave_packages/ocs-0.1.3/asm/asm_initialize_system.m new file mode 100644 index 0000000..f9ba5dc --- /dev/null +++ b/octave_packages/ocs-0.1.3/asm/asm_initialize_system.m @@ -0,0 +1,118 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco, Culpo Massimiliano +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco +## author: culpo@math.uni-wuppertal.de + +## -*- texinfo -*- +## +## @deftypefn{Function File} {[@var{A},@var{B},@var{C}] =}@ +## asm_initialize_system(@var{instruct},@var{x}) +## +## Cycle through the circuit description structure @var{instruct} +## to build the system matrices @var{A}, @var{B}, @var{C} for +## the linear and time-invariant part of the system. +## +## @var{x} is the current value of the state variables. +## +## See the @cite{IFF file format specifications} for details about +## the output matrices. +## +## @seealso{asm_build_system,prs_iff} +## +## @end deftypefn + +function [A,B,C] = asm_initialize_system(instruct,x); + + ## Check input + if nargin != 2 + error("asm_initialize_system: wrong number of input parameters."); + elseif !(isstruct(instruct) && isfield(instruct,"LCR") && + isfield(instruct,"NLC")) + error("asm_initialize_system: first input is not a valid structure."); + elseif !isvector(x) + error("asm_initialize_system: second input is not a valid vector."); + endif + + ## Build linear part of the system + n = instruct.totextvar + instruct.totintvar; # Number of variables + + ## Initialize to zero any state variable that is not in the input argument + lx = length(x); + if lx < n + x(lx+1:n) = 0; + endif + ## FIXME: should a warning be passed if lx != n ? + + A = sparse(n,n); + + ## LCR section + B = sparse(n,n); + C = sparse(n,1); + + nblocks = length(instruct.LCR); + + for ibl = 1:nblocks + for iel = 1:instruct.LCR(ibl).nrows + + ## Evaluate element + if instruct.LCR(ibl).nintvar(iel) + intvars = instruct.totextvar + instruct.LCR(ibl).osintvar(iel) + [1:instruct.LCR(ibl).nintvar(iel)]'; + else + intvars=[]; + endif + + il = instruct.LCR(ibl).vnmatrix(iel,:)'; + nzil = find(il!=0); + + y = zeros(size(il)); + y(nzil) = x(il(nzil)); + z = x(intvars); + + [a,b,c] = feval(instruct.LCR(ibl).func, + instruct.LCR(ibl).section, + instruct.LCR(ibl).pvmatrix(iel,:), + instruct.LCR(ibl).parnames, + y,z,0); + + ## Assemble matrices + + ## Global indexing + vars = [il(nzil);intvars]; + + ## Local indexing + lclvars = [nzil; instruct.LCR(ibl).nextvar + (1:length(intvars))' ]; + + ## Reshaping sparse stamps + a = a(lclvars,lclvars); + b = b(lclvars,lclvars); + c = reshape(c(lclvars),[],1); + + [na,ma,va] = find(a); + [nb,mb,vb] = find(b); + [nc,mc,vc] = find(c); + + ## Stamping + A += sparse(vars(na),vars(ma),va,n,n); + B += sparse(vars(nb),vars(mb),vb,n,n); + C += sparse(vars(nc),1,vc,n,1); + + endfor + endfor + +endfunction \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/asm/doc-cache b/octave_packages/ocs-0.1.3/asm/doc-cache new file mode 100644 index 0000000..55e603d --- /dev/null +++ b/octave_packages/ocs-0.1.3/asm/doc-cache @@ -0,0 +1,80 @@ +# Created by Octave 3.6.1, Sun Mar 25 17:34:24 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 2 +# name: +# type: sq_string +# elements: 1 +# length: 16 +asm_build_system + + +# name: +# type: sq_string +# elements: 1 +# length: 453 + -- Function File: [A,JAC,RES] = asm_build_system(INSTRUCT,X,T) + Cycle through the circuit description structure INSTRUCT to build + the system matrices A, JAC, RES for the current step of the Newton + method. + + X is the current value of the state variables, while T is the + current time point. + + See the `IFF file format specifications' for details about the + output matrices. + + See also: asm_initialize_system, prs_iff + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Cycle through the circuit description structure INSTRUCT to build the +system mat + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +asm_initialize_system + + +# name: +# type: sq_string +# elements: 1 +# length: 414 + -- Function File: [A,B,C] = asm_initialize_system(INSTRUCT,X) + Cycle through the circuit description structure INSTRUCT to build + the system matrices A, B, C for the linear and time-invariant part + of the system. + + X is the current value of the state variables. + + See the `IFF file format specifications' for details about the + output matrices. + + See also: asm_build_system, prs_iff + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Cycle through the circuit description structure INSTRUCT to build the +system mat + + + + + diff --git a/octave_packages/ocs-0.1.3/nls/doc-cache b/octave_packages/ocs-0.1.3/nls/doc-cache new file mode 100644 index 0000000..dca39ca --- /dev/null +++ b/octave_packages/ocs-0.1.3/nls/doc-cache @@ -0,0 +1,94 @@ +# Created by Octave 3.6.1, Sun Mar 25 17:34:24 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 2 +# name: +# type: sq_string +# elements: 1 +# length: 18 +nls_newton_raphson + + +# name: +# type: sq_string +# elements: 1 +# length: 1013 + -- Function File: [Y,NUMIT,RESNRM] = nls_newton_raphson + (Y0,RES,JAC,TOL, MAXIT,VERBOSITY,UPDATE); + Solve a non-linear system of equations using the Newton-Raphson + method with damping and return the computed solution vector Y. + + The initial guess for the algorithm is set to Y0. + + The Jacobian and residual at each step are computed via the + function handles RES and JAC. + + The variables TOL and MAXIT are the relative tolerance on the + error of the computed solution and the maximum number of + iterations to be performed by the algorithm. + + The optional parameter VERBOSITY produce verbose output if + non-zero. + + The optional function handle UPDATE may be used to provide a + faster mean to update Jacobian and residual at runtime. + + NUMIT is the number of performed iterations while RESNRM is a + vector containing the residual norm at each step. + + See also: nls_stationary, tst_backward_euler, tst_theta_method, + tst_daspk, tst_odepkg + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Solve a non-linear system of equations using the Newton-Raphson method +with damp + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +nls_stationary + + +# name: +# type: sq_string +# elements: 1 +# length: 471 + -- Function File: [OUT, NITER] = nls_stationary (INSTRUCT,X,TOL,MAXIT) + Compute the stationary state solution OUT of the system described + by INSTRUCT. + + X is the initial guess used by the Newton-Raphson algorithm + implemented in `nls_newton_raphson', while TOL and MAXIT are the + corresponding parameters. + + The optional output NITER returns the number of Newton iterations + needed to reach convergence. + + See also: nls_newton_raphson + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 78 +Compute the stationary state solution OUT of the system described by +INSTRUCT. + + + + + diff --git a/octave_packages/ocs-0.1.3/nls/nls_newton_raphson.m b/octave_packages/ocs-0.1.3/nls/nls_newton_raphson.m new file mode 100644 index 0000000..296df36 --- /dev/null +++ b/octave_packages/ocs-0.1.3/nls/nls_newton_raphson.m @@ -0,0 +1,110 @@ +## Copyright (C) 2006-2009 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco +## author: Massimiliano Culpo + +## -*- texinfo -*- +## @deftypefn{Function File}{[@var{y},@var{numit},@var{resnrm}] =} @ +## nls_newton_raphson (@var{y0},@var{RES},@var{JAC},@var{tol},@ +## @var{maxit},@var{verbosity},@var{update}); +## +## Solve a non-linear system of equations using the Newton-Raphson +## method with damping and return the computed solution vector @var{y}. +## +## The initial guess for the algorithm is set to @var{y0}. +## +## The Jacobian and residual at each step are computed via the function +## handles @var{RES} and @var{JAC}. +## +## The variables @var{tol} and @var{maxit} are the relative tolerance on the +## error of the computed solution and the maximum number of iterations to be +## performed by the algorithm. +## +## The optional parameter @var{verbosity} produce verbose output if non-zero. +## +## The optional function handle @var{update} may be used to provide +## a faster mean to update Jacobian and residual at runtime. +## +## @var{numit} is the number of performed iterations while @var{resnrm} +## is a vector containing the residual norm at each step. +## +## @seealso{nls_stationary,tst_backward_euler,tst_theta_method,tst_daspk,tst_odepkg} +## @end deftypefn + +function [y,ii,resnrm] = nls_newton_raphson(y0,RES,JAC,tol,maxit,\ + verbosity,update); + + ## Check input + ## FIXME: add input check! + if ((nargin < 5) || (nargin > 7)) + error("nls_newton_raphson: wrong number of input parameters."); + endif + + if ~exist("verbosity") + verbosity = 0; + endif + + if ~exist("update") + update = @(x) ({}); + endif + + jjtot = 0; + y = y0; + + uptodate = update(y); + res_y = RES(y,uptodate{:}); + resnrm(1) = norm(res_y,inf); + + for ii = 1:maxit + + jac_y = JAC(y,uptodate{:}); + ynew = jac_y\(-res_y+jac_y*y); + uptodate = update(ynew); + res_y = RES(ynew,uptodate{:}); + + resnrm(ii+1) = norm(res_y,inf); + + jj = 0; + while ((resnrm(ii+1)>resnrm(ii))&&(jj<10)) + jj++; + damp = 2^(-jj); + ynew = y*(1-damp) + ynew*damp; + uptodate = update(ynew); + res_y = RES(ynew,uptodate{:}); + resnrm(ii+1) = norm(res_y,inf); + endwhile + + jjtot += jj; + y = ynew; + + if resnrm(ii+1). +## +## author: Carlo de Falco + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{out}, @var{niter}]} = nls_stationary @ +## (@var{instruct},@var{x},@var{tol},@var{maxit}) +## Compute the stationary state solution @var{out} of the system described +## by @var{instruct}. +## +## @var{x} is the initial guess used by the Newton-Raphson algorithm implemented in +## @code{nls_newton_raphson}, while @var{tol} and @var{maxit} are the corresponding +## parameters. +## +## The optional output @var{niter} returns the number of Newton iterations +## needed to reach convergence. +## +## @seealso{nls_newton_raphson} +## @end deftypefn + +function [out, varargout] = nls_stationary(outstruct,x,tol,maxit) + + ## Check input + ## FIXME: add input check! + if nargin != 4 + error("nls_stationary: wrong number of input parameters."); + endif + + [A0,B,C] = asm_initialize_system(outstruct,x); + JAC = @(x) TSTSTATFUNJAC(outstruct,x,B); + RES = @(x) TSTSTATFUNRES(outstruct,x,B,C); + UPD = @(x) TSTSTATUP(outstruct,x); + [out,ii,resnrm] = nls_newton_raphson(x,RES,JAC,tol,maxit,0,UPD); + + if nargin > 1 + varargout{1} = ii; + endif + +endfunction + +## Jacobian for steady state problems +function lhs = TSTSTATFUNJAC(outstruct,x,B,Jac,res) + + if nargin < 5 + [A1,Jac,res] = asm_build_system(outstruct,x,0); + endif + lhs = (B + Jac); + +endfunction +## Residual for steady state problem +function rhs = TSTSTATFUNRES(outstruct,x,B,C,Jac,res) + + if nargin < 6 + [A1,Jac,res] = asm_build_system(outstruct,x,0); + endif + rhs = (res + C + B*x); + +endfunction +## Update for transient problem +function update = TSTSTATUP(outstruct,x) + + [A1,Jac,res] = asm_build_system(outstruct,x,0); + update = {Jac,res}; + +endfunction \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/packinfo/.autoload b/octave_packages/ocs-0.1.3/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/ocs-0.1.3/packinfo/DESCRIPTION b/octave_packages/ocs-0.1.3/packinfo/DESCRIPTION new file mode 100644 index 0000000..bad967b --- /dev/null +++ b/octave_packages/ocs-0.1.3/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: OCS +Version: 0.1.3 +Date: 2011-08-08 +Author: Carlo de Falco, Culpo Massimiliano, Marco Merlin +Maintainer: Culpo Massimiliano +Title: Octave Circuit Simulator +Description: Package for solving DC and transient electrical circuit equations +Depends: octave (>= 3.0.0), odepkg +Autoload: yes +License: GPL version 2 or later +SVNRelease: 9554 diff --git a/octave_packages/ocs-0.1.3/packinfo/INDEX b/octave_packages/ocs-0.1.3/packinfo/INDEX new file mode 100644 index 0000000..51d0e2d --- /dev/null +++ b/octave_packages/ocs-0.1.3/packinfo/INDEX @@ -0,0 +1,28 @@ +OCS >> Octave Circuit Simulator +Matrix Assembly Functions + asm_initialize_system + asm_build_system +Netlist Parsing Functions + prs_iff +Time Stepping Functions + tst_backward_euler + tst_daspk + tst_theta_method + tst_odepkg +Non Linear Solvers + nls_stationary + nls_newton_raphson +UTiLity Functions + utl_plot_by_name + utl_sbn_server +SuBNet Function Library + Mcapacitors + Mcurrentsources + Mdiode + Minductors + Mnmosfet + Mpmosfet + Mresistors + Mshichmanhodgesmosfet + Mvoltagesources + diff --git a/octave_packages/ocs-0.1.3/prs/doc-cache b/octave_packages/ocs-0.1.3/prs/doc-cache new file mode 100644 index 0000000..f028b3e --- /dev/null +++ b/octave_packages/ocs-0.1.3/prs/doc-cache @@ -0,0 +1,193 @@ +# Created by Octave 3.6.1, Sun Mar 25 17:34:24 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 2 +# name: +# type: sq_string +# elements: 1 +# length: 7 +prs_iff + + +# name: +# type: sq_string +# elements: 1 +# length: 1823 + -- Function File: OUTSTRUCT = prs_iff(NAME) + Parse a netlist in IFF format and produce the system description + structure OUTSTRUCT. + + NAME is the basename of the CIR and NMS files to be parsed. + + See the `IFF file format specifications' (distributed together + with the OCS package) for more details on the file format. + + OUTSTRUCT has the following fields: + + outstruct = + { + LCR: struct % the fields of LCR are shown below + NLC: struct % NLC has the same fields as LCR + namesn: matrix % numbers of vars named in .nms file + namess: cell % the names corresponding to the vars above + totextvar: scalar % the total number of external variables + totintvar: scalar % the total number of internal variables + } + + outstruct.LCR = + outstruct.NLC = + { + struct array containing the fields: % array has one element per block + + func % name of the sbn file corresponding to each block + section % string parameter to be passed to the sbn files + nextvar % number of external variables for each element of the block + vnmatrix % numbers of the external variables of each element + nintvar % number of internal variables for each element of the block + osintvar % number of the first internal variable + npar % number of parameters + nparnames% number of parameter names + nrows % number of rows in the block + parnames % list of parameter names + pvmatrix % list of parameter values for each element + + } + + See the `IFF file format specifications' for details about the + output structures. + + See also: prs_spice + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Parse a netlist in IFF format and produce the system description +structure OUTST + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +prs_spice + + +# name: +# type: sq_string +# elements: 1 +# length: 2554 + -- Function File: [STUCT] = prs_spice (FILENAME) + Circuit file parser that can interpret a subset of the spice file + format. + + `prs_spice' currently supports the following set of "Element Cards" + - Capacitors: + Cname n+ n- cvalue + + - Diodes: + Cname anode knode modelname + + - MOS: + Mname gnode dnode snode bnode modelname + + N.B.: one instance of a MOS element MUST be preceeded + (everywhere in the file) by the declaration of the related + model. For instance: + .MODEL mynmos NMOS( k=1e-4 Vth=0.1 rd=1e6) + M2 Vgate 0 Vdrain 0 mynmos + + - Resistors: + Rname n+ n- rvalue + + - Voltage sources: + Vname n+ n- + + Transvalue specifies a transient voltage source + SIN(VO VA FREQ TD THETA) + where: + * VO (offset) + + * VA (amplitude) + + * FREQ (frequency) + + * TD (delay) + + * THETA (damping factor) + + * 0 to TD: V0 + + * TD to TSTOP: VO + + VA*exp(-(time-TD)*THETA)*sine(twopi*FREQ*(time+TD)) + + Currently the damping factor has no effect. + + Pulse + PULSE(V1 V2 TD TR TF PW PER) + + parameters meaning + * V1 (initial value) + + * V2 (pulsed value) + + * TD (delay time) + + * TR (rise time) + + * TF (fall time) + + * PW (pulse width) + + * PER (period) + + Currently rise and fall time are not implemented yet. + + - .MODEL cards Defines a model for semiconductor devices + + .MODEL MNAME TYPE(PNAME1=PVAL1 PNAME2=PVAL2 ... ) + + TYPE can be: + * NMOS N-channel MOSFET model + + * PMOS P-channel MOSFET model + + * D diode model + + The parameter "LEVEL" is currently assigned to the field + "section" in the call of the element functions by the solver. + Currently supported values for the parameter LEVEL for NMOS + and PMOS are: + * simple + + * lincap + (see documentation of function Mdiode). + + Currently supported values for the parameter LEVEL for D are: + * simple + (see documentation of functions Mnmosfet and Mpmosfet). + + + See also: prs_iff, Mdiode, Mnmosfet, Mpmosfet + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 +Circuit file parser that can interpret a subset of the spice file +format. + + + + + diff --git a/octave_packages/ocs-0.1.3/prs/prs_iff.m b/octave_packages/ocs-0.1.3/prs/prs_iff.m new file mode 100644 index 0000000..1d3df5d --- /dev/null +++ b/octave_packages/ocs-0.1.3/prs/prs_iff.m @@ -0,0 +1,312 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## 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 OCS; If not, see . +## +## author: Carlo de Falco +## author: Massimiliano Culpo + +## -*- texinfo -*- +## @deftypefn{Function File} @var{outstruct} = prs_iff(@var{name}) +## Parse a netlist in IFF format and produce the system description +## structure @var{outstruct}. +## +## @var{name} is the basename of the CIR and NMS files to +## be parsed. +## +## See the @cite{IFF file format specifications} (distributed together +## with the OCS package) for more details on the file format. +## +## @var{outstruct} has the following fields: +## +## @example +## outstruct = +## @{ +## LCR: struct % the fields of LCR are shown below +## NLC: struct % NLC has the same fields as LCR +## namesn: matrix % numbers of vars named in .nms file +## namess: cell % the names corresponding to the vars above +## totextvar: scalar % the total number of external variables +## totintvar: scalar % the total number of internal variables +## @} +## +## outstruct.LCR = +## outstruct.NLC = +## @{ +## struct array containing the fields: % array has one element per block +## +## func % name of the sbn file corresponding to each block +## section % string parameter to be passed to the sbn files +## nextvar % number of external variables for each element of the block +## vnmatrix % numbers of the external variables of each element +## nintvar % number of internal variables for each element of the block +## osintvar % number of the first internal variable +## npar % number of parameters +## nparnames% number of parameter names +## nrows % number of rows in the block +## parnames % list of parameter names +## pvmatrix % list of parameter values for each element +## +## @} +## @end example +## +## See the @cite{IFF file format specifications} for details about +## the output structures. +## @seealso{prs_spice} +## @end deftypefn + +function outstruct = prs_iff(name) + + ## Check input + if (nargin != 1 || !ischar(name)) + error("prs_iff: wrong input.") + endif + + ## Initialization + version ="0.1b1"; + outstruct = struct("NLC",[],\ + "LCR",[],\ + "totextvar",0); + + ## Open cir file + filename = [name ".cir"]; + if isempty(file_in_path(".",filename)) + error(["prs_iff: .cir file not found:" filename]); + endif + fid = fopen(filename,"r"); + + ## Check version + ## FIXME: this part can be improved a lot!! + line = fgetl(fid); + + if line(1)!="%" + error(["prs_iff: missing version number in file " filename]); + endif + + if ~strcmp(version,sscanf(line(2:end),"%s")); + error(["prs_iff: conflicting version number in file " filename]); + endif + + ndsvec = []; # Vector of circuit nodes + intvar = 0; # Number of internal variables + + ## NLC section + NLCcount = 0; + while !strcmp(line,"END") + + ## Skip comments + while line(1)=="%" + line = fgetl(fid); + endwhile + + if strcmp(line,"END") + break + else + NLCcount++; + endif + + ## parse NLC block + [outstruct,intvar] = parseNLCblock(fid,line,outstruct,NLCcount,intvar); + + ndsvec = [ndsvec ; \ + outstruct.NLC(NLCcount).vnmatrix(:)]; + + ## skip the newline char after the matrix + line = fgetl(fid); + + ## proceed to next line + line = fgetl(fid); + + endwhile + + ## LCR section + LCRcount = 0; + line = fgetl(fid); + + while (!strcmp(line,"END")) + + ## Skip comments + while line(1)=="%" + line = fgetl(fid); + endwhile + + if strcmp(line,"END") + break + else + LCRcount++; + endif + + ## parse block header + [outstruct,intvar] = parseLCRblock(fid,line,outstruct,LCRcount,intvar); + + ndsvec = [ndsvec ; \ + outstruct.LCR(LCRcount).vnmatrix(:)]; + + ## skip the newline char after the matrix + line = fgetl(fid); + + ## proceed to next line + line = fgetl(fid); + + endwhile + + ## Set the number of internal and external variables + outstruct.totintvar = intvar; + nnodes = length(unique(ndsvec)); + maxidx = max(ndsvec); + + if nnodes <= (maxidx+1) + ## If the valid file is a subcircuit it may happen + ## that nnodes == maxidx, otherwise nnodes == (maxidx+1) + outstruct.totextvar = max(ndsvec); + else + error("prs_iff: hanging nodes in circuit %s",name); + endif + ## fclose cir file + fclose(fid); + + ## Open nms file + filename = [name ".nms"]; + if isempty(file_in_path(".",filename)) + error(["prs_iff: .nms file not found:" filename]); + endif + fid = fopen(filename,"r"); + + ## Check version + line = fgetl(fid); + + if line(1)~="%" + error(["prs_iff: missing version number in file " filename]); + endif + + if ~strcmp(version,sscanf(line(2:end),"%s")); + error(["prs_iff: conflicting version number in file " filename]); + endif + + ## Initialization + cnt = 1; + outstruct.namesn = []; + outstruct.namess = {}; + nnames = 0; + + while cnt + [nn,cnt] = fscanf(fid,"%d","C"); + [ns,cnt] = fscanf(fid,"%s","C"); + + if cnt + outstruct.namesn(++nnames)=nn; + outstruct.namess{nnames}=ns; + endif + endwhile + + ## fclose nms file + fclose(fid); + +endfunction + + +############################################## +function [outstruct,intvar] = parseNLCblock(fid,line,outstruct,NLCcount,intvar); + + ## Parse first line of the header and retrieve: + ## 1 - SBN function name + ## 2 - Section + ## 3 - Number of external variables + ## 4 - Number of parameters + [func,section,nextvar,npar] = sscanf(line,"%s %s %g %g","C"); + outstruct.NLC(NLCcount).func = func; + outstruct.NLC(NLCcount).section = section; + outstruct.NLC(NLCcount).nextvar = nextvar; + outstruct.NLC(NLCcount).npar = npar; + ## Parse second line of the header and retrieve: + ## 1 - Number of elements of this type + ## 2 - Number of parameter names to be parsed + [nrows,nparnames] = fscanf(fid,"%g %g","C"); + outstruct.NLC(NLCcount).nrows = nrows; + outstruct.NLC(NLCcount).nparnames = nparnames; + outstruct.NLC(NLCcount).parnames = {}; + for ii=1:nparnames + outstruct.NLC(NLCcount).parnames{ii} = fscanf(fid,"%s","C"); + endfor + + ## Parse the matrix containing the values of parameters + [outstruct.NLC(NLCcount).pvmatrix] = fscanf(fid,"%g",[npar,nrows])'; + + ## Parse the connectivity matrix + [outstruct.NLC(NLCcount).vnmatrix] = fscanf(fid,"%g",[nextvar,nrows])'; + + ## Compute internal variables cycling over each + ## element in the section + for iel = 1:nrows + [a,b,c] = feval(func,section,outstruct.NLC(NLCcount).pvmatrix(iel,:),\ + outstruct.NLC(NLCcount).parnames,zeros(nextvar,1),[],0); + + ## FIXME: if all the element in the same section share the + ## same number of internal variables, the for cycle can be + ## substituted by only one call + outstruct.NLC(NLCcount).nintvar(iel) = columns(a) - outstruct.NLC(NLCcount).nextvar; + outstruct.NLC(NLCcount).osintvar(iel) = intvar; + + intvar += outstruct.NLC(NLCcount).nintvar(iel); + endfor + +endfunction + +############################################## +function [outstruct,intvar] = parseLCRblock(fid,line,outstruct,LCRcount,intvar); + + ## Parse first line of the header and retrieve: + ## 1 - SBN function name + ## 2 - Section + ## 3 - Number of external variables + ## 4 - Number of parameters + [func,section,nextvar,npar] = sscanf(line,"%s %s %g %g","C"); + outstruct.LCR(LCRcount).func = func; + outstruct.LCR(LCRcount).section = section; + outstruct.LCR(LCRcount).nextvar = nextvar; + outstruct.LCR(LCRcount).npar = npar; + ## Parse second line of the header and retrieve: + ## 1 - Number of elements of this type + ## 2 - Number of parameter names to be parsed + [nrows,nparnames] = fscanf(fid,"%g %g","C"); + outstruct.LCR(LCRcount).nrows = nrows; + outstruct.LCR(LCRcount).nparnames = nparnames; + outstruct.LCR(LCRcount).parnames = {}; + for ii=1:nparnames + outstruct.LCR(LCRcount).parnames{ii} = fscanf(fid,"%s","C"); + endfor + + ## Parse the matrix containing the values of parameters + [outstruct.LCR(LCRcount).pvmatrix] = fscanf(fid,"%g",[npar,nrows])'; + + ## Parse the connectivity matrix + [outstruct.LCR(LCRcount).vnmatrix] = fscanf(fid,"%g",[nextvar,nrows])'; + + ## Compute internal variables cycling over each + ## element in the section + for iel = 1:nrows + [a,b,c] = feval(func,section,outstruct.LCR(LCRcount).pvmatrix(iel,:),\ + outstruct.LCR(LCRcount).parnames,zeros(nextvar,1),[],0); + + ## FIXME: if all the element in the same section share the + ## same number of internal variables, the for cycle can be + ## substituted by only one call + outstruct.LCR(LCRcount).nintvar(iel) = columns(a) - outstruct.LCR(LCRcount).nextvar; + outstruct.LCR(LCRcount).osintvar(iel) = intvar; + + intvar += outstruct.LCR(LCRcount).nintvar(iel); + endfor + +endfunction \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/prs/prs_spice.m b/octave_packages/ocs-0.1.3/prs/prs_spice.m new file mode 100644 index 0000000..35e6d27 --- /dev/null +++ b/octave_packages/ocs-0.1.3/prs/prs_spice.m @@ -0,0 +1,1127 @@ +## Copyright (C) 2012 Marco Merlin +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can 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. +## +## OCS is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with OCS; If not, see . +## +## author: Marco Merlin +## based on prs_iff which is (C) Carlo de Falco and Massimiliano Culpo + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{stuct}]} = prs_spice (@var{filename}) +## +## Circuit file parser that can interpret a subset of the spice file format. +## +## @code{prs_spice} currently supports the following set of "Element Cards" +## @itemize @minus +## @item Capacitors: +## @example +## Cname n+ n- cvalue +## @end example +## +## @item Diodes: +## @example +## Cname anode knode modelname +## @end example +## +## @item MOS: +## @example +## Mname gnode dnode snode bnode modelname +## @end example +## +## N.B.: one instance of a MOS element MUST be preceeded (everywhere in the file) by the declaration of the related model. +## For instance: +## @example +## .MODEL mynmos NMOS( k=1e-4 Vth=0.1 rd=1e6) +## M2 Vgate 0 Vdrain 0 mynmos +## @end example +## +## @item Resistors: +## @example +## Rname n+ n- rvalue +## @end example +## +## @item Voltage sources: +## @example +## Vname n+ n- +## @end example +## +## Transvalue specifies a transient voltage source +## @example +## SIN(VO VA FREQ TD THETA) +## @end example +## where: +## @itemize @bullet +## @item VO (offset) +## @item VA (amplitude) +## @item FREQ (frequency) +## @item TD (delay) +## @item THETA (damping factor) +## @end itemize +## +## @itemize @bullet +## @item 0 to TD: V0 +## @item TD to TSTOP: +## VO + VA*exp(-(time-TD)*THETA)*sine(twopi*FREQ*(time+TD)) +## @end itemize +## +## Currently the damping factor has no effect. +## +## Pulse +## @example +## PULSE(V1 V2 TD TR TF PW PER) +## @end example +## +## parameters meaning +## @itemize @bullet +## @item V1 (initial value) +## @item V2 (pulsed value) +## @item TD (delay time) +## @item TR (rise time) +## @item TF (fall time) +## @item PW (pulse width) +## @item PER (period) +## @end itemize +## +## Currently rise and fall time are not implemented yet. +## +## @item .MODEL cards +## Defines a model for semiconductor devices +## +## @example +## .MODEL MNAME TYPE(PNAME1=PVAL1 PNAME2=PVAL2 ... ) +## @end example +## +## TYPE can be: +## @itemize @bullet +## @item NMOS N-channel MOSFET model +## @item PMOS P-channel MOSFET model +## @item D diode model +## @end itemize +## +## The parameter "LEVEL" is currently assigned to the field "section" in the call +## of the element functions by the solver. +## Currently supported values for the parameter LEVEL for NMOS and PMOS are: +## @itemize @bullet +## @item simple +## @item lincap +## @end itemize +## (see documentation of function Mdiode). +## +## Currently supported values for the parameter LEVEL for D are: +## @itemize @bullet +## @item simple +## @end itemize +## (see documentation of functions Mnmosfet and Mpmosfet). +## +## @end itemize +## @seealso{prs_iff,Mdiode,Mnmosfet,Mpmosfet} +## @end deftypefn + +function outstruct = prs_spice (name) + + ## Check input + if (nargin != 1 || !ischar (name)) + error ("prs_spice: wrong input.") + endif + + ## Initialization + + outstruct = struct ("LCR", [], + "NLC", [], + "totextvar", 0); + + global ndsvec; # Vector of circuit nodes + global nodes_list; + global intvar_list; + global models_list; + + ndsvec = []; + outstruct.totintvar = 0; # Number of internal variables + + count = struct ("NLC", struct ("n", 0, + "list", {""}), + "LCR", struct ("n", 0, + "list", {""})); + nodes_list = {"0"}; + intvar_list = {}; + models_list = struct ("mname", {""}, + "melement", {""}, + "msection", {""}); + + ## File parsing + + ## Open circuit file + filename = [name ".spc"]; + if (exist (filename) != 2) ## isempty (file_in_path (".", filename)) + error (["prs_spice: .spc file not found:" filename]); + endif + fid = fopen (filename, "r"); + + if (fid>-1) + line = ''; + fullline = ''; + lineCounter = 0; + while (! feof (fid)) + line = strtrim (line); + + %% exclude empty lines + if length (line) + %% exclude comments + if (! strncmpi (line, '*', 1)) + %% lines here aren't comments + if (strncmpi (line, '+', 1)) + %% this line has to be concatenated to previous one + line (1) = ' '; + fullline = [fullline line]; + else + %% these lines are not a concatenation + + %% line echo for debug + %# disp (fullline); + + %% compute fullline here! + %#[outstruct, intvar, count] = lineParse (upper (fullline), outstruct, count, intvar); + + %# NB: case-sensitive because of parameter names + %#[outstruct, intvar, count] = lineParse (fullline, outstruct, intvar, count); + [outstruct, count] = lineParse (fullline, outstruct, count); + + fullline = line; + end %if (strncmpi (line, '+', 1)) + end %if (~strncmpi (line, '*', 1)) + end % if length (line) + line = fgets (fid); + lineCounter = lineCounter+1; + end % while ~feof (fid) + + %% parse last line + if length (fullline) + ## NB: case-sensitive because of parameter names + %#[outstruct, intvar, count] = lineParse (upper (fullline), outstruct, count, intvar); + %#[outstruct, intvar, count] = lineParse (fullline, outstruct, intvar, count); + [outstruct, count] = lineParse (fullline, outstruct, count); + end + fclose (fid); + else + error ('Input file not found!'); + end + + + ## Set the number of internal and external variables + nnodes = length (unique (ndsvec)); + maxidx = max (ndsvec); + + if (nnodes <= (maxidx+1)) + ## If the valid file is a subcircuit it may happen + ## that nnodes == maxidx, otherwise nnodes == (maxidx+1) + outstruct.totextvar = max (ndsvec); + else + error ("prs_spice: hanging nodes in circuit %s", name); + endif + + ## set node names as variable names + for ii = 1:length (nodes_list) + outstruct.namesn (ii) = ii-1; + endfor + outstruct.namess = horzcat (nodes_list, intvar_list); + ##outstruct.namess + + ##outstruct.totintvar +endfunction + +## NLC block intvar count update +function outstruct = NLCintvar (outstruct, NLCcount, name) + + global ndsvec; + global intvar_list; + + ## set node names for NLC subcircuit + ##for NLCcount = 1:count.NLC.n; + ##NLCcount = count.NLC.n; + ## set vnmatrix for NLC subcircuit + ndsvec = [ndsvec ; + outstruct.NLC(NLCcount).vnmatrix(:)]; + ## Compute internal variables cycling over each + ## element in the section + ##for iel = 1:outstruct.NLC(NLCcount).nrows + iel = outstruct.NLC(NLCcount).nrows; + [a, b, c] = feval (outstruct.NLC(NLCcount).func, + outstruct.NLC(NLCcount).section, + outstruct.NLC(NLCcount).pvmatrix(iel, :), + outstruct.NLC(NLCcount).parnames, + zeros (outstruct.NLC(NLCcount).nextvar, 1), + [], + 0); + + ## FIXME: if all the element in the same section share the + ## same number of internal variables, the for cycle can be + ## substituted by only one call + outstruct.NLC(NLCcount).nintvar(iel) = columns (a) - outstruct.NLC(NLCcount).nextvar; + outstruct.NLC(NLCcount).osintvar(iel) = outstruct.totintvar; + + outstruct.totintvar += outstruct.NLC(NLCcount).nintvar(iel); + if outstruct.NLC(NLCcount).nintvar(iel)>0 + intvar_list{outstruct.totintvar} = ["I(" name ")"]; + endif + ##endfor + ##endfor # NLCcount = 1:count.NLC.n; +endfunction + +## LCR block intvar count update +function outstruct = LCRintvar (outstruct, LCRcount, name) + global ndsvec; + global intvar_list; + ## set node names for LCR subcircuit + ## for LCRcount = 1:count.LCR.n; + ## LCRcount = count.LCR.n; + ## set vnmatrix for LCR subcircuit + ndsvec = [ndsvec ; + outstruct.LCR(LCRcount).vnmatrix(:)]; + + ## Compute internal variables cycling over each + ## element in the section + ##for iel = 1:outstruct.LCR(LCRcount).nrows + iel = outstruct.LCR(LCRcount).nrows; + [a, b, c] = feval (outstruct.LCR(LCRcount).func, + outstruct.LCR(LCRcount).section, + outstruct.LCR(LCRcount).pvmatrix(iel, :), + outstruct.LCR(LCRcount).parnames, + zeros(outstruct.LCR(LCRcount).nextvar, 1), + [], + 0); + + ## FIXME: if all the element in the same section share the + ## same number of internal variables, the for cycle can be + ## substituted by only one call + outstruct.LCR(LCRcount).nintvar(iel) = columns (a) - outstruct.LCR(LCRcount).nextvar; + ##outstruct.LCR(LCRcount).osintvar(iel) = intvar; + outstruct.LCR(LCRcount).osintvar(iel) = outstruct.totintvar; + + ##intvar += outstruct.LCR(LCRcount).nintvar(iel); + outstruct.totintvar += outstruct.LCR(LCRcount).nintvar(iel); + if outstruct.LCR(LCRcount).nintvar(iel)>0 + intvar_list{outstruct.totintvar} = ["I(" name ")"]; + endif + ##endfor + ## endfor # LCRcount = 1:count.LCR.n; +endfunction + +## Parses a single line +function [outstruct, count] = lineParse (line, outstruct, count) + if length (line) + switch (line (1)) + case 'B' + case 'C' + [outstruct, count] = prs_spice_C (line, outstruct, count); + case 'D' + [outstruct, count] = prs_spice_D (line, outstruct, count); + case 'E' + ##mspINP2E (line, lineCounter); + case 'F' + ##mspINP2F (line, lineCounter); + case 'G' + ##mspINP2G (line, lineCounter); + case 'H' + ##mspINP2H (line, lineCounter); + case 'I' + ##mspINP2I (line, lineCounter); + case 'J' + case 'K' + ##mspINP2K (line, lineCounter); + case 'L' + ##mspINP2L (line, lineCounter); + case 'M' + ## FIXME: just for nMOS devices! + [outstruct, count] = prs_spice_M (line, outstruct, count); + ## case 'P' + ## temporarily assigned to pMOS devices. + ##[outstruct, count] = prs_spice_P (line, outstruct, count); + case 'Q' + case 'R' + [outstruct, count] = prs_spice_R (line, outstruct, count); + case 'S' + case 'T' + case 'U' + case 'V' + [outstruct, count] = prs_spice_V (line, outstruct, count); + case 'W' + case 'X' + case 'Z' + case '.' + [outstruct, count] = prs_spice_dot (line, outstruct, count); + otherwise + warn = sprintf (['prs_spice: Unsupported circuit element in line: ' line ]); + warning (warn); + end % switch (line (1)) + end %if length (line) + +endfunction + +## adds an NLC element to outstruct +function [outstruct, count] = addNLCelement (outstruct, count, element, section, nextvar, npar, nparnames, parnames, vnmatrix, pvmatrix) + ## check whether the element type already exists in output structure + ## the search key is (func, section) + ##[tf, idx] = ismember ({element}, count.NLC.list); + ##if !tf + ## the element still does not exist + ## update counters + count.NLC.n++; + count.NLC.list{count.NLC.n} = element; + + ## if the element doesn't exists, add it to the output structure + outstruct.NLC(count.NLC.n).func = element; + outstruct.NLC(count.NLC.n).section = section; + outstruct.NLC(count.NLC.n).nextvar = nextvar; + outstruct.NLC(count.NLC.n).npar = npar; + outstruct.NLC(count.NLC.n).nrows = 1; + outstruct.NLC(count.NLC.n).nparnames = nparnames; + outstruct.NLC(count.NLC.n).parnames = parnames; + outstruct.NLC(count.NLC.n).vnmatrix = vnmatrix; + outstruct.NLC(count.NLC.n).pvmatrix = pvmatrix; + ##else + ## found = 0; + ## for ii = 1:length (idx) + ## if strcmp (outstruct.NLC(idx(ii)).section, section) + ## found = 1; + ## break; + ## endif #!strcmp (outstruct.NLC(idx(ii)).section, section) + ## endfor #ii = 1:length (idx) + + ## if !found + ## the section does not exist + + ## the element still does not exist + ## update counters + ## count.NLC.n++; + ## count.NLC.list{count.NLC.n} = element; + + ## if the element doesn't exists, add it to the output structure + ## outstruct.NLC(count.NLC.n).func = element; + ## outstruct.NLC(count.NLC.n).section = section; + ## outstruct.NLC(count.NLC.n).nextvar = nextvar; + ## outstruct.NLC(count.NLC.n).npar = npar; + ## outstruct.NLC(count.NLC.n).nrows = 1; + ## outstruct.NLC(count.NLC.n).nparnames = nparnames; + ## outstruct.NLC(count.NLC.n).parnames = parnames; + ## outstruct.NLC(count.NLC.n).vnmatrix = vnmatrix; + ## outstruct.NLC(count.NLC.n).pvmatrix = pvmatrix; + + ## else + ## the couple (element, section) already exists, so add a row in the structure + ## add an element to the structure + ## outstruct.NLC(idx(ii)).nrows++; + + ## update parameter value and connectivity matrix + ## [outstruct.NLC(idx(ii)).vnmatrix] = [outstruct.NLC(idx(ii)).vnmatrix; vnmatrix]; + ## [outstruct.NLC(idx(ii)).pvmatrix] = [outstruct.NLC(idx(ii)).pvmatrix; pvmatrix]; + ## endif + ##endif +endfunction + +## adds an LCR element to outstruct +function [outstruct, count] = addLCRelement (outstruct, count, element, section, nextvar, npar, nparnames, parnames, vnmatrix, pvmatrix) + ## check whether the element type already exists in output structure + ## the search key is (func, section) + [tf, idx] = ismember ({element}, count.LCR.list); + if !tf + ## the element still does not exist + ## update counters + count.LCR.n++; + count.LCR.list{count.LCR.n} = element; + + ## if the element doesn't exists, add it to the output structure + outstruct.LCR(count.LCR.n).func = element; + outstruct.LCR(count.LCR.n).section = section; + outstruct.LCR(count.LCR.n).nextvar = nextvar; + outstruct.LCR(count.LCR.n).npar = npar; + outstruct.LCR(count.LCR.n).nrows = 1; + outstruct.LCR(count.LCR.n).nparnames = nparnames; + outstruct.LCR(count.LCR.n).parnames = parnames; + outstruct.LCR(count.LCR.n).vnmatrix = vnmatrix; + outstruct.LCR(count.LCR.n).pvmatrix = pvmatrix; + else + found = 0; + for ii = 1:length (idx) + if strcmp (outstruct.LCR(idx(ii)).section, section) + found = 1; + break; + endif #!strcmp (outstruct.LCR(idx(ii)).section, section) + endfor #ii = 1:length (idx) + + if (! found) + ## the section does not exist + + ## the element still does not exist + ## update counters + count.LCR.n++; + count.LCR.list{count.LCR.n} = element; + + ## if the element doesn't exists, add it to the output structure + outstruct.LCR(count.LCR.n).func = element; + outstruct.LCR(count.LCR.n).section = section; + outstruct.LCR(count.LCR.n).nextvar = nextvar; + outstruct.LCR(count.LCR.n).npar = npar; + outstruct.LCR(count.LCR.n).nrows = 1; + outstruct.LCR(count.LCR.n).nparnames = nparnames; + outstruct.LCR(count.LCR.n).parnames = parnames; + outstruct.LCR(count.LCR.n).vnmatrix = vnmatrix; + outstruct.LCR(count.LCR.n).pvmatrix = pvmatrix; + + else + ## the couple (element, section) already exists, so add a row in the structure + ## add an element to the structure + outstruct.LCR(idx(ii)).nrows++; + + ## update parameter value and connectivity matrix + [outstruct.LCR(idx(ii)).vnmatrix] = [outstruct.LCR(idx(ii)).vnmatrix; vnmatrix]; + [outstruct.LCR(idx(ii)).pvmatrix] = [outstruct.LCR(idx(ii)).pvmatrix; pvmatrix]; + endif + endif +endfunction + +## converts a blank separated values string into a cell array +function ca = str2ca (str) + ca = regexpi (str, '[^ \s=]+', 'match'); +endfunction + +## replaces the tokens c_old with c_new in string inString +function outString = strReplace (inString, c_old, c_new) + outString = inString; + l = length (c_new); + for idx = 1:length (c_old) + if (idx<=l) + outString = strrep (outString, c_old{idx}, c_new{idx}); + end + end +endfunction + +## returns the numeric value of a string +function num = literal2num (string) + literals = {'MEG' 'MIL' 'A' 'F' 'P' 'N' 'U' 'M' 'K' 'G' 'T'}; + numerics = {'e6' '*25.4e-6' 'e-18' 'e-15' 'e-12' 'e-9' 'e-6' 'e-3' 'e3' 'e9' 'e12'}; + newstr = strReplace (upper (string), literals, numerics); + num = str2num (newstr); +end + +function syntaxError (line) + warnstr = sprintf ("Syntax error in line: %s", line); + error (warnstr); +endfunction + +function [outstruct, count] = prs_spice_C (line, outstruct, count) + element = "Mcapacitors"; + ## check wheter the element type already exists in output structure + [tf, idx] = ismember ({element}, count.NLC.list); + if !tf + ## update counters + count.NLC.n++; + count.NLC.list{count.NLC.n} = element; + #idx=count.NLC.n; + + ## if the element doesn't exists, add it to the output structure + outstruct.NLC(count.NLC.n).func = element; + outstruct.NLC(count.NLC.n).section = "LIN"; + outstruct.NLC(count.NLC.n).nextvar = 2; + outstruct.NLC(count.NLC.n).npar = 1; + outstruct.NLC(count.NLC.n).nrows = 0; + outstruct.NLC(count.NLC.n).nparnames = 1; + outstruct.NLC(count.NLC.n).parnames = {"C"}; + outstruct.NLC(count.NLC.n).vnmatrix = []; + outstruct.NLC(count.NLC.n).pvmatrix = []; + endif + + ## add an element to the structure + ##outstruct.NLC(idx).nrows++; + outstruct.NLC(count.NLC.n).nrows++; + + ## convert input line string into cell array + ca = str2ca (line); + + if length (ca)>3 + ## update parameter value and connectivity matrix + ##[outstruct.NLC(idx).vnmatrix] = [outstruct.NLC(idx).vnmatrix; add_nodes(ca(2:3))]; + ##[outstruct.NLC(idx).pvmatrix] = [outstruct.NLC(idx).pvmatrix; literal2num(ca{4})]; + [outstruct.NLC(count.NLC.n).vnmatrix] = [outstruct.NLC(count.NLC.n).vnmatrix; add_nodes(ca(2:3))]; + [outstruct.NLC(count.NLC.n).pvmatrix] = [outstruct.NLC(count.NLC.n).pvmatrix; literal2num(ca{4})]; + else + syntaxError (line); + endif + + ##outstruct = NLCintvar (outstruct, idx, ca{1}); + outstruct = NLCintvar(outstruct, count.NLC.n, ca{1}); +endfunction + +function [outstruct, count] = prs_spice_D (line, outstruct, count) + element = "Mdiode"; + ## check wheter the element type already exists in output structure + ##[tf, idx] = ismember ({element}, count.NLC.list); + ##if !tf + ## update counters + count.NLC.n++; + count.NLC.list{count.NLC.n} = element; + ##idx = count.NLC.n; + + ## if the element doesn't exists, add it to the output structure + outstruct.NLC(count.NLC.n).func = element; + outstruct.NLC(count.NLC.n).section = "simple"; + outstruct.NLC(count.NLC.n).nextvar = 2; + outstruct.NLC(count.NLC.n).npar = 0; + outstruct.NLC(count.NLC.n).nrows = 1; + outstruct.NLC(count.NLC.n).nparnames = 0; + outstruct.NLC(count.NLC.n).parnames = {}; + outstruct.NLC(count.NLC.n).vnmatrix = []; + outstruct.NLC(count.NLC.n).pvmatrix = []; + ##endif + + ## convert input line string into cell array + ca = str2ca (line); + ## update parameter value and connectivity matrix + ##[outstruct.NLC(idx).vnmatrix] = [outstruct.NLC(idx).vnmatrix; add_nodes(ca(2:3))]; + [outstruct.NLC(count.NLC.n).vnmatrix] = [outstruct.NLC(count.NLC.n).vnmatrix; add_nodes(ca(2:3))]; + + ## check if parameters are specified + for prm_idx = 1:(length (ca)-3)/2 + ## [tf, str_idx] = ismember (outstruct.NLC(count.NLC.n).parnames{prm_idx}, ca); + ## TODO: can the loop be executed in a single operation? + ## [tf, str_idx] = ismember (outstruct.NLC(count.NLC.n).parnames, ca); + if length (ca) >= 1+prm_idx*2 + ## find specified parameter name + ##if tf + + outstruct.NLC(count.NLC.n).npar++; + outstruct.NLC(count.NLC.n).nparnames++; + outstruct.NLC(count.NLC.n).parnames{1, prm_idx} = ca{2*prm_idx+2}; + outstruct.NLC(count.NLC.n).pvmatrix(1, prm_idx) = literal2num (ca{2*prm_idx+3}); + ##else + ## TODO: set to a default value undefined parameters, instead of rising an error? + ## errstr = sprintf ("Undefined parameter %s in line: %s", outstruct.NLC(count.NLC.n).parnames{prm_idx}, line); + ## error (errstr); + ##endif + else + syntaxError (line); + endif + endfor + + outstruct = NLCintvar(outstruct, count.NLC.n, ca{1}); +endfunction + +function [outstruct, count] = prs_spice_M (line, outstruct, count) + global models_list; + ##element = "Mnmosfet"; + ## check wheter the element type already exists in output structure + ##[tf, idx] = ismember ({element}, count.NLC.list); + ##if !tf + ## update counters + count.NLC.n++; + ##count.NLC.list{count.NLC.n} = element; + ##idx = count.NLC.n; + + ## if the element doesn't exists, add it to the output structure + ##outstruct.NLC(count.NLC.n).func = element; + ##outstruct.NLC(count.NLC.n).section = "simple"; + ## outstruct.NLC(count.NLC.n).section = "lincap"; + outstruct.NLC(count.NLC.n).nextvar = 4; + outstruct.NLC(count.NLC.n).npar = 0; + outstruct.NLC(count.NLC.n).nrows = 1; + outstruct.NLC(count.NLC.n).nparnames = 0; + outstruct.NLC(count.NLC.n).parnames = {}; + ##outstruct.NLC(count.NLC.n).vnmatrix = []; + outstruct.NLC(count.NLC.n).pvmatrix = []; + ##endif + + ## convert input line string into cell array + ca = str2ca (line); + ## update parameter value and connectivity matrix + ##[outstruct.NLC(idx).vnmatrix] = [add_nodes(ca(2:5))]; + [outstruct.NLC(count.NLC.n).vnmatrix] = [add_nodes(ca(2:5))]; + + [tf, idx] = ismember (ca{6}, models_list.mname); + + if (tf) + outstruct.NLC(count.NLC.n).func = models_list.melement{idx}; + outstruct.NLC(count.NLC.n).section = models_list.msection{idx}; + + ## check if parameters are specified + for prm_idx = 1:(length (ca)-6)/2 + if length (ca)>=4+prm_idx*2 + outstruct.NLC(count.NLC.n).npar++; + outstruct.NLC(count.NLC.n).nparnames++; + outstruct.NLC(count.NLC.n).parnames{1, prm_idx} = ca{2*prm_idx+5}; + outstruct.NLC(count.NLC.n).pvmatrix(1, prm_idx) = literal2num (ca{2*prm_idx+6}); + else + syntaxError (line); + endif + endfor + + ## add model parameters to list + prm_idx = outstruct.NLC(count.NLC.n).npar; + len = length (models_list.plist{idx}.pnames); + for mpidx = 1:len + outstruct.NLC(count.NLC.n).parnames{prm_idx+mpidx} = models_list.plist{idx}.pnames{mpidx}; + outstruct.NLC(count.NLC.n).pvmatrix(1, prm_idx+mpidx) = models_list.plist{idx}.pvalues(mpidx); + endfor + outstruct.NLC(count.NLC.n).npar = outstruct.NLC(count.NLC.n).npar+len; + outstruct.NLC(count.NLC.n).nparnanames = outstruct.NLC(count.NLC.n).nparnames+len; + + outstruct = NLCintvar(outstruct, count.NLC.n, ca{1}); + else + syntaxError (line); + endif +endfunction + +function [outstruct, count]= prs_spice_P (line, outstruct, count) + element = "Mpmosfet"; + ## check wheter the element type already exists in output structure + ## update counters + count.NLC.n++; + count.NLC.list{count.NLC.n} = element; + + ## if the element doesn't exists, add it to the output structure + outstruct.NLC(count.NLC.n).func = element; + outstruct.NLC(count.NLC.n).section = "simple"; + ## outstruct.NLC(count.NLC.n).section = "lincap"; + outstruct.NLC(count.NLC.n).nextvar = 4; + outstruct.NLC(count.NLC.n).npar = 0; + outstruct.NLC(count.NLC.n).nrows = 1; + outstruct.NLC(count.NLC.n).nparnames = 0; + outstruct.NLC(count.NLC.n).parnames = {}; + ##outstruct.NLC(count.NLC.n).vnmatrix = []; + outstruct.NLC(count.NLC.n).pvmatrix = []; + + ## convert input line string into cell array + ca = str2ca (line); + ## update parameter value and connectivity matrix + ##[outstruct.NLC(idx).vnmatrix] = [add_nodes(ca(2:5))]; + [outstruct.NLC(count.NLC.n).vnmatrix] = [add_nodes(ca(2:5))]; + + ## check if parameters are specified + for prm_idx = 1:(length (ca)-5)/2 + ## [tf, str_idx] = ismember (outstruct.NLC(count.NLC.n).parnames{prm_idx}, ca); + ## TODO: can the loop be executed in a single operation? + ## [tf, str_idx] = ismember (outstruct.NLC(count.NLC.n).parnames, ca); + if (length (ca) >= 3+prm_idx*2) + ## find specified parameter name + ##if tf + + outstruct.NLC(count.NLC.n).npar++; + outstruct.NLC(count.NLC.n).nparnames++; + outstruct.NLC(count.NLC.n).parnames{1, prm_idx} = ca{2*prm_idx+4}; + outstruct.NLC(count.NLC.n).pvmatrix(1, prm_idx) = literal2num (ca{2*prm_idx+5}); + ##else + ## TODO: set to a default value undefined parameters, instead of rising an error? + ## errstr=sprintf("Undefined parameter %s in line: %s", outstruct.NLC(count.NLC.n).parnames{prm_idx}, line); + ## error(errstr); + ##endif + else + syntaxError (line); + endif + endfor + + outstruct = NLCintvar(outstruct, count.NLC.n, ca{1}); +endfunction + + +function [outstruct, count]= prs_spice_R (line, outstruct, count) + + element = "Mresistors"; + ## check wheter the element type already exists in output structure + [tf, idx] = ismember ({element}, count.LCR.list); + if !tf + ## update counters + count.LCR.n++; + count.LCR.list{count.LCR.n} = element; + ##idx = count.LCR.n; + + ## if the element doesn't exists, add it to the output structure + outstruct.LCR(count.LCR.n).func = element; + outstruct.LCR(count.LCR.n).section = "LIN"; + outstruct.LCR(count.LCR.n).nextvar = 2; + outstruct.LCR(count.LCR.n).npar = 1; + outstruct.LCR(count.LCR.n).nrows = 0; + outstruct.LCR(count.LCR.n).nparnames = 1; + outstruct.LCR(count.LCR.n).parnames = {"R"}; + outstruct.LCR(count.LCR.n).vnmatrix = []; + outstruct.LCR(count.LCR.n).pvmatrix = []; + endif + + ## add an element to the structure + ##outstruct.LCR(idx).nrows++; + outstruct.LCR(count.LCR.n).nrows++; + + ## convert input line string into cell array + ca = str2ca (line); + + if (length (ca) > 3) + ## update parameter value and connectivity matrix + ##[outstruct.LCR(idx).vnmatrix] = [outstruct.LCR(idx).vnmatrix; add_nodes(ca(2:3))]; + ##[outstruct.LCR(idx).pvmatrix] = [outstruct.LCR(idx).pvmatrix; literal2num(ca{4})]; + [outstruct.LCR(count.LCR.n).vnmatrix] = [outstruct.LCR(count.LCR.n).vnmatrix; add_nodes(ca(2:3))]; + [outstruct.LCR(count.LCR.n).pvmatrix] = [outstruct.LCR(count.LCR.n).pvmatrix; literal2num(ca{4})]; + else + syntaxError (line); + endif + + outstruct = LCRintvar(outstruct, count.LCR.n, ca{1}); +endfunction + +function [outstruct, count] = prs_spice_V (line, outstruct, count) + + ## Sine + ## SIN(VO VA FREQ TD THETA) + ## + ## VO (offset) + ## VA (amplitude) + ## FREQ (frequency) + ## TD (delay) + ## THETA (damping factor) + ## + ## 0 to TD: V0 + ## TD to TSTOP: VO + VA*exp(-(time-TD)*THETA)*sine(twopi*FREQ*(time+TD) + + ## check if it is a sinwave generator + sine = regexp (line, '(?SIN)[\s]*\((?.+)\)', 'names'); + + ## Pulse + ## PULSE(V1 V2 TD TR TF PW PER) + ## + ## parameters default values units + ## V1 (initial value) Volts or Amps + ## V2 (pulsed value) Volts or Amps + ## TD (delay time) 0.0 seconds + ## TR (rise time) TSTEP seconds + ## TF (fall time) TSTEP seconds + ## PW (pulse width) TSTOP seconds + ## PER (period) TSTOP seconds + + ## check if it is a pulse generator + pulse = regexp (line, '(?PULSE)[\s]*\((?.+)\)', 'names'); + + if (! isempty (sine.stim)) + ## sinwave generator + ca = str2ca (sine.prms); + if (length (ca) == 5) + vo = literal2num (ca{1}); + va = literal2num (ca{2}); + freq = literal2num (ca{3}); + td = literal2num (ca{4}); + theta = literal2num (ca{5}); + + pvmatrix = [va freq td vo]; + + element = "Mvoltagesources"; + section = "sinwave"; + + nextvar = 2; + npar = 4; + nparnames = 4; + parnames = {"Ampl", "f", "delay", "shift"}; + ## convert input line string into cell array + ca = str2ca (line); + vnmatrix = add_nodes (ca(2:3)); + [outstruct, count] = addNLCelement (outstruct, count, element, section, nextvar, npar, nparnames, parnames, vnmatrix, pvmatrix); + outstruct = NLCintvar(outstruct, count.NLC.n, ca{1}); + else #length(ca) == 5 + syntaxError (line); + endif #length (ca) == 5 + elseif (! isempty (pulse.stim)) + ca = str2ca (pulse.prms); + if length (ca) == 7 + low = literal2num (ca{1}); + high = literal2num (ca{2}); + delay = literal2num (ca{3}); + ## TODO: add rise and fall times! + ## tr = literal2num (ca{4}); + ## tf = literal2num (ca{5}); + thigh = literal2num (ca{6}); + period = literal2num (ca{7}) + tlow = period-thigh; + + pvmatrix = [low high tlow thigh delay]; + + element = "Mvoltagesources"; + section = "squarewave"; + + nextvar = 2; + npar = 5; + nparnames = 5; + parnames = {"low", "high", "tlow", "thigh", "delay"}; + ## convert input line string into cell array + ca = str2ca (line); + vnmatrix = add_nodes (ca(2:3)); + [outstruct, count] = addNLCelement (outstruct, count, element, section, nextvar, npar, nparnames, parnames, vnmatrix, pvmatrix); + outstruct = NLCintvar(outstruct, count.NLC.n, ca{1}); + else ##length (ca) == 7 + syntaxError (line); + endif ##length (ca) == 7 + else ##~isempty (tran.stim) + ## DC generator + element = "Mvoltagesources"; + section = "DC"; + + nextvar = 2; + npar = 1; + nparnames = 1; + parnames = {"V"}; + ## convert input line string into cell array + ca = str2ca (line); + vnmatrix = add_nodes (ca(2:3)); + + pvmatrix = literal2num (ca{4}); + [outstruct, count] = addLCRelement (outstruct, count, element, section, nextvar, npar, nparnames, parnames, vnmatrix, pvmatrix); + outstruct = LCRintvar(outstruct, count.LCR.n, ca{1}); + endif #~isempty(tran.stim) +endfunction + +function [outstruct, count] = prs_spice_dot (line, outstruct, count) + ## .MODEL MNAME TYPE(PNAMEl = PVALl PNAME2 = PVAL2 ... ) + + ## TYPE can be: + ## R resistor model + ## C capacitor model + ## URC Uniform Distributed RC model + ## D diode model + ## NPN NPN BIT model + ## PNP PNP BJT model + ## NJF N-channel JFET model + ## PJF P-channel lFET model + ## NMOS N-channel MOSFET model + ## PMOS P-channel MOSFET model + ## NMF N-channel MESFET model + ## PMF P-channel MESFET model + ## SW voltage controlled switch + ## CSW current controlled switch + + global models_list; + + model = regexp (line, '.MODEL[\s]+(?[\S]+)[\s]+(?R|C|URC|D|NPN|PNP|NJF|PJF|NMOS|PMOS|NMF|PMF|SW|CSW)[\s]*\([\s]*(?.+)[\s]*\)', 'names'); + if !isempty (model) + switch (model.mtype) + case 'R' + case 'C' + case 'URC' + case 'D' + element = "Mdiode"; + case 'NPN' + case 'PNP' + case 'NJF' + case 'PJF' + case 'NMOS' + element = "Mnmosfet"; + case 'PMOS' + element = "Mpmosfet"; + case 'NMF' + case 'PMF' + case 'SW' + case 'CSW' + otherwise + syntaxError (line); + endswitch + + ## get model level (=section) + level = regexp (model.prms, 'LEVEL=(?[\S]+)[\s]+(?.+)', 'names'); + if isempty (level.level) + section = "simple"; + else + section = level.level; + model.prms = level.prms; + endif + + midx = length (models_list.mname)+1; + + models_list.mname{midx} = model.mname; + models_list.melement{midx} = element; + models_list.msection{midx} = section; + + ## set model parameters + ca = str2ca (model.prms); + midx = length (models_list.mname); + + models_list.plist{midx} = struct ("pnames", {""}, "pvalues", []); + + for prm_idx = 1:length (ca)/2 + ## save parameter name + models_list.plist{midx}.pnames{prm_idx} = ca{2*prm_idx-1}; + ## save parameter value + models_list.plist{midx}.pvalues = [models_list.plist{midx}.pvalues literal2num(ca{2*prm_idx})]; + endfor + + endif #!isempty (model) +endfunction + +## adds nodes to nodes_list and returns the indexes of the added nodes +function indexes = add_nodes (nodes) + global nodes_list; + for ii = 1:length (nodes) + [tf, idx] = ismember (nodes(ii), nodes_list); + if tf + indexes(ii) = idx-1; + else + indexes(ii) = length (nodes_list); + nodes_list{length (nodes_list)+1} = nodes{ii}; + endif + endfor +endfunction + +%!demo +%! outstruct = prs_spice ("rlc"); +%! vin = linspace (0, 10, 10); +%! x = zeros (outstruct.totextvar+outstruct.totintvar, 1); +%! +%! for idx = 1:length (vin) +%! outstruct.NLC(1).pvmatrix(1) = vin(idx); +%! out = nls_stationary (outstruct, x, 1e-15, 100); +%! vout(idx) = out(2); +%! end +%! +%! plot (vin, vout); +%! grid on; + +%!demo +%! ## Circuit +%! +%! cir = menu ("Chose the circuit to analyze:", +%! "AND (Simple algebraic MOS-FET model)", +%! "AND (Simple MOS-FET model with parasitic capacitances)", +%! "Diode clamper (Simple exponential diode model)", +%! "CMOS-inverter circuit (Simple algebraic MOS-FET model)", +%! "n-MOS analog amplifier (Simple algebraic MOS-FET model)", +%! "Linear RC circuit", +%! "Diode bridge rectifier", +%! "RLC circuit"); +%! +%! switch cir +%! case 1 +%! outstruct = prs_spice ("and"); +%! x = [.5 .5 .33 .66 .5 1 0 0 1 ]'; +%! t = linspace (0, .5, 100); +%! pltvars = {"Va", "Vb", "Va_and_b"}; +%! dmp = .2; +%! tol = 1e-15; +%! maxit = 100; +%! case 2 +%! outstruct = prs_spice ("and2"); +%! x = [.8;.8;0.00232;0.00465;.8; +%! .8;0.00232;0.00465;0.00000; +%! 0.0;0.0;0.0;0.00232;0.0; +%! 0.0;0.0;0.0;1.0;0.0;-0.0; +%! 0.0;1.0;0.00465;0.0;0.0; +%! -0.0;1.0;0.00465;0.0; +%! 0.0;0.0;1.0;1.0;0.0;0.0;0.0; +%! 0.0;0.0;0.0]; +%! t = linspace (.25e-6, .5e-6, 100); +%! dmp = .1; +%! pltvars = {"Va", "Vb", "Va_and_b"}; +%! tol = 1e-15; +%! maxit = 100; +%! case 3 +%! outstruct = prs_spice ("diode"); +%! x = [0 0 0 0 0]'; +%! t = linspace (0, 3e-10, 200); +%! dmp = .1; +%! pltvars = {"Vin", "Vout", "V2"}; +%! tol = 1e-15; +%! maxit = 100; +%! case 4 +%! outstruct = prs_spice ("inverter"); +%! x = [.5 .5 1 0 0]'; +%! t = linspace (0, 1, 100); +%! dmp = .1; +%! pltvars={"Vgate", "Vdrain"}; +%! tol = 1e-15; +%! maxit = 100; +%! case 5 +%! outstruct = prs_spice ("nmos"); +%! x = [1 .03 1 0 0]'; +%! t = linspace (0, 1, 50); +%! dmp = .1; +%! pltvars = {"Vgate", "Vdrain"}; +%! tol = 1e-15; +%! maxit = 100; +%! case 6 +%! outstruct = prs_spice ("rcs"); +%! x = [0 0 0 0]'; +%! t = linspace (0, 2e-5, 100); +%! dmp = 1; +%! pltvars = {"Vout"}; +%! tol = 1e-15; +%! maxit = 100; +%! case 7 +%! outstruct = prs_spice ("rect"); +%! x = [0 0 0 0 ]'; +%! t = linspace (0, 3e-10, 60); +%! dmp = .1; +%! pltvars = {"Vin", "Voutlow", "Vouthigh"}; +%! tol = 1e-15; +%! maxit = 100; +%! case 8 +%! outstruct = prs_spice ("rlc") +%! #x = [0 0 0 0 0]'; +%! #x = [0 0 0 ]'; +%! #x = [0 0 0 0]'; +%! x = [0 0 0 0 0 0 ]'; +%! t = linspace (0, 2e-5, 200); +%! dmp = 1; +%! #pltvars = {"Vin", "Vout"}; +%! pltvars = {"I(C3)"}; +%! #pltvars = {"Vout"}; +%! tol = 1e-15; +%! maxit = 100; +%! otherwise +%! error ("unknown circuit"); +%! endswitch +%! +%! clc; +%! slv = menu("Chose the solver to use:", +%! "BWEULER", # 1 +%! "DASPK", # 2 +%! "THETA", # 3 +%! "ODERS", # 4 +%! "ODESX", # 5 +%! "ODE2R", # 6 +%! "ODE5R" # 7 +%! ); +%! +%! out = zeros (rows (x), columns (t)); +%! +%! switch slv +%! case 1 +%! out = tst_backward_euler (outstruct, x, t, tol, maxit, pltvars); +%! # out = TSTbweuler (outstruct, x, t, tol, maxit, pltvars); +%! case 2 +%! out = tst_daspk (outstruct, x, t, tol, maxit, pltvars); +%! # out = TSTdaspk (outstruct, x, t, tol, maxit, pltvars); +%! case 3 +%! out = tst_theta_method (outstruct, x, t, tol, maxit, .5, pltvars, [0 0]); +%! # out = TSTthetamethod (outstruct, x, t, tol, maxit, .5, pltvars, [0 0]); +%! case 4 +%! out = tst_odepkg (outstruct, x, t, tol, maxit, pltvars, "oders", [0, 1]); +%! # out = TSTodepkg (outstruct, x, t, tol, maxit, pltvars, "oders", [0, 1]); +%! case 5 +%! out = tst_odepkg (outstruct, x, t, tol, maxit, pltvars, "odesx", [0, 1]); +%! # out = TSTodepkg (outstruct, x, t, tol, maxit, pltvars, "odesx", [0, 1]); +%! case 6 +%! out = tst_odepkg (outstruct, x, t, tol, maxit, pltvars, "ode2r", [0, 1]); +%! # out = TSTodepkg (outstruct, x, t, tol, maxit, pltvars, "ode2r", [0, 1]); +%! case 7 +%! out = tst_odepkg (outstruct, x, t, tol, maxit, pltvars, "ode5r", [0, 1]) +%! # out = TSTodepkg (outstruct, x, t, tol, maxit, pltvars, "ode5r", [0, 1]) +%! otherwise +%! error ("unknown solver"); +%! endswitch +%! +%! #utl_plot_by_name (t, out, outstruct, pltvars); +%! utl_plot_by_name (t, out, outstruct, pltvars); +%! axis ("tight"); diff --git a/octave_packages/ocs-0.1.3/sbn/Mcapacitors.m b/octave_packages/ocs-0.1.3/sbn/Mcapacitors.m new file mode 100644 index 0000000..fdb22b1 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mcapacitors.m @@ -0,0 +1,178 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## +## @deftypefn{Function File} @ +## {[@var{a},@var{b},@var{c}]=} Mcapacitors(@var{string},@var{parameters},@ +## @var{parameternames},@var{extvar},@var{intvar},@var{t}) +## +## SBN file implementing models for capacitors. +## +## @var{string} is used to select among models. Parameters are listed +## as inner items. Possible models are: +## +## @enumerate +## @item @var{string} = "LIN" (Linear Capacitor) +## @itemize @minus +## @item C -> capacitance value +## @end itemize +## @item @var{string} = "MULTICAP" (Multipole Capacitor) +## @itemize @minus +## @item C -> capacitance values +## @end itemize +## @item @var{string} = "PDE_NMOS" (Drift-Diffusion PDE NMOS capacitor) +## @itemize @minus +## @item tbulk -> bulk thickness +## @item tox -> oxide thickness +## @item Nnodes -> number of nodes of 1D grid +## @item Na -> bulk doping +## @item toll -> absolute tolerance +## @item maxit -> max iterations number +## @item Area -> device area +## @end itemize +## @end enumerate +## +## See the @cite{IFF file format specifications} for details about +## the output structures. +## +## @seealso{prs_iff,asm_initialize_system,asm_build_system} +## @end deftypefn + +function [a,b,c] = Mcapacitors(string,parameters,parameternames,extvar,intvar,t) + + if isempty(intvar) + intvar = 0; + endif + + switch string + ##LCR part + case "LIN" + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + a = [0 0 1; 0 0 -1; 0 0 0]; + b = [0 0 0;0 0 0;-C C 1]; + c = [0 0 0]'; + break + + case "MULTICAP" + + n = length(extvar); + C = reshape(parameters,n,n); + + a = [zeros(n) eye(n); zeros(n) zeros(n)]; + b = [zeros(n) zeros(n); -C eye(n)]; + c = [zeros(2*n,1)]'; + + break + + ##NLC part + case "PDE_NMOS" + + constants + + tbulk = 1.5e-6; + tox = 90e-9; + len = tbulk + tox; + Nnodes = 300; + Na=1e21; + toll = 1e-10; + maxit = 1000; + Area = 1e-12; + + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + Vg = extvar(1) - extvar(2); + q = intvar(1); + + [Q,C]=Mnmoscap(tbulk,tox,Area,Vg,Na,Nnodes,toll,maxit); + + a = [0 0 1; 0 0 -1; 0 0 0]; + b = [0 0 0;0 0 0;C -C -1]; + c = [0 0 Q-q]'; + break + + otherwise + error (["unknown section:" string]) + endswitch + +endfunction +## Non-linear 1D MOS structure. +## FIXME: requires SECS1D!!! +function [Q,C]=Mnmoscap(tbulk,tox,Area,Vg,Na,Nnodes,toll,maxit); + + constants + + Nelements = Nnodes - 1; + len = tox+tbulk; + x = linspace(0,len,Nnodes)'; + sinodes = find(x<=tbulk); + Nsinodes = length(sinodes); + NelementsSi = Nsinodes-1; + D = - Na* ones(Nsinodes,1); + pp = Na ; + p = pp* ones(Nsinodes,1); + n = (ni^2)./p; + Fn = 0*n; + Fp = 0*n; + + V = -Phims + Vg * ones(Nnodes,1); + V(sinodes) = Fn + Vth*log(n/ni); + + ## Scaling + xs = len; + ns = norm(D,inf); + Din = D/ns; + Vs = Vth; + xin = x/xs; + nin = n/ns; + pin = p/ns; + Vin = V/Vs; + Fnin = (Fn - Vs * log(ni/ns))/Vs; + Fpin = (Fp + Vs * log(ni/ns))/Vs; + + l2 = (Vs*esio2)/(q*ns*xs^2)* ones(Nelements,1); + l2(1:NelementsSi) = (Vs*esi)/(q*ns*xs^2); + + ## Solution of Nonlinear Poisson equation + [V,nout,pout,res,niter] = DDGnlpoisson (xin,sinodes,Vin,nin,... + pin,Fnin,Fpin,Din,l2,... + toll,maxit,0); + + L = Ucomplap(xin,Nnodes,[],Nelements,l2); + C22 = L(end,end); + C12 = L(2:end-1,end); + C11 = L(2:end-1,2:end-1); + + drdv = zeros(Nnodes,1); drdv(sinodes) = nout + pout; + coeff = zeros(Nelements,1); coeff(1:NelementsSi) = 1; + M = Ucompmass(xin,Nnodes,[],[],drdv,coeff); + C = C22 - C12'*((C11+M(2:end-1,2:end-1))\C12); + Q =(C12'*V(2:end-1)+C22*V(end)); + + ## Descaling + C = Area*C*(q*ns*xs/Vs); + Q = Area*Q*(q*ns*xs); + +endfunction \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/sbn/Mcurrentsources.m b/octave_packages/ocs-0.1.3/sbn/Mcurrentsources.m new file mode 100644 index 0000000..dcd4b61 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mcurrentsources.m @@ -0,0 +1,123 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco, Culpo Massimiliano +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco +## author culpo@math.uni-wuppertal.de + +## -*- texinfo -*- +## +## @deftypefn{Function File} @ +## {[@var{a},@var{b},@var{c}]=}Mcurrentsources(@var{string},@var{parameters},@ +## @var{parameternames},@var{extvar},@var{intvar},@var{t}) +## +## SBN file implementing models for current sources. +## +## @var{string} is used to select among models. Parameters are listed +## as inner items. Possible models are: +## +## @enumerate +## @item @var{string} = "DC" (Static indipendent current source) +## @itemize @minus +## @item I -> Current source value +## @end itemize +## @item @var{string} = "VCCS" (Voltage controlled current source) +## @itemize @minus +## @item K -> Control parameter +## @end itemize +## @item @var{string} = "sinwave" (Sinusoidal indipendent current +## source) +## @itemize @minus +## @item shift -> mean value of sinusoidal input +## @item Ampl -> amplitude of sinusoidal wave +## @item f -> frequency of sinusoidal wave +## @item delay -> delay of sinusoidal wave +## @end itemize +## @item @var{string} = "VCPS" (Voltage controlled power source) +## @itemize @minus +## @item K -> Control parameter +## @end itemize +## @end enumerate +## +## See the @cite{IFF file format specifications} for details about +## the output structures. +## +## @seealso{prs_iff,asm_initialize_system,asm_build_system} +## @end deftypefn + +function [a,b,c] = Mcurrentsources (string,parameters,parameternames,extvar,intvar,t) + + switch string + ## LCR part + case "DC" + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + a = zeros(2); + b = a; + c = [I -I]'; + break + + case "VCCS" + ## Voltage controlled current source + K = 1; + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + a = zeros(4); + b = [0 0 K -K;\ + 0 0 -K K;\ + 0 0 0 0;\ + 0 0 0 0]; + c = zeros(4,1); + ## NLC part + case "sinwave" + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + I = shift+Ampl * sin(2*pi*(t+delay)*f ); + a = zeros(2); + b = a; + c = [I -I]'; + break + + case "VCPS" + ## Voltage controlled power source + K = 1; + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + dv = extvar(3) - extvar(4); + I = K*(dv^2); + dIdv = 2*K*dv; + + a = zeros(4); + b = [0 0 dIdv -dIdv;\ + 0 0 -dIdv dIdv;\ + 0 0 0 0;\ + 0 0 0 0]; + c = [I -I 0 0]; + + otherwise + error (["unknown section:" string]) + endswitch + +endfunction diff --git a/octave_packages/ocs-0.1.3/sbn/Mdiode.m b/octave_packages/ocs-0.1.3/sbn/Mdiode.m new file mode 100644 index 0000000..9db5410 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mdiode.m @@ -0,0 +1,111 @@ +## Copyright (C) 2006,2007,2008 Massimiliano Culpo, Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: culpo@math.uni-wuppertal.de, Carlo de Falco + +## -*- texinfo -*- +## +## @deftypefn{Function File} @ +## {[@var{a},@var{b},@var{c}]=}Mdiode(@var{string},@var{parameters},@ +## @var{parameternames},@var{extvar},@var{intvar},@var{t}) +## +## SBN file implementing models for diodes. +## +## @var{string} is used to select among models. Parameters are listed +## as inner items. Possible models are: +## +## @itemize @minus +## @item @var{string} = "simple" (Usual exponential diode model) +## @itemize @minus +## @item Is -> reverse current +## @item Vth -> thermal voltage +## @item Rpar -> parasitic resistance +## @end itemize +## @item @var{string} = "PDEsymmetric" (Drift-Diffusion PDE model) +## @itemize @minus +## @item len -> diode length +## @item Nnodes -> number of nodes of 1D grid +## @item Dope -> doping (abrupt and symmetric) +## @item toll -> absolute tolerance +## @item maxit -> max iterations number +## @item Area -> device area +## @end itemize +## @end itemize +## +## See the @cite{IFF file format specifications} for details about +## the output structures. +## +## @seealso{prs_iff,asm_initialize_system,asm_build_system} +## @end deftypefn + +function [a,b,c] = Mdiode (string,parameters,parameternames,extvar,intvar,t) + + switch string + + case "simple" + Is = 1e-14; + Vth = 2.5e-2; + Rpar = 1e12; + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + vp = extvar(1); + vm = extvar(2); + + I = Is*(exp((vp - vm)/Vth) -1 ) + (vp - vm)/Rpar; + geq = Is*exp((vp - vm)/Vth)/Vth + 1/Rpar; + + a = zeros(2); + b = [geq -geq; -geq geq]; + c = [I ; -I] ; + break + + case "PDEsymmetric" + + len = 1e-6; + Nnodes = 100; + Dope=1e23; + + toll = 1e-5; + maxit = 100; + ptoll = 1e-10; + pmaxit = 100; + + Area = 1e-10; + + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + vp = extvar(1); + vm = extvar(2); + + [I,g] = Mpdesympnjunct (len,Dope,vp-vm,Area,Nnodes,toll,maxit,ptoll,pmaxit); + + a = zeros(2); + b = [g -g; -g g]; + c = [I ; -I] ; + + break + + otherwise + error(["unknown section:" string]) + endswitch + +endfunction diff --git a/octave_packages/ocs-0.1.3/sbn/Minductors.m b/octave_packages/ocs-0.1.3/sbn/Minductors.m new file mode 100644 index 0000000..219a922 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Minductors.m @@ -0,0 +1,77 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## +## @deftypefn{Function File} @ +## {[@var{a},@var{b},@var{c}]=}Minductors(@var{string},@var{parameters},@ +## @var{parameternames},@var{extvar},@var{intvar},@var{t}) +## +## SBN file implementing models for inductors. +## +## @var{string} is used to select among models. Parameters are listed +## as inner items. Possible models are: +## +## @enumerate +## @item @var{string} = "LIN" (Linear inductor model) +## @itemize @minus +## @item L -> inductance value +## @end itemize +## @end enumerate +## +## See the @cite{IFF file format specifications} for details about +## the output structures. +## +## @seealso{prs_iff,asm_initialize_system,asm_build_system} +## @end deftypefn + +function [a,b,c] = Minductors (string,parameters,parameternames,extvar,intvar,t) + + if isempty(intvar) + intvar = [0 0]; + endif + + switch string + + case "LIN" + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + phi = intvar(1); + jl = intvar(2); + + a = [0 0 0 0; + 0 0 0 0; + 0 0 1 0; + 0 0 0 0]; + + b = [0 0 0 1; + 0 0 0 -1; + -1 1 0 0; + 0 0 1 -L]; + + c = [0 0 0 0]'; + otherwise + error (["unknown section:" string]) + endswitch + +endfunction + \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/sbn/Mnmosfet.m b/octave_packages/ocs-0.1.3/sbn/Mnmosfet.m new file mode 100644 index 0000000..5fe4962 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mnmosfet.m @@ -0,0 +1,161 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## +## @deftypefn{Function File} @ +## {[@var{a},@var{b},@var{c}]=}Mnmosfet(@var{string},@var{parameters},@ +## @var{parameternames},@var{extvar},@var{intvar},@var{t}) +## +## SBN file implementing standard models for n-mosfets. +## +## @var{string} is used to select among models. Parameters are listed +## as inner items. Possible models are: +## +## @enumerate +## @item @var{string} = "simple" (Standard model for MOSFET) +## @itemize @minus +## @item rd -> parasitic resistance between drain and source +## @item k -> k parameter for usual mosfet model +## @item Vth -> threshold voltage +## @end itemize +## @item @var{string} = "lincap" (Adds RC parasitics) +## @itemize @minus +## @item rd -> parasitic resistance between drain and source +## @item k -> k parameter for usual mosfet model +## @item Vth -> threshold voltage +## @item Rs -> parasitic source resistance +## @item Rd -> parasitic drain resistance +## @item Cs -> gate-source capacitance +## @item Cd -> gate-drain capacitance +## @item Cb -> gate-bulk capacitance +## @end itemize +## @end enumerate +## +## See the @cite{IFF file format specifications} for details about +## the output structures. +## +## @seealso{prs_iff,asm_initialize_system,asm_build_system} +## @end deftypefn + +function [a,b,c]=Mnmosfet(string,parameters,parameternames,extvar,intvar,t) + + switch string + case "simple" + + rd = 1e6; + k = 1e-5; + Vth = .5; + + for ii=1:length(parameternames) + eval([parameternames{ii} "=",... + num2str(parameters(ii)) " ;"]) + endfor + + vg = extvar(1); + vs = extvar(2); + vd = extvar(3); + vb = extvar(4); + + vgs = vg-vs; + vds = vd-vs; + + if (vgs < Vth) + + + gm = 0; + gd = 1/rd; + id = vds*gd; + + elseif (((vgs-Vth) >= (vds)) && (vds>=0)) + + id = k*((vgs-Vth)*vds-(vds^2)/2)+vds/rd; + gm = k*vds; + gd = k*(vgs-Vth-vds)+1/rd; + + elseif (((vgs-Vth) >= (vds)) && (vds<0)) + + gm = 0; + gd = 1/rd; + id = vds*gd; + + else # (i.e. if 0 <= vgs-vth <= vds) + + id = (k/(2))*(vgs-Vth)^2+vds/rd; + gm = (2*k/(2))*(vgs-Vth); + gd = 1/rd; + + endif + + a = zeros(4); + + b = [0 0 0 0; + -gm (gm+gd) -gd 0; + gm -(gm+gd) gd 0; + 0 0 0 0]; + + c = [0 -id id 0]'; + break; + + case "lincap" + + ## Default parameter values + if isempty(intvar) + intvar = zeros(5,1); + endif + Rs = 1e2; Rd = 1e2; Cs = 1e-15; + Cd = 1e-15; Cb = 1e-14; + rd = inf; k = 1e-3; Vth = .1; + + ## parameters given in input + for ii=1:length(parameternames) + eval([parameternames{ii} "=",... + num2str(parameters(ii)) " ;"]) + endfor + + + persistent tmpstruct + + if isempty(tmpstruct) + + mtdnmos = file_in_path(path,"Mtdnmos.cir"); + mtdnmos(end-3:end)=[]; + tmpstruct = prs_iff(mtdnmos); + + endif + + + tmpstruct.NLC.pvmatrix = [k Vth rd]; + tmpstruct.LCR(1).pvmatrix = [Rs; Rd]; + tmpstruct.LCR(2).pvmatrix = [Cs; Cd; Cb]; + + [A0,B,C] = asm_initialize_system(tmpstruct,[extvar;intvar]); + [A1,Jac,res] = asm_build_system(tmpstruct,[extvar;intvar],t); + + a = A0+A1; + b = B+Jac; + c = res + B*[extvar;intvar] + C; + + break; + otherwise + error(["unknown option:" string]); + endswitch + +endfunction diff --git a/octave_packages/ocs-0.1.3/sbn/Mpdesympnjunct.m b/octave_packages/ocs-0.1.3/sbn/Mpdesympnjunct.m new file mode 100644 index 0000000..e546612 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mpdesympnjunct.m @@ -0,0 +1,125 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## +## @deftypefn{Function File} @ +## {[@var{j},@var{g}]=}Mpdesympnjunct@ +## (@var{len}, @var{Dope}, @var{va}, @ +## @var{Area}, @var{Nnodes}, @var{toll}, @var{maxit}, @var{ptoll}, @var{pmaxit}) +## +## INTERNAL FUNCTION: +## +## NOT SUPPOSED TO BE CALLED DIRECTLY BY USERS +## @end deftypefn + +function [j,g] = Mpdesympnjunct (len,Dope,va,Area,Nnodes,toll,maxit,ptoll,pmaxit) + + constants + + x = linspace(0,len,Nnodes)'; + xm = mean(x); + Nd=Dope; + Na=Dope; + nn = (Nd + sqrt(Nd^2+4*ni^2))/2; + pp = (Na + sqrt(Na^2+4*ni^2))/2; + xn = xm+len/10; + xp = xm-len/10; + D = Nd * (x>xm) - Na * (x<=xm); + + ## Scaling coefficients + xs = len; + ns = norm(D,inf); + Vs = Vth; + us = un; + Js = (Area*us*Vs*q*ns/xs); + xin = x/xs; + gs = Js/Vs; + + n = nn * (x>=xn) + (ni^2)/pp * (xxp) + pp * (x<=xp); + + Fn = va*(x<=xm); + Fp = Fn; + + V = (Fn - Vth * log(p/ni)); + + ## Scaling + idata.D = D/ns; + idata.un = un/us; + idata.up = up/us; + idata.tn = inf; + idata.tp = inf; + idata.l2 = (Vs*esi)/(q*ns*xs^2); + idata.nis = ni/ns; + idata.n = n/ns; + idata.p = p/ns; + idata.V = V/Vs; + idata.Fn = (Fn - Vs * log(ni/ns))/Vs; + idata.Fp = (Fp + Vs * log(ni/ns))/Vs; + + + ## Solution of DD system + ## Algorithm parameters + + sinodes = [1:length(x)]; + + [idata,it,res] = DDGgummelmap (xin,idata,toll,maxit/2,ptoll,pmaxit,0); + [odata,it,res] = DDNnewtonmap (xin,idata,toll,maxit/2,0); + + DV = diff(odata.V); + h = xin(2)-xin(1); + + Bp = Ubernoulli(DV,1); + Bm = Ubernoulli(DV,0); + + Jn = -odata.un * (odata.n(2:end).*Bp-odata.n(1:end-1).*Bm)/h; + Jp = odata.up * (odata.p(2:end).*Bm-odata.p(1:end-1).*Bp)/h; + + coeff = idata.un.*Umediaarmonica(odata.n); + L =- Ucomplap (xin,Nnodes,[],[],coeff); + Jn1 = L*odata.Fn; + fprintf(1,"jn1=%g\n",Jn1(1)) + fprintf(1,"jn=%g\n",Jn(1)) + + C11 = L(1,1); + C1I = L(1,2:end-1); + CII = L(2:end-1,2:end-1); + Gn = C11 - C1I*(CII\C1I'); + Gn = Gn - coeff(1)*(odata.Fn(2)-odata.Fn(1))/h + + coeff = idata.up.*Umediaarmonica(odata.p); + L =- Ucomplap (xin,Nnodes,[],[],coeff); + Jp1 = L*odata.Fp; + fprintf(1,"jp1=%g\n",Jp1(1)) + fprintf(1,"jp=%g\n",Jp(1)) + + C11 = L(1,1); + C1I = L(1,2:end-1); + CII = L(2:end-1,2:end-1); + Gp = C11 - C1I*(CII\C1I'); + Gp = Gp - coeff(1)*(odata.Fp(2)-odata.Fp(1))/h + + + ## Descaling + j= -(Jp(1)+Jn(1))*Js + g= gs*(Gn+Gp) + +endfunction \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/sbn/Mpmosfet.m b/octave_packages/ocs-0.1.3/sbn/Mpmosfet.m new file mode 100644 index 0000000..c4fbae3 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mpmosfet.m @@ -0,0 +1,153 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## +## @deftypefn{Function File} @ +## {[@var{a},@var{b},@var{c}]=} Mpmosfet(@var{string},@var{parameters},@ +## @var{parameternames},@var{extvar},@var{intvar},@var{t}) +## +## SBN file implementing standard models for p-mosfets. +## +## @var{string} is used to select among models. Parameters are listed +## as inner items. Possible models are: +## +## @enumerate +## @item @var{string} = "simple" (Standard model for MOSFET) +## @itemize @minus +## @item rd -> parasitic resistance between drain and source +## @item k -> k parameter for usual mosfet model +## @item Vth -> threshold voltage +## @end itemize +## @item @var{string} = "lincap" (Adds RC parasitics) +## @itemize @minus +## @item rd -> parasitic resistance between drain and source +## @item k -> k parameter for usual mosfet model +## @item Vth -> threshold voltage +## @item Rs -> parasitic source resistance +## @item Rd -> parasitic drain resistance +## @item Cs -> gate-source capacitance +## @item Cd -> gate-drain capacitance +## @item Cb -> gate-bulk capacitance +## @end itemize +## @end enumerate +## +## See the @cite{IFF file format specifications} for details about +## the output structures. +## +## @seealso{prs_iff,asm_initialize_system,asm_build_system} +## @end deftypefn + +function [a,b,c]= Mpmosfet (string,parameters,parameternames,extvar,intvar,t) + + switch string + case "simple" + + rd = 1e6; + + for ii=1:length(parameternames) + eval([parameternames{ii} "=",... + num2str(parameters(ii)) " ;"]); + endfor + + vg = extvar(1); + vs = extvar(2); + vd = extvar(3); + vb = extvar(4); + + vgs = vg-vs; + vds = vd-vs; + + if (vgs > Vth) + + gm = 0; + gd = 1/rd; + id = vds*gd; + + elseif (((vgs-Vth) <= (vds)) && (vds<=0)) + + id = k*((vgs-Vth)*vds-(vds^2)/2)+vds/rd; + gm = k*vds; + gd = k*(vgs-Vth-vds)+1/rd; + + elseif (((vgs-Vth) <= (vds)) && (vds>0)) + + gm = 0; + gd = 1/rd; + id = vds*gd; + + else + + id = k*(vgs-Vth)^2/2+vds/rd; + gm = k*(vgs-Vth); + gd = 1/rd; + + endif + a = zeros(4); + + b = [0 0 0 0; + -gm (gm+gd) -gd 0; + gm -(gm+gd) gd 0; + 0 0 0 0 ]; + + c =[0 -id id 0]'; + break; + + case "lincap" + + ## Default parameter values + if isempty(intvar) + intvar = zeros(5,1); + endif + Rs = 1e2; Rd = 1e2; Cs = 1e-15; + Cd = 1e-15; Cb = 1e-12; + rd = inf; k = -1e-3; Vth = -.1; + + ## parameters given in input + + for ii=1:length(parameternames) + eval([parameternames{ii} "=",... + num2str(parameters(ii)) " ;"]) + endfor + + + mtdpmos = file_in_path(path,"Mtdpmos.cir"); + mtdpmos(end-3:end)=[]; + tmpstruct = prs_iff(mtdpmos); + + + tmpstruct.NLC.pvmatrix = [k Vth rd]; + tmpstruct.LCR(1).pvmatrix = [Rs; Rd]; + tmpstruct.LCR(2).pvmatrix = [Cs; Cd; Cb]; + + [A0,B,C] = asm_initialize_system(tmpstruct,[extvar;intvar]); + [A1,Jac,res] = asm_build_system(tmpstruct,[extvar;intvar],t); + + a = A0+A1; + b = B+Jac; + c = res + B*[extvar;intvar] + C; + + break; + + otherwise + error(["unknown option:" string]); + endswitch + +endfunction diff --git a/octave_packages/ocs-0.1.3/sbn/Mresistors.m b/octave_packages/ocs-0.1.3/sbn/Mresistors.m new file mode 100644 index 0000000..3a4b543 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mresistors.m @@ -0,0 +1,131 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco, Culpo Massimiliano +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco +## author: culpo@math.uni-wuppertal.de + +## -*- texinfo -*- +## +## @deftypefn{Function File} @ +## {[@var{a},@var{b},@var{c}]=}Mresistors(@var{string},@var{parameters},@ +## @var{parameternames},@var{extvar},@var{intvar},@var{t}) +## +## SBN file implementing models for resistors. +## +## @var{string} is used to select among models. Parameters are listed +## as inner items. Possible models are: +## +## @enumerate +## @item @var{string} = "LIN" (Linear resistor) +## @itemize @minus +## @item R -> resistance value +## @end itemize +## @item @var{string} = "THERMAL" (Linear resistor with termal pin) +## @itemize @minus +## @item R0 -> reference resistance value at temperature @code{TNOM} +## @item TC1 -> coefficient for first order Taylor expansion +## @item TC2 -> coefficient for second order Taylor expansion +## @item TNOM -> reference temperature +## @end itemize +## @item @var{string} = "THERMAL1D" (1D Thermal resistor) +## @itemize @minus +## @item L -> length of 1D domain +## @item N -> number of discretized elements +## @item cv -> PDE coefficient for dynamic part +## @item k -> PDE coefficient for diffusion part +## @end itemize +## @end enumerate +## +## See the @cite{IFF file format specifications} for details about +## the output structures. +## +## @seealso{prs_iff,asm_initialize_system,asm_build_system} +## @end deftypefn + + +function [a,b,c] =Mresistors(string,parameters,parameternames,extvar,intvar,t) + + switch string + ## LCR part + case "LIN" + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + vp = extvar(1); + vm = extvar(2); + + a = zeros(2); + b = [1 -1 ;-1 1]/R; + c = -[0; 0]; + + break + ##NLCpart + case "THERMAL" + + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + v1 = extvar(1); + v2 = extvar(2); + T = extvar(3); + + RT = R0*(1 + TC1*(T-TNOM) + TC2*(T - TNOM)^2); + dRdT = R0*(TC1 + 2*TC2*(T-TNOM)); + + i1 = (v1-v2)/RT; + i2 = (v2-v1)/RT; + P = -(v1-v2)^2/RT; + + a = zeros(3); + b = [ 1/RT -1/RT (v2-v1)*dRdT/RT^2;... + -1/RT 1/RT (v1-v2)*dRdT/RT^2;... + -2*(v1-v2)/RT -2*(v2-v1)/RT (v1-v2)^2*dRdT/RT^2]; + c = [i1 i2 P]'; + + break; + + case "THERMAL1D" + + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + h = L/N; + + A = (cv*S*h)*speye(N+1); + + B = spdiags([ -ones(N+1,1) 2*ones(N+1,1) -ones(N+1,1)],-1:1,N+1,N+1); + B(1 ,1) = 1; + B(N+1 ,N+1) = 1; + + ext=[1 N+1]; + int=[2:N]; + + a = [A(ext,ext), A(ext,int); A(int,ext), A(int,int)]; + b = k*(S/h)*[B(ext,ext), B(ext,int); B(int,ext), B(int,int)]; + c = zeros(N+1,1); + + break; + + otherwise + error (["unknown section:" string]) + endswitch + +endfunction diff --git a/octave_packages/ocs-0.1.3/sbn/Mshichmanhodgesmosfet.m b/octave_packages/ocs-0.1.3/sbn/Mshichmanhodgesmosfet.m new file mode 100644 index 0000000..623e319 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mshichmanhodgesmosfet.m @@ -0,0 +1,332 @@ +## Copyright (C) 2006-2009 Carlo de Falco, Massimiliano Culpo +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco , culpo@math.uni-wuppertal.de + +## -*- texinfo -*- +## +## @deftypefn{Function File} @ +## {[@var{a},@var{b},@var{c}]=} Mshichmanhodgesmosfet(@var{string},@var{parameters},@ +## @var{parameternames},@var{extvar},@var{intvar},@var{t}) +## +## SBN file implementing Schichman-Hodges MOSFETs model. +## +## @var{string} is used to select among models. Possible models are: +## +## @enumerate +## @item @var{string} = "NMOS" (Schichman-Hodges n-MOSFET) +## @item @var{string} = "PMOS" (Schichman-Hodges p-MOSFET) +## @end enumerate +## +## Parameters for all the above models are: +## @itemize +## @item rd -> parasitic resistance between drain and source +## @item W -> MOSFET width +## @item L -> channel length +## @item mu0 -> reference value for mobility +## @item Vth -> threshold voltage +## @item Cox -> oxide capacitance +## @item Cgs -> gate-source capacitance +## @item Cgd -> gate-drain capacitance +## @item Cgb -> gate-bulk capacitance +## @item Csb -> source-bulk capacitance +## @item Cdb -> drain-bulk capacitance +## @item Tshift -> shift for reference temperature on MOSFETs (default 0) +## @end itemize +## +## See the @cite{IFF file format specifications} for details about +## the output structures. +## +## @seealso{prs_iff,asm_initialize_system,asm_build_system} +## @end deftypefn + +function [a,b,c]= Mshichmanhodgesmosfet (string,parameters,parameternames,extvar,intvar,t) + + if isempty(intvar) + ## If intvar is empty, then we are initializing the system + ## and there is no need of a matrix evaluation + a = sparse(10,10); + b = []; + c = []; + else + ## If intvar is NOT empty, then we are evaluating the + ## element stamp + switch string + case "NMOS" + + rd = 1e6; + W = 1; + L = 1; + mu0 = 1e-5; + Vth = .5; + Cox = 1e-9; + Cgb = Cox; + Cgs=Cgd=Csb=Cdb=.1*Cox; + Tshift = 0; + + for ii=1:length(parameternames) + eval([parameternames{ii} "=",... + num2str(parameters(ii)) " ;"]) + endfor + + [gm,gd,ids,didT,P,dPdT,dPdvgs,dPdvds] = \ + nmos(extvar,mu0,Cox,W,L,Vth,rd,Tshift); + + vg = extvar(1); + vs = extvar(2); + vd = extvar(3); + vb = extvar(4); + T = max(extvar(5),0); + + if isempty(intvar) + intvar = zeros(5,1); + endif + + Qgb = intvar(1); + Qgs = intvar(2); + Qgd = intvar(3); + Qsb = intvar(4); + Qdb = intvar(5); + + a11 = a21 = a22 = zeros(5,5); + a12 = [ 1 1 1 0 0; \ + 0 -1 0 1 0; \ + 0 0 -1 0 1; \ + -1 0 0 -1 -1; \ + 0 0 0 0 0]; + + a = [a11 a12; a21 a22]; + + b11 = [0 0 0 0 0; \ + -gm (gm+gd) -gd 0 -didT; \ + gm -(gm+gd) gd 0 didT; \ + 0 0 0 0 0; \ + dPdvgs -(dPdvgs+dPdvds) dPdvds 0 dPdT]; + + b12 = zeros(5,5); + + b21 = [Cgb 0 0 -Cgb 0; \ + Cgs -Cgs 0 0 0; \ + Cgd 0 -Cgd 0 0; \ + 0 Csb 0 -Csb 0; \ + 0 0 Cdb -Cdb 0]; + b22 = -eye(5); + + b = [b11 b12; b21 b22]; + + + c1 = [0; -ids; ids; 0; P]; + + c2 = [Cgb*(vg - vb) - Qgb;\ + Cgs*(vg - vs) - Qgs;\ + Cgd*(vg - vd) - Qgd;\ + Csb*(vs - vb) - Qsb;\ + Cdb*(vd - vb) - Qdb]; + + c = [c1;c2]; + + + break; + + case "PMOS" + + rd = 1e6; + W = 1; + L = 1; + mu0 = 1e-5; + Vth = -.5; + Cox = 1e-9; + Cgb=Cox; + Cgs=Cgd=Csb=Cdb=.1*Cox; + Tshift = 0; + + for ii=1:length(parameternames) + eval([parameternames{ii} "=",... + num2str(parameters(ii)) " ;"]) + endfor + + [gm,gd,ids,didT,P,dPdT,dPdvgs,dPdvds] = \ + pmos(extvar,mu0,Cox,W,L,Vth,rd,Tshift); + + + vg = extvar(1); + vs = extvar(2); + vd = extvar(3); + vb = extvar(4); + T = extvar(5); + + if isempty(intvar) + intvar = zeros(5,1); + endif + + Qgb = intvar(1); + Qgs = intvar(2); + Qgd = intvar(3); + Qsb = intvar(4); + Qdb = intvar(5); + + a11 = a21 = a22 = zeros(5,5); + a12 = [ 1 1 1 0 0; \ + 0 -1 0 1 0; \ + 0 0 -1 0 1; \ + -1 0 0 -1 -1; \ + 0 0 0 0 0]; + + a = [a11 a12; a21 a22]; + + b11 = [0 0 0 0 0; \ + -gm (gm+gd) -gd 0 -didT; \ + gm -(gm+gd) gd 0 didT; \ + 0 0 0 0 0; \ + dPdvgs -(dPdvgs+dPdvds) dPdvds 0 dPdT]; + + b12 = zeros(5,5); + + b21 = [Cgb 0 0 -Cgb 0; \ + Cgs -Cgs 0 0 0; \ + Cgd 0 -Cgd 0 0; \ + 0 Csb 0 -Csb 0; \ + 0 0 Cdb -Cdb 0]; + + b22 = -eye(5); + + b = [b11 b12; b21 b22]; + + + c1 = [0; -ids; ids; 0; P]; + + c2 = [Cgb*(vg - vb) - Qgb;\ + Cgs*(vg - vs) - Qgs;\ + Cgd*(vg - vd) - Qgd;\ + Csb*(vs - vb) - Qsb;\ + Cdb*(vd - vb) - Qdb]; + + c = [c1;c2]; + + break; + + otherwise + error(["unknown option:" string]); + endswitch + endif + +endfunction + +function [gm,gd,ids,didT,P,dPdT,dPdvgs,dPdvds] = nmos(extvar,mu0,Cox,W,L,Vth,rd,Tshift) + ##Computes values for nmos case + + vg = extvar(1); + vs = extvar(2); + vd = extvar(3); + vb = extvar(4); + T = max(extvar(5),0); + + k = mu0*Cox*((T + Tshift)/300)^(-3/2)*W/L; + dkdT = mu0*Cox*W*(-3/2)*((T + Tshift)/300)^(-5/2)*(1/300)/L; + + vgs = vg-vs; + vds = vd-vs; + + if (vgs < Vth) + + gm = 0; + gd = 1/rd; + ids = vds*gd; + didT= 0; + + elseif (((vgs-Vth) >= (vds)) && (vds >= 0)) + + ids = k*((vgs-Vth)*vds-(vds^2)/2)+vds/rd; + gm = k*vds; + gd = k*(vgs-Vth-vds) + 1/rd; + didT= dkdT*((vgs-Vth)*vds-(vds^2)/2); + + elseif (((vgs-Vth) >= (vds)) && (vds < 0)) + + gm = 0; + gd = 1/rd; + ids = vds*gd; + didT= 0; + + else # (i.e. if 0 <= vgs-vth <= vds) + + ids = (k/2)*(vgs-Vth)^2+vds/rd; + gm = k*(vgs-Vth); + gd = 1/rd; + didT= (dkdT/(2))*(vgs-Vth)^2; + + endif + + P = -ids * vds; + dPdT = -didT* vds; + dPdvgs = -(gm*vds); + dPdvds = -(gd*vds + ids); + +endfunction + +function [gm,gd,ids,didT,P,dPdT,dPdvgs,dPdvds] = pmos(extvar,mu0,Cox,W,L,Vth,rd,Tshift) + ##Computes values for pmos case + + vg = extvar(1); + vs = extvar(2); + vd = extvar(3); + vb = extvar(4); + T = extvar(5); + + k = - mu0 * Cox * ((T + Tshift)/300)^(-3/2) *W/L; + dkdT = - mu0 * Cox * W *(-3/2)*((T + Tshift)/300)^(-5/2)*(1/300)/L; + + vgs = vg-vs; + vds = vd-vs; + + if (vgs > Vth) + + gm = 0; + gd = 1/rd; + ids = vds*gd; + didT= 0; + + elseif (((vgs-Vth) <= (vds)) && (vds <= 0)) + + ids = k*((vgs-Vth)*vds-(vds^2)/2)+vds/rd; + gm = k*vds; + gd = k*(vgs-Vth-vds)+1/rd; + didT= dkdT*((vgs-Vth)*vds-(vds^2)/2); + + elseif (((vgs-Vth) <= (vds)) && (vds > 0)) + + gm = 0; + gd = 1/rd; + ids = vds*gd; + didT= 0; + + else + + ids = (k/2)*(vgs-Vth)^2+vds/rd; + gm = k*(vgs-Vth); + gd = 1/rd; + didT= (dkdT/(2))*(vgs-Vth)^2; + + endif + + P = -ids * vds; + dPdT = -didT* vds; + dPdvgs = -(gm*vds); + dPdvds = -(gd*vds + ids); + +endfunction \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/sbn/Mtdnmos.cir b/octave_packages/ocs-0.1.3/sbn/Mtdnmos.cir new file mode 100644 index 0000000..5b42a70 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mtdnmos.cir @@ -0,0 +1,29 @@ +% 0.1b1 +% A Simple MOSFET model +% including charge stores +% N-Mosfet +Mnmosfet simple 4 3 +1 3 +k Vth rd +1 1 1e30 +1 5 6 4 +END +% Resistors +Mresistors LIN 2 1 +2 1 +R +1 +1 +2 5 +3 6 +% Capacitors +Mcapacitors LIN 2 1 +3 1 +C +1 +1 +1 +1 5 +1 6 +1 4 +END diff --git a/octave_packages/ocs-0.1.3/sbn/Mtdnmos.nms b/octave_packages/ocs-0.1.3/sbn/Mtdnmos.nms new file mode 100644 index 0000000..5c386a8 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mtdnmos.nms @@ -0,0 +1,10 @@ +% 0.1b1 +1 Vg +2 Vs +3 Vd +4 Vb +5 Vsi +6 Vdi +7 Qs +8 Qd +9 Qb \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/sbn/Mtdpmos.cir b/octave_packages/ocs-0.1.3/sbn/Mtdpmos.cir new file mode 100644 index 0000000..8c31bfc --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mtdpmos.cir @@ -0,0 +1,29 @@ +% 0.1b1 +% A Simple MOSFET model +% including charge stores +% N-Mosfet +Mpmosfet simple 4 3 +1 3 +k Vth rd +1 1 1e30 +1 5 6 4 +END +% Resistors +Mresistors LIN 2 1 +2 1 +R +1 +1 +2 5 +3 6 +% Capacitors +Mcapacitors LIN 2 1 +3 1 +C +1 +1 +1 +1 5 +1 6 +1 4 +END diff --git a/octave_packages/ocs-0.1.3/sbn/Mtdpmos.nms b/octave_packages/ocs-0.1.3/sbn/Mtdpmos.nms new file mode 100644 index 0000000..5c386a8 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mtdpmos.nms @@ -0,0 +1,10 @@ +% 0.1b1 +1 Vg +2 Vs +3 Vd +4 Vb +5 Vsi +6 Vdi +7 Qs +8 Qd +9 Qb \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/sbn/Mvoltagesources.m b/octave_packages/ocs-0.1.3/sbn/Mvoltagesources.m new file mode 100644 index 0000000..b0a9819 --- /dev/null +++ b/octave_packages/ocs-0.1.3/sbn/Mvoltagesources.m @@ -0,0 +1,183 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## +## @deftypefn{Function File} @ +## {[@var{a},@var{b},@var{c}]=} Mvoltagesources(@var{string},@var{parameters},@ +## @var{parameternames},@var{extvar},@var{intvar},@var{t}) +## +## SBN file implementing models for voltage sources. +## +## @var{string} is used to select among models. Parameters are listed +## as inner items. Possible models are: +## +## @enumerate +## @item @var{string} = "DC" (Static indipendent voltage source) +## @itemize @minus +## @item V -> Current source value +## @end itemize +## @item @var{string} = "sinwave" (Sinusoidal indipendent voltage +## source) +## @itemize @minus +## @item shift -> mean value of sinusoidal input +## @item Ampl -> amplitude of sinusoidal wave +## @item f -> frequency of sinusoidal wave +## @item delay -> delay of sinusoidal wave +## @end itemize +## @item @var{string} = "pwl" (Piecewise linear voltage source) +## @itemize @minus +## @item takes as parameter times and values. For example @code{0 1 4 6} +## means at time instant 0 value 1, at time instant 4 value 6, etc. +## @end itemize +## @item @var{string} = "squarewave" (Square wave) +## @itemize @minus +## @item low -> low-state value +## @item high -> high-state value +## @item tlow -> duration of low-state +## @item thigh -> duration of high-state +## @item delay -> delay of square wave +## @item start -> starting voltage value +## @end itemize +## @item @var{string} = "step" (Voltage step) +## @itemize @minus +## @item low -> low-state value +## @item high -> high-state value +## @item tstep -> time instant of step transition +## @end itemize +## @item @var{string} = "VCVS" (Voltage controlled voltage source) +## @itemize @minus +## @item K -> Control parameter +## @end itemize +## @end enumerate +## +## See the @cite{IFF file format specifications} for details about +## the output structures. +## +## @seealso{prs_iff,asm_initialize_system,asm_build_system} +## @end deftypefn + +function [a,b,c] = Mvoltagesources (string,parameters,parameternames,extvar,intvar,t) + + if isempty(intvar) + intvar = 0; + endif + + switch string + ##LCR part + case "DC" + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + j = intvar(1); + + a = zeros(3); + b = [0 0 1;0 0 -1;1 -1 0]; + c = [0 0 -V]; + break + ## NLC part + case "sinwave" + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + + DV = shift+Ampl * sin(2*pi*(t+delay)*f ); + j = intvar(1); + + a = zeros(3); + b = [0 0 1;0 0 -1;1 -1 0]; + c = [0 0 -DV]' + b * [extvar;intvar]; + break + + case "pwl" + + times = parameters(1:2:end-1); + values= parameters(2:2:end); + + DV = interp1(times,values,t,"linear","extrap"); + j = intvar(1); + + a = zeros(3); + b = [0 0 1;0 0 -1;1 -1 0]; + c = [0 0 -DV]' + b * [extvar;intvar]; + break + + case "squarewave" + for ii=1:length(parameternames) + eval([parameternames{ii} "=" num2str(parameters(ii)) ";"]) + endfor + if t +# name: cache +# type: cell +# rows: 3 +# columns: 10 +# name: +# type: sq_string +# elements: 1 +# length: 11 +Mcapacitors + + +# name: +# type: sq_string +# elements: 1 +# length: 968 + -- Function File: [A,B,C]= Mcapacitors(STRING,PARAMETERS, + PARAMETERNAMES,EXTVAR,INTVAR,T) + SBN file implementing models for capacitors. + + STRING is used to select among models. Parameters are listed as + inner items. Possible models are: + + 1. STRING = "LIN" (Linear Capacitor) + - C -> capacitance value + + 2. STRING = "MULTICAP" (Multipole Capacitor) + - C -> capacitance values + + 3. STRING = "PDE_NMOS" (Drift-Diffusion PDE NMOS capacitor) + - tbulk -> bulk thickness + + - tox -> oxide thickness + + - Nnodes -> number of nodes of 1D grid + + - Na -> bulk doping + + - toll -> absolute tolerance + + - maxit -> max iterations number + + - Area -> device area + + See the `IFF file format specifications' for details about the + output structures. + + See also: prs_iff, asm_initialize_system, asm_build_system + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 +SBN file implementing models for capacitors. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +Mcurrentsources + + +# name: +# type: sq_string +# elements: 1 +# length: 1014 + -- Function File: [A,B,C]= Mcurrentsources(STRING,PARAMETERS, + PARAMETERNAMES,EXTVAR,INTVAR,T) + SBN file implementing models for current sources. + + STRING is used to select among models. Parameters are listed as + inner items. Possible models are: + + 1. STRING = "DC" (Static indipendent current source) + - I -> Current source value + + 2. STRING = "VCCS" (Voltage controlled current source) + - K -> Control parameter + + 3. STRING = "sinwave" (Sinusoidal indipendent current source) + - shift -> mean value of sinusoidal input + + - Ampl -> amplitude of sinusoidal wave + + - f -> frequency of sinusoidal wave + + - delay -> delay of sinusoidal wave + + 4. STRING = "VCPS" (Voltage controlled power source) + - K -> Control parameter + + See the `IFF file format specifications' for details about the + output structures. + + See also: prs_iff, asm_initialize_system, asm_build_system + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +SBN file implementing models for current sources. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +Mdiode + + +# name: +# type: sq_string +# elements: 1 +# length: 937 + -- Function File: [A,B,C]= Mdiode(STRING,PARAMETERS, + PARAMETERNAMES,EXTVAR,INTVAR,T) + SBN file implementing models for diodes. + + STRING is used to select among models. Parameters are listed as + inner items. Possible models are: + + - STRING = "simple" (Usual exponential diode model) + - Is -> reverse current + + - Vth -> thermal voltage + + - Rpar -> parasitic resistance + + - STRING = "PDEsymmetric" (Drift-Diffusion PDE model) + - len -> diode length + + - Nnodes -> number of nodes of 1D grid + + - Dope -> doping (abrupt and symmetric) + + - toll -> absolute tolerance + + - maxit -> max iterations number + + - Area -> device area + + See the `IFF file format specifications' for details about the + output structures. + + See also: prs_iff, asm_initialize_system, asm_build_system + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +SBN file implementing models for diodes. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +Minductors + + +# name: +# type: sq_string +# elements: 1 +# length: 505 + -- Function File: [A,B,C]= Minductors(STRING,PARAMETERS, + PARAMETERNAMES,EXTVAR,INTVAR,T) + SBN file implementing models for inductors. + + STRING is used to select among models. Parameters are listed as + inner items. Possible models are: + + 1. STRING = "LIN" (Linear inductor model) + - L -> inductance value + + See the `IFF file format specifications' for details about the + output structures. + + See also: prs_iff, asm_initialize_system, asm_build_system + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +SBN file implementing models for inductors. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +Mnmosfet + + +# name: +# type: sq_string +# elements: 1 +# length: 1105 + -- Function File: [A,B,C]= Mnmosfet(STRING,PARAMETERS, + PARAMETERNAMES,EXTVAR,INTVAR,T) + SBN file implementing standard models for n-mosfets. + + STRING is used to select among models. Parameters are listed as + inner items. Possible models are: + + 1. STRING = "simple" (Standard model for MOSFET) + - rd -> parasitic resistance between drain and source + + - k -> k parameter for usual mosfet model + + - Vth -> threshold voltage + + 2. STRING = "lincap" (Adds RC parasitics) + - rd -> parasitic resistance between drain and source + + - k -> k parameter for usual mosfet model + + - Vth -> threshold voltage + + - Rs -> parasitic source resistance + + - Rd -> parasitic drain resistance + + - Cs -> gate-source capacitance + + - Cd -> gate-drain capacitance + + - Cb -> gate-bulk capacitance + + See the `IFF file format specifications' for details about the + output structures. + + See also: prs_iff, asm_initialize_system, asm_build_system + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +SBN file implementing standard models for n-mosfets. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +Mpdesympnjunct + + +# name: +# type: sq_string +# elements: 1 +# length: 184 + -- Function File: [J,G]= Mpdesympnjunct (LEN, DOPE, VA, AREA, NNODES, + TOLL, MAXIT, PTOLL, PMAXIT) + INTERNAL FUNCTION: + + NOT SUPPOSED TO BE CALLED DIRECTLY BY USERS + + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +INTERNAL FUNCTION: + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +Mpmosfet + + +# name: +# type: sq_string +# elements: 1 +# length: 1105 + -- Function File: [A,B,C]= Mpmosfet(STRING,PARAMETERS, + PARAMETERNAMES,EXTVAR,INTVAR,T) + SBN file implementing standard models for p-mosfets. + + STRING is used to select among models. Parameters are listed as + inner items. Possible models are: + + 1. STRING = "simple" (Standard model for MOSFET) + - rd -> parasitic resistance between drain and source + + - k -> k parameter for usual mosfet model + + - Vth -> threshold voltage + + 2. STRING = "lincap" (Adds RC parasitics) + - rd -> parasitic resistance between drain and source + + - k -> k parameter for usual mosfet model + + - Vth -> threshold voltage + + - Rs -> parasitic source resistance + + - Rd -> parasitic drain resistance + + - Cs -> gate-source capacitance + + - Cd -> gate-drain capacitance + + - Cb -> gate-bulk capacitance + + See the `IFF file format specifications' for details about the + output structures. + + See also: prs_iff, asm_initialize_system, asm_build_system + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +SBN file implementing standard models for p-mosfets. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +Mresistors + + +# name: +# type: sq_string +# elements: 1 +# length: 1080 + -- Function File: [A,B,C]= Mresistors(STRING,PARAMETERS, + PARAMETERNAMES,EXTVAR,INTVAR,T) + SBN file implementing models for resistors. + + STRING is used to select among models. Parameters are listed as + inner items. Possible models are: + + 1. STRING = "LIN" (Linear resistor) + - R -> resistance value + + 2. STRING = "THERMAL" (Linear resistor with termal pin) + - R0 -> reference resistance value at temperature `TNOM' + + - TC1 -> coefficient for first order Taylor expansion + + - TC2 -> coefficient for second order Taylor expansion + + - TNOM -> reference temperature + + 3. STRING = "THERMAL1D" (1D Thermal resistor) + - L -> length of 1D domain + + - N -> number of discretized elements + + - cv -> PDE coefficient for dynamic part + + - k -> PDE coefficient for diffusion part + + See the `IFF file format specifications' for details about the + output structures. + + See also: prs_iff, asm_initialize_system, asm_build_system + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +SBN file implementing models for resistors. + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +Mshichmanhodgesmosfet + + +# name: +# type: sq_string +# elements: 1 +# length: 1124 + -- Function File: [A,B,C]= Mshichmanhodgesmosfet(STRING,PARAMETERS, + PARAMETERNAMES,EXTVAR,INTVAR,T) + SBN file implementing Schichman-Hodges MOSFETs model. + + STRING is used to select among models. Possible models are: + + 1. STRING = "NMOS" (Schichman-Hodges n-MOSFET) + + 2. STRING = "PMOS" (Schichman-Hodges p-MOSFET) + + Parameters for all the above models are: + * rd -> parasitic resistance between drain and source + + * W -> MOSFET width + + * L -> channel length + + * mu0 -> reference value for mobility + + * Vth -> threshold voltage + + * Cox -> oxide capacitance + + * Cgs -> gate-source capacitance + + * Cgd -> gate-drain capacitance + + * Cgb -> gate-bulk capacitance + + * Csb -> source-bulk capacitance + + * Cdb -> drain-bulk capacitance + + * Tshift -> shift for reference temperature on MOSFETs (default + 0) + + See the `IFF file format specifications' for details about the + output structures. + + See also: prs_iff, asm_initialize_system, asm_build_system + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +SBN file implementing Schichman-Hodges MOSFETs model. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +Mvoltagesources + + +# name: +# type: sq_string +# elements: 1 +# length: 1643 + -- Function File: [A,B,C]= Mvoltagesources(STRING,PARAMETERS, + PARAMETERNAMES,EXTVAR,INTVAR,T) + SBN file implementing models for voltage sources. + + STRING is used to select among models. Parameters are listed as + inner items. Possible models are: + + 1. STRING = "DC" (Static indipendent voltage source) + - V -> Current source value + + 2. STRING = "sinwave" (Sinusoidal indipendent voltage source) + - shift -> mean value of sinusoidal input + + - Ampl -> amplitude of sinusoidal wave + + - f -> frequency of sinusoidal wave + + - delay -> delay of sinusoidal wave + + 3. STRING = "pwl" (Piecewise linear voltage source) + - takes as parameter times and values. For example `0 1 4 + 6' means at time instant 0 value 1, at time instant 4 + value 6, etc. + + 4. STRING = "squarewave" (Square wave) + - low -> low-state value + + - high -> high-state value + + - tlow -> duration of low-state + + - thigh -> duration of high-state + + - delay -> delay of square wave + + - start -> starting voltage value + + 5. STRING = "step" (Voltage step) + - low -> low-state value + + - high -> high-state value + + - tstep -> time instant of step transition + + 6. STRING = "VCVS" (Voltage controlled voltage source) + - K -> Control parameter + + See the `IFF file format specifications' for details about the + output structures. + + See also: prs_iff, asm_initialize_system, asm_build_system + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +SBN file implementing models for voltage sources. + + + + + diff --git a/octave_packages/ocs-0.1.3/tst/doc-cache b/octave_packages/ocs-0.1.3/tst/doc-cache new file mode 100644 index 0000000..1357440 --- /dev/null +++ b/octave_packages/ocs-0.1.3/tst/doc-cache @@ -0,0 +1,239 @@ +# Created by Octave 3.6.1, Sun Mar 25 17:34:24 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 4 +# name: +# type: sq_string +# elements: 1 +# length: 18 +tst_backward_euler + + +# name: +# type: sq_string +# elements: 1 +# length: 1396 + -- Function File: [OUT,NITER] = tst_backward_euler(CIRSTRUCT,X,T,TOL, + MAXIT,PLTVARS,VERBOSITY,DAE_FUN) + Perform a transient simulation of the system described by + CIRSTRUCT over the time interval T using the backward Euler + algorithm. + + The initial value for the state vector is computed by solving a + steady state problem at T(1), with starting guess X. + + TOL and MAXIT are parameters passed to `nls_newton_raphson'. + + The output OUT will contain the value of the state vector at each + point of T. + + The optional parameter VERBOSITY controls the amount of output + produced: + + - if verbosity(1) != 0, information on the progress of the + algorithm are output at runtime + + - if verbosity(2) != 0, the plot of the variables whose names + are listed in PLTVARS is produced after the computation + + For special purposes one may need to pass modified jacobian and + residual functions. This can be done via the cell array of function + handles DAE_FUN. + + Such functions should have the same input and output parameter + list as the default sub-functions TSTBWEFUNJAC0,TSTBWEFUNRES0, + TSTBWEFUNJAC,TSTBWEFUNRES. + + The optional output NITER returns the number of Newton iterations + needed to reach convergence. + + See also: tst_daspk, tst_theta_method, tst_odepkg, + nls_newton_raphson + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Perform a transient simulation of the system described by CIRSTRUCT +over the tim + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +tst_daspk + + +# name: +# type: sq_string +# elements: 1 +# length: 1375 + -- Function File: [OUT] = tst_daspk (CIRSTRUCT,X,T,TOL,MAXIT, + PLTVARS,VERBOSITY,DASKOPTS,DAE_FUN); + Perform a transient simulation of the system described by + CIRSTRUCT over the time interval T using `daspk'. + + The initial value for the state vector is computed by solving a + steady state problem at T(1), with starting guess X. + + TOL and MAXIT are parameters passed to `nls_newton_raphson'. + + The output OUT will contain the value of the state vector at each + point of T. + + Extra options for `daspk' can be passed as name/value pairs in the + cellarray DASKOPTS. + + The optional parameter VERBOSITY controls the amount of output + produced: + + - if verbosity(1) != 0, information on the progress of the + algorithm are output at runtime + + - if verbosity(2) != 0, the plot of the variables whose names + are listed in PLTVARS is produced after the computation + + For special purposes one may need to pass modified jacobian and + residual functions. This can be done via the cell array of function + handles DAE_FUN. + + Such functions should have the same input and output parameter + list as the default sub-functions TSTBWEFUNJAC0,TSTBWEFUNRES0, + TSTBWEFUNJAC,TSTBWEFUNRES. + + See also: tst_backward_euler, tst_odepkg, tst_theta_method, + nls_newton_raphson, daspk + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Perform a transient simulation of the system described by CIRSTRUCT +over the tim + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +tst_odepkg + + +# name: +# type: sq_string +# elements: 1 +# length: 1325 + -- Function File: [OUT, [TOUT]] = tst_odepkg (CIRSTRUCT,X,T,TOL,MAXIT, + PLTVARS,SOLVER,ODESTRUCT,VERBOSITY); + Perform a transient simulation of the system described by + CIRSTRUCT over the time interval T using the `odepkg' DAE solver + specified in SOLVER. + + Pssible values for SOLVER are `ode2r', `ode5r', `oders' or `odesx'. + + The initial value for the state vector is computed by solving a + steady state problem at T(1), with starting guess X. + + TOL and MAXIT are parameters passed to `nls_newton_raphson'. + + If one output is requested OUT will contain the value of the state + vector at each point of T. + + If two outputs are requested OUT will contain the value of the + state vector at each point of TOUT. + + Extra options for options for the solver can be passed to the + solver via ODESTRUCT. + + The optional parameter VERBOSITY controls the amount of output + produced: + + - if verbosity(1) != 0, information on the progress of the + algorithm are output at runtime + + - if verbosity(2) != 0, the plot of the variables whose names + are listed in PLTVARS is produced after the computation + + See also: tst_backward_euler, tst_theta_method, tst_daspk, + nls_newton_raphson, odepkg, odeset, ode2r, ode5r, oders, odesx + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Perform a transient simulation of the system described by CIRSTRUCT +over the tim + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +tst_theta_method + + +# name: +# type: sq_string +# elements: 1 +# length: 1072 + -- Function File: [OUT,NITER] = tst_theta_method (CIRSTRUCT,X,T,TOL, + MAXIT,THETA,PLTVARS, VERBOSITY); + Perform a transient simulation of the system described by + CIRSTRUCT over the time interval T using the theta-method with + parameter THETA. + + The initial value for the state vector is computed by solving a + steady state problem at T(1), with starting guess X. + + TOL and MAXIT are parameters passed to `nls_newton_raphson'. + + The output OUT will contain the value of the state vector at each + point of T. + + The optional parameter VERBOSITY controls the amount of output + produced: + + - if verbosity(1) != 0, information on the progress of the + algorithm are output at runtime + + - if verbosity(2) != 0, the plot of the variables whose names + are listed in PLTVARS is produced after the computation + + The optional output NITER returns the number of Newton iterations + needed to reach convergence. + + See also: tst_backward_euler, tst_daspk, tst_odepkg, + nls_newton_raphson + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Perform a transient simulation of the system described by CIRSTRUCT +over the tim + + + + + diff --git a/octave_packages/ocs-0.1.3/tst/tst_backward_euler.m b/octave_packages/ocs-0.1.3/tst/tst_backward_euler.m new file mode 100644 index 0000000..d89f4ed --- /dev/null +++ b/octave_packages/ocs-0.1.3/tst/tst_backward_euler.m @@ -0,0 +1,179 @@ +## Copyright (C) 2006,2007,2008,2011 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## +## @deftypefn{Function File} {[@var{out},@var{niter}] =} @ +## tst_backward_euler(@var{cirstruct},@var{x},@var{t},@var{tol},@ +## @var{maxit},@var{pltvars},@var{verbosity},@var{dae_fun}) +## +## Perform a transient simulation of the system described by +## @var{cirstruct} over the time interval @var{t} using the backward +## Euler algorithm. +## +## The initial value for the state vector is computed by solving a +## steady state problem at @var{t}(1), with starting guess @var{x}. +## +## @var{tol} and @var{maxit} are parameters passed to +## @code{nls_newton_raphson}. +## +## The output @var{out} will contain the value of the state vector at +## each point of @var{t}. +## +## The optional parameter @var{verbosity} controls the amount of +## output produced: +## +## @itemize @minus +## @item if verbosity(1) != 0, information on the progress +## of the algorithm are output at runtime +## @item if verbosity(2) != 0, the plot of the variables whose names +## are listed in @var{pltvars} is +## produced after the computation +## @end itemize +## +## For special purposes one may need to pass modified jacobian and +## residual functions. This can be done via the cell array of function +## handles @var{dae_fun}. +## +## Such functions should have the same input and output +## parameter list as the default sub-functions +## TSTBWEFUNJAC0,TSTBWEFUNRES0, TSTBWEFUNJAC,TSTBWEFUNRES. +## +## The optional output @var{niter} returns the number of Newton iterations +## needed to reach convergence. +## +## @seealso{tst_daspk,tst_theta_method,tst_odepkg,nls_newton_raphson} +## +## @end deftypefn + +function [out, varargout] = tst_backward_euler (outstruct, x, t, tol, maxit, pltvars, verbosity, dae_fun) + + ## Check input + ## FIXME: add input check! + if ((nargin < 6) || (nargin > 8)) + error ("tst_backward_euler: wrong number of input parameters."); + endif + + if ~exist ("verbosity") + verbosity = [0,0]; + elseif (length (verbosity) < 2) + verbosity(2) = 0; + endif + + out = zeros (rows (x), columns (t)); + out(:,1) = x; + + if nargout > 1 + niter = zeros (length(t),1); + endif + + if (verbosity(1)) + fprintf (1, "Initial value.\n"); + endif + + + [A0, B, C] = asm_initialize_system (outstruct, x); + + if (nargin > 8) + JAC = @(x) dae_fun{1} (outstruct,x,t(1),B); + RES = @(x) dae_fun{2} (outstruct,x,t(1),B,C); + [out(:,1), ii, resnrm] = nls_newton_raphson (x, RES, JAC, tol, maxit, verbosity(1)); + else + [out(:,1),ii] = nls_stationary (outstruct, x, tol, maxit); + endif + + if (nargout > 1) + niter(1) = ii; + endif + + for it = 2:length (t) + + if (verbosity(1)) + fprintf (1,"Timestep #%d.\n",it); + endif + + if nargin > 8 + JAC = @(x) dae_fun{3} (outstruct, x, t(it-1), t(it), A0, B); + RES = @(x) dae_fun{4} (outstruct, x, out(:,it-1), t(it-1), t(it), A0, B, C); + else + JAC = @(x,A1,Jac,res) TSTBWEFUNJAC1(outstruct, x, t(it-1), + t(it), A0, B, A1, Jac, res); + RES = @(x,A1,Jac,res) TSTBWEFUNRES1(outstruct, x, out(:,it-1), + t(it-1), t(it), A0, B, C, + A1, Jac, res); + UPDT = @(x) TSTBWEFUNUP1 (outstruct, x, t(it)); + endif + + [out(:,it),ii,resnrm] = nls_newton_raphson (out(:,it-1), RES, JAC, tol, maxit, verbosity(1), UPDT); + + if nargout > 1 + niter(it) = ii; + endif + + if (verbosity(2)) + utl_plot_by_name (t(1:it), out(:,1:it), outstruct, pltvars); + drawnow (); + endif + + ## Stop at runtime + ## FIXME: maintain this part? + if exist("~/.stop_ocs","file") + printf("stopping at timestep %d\n",it); + unix("rm ~/.stop_ocs"); + break + end + + endfor + + if nargout > 1 + varargout{1} = niter; + endif + +endfunction + +## Jacobian for transient problem +function lhs = TSTBWEFUNJAC1 (outstruct, x, t0, t1, A0, B, A1, Jac, res) + + DT = t1-t0; + if (nargin < 9) + [A1, Jac, res] = asm_build_system (outstruct, x, t1); + endif + lhs = ((A0+A1)/DT + B + Jac); + +endfunction + +## Residual for transient problem +function rhs = TSTBWEFUNRES1 (outstruct, x, xold, t0, t1, A0, B, C, A1, Jac, res) + + DT = t1-t0; + if ( nargin < 11 ) + [A1, Jac, res] = asm_build_system (outstruct, x, t1); + endif + rhs = (res + C + B*x + (A0+A1)*(x-xold)/DT); + +endfunction + +## Update for transient problem +function update = TSTBWEFUNUP1 (outstruct, x, t1) + + [A1, Jac, res] = asm_build_system (outstruct, x, t1); + update = {A1, Jac, res}; + +endfunction \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/tst/tst_daspk.m b/octave_packages/ocs-0.1.3/tst/tst_daspk.m new file mode 100644 index 0000000..92cf69e --- /dev/null +++ b/octave_packages/ocs-0.1.3/tst/tst_daspk.m @@ -0,0 +1,135 @@ +## Copyright (C) 2006,2007,2008,2011 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## +## @deftypefn{Function File} {[@var{out}] =} tst_daspk @ +## (@var{cirstruct},@var{x},@var{t},@var{tol},@var{maxit},@ +## @var{pltvars},@var{verbosity},@var{daskopts},@var{dae_fun}); +## +## Perform a transient simulation of the system described by +## @var{cirstruct} over the time interval @var{t} using @code{daspk}. +## +## The initial value for the state vector is computed by solving a +## steady state problem at @var{t}(1), with starting guess @var{x}. +## +## @var{tol} and @var{maxit} are parameters passed to +## @code{nls_newton_raphson}. +## +## The output @var{out} will contain the value of the state vector +## at each point of @var{t}. +## +## Extra options for @code{daspk} can be passed as name/value pairs in +## the cellarray @var{daskopts}. +## +## The optional parameter @var{verbosity} controls the amount of +## output produced: +## +## @itemize @minus +## @item if verbosity(1) != 0, information on the progress +## of the algorithm are output at runtime +## @item if verbosity(2) != 0, the plot of the variables whose names +## are listed in @var{pltvars} is +## produced after the computation +## @end itemize +## +## For special purposes one may need to pass modified jacobian and +## residual functions. This can be done via the cell array of function +## handles @var{dae_fun}. +## +## Such functions should have the same input and output +## parameter list as the default sub-functions +## TSTBWEFUNJAC0,TSTBWEFUNRES0, TSTBWEFUNJAC,TSTBWEFUNRES. +## +## @seealso{tst_backward_euler,tst_odepkg,tst_theta_method,nls_newton_raphson,daspk} +## +## @end deftypefn + +function [out] = tst_daspk (outstruct, x, t, tol, maxit, pltvars, verbosity, daspkopts, dae_fun) + + ## FIXME: add input check! + if ((nargin < 6) || (nargin > 9)) + error ("tst_daspk: wrong number of input parameters."); + endif + + if (! exist ("verbosity")) + verbosity = [0, 0]; + elseif (length (verbosity) < 2) + verbosity(2) = 0; + endif + + if (verbosity(1)) + fprintf (1, "initial value:\n"); + endif + + daspk_options ("print initial condition info",1); + daspk_options ("maximum order",2); + daspk_options ("initial step size",t(2)-t(1)); + daspk_options ("relative tolerance",1e-3); + + if (nargin > 8) + for ii = 1:2:length (daspkopts) + daspk_options (daspkopts{ii}, daspkopts{ii+1}); + endfor + endif + + + [A0, B, C] = asm_initialize_system (outstruct, x); + + if (nargin > 9) + JAC = @(x) dae_fun{1} (outstruct, x, t(1), B); + RES = @(x) dae_fun{2} (outstruct, x, t(1), B, C); + [x, ii, resnrm] = nls_newton_raphson (x, RES, JAC, tol, maxit, verbosity); + else + [out(:,1), ii] = nls_stationary (outstruct, x, tol, maxit); + endif + + if (nargin > 9) + JAC = @(x) dae_fun{3} (outstruct, x, t(1), B); + RES = @(x) dae_fun{4} (outstruct, x, t(1), B, C); + else + JAC = @(x,xdot,t,c) TSTDASPKFUNJAC (outstruct, x, xdot, A0, B, t, c); + RES = @(x,xdot,t) TSTDASPKFUNRES (outstruct, x, xdot, A0, B, C, t); + endif + + [out, xdot, istate, msg] = daspk ({RES,JAC}, out(:,1), zeros (size (x)), t); + + out = out.'; + if (verbosity(2)) + utl_plot_by_name (t, out, outstruct, pltvars) + endif + +endfunction + +## Jacobian for transient problem +function lhs = TSTDASPKFUNJAC (outstruct, x, xdot, A0, B, t, c) + + [A1, Jac, res] = asm_build_system (outstruct, x, t); + lhs = (c*(A0+A1) + B + Jac); + +endfunction + +## Residual for transient problem +function rhs = TSTDASPKFUNRES (outstruct, x, xdot, A0, B, C, t) + + [A1, Jac, res] = asm_build_system (outstruct, x, t); + rhs = (A0+A1)*xdot + B*x + C + res; + +endfunction \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/tst/tst_odepkg.m b/octave_packages/ocs-0.1.3/tst/tst_odepkg.m new file mode 100644 index 0000000..8524d47 --- /dev/null +++ b/octave_packages/ocs-0.1.3/tst/tst_odepkg.m @@ -0,0 +1,164 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## +## @deftypefn{Function File} {[@var{out}, [@var{tout}]] =} tst_odepkg @ +## (@var{cirstruct},@var{x},@var{t},@var{tol},@var{maxit},@ +## @var{pltvars},@var{solver},@var{odestruct},@var{verbosity}); +## +## Perform a transient simulation of the system described by +## @var{cirstruct} over the time interval @var{t} using the @code{odepkg} DAE +## solver specified in @var{solver}. +## +## Pssible values for @var{solver} are @code{ode2r}, @code{ode5r}, +## @code{oders} or @code{odesx}. +## +## The initial value for the state vector is computed by solving a +## steady state problem at @var{t}(1), with starting guess @var{x}. +## +## @var{tol} and @var{maxit} are parameters passed to @code{nls_newton_raphson}. +## +## If one output is requested @var{out} will contain the value of the state vector +## at each point of @var{t}. +## +## If two outputs are requested @var{out} will contain the value of the state vector +## at each point of @var{tout}. +## +## Extra options for options for the solver can be passed to the solver +## via @var{odestruct}. +## +## The optional parameter @var{verbosity} controls the amount of +## output produced: +## +## @itemize @minus +## @item if verbosity(1) != 0, information on the progress +## of the algorithm are output at runtime +## @item if verbosity(2) != 0, the plot of the variables whose names +## are listed in @var{pltvars} is +## produced after the computation +## @end itemize +## +## @seealso{tst_backward_euler,tst_theta_method,tst_daspk,nls_newton_raphson,odepkg,odeset,@ +## ode2r,ode5r,oders,odesx} +## +## @end deftypefn + +function [out, tout] = tst_odepkg (outstruct,x,t,tol,maxit,\ + pltvars,solver,verbosity,odestruct) + + ## Check input + ## FIXME: add input check! + if ((nargin < 7) || (nargin > 9)) + error("tst_odepkg:wrong number of input parameters"); + endif + + if ~exist("verbosity") + verbosity = [0,0]; + elseif length(verbosity)<2 + verbosity(2) =0; + endif + + if(verbosity(1)) + fprintf(1,"initial value:\n"); + endif + + if ~exist("odestruct") + odestruct = odeset(); + endif + + [A0,B,C] = asm_initialize_system(outstruct,x); + + [out(:,1),ii] = nls_stationary(outstruct,x,tol,maxit); + + JAC = @(t, x) TSTODEPKGFUNJAC(outstruct, x, A0, B, t); + RES = @(t, x) TSTODEPKGFUNRES(outstruct, x, A0, B, C, t); + MASS= @(t, x) TSTODEPKGFUNMASS(outstruct, x, A0, t); + + odestruct = odeset(odestruct,"Jacobian", JAC); + odestruct = odeset(odestruct,"Mass",MASS(0,x)); + odestruct = odeset(odestruct,"RelTol", 1e-6,"AbsTol",1e6*eps, + "MaxStep", max(diff(t)),"InitialStep",(diff(t))(1)); + + if verbosity(2) + odestruct = odeset(odestruct, "OutputFcn", + @(t, y, flag) plotfun(t, y, flag, outstruct, pltvars) ); + endif + + [tout, out] = feval( solver, RES, t([1 end]), x, odestruct); + if (nargout < 2) + out = interp1(tout, out, t).'; + endif + +endfunction + +function [varargout] = plotfun (vt, vy, vflag, outstruct, pltvars) + ## this function is a modified version of odeplot distributed + ## with odepkg (c) Thomas Treichl + + %# No input argument check is done for a higher processing speed + persistent vfigure; persistent vtold; + persistent vyold; persistent vcounter; + + if (strcmp (vflag, "init")) + %# Nothing to return, vt is either the time slot [tstart tstop] + %# or [t0, t1, ..., tn], vy is the inital value vector 'vinit' + vfigure = figure; vtold = vt(1,1); vyold = vy(:,1); + vcounter = 1; + + elseif (isempty (vflag)) + %# Return something in varargout{1}, either false for 'not stopping + %# the integration' or true for 'stopping the integration' + vcounter = vcounter + 1; figure (vfigure); + vtold(vcounter,1) = vt(1,1); + vyold(:,vcounter) = vy(:,1); + utl_plot_by_name(vtold, vyold, outstruct, pltvars); drawnow; + varargout{1} = false; + + elseif (strcmp (vflag, "done")) + %# Cleanup has to be done, clear the persistent variables because + %# we don't need them anymore + clear ("vfigure","vtold","vyold","vcounter"); + + endif + +endfunction +## Jacobian for transient problems +function lhs = TSTODEPKGFUNJAC(outstruct,x,A0,B,t) + + [A1,Jac,res] = asm_build_system(outstruct,x,t); + lhs = ( B + Jac); + +endfunction + +function lhs = TSTODEPKGFUNMASS(outstruct,x,A0,t) + + [A1,Jac,res] = asm_build_system(outstruct,x,t); + lhs = -(A0+A1); + +endfunction + +## Residual for transient problems +function rhs = TSTODEPKGFUNRES(outstruct,x,A0,B,C,t) + + [A1,Jac,res] = asm_build_system(outstruct,x,t); + rhs = B*x + C + res; + +endfunction \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/tst/tst_theta_method.m b/octave_packages/ocs-0.1.3/tst/tst_theta_method.m new file mode 100644 index 0000000..7004f26 --- /dev/null +++ b/octave_packages/ocs-0.1.3/tst/tst_theta_method.m @@ -0,0 +1,162 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## +## @deftypefn{Function File} {[@var{out},@var{niter}] =} tst_theta_method @ +## (@var{cirstruct},@var{x},@var{t},@var{tol},@ +## @var{maxit},@var{theta},@var{pltvars},@ +## @var{verbosity}); +## +## Perform a transient simulation of the system described by +## @var{cirstruct} over the time interval @var{t} using the +## theta-method with parameter @var{theta}. +## +## The initial value for the state vector is computed by solving a +## steady state problem at @var{t}(1), with starting guess @var{x}. +## +## @var{tol} and @var{maxit} are parameters passed to +## @code{nls_newton_raphson}. +## +## The output @var{out} will contain the value of the state vector at +## each point of @var{t}. +## +## The optional parameter @var{verbosity} controls the amount of +## output produced: +## +## @itemize @minus +## @item if verbosity(1) != 0, information on the progress +## of the algorithm are output at runtime +## @item if verbosity(2) != 0, the plot of the variables whose names +## are listed in @var{pltvars} is +## produced after the computation +## @end itemize +## +## The optional output @var{niter} returns the number of Newton iterations +## needed to reach convergence. +## +## @seealso{tst_backward_euler,tst_daspk,tst_odepkg,nls_newton_raphson} +## +## @end deftypefn + +function [out, varargout] = tst_theta_method(outstruct,x,t,tol,maxit,\ + theta,pltvars,verbosity) + + ## Check input + ## FIXME: add input check! + if ((nargin < 7) || (nargin > 8)) + error("tst_theta_method: wrong number of input parameters."); + endif + + if ~exist("verbosity") + verbosity = [0,0]; + elseif length(verbosity)<2 + verbosity(2) = 0; + endif + + out = zeros(rows(x),columns(t)); + out(:,1) = x; + + if nargout > 1 + niter = zeros(length(t),1); + endif + + if (verbosity(1)) + fprintf(1,"Initial value.\n"); + endif + + + [A0,B,C] = asm_initialize_system(outstruct,x); + + [out(:,1),ii] = nls_stationary(outstruct,x,tol,maxit); + + if nargout > 1 + niter(1) = ii; + endif + + for it=2:length(t) + + if(verbosity) + fprintf(1,"Timestep #%d.\n",it); + endif + + + [A1old,Jacold,resold] = asm_build_system(outstruct, out(:,it-1), t(it-1)); + + JAC = @(x,A1,Jac,res) TSTTHETAFUNJAC1(outstruct, x, t(it-1), + t(it), A0, B, theta, + A1, Jac, res); + RES = @(x,A1,Jac,res) TSTTHETAFUNRES1(outstruct, x, out(:,it-1), + t(it-1), t(it), A0, B, C, + resold, theta, A1, Jac, res); + UPDT = @(x) TSTTHETAFUNUP1 (outstruct, x, t(it)); + + [out(:,it),ii,resnrm] = nls_newton_raphson(out(:,it-1),RES,JAC,\ + tol, maxit,verbosity(1),\ + UPDT); + + if nargout > 1 + niter(it) = ii; + endif + + if (verbosity(2)) + utl_plot_by_name(t(1:it),out(:,1:it),outstruct,pltvars); + pause(.1); + endif + + if exist("~/.stop_ocs","file") + break + end + endfor + + if nargout > 1 + varargout{1} = niter; + endif + +endfunction + +## Jacobian for transient problem +function lhs = TSTTHETAFUNJAC1(outstruct, x, t0, t1, A0, B, theta, A1, Jac, res) + + DT = t1-t0; + if ( nargin < 10 ) + [A1,Jac,res] = asm_build_system(outstruct,x,t1); + endif + lhs = ( (A0+A1)/DT + theta*(B + Jac) ); + +endfunction +## Residual for transient problem +function rhs = TSTTHETAFUNRES1(outstruct, x, xold, t0, t1, A0, B, C, + resold, theta, A1, Jac, res) + DT = t1-t0; + if ( nargin < 13 ) + [A1,Jac,res] = asm_build_system(outstruct,x,t1); + endif + rhs = ( (A1+A0)*(x-xold)/DT + theta * (res + C + B*x) + + (1-theta) * (resold + C + B*xold) ); + +endfunction +## Update for transient problem +function update = TSTTHETAFUNUP1(outstruct,x,t1) + + [A1,Jac,res] = asm_build_system(outstruct,x,t1); + update = {A1,Jac,res}; + +endfunction \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/utl/doc-cache b/octave_packages/ocs-0.1.3/utl/doc-cache new file mode 100644 index 0000000..5eb8cdb --- /dev/null +++ b/octave_packages/ocs-0.1.3/utl/doc-cache @@ -0,0 +1,70 @@ +# Created by Octave 3.6.1, Sun Mar 25 17:34:24 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 2 +# name: +# type: sq_string +# elements: 1 +# length: 16 +utl_plot_by_name + + +# name: +# type: sq_string +# elements: 1 +# length: 467 + -- Function File: utl_plot_by_name(T,OUT, OUTSTRUCT,NAMELIST) + Select by name some elements of the state vector of the system + described by OUTSTRUCT and plot their dynamics over the time + interval T. + + NAMELIST should contain the list of names of the variables to plot. + OUT should be the output of a transient simulation over the time + interval T + + See also: tst_backward_euler, tst_daspk, tst_theta_method, + tst_odepkg, prs_iff + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Select by name some elements of the state vector of the system described +by OUTS + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +utl_sbn_server + + +# name: +# type: sq_string +# elements: 1 +# length: 163 + -- Function File: utl_sbn_server(PORT) + Listen for socket connections on port PORT, read a command and + return the corresponding output to the socket. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Listen for socket connections on port PORT, read a command and return +the corr + + + + + diff --git a/octave_packages/ocs-0.1.3/utl/utl_plot_by_name.m b/octave_packages/ocs-0.1.3/utl/utl_plot_by_name.m new file mode 100644 index 0000000..e9621df --- /dev/null +++ b/octave_packages/ocs-0.1.3/utl/utl_plot_by_name.m @@ -0,0 +1,59 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## @deftypefn{Function File} {} utl_plot_by_name(@var{t},@var{out}, @ +## @var{outstruct},@var{namelist}) +## +## Select by name some elements of the state vector of the system described +## by @var{outstruct} and plot their dynamics over the time interval +## @var{t}. +## +## @var{namelist} should contain the list of names of the variables +## to plot. +## @var{out} should be the output of a transient simulation over the +## time interval @var{t} +## +## @seealso{tst_backward_euler,tst_daspk,tst_theta_method,tst_odepkg,prs_iff} +## +## @end deftypefn + +function utl_plot_by_name (t, out, outstruct, namelist) + + if (nargin != 4) + error ("utl_plot_by_name: wrong number of input parameters.") + endif + + nn = length (outstruct.namesn); + leg = {}; ileg = 0; + for ip = 1:nn + for in = 1:length (namelist) + if (strcmp (namelist{in},outstruct.namess{ip})) + plot (t, out(outstruct.namesn(ip), :), sprintf("%d", mod (in+1, 6) + 1)); + leg{++ileg} = outstruct.namess{ip}; + hold on + endif + endfor + endfor + legend (leg{:}); + + hold off + +endfunction \ No newline at end of file diff --git a/octave_packages/ocs-0.1.3/utl/utl_sbn_server.m b/octave_packages/ocs-0.1.3/utl/utl_sbn_server.m new file mode 100644 index 0000000..410e081 --- /dev/null +++ b/octave_packages/ocs-0.1.3/utl/utl_sbn_server.m @@ -0,0 +1,96 @@ +## Copyright (C) 2006,2007,2008 Carlo de Falco +## +## This file is part of: +## OCS - A Circuit Simulator for Octave +## +## OCS is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program (see the file LICENSE); if not, +## see . +## +## author: Carlo de Falco + +## -*- texinfo -*- +## @deftypefn{Function File} {} utl_sbn_server(@var{port}) +## Listen for socket connections on port @var{port}, read a command @ +## and return the corresponding output to the socket. +## @end deftypefn + +function utl_sbn_server (portnum) + + QUITMESSAGE = "quit UTLsbnserver"; + CONFIRMMESSAGE = "confirmed"; + + ## CREATE THE SOCKET AND WAIT FOR CONNECTIONS + s = socket(AF_INET, SOCK_STREAM, 0); + if s < 0 + error("cannot create socket\n"); + end + + if bind(s, portnum) < 0 + error("bind failed\n"); + end + + if listen(s, 1) < 0 + error("listen failed\n"); + end + + ##MAIN LOOP + while 1 + + ##ACCEPT CONNECTIONS + c = accept(s); + if c < 0 + error("connection error") + end + + ## READ COMMANDS FROM THE SOCKET + msg = readstring (c) + + ##IF CLIENT SENT SHUTDOWN MESSAGE EXIT + if strcmp (msg,QUITMESSAGE) + printf("client requested server shutdown, goodbye!\n"); + disconnect(c); disconnect(s); + break + end + + ##EXECUTE COMMANDS FROM THE CLIENT + [A,B,C] = eval(msg); + + ##SEND OUTPUT TO THE CLIENT + str = [ sprintf("%17g ",A) "\n" sprintf("%17g ",B)... + "\n" sprintf("%17g ",C) "\n"] + + send(c,str); + + ##END CONNECTION + disconnect(c); + + end + + disconnect(s); +endfunction + + +function msg = readstring (c) + + BUFFER_SIZE = 255; + + msg = ''; + read = BUFFER_SIZE; + + while read >= BUFFER_SIZE + newmsg = char(recv(c, BUFFER_SIZE)); + read = length(newmsg) + msg = [ msg newmsg]; + end + +endfunction diff --git a/octave_packages/octcdf-1.1.4/@ncatt/datatype.m b/octave_packages/octcdf-1.1.4/@ncatt/datatype.m new file mode 100644 index 0000000..3258682 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncatt/datatype.m @@ -0,0 +1,3 @@ +function dt = datatype(self) + dt = ncdatatype(self); +end diff --git a/octave_packages/octcdf-1.1.4/@ncatt/name.m b/octave_packages/octcdf-1.1.4/@ncatt/name.m new file mode 100644 index 0000000..6bebacb --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncatt/name.m @@ -0,0 +1,7 @@ +function n = name(self,varargin) + if nargin == 1 + n = ncname(self); + else + ncname(self,varargin{:}); + end +end diff --git a/octave_packages/octcdf-1.1.4/@ncdim/isrecord.m b/octave_packages/octcdf-1.1.4/@ncdim/isrecord.m new file mode 100644 index 0000000..a214303 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncdim/isrecord.m @@ -0,0 +1,3 @@ +function isr = isrecord(self) + isr = ncisrecord(self); +end diff --git a/octave_packages/octcdf-1.1.4/@ncdim/name.m b/octave_packages/octcdf-1.1.4/@ncdim/name.m new file mode 100644 index 0000000..6bebacb --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncdim/name.m @@ -0,0 +1,7 @@ +function n = name(self,varargin) + if nargin == 1 + n = ncname(self); + else + ncname(self,varargin{:}); + end +end diff --git a/octave_packages/octcdf-1.1.4/@ncfile/att.m b/octave_packages/octcdf-1.1.4/@ncfile/att.m new file mode 100644 index 0000000..cafca5c --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncfile/att.m @@ -0,0 +1,3 @@ +function a = att(self) + a = ncatt(self); +end diff --git a/octave_packages/octcdf-1.1.4/@ncfile/close.m b/octave_packages/octcdf-1.1.4/@ncfile/close.m new file mode 100644 index 0000000..d66bd35 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncfile/close.m @@ -0,0 +1,3 @@ +function close (self) + ncclose (self) +end \ No newline at end of file diff --git a/octave_packages/octcdf-1.1.4/@ncfile/dim.m b/octave_packages/octcdf-1.1.4/@ncfile/dim.m new file mode 100644 index 0000000..97e9dbe --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncfile/dim.m @@ -0,0 +1,3 @@ +function d = dim(self) + d = ncdim(self); +end diff --git a/octave_packages/octcdf-1.1.4/@ncfile/endef.m b/octave_packages/octcdf-1.1.4/@ncfile/endef.m new file mode 100644 index 0000000..74789f2 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncfile/endef.m @@ -0,0 +1,3 @@ +function endef(self) + ncendef(self) +end diff --git a/octave_packages/octcdf-1.1.4/@ncfile/name.m b/octave_packages/octcdf-1.1.4/@ncfile/name.m new file mode 100644 index 0000000..399e2fb --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncfile/name.m @@ -0,0 +1,3 @@ +function n = name(self) + n = ncname(self) +end diff --git a/octave_packages/octcdf-1.1.4/@ncfile/redef.m b/octave_packages/octcdf-1.1.4/@ncfile/redef.m new file mode 100644 index 0000000..d8e8860 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncfile/redef.m @@ -0,0 +1,3 @@ +function redef(self) + ncredef(self) +end diff --git a/octave_packages/octcdf-1.1.4/@ncfile/sync.m b/octave_packages/octcdf-1.1.4/@ncfile/sync.m new file mode 100644 index 0000000..5371431 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncfile/sync.m @@ -0,0 +1,3 @@ +function sync(self) + ncsync(self) +end diff --git a/octave_packages/octcdf-1.1.4/@ncfile/var.m b/octave_packages/octcdf-1.1.4/@ncfile/var.m new file mode 100644 index 0000000..fdb1f66 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncfile/var.m @@ -0,0 +1,3 @@ +function v = var(self) + v = ncvar(self); +end diff --git a/octave_packages/octcdf-1.1.4/@ncvar/att.m b/octave_packages/octcdf-1.1.4/@ncvar/att.m new file mode 100644 index 0000000..cafca5c --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncvar/att.m @@ -0,0 +1,3 @@ +function a = att(self) + a = ncatt(self); +end diff --git a/octave_packages/octcdf-1.1.4/@ncvar/autonan.m b/octave_packages/octcdf-1.1.4/@ncvar/autonan.m new file mode 100644 index 0000000..37e8e5c --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncvar/autonan.m @@ -0,0 +1,3 @@ +function nv = autonan(self,varargin) + nv = ncautonan(self,varargin{:}); +end diff --git a/octave_packages/octcdf-1.1.4/@ncvar/autoscale.m b/octave_packages/octcdf-1.1.4/@ncvar/autoscale.m new file mode 100644 index 0000000..8c090f9 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncvar/autoscale.m @@ -0,0 +1,3 @@ +function nv = autoscale(self,varargin) + nv = ncautoscale(self,varargin{:}); +end diff --git a/octave_packages/octcdf-1.1.4/@ncvar/datatype.m b/octave_packages/octcdf-1.1.4/@ncvar/datatype.m new file mode 100644 index 0000000..3258682 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncvar/datatype.m @@ -0,0 +1,3 @@ +function dt = datatype(self) + dt = ncdatatype(self); +end diff --git a/octave_packages/octcdf-1.1.4/@ncvar/dim.m b/octave_packages/octcdf-1.1.4/@ncvar/dim.m new file mode 100644 index 0000000..97e9dbe --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncvar/dim.m @@ -0,0 +1,3 @@ +function d = dim(self) + d = ncdim(self); +end diff --git a/octave_packages/octcdf-1.1.4/@ncvar/fillval.m b/octave_packages/octcdf-1.1.4/@ncvar/fillval.m new file mode 100644 index 0000000..4c3bb9e --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncvar/fillval.m @@ -0,0 +1,7 @@ +function n = fillval(self,varargin) + if nargin == 1 + n = ncfillval(self); + else + ncfillval(self,varargin{:}); + end +end diff --git a/octave_packages/octcdf-1.1.4/@ncvar/name.m b/octave_packages/octcdf-1.1.4/@ncvar/name.m new file mode 100644 index 0000000..6bebacb --- /dev/null +++ b/octave_packages/octcdf-1.1.4/@ncvar/name.m @@ -0,0 +1,7 @@ +function n = name(self,varargin) + if nargin == 1 + n = ncname(self); + else + ncname(self,varargin{:}); + end +end diff --git a/octave_packages/octcdf-1.1.4/doc-cache b/octave_packages/octcdf-1.1.4/doc-cache new file mode 100644 index 0000000..237dba4 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/doc-cache @@ -0,0 +1,409 @@ +# Created by Octave 3.6.1, Thu Apr 26 22:44:40 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 12 +# name: +# type: sq_string +# elements: 1 +# length: 14 +example_netcdf + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + Example for creating and reading a netcdf file + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + Example for creating and reading a netcdf file + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +example_opendap + + +# name: +# type: sq_string +# elements: 1 +# length: 54 + Example for loading a dataset from an OPeNDAP server + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 + Example for loading a dataset from an OPeNDAP server + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ncbyte + + +# name: +# type: sq_string +# elements: 1 +# length: 578 + -- Loadable Function: NCVAR = ncbyte(DIMNAME_1,...,DIMNAME_N) + creates a netcdf variable of type ncbyte. DIMNAME_1 is the name of + the 1st netcdf dimension, and so on. The return value is a netcdf + variable object and must be affected to a netcdf file, before its + content can be defined. + + Example: + nc = netcdf('test.nc','w'); + nc('lon') = 360; + nc('lat') = 180; + nc{'var'} = ncbyte('lon','lat'); + A new 360 by 180 netcdf variable named 'var' of type byte is + created in file 'test.nc'. + + See also: netcdf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +creates a netcdf variable of type ncbyte. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ncchar + + +# name: +# type: sq_string +# elements: 1 +# length: 578 + -- Loadable Function: NCVAR = ncchar(DIMNAME_1,...,DIMNAME_N) + creates a netcdf variable of type ncchar. DIMNAME_1 is the name of + the 1st netcdf dimension, and so on. The return value is a netcdf + variable object and must be affected to a netcdf file, before its + content can be defined. + + Example: + nc = netcdf('test.nc','w'); + nc('lon') = 360; + nc('lat') = 180; + nc{'var'} = ncchar('lon','lat'); + A new 360 by 180 netcdf variable named 'var' of type char is + created in file 'test.nc'. + + See also: netcdf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +creates a netcdf variable of type ncchar. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +ncdouble + + +# name: +# type: sq_string +# elements: 1 +# length: 586 + -- Loadable Function: NCVAR = ncdouble(DIMNAME_1,...,DIMNAME_N) + creates a netcdf variable of type ncdouble. DIMNAME_1 is the name + of the 1st netcdf dimension, and so on. The return value is a + netcdf variable object and must be affected to a netcdf file, + before its content can be defined. + + Example: + nc = netcdf('test.nc','w'); + nc('lon') = 360; + nc('lat') = 180; + nc{'var'} = ncdouble('lon','lat'); + A new 360 by 180 netcdf variable named 'var' of type double is + created in file 'test.nc'. + + See also: netcdf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +creates a netcdf variable of type ncdouble. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ncdump + + +# name: +# type: sq_string +# elements: 1 +# length: 530 + -- Loadable Function: ncdump (FILENAME) + -- Loadable Function: ncdump (FILENAME,OUTPUT_FILENAME) + This function writes the content of the NetCDF file FILENAME + except the actual values of the variables to the screen or to the + file OUTPUT_FILENAME is this argument is provided. The output + used the same syntax that the octcdf toolbox. Therefore ncdump can + be used to create a program that produces a NetCDF file with the + same metadata than the NetCDF file FILENAME. + + See also: ncdim, ncvar, ncatt + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +This function writes the content of the NetCDF file FILENAME except the +actual v + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +ncfillval + + +# name: +# type: sq_string +# elements: 1 +# length: 192 + -- Loadable Function: FILLVALUE = ncfillval (NCVAR) + -- Loadable Function: ncfillval (NCVAR,FILLVALUE) + returns or sets the FILLVALUE of the NetCDF variable NCVAR. + + See also: netcdf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 +returns or sets the FILLVALUE of the NetCDF variable NCVAR. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +ncfloat + + +# name: +# type: sq_string +# elements: 1 +# length: 582 + -- Loadable Function: NCVAR = ncfloat(DIMNAME_1,...,DIMNAME_N) + creates a netcdf variable of type ncfloat. DIMNAME_1 is the name + of the 1st netcdf dimension, and so on. The return value is a + netcdf variable object and must be affected to a netcdf file, + before its content can be defined. + + Example: + nc = netcdf('test.nc','w'); + nc('lon') = 360; + nc('lat') = 180; + nc{'var'} = ncfloat('lon','lat'); + A new 360 by 180 netcdf variable named 'var' of type float is + created in file 'test.nc'. + + See also: netcdf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 +creates a netcdf variable of type ncfloat. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ncint + + +# name: +# type: sq_string +# elements: 1 +# length: 574 + -- Loadable Function: NCVAR = ncint(DIMNAME_1,...,DIMNAME_N) + creates a netcdf variable of type ncint. DIMNAME_1 is the name of + the 1st netcdf dimension, and so on. The return value is a netcdf + variable object and must be affected to a netcdf file, before its + content can be defined. + + Example: + nc = netcdf('test.nc','w'); + nc('lon') = 360; + nc('lat') = 180; + nc{'var'} = ncint('lon','lat'); + A new 360 by 180 netcdf variable named 'var' of type int is + created in file 'test.nc'. + + See also: netcdf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 +creates a netcdf variable of type ncint. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nclong + + +# name: +# type: sq_string +# elements: 1 +# length: 578 + -- Loadable Function: NCVAR = nclong(DIMNAME_1,...,DIMNAME_N) + creates a netcdf variable of type nclong. DIMNAME_1 is the name of + the 1st netcdf dimension, and so on. The return value is a netcdf + variable object and must be affected to a netcdf file, before its + content can be defined. + + Example: + nc = netcdf('test.nc','w'); + nc('lon') = 360; + nc('lat') = 180; + nc{'var'} = nclong('lon','lat'); + A new 360 by 180 netcdf variable named 'var' of type long is + created in file 'test.nc'. + + See also: netcdf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +creates a netcdf variable of type nclong. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +ncshort + + +# name: +# type: sq_string +# elements: 1 +# length: 582 + -- Loadable Function: NCVAR = ncshort(DIMNAME_1,...,DIMNAME_N) + creates a netcdf variable of type ncshort. DIMNAME_1 is the name + of the 1st netcdf dimension, and so on. The return value is a + netcdf variable object and must be affected to a netcdf file, + before its content can be defined. + + Example: + nc = netcdf('test.nc','w'); + nc('lon') = 360; + nc('lat') = 180; + nc{'var'} = ncshort('lon','lat'); + A new 360 by 180 netcdf variable named 'var' of type short is + created in file 'test.nc'. + + See also: netcdf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 +creates a netcdf variable of type ncshort. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nctest + + +# name: +# type: sq_string +# elements: 1 +# length: 131 + -- Loadable Function: nctest + Tests the octcdf toolbox. Tests results are written to nctest.log. + All tests should pass. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 +Tests the octcdf toolbox. + + + + + diff --git a/octave_packages/octcdf-1.1.4/example_netcdf.m b/octave_packages/octcdf-1.1.4/example_netcdf.m new file mode 100644 index 0000000..546cf19 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/example_netcdf.m @@ -0,0 +1,89 @@ +%% Copyright (C) 2005 Alexander Barth +%% +%% 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 . + +% Example for creating and reading a netcdf file + + +% create some variables to store them in a netcdf file + +latitude = -90:1:90; +longitude = -179:1:180; +[y,x] = meshgrid(pi/180 * latitude,pi/180 * longitude); +temp = cos(2*x) .* cos(y); + +%---------------------------------------% +% % +% write data to a netcdf file % +% % +%---------------------------------------% + +% create netcdf file called example.nc + +nc = netcdf('example.nc','c'); + +% define the dimension longitude and latitude of size +% 360 and 181 respectively. + +nc('longitude') = 360; +nc('latitude') = 181; + +% coordinate variable longitude + +nc{'longitude'} = ncdouble('longitude'); % create a variable longitude of type double with + % 360 elements (dimension longitude). +nc{'longitude'}(:) = longitude; % store the octave variable longitude in the netcdf file +nc{'longitude'}.units = 'degrees_east'; % define a string attribute of the variable longitude + +% coordinate variable latitude + +nc{'latitude'} = ncdouble('latitude');; % create a variable latitude of type double with + % 181 elements (dimension latitude). +nc{'latitude'}(:) = latitude; % store the octave variable latitude in the netcdf file +nc{'latitude'}.units = 'degrees_north'; % define a string attribute of the variable latitude + +% variable temp + +nc{'temp'} = ncdouble('latitude','longitude'); % create a variable temp of type double of the size 360x181 + % (dimension longitude and latitude). +nc{'temp'}(:) = temp; % store the octave variable temp in the netcdf file +nc{'temp'}.long_name = 'Temperature'; +nc{'temp'}.units = 'degree Celsius'; % define a string attribute of the variable +nc{'temp'}.valid_range = [-10 40]; % define a vector of doubles attribute of the variable + + % define a global string attribute +nc.history = 'netcdf file created by example_netcdf.m in octave'; +nc.title = 'sample file'; + +close(nc) % close netcdf file and all changes are written to disk + + +disp(['example.nc file created. You might now inspect this file with the shell command "ncdump -h example.nc"']); + + +%---------------------------------------% +% % +% read data from a netcdf file % +% % +%---------------------------------------% + +nc = netcdf('example.nc','r'); % open netcdf file example.nc in read-only + +n = nc('longitude'); % get the length of the dimension longitude + +temp = nc{'temp'}(:); % retrieve the netcdf variable temp +temp_units = nc{'temp'}.units; % retrieve the attribute units of variable temp +temp_valid_range = nc{'temp'}.valid_range; % retrieve the attribute valid_range of variable temp + +global_history = nc.history; % retrieve the global attribute history diff --git a/octave_packages/octcdf-1.1.4/example_opendap.m b/octave_packages/octcdf-1.1.4/example_opendap.m new file mode 100644 index 0000000..cc2dcbb --- /dev/null +++ b/octave_packages/octcdf-1.1.4/example_opendap.m @@ -0,0 +1,57 @@ +%% Copyright (C) 2005 Alexander Barth +%% +%% 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 . + +% Example for loading a dataset from an OPeNDAP server + +nc = netcdf('http://hycom.coaps.fsu.edu/thredds/dodsC/atl_ops','r'); + +lat = nc{'Latitude'}(:); +lon = nc{'Longitude'}(:); +time = nc{'MT'}(end); + +disp(['SSH forecast for part of the North Atlantic for ' datestr(datenum(1900,12,31) + time)]); + +% +% Select the SSH for part of the North Atlantic +% + +i = find(-92 < lon & lon < -51); +j = find(23 < lat & lat < 45); + +x = lon(i); +y = lat(j); + +% download data + +ssh = nc{'ssh'}(end,j,i); + +fillval = nc{'ssh'}._FillValue; +ssh(ssh == fillval) = NaN; + +% With autonan, i.e. every _FillValue is replaced by a NaN +% nv = ncautonan(nc{'ssh'},1); +% ssh = nv(end,j,i); + +ssh = squeeze(ssh); + +close(nc); + +colormap(hsv); +axis xy +iamgesc(ssh); + +% or with yapso +% pcolor(ssh); + diff --git a/octave_packages/octcdf-1.1.4/ncbyte.m b/octave_packages/octcdf-1.1.4/ncbyte.m new file mode 100644 index 0000000..05c178b --- /dev/null +++ b/octave_packages/octcdf-1.1.4/ncbyte.m @@ -0,0 +1,40 @@ +## Copyright (C) 2005 Alexander Barth +## +## 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 {Loadable Function} {@var{ncvar} = } ncbyte(@var{dimname_1},...,@var{dimname_N}) +## creates a netcdf variable of type ncbyte. @var{dimname_1} is the name +## of the 1st netcdf dimension, and so on. The return value is a netcdf +## variable object and must be affected to a netcdf file, before its content +## can be defined. +## +## Example: +## @example +## nc = netcdf('test.nc','w'); +## nc('lon') = 360; +## nc('lat') = 180; +## nc@{'var'@} = ncbyte('lon','lat'); +## @end example +## A new 360 by 180 netcdf variable named 'var' of type byte is +## created in file 'test.nc'. +## @end deftypefn +## @seealso{netcdf} + +## Author: Alexander Barth + +function c = ncbyte(varargin); + +c = {'byte' varargin{:}}; + diff --git a/octave_packages/octcdf-1.1.4/ncchar.m b/octave_packages/octcdf-1.1.4/ncchar.m new file mode 100644 index 0000000..469e2af --- /dev/null +++ b/octave_packages/octcdf-1.1.4/ncchar.m @@ -0,0 +1,40 @@ +## Copyright (C) 2005 Alexander Barth +## +## 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 {Loadable Function} {@var{ncvar} = } ncchar(@var{dimname_1},...,@var{dimname_N}) +## creates a netcdf variable of type ncchar. @var{dimname_1} is the name +## of the 1st netcdf dimension, and so on. The return value is a netcdf +## variable object and must be affected to a netcdf file, before its content +## can be defined. +## +## Example: +## @example +## nc = netcdf('test.nc','w'); +## nc('lon') = 360; +## nc('lat') = 180; +## nc@{'var'@} = ncchar('lon','lat'); +## @end example +## A new 360 by 180 netcdf variable named 'var' of type char is +## created in file 'test.nc'. +## @end deftypefn +## @seealso{netcdf} + +## Author: Alexander Barth + +function c = ncchar(varargin); + +c = {'char' varargin{:}}; + diff --git a/octave_packages/octcdf-1.1.4/ncdouble.m b/octave_packages/octcdf-1.1.4/ncdouble.m new file mode 100644 index 0000000..fe1de24 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/ncdouble.m @@ -0,0 +1,40 @@ +## Copyright (C) 2005 Alexander Barth +## +## 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 {Loadable Function} {@var{ncvar} = } ncdouble(@var{dimname_1},...,@var{dimname_N}) +## creates a netcdf variable of type ncdouble. @var{dimname_1} is the name +## of the 1st netcdf dimension, and so on. The return value is a netcdf +## variable object and must be affected to a netcdf file, before its content +## can be defined. +## +## Example: +## @example +## nc = netcdf('test.nc','w'); +## nc('lon') = 360; +## nc('lat') = 180; +## nc@{'var'@} = ncdouble('lon','lat'); +## @end example +## A new 360 by 180 netcdf variable named 'var' of type double is +## created in file 'test.nc'. +## @end deftypefn +## @seealso{netcdf} + +## Author: Alexander Barth + +function c = ncdouble(varargin); + +c = {'double' varargin{:}}; + diff --git a/octave_packages/octcdf-1.1.4/ncdump.m b/octave_packages/octcdf-1.1.4/ncdump.m new file mode 100644 index 0000000..03a5cac --- /dev/null +++ b/octave_packages/octcdf-1.1.4/ncdump.m @@ -0,0 +1,147 @@ +## Copyright (C) 2005 Alexander Barth +## +## 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 {Loadable Function} ncdump(@var{filename}) +## @deftypefnx {Loadable Function} ncdump(@var{filename},@var{output_filename}) +## This function writes the content of the NetCDF file @var{filename} except the actual values of the variables +## to the screen or to the file @var{output_filename} is this argument is provided. +## The output used the same syntax that the octcdf toolbox. Therefore ncdump can be used to +## create a program that produces a NetCDF file with the same metadata than the NetCDF file +## @var{filename}. +## @end deftypefn +## +## @seealso{ncdim,ncvar,ncatt} + +## Author: Alexander Barth + + + +function ncdump(fname,output); + +if (nargin == 1) + fid = 1; +else + fid = fopen(output,'w'); +end + +nc = netcdf(fname,'r'); + + +fprintf(fid,'nc = netcdf(''%s'',''noclobber'');\n\n',fname); +fprintf(fid,'%% dimensions\n\n'); + +% query all dimensions + +nd = ncdim(nc); + +for i=1:length(nd) + fprintf(fid,'nc(''%s'') = %d;\n',ncname(nd{i}),nd{i}(:)); +end + +fprintf(fid,'\n%% variables\n\n'); + +% query all variables + +nv = ncvar(nc); + +for i=1:length(nv) + varname = ncname(nv{i}); + + fprintf(fid,'nc{''%s''} = nc%s(',varname,ncdatatype(nv{i})); + + % print all dimension of the variable + nd = ncdim(nv{i}); + n = length(nd); + + for j=1:n + % dimension name in quotes + fprintf(fid,'''%s''',ncname(nd{j})); + + % separator + if (j~=n) + fprintf(fid,','); + end + end + + fprintf(fid,'); %% %d elements \n',numel(nv{i})); + + % print all attributes of the variable + + na = ncatt(nv{i}); + + for j=1:length(na) + datatype = ncdatatype(na{j}); + f = type2format(datatype); + + fprintf(fid,['nc{''%s''}.%s = nc%s(%s);\n'],varname,ncname(na{j}),datatype,att2str(na{j})); + end + + fprintf(fid,'\n'); +end + +fprintf(fid,'%% global attributes\n\n'); + +% query all global attributes + +na = ncatt(nc); + +for j=1:length(na) + datatype = ncdatatype(na{j}); + f = type2format(datatype); + + fprintf(fid,['nc.%s = nc%s(%s);\n'],ncname(na{j}),datatype,att2str(na{j})); +end + +fprintf(fid,'close(nc)\n'); + +if (fid ~= 1) + fclose(fid); +end + + + +function f = type2format(datatype) + +if (strcmp(datatype,'char')) + f = '''%s'''; +elseif (strcmp(datatype,'byte')) + f = '%d'; +else + f = '%g'; +end + + +function s = att2str(att) + datatype = ncdatatype(att); + f = type2format(datatype); + + n = length(att); + val = att(:); + + if (n == 1 || strcmp(datatype,'char')) + s = sprintf(f,val); + else + s = '['; + + for i=1:n-1 + s = [s sprintf(f,val(i)) ' ']; + end + + s = [s sprintf(f,val(n)) ']']; + + end + + diff --git a/octave_packages/octcdf-1.1.4/ncfillval.m b/octave_packages/octcdf-1.1.4/ncfillval.m new file mode 100644 index 0000000..70d67b1 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/ncfillval.m @@ -0,0 +1,40 @@ +## Copyright (C) 2009 Alexander Barth +## +## 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 {Loadable Function} {@var{fillvalue} = } ncfillval (@var{ncvar}) +## @deftypefnx {Loadable Function} ncfillval(@var{ncvar},@var{fillvalue}) +## returns or sets the @var{fillvalue} of the NetCDF variable @var{ncvar}. +## @end deftypefn +## @seealso{netcdf} + +## Author: Alexander Barth + +function varargout = ncfillval(varargin); + +varargout = {}; + +if nargin == 1 + ncvar = varargin{1}; + varargout{1} = ncvar.FillValue_; +elseif nargin == 2 + ncvar = varargin{1}; + fv = varargin{2}; + + ncvar.FillValue_ = fv; +else + error('ncfillval: wrong number of arguments'); +end + diff --git a/octave_packages/octcdf-1.1.4/ncfloat.m b/octave_packages/octcdf-1.1.4/ncfloat.m new file mode 100644 index 0000000..b3634a2 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/ncfloat.m @@ -0,0 +1,40 @@ +## Copyright (C) 2005 Alexander Barth +## +## 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 {Loadable Function} {@var{ncvar} = } ncfloat(@var{dimname_1},...,@var{dimname_N}) +## creates a netcdf variable of type ncfloat. @var{dimname_1} is the name +## of the 1st netcdf dimension, and so on. The return value is a netcdf +## variable object and must be affected to a netcdf file, before its content +## can be defined. +## +## Example: +## @example +## nc = netcdf('test.nc','w'); +## nc('lon') = 360; +## nc('lat') = 180; +## nc@{'var'@} = ncfloat('lon','lat'); +## @end example +## A new 360 by 180 netcdf variable named 'var' of type float is +## created in file 'test.nc'. +## @end deftypefn +## @seealso{netcdf} + +## Author: Alexander Barth + +function c = ncfloat(varargin); + +c = {'float' varargin{:}}; + diff --git a/octave_packages/octcdf-1.1.4/ncint.m b/octave_packages/octcdf-1.1.4/ncint.m new file mode 100644 index 0000000..6469298 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/ncint.m @@ -0,0 +1,40 @@ +## Copyright (C) 2005 Alexander Barth +## +## 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 {Loadable Function} {@var{ncvar} = } ncint(@var{dimname_1},...,@var{dimname_N}) +## creates a netcdf variable of type ncint. @var{dimname_1} is the name +## of the 1st netcdf dimension, and so on. The return value is a netcdf +## variable object and must be affected to a netcdf file, before its content +## can be defined. +## +## Example: +## @example +## nc = netcdf('test.nc','w'); +## nc('lon') = 360; +## nc('lat') = 180; +## nc@{'var'@} = ncint('lon','lat'); +## @end example +## A new 360 by 180 netcdf variable named 'var' of type int is +## created in file 'test.nc'. +## @end deftypefn +## @seealso{netcdf} + +## Author: Alexander Barth + +function c = ncint(varargin); + +c = {'int' varargin{:}}; + diff --git a/octave_packages/octcdf-1.1.4/nclong.m b/octave_packages/octcdf-1.1.4/nclong.m new file mode 100644 index 0000000..084a2aa --- /dev/null +++ b/octave_packages/octcdf-1.1.4/nclong.m @@ -0,0 +1,40 @@ +## Copyright (C) 2005 Alexander Barth +## +## 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 {Loadable Function} {@var{ncvar} = } nclong(@var{dimname_1},...,@var{dimname_N}) +## creates a netcdf variable of type nclong. @var{dimname_1} is the name +## of the 1st netcdf dimension, and so on. The return value is a netcdf +## variable object and must be affected to a netcdf file, before its content +## can be defined. +## +## Example: +## @example +## nc = netcdf('test.nc','w'); +## nc('lon') = 360; +## nc('lat') = 180; +## nc@{'var'@} = nclong('lon','lat'); +## @end example +## A new 360 by 180 netcdf variable named 'var' of type long is +## created in file 'test.nc'. +## @end deftypefn +## @seealso{netcdf} + +## Author: Alexander Barth + +function c = nclong(varargin); + +c = {'long' varargin{:}}; + diff --git a/octave_packages/octcdf-1.1.4/ncshort.m b/octave_packages/octcdf-1.1.4/ncshort.m new file mode 100644 index 0000000..921c16a --- /dev/null +++ b/octave_packages/octcdf-1.1.4/ncshort.m @@ -0,0 +1,40 @@ +## Copyright (C) 2005 Alexander Barth +## +## 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 {Loadable Function} {@var{ncvar} = } ncshort(@var{dimname_1},...,@var{dimname_N}) +## creates a netcdf variable of type ncshort. @var{dimname_1} is the name +## of the 1st netcdf dimension, and so on. The return value is a netcdf +## variable object and must be affected to a netcdf file, before its content +## can be defined. +## +## Example: +## @example +## nc = netcdf('test.nc','w'); +## nc('lon') = 360; +## nc('lat') = 180; +## nc@{'var'@} = ncshort('lon','lat'); +## @end example +## A new 360 by 180 netcdf variable named 'var' of type short is +## created in file 'test.nc'. +## @end deftypefn +## @seealso{netcdf} + +## Author: Alexander Barth + +function c = ncshort(varargin); + +c = {'short' varargin{:}}; + diff --git a/octave_packages/octcdf-1.1.4/nctest.m b/octave_packages/octcdf-1.1.4/nctest.m new file mode 100644 index 0000000..0127bf0 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/nctest.m @@ -0,0 +1,262 @@ +## Copyright (C) 2005 Alexander Barth +## +## 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 {Loadable Function} nctest +## Tests the octcdf toolbox. Tests results are written to nctest.log. All tests +## should pass. +## @end deftypefn + +## Author: Alexander Barth + + + +function [passes,tests] = nctest + disp('writing test output to nctest.log'); + test('nctest','normal','nctest.log'); +endfunction + + +%!shared fname, nc +%! fname = [tmpnam '-octcdf.nc']; +%! nc = netcdf(fname,'c'); + +%!# Test reading/writing dimension +%!test +%! nc('time') = 5; +%! nc('space') = 3; +%! nc('record') = 0; +%! assert(length(nc('time')),5); +%! assert(length(nc('space')),3); + +%!# Test reading/writing global attributes +%!test +%! nc.byte_att = ncbyte(123); +%! nc.short_att = ncshort(123); +%! nc.int_att = ncint(123); +%! nc.long_att = nclong(123); +%! nc.float_att = ncfloat(123); +%! nc.double_att = ncdouble(123.4); +%! nc.string_att = "test string"; +%! assert(nc.byte_att,123) +%! assert(nc.short_att,123) +%! assert(nc.int_att,123) +%! assert(nc.long_att,123) +%! assert(nc.float_att,single(123)) +%! assert(nc.double_att,123.4) +%! assert(nc.string_att,"test string") + +%!# Test reading/writing varaible of type byte +%!test +%! byte_var = reshape(1:15,5,3); +%! nc{'byte_var'} = ncbyte('time','space'); +%! nc{'byte_var'}(:) = byte_var; +%! assert(nc{'byte_var'}(:),byte_var); + +%!# Test reading/writing varaible of type short +%!test +%! short_var = reshape(1:15,5,3); +%! nc{'short_var'} = ncshort('time','space'); +%! nc{'short_var'}(:) = short_var; +%! assert(nc{'short_var'}(:),short_var); + +%!# Test reading/writing varaible of type int +%!test +%! int_var = reshape(1:15,5,3); +%! nc{'int_var'} = ncint('time','space'); +%! nc{'int_var'}(:) = int_var; +%! assert(nc{'int_var'}(:),int_var); + +%!# Test reading/writing varaible of type long +%!test +%! long_var = reshape(1:15,5,3); +%! nc{'long_var'} = nclong('time','space'); +%! nc{'long_var'}(:) = long_var; +%! assert(nc{'long_var'}(:),long_var); + +%!# Test reading/writing varaible of type float +%!test +%! float_var = reshape(1:15,5,3)/10; +%! nc{'float_var'} = ncfloat('time','space'); +%! nc{'float_var'}(:) = float_var; +%! assert(nc{'float_var'}(:),float_var,1e-5); + +%!# Test reading/writing varaible of type double +%!test +%! double_var = reshape(1:15,5,3)/10; +%! nc{'double_var'} = ncdouble('time','space'); +%! nc{'double_var'}(:) = double_var; +%! assert(nc{'double_var'}(:),double_var); + +%!# Test reading/writing varaible of type char +%!test +%! char_var = reshape('ajhkjhgkjhfdgkh',5,3); +%! nc{'char_var'} = ncchar('time','space'); +%! nc{'char_var'}(:) = char_var; +%! assert(nc{'char_var'}(:),char_var); + +%!# Test reading/writing variable attributes +%!test +%! nv = nc{'int_var'}; +%! nv.byte_att = ncbyte(123); +%! nv.short_att = ncshort(123); +%! nv.int_att = ncint(123); +%! nv.long_att = nclong(123); +%! nv.float_att = ncfloat(123); +%! nv.double_att = ncdouble(123.4); +%! nv.string_att = "test string"; +%! assert(nv.byte_att,123) +%! assert(nv.short_att,123) +%! assert(nv.int_att,123) +%! assert(nv.long_att,123) +%! assert(nv.float_att,single(123)) +%! assert(nv.double_att,123.4) +%! assert(nv.string_att,"test string") + +%!# Test ncdim +%!test +%! dimlist = dim(nc); +%! assert(length(dimlist),3); +%! assert(dimlist{1}(:),5); +%! assert(dimlist{2}(:),3); + +%!# Test isrecord +%!test +%! assert(isrecord(nc('record')) == 1); + +%!# Test name on file +%!test +%! assert(name(nc),fname); + +%!# Test ncatt +%!test +%! attlist = att(nc); +%! assert(length(attlist),7); +%! assert(name(attlist{1}),'byte_att'); +%! assert(datatype(attlist{1}),'byte'); +%! assert(attlist{1}(:),123); + +%!# Test ncvar +%!test +%! varlist = var(nc); +%! assert(length(varlist),7); +%! assert(name(varlist{1}),'byte_var'); +%! assert(datatype(varlist{1}),'byte'); + +%!# Test to write a variable by slices +%!test +%! imax = 10; +%! jmax = 11; +%! kmax = 12; +%! nc('imax') = imax; +%! nc('jmax') = jmax; +%! nc('kmax') = kmax; +%! sliced_var = reshape(1:imax*jmax*kmax,imax,jmax,kmax); +%! nc{'sliced_var'} = ncdouble('imax','jmax','kmax'); +%! +%! for i=1:imax +%! nc{'sliced_var'}(i,:,:) = squeeze(sliced_var(i,:,:)); +%! end +%! +%! sliced_var2 = nc{'sliced_var'}(:); +%! +%! assert(sliced_var2 == sliced_var) + +%!# Test autoscale +%!test +%! var = rand(5,3); +%! add_offset = 1; +%! scale_factor = .1; +%! +%! nc{'autoscale_var'} = ncdouble('time','space'); +%! nc{'autoscale_var'}.add_offset = add_offset; +%! nc{'autoscale_var'}.scale_factor = scale_factor; +%! nc{'autoscale_var',1}(:) = var; +%! +%! unscaled = nc{'autoscale_var'}(:); +%! assert(var,scale_factor*unscaled+add_offset,1e-6); +%! +%! scaled = nc{'autoscale_var',1}(:); +%! assert(var,scaled,1e-6); +%! +%! nf = autoscale(nc{'autoscale_var'},1); +%! assert(nf(:),scaled,1e-6); + +%!# Test autonan +%!test +%! nc{'variable_with_gaps'}=ncdouble('time'); +%! nv = nc{'variable_with_gaps'}; +%! nv = autonan(nv,1); +%! nv.FillValue_ = 99; +%! nv(:) = NaN; +%! +%! nv = autonan(nv,0); +%! assert(all(nv(:) == 99)) +%! +%! nv = autonan(nv,1); +%! assert(all(isnan(nv(:)))) + +%!# Test size of vector +%!test +%! nc{'vector'} = ncfloat('time'); +%! nc{'vector'}(:) = 0; +%! v = nc{'vector'}(:); +%! assert(size(v),[5 1]) + +%!# Test scalar +%!test +%! nc{'scalar'} = ncint(); +%! nc{'scalar'}(:) = 10; +%! v = nc{'scalar'}(:); +%! assert(v,10) + +%!# Close file +%!test +%! close(nc); +%! delete(fname); + + +%!# Test rename function +%!test +%! filename = [tmpnam '-octcdf.nc']; +%! nf = netcdf(filename,'c'); +%! +%! nf('longitude') = 5; +%! nf('latitude') = 5; +%! +%! nf.old_name = 'example attribute'; +%! +%! d = dim(nf){1}; +%! name(d,'new_name'); +%! assert(name(d),'new_name') +%! +%! a = att(nf){1}; +%! name(a,'new_name'); +%! assert(name(a),'new_name'); +%! +%! nf{'old_name'} = ncdouble('new_name','latitude'); +%! v = nf{'old_name'}; +%! name(v,'new_name') +%! assert(name(v),'new_name'); +%! close(nf); +%! delete(filename); + +%!# Test 64bit-offset function +%!test +%! filename = [tmpnam '-octcdf.nc']; +%! nf = netcdf(filename,'c','64bit-offset'); +%! close(nf); +%! delete(filename); + diff --git a/octave_packages/octcdf-1.1.4/packinfo/.autoload b/octave_packages/octcdf-1.1.4/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/octcdf-1.1.4/packinfo/DESCRIPTION b/octave_packages/octcdf-1.1.4/packinfo/DESCRIPTION new file mode 100644 index 0000000..4396f3c --- /dev/null +++ b/octave_packages/octcdf-1.1.4/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: octcdf +Version: 1.1.4 +Date: 2012-02-17 +Author: Alexander Barth +Maintainer: Alexander Barth +Title: octcdf +Description: A NetCDF interface for octave +Depends: octave (>= 3.4.0) +Autoload: yes +BuildRequires: netcdf-devel +License: GPL version 2 or later +Url: http://octave.sf.net diff --git a/octave_packages/octcdf-1.1.4/packinfo/INDEX b/octave_packages/octcdf-1.1.4/packinfo/INDEX new file mode 100644 index 0000000..ca1d538 --- /dev/null +++ b/octave_packages/octcdf-1.1.4/packinfo/INDEX @@ -0,0 +1,27 @@ +octcdf >> NetCDF +NetCDF + ncautonan + ncautoscale + ncbyte + ncchar + ncdouble + ncdump + ncfillval + ncfloat + ncint + nclong + ncshort + ncatt + ncclose + ncdatatype + ncdim + ncenddef + ncname + ncredef + ncsync + ncvar + netcdf + ncisrecord +Examples + example_netcdf + example_opendap diff --git a/octave_packages/octgpr-1.2.0/demo_octgpr.m b/octave_packages/octgpr-1.2.0/demo_octgpr.m new file mode 100644 index 0000000..3482230 --- /dev/null +++ b/octave_packages/octgpr-1.2.0/demo_octgpr.m @@ -0,0 +1,279 @@ +% Copyright (C) 2008 VZLU Prague, a.s., Czech Republic +% +% Author: Jaroslav Hajek +% +% This file is part of OctGPR. +% +% OctGPR is free software; you can redistribute it and/or modify +% it under the terms of the 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} demo_octgpr (1, nsamp = 150) +% @deftypefnx {Function File} demo_octgpr (2, ncnt = 20, npt = 500) +% @deftypefnx {Function File} demo_octgpr (3, ncnt = 50, nsamp = 500) +% OctGPR package demo function. +% First argument selects available demos: +% +% @itemize +% @item 1. GPR regression demo @* +% A function is sampled (with small noise), then reconstructed using GPR +% regression. @var{nsamp} specifies the number of samples. +% @seealso{gpr_train, gpr_predict} +% @item 2. RBF centers selection demo @* +% Radial basis centers are selected amongst random points. +% @var{ncnt} specifies number of centers, @var{npt} number of points. +% @item 2. PGP regression demo @* +% A function is densely sampled (with small noise), +% radial basis centers are selected, then the function is reconstructed +% using PGP regression. @var{nsamp} specifies the number of samples, +% @var{ncnt} specifies number of centers. +% @end itemize +% @end deftypefn +function demo_octgpr (number, varargin) + + global prntfmt = ''; + + if (nargin < 1) + print_usage (); + elseif (ischar (number)) + prntfmt = number; + elseif (isscalar (number)) + figure (); + if (! isempty (prntfmt)) + figure (gcf, "visible", "off"); + endif + + switch (number) + case 1 + demo_octgpr1 (varargin{:}) + case 2 + demo_octgpr2 (varargin{:}) + case 3 + demo_octgpr3 (varargin{:}) + otherwise + error ("demo_octgpr: invalid demo number") + endswitch + else + print_usage (); + endif + +endfunction + +function demo_octgpr_pause (idemo, iplot) + global prntfmt; + if (isempty (prntfmt)) + pause; + else + print (sprintf (prntfmt, idemo, iplot)); + fflush (stdout); + endif +endfunction + +% define the test function (the well-known matlab "peaks" plus some sines) +function z = testfun1 (x, y) + z = 4 + 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) ... + + 2*sin (x + y + 1e-1*x.*y); +endfunction + +function demo_octgpr1 (nsamp = 150) + global prntfmt; + tit = "a peaked surface"; + disp (tit); + + % create the mesh onto which to interpolate + t = linspace (-3, 3, 50); + [xi,yi] = meshgrid (t, t); + + % evaluate + zi = testfun1 (xi, yi); + zimax = max (vec (zi)); zimin = min (vec (zi)); + subplot (2, 2, 1); + mesh (xi, yi, zi); + title (tit); + subplot (2, 2, 3); + contourf (xi, yi, zi, 20); + demo_octgpr_pause (1, 1); + + tit = sprintf ("sampled at %d random points", nsamp); + disp (tit); + % create random samples + xs = rand (nsamp,1); ys = rand (nsamp,1); + xs = 6*xs-3; ys = 6*ys - 3; + % evaluate at random samples + zs = testfun1 (xs, ys); + xys = [xs ys]; + + subplot (2, 2, 2); + plot3 (xs, ys, zs, ".+"); + title (tit); + subplot (2, 2, 3); + hold on + plot (xs, ys, "+6"); + hold off + subplot (2, 2, 4); + plot (xs, ys, ".+"); + demo_octgpr_pause (1, 2); + + tit = "GPR model with heuristic hypers"; + disp (tit); + ths = 1 ./ std (xys); + GPM = gpr_train (xys, zs, ths, 1e-5); + zm = gpr_predict (GPM, [vec(xi) vec(yi)]); + zm = reshape (zm, size(zi)); + zm = min (zm, zimax); zm = max (zm, zimin); + subplot (2, 2, 2); + mesh (xi, yi, zm); + title (tit); + subplot(2, 2, 4); + hold on + contourf (xi, yi, zm, 20); + plot (xs, ys, "+6"); + hold off + demo_octgpr_pause (1, 3); + + tit = "GPR model with MLE training"; + disp (tit); + fflush (stdout); + GPM = gpr_train (xys, zs, ths, 1e-5, {"tol", 1e-5, "maxev", 400, "numin", 1e-8}); + zm = gpr_predict (GPM, [vec(xi) vec(yi)]); + zm = reshape (zm, size (zi)); + zm = min (zm, zimax); zm = max (zm, zimin); + subplot (2, 2, 2); + mesh (xi, yi, zm); + title (tit); + subplot(2, 2, 4); + hold on + contourf (xi, yi, zm, 20); + plot (xs, ys, "+6"); + hold off + demo_octgpr_pause (1, 4); + close + +endfunction + +function demo_octgpr2 (ncnt = 50, npt = 500) + + global prntfmt; + npt = ncnt*ceil (npt/ncnt); + U = rand (ncnt, 2); + cs = min (pdist2_mw (U, 2) + diag (Inf (ncnt, 1))); + X = repmat (U, npt/ncnt, 1) + repmat (cs', npt/ncnt, 2) .* randn (npt, 2); + disp ("slightly clustered random points") + plot (X(:,1), X(:,2), "+"); + demo_octgpr_pause (2, 1); + + [U, ur] = rbf_centers(X, ncnt); + + fi = linspace (0, 2*pi, 20); + ncolors = rows (colormap); + hold on + for i = 1:rows (U) + xc = U(i,1) + ur(i) * cos (fi); + yc = U(i,2) + ur(i) * sin (fi); + line (xc, yc); + endfor + hold off + demo_octgpr_pause (2, 2); + close + +endfunction + +function demo_octgpr3 (ncnt = 100, nsamp = 1000) + + global prntfmt; + tit = "a peaked surface"; + disp (tit); + + % create the mesh onto which to interpolate + t = linspace (-3, 3, 50); + [xi,yi] = meshgrid (t, t); + + % evaluate + zi = testfun1 (xi, yi); + zimax = max (vec (zi)); zimin = min (vec (zi)); + subplot (2, 2, 1); + mesh (xi, yi, zi); + title (tit); + subplot (2, 2, 3); + contourf (xi, yi, zi, 20); + demo_octgpr_pause (1, 1); + + tit = sprintf ("sampled at %d random points, selected %d centers", nsamp, ncnt); + disp (tit); + % create random samples + xs = rand (nsamp,1); ys = rand (nsamp,1); + xs = 6*xs-3; ys = 6*ys - 3; + % evaluate at random samples + zs = testfun1 (xs, ys); + xys = [xs ys]; + + % select centers using k-means + xyc = rbf_centers (xys, ncnt); + xc = xyc(:,1); yc = xyc(:,2); + + subplot (2, 2, 2); + plot3 (xs, ys, zs, ".+"); + title (tit); + subplot (2, 2, 3); + hold on + plot (xs, ys, "+6"); + hold off + subplot (2, 2, 4); + hold on + plot (xs, ys, "+"); + plot (xc, yc, "o2"); + hold off + demo_octgpr_pause (1, 2); + + tit = "PGP model with heuristic hypers"; + disp (tit); + ths = 1 ./ std (xyc); + GPM = pgp_train (xys, xyc, zs, ths, 1e-5); + zm = pgp_predict (GPM, [vec(xi) vec(yi)]); + zm = reshape (zm, size(zi)); + zm = min (zm, zimax); zm = max (zm, zimin); + subplot (2, 2, 2); + mesh (xi, yi, zm); + title (tit); + subplot(2, 2, 4); + hold on + contourf (xi, yi, zm, 20); + plot (xs, ys, "+6"); + plot (xc, yc, "o5"); + hold off + demo_octgpr_pause (1, 3); + + tit = "PGP model with MLE training"; + disp (tit); + fflush (stdout); + GPM = pgp_train (xys, xyc, zs, ths, 1e-3, {"tol", 1e-5, "maxev", 400}); + zm = pgp_predict (GPM, [vec(xi) vec(yi)]); + zm = reshape (zm, size (zi)); + zm = min (zm, zimax); zm = max (zm, zimin); + subplot (2, 2, 2); + mesh (xi, yi, zm); + title (tit); + subplot(2, 2, 4); + hold on + contourf (xi, yi, zm, 20); + plot (xs, ys, "+6"); + plot (xc, yc, "o5"); + hold off + demo_octgpr_pause (1, 4); + close + +endfunction diff --git a/octave_packages/octgpr-1.2.0/doc-cache b/octave_packages/octgpr-1.2.0/doc-cache new file mode 100644 index 0000000..276c3ee --- /dev/null +++ b/octave_packages/octgpr-1.2.0/doc-cache @@ -0,0 +1,35 @@ +# Created by Octave 3.6.1, Sat Mar 24 15:52:20 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 1 +# name: +# type: sq_string +# elements: 1 +# length: 11 +rbf_centers + + +# name: +# type: sq_string +# elements: 1 +# length: 149 + -- Function File: [U, ur, iu] = rbf_centers (X, NU, THETA) + Selects a given number of RBF centers based on Lloyd's clustering + algorithm. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 76 +Selects a given number of RBF centers based on Lloyd's clustering +algorithm. + + + + + diff --git a/octave_packages/octgpr-1.2.0/packinfo/.autoload b/octave_packages/octgpr-1.2.0/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/octgpr-1.2.0/packinfo/DESCRIPTION b/octave_packages/octgpr-1.2.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..a601854 --- /dev/null +++ b/octave_packages/octgpr-1.2.0/packinfo/DESCRIPTION @@ -0,0 +1,13 @@ +Name: OctGPR +Version: 1.2.0 +Date: 2009-08-06 +Author: Jaroslav Hajek (highegg@gmail.com) +Title: Package for full dense Gaussian Process Regression +Maintainer: Jaroslav Hajek (highegg@gmail.com) +Description: The package allows interpolating and smoothing scattered + multidimensional data using Gaussian Process Regression (also known + as Kriging). Projected Gaussian Process regression is also + experimentally supported. +License: GPL v3 +Depends: octave (>= 3.2.0) +Autoload: yes diff --git a/octave_packages/octgpr-1.2.0/packinfo/INDEX b/octave_packages/octgpr-1.2.0/packinfo/INDEX new file mode 100644 index 0000000..c986ca9 --- /dev/null +++ b/octave_packages/octgpr-1.2.0/packinfo/INDEX @@ -0,0 +1,10 @@ +octgpr >> OctGPR +OctGPR + gpr_train + gpr_predict + pgp_train + pgp_predict + pdist2_mw +Examples + demo_octgpr + rbf_centers diff --git a/octave_packages/octgpr-1.2.0/rbf_centers.m b/octave_packages/octgpr-1.2.0/rbf_centers.m new file mode 100644 index 0000000..4c56765 --- /dev/null +++ b/octave_packages/octgpr-1.2.0/rbf_centers.m @@ -0,0 +1,92 @@ +% Copyright (C) 2008 VZLU Prague, a.s., Czech Republic +% +% Author: Jaroslav Hajek +% +% This file is part of OctGPR. +% +% OctGPR is free software; you can redistribute it and/or modify +% it under the terms of the 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} {[U, ur, iu]} = rbf_centers (@var{X}, @var{nu}, @var{theta}) +% Selects a given number of RBF centers based on Lloyd's clustering algorithm. +% +% @end deftypefn +function [U, ur, iu] = rbf_centers (X, nu, theta) + + if (nargin == 3) + X *= diag (theta); + elseif (nargin != 2) + print_usage (); + endif + + % the D^2 weighting initialization + + D = Inf; + kk = 1:rows (X); + cp = kk; + + for i = 1:nu + jj = sum (rand() * cp(end) < cp); + k(i) = kk(jj); + kk(jj) = []; + U = X(k(i),:); + D = min (D, pdist2_mw(X, U, 'ssq')'); + cp = cumsum (D(kk)); + endfor + + + % now perform the k-means algorithm + + U = X(k,:); + D = pdist2_mw (U, X, 'ssq'); + [xx, j] = min (D); + + it = 0; + do + for i = 1:columns (X) + U(:,i) = accumarray (j.', X(:,i), [nu, 1]); + endfor + N = accumarray (j.', ones (1, length (j)), [nu, 1]); + U = diag (N) \ U; + i = find (all (U == 0, 2)); + U(i,:) = X(ceil (rand (1, length (i)) * rows (X)), :); + j1 = j; + D = pdist2_mw (U, X, 'ssq'); + [xx, j] = min (D); + fprintf (stderr, "k-means iteration %d\r", ++it); + until (all (j == j1)) + fprintf (stderr, "\n"); + + if (nargout > 2) + iu = j; + endif + + if (nargout > 1) + ur = zeros (nu, 1); + for i = 1:nu + ij = (j == i); + ur(i) = sqrt (max (D(i,ij))); + endfor + endif + + if (nargin == 3) + U = dmult (U, 1./theta); + if (any(theta == 0)) + U(:,theta == 0) = 0; + endif + endif + +endfunction diff --git a/octave_packages/odepkg-0.8.2/bvp4c.m b/octave_packages/odepkg-0.8.2/bvp4c.m new file mode 100644 index 0000000..a7868c2 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/bvp4c.m @@ -0,0 +1,233 @@ +## Copyright (C) 2008-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{A}} = bvp4c (@var{odefun}, @var{bcfun}, @var{solinit}) +## +## Solves the first order system of non-linear differential equations defined by +## @var{odefun} with the boundary conditions defined in @var{bcfun}. +## +## The structure @var{solinit} defines the grid on which to compute the +## solution (@var{solinit.x}), and an initial guess for the solution (@var{solinit.y}). +## The output @var{sol} is also a structure with the following fields: +## @itemize +## @item @var{sol.x} list of points where the solution is evaluated +## @item @var{sol.y} solution evaluated at the points @var{sol.x} +## @item @var{sol.yp} derivative of the solution evaluated at the +## points @var{sol.x} +## @item @var{sol.solver} = "bvp4c" for compatibility +## @end itemize +## @seealso{odpkg} +## @end deftypefn + +## Author: Carlo de Falco +## Created: 2008-09-05 + + +function sol = bvp4c(odefun,bcfun,solinit,options) + + if (isfield(solinit,"x")) + t = solinit.x; + else + error("bvp4c: missing initial mesh solinit.x"); + end + + if (isfield(solinit,"y")) + u_0 = solinit.y; + else + error("bvp4c: missing initial guess"); + end + + if (isfield(solinit,"parameters")) + error("bvp4c: solving for unknown parameters is not yet supported"); + end + + RelTol = 1e-3; + AbsTol = 1e-6; + if ( nargin > 3 ) + if (isfield(options,"RelTol")) + RelTol = options.RelTol; + endif + if (isfield(options,"RelTol")) + AbsTol = options.AbsTol; + endif + endif + + Nvar = rows(u_0); + Nint = length(t)-1; + s = 3; + h = diff(t); + + AbsErr = inf; + RelErr = inf; + MaxIt = 10; + + for iter = 1:MaxIt + + x = [ u_0(:); zeros(Nvar*Nint*s,1) ]; + x = __bvp4c_solve__ (t, x, h, odefun, bcfun, Nvar, Nint, s); + u = reshape(x(1:Nvar*(Nint+1)),Nvar,Nint+1); + + for kk=1:Nint+1 + du(:,kk) = odefun(t(kk), u(:,kk)); + end + + tm = (t(1:end-1)+t(2:end))/2; + um = []; + for nn=1:Nvar + um(nn,:) = interp1(t,u(nn,:),tm); + endfor + + f_est = []; + for kk=1:Nint + f_est(:,kk) = odefun(tm(kk), um(:,kk)); + end + + du_est = []; + for nn=1:Nvar + du_est(nn,:) = diff(u(nn,:))./h; + end + + err = max(abs(f_est-du_est)); semilogy(tm,err), pause(.1) + AbsErr = max(err) + RelErr = AbsErr/norm(du,inf) + + if ( (AbsErr >= AbsTol) && (RelErr >= RelTol) ) + ref_int = find( (err >= AbsTol) & (err./max(max(abs(du))) >= RelTol) ); + + t_add = tm(ref_int); + t_old = t; + + t = sort([t, t_add]); + h = diff(t); + + u_0 = []; + for nn=1:Nvar + u_0(nn,:) = interp1(t_old, u(nn,:), t); + end + Nvar = rows(u_0); + Nint = length(t)-1 + else + break + end + + endfor + + ## K = reshape(x([1:Nvar*Nint*s]+Nvar*(Nint+1)),Nvar,Nint,s); + ## K1 = reshape(K(:,:,1), Nvar, Nint); + ## K2 = reshape(K(:,:,2), Nvar, Nint); + ## K3 = reshape(K(:,:,3), Nvar, Nint); + + + + sol.x = t; + sol.y = u; + sol.yp= du; + sol.parameters = []; + sol.solver = 'bvp4c'; + +endfunction + +function diff_K = __bvp4c_fun_K__ (t, u, Kin, f, h, s, Nint, Nvar) + + %% coefficients + persistent C = [0 1/2 1 ]; + + persistent A = [0 0 0; + 5/24 1/3 -1/24; + 1/6 2/3 1/6]; + + for jj = 1:s + for kk = 1:Nint + Y = repmat(u(:,kk),1,s) + ... + (reshape(Kin(:,kk,:),Nvar,s) * A.') * h(kk); + diff_K(:,kk,jj) = Kin(:,kk,jj) - f (t(kk)+C(jj)*h(kk), Y); + endfor + endfor + +endfunction + + +function diff_u = __bvp4c_fun_u__ (t, u, K, h, s, Nint, Nvar) + + %% coefficients + persistent B= [1/6 2/3 1/6 ]; + + Y = zeros(Nvar, Nint); + for jj = 1:s + Y += B(jj) * K(:,:,jj); + endfor + diff_u = u(:,2:end) - u(:,1:end-1) - repmat(h,Nvar,1) .* Y; + +endfunction + +function x = __bvp4c_solve__ (t, x, h, odefun, bcfun, Nvar, Nint, s) + fun = @( x ) ( [__bvp4c_fun_u__(t, + reshape(x(1:Nvar*(Nint+1)),Nvar,(Nint+1)), + reshape(x([1:Nvar*Nint*s]+Nvar*(Nint+1)),Nvar,Nint,s), + h, + s, + Nint, + Nvar)(:) ; + __bvp4c_fun_K__(t, + reshape(x(1:Nvar*(Nint+1)),Nvar,(Nint+1)), + reshape(x([1:Nvar*Nint*s]+Nvar*(Nint+1)),Nvar,Nint,s), + odefun, + h, + s, + Nint, + Nvar)(:); + bcfun(reshape(x(1:Nvar*(Nint+1)),Nvar,Nint+1)(:,1), + reshape(x(1:Nvar*(Nint+1)),Nvar,Nint+1)(:,end)); + ] ); + + x = fsolve ( fun, x ); +endfunction + + + +%!demo +%! a = 0; +%! b = 4; +%! Nint = 3; +%! Nvar = 2; +%! s = 3; +%! t = linspace(a,b,Nint+1); +%! h = diff(t); +%! u_1 = ones(1, Nint+1); +%! u_2 = 0*u_1; +%! u_0 = [u_1 ; u_2]; +%! f = @(t,u) [ u(2); -abs(u(1)) ]; +%! g = @(ya,yb) [ya(1); yb(1)+2]; +%! solinit.x = t; solinit.y=u_0; +%! sol = bvp4c(f,g,solinit); +%! plot (sol.x,sol.y,'x-') + +%!demo +%! a = 0; +%! b = 4; +%! Nint = 2; +%! Nvar = 2; +%! s = 3; +%! t = linspace(a,b,Nint+1); +%! h = diff(t); +%! u_1 = -ones(1, Nint+1); +%! u_2 = 0*u_1; +%! u_0 = [u_1 ; u_2]; +%! f = @(t,u) [ u(2); -abs(u(1)) ]; +%! g = @(ya,yb) [ya(1); yb(1)+2]; +%! solinit.x = t; solinit.y=u_0; +%! sol = bvp4c(f,g,solinit); +%! plot (sol.x,sol.y,'x-') diff --git a/octave_packages/odepkg-0.8.2/doc-cache b/octave_packages/odepkg-0.8.2/doc-cache new file mode 100644 index 0000000..575028f --- /dev/null +++ b/octave_packages/odepkg-0.8.2/doc-cache @@ -0,0 +1,1891 @@ +# Created by Octave 3.6.2, Sun Aug 05 21:39:02 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 35 +# name: +# type: sq_string +# elements: 1 +# length: 5 +bvp4c + + +# name: +# type: sq_string +# elements: 1 +# length: 694 + -- Function File: A = bvp4c (ODEFUN, BCFUN, SOLINIT) + Solves the first order system of non-linear differential equations + defined by ODEFUN with the boundary conditions defined in BCFUN. + + The structure SOLINIT defines the grid on which to compute the + solution (SOLINIT.X), and an initial guess for the solution + (SOLINIT.Y). The output SOL is also a structure with the + following fields: + * SOL.X list of points where the solution is evaluated + + * SOL.Y solution evaluated at the points SOL.X + + * SOL.YP derivative of the solution evaluated at the points + SOL.X + + * SOL.SOLVER = "bvp4c" for compatibility + + See also: odpkg + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Solves the first order system of non-linear differential equations +defined by OD + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ode23 + + +# name: +# type: sq_string +# elements: 1 +# length: 2466 + -- Function File: [] = ode23 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, + ...]) + -- Command: [SOL] = ode23 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode23 (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff + ordinary differential equations (non-stiff ODEs) or non-stiff + differential algebraic equations (non-stiff DAEs) with the well + known explicit Runge-Kutta method of order (2,3). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, solve an anonymous implementation of the Van der Pol + equation + + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ + "NormControl", "on", "OutputFcn", @odeplot); + ode23 (fvdb, [0 20], [2 0], vopt); + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +This function file can be used to solve a set of non-stiff ordinary +differential + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ode23d + + +# name: +# type: sq_string +# elements: 1 +# length: 3606 + -- Function File: [] = ode23d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [SOL] = ode23d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode23d (@FUN, SLOT, INIT, LAGS, + HIST, [OPT], [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff delay + differential equations (non-stiff DDEs) with a modified version of + the well known explicit Runge-Kutta method of order (2,3). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + DDEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, LAGS is a double vector that + describes the lags of time, HIST is a double matrix and describes + the history of the DDEs, OPT can optionally be a structure array + that keeps the options created with the command `odeset' and PAR1, + PAR2, ... can optionally be other input arguments of any type that + have to be passed to the function defined by @FUN. + + In other words, this function will solve a problem of the form + dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), ...))) + y(slot(1)) = init + y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), ... + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + DDEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example: + - the following code solves an anonymous implementation of a + chaotic behavior + + fcao = @(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy]; + + vopt = odeset ("NormControl", "on", "RelTol", 1e-3); + vsol = ode23d (fcao, [0, 100], 0.5, 2, 0.5, vopt); + + vlag = interp1 (vsol.x, vsol.y, vsol.x - 2); + plot (vsol.y, vlag); legend ("fcao (t,y,z)"); + + - to solve the following problem with two delayed state + variables + + d y1(t)/dt = -y1(t) + d y2(t)/dt = -y2(t) + y1(t-5) + d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10) + + one might do the following + + function f = fun (t, y, yd) + f(1) = -y(1); %% y1' = -y1(t) + f(2) = -y(2) + yd(1,1); %% y2' = -y2(t) + y1(t-lags(1)) + f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2)) + endfunction + T = [0,20] + res = ode23d (@fun, T, [1;1;1], [5, 10], ones (3,2)); + + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +This function file can be used to solve a set of non-stiff delay +differential eq + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ode45 + + +# name: +# type: sq_string +# elements: 1 +# length: 2466 + -- Function File: [] = ode45 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, + ...]) + -- Command: [SOL] = ode45 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode45 (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff + ordinary differential equations (non-stiff ODEs) or non-stiff + differential algebraic equations (non-stiff DAEs) with the well + known explicit Runge-Kutta method of order (4,5). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, solve an anonymous implementation of the Van der Pol + equation + + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ + "NormControl", "on", "OutputFcn", @odeplot); + ode45 (fvdb, [0 20], [2 0], vopt); + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +This function file can be used to solve a set of non-stiff ordinary +differential + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ode45d + + +# name: +# type: sq_string +# elements: 1 +# length: 3606 + -- Function File: [] = ode45d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [SOL] = ode45d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode45d (@FUN, SLOT, INIT, LAGS, + HIST, [OPT], [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff delay + differential equations (non-stiff DDEs) with a modified version of + the well known explicit Runge-Kutta method of order (4,5). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + DDEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, LAGS is a double vector that + describes the lags of time, HIST is a double matrix and describes + the history of the DDEs, OPT can optionally be a structure array + that keeps the options created with the command `odeset' and PAR1, + PAR2, ... can optionally be other input arguments of any type that + have to be passed to the function defined by @FUN. + + In other words, this function will solve a problem of the form + dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), ...))) + y(slot(1)) = init + y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), ... + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + DDEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example: + - the following code solves an anonymous implementation of a + chaotic behavior + + fcao = @(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy]; + + vopt = odeset ("NormControl", "on", "RelTol", 1e-3); + vsol = ode45d (fcao, [0, 100], 0.5, 2, 0.5, vopt); + + vlag = interp1 (vsol.x, vsol.y, vsol.x - 2); + plot (vsol.y, vlag); legend ("fcao (t,y,z)"); + + - to solve the following problem with two delayed state + variables + + d y1(t)/dt = -y1(t) + d y2(t)/dt = -y2(t) + y1(t-5) + d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10) + + one might do the following + + function f = fun (t, y, yd) + f(1) = -y(1); %% y1' = -y1(t) + f(2) = -y(2) + yd(1,1); %% y2' = -y2(t) + y1(t-lags(1)) + f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2)) + endfunction + T = [0,20] + res = ode45d (@fun, T, [1;1;1], [5, 10], ones (3,2)); + + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +This function file can be used to solve a set of non-stiff delay +differential eq + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ode54 + + +# name: +# type: sq_string +# elements: 1 +# length: 2466 + -- Function File: [] = ode54 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, + ...]) + -- Command: [SOL] = ode54 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode54 (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff + ordinary differential equations (non-stiff ODEs) or non-stiff + differential algebraic equations (non-stiff DAEs) with the well + known explicit Runge-Kutta method of order (5,4). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, solve an anonymous implementation of the Van der Pol + equation + + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ + "NormControl", "on", "OutputFcn", @odeplot); + ode54 (fvdb, [0 20], [2 0], vopt); + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +This function file can be used to solve a set of non-stiff ordinary +differential + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ode54d + + +# name: +# type: sq_string +# elements: 1 +# length: 3606 + -- Function File: [] = ode54d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [SOL] = ode54d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode54d (@FUN, SLOT, INIT, LAGS, + HIST, [OPT], [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff delay + differential equations (non-stiff DDEs) with a modified version of + the well known explicit Runge-Kutta method of order (2,3). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + DDEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, LAGS is a double vector that + describes the lags of time, HIST is a double matrix and describes + the history of the DDEs, OPT can optionally be a structure array + that keeps the options created with the command `odeset' and PAR1, + PAR2, ... can optionally be other input arguments of any type that + have to be passed to the function defined by @FUN. + + In other words, this function will solve a problem of the form + dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), ...))) + y(slot(1)) = init + y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), ... + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + DDEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example: + - the following code solves an anonymous implementation of a + chaotic behavior + + fcao = @(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy]; + + vopt = odeset ("NormControl", "on", "RelTol", 1e-3); + vsol = ode54d (fcao, [0, 100], 0.5, 2, 0.5, vopt); + + vlag = interp1 (vsol.x, vsol.y, vsol.x - 2); + plot (vsol.y, vlag); legend ("fcao (t,y,z)"); + + - to solve the following problem with two delayed state + variables + + d y1(t)/dt = -y1(t) + d y2(t)/dt = -y2(t) + y1(t-5) + d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10) + + one might do the following + + function f = fun (t, y, yd) + f(1) = -y(1); %% y1' = -y1(t) + f(2) = -y(2) + yd(1,1); %% y2' = -y2(t) + y1(t-lags(1)) + f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2)) + endfunction + T = [0,20] + res = ode54d (@fun, T, [1;1;1], [5, 10], ones (3,2)); + + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +This function file can be used to solve a set of non-stiff delay +differential eq + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ode78 + + +# name: +# type: sq_string +# elements: 1 +# length: 2466 + -- Function File: [] = ode78 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, + ...]) + -- Command: [SOL] = ode78 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode78 (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff + ordinary differential equations (non-stiff ODEs) or non-stiff + differential algebraic equations (non-stiff DAEs) with the well + known explicit Runge-Kutta method of order (7,8). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, solve an anonymous implementation of the Van der Pol + equation + + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ + "NormControl", "on", "OutputFcn", @odeplot); + ode78 (fvdb, [0 20], [2 0], vopt); + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +This function file can be used to solve a set of non-stiff ordinary +differential + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ode78d + + +# name: +# type: sq_string +# elements: 1 +# length: 3606 + -- Function File: [] = ode78d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [SOL] = ode78d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode78d (@FUN, SLOT, INIT, LAGS, + HIST, [OPT], [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff delay + differential equations (non-stiff DDEs) with a modified version of + the well known explicit Runge-Kutta method of order (7,8). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + DDEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, LAGS is a double vector that + describes the lags of time, HIST is a double matrix and describes + the history of the DDEs, OPT can optionally be a structure array + that keeps the options created with the command `odeset' and PAR1, + PAR2, ... can optionally be other input arguments of any type that + have to be passed to the function defined by @FUN. + + In other words, this function will solve a problem of the form + dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), ...))) + y(slot(1)) = init + y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), ... + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + DDEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example: + - the following code solves an anonymous implementation of a + chaotic behavior + + fcao = @(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy]; + + vopt = odeset ("NormControl", "on", "RelTol", 1e-3); + vsol = ode78d (fcao, [0, 100], 0.5, 2, 0.5, vopt); + + vlag = interp1 (vsol.x, vsol.y, vsol.x - 2); + plot (vsol.y, vlag); legend ("fcao (t,y,z)"); + + - to solve the following problem with two delayed state + variables + + d y1(t)/dt = -y1(t) + d y2(t)/dt = -y2(t) + y1(t-5) + d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10) + + one might do the following + + function f = fun (t, y, yd) + f(1) = -y(1); %% y1' = -y1(t) + f(2) = -y(2) + yd(1,1); %% y2' = -y2(t) + y1(t-lags(1)) + f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2)) + endfunction + T = [0,20] + res = ode78d (@fun, T, [1;1;1], [5, 10], ones (3,2)); + + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +This function file can be used to solve a set of non-stiff delay +differential eq + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +odebwe + + +# name: +# type: sq_string +# elements: 1 +# length: 2525 + -- Function File: [] = odebwe (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, + ...]) + -- Command: [SOL] = odebwe (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = odebwe (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of stiff ordinary + differential equations (stiff ODEs) or stiff differential + algebraic equations (stiff DAEs) with the Backward Euler method. + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, solve an anonymous implementation of the Van der Pol + equation + + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + vjac = @(vt,vy) [0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]; + vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ + "NormControl", "on", "OutputFcn", @odeplot, \ + "Jacobian",vjac); + odebwe (fvdb, [0 20], [2 0], vopt); + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +This function file can be used to solve a set of stiff ordinary +differential equ + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +odeexamples + + +# name: +# type: sq_string +# elements: 1 +# length: 169 + -- Function File: [] = odeexamples () + Open the differential equations examples menu and allow the user + to select a submenu of ODE, DAE, IDE or DDE examples. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Open the differential equations examples menu and allow the user to +select a sub + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +odeget + + +# name: +# type: sq_string +# elements: 1 +# length: 1313 + -- Function File: [VALUE] = odeget (ODESTRUCT, OPTION, [DEFAULT]) + -- Command: [VALUES] = odeget (ODESTRUCT, {OPT1, OPT2, ...}, [{DEF1, + DEF2, ...}]) + If this function is called with two input arguments and the first + input argument ODESTRUCT is of type structure array and the second + input argument OPTION is of type string then return the option + value VALUE that is specified by the option name OPTION in the + OdePkg option structure ODESTRUCT. Optionally if this function is + called with a third input argument then return the default value + DEFAULT if OPTION is not set in the structure ODESTRUCT. + + If this function is called with two input arguments and the first + input argument ODESTRUCT is of type structure array and the second + input argument OPTION is of type cell array of strings then return + the option values VALUES that are specified by the option names + OPT1, OPT2, ... in the OdePkg option structure ODESTRUCT. + Optionally if this function is called with a third input argument + of type cell array then return the default value DEF1 if OPT1 is + not set in the structure ODESTRUCT, DEF2 if OPT2 is not set in the + structure ODESTRUCT, ... + + Run examples with the command + demo odeget + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with two input arguments and the first input +argument + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +odephas2 + + +# name: +# type: sq_string +# elements: 1 +# length: 1625 + -- Function File: [RET] = odephas2 (T, Y, FLAG) + Open a new figure window and plot the first result from the + variable Y that is of type double column vector over the second + result from the variable Y while solving. The types and the values + of the input parameter T and the output parameter RET depend on + the input value FLAG that is of type string. If FLAG is + ``"init"'' + then T must be a double column vector of length 2 with the + first and the last time step and nothing is returned from + this function, + + ``""'' + then T must be a double scalar specifying the actual time + step and the return value is false (resp. value 0) for 'not + stop solving', + + ``"done"'' + then T must be a double scalar specifying the last time step + and nothing is returned from this function. + + This function is called by a OdePkg solver function if it was + specified in an OdePkg options structure with the `odeset'. This + function is an OdePkg internal helper function therefore it should + never be necessary that this function is called directly by a + user. There is only little error detection implemented in this + function file to achieve the highest performance. + + For example, solve an anonymous implementation of the "Van der + Pol" equation and display the results while solving in a 2D plane + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ('OutputFcn', @odephas2, 'RelTol', 1e-6); + vsol = ode45 (fvdb, [0 20], [2 0], vopt); + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Open a new figure window and plot the first result from the variable Y +that is o + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +odephas3 + + +# name: +# type: sq_string +# elements: 1 +# length: 1735 + -- Function File: [RET] = odephas3 (T, Y, FLAG) + Open a new figure window and plot the first result from the + variable Y that is of type double column vector over the second + and the third result from the variable Y while solving. The types + and the values of the input parameter T and the output parameter + RET depend on the input value FLAG that is of type string. If FLAG + is + ``"init"'' + then T must be a double column vector of length 2 with the + first and the last time step and nothing is returned from + this function, + + ``""'' + then T must be a double scalar specifying the actual time + step and the return value is false (resp. value 0) for 'not + stop solving', + + ``"done"'' + then T must be a double scalar specifying the last time step + and nothing is returned from this function. + + This function is called by a OdePkg solver function if it was + specified in an OdePkg options structure with the `odeset'. This + function is an OdePkg internal helper function therefore it should + never be necessary that this function is called directly by a + user. There is only little error detection implemented in this + function file to achieve the highest performance. + + For example, solve the "Lorenz attractor" and display the results + while solving in a 3D plane + function vyd = florenz (vt, vx) + vyd = [10 * (vx(2) - vx(1)); + vx(1) * (28 - vx(3)); + vx(1) * vx(2) - 8/3 * vx(3)]; + endfunction + + vopt = odeset ('OutputFcn', @odephas3); + vsol = ode23 (@florenz, [0:0.01:7.5], [3 15 1], vopt); + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Open a new figure window and plot the first result from the variable Y +that is o + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +odepkg + + +# name: +# type: sq_string +# elements: 1 +# length: 664 + -- Function File: [] = odepkg () + OdePkg is part of the GNU Octave Repository (the Octave-Forge + project). The package includes commands for setting up various + options, output functions etc. before solving a set of + differential equations with the solver functions that are also + included. At this time OdePkg is under development with the main + target to make a package that is mostly compatible to proprietary + solver products. + + If this function is called without any input argument then open + the OdePkg tutorial in the Octave window. The tutorial can also be + opened with the following command + + doc odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +OdePkg is part of the GNU Octave Repository (the Octave-Forge project). + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +odepkg_event_handle + + +# name: +# type: sq_string +# elements: 1 +# length: 1577 + -- Function File: [SOL] = odepkg_event_handle (@FUN, TIME, Y, FLAG, + [PAR1, PAR2, ...]) + Return the solution of the event function that is specified as the + first input argument @FUN in form of a function handle. The second + input argument TIME is of type double scalar and specifies the + time of the event evaluation, the third input argument Y either is + of type double column vector (for ODEs and DAEs) and specifies the + solutions or is of type cell array (for IDEs and DDEs) and + specifies the derivatives or the history values, the third input + argument FLAG is of type string and can be of the form + ``"init"'' + then initialize internal persistent variables of the function + `odepkg_event_handle' and return an empty cell array of size + 4, + + ``"calc"'' + then do the evaluation of the event function and return the + solution SOL as type cell array of size 4, + + ``"done"'' + then cleanup internal variables of the function + `odepkg_event_handle' and return an empty cell array of size + 4. + Optionally if further input arguments PAR1, PAR2, ... of any type + are given then pass these parameters through `odepkg_event_handle' + to the event function. + + This function is an OdePkg internal helper function therefore it + should never be necessary that this function is called directly by + a user. There is only little error detection implemented in this + function file to achieve the highest performance. + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the solution of the event function that is specified as the +first input a + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +odepkg_examples_dae + + +# name: +# type: sq_string +# elements: 1 +# length: 145 + -- Function File: [] = odepkg_examples_dae () + Open the DAE examples menu and allow the user to select a demo + that will be evaluated. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Open the DAE examples menu and allow the user to select a demo that +will be eval + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +odepkg_examples_dde + + +# name: +# type: sq_string +# elements: 1 +# length: 145 + -- Function File: [] = odepkg_examples_dde () + Open the DDE examples menu and allow the user to select a demo + that will be evaluated. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Open the DDE examples menu and allow the user to select a demo that +will be eval + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +odepkg_examples_ide + + +# name: +# type: sq_string +# elements: 1 +# length: 145 + -- Function File: [] = odepkg_examples_ide () + Open the IDE examples menu and allow the user to select a demo + that will be evaluated. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Open the IDE examples menu and allow the user to select a demo that +will be eval + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +odepkg_examples_ode + + +# name: +# type: sq_string +# elements: 1 +# length: 145 + -- Function File: [] = odepkg_examples_ode () + Open the ODE examples menu and allow the user to select a demo + that will be evaluated. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Open the ODE examples menu and allow the user to select a demo that +will be eval + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +odepkg_structure_check + + +# name: +# type: sq_string +# elements: 1 +# length: 1043 + -- Function File: [NEWSTRUCT] = odepkg_structure_check (OLDSTRUCT, + ["SOLVER"]) + If this function is called with one input argument of type + structure array then check the field names and the field values of + the OdePkg structure OLDSTRUCT and return the structure as + NEWSTRUCT if no error is found. Optionally if this function is + called with a second input argument "SOLVER" of type string taht + specifies the name of a valid OdePkg solver then a higher level + error detection is performed. The function does not modify any of + the field names or field values but terminates with an error if an + invalid option or value is found. + + This function is an OdePkg internal helper function therefore it + should never be necessary that this function is called directly by + a user. There is only little error detection implemented in this + function file to achieve the highest performance. + + Run examples with the command + demo odepkg_structure_check + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with one input argument of type structure +array then + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 +odepkg_testsuite_calcmescd + + +# name: +# type: sq_string +# elements: 1 +# length: 890 + -- Function File: [MESCD] = odepkg_testsuite_calcmescd (SOLUTION, + REFERENCE, ABSTOL, RELTOL) + If this function is called with four input arguments of type + double scalar or column vector then return a normalized value for + the minimum number of correct digits MESCD that is calculated from + the solution at the end of an integration interval SOLUTION and a + set of reference values REFERENCE. The input arguments ABSTOL and + RELTOL are used to calculate a reference solution that depends on + the relative and absolute error tolerances. + + Run examples with the command + demo odepkg_testsuite_calcmescd + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with four input arguments of type double +scalar or co + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +odepkg_testsuite_calcscd + + +# name: +# type: sq_string +# elements: 1 +# length: 873 + -- Function File: [SCD] = odepkg_testsuite_calcscd (SOLUTION, + REFERENCE, ABSTOL, RELTOL) + If this function is called with four input arguments of type + double scalar or column vector then return a normalized value for + the minimum number of correct digits SCD that is calculated from + the solution at the end of an integration interval SOLUTION and a + set of reference values REFERENCE. The input arguments ABSTOL and + RELTOL are unused but present because of compatibility to the + function `odepkg_testsuite_calcmescd'. + + Run examples with the command + demo odepkg_testsuite_calcscd + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with four input arguments of type double +scalar or co + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 +odepkg_testsuite_chemakzo + + +# name: +# type: sq_string +# elements: 1 +# length: 835 + -- Function File: [SOLUTION] = odepkg_testsuite_chemakzo (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return a cell array + SOLUTION with performance informations about the chemical AKZO + Nobel testsuite of differential algebraic equations after solving + (DAE-test). + + Run examples with the command + demo odepkg_testsuite_chemakzo + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with two input arguments and the first input +argument + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +odepkg_testsuite_hires + + +# name: +# type: sq_string +# elements: 1 +# length: 799 + -- Function File: [SOLUTION] = odepkg_testsuite_hires (@SOLVER, RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return a cell array + SOLUTION with performance informations about the HIRES testsuite + of ordinary differential equations after solving (ODE-test). + + Run examples with the command + demo odepkg_testsuite_hires + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with two input arguments and the first input +argument + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 +odepkg_testsuite_implakzo + + +# name: +# type: sq_string +# elements: 1 +# length: 844 + -- Function File: [SOLUTION] = odepkg_testsuite_implakzo (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return a cell array + SOLUTION with performance informations about the chemical AKZO + Nobel testsuite of implicit differential algebraic equations after + solving (IDE-test). + + Run examples with the command + demo odepkg_testsuite_implakzo + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with two input arguments and the first input +argument + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 +odepkg_testsuite_implrober + + +# name: +# type: sq_string +# elements: 1 +# length: 866 + -- Function File: [SOLUTION] = odepkg_testsuite_implrober (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return a cell array + SOLUTION with performance informations about the implicit form of + the modified ROBERTSON testsuite of implicit differential + algebraic equations after solving (IDE-test). + + Run examples with the command + demo odepkg_testsuite_implrober + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with two input arguments and the first input +argument + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 +odepkg_testsuite_impltrans + + +# name: +# type: sq_string +# elements: 1 +# length: 839 + -- Function File: [SOLUTION] = odepkg_testsuite_impltrans (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return the cell array + SOLUTION with performance informations about the TRANSISTOR + testsuite of implicit differential algebraic equations after + solving (IDE-test). + + Run examples with the command + demo odepkg_testsuite_impltrans + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with two input arguments and the first input +argument + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 +odepkg_testsuite_oregonator + + +# name: +# type: sq_string +# elements: 1 +# length: 829 + -- Function File: [SOLUTION] = odepkg_testsuite_oregonator (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return a cell array + SOLUTION with performance informations about the OREGONATOR + testsuite of ordinary differential equations after solving + (ODE-test). + + Run examples with the command + demo odepkg_testsuite_oregonator + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with two input arguments and the first input +argument + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 +odepkg_testsuite_pollution + + +# name: +# type: sq_string +# elements: 1 +# length: 828 + -- Function File: [SOLUTION] = odepkg_testsuite_pollution (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return the cell array + SOLUTION with performance informations about the POLLUTION + testsuite of ordinary differential equations after solving + (ODE-test). + + Run examples with the command + demo odepkg_testsuite_pollution + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with two input arguments and the first input +argument + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 +odepkg_testsuite_robertson + + +# name: +# type: sq_string +# elements: 1 +# length: 836 + -- Function File: [SOLUTION] = odepkg_testsuite_robertson (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return a cell array + SOLUTION with performance informations about the modified + ROBERTSON testsuite of differential algebraic equations after + solving (DAE-test). + + Run examples with the command + demo odepkg_testsuite_robertson + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with two input arguments and the first input +argument + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 +odepkg_testsuite_transistor + + +# name: +# type: sq_string +# elements: 1 +# length: 832 + -- Function File: [SOLUTION] = odepkg_testsuite_transistor (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return the cell array + SOLUTION with performance informations about the TRANSISTOR + testsuite of differential algebraic equations after solving + (DAE-test). + + Run examples with the command + demo odepkg_testsuite_transistor + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called with two input arguments and the first input +argument + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +odeplot + + +# name: +# type: sq_string +# elements: 1 +# length: 1551 + -- Function File: [RET] = odeplot (T, Y, FLAG) + Open a new figure window and plot the results from the variable Y + of type column vector over time while solving. The types and the + values of the input parameter T and the output parameter RET + depend on the input value FLAG that is of type string. If FLAG is + ``"init"'' + then T must be a double column vector of length 2 with the + first and the last time step and nothing is returned from + this function, + + ``""'' + then T must be a double scalar specifying the actual time + step and the return value is false (resp. value 0) for 'not + stop solving', + + ``"done"'' + then T must be a double scalar specifying the last time step + and nothing is returned from this function. + + This function is called by a OdePkg solver function if it was + specified in an OdePkg options structure with the `odeset'. This + function is an OdePkg internal helper function therefore it should + never be necessary that this function is called directly by a + user. There is only little error detection implemented in this + function file to achieve the highest performance. + + For example, solve an anonymous implementation of the "Van der + Pol" equation and display the results while solving + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ('OutputFcn', @odeplot, 'RelTol', 1e-6); + vsol = ode45 (fvdb, [0 20], [2 0], vopt); + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Open a new figure window and plot the results from the variable Y of +type column + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +odeprint + + +# name: +# type: sq_string +# elements: 1 +# length: 1760 + -- Function File: [RET] = odeprint (T, Y, FLAG) + Display the results of the set of differential equations in the + Octave window while solving. The first column of the screen output + shows the actual time stamp that is given with the input arguemtn + T, the following columns show the results from the function + evaluation that are given by the column vector Y. The types and + the values of the input parameter T and the output parameter RET + depend on the input value FLAG that is of type string. If FLAG is + ``"init"'' + then T must be a double column vector of length 2 with the + first and the last time step and nothing is returned from + this function, + + ``""'' + then T must be a double scalar specifying the actual time + step and the return value is false (resp. value 0) for 'not + stop solving', + + ``"done"'' + then T must be a double scalar specifying the last time step + and nothing is returned from this function. + + This function is called by a OdePkg solver function if it was + specified in an OdePkg options structure with the `odeset'. This + function is an OdePkg internal helper function therefore it should + never be necessary that this function is called directly by a + user. There is only little error detection implemented in this + function file to achieve the highest performance. + + For example, solve an anonymous implementation of the "Van der + Pol" equation and print the results while solving + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ('OutputFcn', @odeprint, 'RelTol', 1e-6); + vsol = ode45 (fvdb, [0 20], [2 0], vopt); + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Display the results of the set of differential equations in the Octave +window wh + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +odeset + + +# name: +# type: sq_string +# elements: 1 +# length: 1704 + -- Function File: [ODESTRUCT] = odeset () + -- Command: [ODESTRUCT] = odeset ("FIELD1", VALUE1, "FIELD2", VALUE2, + ...) + -- Command: [ODESTRUCT] = odeset (OLDSTRUCT, "FIELD1", VALUE1, + "FIELD2", VALUE2, ...) + -- Command: [ODESTRUCT] = odeset (OLDSTRUCT, NEWSTRUCT) + If this function is called without an input argument then return a + new OdePkg options structure array that contains all the necessary + fields and sets the values of all fields to default values. + + If this function is called with string input arguments "FIELD1", + "FIELD2", ... identifying valid OdePkg options then return a new + OdePkg options structure with all necessary fields and set the + values of the fields "FIELD1", "FIELD2", ... to the values VALUE1, + VALUE2, ... + + If this function is called with a first input argument OLDSTRUCT + of type structure array then overwrite all values of the options + "FIELD1", "FIELD2", ... of the structure OLDSTRUCT with new values + VALUE1, VALUE2, ... and return the modified structure array. + + If this function is called with two input argumnets OLDSTRUCT and + NEWSTRUCT of type structure array then overwrite all values in the + fields from the structure OLDSTRUCT with new values of the fields + from the structure NEWSTRUCT. Empty values of NEWSTRUCT will not + overwrite values in OLDSTRUCT. + + For a detailed explanation about valid fields and field values in + an OdePkg structure aaray have a look at the `odepkg.pdf', Section + 'ODE/DAE/IDE/DDE options' or run the command `doc odepkg' to open + the tutorial. + + Run examples with the command + demo odeset + + See also: odepkg + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If this function is called without an input argument then return a new +OdePkg op + + + + + diff --git a/octave_packages/odepkg-0.8.2/doc.info b/octave_packages/odepkg-0.8.2/doc.info new file mode 100644 index 0000000..1b913ac --- /dev/null +++ b/octave_packages/odepkg-0.8.2/doc.info @@ -0,0 +1,2758 @@ +Dies ist odepkg.info, hergestellt von Makeinfo Version 4.8 aus +odepkg.texi. + + +File: odepkg.info, Node: Top, Next: Beginners Guide, Prev: (dir), Up: (dir) + +Copyright +********* + +Copyright (C) 2006-2012, Thomas Treichl + + Permission is granted to make and distribute verbatim copies of this +manual provided the copyright notice and this permission notice are +preserved on all copies. + + Permission is granted to copy and distribute modified versions of +this manual under the conditions for verbatim copying, provided that +the entire resulting derived work is distributed under the terms of a +permission notice identical to this one. + + Permission is granted to copy and distribute translations of this +manual into another language, under the same conditions as for modified +versions. + +* Menu: + +* Beginners Guide:: Manual for users who are completely new to OdePkg +* Users Guide:: Manual for users who are already familiar with OdePkg +* Programmers Guide:: Manual for users who want to make changes to OdePkg +* Function Index:: Reference about all functions from this package +* Index:: OdePkg Reference + + +File: odepkg.info, Node: Beginners Guide, Next: Users Guide, Prev: Top, Up: Top + +1 Beginners Guide +***************** + +The "Beginners Guide" is intended for users who are new to OdePkg and +who want to solve differential equations with the Octave language and +the package OdePkg. In this section it will be explained what OdePkg is +about in *Note About OdePkg:: and how OdePkg grew up from the beginning +in *Note OdePkg history and roadmap::. In *Note Installation and +deinstallation:: it is explained how OdePkg can be installed in Octave +and how it can later be removed from Octave if it is not needed +anymore. If you encounter problems while using OdePkg then have a look +at *Note Reporting Bugs:: how these bugs can be reported. In the *Note +The "foo" example:: a first example is explained. + +* Menu: + +* About OdePkg:: An introduction about OdePkg +* OdePkg history and roadmap:: From the first OdePkg release to the future +* Installation and deinstallation:: Setting up OdePkg on your system +* Reporting Bugs:: Writing comments and bugs to the help list +* The "foo" example:: A first example and where to go from here + + +File: odepkg.info, Node: About OdePkg, Next: OdePkg history and roadmap, Prev: Beginners Guide, Up: Beginners Guide + +1.1 About OdePkg +================ + +OdePkg is part of the Octave Repository (resp. the Octave-Forge +project) that was initiated by Matthew W. Roberts and Paul Kienzle in +the year 2000 and that is hosted at `http://octave.sourceforge.net'. +Since then a lot of contributors joined this project and added a lot +more packages and functions to further extend the capabilities of GNU +Octave. + + OdePkg includes commands for setting up various options, output +functions etc. before solving a set of differential equations with the +solver functions that are included. The package formerly was initiated +in autumn 2006 to solve ordinary differential equations (ODEs) only but +there are already improvements so that differential algebraic equations +(DAEs) in explicit form and in implicit form (IDEs) and delay +differential equations (DDEs) can also be solved. The goal of OdePkg is +to have a package for solving differential equations that is mostly +compatible to proprietary solver products. + + +File: odepkg.info, Node: OdePkg history and roadmap, Next: Installation and deinstallation, Prev: About OdePkg, Up: Beginners Guide + +1.2 OdePkg history and roadmap +============================== + +OdePkg Version The initial release was a modification of the old +0.0.1 "ode" package that is hosted at Octave-Forge and that + was written by Marc Compere somewhen between 2000 and + 2001. The four variable step-size Runge-Kutta + algorithms in three solver files and the three fixed + step-size solvers have been merged. It was possible + to set some options for these solvers. The four + output-functions (`odeprint', `odeplot', `odephas2' + and `odephas3') have been added along with other + examples that initially have not been there. +OdePkg Version The major milestone along versions 0.1.x was that +0.1.x four stable solvers have been implemented (ie. + `ode23', `ode45', `ode54' and `ode78') supporting all + options that can be set for these kind of solvers and + also all necessary functions for setting their + options (eg. `odeset', `odepkg_structure_check, + odepkg_event_handle'). Since version 0.1.3 there is + also source code available that interfaces the + Fortran solver `dopri5.f' (that is written by Ernst + Hairer and Gerhard Wanner, cf. + `odepkg_mexsolver_dopri5.c' and the helper files + `odepkgext.c' and `odepkgmex.c'). +OdePkg Version The main work along version 0.2.x was to make the +0.2.x interface functions for the non-stiff and stiff + solvers from Ernst Hairer and Gerhard Wanner enough + stable so that they could be compiled and installed + by default. Wrapper functions have been added to the + package containing a help text and test functions + (eg. `ode2r', `ode5r', `oders'). Six testsuite + functions have been added to check the performance of + the different solvers (eg. + `odepkg_testsuite_chemakzo', + `odepkg_testsuite_oregonator'). +OdePkg Version Fixed some minor bugs along version 0.3.x. Thanks to +0.3.x Jeff Cash, who released his Fortran `mebdfX' solvers + under the GNU GPL V2 after some discussion. The first + IDE solver `odebdi' appeared that is an interface + function for Cash's `mebdfi' Fortran core solver. + With version 0.3.5 of OdePkg a first new interface + function was created based on Octave's C++ + `DEFUN_DLD' interface to achieve the highest + performance available. Added more examples and + testsuite functions (eg. `odepkg_equations_ilorenz', + `odepkg_testsuite_implrober'). Porting all at this + time present Mex-file solvers to Octave's C++ + `DEFUN_DLD' interface. Ongoing work with this manual. +OdePkg Version Added a new solver function `odekdi' for the direct +0.4.x method (not the Krylov method) of the `daskr.f' + solver from the authors Peter N. Brown, Alan C. + Hindmarsh, Linda R. Petzold and Clement W. Ulrich + that is available under a modified BSD license + (without advertising clause). Ongoing work with this + manual. +OdePkg Version Added new solver functions `ode23d', `ode45d', +0.5.x `ode54d' and `ode78d' for solving non-stiff delay + differential equations (non-stiff DDEs). These + solvers are based on the Runge-Kutta solvers + `ode23'..`ode78'. Tests and demos have been included + for this type of solvers. Added new functions + `odeexamples', `odepkg_examples_ode', + `odepkg_examples_dae', `odepkg_examples_ide' and + `odepkg_examples_ide'. Ongoing work with this manual. +OdePkg Version A lot of compatibility tests, improvements, bugfixes, +0.6.x etc. +(current) Version Final releases before version 1.0.0. +0.8.x +(future) Version Completed OdePkg release 1.0.0 with M-solvers and +1.0.0 DLD-solvers. + + +File: odepkg.info, Node: Installation and deinstallation, Next: Reporting Bugs, Prev: OdePkg history and roadmap, Up: Beginners Guide + +1.3 Installation and deinstallation +=================================== + +OdePkg can be installed easily using the `pkg' command in Octave. To +install OdePkg download the latest release of OdePkg from the +Octave-Forge download site, then get into that directory where the +downloaded release of OdePkg has been saved, start Octave and type + pkg install odepkg-x.x.x.tar.gz + where `x.x.x' in the name of the `*.tar.gz' file is the current +release number of OdePkg that is available. If you want to deinstall +resp. remove OdePkg then simply type + pkg uninstall odepkg + and make sure that OdePkg has been removed completely and does not +appear in the list of installed packages anymore with the following +command + pkg list + + +File: odepkg.info, Node: Reporting Bugs, Next: The "foo" example, Prev: Installation and deinstallation, Up: Beginners Guide + +1.4 Reporting Bugs +================== + +If you encounter problems during the installation process of OdePkg +with the `pkg' command or if you have an OdePkg that seems to be broken +or if you encounter problems while using OdePkg or if you find bugs in +the source codes then please report all of that via email at the +Octave-Forge mailing-list using the email address +. Not only bugs are welcome but also +any kind of comments are welcome (eg. if you think that OdePkg is +absolutely useful or even unnecessary). + + +File: odepkg.info, Node: The "foo" example, Prev: Reporting Bugs, Up: Beginners Guide + +1.5 The "foo" example +===================== + +Have a look at the first ordinary differential equation with the name +"`foo'". The `foo' equation of second order may be of the form y"(t) + +C_1 y'(t) + C_2 y(t) = C_3. With the substitutions y_1(t) = y(t) and +y_2(t) = y'(t) this differential equation of second order can be split +into two differential equations of first order, ie. y'_1(t) = y_2(t) +and y'_2(t) = - C_1 y_2(t) - C_2 y_1(t) + C_3. Next the numerical +values for the constants need to be defined, ie. C_1 = 2.0, C_2 = 5.0, +C_3 = 10.0. This set of ordinary differential equations can then be +written as an Octave M-file function like + function vdy = foo (vt, vy, varargin) + vdy(1,1) = vy(2); + vdy(2,1) = - 2.0 * vy(2) - 5.0 * vy(1) + 10.0; + endfunction + It can be seen that this ODEs do not depend on time, nevertheless +the first input argument of this function needs to be defined as the +time argument VT followed by a solution array argument `vy' as the +second input argument and a variable size input argument `varargin' +that can be used to set up user defined constants or control variables. + + As it is known that `foo' is a set of ordinary differential +equations we can choose one of the four Runge-Kutta solvers (cf. *Note +Solver families::). It is also known that the time period of interest +may be between t_0 = 0.0 and t_e = 5.0 as well as that the initial +values of the ODEs are y_1(t=0) = 0.0 and y_2(t=0) = 0.0. Solving this +set of ODEs can be done by typing the following commands in Octave + ode45 (@foo, [0 5], [0 0]); + A figure window opens and it can be seen how this ODEs are solved +over time. For some of the solvers that come with OdePkg it is possible +to define exact time stamps for which an solution is required. Then the +example can be called eg. + ode45 (@foo, [0:0.1:5], [0 0]); + If it is not wanted that a figure window is opened while solving +then output arguments have to be used to catch the results of the +solving process and to not pass the results to the figure window, eg. + [t, y] = ode45 (@foo, [0 5], [0 0]); + Results can also be obtained in form of an Octave structure if one +output argument is used like in the following example. Then the results +are stored in the fields `S.x' and `S.y'. + S = ode45 (@foo, [0 5], [0 0]); + As noticed before, a function for the ordinary differential +equations must not be rewritten all the time if some of the parameters +are going to change. That's what the input argument `varargin' can be +used for. So rewrite the function `foo' into `newfoo' the following way + function vdy = newfoo (vt, vy, varargin) + vdy(1,1) = vy(2); + vdy(2,1) = -varargin{1}*vy(2)-varargin{2}*vy(1)+varargin{3}; + endfunction + There is nothing said anymore about the constant values but if using +the following caller routine in the Octave window then the same results +can be obtained with the new function `newfoo' as before with the +function `foo' (ie. the parameters are directly feed through from the +caller routine `ode45' to the function `newfoo') + ode45 (@newfoo, [0 5], [0 0], 2.0, 5.0, 10.0); + OdePkg can do much more while solving differential equations, eg. +setting up other output functions instead of the function `odeplot' or +setting up other tolerances for the solving process etc. As a last +example in this beginning chapter it is shown how this can be done, ie. +with the command `odeset' + A = odeset ('OutputFcn', @odeprint); + ode45 (@newfoo, [0 5], [0 0], A, 2.0, 5.0, 10.0); + or + A = odeset ('OutputFcn', @odeprint, 'AbsTol', 1e-5, \ + 'RelTol', 1e-5, 'NormControl', 'on'); + ode45 (@newfoo, [0 5], [0 0], A, 2.0, 5.0, 10.0); + The options structure `A' that can be set up with with the command +`odeset' must always be the fourth input argument when using the ODE +solvers and the DAE solvers but if you are using an IDE solver then `A' +must be the fifth input argument (cf. *Note Solver families::). The +various options that can be set with the command `odeset' are described +in *Note ODE/DAE/IDE/DDE options::. + + Further examples have also been implemented. These example files and +functions are of the form `odepkg_examples_*'. Different testsuite +examples have been added that are stored in files with filenames +`odepkg_testsuite_*'. Before reading the next chapter note that nearly +every function that comes with OdePkg has its own help text and its own +examples. Look for yourself how the different functions, options and +combinations can be used. If you want to have a look at the help +description of a special function then type + help fcnname + in the Octave window where `fcnname' is the name of the function for +the help text to be viewed. Type + demo fcnname + in the Octave window where `fcnname' is the name of the function for +the demo to run. Finally write + doc odepkg + for opening this manual in the texinfo reader of the Octave window. + + +File: odepkg.info, Node: Users Guide, Next: Programmers Guide, Prev: Beginners Guide, Up: Top + +2 Users Guide +************* + +The "Users Guide" is intended for trained users who already know in +principal how to solve differential equations with the Octave language +and OdePkg. In this chapter it will be explained which equations can be +solved with OdePkg in *Note Differential Equations::. It will be +explained which solvers can be used for the different kind of equations +in *Note Solver families:: and which options can be set for the +optimization of the solving process in *Note ODE/DAE/IDE/DDE options::. +The help text of all M-file functions and all Oct-file functions have +been extracted and are displayed in the sections *Note M-File Function +Reference:: and *Note Oct-File Function Reference::. + +* Menu: + +* Differential Equations:: The different kind of problems that can be solved with OdePkg +* Solver families:: The different kind of solvers within OdePkg +* ODE/DAE/IDE/DDE options:: The options that can be set for a solving process +* M-File Function Reference:: The description about all `*.m'-file functions +* Oct-File Function Reference:: The description about all DLD-functions from `*.oct'-files + + +File: odepkg.info, Node: Differential Equations, Next: Solver families, Prev: Users Guide, Up: Users Guide + +2.1 Differential Equations +========================== + +In this section the different kind of differential equations that can +be solved with OdePkg are explained. The formulation of ordinary +differential equations is described in section *Note ODE equations:: +followed by the description of explicetly formulated differential +algebraic equations in section *Note DAE equations::, implicetely +formulated differential algebraic equations in section *Note IDE +equations:: and delay differential algebraic equations in section *Note +DDE equations::. + +* Menu: + +* ODE equations:: Ordinary differential equations +* DAE equations:: Differential algebraic equations in explicit form +* IDE equations:: Differential algebraic equations in implicit form +* DDE equations:: Delay differential equations + + +File: odepkg.info, Node: ODE equations, Next: DAE equations, Prev: Differential Equations, Up: Differential Equations + +2.1.1 ODE equations +------------------- + +ODE equations in general are of the form y'(t) = f(t,y) where y'(t) may +be a scalar or vector of derivatives. The variable t always is a scalar +describing one point of time and the variable y(t) is a scalar or +vector of solutions from the last time step of the set of ordinary +differential equations. If the equation is non-stiff then the *Note +Runge-Kutta solvers:: can be used to solve such kind of differential +equations but if the equation is stiff then it is recommended to use +the *Note Hairer-Wanner solvers::. An ODE equation definition in Octave +must look like + function [dy] = ODEequation (t, y, varargin) + + +File: odepkg.info, Node: DAE equations, Next: IDE equations, Prev: ODE equations, Up: Differential Equations + +2.1.2 DAE equations +------------------- + +DAE equations in general are of the form M(t,y) \cdot y'(t) = f(t,y) +where y'(t) may be a scalar or vector of derivatives. The variable t +always is a scalar describing one point of time and the variable y(t) +is a scalar or vector of solutions from the set of differential +algebraic equations. The variable M(t,y) is the squared singular mass +matrix that may depend on y and t. If M(t,y) is not singular then the +set of equations from above can normally also be written as an ODE +equation. If it does not depend on time then it can be defined as a +constant matrix or a function. If it does depend on time then it must +be defined as a function. Use the command `odeset' to pass the mass +matrix information to the solver function (cf. *Note ODE/DAE/IDE/DDE +options::). If the equation is non-stiff then the *Note Runge-Kutta +solvers:: can be used to solve such kind of differential equations but +if the equation is stiff then it is recommended to use the *Note +Hairer-Wanner solvers::. A DAE equation definition in Octave must look +like + function [dy] = DAEequation (t, y, varargin) + and the mass matrix definition can either be a constant mass matrix +or a valid function handle to a mass matrix calculation function that +can be set with the command `odeset' (cf. option `Mass' of section +*Note ODE/DAE/IDE/DDE options::). + + +File: odepkg.info, Node: IDE equations, Next: DDE equations, Prev: DAE equations, Up: Differential Equations + +2.1.3 IDE equations +------------------- + +IDE equations in general are of the form y'(t) + f(t,y) = 0 where y'(t) +may be a scalar or vector of derivatives. The variable t always is a +scalar describing one point of time and the variable y(t) is a scalar +or vector of solutions from the set of implicit differential equations. +Only IDE solvers from section *Note Cash modified BDF solvers:: or +section *Note DDaskr direct method solver:: can be used to solve such +kind of differential equations. A DAE equation definition in Octave +must look like + function [residual] = IDEequation (t, y, dy, varargin) + + +File: odepkg.info, Node: DDE equations, Prev: IDE equations, Up: Differential Equations + +2.1.4 DDE equations +------------------- + +DDE equations in general are of the form y'(t) = +f(t,y(t),y(t-\tau_1),...,y(t-\tau_n)) where y'(t) may be a scalar or +vector of derivatives. The variable t always is a scalar describing one +point of time and the variables y(t-\tau_i) are scalars or vectors from +the past. Only DDE solvers from section *Note Modified Runge-Kutta +solvers:: can be used to solve such kind of differential equations. A +DDE equation definition in Octave must look like + function [dy] = DDEequation (t, y, z, varargin) + NOTE: Only DDEs with constant delays y(t-\tau_i) can be solved with +OdePkg. + + +File: odepkg.info, Node: Solver families, Next: ODE/DAE/IDE/DDE options, Prev: Differential Equations, Up: Users Guide + +2.2 Solver families +=================== + +In this section the different kind of solvers are introduced that have +been implemented in OdePkg. This section starts with the basic +Runge-Kutta solvers in section *Note Runge-Kutta solvers:: and is +continued with the Mex-file Hairer-Wanner solvers in section *Note +Hairer-Wanner solvers::. Performance tests have also been added to the +OdePkg. Some of these performance results have been added to section +*Note ODE solver performances::. + +* Menu: + +* Runge-Kutta solvers:: ODE solvers written as `*.m' files +* Hairer-Wanner solvers:: DAE solvers interfaced by `*.cc' files +* Cash modified BDF solvers:: A DAE and an IDE solver interfaced by `*.cc' files +* DDaskr direct method solver:: An IDE solver interfaced by a `*.cc' file +* Modified Runge-Kutta solvers:: DDE solvers written as `*.m' files +* ODE solver performances:: Cross math-engine performance tests + + +File: odepkg.info, Node: Runge-Kutta solvers, Next: Hairer-Wanner solvers, Prev: Solver families, Up: Solver families + +2.2.1 Runge-Kutta solvers +------------------------- + +The Runge-Kutta solvers are written in the Octave language and that are +saved as `m'-files. There have been implemented four different solvers +with a very similiar structure, ie. `ode23', `ode45', `ode54' and +`ode78'(1). The Runge-Kutta solvers have been added to the OdePkg to +solve non-stiff ODEs and DAEs, stiff equations of that form cannot be +solved with these solvers. + + The order of all of the following Runge-Kutta methods is the order +of the local truncation error, which is the principle error term in the +portion of the Taylor series expansion that gets dropped, or +intentionally truncated. This is different from the local error which +is the difference between the estimated solution and the actual, or +true solution. The local error is used in stepsize selection and may be +approximated by the difference between two estimates of different order, +l(h) = x(O(h+1)) - x(O(h)). With this definition, the local error will +be as large as the error in the lower order method. The local +truncation error is within the group of terms that gets multipled by h +when solving for a solution from the general Runge-Kutta method. +Therefore, the order-p solution created by the Runge-Kunge method will +be roughly accurate to O(h^(p+1)) since the local truncation error +shows up in the solution as e = h\cdot d which is h-times an +O(h^p)-term, or rather O(h^(p+1)). + +`ode23'Integrates a system of non-stiff ordinary differential equations + (non-stiff ODEs and DAEs) using second and third order Runge-Kutta + formulas. This particular third order method reduces to Simpson's + 1/3 rule and uses the third order estimation for the output + solutions. Third order accurate Runge-Kutta methods have local and + global errors of O(h^4) and O(h^3) respectively and yield exact + results when the solution is a cubic (the variable h is the step + size from one integration step to another integration step). This + solver requires three function evaluations per integration step. +`ode45'Integrates a system of non-stiff ordinary differential equations + (non-stiff ODEs and DAEs) using fourth and fifth order embedded + formulas from Fehlberg. This is a fourth-order accurate integrator + therefore the local error normally expected is O(h^5). However, + because this particular implementation uses the fifth-order + estimate for x_out (ie. local extrapolation) moving forward with + the fifth-order estimate should yield local error of O(h^6). This + solver requires six function evaluations per integration step. +`ode54'Integrates a system of non-stiff ordinary differential equations + (non-stiff ODEs and DAEs) using fifth and fourth order Runge-Kutta + formulas. The Fehlberg 4(5) of the `ode45' pair is established and + works well, however, the Dormand-Prince 5(4) pair minimizes the + local truncation error in the fifth-order estimate which is what + is used to step forward (local extrapolation). Generally it + produces more accurate results and costs roughly the same + computationally. This solver requires seven function evaluations + per integration step. +`ode78'Integrates a system of non-stiff ordinary differential equations + (non-stiff ODEs and DAEs) using seventh and eighth order + Runge-Kutta formulas. This is a seventh-order accurate integrator + therefore the local error normally expected is O(h^8). However, + because this particular implementation uses the eighth-order + estimate for x_out moving forward with the eighth-order estimate + will yield errors on the order of O(h^9). This solver requires + thirteen function evaluations per integration step. + + ---------- Footnotes ---------- + + (1) The descriptions for these Runge-Kutta solvers have been taken +from the help texts of the initial Runge-Kutta solvers that were +written by Marc Compere, he also pointed out that "a relevant +discussion on step size choice can be found on page 90ff in U.M. +Ascher, L.R. Petzold, Computer Methods for Ordinary Differential +Equations and Differential-Agebraic Equations, Society for Industrial +and Applied Mathematics (SIAM), Philadelphia, 1998". + + +File: odepkg.info, Node: Hairer-Wanner solvers, Next: Cash modified BDF solvers, Prev: Runge-Kutta solvers, Up: Solver families + +2.2.2 Hairer-Wanner solvers +--------------------------- + +The Hairer-Wanner solvers have been written by Ernst Hairer and Gerhard +Wanner. They are written in the Fortran language (hosted at +`http://www.unige.ch/~hairer') and that have been added to the OdePkg +as a compressed file with the name `hairer.tgz'. Papers and other +details about these solvers can be found at the adress given before. +The licence of these solvers is a modified BSD license (without +advertising clause and therefore are GPL compatible) and can be found +as `licence.txt' file in the `hairer.tgz' package. The Hairer-Wanner +solvers have been added to the OdePkg to solve non-stiff and stiff ODEs +and DAEs that cannot be solved with any of the Runge-Kutta solvers. + + Interface functions for these solvers have been created and have +been added to the OdePkg. Their names are `odepkg_octsolver_XXX.cc' +where `XXX' is the name of the Fortran file that is interfaced. The +file `dldsolver.oct' is created automatically when installing OdePkg +with the command `pkg', but developers can also build each solver +manually with the instructions given as a preamble of every +`odepkg_octsolver_XXX.cc' file. + + To provide a short name and to circumvent from the syntax of the +original solver function wrapper functions have been added, eg. the +command `ode2r' calls the solver `radau' from the Fortran file +`radau.f'. The other wrapper functions for the Hairer-Wanner solvers +are `ode5r' for the `radau5' solver, `oders' for the `rodas' solver and +`odesx' for the `seulex' solver. The help text of all these solver +functions can be diaplyed by calling `help wrapper' where wrapper is +one of `ode2r', `ode5r', `oders' or `odesx'. + + +File: odepkg.info, Node: Cash modified BDF solvers, Next: DDaskr direct method solver, Prev: Hairer-Wanner solvers, Up: Solver families + +2.2.3 Cash modified BDF solvers +------------------------------- + +The backward differentiation algorithm solvers have been written by +Jeff Cash in the Fortran language and that are hosted at +`http://pitagora.dm.uniba.it/~testset'. They have been added to the +OdePkg as a compressed file with the name `cash.tgz'. The license of +these solvers is a General Public License V2 that can be found as a +preamble of each Fortran solver source file. Papers and other details +about these solvers can be found at the host adress given before and +also at Jeff Cash's homepage at `http://www.ma.ic.ac.uk/~jcash'. Jeff +Cash's modified BDF solvers have been added to the OdePkg to solve +non-stiff and stiff ODEs and DAEs and also IDEs that cannot be solved +with any of the Runge-Kutta solvers. + + Interface functions for these solvers have been created and have +been added to the OdePkg. Their names are `odepkg_octsolver_XXX.cc' +where `XXX' is the name of the Fortran file that is interfaced. The +file `dldsolver.oct' is created automatically when installing OdePkg +with the command `pkg', but developers can also build each solver +manually with the instructions given as a preamble of every +`odepkg_octsolver_XXX.cc' file. + + To provide a short name and to circumvent from the syntax of the +original solver function wrapper functions have been added. The command +`odebda' calls the solver `mebdfdae' from the Fortran file `mebdf.f' +and the `odebdi' calls the solver `mebdfi' from the Fortran file +`mebdfi.f'. + + +File: odepkg.info, Node: DDaskr direct method solver, Next: Modified Runge-Kutta solvers, Prev: Cash modified BDF solvers, Up: Solver families + +2.2.4 DDaskr direct method solver +--------------------------------- + +The direct method from the Krylov solver file `ddaskr.f' has been +written by Peter N. Brown, Alan C. Hindmarsh, Linda R. Petzold and +Clement W. Ulrich in the Fortran language and that is hosted at +`http://www.netlib.org'. The Krylov method has not been implemented +within OdePkg, only the direct method has been implemented. The solver +and further files for the interface have been added to the OdePkg as a +compressed package with the name `ddaskr.tgz'. The license of these +solvers is a modfied BSD license (without advertising clause) that can +be found inside of the compressed package. Other details about this +solver can be found as a preamble in the source file `ddaskr.f'. The +direct method solver of the file `ddaskr.f' has been added to the +OdePkg to solve non-stiff and stiff IDEs. + + An interface function for this solver has been created and has been +added to the OdePkg. The source file name is +`odepkg_octsolver_ddaskr.cc'. The binary function can be found in the +file `dldsolver.oct' that is created automatically when installing +OdePkg with the command `pkg', but developers can also build the solver +wrapper manually with the instructions given as a preamble of the +`odepkg_octsolver_ddaskr.cc' file. + + To provide a short name and to circumvent from the syntax of the +original solver function a wrapper function has been added. The command +`odekdi' calls the direct method of the solver `ddaskr' from the +Fortran file `ddaskr.f'. + + +File: odepkg.info, Node: Modified Runge-Kutta solvers, Next: ODE solver performances, Prev: DDaskr direct method solver, Up: Solver families + +2.2.5 Modified Runge-Kutta solvers +---------------------------------- + +The modified Runge-Kutta solvers are written in the Octave language and +that are saved as m-files. There have been implemented four different +solvers that do have a very similiar structure to that solvers found in +section *Note Runge-Kutta solvers::. Their names are `ode23d', +`ode45d', `ode54d' and `ode78d'. The modified Runge-Kutta solvers have +been added to the OdePkg to solve non-stiff DDEs with constant delays +only, stiff equations of that form cannot be solved with these solvers. +For further information about the error estimation of these solvers cf. +section *Note Runge-Kutta solvers::. + + Note: The four DDE solvers of OdePkg are not syntax compatible to +propietary solvers. The reason is that the input arguments of the +propietary DDE-solvers are completely mixed up in comparison to ODE, +DAE and IDE propietary solvers. The DDE solvers of OdePkg have been +implemented in form of a syntax compatible way to the other family +solvers, eg. propietary solver calls look like + + ode23 (@fode, vt, vy) %# for solving an ODE + ode15i (@fide, vt, vy, vdy) %# for solving an IDE + dde23 (@fdde, vlag, vhist, vt) %# for solving a DDE + whereas in OdePkg the same examples would look like + ode23 (@fode, vt, vy) %# for solving an ODE + odebdi (@fide, vt, vy, vdy) %# for solving an IDE + ode23d (@fdde, vt, vy, vlag, vhist) %# for solving a DDE + + Further, the commands `ddeset' and `ddeget' have not been +implemented in OdePkg. Use the functions `odeset' and `odeget' for +setting and returning DDE options instead. + + +File: odepkg.info, Node: ODE solver performances, Prev: Modified Runge-Kutta solvers, Up: Solver families + +2.2.6 ODE solver performances +----------------------------- + +The following tables give an overview about the performance of the +OdePkg ODE/DAE solvers in comparison to propietary solvers when running +the HIRES function from the OdePkg testsuite (non-stiff ODE test). + + >> odepkg ('odepkg_performance_mathires'); + ----------------------------------------------------------------------------------------- + Solver RelTol AbsTol Init Mescd Scd Steps Accept FEval JEval LUdec Time + ----------------------------------------------------------------------------------------- + ode113 1e-007 1e-007 1e-009 7.57 5.37 24317 21442 45760 11.697 + ode23 1e-007 1e-007 1e-009 7.23 5.03 13876 13862 41629 2.634 + ode45 1e-007 1e-007 1e-009 7.91 5.70 11017 10412 66103 2.994 + ode15s 1e-007 1e-007 1e-009 7.15 4.95 290 273 534 8 59 0.070 + ode23s 1e-007 1e-007 1e-009 6.24 4.03 702 702 2107 702 702 0.161 + ode23t 1e-007 1e-007 1e-009 6.00 3.79 892 886 1103 5 72 0.180 + ode23tb 1e-007 1e-007 1e-009 5.85 3.65 735 731 2011 5 66 0.230 + ----------------------------------------------------------------------------------------- + + octave:1> odepkg ('odepkg_performance_octavehires'); + ----------------------------------------------------------------------------------------- + Solver RelTol AbsTol Init Mescd Scd Steps Accept FEval JEval LUdec Time + ----------------------------------------------------------------------------------------- + ode23 1e-07 1e-07 1e-09 7.86 5.44 17112 13369 51333 138.071 + ode45 1e-07 1e-07 1e-09 8.05 5.63 9397 9393 56376 92.065 + ode54 1e-07 1e-07 1e-09 8.25 5.83 9300 7758 65093 84.319 + ode78 1e-07 1e-07 1e-09 8.54 6.12 7290 6615 94757 97.746 + ode2r 1e-07 1e-07 1e-09 7.69 5.27 50 50 849 50 59 0.624 + ode5r 1e-07 1e-07 1e-09 7.55 5.13 71 71 671 71 81 0.447 + oders 1e-07 1e-07 1e-09 7.08 4.66 138 138 828 138 138 0.661 + odesx 1e-07 1e-07 1e-09 6.56 4.13 30 26 1808 26 205 1.057 + odebda 1e-07 1e-07 1e-09 6.53 4.11 401 400 582 42 42 0.378 + ----------------------------------------------------------------------------------------- + + The following tables give an overview about the performance of the +OdePkg ODE/DAE solvers in comparison to propietary solvers when running +the chemical AKZO-NOBEL function from the OdePkg testsuite (non-stiff +ODE test). + + >> odepkg ('odepkg_performance_matchemakzo'); + ----------------------------------------------------------------------------------------- + Solver RelTol AbsTol Init Mescd Scd Steps Accept FEval JEval LUdec Time + ----------------------------------------------------------------------------------------- + ode113 1e-007 1e-007 1e-007 NaN Inf - - - - - - + ode23 1e-007 1e-007 1e-007 NaN Inf 15 15 47 0.431 + ode45 1e-007 1e-007 1e-007 NaN Inf 15 15 92 0.170 + ode15s 1e-007 1e-007 1e-007 7.04 6.20 161 154 4 35 0.521 + ode23s 1e-007 1e-007 1e-007 7.61 6.77 1676 1676 5029 1676 1677 2.704 + ode23t 1e-007 1e-007 1e-007 5.95 5.11 406 404 3 39 0.611 + ode23tb 1e-007 1e-007 1e-007 NaN Inf 607 3036 1 608 6.730 + ----------------------------------------------------------------------------------------- + + octave:1> odepkg ('odepkg_performance_octavechemakzo'); + ----------------------------------------------------------------------------------------- + Solver RelTol AbsTol Init Mescd Scd Steps Accept FEval JEval LUdec Time + ----------------------------------------------------------------------------------------- + ode23 1e-07 1e-07 1e-07 2.95 2.06 424 385 1269 1.270 + ode45 1e-07 1e-07 1e-07 2.95 2.06 256 218 1530 1.281 + ode54 1e-07 1e-07 1e-07 2.95 2.06 197 195 1372 1.094 + ode78 1e-07 1e-07 1e-07 2.95 2.06 184 156 2379 1.933 + ode2r 1e-07 1e-07 1e-07 8.50 7.57 39 39 372 39 43 0.280 + ode5r 1e-07 1e-07 1e-07 8.50 7.57 39 39 372 39 43 0.238 + oders 1e-07 1e-07 1e-07 7.92 7.04 67 66 401 66 67 0.336 + odesx 1e-07 1e-07 1e-07 7.19 6.26 19 19 457 19 82 0.248 + odebda 1e-07 1e-07 1e-07 7.47 6.54 203 203 307 25 25 0.182 + ----------------------------------------------------------------------------------------- + + Other testsuite functions have been added to the OdePkg that can be +taken for further performance tests and syntax checks on your own +hardware. These functions all have a name `odepkg_testsuite_XXX.m' with +`XXX' being the name of the testsuite equation that has been +implemented. + + +File: odepkg.info, Node: ODE/DAE/IDE/DDE options, Next: M-File Function Reference, Prev: Solver families, Up: Users Guide + +2.3 ODE/DAE/IDE/DDE options +=========================== + +The default values of an OdePkg options structure can be displayed with +the command `odeset'. If `odeset' is called without any input argument +and one output argument then a OdePkg options structure with default +values is created, eg. + A = odeset (); + disp (A); + There also is an command `odeget' which extracts one or more options +from an OdePkg options structure. Other values than default values can +also be set with the command `odeset'. The function description of the +commands `odeset' and `odeget' can be found in the *Note M-File +Function Reference::. The values that can be set with the `odeset' +command are + +`RelTol' + The option `RelTol' is used to set the relative error tolerance + for the error estimation of the solver that is used while solving. + It can either be a positive scalar or a vector with every element + of the vector being a positive scalar (this depends on the solver + that is used if both variants are supported). The definite error + estimation equation also depends on the solver that is used but + generalized (eg. for the solvers `ode23', `ode45', `ode54' and + `ode78') it may be a form like e(t) = max (r_tol^T y(t), a_tol). + Run the following example to illustrate the effect if this option + is used + function yd = fvanderpol (vt, vy, varargin) + mu = 1; ## Set mu > 10 for higher stiffness + yd = [vy(2); mu * (1 - vy(1)^2) * vy(2) - vy(1)]; + endfunction + + A = odeset ("RelTol", 1, "OutputFcn", @odeplot); + ode78 (@fvanderpol, [0 20], [2 0], A); + B = odeset (A, "RelTol", 1e-10); + ode78 (@fvanderpol, [0 20], [2 0], B); + +`AbsTol' + The option `AbsTol' is used to set the absolute error tolerance + for the error estimation of the solver that is used while solving. + It can either be a positive scalar or a vector with every element + of the vector being a positive scalar (it depends on the solver + that is used if both variants are supported). The definite error + estimation equation also depends on the solver that is used but + generalized (eg. for the solvers `ode23', `ode45', `ode54' and + `ode78') it may be a form like e(t) = max (r_tol^T y(t), a_tol). + Run the following example to illustrate the effect if this option + is used + ## An anonymous implementation of the Van der Pol equation + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + A = odeset ("AbsTol", 1e-3, "OutputFcn", @odeplot); + ode54 (fvdb, [0 10], [2 0], A); + B = odeset (A, "AbsTol", 1e-10); + ode54 (fvdb, [0 10], [2 0], B); + +`NormControl' + The option `NormControl' is used to set the type of error + tolerance calculation of the solver that is used while solving. It + can either be the string `"on"' or `"off"'. At the time the solver + starts solving a warning message may be displayed if the solver + will ignore the `"on"' setting of this option because of an + unhandled resp. missing implementation. If set `"on"' then the + definite error estimation equation also depends on the solver that + is used but generalized (eg. for the solvers `ode23', `ode45', + `ode54' and `ode78') it may be a form like e(t) = max (r_tol^T max + (norm (y(t), \infty)), a_tol). Run the following example to + illustrate the effect if this option is used + function yd = fvanderpol (vt, vy, varargin) + mu = 1; ## Set mu > 10 for higher stiffness + yd = [vy(2); mu * (1 - vy(1)^2) * vy(2) - vy(1)]; + endfunction + + A = odeset ("NormControl", "on", "OutputFcn", @odeplot); + ode78 (@fvanderpol, [0 20], [2 0], A); + B = odeset (A, "NormControl", "off"); + ode78 (@fvanderpol, [0 20], [2 0], B); + +`MaxStep' + The option `MaxStep' is used to set the maximum step size for the + solver that is used while solving. It can only be a positive + scalar. By default this value is set internally by every solver + and also may differ when using different solvers. Run the + following example to illustrate the effect if this option is used + function yd = fvanderpol (vt, vy, varargin) + mu = 1; ## Set mu > 10 for higher stiffness + yd = [vy(2); mu * (1 - vy(1)^2) * vy(2) - vy(1)]; + endfunction + + A = odeset ("MaxStep", 10, "OutputFcn", @odeprint); + ode78 (@fvanderpol, [0 20], [2 0], A); + B = odeset (A, "MaxStep", 1e-1); + ode78 (@fvanderpol, [0 20], [2 0], B); + +`InitialStep' + The option `InitialStep' is used to set the initial first step + size for the solver. It can only be a positive scalar. By default + this value is set internally by every solver and also may be + different when using different solvers. Run the following example + to illustrate the effect if this option is used + function yd = fvanderpol (vt, vy, varargin) + mu = 1; ## Set mu > 10 for higher stiffness + yd = [vy(2); mu * (1 - vy(1)^2) * vy(2) - vy(1)]; + endfunction + + A = odeset ("InitialStep", 1, "OutputFcn", @odeprint); + ode78 (@fvanderpol, [0 1], [2 0], A); + B = odeset (A, "InitialStep", 1e-5); + ode78 (@fvanderpol, [0 1], [2 0], B); + +`InitialSlope' + The option `InitialSlope' is not handled by any of the solvers by + now. +`OutputFcn' + The option `OutputFcn' can be used to set up an output function + for displaying the results of the solver while solving. It must be + a function handle to a valid function. There are four predefined + output functions available with OdePkg. `odeprint' prints the + actual time values and results in the Octave window while solving, + `odeplot' plots the results over time in a new figure window while + solving, `odephas2' plots the first result over the second result + as a two-dimensional plot while solving and `odephas3' plots the + first result over the second result over the third result as a + three-dimensional plot while solving. Run the following example to + illustrate the effect if this option is used + function yd = fvanderpol (vt, vy, varargin) + mu = 1; ## Set mu > 10 for higher stiffness + yd = [vy(2); mu * (1 - vy(1)^2) * vy(2) - vy(1)]; + endfunction + + A = odeset ("OutputFcn", @odeprint); + ode78 (@fvanderpol, [0 2], [2 0], A); + User defined output functions can also be used. A typical + framework for a self-made output function may then be of the form + function [vret] = odeoutput (vt, vy, vdeci, varargin) + switch vdeci + case "init" + ## Do everything needed to intialize output function + case "calc" + ## Do everything needed to create output + case "done" + ## Do everything needed to clean up output function + endswitch + endfunction + The output function `odeplot' is also set automatically if the + solver calculation routine is called without any output argument. + Run the following example to illustrate the effect if this option + is not used and no output argument is given + ## An anonymous implementation of the Van der Pol equation + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + ode78 (fvdb, [0 20], [2 0]); + +`Refine' + The option `Refine' is used to set the interpolation factor that + is used to increase the quality for the output values if an output + function is also set with the option `OutputFcn'. It can only be a + integer value 0<=`Refine'<=5. Run the following example to + illustrate the effect if this option is used + function yd = fvanderpol (vt, vy, varargin) + mu = 1; ## Set mu > 10 for higher stiffness + yd = [vy(2); mu * (1 - vy(1)^2) * vy(2) - vy(1)]; + endfunction + + A = odeset ("Refine", 0, "OutputFcn", @odeplot); + ode78 (@fvanderpol, [0 20], [2 0], A); + B = odeset (A, "Refine", 3); + ode78 (@fvanderpol, [0 20], [2 0], B); + +`OutputSel' + The option `OutputSel' is used to set the components for which + output has to be performed if an output function is also set with + the option `OutputFcn'. It can only be a vector of integer values. + Run the following example to illustrate the effect if this option + is used + function yd = fvanderpol (vt, vy, varargin) + mu = 1; ## Set mu > 10 for higher stiffness + yd = [vy(2); mu * (1 - vy(1)^2) * vy(2) - vy(1)]; + endfunction + + A = odeset ("OutputSel", [1, 2], "OutputFcn", @odeplot); + ode78 (@fvanderpol, [0 20], [2 0], A); + B = odeset (A, "OutputSel", [2]); + ode78 (@fvanderpol, [0 20], [2 0], B); + +`Stats' + The option `Stats' is used to print cost statistics about the + solving process after solving has been finished. It can either be + the string `"on"' or `"off"'. Run the following example to + illustrate the effect if this option is used + function yd = fvanderpol (vt, vy, varargin) + mu = 1; ## Set mu > 10 for higher stiffness + yd = [vy(2); mu * (1 - vy(1)^2) * vy(2) - vy(1)]; + endfunction + + A = odeset ("Stats", "off"); + [a, b] = ode78 (@fvanderpol, [0 2], [2 0], A); + B = odeset ("Stats", "on"); + [c, d] = ode78 (@fvanderpol, [0 2], [2 0], B); + The cost statistics can also be obtained if the solver calculation + routine is called with one output argument. The cost statistics + then are in the field `stats' of the output arguemnt structure. + Run the following example to illustrate the effect if this option + is used + S = ode78 (@fvanderpol, [0 2], [2 0], B); + disp (S); + +`Jacobian' + The option `Jacobian' can be used to set up an external Jacobian + function or Jacobian matrix for DAE solvers to achieve faster and + better results (ODE Runge-Kutta solvers do not need to handle a + Jacobian function handle or Jacobian matrix). It must either be a + function handle to a valid function or a full constant matrix of + size squared the dimension of the set of differential equations. + User defined Jacobian functions must have the form `function + [vjac] = fjac (vt, vy, varargin)'. Run the following example to + illustrate the effect if this option is used + function vdy = fpol (vt, vy, varargin) + vdy = [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + endfunction + + function vr = fjac (vt, vy, varargin) + vr = [0, 1; ... + -1-2*vy(1)*vy(2), 1-vy(1)^2]; + endfunction + + A = odeset ("Stats", "on"); + B = ode5r (@fpol, [0 20], [2 0], A); + C = odeset (A, "Jacobian", @fjac); + D = ode5r (@fpol, [0 20], [2 0], C); + Note: The function definition for Jacobian calculations of IDE + equations must have the form `function [vjac, vdjc] = fjac (vt, + vy, vyd, varargin)'. Run the following example to illustrate the + effect if this option is used + function [vres] = fvanderpol (vt, vy, vyd, varargin) + vres = [vy(2) - vyd(1); + (1 - vy(1)^2) * vy(2) - vy(1) - vyd(2)]; + endfunction + + function [vjac, vdjc] = fjacobian (vt, vy, vyd, varargin) + vjac = [0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]; + vdjc = [-1, 0; 0, -1]; + endfunction + + vopt = odeset ("Jacobian", @fjacobian, "Stats", "on"); + vsol = odebdi (@fvanderpol, [0, 20], [2; 0], [0; -2], vopt, 10); + +`JPattern' + The option `JPattern' is not handled by any of the solvers by now. +`Vectorized' + The option `Vectorized' is not handled by any of the solvers by + now. +`Mass' + The option `Mass' can be used to set up an external Mass function + or Mass matrix for solving DAE equations. It depends on the solver + that is used if `Mass' is supported or not. It must either be a + function handle to a valid function or a full constant matrix of + size squared the dimension of the set of differential equations. + User defined Jacobian functions must have the form `function vmas + = fmas (vt, vy, varargin)'. Run the following example to + illustrate the effect if this option is used + function vdy = frob (t, y, varargin) + vdy(1,1) = -0.04*y(1)+1e4*y(2)*y(3); + vdy(2,1) = 0.04*y(1)-1e4*y(2)*y(3)-3e7*y(2)^2; + vdy(3,1) = y(1)+y(2)+y(3)-1; + endfunction + + function vmas = fmas (vt, vy, varargin) + vmas = [1, 0, 0; 0, 1, 0; 0, 0, 0]; + endfunction + + A = odeset ("Mass", @fmas); + B = ode5r (@frob, [0 1e8], [1 0 0], A); + Note: The function definition for Mass calculations of DDE + equations must have the form `function vmas = fmas (vt, vy, vz, + varargin)'. +`MStateDependence' + The option `MStateDependence' can be used to set up the type of + the external Mass function for solving DAE equations if a Mass + function handle is set with the option `Mass'. It depends on the + solver that is used if `MStateDependence' is supported or not. It + must be a string of the form `"none"', `"weak"' or `"strong"'. Run + the following example to illustrate the effect if this option is + used + function vdy = frob (vt, vy, varargin) + vdy(1,1) = -0.04*vy(1)+1e4*vy(2)*vy(3); + vdy(2,1) = 0.04*vy(1)-1e4*vy(2)*vy(3)-3e7*vy(2)^2; + vdy(3,1) = vy(1)+vy(2)+vy(3)-1; + endfunction + + function vmas = fmas (vt, varargin) + vmas = [1, 0, 0; 0, 1, 0; 0, 0, 0]; + endfunction + + A = odeset ("Mass", @fmas, "MStateDependence", "none"); + B = ode5r (@frob, [0 1e8], [1 0 0], A); + User defined Mass functions must have the form as described before + (ie. `function vmas = fmas (vt, varargin)' if the option + `MStateDependence' was set to `"none"', otherwise the user defined + Mass function must have the form `function vmas = fmas (vt, vy, + varargin)' if the option `MStateDependence' was set to either + `"weak"' or `"strong"'. +`MvPattern' + The option `MvPattern' is not handled by any of the solvers by now. +`MassSingular' + The option `MassSingular' is not handled by any of the solvers by + now. +`NonNegative' + The option `NonNegative' can be used to set solution variables to + zero even if their real solution would be a negative value. It + must be a vector describing the positions in the solution vector + for which the option `NonNegative' should be used. Run the + following example to illustrate the effect if this option is used + vfun = @(vt,vy) -abs(vy); + vopt = odeset ("NonNegative", [1]); + + [vt1, vy1] = ode78 (vfun, [0 100], [1]); + [vt2, vy2] = ode78 (vfun, [0 100], [1], vopt); + + subplot (2,1,1); plot (vt1, vy1); + subplot (2,1,2); plot (vt2, vy2); + +`Events' + The option `Events' can be used to set up an Event function, ie. + the Event function can be used to find zero crossings in one of + the results. It must either be a function handle to a valid + function. Run the following example to illustrate the effect if + this option is used + function vdy = fbal (vt, vy, varargin) + vdy(1,1) = vy(2); + vdy(2,1) = -9.81; ## m/s² + endfunction + + function [veve, vterm, vdir] = feve (vt, vy, varargin) + veve = vy(1); ## Which event component should be tread + vterm = 1; ## Terminate if an event is found + vdir = -1; ## In which direction, -1 for falling + endfunction + + A = odeset ("Events", @feve); + B = ode78 (@fbal, [0 1.5], [1 3], A); + plot (B.x, B.y(:,1)); + Note: The function definition for Events calculations of DDE + equations must have the form `function [veve, vterm, vdir] = feve + (vt, vy, vz, varargin)' and the function definition for Events + calculations of IDE equations must have the form `function [veve, + vterm, vdir] = feve (vt, vy, vyd, varargin)'. +`MaxOrder' + The option `MaxOrder' can be used to set the maximum order of the + backward differentiation algorithm of the `odebdi' and `odebda' + solvers. It must be a scalar integer value between 1 and 7. Run + the following example to illustrate the effect if this option is + used + function res = fwei (t, y, yp, varargin) + res = t*y^2*yp^3 - y^3*yp^2 + t*yp*(t^2 + 1) - t^2*y; + endfunction + + function [dy, dyp] = fjac (t, y, yp, varargin) + dy = 2*t*y*yp^3 - 3*y^2*yp^2 - t^2; + dyp = 3*t*y^2*yp^2 - 2*y^3*yp + t*(t^2 + 1); + endfunction + + A = odeset ("AbsTol", 1e-6, "RelTol", 1e-6, "Jacobian", @fjac, ... + "Stats", "on", "MaxOrder", 1, "BDF", "on") + B = odeset (A, "MaxOrder", 5) + C = odebdi (@fwei, [1 10], 1.2257, 0.8165, A); + D = odebdi (@fwei, [1 10], 1.2257, 0.8165, B); + plot (C.x, C.y, "bo-", D.x, D.y, "rx:"); + +`BDF' + The option `BDF' is only supported by the `odebdi' and `odebda' + solvers. Using these solvers the option `BDF' will automatically + be set `"on"' (even if it was set `"off"' before) because the + `odebdi' and `odebda' solvers all use the backward differentiation + algorithm to solve the different kind of equations. + +`NewtonTol' + TODO + +`MaxNewtonIterations' + TODO + + +File: odepkg.info, Node: M-File Function Reference, Next: Oct-File Function Reference, Prev: ODE/DAE/IDE/DDE options, Up: Users Guide + +2.4 M-File Function Reference +============================= + +The help texts of this section are autogenerated and refer to commands +that all can be found in the files `*.m'. All commands that are listed +below are loaded automatically everytime you launch Octave. + -- Function File: [] = ode23 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, + ...]) + -- Command: [SOL] = ode23 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode23 (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff + ordinary differential equations (non-stiff ODEs) or non-stiff + differential algebraic equations (non-stiff DAEs) with the well + known explicit Runge-Kutta method of order (2,3). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, solve an anonymous implementation of the Van der Pol + equation + + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ + "NormControl", "on", "OutputFcn", @odeplot); + ode23 (fvdb, [0 20], [2 0], vopt); + + -- Function File: [] = ode23d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [SOL] = ode23d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode23d (@FUN, SLOT, INIT, LAGS, + HIST, [OPT], [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff delay + differential equations (non-stiff DDEs) with a modified version of + the well known explicit Runge-Kutta method of order (2,3). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + DDEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, LAGS is a double vector that + describes the lags of time, HIST is a double matrix and describes + the history of the DDEs, OPT can optionally be a structure array + that keeps the options created with the command `odeset' and PAR1, + PAR2, ... can optionally be other input arguments of any type that + have to be passed to the function defined by @FUN. + + In other words, this function will solve a problem of the form + dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), ...))) + y(slot(1)) = init + y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), ... + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + DDEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example: + - the following code solves an anonymous implementation of a + chaotic behavior + + fcao = @(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy]; + + vopt = odeset ("NormControl", "on", "RelTol", 1e-3); + vsol = ode23d (fcao, [0, 100], 0.5, 2, 0.5, vopt); + + vlag = interp1 (vsol.x, vsol.y, vsol.x - 2); + plot (vsol.y, vlag); legend ("fcao (t,y,z)"); + + - to solve the following problem with two delayed state + variables + + d y1(t)/dt = -y1(t) + d y2(t)/dt = -y2(t) + y1(t-5) + d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10) + + one might do the following + + function f = fun (t, y, yd) + f(1) = -y(1); %% y1' = -y1(t) + f(2) = -y(2) + yd(1,1); %% y2' = -y2(t) + y1(t-lags(1)) + f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2)) + endfunction + T = [0,20] + res = ode23d (@fun, T, [1;1;1], [5, 10], ones (3,2)); + + + -- Function File: [] = ode45 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, + ...]) + -- Command: [SOL] = ode45 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode45 (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff + ordinary differential equations (non-stiff ODEs) or non-stiff + differential algebraic equations (non-stiff DAEs) with the well + known explicit Runge-Kutta method of order (4,5). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, solve an anonymous implementation of the Van der Pol + equation + + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ + "NormControl", "on", "OutputFcn", @odeplot); + ode45 (fvdb, [0 20], [2 0], vopt); + + -- Function File: [] = ode45d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [SOL] = ode45d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode45d (@FUN, SLOT, INIT, LAGS, + HIST, [OPT], [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff delay + differential equations (non-stiff DDEs) with a modified version of + the well known explicit Runge-Kutta method of order (4,5). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + DDEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, LAGS is a double vector that + describes the lags of time, HIST is a double matrix and describes + the history of the DDEs, OPT can optionally be a structure array + that keeps the options created with the command `odeset' and PAR1, + PAR2, ... can optionally be other input arguments of any type that + have to be passed to the function defined by @FUN. + + In other words, this function will solve a problem of the form + dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), ...))) + y(slot(1)) = init + y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), ... + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + DDEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example: + - the following code solves an anonymous implementation of a + chaotic behavior + + fcao = @(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy]; + + vopt = odeset ("NormControl", "on", "RelTol", 1e-3); + vsol = ode45d (fcao, [0, 100], 0.5, 2, 0.5, vopt); + + vlag = interp1 (vsol.x, vsol.y, vsol.x - 2); + plot (vsol.y, vlag); legend ("fcao (t,y,z)"); + + - to solve the following problem with two delayed state + variables + + d y1(t)/dt = -y1(t) + d y2(t)/dt = -y2(t) + y1(t-5) + d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10) + + one might do the following + + function f = fun (t, y, yd) + f(1) = -y(1); %% y1' = -y1(t) + f(2) = -y(2) + yd(1,1); %% y2' = -y2(t) + y1(t-lags(1)) + f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2)) + endfunction + T = [0,20] + res = ode45d (@fun, T, [1;1;1], [5, 10], ones (3,2)); + + + -- Function File: [] = ode54 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, + ...]) + -- Command: [SOL] = ode54 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode54 (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff + ordinary differential equations (non-stiff ODEs) or non-stiff + differential algebraic equations (non-stiff DAEs) with the well + known explicit Runge-Kutta method of order (5,4). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, solve an anonymous implementation of the Van der Pol + equation + + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ + "NormControl", "on", "OutputFcn", @odeplot); + ode54 (fvdb, [0 20], [2 0], vopt); + + -- Function File: [] = ode54d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [SOL] = ode54d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode54d (@FUN, SLOT, INIT, LAGS, + HIST, [OPT], [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff delay + differential equations (non-stiff DDEs) with a modified version of + the well known explicit Runge-Kutta method of order (2,3). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + DDEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, LAGS is a double vector that + describes the lags of time, HIST is a double matrix and describes + the history of the DDEs, OPT can optionally be a structure array + that keeps the options created with the command `odeset' and PAR1, + PAR2, ... can optionally be other input arguments of any type that + have to be passed to the function defined by @FUN. + + In other words, this function will solve a problem of the form + dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), ...))) + y(slot(1)) = init + y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), ... + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + DDEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example: + - the following code solves an anonymous implementation of a + chaotic behavior + + fcao = @(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy]; + + vopt = odeset ("NormControl", "on", "RelTol", 1e-3); + vsol = ode54d (fcao, [0, 100], 0.5, 2, 0.5, vopt); + + vlag = interp1 (vsol.x, vsol.y, vsol.x - 2); + plot (vsol.y, vlag); legend ("fcao (t,y,z)"); + + - to solve the following problem with two delayed state + variables + + d y1(t)/dt = -y1(t) + d y2(t)/dt = -y2(t) + y1(t-5) + d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10) + + one might do the following + + function f = fun (t, y, yd) + f(1) = -y(1); %% y1' = -y1(t) + f(2) = -y(2) + yd(1,1); %% y2' = -y2(t) + y1(t-lags(1)) + f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2)) + endfunction + T = [0,20] + res = ode54d (@fun, T, [1;1;1], [5, 10], ones (3,2)); + + + -- Function File: [] = ode78 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, + ...]) + -- Command: [SOL] = ode78 (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode78 (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff + ordinary differential equations (non-stiff ODEs) or non-stiff + differential algebraic equations (non-stiff DAEs) with the well + known explicit Runge-Kutta method of order (7,8). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, solve an anonymous implementation of the Van der Pol + equation + + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ + "NormControl", "on", "OutputFcn", @odeplot); + ode78 (fvdb, [0 20], [2 0], vopt); + + -- Function File: [] = ode78d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [SOL] = ode78d (@FUN, SLOT, INIT, LAGS, HIST, [OPT], + [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode78d (@FUN, SLOT, INIT, LAGS, + HIST, [OPT], [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff delay + differential equations (non-stiff DDEs) with a modified version of + the well known explicit Runge-Kutta method of order (7,8). + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + DDEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, LAGS is a double vector that + describes the lags of time, HIST is a double matrix and describes + the history of the DDEs, OPT can optionally be a structure array + that keeps the options created with the command `odeset' and PAR1, + PAR2, ... can optionally be other input arguments of any type that + have to be passed to the function defined by @FUN. + + In other words, this function will solve a problem of the form + dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), ...))) + y(slot(1)) = init + y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), ... + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + DDEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example: + - the following code solves an anonymous implementation of a + chaotic behavior + + fcao = @(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy]; + + vopt = odeset ("NormControl", "on", "RelTol", 1e-3); + vsol = ode78d (fcao, [0, 100], 0.5, 2, 0.5, vopt); + + vlag = interp1 (vsol.x, vsol.y, vsol.x - 2); + plot (vsol.y, vlag); legend ("fcao (t,y,z)"); + + - to solve the following problem with two delayed state + variables + + d y1(t)/dt = -y1(t) + d y2(t)/dt = -y2(t) + y1(t-5) + d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10) + + one might do the following + + function f = fun (t, y, yd) + f(1) = -y(1); %% y1' = -y1(t) + f(2) = -y(2) + yd(1,1); %% y2' = -y2(t) + y1(t-lags(1)) + f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2)) + endfunction + T = [0,20] + res = ode78d (@fun, T, [1;1;1], [5, 10], ones (3,2)); + + + -- Function File: [] = odebwe (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, + ...]) + -- Command: [SOL] = odebwe (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = odebwe (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of stiff ordinary + differential equations (stiff ODEs) or stiff differential + algebraic equations (stiff DAEs) with the Backward Euler method. + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, solve an anonymous implementation of the Van der Pol + equation + + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + vjac = @(vt,vy) [0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]; + vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ + "NormControl", "on", "OutputFcn", @odeplot, \ + "Jacobian",vjac); + odebwe (fvdb, [0 20], [2 0], vopt); + + -- Function File: [] = odeexamples () + Open the differential equations examples menu and allow the user + to select a submenu of ODE, DAE, IDE or DDE examples. + + -- Function File: [VALUE] = odeget (ODESTRUCT, OPTION, [DEFAULT]) + -- Command: [VALUES] = odeget (ODESTRUCT, {OPT1, OPT2, ...}, [{DEF1, + DEF2, ...}]) + If this function is called with two input arguments and the first + input argument ODESTRUCT is of type structure array and the second + input argument OPTION is of type string then return the option + value VALUE that is specified by the option name OPTION in the + OdePkg option structure ODESTRUCT. Optionally if this function is + called with a third input argument then return the default value + DEFAULT if OPTION is not set in the structure ODESTRUCT. + + If this function is called with two input arguments and the first + input argument ODESTRUCT is of type structure array and the second + input argument OPTION is of type cell array of strings then return + the option values VALUES that are specified by the option names + OPT1, OPT2, ... in the OdePkg option structure ODESTRUCT. + Optionally if this function is called with a third input argument + of type cell array then return the default value DEF1 if OPT1 is + not set in the structure ODESTRUCT, DEF2 if OPT2 is not set in the + structure ODESTRUCT, ... + + Run examples with the command + demo odeget + + -- Function File: [RET] = odephas2 (T, Y, FLAG) + Open a new figure window and plot the first result from the + variable Y that is of type double column vector over the second + result from the variable Y while solving. The types and the values + of the input parameter T and the output parameter RET depend on + the input value FLAG that is of type string. If FLAG is + ``"init"'' + then T must be a double column vector of length 2 with the + first and the last time step and nothing is returned from + this function, + + ``""'' + then T must be a double scalar specifying the actual time + step and the return value is false (resp. value 0) for 'not + stop solving', + + ``"done"'' + then T must be a double scalar specifying the last time step + and nothing is returned from this function. + + This function is called by a OdePkg solver function if it was + specified in an OdePkg options structure with the `odeset'. This + function is an OdePkg internal helper function therefore it should + never be necessary that this function is called directly by a + user. There is only little error detection implemented in this + function file to achieve the highest performance. + + For example, solve an anonymous implementation of the "Van der + Pol" equation and display the results while solving in a 2D plane + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ('OutputFcn', @odephas2, 'RelTol', 1e-6); + vsol = ode45 (fvdb, [0 20], [2 0], vopt); + + -- Function File: [RET] = odephas3 (T, Y, FLAG) + Open a new figure window and plot the first result from the + variable Y that is of type double column vector over the second + and the third result from the variable Y while solving. The types + and the values of the input parameter T and the output parameter + RET depend on the input value FLAG that is of type string. If FLAG + is + ``"init"'' + then T must be a double column vector of length 2 with the + first and the last time step and nothing is returned from + this function, + + ``""'' + then T must be a double scalar specifying the actual time + step and the return value is false (resp. value 0) for 'not + stop solving', + + ``"done"'' + then T must be a double scalar specifying the last time step + and nothing is returned from this function. + + This function is called by a OdePkg solver function if it was + specified in an OdePkg options structure with the `odeset'. This + function is an OdePkg internal helper function therefore it should + never be necessary that this function is called directly by a + user. There is only little error detection implemented in this + function file to achieve the highest performance. + + For example, solve the "Lorenz attractor" and display the results + while solving in a 3D plane + function vyd = florenz (vt, vx) + vyd = [10 * (vx(2) - vx(1)); + vx(1) * (28 - vx(3)); + vx(1) * vx(2) - 8/3 * vx(3)]; + endfunction + + vopt = odeset ('OutputFcn', @odephas3); + vsol = ode23 (@florenz, [0:0.01:7.5], [3 15 1], vopt); + + -- Function File: [] = odepkg () + OdePkg is part of the GNU Octave Repository (the Octave-Forge + project). The package includes commands for setting up various + options, output functions etc. before solving a set of + differential equations with the solver functions that are also + included. At this time OdePkg is under development with the main + target to make a package that is mostly compatible to proprietary + solver products. + + If this function is called without any input argument then open + the OdePkg tutorial in the Octave window. The tutorial can also be + opened with the following command + + doc odepkg + + -- Function File: [SOL] = odepkg_event_handle (@FUN, TIME, Y, FLAG, + [PAR1, PAR2, ...]) + Return the solution of the event function that is specified as the + first input argument @FUN in form of a function handle. The second + input argument TIME is of type double scalar and specifies the + time of the event evaluation, the third input argument Y either is + of type double column vector (for ODEs and DAEs) and specifies the + solutions or is of type cell array (for IDEs and DDEs) and + specifies the derivatives or the history values, the third input + argument FLAG is of type string and can be of the form + ``"init"'' + then initialize internal persistent variables of the function + `odepkg_event_handle' and return an empty cell array of size + 4, + + ``"calc"'' + then do the evaluation of the event function and return the + solution SOL as type cell array of size 4, + + ``"done"'' + then cleanup internal variables of the function + `odepkg_event_handle' and return an empty cell array of size + 4. + Optionally if further input arguments PAR1, PAR2, ... of any type + are given then pass these parameters through `odepkg_event_handle' + to the event function. + + This function is an OdePkg internal helper function therefore it + should never be necessary that this function is called directly by + a user. There is only little error detection implemented in this + function file to achieve the highest performance. + + -- Function File: [] = odepkg_examples_dae () + Open the DAE examples menu and allow the user to select a demo + that will be evaluated. + + -- Function File: [] = odepkg_examples_dde () + Open the DDE examples menu and allow the user to select a demo + that will be evaluated. + + -- Function File: [] = odepkg_examples_ide () + Open the IDE examples menu and allow the user to select a demo + that will be evaluated. + + -- Function File: [] = odepkg_examples_ode () + Open the ODE examples menu and allow the user to select a demo + that will be evaluated. + + -- Function File: [NEWSTRUCT] = odepkg_structure_check (OLDSTRUCT, + ["SOLVER"]) + If this function is called with one input argument of type + structure array then check the field names and the field values of + the OdePkg structure OLDSTRUCT and return the structure as + NEWSTRUCT if no error is found. Optionally if this function is + called with a second input argument "SOLVER" of type string taht + specifies the name of a valid OdePkg solver then a higher level + error detection is performed. The function does not modify any of + the field names or field values but terminates with an error if an + invalid option or value is found. + + This function is an OdePkg internal helper function therefore it + should never be necessary that this function is called directly by + a user. There is only little error detection implemented in this + function file to achieve the highest performance. + + Run examples with the command + demo odepkg_structure_check + + -- Function File: [MESCD] = odepkg_testsuite_calcmescd (SOLUTION, + REFERENCE, ABSTOL, RELTOL) + If this function is called with four input arguments of type + double scalar or column vector then return a normalized value for + the minimum number of correct digits MESCD that is calculated from + the solution at the end of an integration interval SOLUTION and a + set of reference values REFERENCE. The input arguments ABSTOL and + RELTOL are used to calculate a reference solution that depends on + the relative and absolute error tolerances. + + Run examples with the command + demo odepkg_testsuite_calcmescd + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + -- Function File: [SCD] = odepkg_testsuite_calcscd (SOLUTION, + REFERENCE, ABSTOL, RELTOL) + If this function is called with four input arguments of type + double scalar or column vector then return a normalized value for + the minimum number of correct digits SCD that is calculated from + the solution at the end of an integration interval SOLUTION and a + set of reference values REFERENCE. The input arguments ABSTOL and + RELTOL are unused but present because of compatibility to the + function `odepkg_testsuite_calcmescd'. + + Run examples with the command + demo odepkg_testsuite_calcscd + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + -- Function File: [SOLUTION] = odepkg_testsuite_chemakzo (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return a cell array + SOLUTION with performance informations about the chemical AKZO + Nobel testsuite of differential algebraic equations after solving + (DAE-test). + + Run examples with the command + demo odepkg_testsuite_chemakzo + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + -- Function File: [SOLUTION] = odepkg_testsuite_hires (@SOLVER, RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return a cell array + SOLUTION with performance informations about the HIRES testsuite + of ordinary differential equations after solving (ODE-test). + + Run examples with the command + demo odepkg_testsuite_hires + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + -- Function File: [SOLUTION] = odepkg_testsuite_implakzo (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return a cell array + SOLUTION with performance informations about the chemical AKZO + Nobel testsuite of implicit differential algebraic equations after + solving (IDE-test). + + Run examples with the command + demo odepkg_testsuite_implakzo + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + -- Function File: [SOLUTION] = odepkg_testsuite_implrober (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return a cell array + SOLUTION with performance informations about the implicit form of + the modified ROBERTSON testsuite of implicit differential + algebraic equations after solving (IDE-test). + + Run examples with the command + demo odepkg_testsuite_implrober + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + -- Function File: [SOLUTION] = odepkg_testsuite_oregonator (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return a cell array + SOLUTION with performance informations about the OREGONATOR + testsuite of ordinary differential equations after solving + (ODE-test). + + Run examples with the command + demo odepkg_testsuite_oregonator + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + -- Function File: [SOLUTION] = odepkg_testsuite_pollution (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return the cell array + SOLUTION with performance informations about the POLLUTION + testsuite of ordinary differential equations after solving + (ODE-test). + + Run examples with the command + demo odepkg_testsuite_pollution + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + -- Function File: [SOLUTION] = odepkg_testsuite_robertson (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return a cell array + SOLUTION with performance informations about the modified + ROBERTSON testsuite of differential algebraic equations after + solving (DAE-test). + + Run examples with the command + demo odepkg_testsuite_robertson + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + -- Function File: [SOLUTION] = odepkg_testsuite_transistor (@SOLVER, + RELTOL) + If this function is called with two input arguments and the first + input argument @SOLVER is a function handle describing an OdePkg + solver and the second input argument RELTOL is a double scalar + describing the relative error tolerance then return the cell array + SOLUTION with performance informations about the TRANSISTOR + testsuite of differential algebraic equations after solving + (DAE-test). + + Run examples with the command + demo odepkg_testsuite_transistor + + This function has been ported from the "Test Set for IVP solvers" + which is developed by the INdAM Bari unit project group "Codes and + Test Problems for Differential Equations", coordinator F. Mazzia. + + -- Function File: [RET] = odeplot (T, Y, FLAG) + Open a new figure window and plot the results from the variable Y + of type column vector over time while solving. The types and the + values of the input parameter T and the output parameter RET + depend on the input value FLAG that is of type string. If FLAG is + ``"init"'' + then T must be a double column vector of length 2 with the + first and the last time step and nothing is returned from + this function, + + ``""'' + then T must be a double scalar specifying the actual time + step and the return value is false (resp. value 0) for 'not + stop solving', + + ``"done"'' + then T must be a double scalar specifying the last time step + and nothing is returned from this function. + + This function is called by a OdePkg solver function if it was + specified in an OdePkg options structure with the `odeset'. This + function is an OdePkg internal helper function therefore it should + never be necessary that this function is called directly by a + user. There is only little error detection implemented in this + function file to achieve the highest performance. + + For example, solve an anonymous implementation of the "Van der + Pol" equation and display the results while solving + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ('OutputFcn', @odeplot, 'RelTol', 1e-6); + vsol = ode45 (fvdb, [0 20], [2 0], vopt); + + -- Function File: [RET] = odeprint (T, Y, FLAG) + Display the results of the set of differential equations in the + Octave window while solving. The first column of the screen output + shows the actual time stamp that is given with the input arguemtn + T, the following columns show the results from the function + evaluation that are given by the column vector Y. The types and + the values of the input parameter T and the output parameter RET + depend on the input value FLAG that is of type string. If FLAG is + ``"init"'' + then T must be a double column vector of length 2 with the + first and the last time step and nothing is returned from + this function, + + ``""'' + then T must be a double scalar specifying the actual time + step and the return value is false (resp. value 0) for 'not + stop solving', + + ``"done"'' + then T must be a double scalar specifying the last time step + and nothing is returned from this function. + + This function is called by a OdePkg solver function if it was + specified in an OdePkg options structure with the `odeset'. This + function is an OdePkg internal helper function therefore it should + never be necessary that this function is called directly by a + user. There is only little error detection implemented in this + function file to achieve the highest performance. + + For example, solve an anonymous implementation of the "Van der + Pol" equation and print the results while solving + fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; + + vopt = odeset ('OutputFcn', @odeprint, 'RelTol', 1e-6); + vsol = ode45 (fvdb, [0 20], [2 0], vopt); + + -- Function File: [ODESTRUCT] = odeset () + -- Command: [ODESTRUCT] = odeset ("FIELD1", VALUE1, "FIELD2", VALUE2, + ...) + -- Command: [ODESTRUCT] = odeset (OLDSTRUCT, "FIELD1", VALUE1, + "FIELD2", VALUE2, ...) + -- Command: [ODESTRUCT] = odeset (OLDSTRUCT, NEWSTRUCT) + If this function is called without an input argument then return a + new OdePkg options structure array that contains all the necessary + fields and sets the values of all fields to default values. + + If this function is called with string input arguments "FIELD1", + "FIELD2", ... identifying valid OdePkg options then return a new + OdePkg options structure with all necessary fields and set the + values of the fields "FIELD1", "FIELD2", ... to the values VALUE1, + VALUE2, ... + + If this function is called with a first input argument OLDSTRUCT + of type structure array then overwrite all values of the options + "FIELD1", "FIELD2", ... of the structure OLDSTRUCT with new values + VALUE1, VALUE2, ... and return the modified structure array. + + If this function is called with two input argumnets OLDSTRUCT and + NEWSTRUCT of type structure array then overwrite all values in the + fields from the structure OLDSTRUCT with new values of the fields + from the structure NEWSTRUCT. Empty values of NEWSTRUCT will not + overwrite values in OLDSTRUCT. + + For a detailed explanation about valid fields and field values in + an OdePkg structure aaray have a look at the `odepkg.pdf', Section + 'ODE/DAE/IDE/DDE options' or run the command `doc odepkg' to open + the tutorial. + + Run examples with the command + demo odeset + + +File: odepkg.info, Node: Oct-File Function Reference, Prev: M-File Function Reference, Up: Users Guide + +2.5 Oct-File Function Reference +=============================== + +The help texts of this section are autogenerated and refer to commands +that all can be found in the file `dldsolver.oct'. The file +`dldsolver.oct' is generated automatically if you install OdePkg with +the command `pkg'. All commands that are listed below are loaded +automatically everytime you launch Octave. + -- Command: [] = odebda (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [SOL] = odebda (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = odebda (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff or + stiff ordinary differential equations (ODEs) and non-stiff or + stiff differential algebraic equations (DAEs). This function file + is a wrapper file that uses Jeff Cash's Fortran solver + `mebdfdae.f'. + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, + function y = odepkg_equations_lorenz (t, x) + y = [10 * (x(2) - x(1)); + x(1) * (28 - x(3)); + x(1) * x(2) - 8/3 * x(3)]; + endfunction + + vopt = odeset ("InitialStep", 1e-3, "MaxStep", 1e-1, \\ + "OutputFcn", @odephas3, "Refine", 5); + odebda (@odepkg_equations_lorenz, [0, 25], [3 15 1], vopt); + + -- Command: [] = odebdi (@FUN, SLOT, Y0, DY0, [OPT], [P1, P2, ...]) + -- Command: [SOL] = odebdi (@FUN, SLOT, Y0, DY0, [OPT], [P1, P2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = odebdi (@FUN, SLOT, Y0, DY0, [OPT], + [P1, P2, ...]) + This function file can be used to solve a set of non-stiff and + stiff implicit differential equations (IDEs). This function file + is a wrapper file that uses Jeff Cash's Fortran solver `mebdfi.f'. + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + IDEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, Y0 is a double vector that defines the + initial values of the states, DY0 is a double vector that defines + the initial values of the derivatives, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + IDEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, + function res = odepkg_equations_ilorenz (t, y, yd) + res = [10 * (y(2) - y(1)) - yd(1); + y(1) * (28 - y(3)) - yd(2); + y(1) * y(2) - 8/3 * y(3) - yd(3)]; + endfunction + + vopt = odeset ("InitialStep", 1e-3, "MaxStep", 1e-1, \\ + "OutputFcn", @odephas3, "Refine", 5); + odebdi (@odepkg_equations_ilorenz, [0, 25], [3 15 1], \\ + [120 81 42.333333], vopt); + + -- Command: [] = odekdi (@FUN, SLOT, Y0, DY0, [OPT], [P1, P2, ...]) + -- Command: [SOL] = odekdi (@FUN, SLOT, Y0, DY0, [OPT], [P1, P2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = odekdi (@FUN, SLOT, Y0, DY0, [OPT], + [P1, P2, ...]) + This function file can be used to solve a set of non-stiff or + stiff implicit differential equations (IDEs). This function file + is a wrapper file that uses the direct method (not the Krylov + method) of Petzold's, Brown's, Hindmarsh's and Ulrich's Fortran + solver `ddaskr.f'. + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + IDEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, Y0 is a double vector that defines the + initial values of the states, DY0 is a double vector that defines + the initial values of the derivatives, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + IDEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, + function res = odepkg_equations_ilorenz (t, y, yd) + res = [10 * (y(2) - y(1)) - yd(1); + y(1) * (28 - y(3)) - yd(2); + y(1) * y(2) - 8/3 * y(3) - yd(3)]; + endfunction + + vopt = odeset ("InitialStep", 1e-3, "MaxStep", 1e-1, \\ + "OutputFcn", @odephas3, "Refine", 5); + odekdi (@odepkg_equations_ilorenz, [0, 25], [3 15 1], \\ + [120 81 42.333333], vopt); + + -- Command: [] = ode2r (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [SOL] = ode2r (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode2r (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff or + stiff ordinary differential equations (ODEs) and non-stiff or + stiff differential algebraic equations (DAEs). This function file + is a wrapper to Hairer's and Wanner's Fortran solver `radau.f'. + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, + function y = odepkg_equations_lorenz (t, x) + y = [10 * (x(2) - x(1)); + x(1) * (28 - x(3)); + x(1) * x(2) - 8/3 * x(3)]; + endfunction + + vopt = odeset ("InitialStep", 1e-3, "MaxStep", 1e-1, \\ + "OutputFcn", @odephas3, "Refine", 5); + ode2r (@odepkg_equations_lorenz, [0, 25], [3 15 1], vopt); + + -- Command: [] = ode5r (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [SOL] = ode5r (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = ode5r (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff or + stiff ordinary differential equations (ODEs) and non-stiff or + stiff differential algebraic equations (DAEs). This function file + is a wrapper to Hairer's and Wanner's Fortran solver `radau5.f'. + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, + function y = odepkg_equations_lorenz (t, x) + y = [10 * (x(2) - x(1)); + x(1) * (28 - x(3)); + x(1) * x(2) - 8/3 * x(3)]; + endfunction + + vopt = odeset ("InitialStep", 1e-3, "MaxStep", 1e-1, \\ + "OutputFcn", @odephas3, "Refine", 5); + ode5r (@odepkg_equations_lorenz, [0, 25], [3 15 1], vopt); + + -- Function File: [] = oders (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, + ...]) + -- Command: [SOL] = oders (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = oders (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of non-stiff or + stiff ordinary differential equations (ODEs) and non-stiff or + stiff differential algebraic equations (DAEs). This function file + is a wrapper to Hairer's and Wanner's Fortran solver `rodas.f'. + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, + function y = odepkg_equations_lorenz (t, x) + y = [10 * (x(2) - x(1)); + x(1) * (28 - x(3)); + x(1) * x(2) - 8/3 * x(3)]; + endfunction + + vopt = odeset ("InitialStep", 1e-3, "MaxStep", 1e-1, \\ + "OutputFcn", @odephas3, "Refine", 5); + oders (@odepkg_equations_lorenz, [0, 25], [3 15 1], vopt); + + -- Command: [] = odesx (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [SOL] = odesx (@FUN, SLOT, INIT, [OPT], [PAR1, PAR2, ...]) + -- Command: [T, Y, [XE, YE, IE]] = odesx (@FUN, SLOT, INIT, [OPT], + [PAR1, PAR2, ...]) + This function file can be used to solve a set of stiff or + non-stiff ordinary differential equations (ODEs) and non-stiff or + stiff differential algebraic equations (DAEs). This function file + is a wrapper to Hairer's and Wanner's Fortran solver `seulex.f'. + + If this function is called with no return argument then plot the + solution over time in a figure window while solving the set of + ODEs that are defined in a function and specified by the function + handle @FUN. The second input argument SLOT is a double vector + that defines the time slot, INIT is a double vector that defines + the initial values of the states, OPT can optionally be a + structure array that keeps the options created with the command + `odeset' and PAR1, PAR2, ... can optionally be other input + arguments of any type that have to be passed to the function + defined by @FUN. + + If this function is called with one return argument then return + the solution SOL of type structure array after solving the set of + ODEs. The solution SOL has the fields X of type double column + vector for the steps chosen by the solver, Y of type double column + vector for the solutions at each time step of X, SOLVER of type + string for the solver name and optionally the extended time stamp + information XE, the extended solution information YE and the + extended index information IE all of type double column vector + that keep the informations of the event function if an event + function handle is set in the option argument OPT. + + If this function is called with more than one return argument then + return the time stamps T, the solution values Y and optionally the + extended time stamp information XE, the extended solution + information YE and the extended index information IE all of type + double column vector. + + For example, + function y = odepkg_equations_lorenz (t, x) + y = [10 * (x(2) - x(1)); + x(1) * (28 - x(3)); + x(1) * x(2) - 8/3 * x(3)]; + endfunction + + vopt = odeset ("InitialStep", 1e-3, "MaxStep", 1e-1, \\ + "OutputFcn", @odephas3, "Refine", 5); + odesx (@odepkg_equations_lorenz, [0, 25], [3 15 1], vopt); + + +File: odepkg.info, Node: Programmers Guide, Next: Function Index, Prev: Users Guide, Up: Top + +3 Programmers Guide +******************* + +* Menu: + +* Missing features:: The TODO-list for missing features + + +File: odepkg.info, Node: Missing features, Prev: Programmers Guide, Up: Programmers Guide + +3.1 Missing features +==================== + +If somebody want to help improving OdePkg then please contact the +Octave-Forge developer team sending your modifications via the +mailing-list . Here is a TODO-list +about missing features: + * Partial Derivative equations (PDEs) and Boundary Value Equations + (BVPs) cannot be solved with the solvers of the OdePkg. The wish + for solving PDEs and BVPs definitely is there (maybe you'd like to + create another package and call that package PdePkg, which is just + an idea). + + * Some options that can be set with propietary solver products are + not available within OdePkg. Have a look at section *Note + ODE/DAE/IDE/DDE options:: about which options can be set and which + options are not supported and help improving the command `odeset', + `odepkg_structure_check' and the solvers that have to deal with + these options. + + * OdePkg currently is missing the command `decic' which computes an + initial constraint for IDEs before solving. The command `deval' + also is missing that interpolates the results that can be obtained + from the solvers after solving and then plots the results in a new + figure. However, instead of using `deval' any of the commands + `interpX'. + + * If you want to include your own solver within OdePkg then either + code in `*.m' or `*.cc'. Solvers in `*.m' are preferred. Choose a + GPL compatible license for your solver and send your solver file + to the mailing list. + + * Before interfacing other solvers make sure that the core solver + file is available under a GPL-compatible license (if you'd like to + redistribute your wrapper with OdePkg). There can be found a lot + of solver files at `http://www.netlib.org' but most of them are + not GPL-compatible. Here is a list about authors and their solvers + that do have a GPL compatible license so that their codes can be + redistributed with OdePkg: + + * Cecilia Magherini and Luigi Brugnano from the University of + Bari created the BIMD solver that is available at + `http://pitagora.dm.uniba.it/~testset/solvers/bimd.php'. This + solver can be used to solve stiff DAE equations. The + Fortran77 file has been released under the GNU GPL V2. + + * Francesca Mazzia and Felice Iavernaro from the University of + Bari created the GAMD solver that is available at + `http://pitagora.dm.uniba.it/~testset/solvers/gamd.php'. This + solver can be used to solve stiff DAE equations. The + Fortran90 file has been released under the GNU GPL V2 but for + OdePkg a Fortran77 implementation would be preferred. + + * Ernst Hairer and Gerhard Wanner have been written more + solvers that are released under a modified BSD license than + have been interfaced by OdePkg. Notable solvers that can be + found at `http://www.unige.ch/~hairer/software.html' are + explicit Runge-Kutta methods `dopri5' and `dop853' and + extrapolation methods `odex' and `odex2' for solving ODEs, + `retard' and `radar5' for solving DDEs. + + * Jeff Cash has released some more Fortran77 solvers for + different kinds of differential equation problems than are + interfaced by OdePkg, check his website at + `http://www.ma.ic.ac.uk/~jcash'. + + + +File: odepkg.info, Node: Function Index, Next: Index, Prev: Programmers Guide, Up: Top + +Function Index +************** + +[index] +* Menu: + +* ode23: M-File Function Reference. + (line 14) +* ode23d: M-File Function Reference. + (line 60) +* ode2r: Oct-File Function Reference. + (line 164) +* ode45: M-File Function Reference. + (line 133) +* ode45d: M-File Function Reference. + (line 181) +* ode54: M-File Function Reference. + (line 254) +* ode54d: M-File Function Reference. + (line 300) +* ode5r: Oct-File Function Reference. + (line 210) +* ode78: M-File Function Reference. + (line 375) +* ode78d: M-File Function Reference. + (line 423) +* odebda: Oct-File Function Reference. + (line 12) +* odebdi: Oct-File Function Reference. + (line 62) +* odebwe: M-File Function Reference. + (line 496) +* odeexamples: M-File Function Reference. + (line 541) +* odeget: M-File Function Reference. + (line 545) +* odekdi: Oct-File Function Reference. + (line 113) +* odephas2: M-File Function Reference. + (line 569) +* odephas3: M-File Function Reference. + (line 603) +* odepkg: M-File Function Reference. + (line 642) +* odepkg_event_handle: M-File Function Reference. + (line 658) +* odepkg_examples_dae: M-File Function Reference. + (line 689) +* odepkg_examples_dde: M-File Function Reference. + (line 693) +* odepkg_examples_ide: M-File Function Reference. + (line 697) +* odepkg_examples_ode: M-File Function Reference. + (line 701) +* odepkg_structure_check: M-File Function Reference. + (line 706) +* odepkg_testsuite_calcmescd: M-File Function Reference. + (line 726) +* odepkg_testsuite_calcscd: M-File Function Reference. + (line 743) +* odepkg_testsuite_chemakzo: M-File Function Reference. + (line 760) +* odepkg_testsuite_hires: M-File Function Reference. + (line 776) +* odepkg_testsuite_implakzo: M-File Function Reference. + (line 792) +* odepkg_testsuite_implrober: M-File Function Reference. + (line 809) +* odepkg_testsuite_oregonator: M-File Function Reference. + (line 826) +* odepkg_testsuite_pollution: M-File Function Reference. + (line 843) +* odepkg_testsuite_robertson: M-File Function Reference. + (line 860) +* odepkg_testsuite_transistor: M-File Function Reference. + (line 877) +* odeplot: M-File Function Reference. + (line 893) +* odeprint: M-File Function Reference. + (line 926) +* oders: Oct-File Function Reference. + (line 259) +* odeset: M-File Function Reference. + (line 966) +* odesx: Oct-File Function Reference. + (line 306) + + +File: odepkg.info, Node: Index, Prev: Function Index, Up: Top + +Index +***** + +[index] +* Menu: + +* About OdePkg: About OdePkg. (line 6) +* AbsTol option: ODE/DAE/IDE/DDE options. + (line 41) +* BDF option: ODE/DAE/IDE/DDE options. + (line 373) +* BDF solver: Cash modified BDF solvers. + (line 6) +* Beginners guide: Beginners Guide. (line 6) +* bugs: Reporting Bugs. (line 6) +* Cash modified BDF: Cash modified BDF solvers. + (line 6) +* dae equations: DAE equations. (line 6) +* dae options: ODE/DAE/IDE/DDE options. + (line 6) +* ddaskr solver: DDaskr direct method solver. + (line 6) +* dde equations: DDE equations. (line 6) +* dde options: ODE/DAE/IDE/DDE options. + (line 6) +* decic: Missing features. (line 28) +* deinstallation: Installation and deinstallation. + (line 6) +* deval: Missing features. (line 28) +* differential equations: Differential Equations. + (line 6) +* Events option: ODE/DAE/IDE/DDE options. + (line 326) +* foo example: The "foo" example. (line 6) +* Hairer-Wanner: Hairer-Wanner solvers. + (line 6) +* history: OdePkg history and roadmap. + (line 6) +* ide equations: IDE equations. (line 6) +* ide options: ODE/DAE/IDE/DDE options. + (line 6) +* InitialSlope option: ODE/DAE/IDE/DDE options. + (line 114) +* InitialStep option: ODE/DAE/IDE/DDE options. + (line 98) +* installation: Installation and deinstallation. + (line 6) +* Jacobian option: ODE/DAE/IDE/DDE options. + (line 211) +* JPattern option: ODE/DAE/IDE/DDE options. + (line 251) +* m-file reference: M-File Function Reference. + (line 6) +* Mass option: ODE/DAE/IDE/DDE options. + (line 256) +* MassSingular option: ODE/DAE/IDE/DDE options. + (line 308) +* MaxNewtonIterations option: ODE/DAE/IDE/DDE options. + (line 383) +* MaxOrder option: ODE/DAE/IDE/DDE options. + (line 351) +* MaxStep option: ODE/DAE/IDE/DDE options. + (line 82) +* missing features: Missing features. (line 6) +* MStateDependence option: ODE/DAE/IDE/DDE options. + (line 280) +* MvPattern option: ODE/DAE/IDE/DDE options. + (line 306) +* NewtonTol option: ODE/DAE/IDE/DDE options. + (line 380) +* NonNegative option: ODE/DAE/IDE/DDE options. + (line 311) +* NormControl option: ODE/DAE/IDE/DDE options. + (line 60) +* oct-file reference: Oct-File Function Reference. + (line 6) +* ode equations: ODE equations. (line 6) +* ode options: ODE/DAE/IDE/DDE options. + (line 6) +* OutputFcn option: ODE/DAE/IDE/DDE options. + (line 117) +* OutputSel option: ODE/DAE/IDE/DDE options. + (line 173) +* performance: ODE solver performances. + (line 6) +* Programmers guide: Programmers Guide. (line 6) +* Refine option: ODE/DAE/IDE/DDE options. + (line 157) +* RelTol option: ODE/DAE/IDE/DDE options. + (line 20) +* roadmap: OdePkg history and roadmap. + (line 6) +* Runge-Kutta: Runge-Kutta solvers. (line 6) +* Runge-Kutta modified: Modified Runge-Kutta solvers. + (line 6) +* solver families: Solver families. (line 6) +* Stats option: ODE/DAE/IDE/DDE options. + (line 189) +* Users guide: Users Guide. (line 6) +* Vectorized option: ODE/DAE/IDE/DDE options. + (line 253) + + + +Tag Table: +Node: Top77 +Node: Beginners Guide1175 +Node: About OdePkg2340 +Node: OdePkg history and roadmap3448 +Node: Installation and deinstallation8050 +Node: Reporting Bugs8926 +Node: The "foo" example9602 +Node: Users Guide14647 +Node: Differential Equations15889 +Node: ODE equations16848 +Node: DAE equations17635 +Node: IDE equations19119 +Node: DDE equations19840 +Node: Solver families20556 +Node: Runge-Kutta solvers21606 +Ref: Runge-Kutta solvers-Footnote-125521 +Node: Hairer-Wanner solvers25973 +Node: Cash modified BDF solvers27800 +Node: DDaskr direct method solver29441 +Node: Modified Runge-Kutta solvers31110 +Node: ODE solver performances32910 +Node: ODE/DAE/IDE/DDE options38580 +Node: M-File Function Reference56436 +Node: Oct-File Function Reference105239 +Node: Programmers Guide123795 +Node: Missing features124013 +Node: Function Index127528 +Node: Index133329 + +End Tag Table diff --git a/octave_packages/odepkg-0.8.2/ode23.m b/octave_packages/odepkg-0.8.2/ode23.m new file mode 100644 index 0000000..6c506c4 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/ode23.m @@ -0,0 +1,753 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} ode23 (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{sol}] =} ode23 (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{t}, @var{y}, [@var{xe}, @var{ye}, @var{ie}]] =} ode23 (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# +%# This function file can be used to solve a set of non--stiff ordinary differential equations (non--stiff ODEs) or non--stiff differential algebraic equations (non--stiff DAEs) with the well known explicit Runge--Kutta method of order (2,3). +%# +%# If this function is called with no return argument then plot the solution over time in a figure window while solving the set of ODEs that are defined in a function and specified by the function handle @var{@@fun}. The second input argument @var{slot} is a double vector that defines the time slot, @var{init} is a double vector that defines the initial values of the states, @var{opt} can optionally be a structure array that keeps the options created with the command @command{odeset} and @var{par1}, @var{par2}, @dots{} can optionally be other input arguments of any type that have to be passed to the function defined by @var{@@fun}. +%# +%# If this function is called with one return argument then return the solution @var{sol} of type structure array after solving the set of ODEs. The solution @var{sol} has the fields @var{x} of type double column vector for the steps chosen by the solver, @var{y} of type double column vector for the solutions at each time step of @var{x}, @var{solver} of type string for the solver name and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector that keep the informations of the event function if an event function handle is set in the option argument @var{opt}. +%# +%# If this function is called with more than one return argument then return the time stamps @var{t}, the solution values @var{y} and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector. +%# +%# For example, solve an anonymous implementation of the Van der Pol equation +%# +%# @example +%# fvdb = @@(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%# +%# vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ +%# "NormControl", "on", "OutputFcn", @@odeplot); +%# ode23 (fvdb, [0 20], [2 0], vopt); +%# @end example +%# @end deftypefn +%# +%# @seealso{odepkg} + +%# ChangeLog: +%# 20010703 the function file "ode23.m" was written by Marc Compere +%# under the GPL for the use with this software. This function has been +%# taken as a base for the following implementation. +%# 20060810, Thomas Treichl +%# This function was adapted to the new syntax that is used by the +%# new OdePkg for Octave and is compatible to Matlab's ode23. + +function [varargout] = ode23 (vfun, vslot, vinit, varargin) + + if (nargin == 0) %# Check number and types of all input arguments + help ('ode23'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be greater than zero'); + + elseif (nargin < 3) + print_usage; + + elseif ~(isa (vfun, 'function_handle') || isa (vfun, 'inline')) + error ('OdePkg:InvalidArgument', ... + 'First input argument must be a valid function handle'); + + elseif (~isvector (vslot) || length (vslot) < 2) + error ('OdePkg:InvalidArgument', ... + 'Second input argument must be a valid vector'); + + elseif (~isvector (vinit) || ~isnumeric (vinit)) + error ('OdePkg:InvalidArgument', ... + 'Third input argument must be a valid numerical value'); + + elseif (nargin >= 4) + + if (~isstruct (varargin{1})) + %# varargin{1:len} are parameters for vfun + vodeoptions = odeset; + vfunarguments = varargin; + + elseif (length (varargin) > 1) + %# varargin{1} is an OdePkg options structure vopt + vodeoptions = odepkg_structure_check (varargin{1}, 'ode23'); + vfunarguments = {varargin{2:length(varargin)}}; + + else %# if (isstruct (varargin{1})) + vodeoptions = odepkg_structure_check (varargin{1}, 'ode23'); + vfunarguments = {}; + + end + + else %# if (nargin == 3) + vodeoptions = odeset; + vfunarguments = {}; + end + + %# Start preprocessing, have a look which options are set in + %# vodeoptions, check if an invalid or unused option is set + vslot = vslot(:).'; %# Create a row vector + vinit = vinit(:).'; %# Create a row vector + if (length (vslot) > 2) %# Step size checking + vstepsizefixed = true; + else + vstepsizefixed = false; + end + + %# Get the default options that can be set with 'odeset' temporarily + vodetemp = odeset; + + %# Implementation of the option RelTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.RelTol) && ~vstepsizefixed) + vodeoptions.RelTol = 1e-6; + warning ('OdePkg:InvalidArgument', ... + 'Option "RelTol" not set, new value %f is used', vodeoptions.RelTol); + elseif (~isempty (vodeoptions.RelTol) && vstepsizefixed) + warning ('OdePkg:InvalidArgument', ... + 'Option "RelTol" will be ignored if fixed time stamps are given'); + end + + %# Implementation of the option AbsTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.AbsTol) && ~vstepsizefixed) + vodeoptions.AbsTol = 1e-6; + warning ('OdePkg:InvalidArgument', ... + 'Option "AbsTol" not set, new value %f is used', vodeoptions.AbsTol); + elseif (~isempty (vodeoptions.AbsTol) && vstepsizefixed) + warning ('OdePkg:InvalidArgument', ... + 'Option "AbsTol" will be ignored if fixed time stamps are given'); + else + vodeoptions.AbsTol = vodeoptions.AbsTol(:); %# Create column vector + end + + %# Implementation of the option NormControl has been finished. This + %# option can be set by the user to another value than default value. + if (strcmp (vodeoptions.NormControl, 'on')) vnormcontrol = true; + else vnormcontrol = false; end + + %# Implementation of the option NonNegative has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.NonNegative)) + if (isempty (vodeoptions.Mass)), vhavenonnegative = true; + else + vhavenonnegative = false; + warning ('OdePkg:InvalidArgument', ... + 'Option "NonNegative" will be ignored if mass matrix is set'); + end + else vhavenonnegative = false; + end + + %# Implementation of the option OutputFcn has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputFcn) && nargout == 0) + vodeoptions.OutputFcn = @odeplot; + vhaveoutputfunction = true; + elseif (isempty (vodeoptions.OutputFcn)), vhaveoutputfunction = false; + else vhaveoutputfunction = true; + end + + %# Implementation of the option OutputSel has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.OutputSel)), vhaveoutputselection = true; + else vhaveoutputselection = false; end + + %# Implementation of the option OutputSave has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputSave)), vodeoptions.OutputSave = 1; + end + + %# Implementation of the option Refine has been finished. This option + %# can be set by the user to another value than default value. + if (vodeoptions.Refine > 0), vhaverefine = true; + else vhaverefine = false; end + + %# Implementation of the option Stats has been finished. This option + %# can be set by the user to another value than default value. + + %# Implementation of the option InitialStep has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.InitialStep) && ~vstepsizefixed) + vodeoptions.InitialStep = (vslot(1,2) - vslot(1,1)) / 10; + vodeoptions.InitialStep = vodeoptions.InitialStep / 10^vodeoptions.Refine; + warning ('OdePkg:InvalidArgument', ... + 'Option "InitialStep" not set, new value %f is used', vodeoptions.InitialStep); + end + + %# Implementation of the option MaxStep has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.MaxStep) && ~vstepsizefixed) + vodeoptions.MaxStep = abs (vslot(1,2) - vslot(1,1)) / 10; + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxStep" not set, new value %f is used', vodeoptions.MaxStep); + end + + %# Implementation of the option Events has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Events)), vhaveeventfunction = true; + else vhaveeventfunction = false; end + + %# The options 'Jacobian', 'JPattern' and 'Vectorized' will be ignored + %# by this solver because this solver uses an explicit Runge-Kutta + %# method and therefore no Jacobian calculation is necessary + if (~isequal (vodeoptions.Jacobian, vodetemp.Jacobian)) + warning ('OdePkg:InvalidArgument', ... + 'Option "Jacobian" will be ignored by this solver'); + end + if (~isequal (vodeoptions.JPattern, vodetemp.JPattern)) + warning ('OdePkg:InvalidArgument', ... + 'Option "JPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.Vectorized, vodetemp.Vectorized)) + warning ('OdePkg:InvalidArgument', ... + 'Option "Vectorized" will be ignored by this solver'); + end + if (~isequal (vodeoptions.NewtonTol, vodetemp.NewtonTol)) + warning ('OdePkg:InvalidArgument', ... + 'Option "NewtonTol" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxNewtonIterations,... + vodetemp.MaxNewtonIterations)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxNewtonIterations" will be ignored by this solver'); + end + + %# Implementation of the option Mass has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Mass) && isnumeric (vodeoptions.Mass)) + vhavemasshandle = false; vmass = vodeoptions.Mass; %# constant mass + elseif (isa (vodeoptions.Mass, 'function_handle')) + vhavemasshandle = true; %# mass defined by a function handle + else %# no mass matrix - creating a diag-matrix of ones for mass + vhavemasshandle = false; %# vmass = diag (ones (length (vinit), 1), 0); + end + + %# Implementation of the option MStateDependence has been finished. + %# This option can be set by the user to another value than default + %# value. + if (strcmp (vodeoptions.MStateDependence, 'none')) + vmassdependence = false; + else vmassdependence = true; + end + + %# Other options that are not used by this solver. Print a warning + %# message to tell the user that the option(s) is/are ignored. + if (~isequal (vodeoptions.MvPattern, vodetemp.MvPattern)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MvPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MassSingular, vodetemp.MassSingular)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MassSingular" will be ignored by this solver'); + end + if (~isequal (vodeoptions.InitialSlope, vodetemp.InitialSlope)) + warning ('OdePkg:InvalidArgument', ... + 'Option "InitialSlope" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxOrder, vodetemp.MaxOrder)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxOrder" will be ignored by this solver'); + end + if (~isequal (vodeoptions.BDF, vodetemp.BDF)) + warning ('OdePkg:InvalidArgument', ... + 'Option "BDF" will be ignored by this solver'); + end + + %# Starting the initialisation of the core solver ode23 + vtimestamp = vslot(1,1); %# timestamp = start time + vtimelength = length (vslot); %# length needed if fixed steps + vtimestop = vslot(1,vtimelength); %# stop time = last value + %# 20110611, reported by Nils Strunk + %# Make it possible to solve equations from negativ to zero, + %# eg. vres = ode23 (@(t,y) y, [-2 0], 2); + vdirection = sign (vtimestop - vtimestamp); %# Direction flag + + if (~vstepsizefixed) + if (sign (vodeoptions.InitialStep) == vdirection) + vstepsize = vodeoptions.InitialStep; + else %# Fix wrong direction of InitialStep. + vstepsize = - vodeoptions.InitialStep; + end + vminstepsize = (vtimestop - vtimestamp) / (1/eps); + else %# If step size is given then use the fixed time steps + vstepsize = vslot(1,2) - vslot(1,1); + vminstepsize = sign (vstepsize) * eps; + end + + vretvaltime = vtimestamp; %# first timestamp output + vretvalresult = vinit; %# first solution output + + %# Initialize the OutputFcn + if (vhaveoutputfunction) + if (vhaveoutputselection) vretout = vretvalresult(vodeoptions.OutputSel); + else vretout = vretvalresult; end + feval (vodeoptions.OutputFcn, vslot.', ... + vretout.', 'init', vfunarguments{:}); + end + + %# Initialize the EventFcn + if (vhaveeventfunction) + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vretvalresult.', 'init', vfunarguments{:}); + end + + vpow = 1/3; %# 20071016, reported by Luis Randez + va = [ 0, 0, 0; %# The Runge-Kutta-Fehlberg 2(3) coefficients + 1/2, 0, 0; %# Coefficients proved on 20060827 + -1, 2, 0]; %# See p.91 in Ascher & Petzold + vb2 = [0; 1; 0]; %# 2nd and 3rd order + vb3 = [1/6; 2/3; 1/6]; %# b-coefficients + vc = sum (va, 2); + + %# The solver main loop - stop if the endpoint has been reached + vcntloop = 2; vcntcycles = 1; vu = vinit; vk = vu.' * zeros(1,3); + vcntiter = 0; vunhandledtermination = true; vcntsave = 2; + while ((vdirection * (vtimestamp) < vdirection * (vtimestop)) && ... + (vdirection * (vstepsize) >= vdirection * (vminstepsize))) + + %# Hit the endpoint of the time slot exactely + if (vdirection * (vtimestamp + vstepsize) > vdirection * vtimestop) + %# vstepsize = vtimestop - vdirection * vtimestamp; + %# 20110611, reported by Nils Strunk + %# The endpoint of the time slot must be hit exactly, + %# eg. vsol = ode23 (@(t,y) y, [0 -1], 1); + vstepsize = vdirection * abs (abs (vtimestop) - abs (vtimestamp)); + end + + %# Estimate the three results when using this solver + for j = 1:3 + vthetime = vtimestamp + vc(j,1) * vstepsize; + vtheinput = vu.' + vstepsize * vk(:,1:j-1) * va(j,1:j-1).'; + if (vhavemasshandle) %# Handle only the dynamic mass matrix, + if (vmassdependence) %# constant mass matrices have already + vmass = feval ... %# been set before (if any) + (vodeoptions.Mass, vthetime, vtheinput, vfunarguments{:}); + else %# if (vmassdependence == false) + vmass = feval ... %# then we only have the time argument + (vodeoptions.Mass, vthetime, vfunarguments{:}); + end + vk(:,j) = vmass \ feval ... + (vfun, vthetime, vtheinput, vfunarguments{:}); + else + vk(:,j) = feval ... + (vfun, vthetime, vtheinput, vfunarguments{:}); + end + end + + %# Compute the 2nd and the 3rd order estimation + y2 = vu.' + vstepsize * (vk * vb2); + y3 = vu.' + vstepsize * (vk * vb3); + if (vhavenonnegative) + vu(vodeoptions.NonNegative) = abs (vu(vodeoptions.NonNegative)); + y2(vodeoptions.NonNegative) = abs (y2(vodeoptions.NonNegative)); + y3(vodeoptions.NonNegative) = abs (y3(vodeoptions.NonNegative)); + end + if (vhaveoutputfunction && vhaverefine) + vSaveVUForRefine = vu; + end + + %# Calculate the absolute local truncation error and the acceptable error + if (~vstepsizefixed) + if (~vnormcontrol) + vdelta = abs (y3 - y2); + vtau = max (vodeoptions.RelTol * abs (vu.'), vodeoptions.AbsTol); + else + vdelta = norm (y3 - y2, Inf); + vtau = max (vodeoptions.RelTol * max (norm (vu.', Inf), 1.0), ... + vodeoptions.AbsTol); + end + else %# if (vstepsizefixed == true) + vdelta = 1; vtau = 2; + end + + %# If the error is acceptable then update the vretval variables + if (all (vdelta <= vtau)) + vtimestamp = vtimestamp + vstepsize; + vu = y3.'; %# MC2001: the higher order estimation as "local extrapolation" + %# Save the solution every vodeoptions.OutputSave steps + if (mod (vcntloop-1,vodeoptions.OutputSave) == 0) + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu; + vcntsave = vcntsave + 1; + end + vcntloop = vcntloop + 1; vcntiter = 0; + + %# Call plot only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if plot function + %# returns false + if (vhaveoutputfunction) + for vcnt = 0:vodeoptions.Refine %# Approximation between told and t + if (vhaverefine) %# Do interpolation + vapproxtime = (vcnt + 1) * vstepsize / (vodeoptions.Refine + 2); + vapproxvals = vSaveVUForRefine.' + vapproxtime * (vk * vb3); + vapproxtime = (vtimestamp - vstepsize) + vapproxtime; + else + vapproxvals = vu.'; + vapproxtime = vtimestamp; + end + if (vhaveoutputselection) + vapproxvals = vapproxvals(vodeoptions.OutputSel); + end + vpltret = feval (vodeoptions.OutputFcn, vapproxtime, ... + vapproxvals, [], vfunarguments{:}); + if vpltret %# Leave refinement loop + break; + end + end + if (vpltret) %# Leave main loop + vunhandledtermination = false; + break; + end + end + + %# Call event only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if veventbreak is + %# true + if (vhaveeventfunction) + vevent = ... + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vu(:), [], vfunarguments{:}); + if (~isempty (vevent{1}) && vevent{1} == 1) + vretvaltime(vcntloop-1,:) = vevent{3}(end,:); + vretvalresult(vcntloop-1,:) = vevent{4}(end,:); + vunhandledtermination = false; break; + end + end + end %# If the error is acceptable ... + + %# Update the step size for the next integration step + if (~vstepsizefixed) + %# 20080425, reported by Marco Caliari + %# vdelta cannot be negative (because of the absolute value that + %# has been introduced) but it could be 0, then replace the zeros + %# with the maximum value of vdelta + vdelta(find (vdelta == 0)) = max (vdelta); + %# It could happen that max (vdelta) == 0 (ie. that the original + %# vdelta was 0), in that case we double the previous vstepsize + vdelta(find (vdelta == 0)) = max (vtau) .* (0.4 ^ (1 / vpow)); + + if (vdirection == 1) + vstepsize = min (vodeoptions.MaxStep, ... + min (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + else + vstepsize = max (- vodeoptions.MaxStep, ... + max (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + end + + else %# if (vstepsizefixed) + if (vcntloop <= vtimelength) + vstepsize = vslot(vcntloop) - vslot(vcntloop-1); + else %# Get out of the main integration loop + break; + end + end + + %# Update counters that count the number of iteration cycles + vcntcycles = vcntcycles + 1; %# Needed for cost statistics + vcntiter = vcntiter + 1; %# Needed to find iteration problems + + %# Stop solving because the last 1000 steps no successful valid + %# value has been found + if (vcntiter >= 5000) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f before endpoint at', ... + ' tend = %f was reached. This happened because the iterative', ... + ' integration loop does not find a valid solution at this time', ... + ' stamp. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + end + + end %# The main loop + + %# Check if integration of the ode has been successful + if (vdirection * vtimestamp < vdirection * vtimestop) + if (vunhandledtermination == true) + error ('OdePkg:InvalidArgument', ... + ['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f', ... + ' before endpoint at tend = %f was reached. This may', ... + ' happen if the stepsize grows smaller than defined in', ... + ' vminstepsize. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + else + warning ('OdePkg:InvalidArgument', ... + ['Solver has been stopped by a call of "break" in', ... + ' the main iteration loop at time t = %f before endpoint at', ... + ' tend = %f was reached. This may happen because the @odeplot', ... + ' function returned "true" or the @event function returned "true".'], ... + vtimestamp, vtimestop); + end + end + + %# Postprocessing, do whatever when terminating integration algorithm + if (vhaveoutputfunction) %# Cleanup plotter + feval (vodeoptions.OutputFcn, vtimestamp, ... + vu.', 'done', vfunarguments{:}); + end + if (vhaveeventfunction) %# Cleanup event function handling + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vu.', 'done', vfunarguments{:}); + end + %# Save the last step, if not already saved + if (mod (vcntloop-2,vodeoptions.OutputSave) ~= 0) + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu; + end + + %# Print additional information if option Stats is set + if (strcmp (vodeoptions.Stats, 'on')) + vhavestats = true; + vnsteps = vcntloop-2; %# vcntloop from 2..end + vnfailed = (vcntcycles-1)-(vcntloop-2)+1; %# vcntcycl from 1..end + vnfevals = 3*(vcntcycles-1); %# number of ode evaluations + vndecomps = 0; %# number of LU decompositions + vnpds = 0; %# number of partial derivatives + vnlinsols = 0; %# no. of solutions of linear systems + %# Print cost statistics if no output argument is given + if (nargout == 0) + vmsg = fprintf (1, 'Number of successful steps: %d\n', vnsteps); + vmsg = fprintf (1, 'Number of failed attempts: %d\n', vnfailed); + vmsg = fprintf (1, 'Number of function calls: %d\n', vnfevals); + end + else + vhavestats = false; + end + + if (nargout == 1) %# Sort output variables, depends on nargout + varargout{1}.x = vretvaltime; %# Time stamps are saved in field x + varargout{1}.y = vretvalresult; %# Results are saved in field y + varargout{1}.solver = 'ode23'; %# Solver name is saved in field solver + if (vhaveeventfunction) + varargout{1}.ie = vevent{2}; %# Index info which event occured + varargout{1}.xe = vevent{3}; %# Time info when an event occured + varargout{1}.ye = vevent{4}; %# Results when an event occured + end + if (vhavestats) + varargout{1}.stats = struct; + varargout{1}.stats.nsteps = vnsteps; + varargout{1}.stats.nfailed = vnfailed; + varargout{1}.stats.nfevals = vnfevals; + varargout{1}.stats.npds = vnpds; + varargout{1}.stats.ndecomps = vndecomps; + varargout{1}.stats.nlinsols = vnlinsols; + end + elseif (nargout == 2) + varargout{1} = vretvaltime; %# Time stamps are first output argument + varargout{2} = vretvalresult; %# Results are second output argument + elseif (nargout == 5) + varargout{1} = vretvaltime; %# Same as (nargout == 2) + varargout{2} = vretvalresult; %# Same as (nargout == 2) + varargout{3} = []; %# LabMat doesn't accept lines like + varargout{4} = []; %# varargout{3} = varargout{4} = []; + varargout{5} = []; + if (vhaveeventfunction) + varargout{3} = vevent{3}; %# Time info when an event occured + varargout{4} = vevent{4}; %# Results when an event occured + varargout{5} = vevent{2}; %# Index info which event occured + end + end +end + +%! # We are using the "Van der Pol" implementation for all tests that +%! # are done for this function. We also define a Jacobian, Events, +%! # pseudo-Mass implementation. For further tests we also define a +%! # reference solution (computed at high accuracy) and an OutputFcn +%!function [ydot] = fpol (vt, vy, varargin) %# The Van der Pol +%! ydot = [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%!function [vjac] = fjac (vt, vy, varargin) %# its Jacobian +%! vjac = [0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]; +%!function [vjac] = fjcc (vt, vy, varargin) %# sparse type +%! vjac = sparse ([0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]); +%!function [vval, vtrm, vdir] = feve (vt, vy, varargin) +%! vval = fpol (vt, vy, varargin); %# We use the derivatives +%! vtrm = zeros (2,1); %# that's why component 2 +%! vdir = ones (2,1); %# seems to not be exact +%!function [vval, vtrm, vdir] = fevn (vt, vy, varargin) +%! vval = fpol (vt, vy, varargin); %# We use the derivatives +%! vtrm = ones (2,1); %# that's why component 2 +%! vdir = ones (2,1); %# seems to not be exact +%!function [vmas] = fmas (vt, vy) +%! vmas = [1, 0; 0, 1]; %# Dummy mass matrix for tests +%!function [vmas] = fmsa (vt, vy) +%! vmas = sparse ([1, 0; 0, 1]); %# A sparse dummy matrix +%!function [vref] = fref () %# The computed reference sol +%! vref = [0.32331666704577, -1.83297456798624]; +%!function [vout] = fout (vt, vy, vflag, varargin) +%! if (regexp (char (vflag), 'init') == 1) +%! if (any (size (vt) ~= [2, 1])) error ('"fout" step "init"'); end +%! elseif (isempty (vflag)) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "calc"'); end +%! vout = false; +%! elseif (regexp (char (vflag), 'done') == 1) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "done"'); end +%! else error ('"fout" invalid vflag'); +%! end +%! +%! %# Turn off output of warning messages for all tests, turn them on +%! %# again if the last test is called +%!error %# input argument number one +%! warning ('off', 'OdePkg:InvalidArgument'); +%! B = ode23 (1, [0 25], [3 15 1]); +%!error %# input argument number two +%! B = ode23 (@fpol, 1, [3 15 1]); +%!error %# input argument number three +%! B = ode23 (@flor, [0 25], 1); +%!test %# one output argument +%! vsol = ode23 (@fpol, [0 2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%! assert (isfield (vsol, 'solver')); +%! assert (vsol.solver, 'ode23'); +%!test %# two output arguments +%! [vt, vy] = ode23 (@fpol, [0 2], [2 0]); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%!test %# five output arguments and no Events +%! [vt, vy, vxe, vye, vie] = ode23 (@fpol, [0 2], [2 0]); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%! assert ([vie, vxe, vye], []); +%!test %# anonymous function instead of real function +%! fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%! vsol = ode23 (fvdb, [0 2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# extra input arguments passed through +%! vsol = ode23 (@fpol, [0 2], [2 0], 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# empty OdePkg structure *but* extra input arguments +%! vopt = odeset; +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt, 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!error %# strange OdePkg structure +%! vopt = struct ('foo', 1); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%!test %# Solve vdp in fixed step sizes +%! vsol = ode23 (@fpol, [0:0.1:2], [2 0]); +%! assert (vsol.x(:), [0:0.1:2]'); +%! assert (vsol.y(end,:), fref, 1e-3); +%!test %# Solve in backward direction starting at t=0 +%! vref = [-1.205364552835178, 0.951542399860817]; +%! vsol = ode23 (@fpol, [0 -2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [-2, vref], 1e-3); +%!test %# Solve in backward direction starting at t=2 +%! vref = [-1.205364552835178, 0.951542399860817]; +%! vsol = ode23 (@fpol, [2 -2], fref); +%! assert ([vsol.x(end), vsol.y(end,:)], [-2, vref], 1e-3); +%!test %# Solve another anonymous function in backward direction +%! vref = [-1, 0.367879437558975]; +%! vsol = ode23 (@(t,y) y, [0 -1], 1); +%! assert ([vsol.x(end), vsol.y(end,:)], vref, 1e-3); +%!test %# Solve another anonymous function below zero +%! vref = [0, 14.77810590694212]; +%! vsol = ode23 (@(t,y) y, [-2 0], 2); +%! assert ([vsol.x(end), vsol.y(end,:)], vref, 1e-3); +%!test %# AbsTol option +%! vopt = odeset ('AbsTol', 1e-5); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# AbsTol and RelTol option +%! vopt = odeset ('AbsTol', 1e-8, 'RelTol', 1e-8); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# RelTol and NormControl option -- higher accuracy +%! vopt = odeset ('RelTol', 1e-8, 'NormControl', 'on'); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-6); +%!test %# Keeps initial values while integrating +%! vopt = odeset ('NonNegative', 2); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, 2, 0], 1e-1); +%!test %# Details of OutputSel and Refine can't be tested +%! vopt = odeset ('OutputFcn', @fout, 'OutputSel', 1, 'Refine', 5); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%!test %# Details of OutputSave can't be tested +%! vopt = odeset ('OutputSave', 1, 'OutputSel', 1); +%! vsla = ode23 (@fpol, [0 2], [2 0], vopt); +%! vopt = odeset ('OutputSave', 2); +%! vslb = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert (length (vsla.x) > length (vslb.x)) +%!test %# Stats must add further elements in vsol +%! vopt = odeset ('Stats', 'on'); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert (isfield (vsol, 'stats')); +%! assert (isfield (vsol.stats, 'nsteps')); +%!test %# InitialStep option +%! vopt = odeset ('InitialStep', 1e-8); +%! vsol = ode23 (@fpol, [0 0.2], [2 0], vopt); +%! assert ([vsol.x(2)-vsol.x(1)], [1e-8], 1e-9); +%!test %# MaxStep option +%! vopt = odeset ('MaxStep', 1e-2); +%! vsol = ode23 (@fpol, [0 0.2], [2 0], vopt); +%! assert ([vsol.x(5)-vsol.x(4)], [1e-2], 1e-2); +%!test %# Events option add further elements in vsol +%! vopt = odeset ('Events', @feve); +%! vsol = ode23 (@fpol, [0 10], [2 0], vopt); +%! assert (isfield (vsol, 'ie')); +%! assert (vsol.ie, [2; 1; 2; 1]); +%! assert (isfield (vsol, 'xe')); +%! assert (isfield (vsol, 'ye')); +%!test %# Events option, now stop integration +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! vsol = ode23 (@fpol, [0 10], [2 0], vopt); +%! assert ([vsol.ie, vsol.xe, vsol.ye], ... +%! [2.0, 2.496110, -0.830550, -2.677589], 1e-3); +%!test %# Events option, five output arguments +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! [vt, vy, vxe, vye, vie] = ode23 (@fpol, [0 10], [2 0], vopt); +%! assert ([vie, vxe, vye], ... +%! [2.0, 2.496110, -0.830550, -2.677589], 1e-3); +%!test %# Jacobian option +%! vopt = odeset ('Jacobian', @fjac); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Jacobian option and sparse return value +%! vopt = odeset ('Jacobian', @fjcc); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%! +%! %# test for JPattern option is missing +%! %# test for Vectorized option is missing +%! %# test for NewtonTol option is missing +%! %# test for MaxNewtonIterations option is missing +%! +%!test %# Mass option as function +%! vopt = odeset ('Mass', @fmas); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as matrix +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as sparse matrix +%! vopt = odeset ('Mass', sparse (eye (2,2))); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as function and sparse matrix +%! vopt = odeset ('Mass', @fmsa); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as function and MStateDependence +%! vopt = odeset ('Mass', @fmas, 'MStateDependence', 'strong'); +%! vsol = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Set BDF option to something else than default +%! vopt = odeset ('BDF', 'on'); +%! [vt, vy] = ode23 (@fpol, [0 2], [2 0], vopt); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%! +%! %# test for MvPattern option is missing +%! %# test for InitialSlope option is missing +%! %# test for MaxOrder option is missing +%! +%! warning ('on', 'OdePkg:InvalidArgument'); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** + diff --git a/octave_packages/odepkg-0.8.2/ode23d.m b/octave_packages/odepkg-0.8.2/ode23d.m new file mode 100644 index 0000000..fbd136d --- /dev/null +++ b/octave_packages/odepkg-0.8.2/ode23d.m @@ -0,0 +1,764 @@ +%# Copyright (C) 2008-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} ode23d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{sol}] =} ode23d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{t}, @var{y}, [@var{xe}, @var{ye}, @var{ie}]] =} ode23d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# +%# This function file can be used to solve a set of non--stiff delay differential equations (non--stiff DDEs) with a modified version of the well known explicit Runge--Kutta method of order (2,3). +%# +%# If this function is called with no return argument then plot the solution over time in a figure window while solving the set of DDEs that are defined in a function and specified by the function handle @var{@@fun}. The second input argument @var{slot} is a double vector that defines the time slot, @var{init} is a double vector that defines the initial values of the states, @var{lags} is a double vector that describes the lags of time, @var{hist} is a double matrix and describes the history of the DDEs, @var{opt} can optionally be a structure array that keeps the options created with the command @command{odeset} and @var{par1}, @var{par2}, @dots{} can optionally be other input arguments of any type that have to be passed to the function defined by @var{@@fun}. +%# +%# In other words, this function will solve a problem of the form +%# @example +%# dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), @dots{}))) +%# y(slot(1)) = init +%# y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), @dots{} +%# @end example +%# +%# If this function is called with one return argument then return the solution @var{sol} of type structure array after solving the set of DDEs. The solution @var{sol} has the fields @var{x} of type double column vector for the steps chosen by the solver, @var{y} of type double column vector for the solutions at each time step of @var{x}, @var{solver} of type string for the solver name and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector that keep the informations of the event function if an event function handle is set in the option argument @var{opt}. +%# +%# If this function is called with more than one return argument then return the time stamps @var{t}, the solution values @var{y} and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector. +%# +%# For example: +%# @itemize @minus +%# @item +%# the following code solves an anonymous implementation of a chaotic behavior +%# +%# @example +%# fcao = @@(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy]; +%# +%# vopt = odeset ("NormControl", "on", "RelTol", 1e-3); +%# vsol = ode23d (fcao, [0, 100], 0.5, 2, 0.5, vopt); +%# +%# vlag = interp1 (vsol.x, vsol.y, vsol.x - 2); +%# plot (vsol.y, vlag); legend ("fcao (t,y,z)"); +%# @end example +%# +%# @item +%# to solve the following problem with two delayed state variables +%# +%# @example +%# d y1(t)/dt = -y1(t) +%# d y2(t)/dt = -y2(t) + y1(t-5) +%# d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10) +%# @end example +%# +%# one might do the following +%# +%# @example +%# function f = fun (t, y, yd) +%# f(1) = -y(1); %% y1' = -y1(t) +%# f(2) = -y(2) + yd(1,1); %% y2' = -y2(t) + y1(t-lags(1)) +%# f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2)) +%# endfunction +%# T = [0,20] +%# res = ode23d (@@fun, T, [1;1;1], [5, 10], ones (3,2)); +%# @end example +%# +%# @end itemize +%# @end deftypefn +%# +%# @seealso{odepkg} + +function [varargout] = ode23d (vfun, vslot, vinit, vlags, vhist, varargin) + + if (nargin == 0) %# Check number and types of all input arguments + help ('ode23d'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be greater than zero'); + + elseif (nargin < 5) + print_usage; + + elseif (~isa (vfun, 'function_handle')) + error ('OdePkg:InvalidArgument', ... + 'First input argument must be a valid function handle'); + + elseif (~isvector (vslot) || length (vslot) < 2) + error ('OdePkg:InvalidArgument', ... + 'Second input argument must be a valid vector'); + + elseif (~isvector (vinit) || ~isnumeric (vinit)) + error ('OdePkg:InvalidArgument', ... + 'Third input argument must be a valid numerical value'); + + elseif (~isvector (vlags) || ~isnumeric (vlags)) + error ('OdePkg:InvalidArgument', ... + 'Fourth input argument must be a valid numerical value'); + + elseif ~(isnumeric (vhist) || isa (vhist, 'function_handle')) + error ('OdePkg:InvalidArgument', ... + 'Fifth input argument must either be numeric or a function handle'); + + elseif (nargin >= 6) + + if (~isstruct (varargin{1})) + %# varargin{1:len} are parameters for vfun + vodeoptions = odeset; + vfunarguments = varargin; + + elseif (length (varargin) > 1) + %# varargin{1} is an OdePkg options structure vopt + vodeoptions = odepkg_structure_check (varargin{1}, 'ode23d'); + vfunarguments = {varargin{2:length(varargin)}}; + + else %# if (isstruct (varargin{1})) + vodeoptions = odepkg_structure_check (varargin{1}, 'ode23d'); + vfunarguments = {}; + + end + + else %# if (nargin == 5) + vodeoptions = odeset; + vfunarguments = {}; + end + + %# Start preprocessing, have a look which options have been set in + %# vodeoptions. Check if an invalid or unused option has been set and + %# print warnings. + vslot = vslot(:)'; %# Create a row vector + vinit = vinit(:)'; %# Create a row vector + vlags = vlags(:)'; %# Create a row vector + + %# Check if the user has given fixed points of time + if (length (vslot) > 2), vstepsizegiven = true; %# Step size checking + else vstepsizegiven = false; end + + %# Get the default options that can be set with 'odeset' temporarily + vodetemp = odeset; + + %# Implementation of the option RelTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.RelTol) && ~vstepsizegiven) + vodeoptions.RelTol = 1e-6; + warning ('OdePkg:InvalidOption', ... + 'Option "RelTol" not set, new value %f is used', vodeoptions.RelTol); + elseif (~isempty (vodeoptions.RelTol) && vstepsizegiven) + warning ('OdePkg:InvalidOption', ... + 'Option "RelTol" will be ignored if fixed time stamps are given'); + %# This implementation has been added to odepkg_structure_check.m + %# elseif (~isscalar (vodeoptions.RelTol) && ~vstepsizegiven) + %# error ('OdePkg:InvalidOption', ... + %# 'Option "RelTol" must be set to a scalar value for this solver'); + end + + %# Implementation of the option AbsTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.AbsTol) && ~vstepsizegiven) + vodeoptions.AbsTol = 1e-6; + warning ('OdePkg:InvalidOption', ... + 'Option "AbsTol" not set, new value %f is used', vodeoptions.AbsTol); + elseif (~isempty (vodeoptions.AbsTol) && vstepsizegiven) + warning ('OdePkg:InvalidOption', ... + 'Option "AbsTol" will be ignored if fixed time stamps are given'); + else %# create column vector + vodeoptions.AbsTol = vodeoptions.AbsTol(:); + end + + %# Implementation of the option NormControl has been finished. This + %# option can be set by the user to another value than default value. + if (strcmp (vodeoptions.NormControl, 'on')), vnormcontrol = true; + else vnormcontrol = false; + end + + %# Implementation of the option NonNegative has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.NonNegative)) + if (isempty (vodeoptions.Mass)), vhavenonnegative = true; + else + vhavenonnegative = false; + warning ('OdePkg:InvalidOption', ... + 'Option "NonNegative" will be ignored if mass matrix is set'); + end + else vhavenonnegative = false; + end + + %# Implementation of the option OutputFcn has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputFcn) && nargout == 0) + vodeoptions.OutputFcn = @odeplot; + vhaveoutputfunction = true; + elseif (isempty (vodeoptions.OutputFcn)), vhaveoutputfunction = false; + else vhaveoutputfunction = true; + end + + %# Implementation of the option OutputSel has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.OutputSel)), vhaveoutputselection = true; + else vhaveoutputselection = false; end + + %# Implementation of the option Refine has been finished. This option + %# can be set by the user to another value than default value. + if (isequal (vodeoptions.Refine, vodetemp.Refine)), vhaverefine = true; + else vhaverefine = false; end + + %# Implementation of the option Stats has been finished. This option + %# can be set by the user to another value than default value. + + %# Implementation of the option InitialStep has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.InitialStep) && ~vstepsizegiven) + vodeoptions.InitialStep = abs (vslot(1,1) - vslot(1,2)) / 10; + vodeoptions.InitialStep = vodeoptions.InitialStep / 10^vodeoptions.Refine; + warning ('OdePkg:InvalidOption', ... + 'Option "InitialStep" not set, new value %f is used', vodeoptions.InitialStep); + end + + %# Implementation of the option MaxStep has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.MaxStep) && ~vstepsizegiven) + vodeoptions.MaxStep = abs (vslot(1,1) - vslot(1,length (vslot))) / 10; + %# vodeoptions.MaxStep = vodeoptions.MaxStep / 10^vodeoptions.Refine; + warning ('OdePkg:InvalidOption', ... + 'Option "MaxStep" not set, new value %f is used', vodeoptions.MaxStep); + end + + %# Implementation of the option Events has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Events)), vhaveeventfunction = true; + else vhaveeventfunction = false; end + + %# The options 'Jacobian', 'JPattern' and 'Vectorized' will be ignored + %# by this solver because this solver uses an explicit Runge-Kutta + %# method and therefore no Jacobian calculation is necessary + if (~isequal (vodeoptions.Jacobian, vodetemp.Jacobian)) + warning ('OdePkg:InvalidOption', ... + 'Option "Jacobian" will be ignored by this solver'); + end + if (~isequal (vodeoptions.JPattern, vodetemp.JPattern)) + warning ('OdePkg:InvalidOption', ... + 'Option "JPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.Vectorized, vodetemp.Vectorized)) + warning ('OdePkg:InvalidOption', ... + 'Option "Vectorized" will be ignored by this solver'); + end + if (~isequal (vodeoptions.NewtonTol, vodetemp.NewtonTol)) + warning ('OdePkg:InvalidArgument', ... + 'Option "NewtonTol" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxNewtonIterations,... + vodetemp.MaxNewtonIterations)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxNewtonIterations" will be ignored by this solver'); + end + + %# Implementation of the option Mass has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Mass) && isnumeric (vodeoptions.Mass)) + vhavemasshandle = false; vmass = vodeoptions.Mass; %# constant mass + elseif (isa (vodeoptions.Mass, 'function_handle')) + vhavemasshandle = true; %# mass defined by a function handle + else %# no mass matrix - creating a diag-matrix of ones for mass + vhavemasshandle = false; %# vmass = diag (ones (length (vinit), 1), 0); + end + + %# Implementation of the option MStateDependence has been finished. + %# This option can be set by the user to another value than default + %# value. + if (strcmp (vodeoptions.MStateDependence, 'none')) + vmassdependence = false; + else vmassdependence = true; + end + + %# Other options that are not used by this solver. Print a warning + %# message to tell the user that the option(s) is/are ignored. + if (~isequal (vodeoptions.MvPattern, vodetemp.MvPattern)) + warning ('OdePkg:InvalidOption', ... + 'Option "MvPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MassSingular, vodetemp.MassSingular)) + warning ('OdePkg:InvalidOption', ... + 'Option "MassSingular" will be ignored by this solver'); + end + if (~isequal (vodeoptions.InitialSlope, vodetemp.InitialSlope)) + warning ('OdePkg:InvalidOption', ... + 'Option "InitialSlope" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxOrder, vodetemp.MaxOrder)) + warning ('OdePkg:InvalidOption', ... + 'Option "MaxOrder" will be ignored by this solver'); + end + if (~isequal (vodeoptions.BDF, vodetemp.BDF)) + warning ('OdePkg:InvalidOption', ... + 'Option "BDF" will be ignored by this solver'); + end + + %# Starting the initialisation of the core solver ode23d + vtimestamp = vslot(1,1); %# timestamp = start time + vtimelength = length (vslot); %# length needed if fixed steps + vtimestop = vslot(1,vtimelength); %# stop time = last value + + if (~vstepsizegiven) + vstepsize = vodeoptions.InitialStep; + vminstepsize = (vtimestop - vtimestamp) / (1/eps); + else %# If step size is given then use the fixed time steps + vstepsize = abs (vslot(1,1) - vslot(1,2)); + vminstepsize = eps; %# vslot(1,2) - vslot(1,1) - eps; + end + + vretvaltime = vtimestamp; %# first timestamp output + if (vhaveoutputselection) %# first solution output + vretvalresult = vinit(vodeoptions.OutputSel); + else vretvalresult = vinit; + end + + %# Initialize the OutputFcn + if (vhaveoutputfunction) + feval (vodeoptions.OutputFcn, vslot', ... + vretvalresult', 'init', vfunarguments{:}); + end + + %# Initialize the History + if (isnumeric (vhist)) + vhmat = vhist; + vhavehistnumeric = true; + else %# it must be a function handle + for vcnt = 1:length (vlags); + vhmat(:,vcnt) = feval (vhist, (vslot(1)-vlags(vcnt)), vfunarguments{:}); + end + vhavehistnumeric = false; + end + + %# Initialize DDE variables for history calculation + vsaveddetime = [vtimestamp - vlags, vtimestamp]'; + vsaveddeinput = [vhmat, vinit']'; + vsavedderesult = [vhmat, vinit']'; + + %# Initialize the EventFcn + if (vhaveeventfunction) + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + {vretvalresult', vhmat}, 'init', vfunarguments{:}); + end + + vpow = 1/3; %# 20071016, reported by Luis Randez + va = [ 0, 0, 0; %# The Runge-Kutta-Fehlberg 2(3) coefficients + 1/2, 0, 0; %# Coefficients proved on 20060827 + -1, 2, 0]; %# See p.91 in Ascher & Petzold + vb2 = [0; 1; 0]; %# 2nd and 3rd order + vb3 = [1/6; 2/3; 1/6]; %# b-coefficients + vc = sum (va, 2); + + %# The solver main loop - stop if the endpoint has been reached + vcntloop = 2; vcntcycles = 1; vu = vinit; vk = vu' * zeros(1,3); + vcntiter = 0; vunhandledtermination = true; + while ((vtimestamp < vtimestop && vstepsize >= vminstepsize)) + + %# Hit the endpoint of the time slot exactely + if ((vtimestamp + vstepsize) > vtimestop) + vstepsize = vtimestop - vtimestamp; end + + %# Estimate the three results when using this solver + for j = 1:3 + vthetime = vtimestamp + vc(j,1) * vstepsize; + vtheinput = vu' + vstepsize * vk(:,1:j-1) * va(j,1:j-1)'; + %# Claculate the history values (or get them from an external + %# function) that are needed for the next step of solving + if (vhavehistnumeric) + for vcnt = 1:length (vlags) + %# Direct implementation of a 'quadrature cubic Hermite interpolation' + %# found at the Faculty for Mathematics of the University of Stuttgart + %# http://mo.mathematik.uni-stuttgart.de/inhalt/aussage/aussage1269 + vnumb = find (vthetime - vlags(vcnt) >= vsaveddetime); + velem = min (vnumb(end), length (vsaveddetime) - 1); + vstep = vsaveddetime(velem+1) - vsaveddetime(velem); + vdiff = (vthetime - vlags(vcnt) - vsaveddetime(velem)) / vstep; + vsubs = 1 - vdiff; + %# Calculation of the coefficients for the interpolation algorithm + vua = (1 + 2 * vdiff) * vsubs^2; + vub = (3 - 2 * vdiff) * vdiff^2; + vva = vstep * vdiff * vsubs^2; + vvb = -vstep * vsubs * vdiff^2; + vhmat(:,vcnt) = vua * vsaveddeinput(velem,:)' + ... + vub * vsaveddeinput(velem+1,:)' + ... + vva * vsavedderesult(velem,:)' + ... + vvb * vsavedderesult(velem+1,:)'; + end + else %# the history must be a function handle + for vcnt = 1:length (vlags) + vhmat(:,vcnt) = feval ... + (vhist, vthetime - vlags(vcnt), vfunarguments{:}); + end + end + + if (vhavemasshandle) %# Handle only the dynamic mass matrix, + if (vmassdependence) %# constant mass matrices have already + vmass = feval ... %# been set before (if any) + (vodeoptions.Mass, vthetime, vtheinput, vfunarguments{:}); + else %# if (vmassdependence == false) + vmass = feval ... %# then we only have the time argument + (vodeoptions.Mass, vthetime, vfunarguments{:}); + end + vk(:,j) = vmass \ feval ... + (vfun, vthetime, vtheinput, vhmat, vfunarguments{:}); + else + vk(:,j) = feval ... + (vfun, vthetime, vtheinput, vhmat, vfunarguments{:}); + end + end + + %# Compute the 2nd and the 3rd order estimation + y2 = vu' + vstepsize * (vk * vb2); + y3 = vu' + vstepsize * (vk * vb3); + if (vhavenonnegative) + vu(vodeoptions.NonNegative) = abs (vu(vodeoptions.NonNegative)); + y2(vodeoptions.NonNegative) = abs (y2(vodeoptions.NonNegative)); + y3(vodeoptions.NonNegative) = abs (y3(vodeoptions.NonNegative)); + end + vSaveVUForRefine = vu; + + %# Calculate the absolute local truncation error and the acceptable error + if (~vstepsizegiven) + if (~vnormcontrol) + vdelta = y3 - y2; + vtau = max (vodeoptions.RelTol * vu', vodeoptions.AbsTol); + else + vdelta = norm (y3 - y2, Inf); + vtau = max (vodeoptions.RelTol * max (norm (vu', Inf), 1.0), ... + vodeoptions.AbsTol); + end + else %# if (vstepsizegiven == true) + vdelta = 1; vtau = 2; + end + + %# If the error is acceptable then update the vretval variables + if (all (vdelta <= vtau)) + vtimestamp = vtimestamp + vstepsize; + vu = y3'; %# MC2001: the higher order estimation as "local extrapolation" + vretvaltime(vcntloop,:) = vtimestamp; + if (vhaveoutputselection) + vretvalresult(vcntloop,:) = vu(vodeoptions.OutputSel); + else + vretvalresult(vcntloop,:) = vu; + end + vcntloop = vcntloop + 1; vcntiter = 0; + + %# Update DDE values for next history calculation + vsaveddetime(end+1) = vtimestamp; + vsaveddeinput(end+1,:) = vtheinput'; + vsavedderesult(end+1,:) = vu; + + %# Call plot only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if plot function + %# returns false + if (vhaveoutputfunction) + if (vhaverefine) %# Do interpolation + for vcnt = 0:vodeoptions.Refine %# Approximation between told and t + vapproxtime = (vcnt + 1) * vstepsize / (vodeoptions.Refine + 2); + vapproxvals = vSaveVUForRefine' + vapproxtime * (vk * vb3); + if (vhaveoutputselection) + vapproxvals = vapproxvals(vodeoptions.OutputSel); + end + feval (vodeoptions.OutputFcn, (vtimestamp - vstepsize) + vapproxtime, ... + vapproxvals, [], vfunarguments{:}); + end + end + vpltret = feval (vodeoptions.OutputFcn, vtimestamp, ... + vretvalresult(vcntloop-1,:)', [], vfunarguments{:}); + if (vpltret), vunhandledtermination = false; break; end + end + + %# Call event only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if veventbreak is + %# true + if (vhaveeventfunction) + vevent = ... + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + {vu(:), vhmat}, [], vfunarguments{:}); + if (~isempty (vevent{1}) && vevent{1} == 1) + vretvaltime(vcntloop-1,:) = vevent{3}(end,:); + vretvalresult(vcntloop-1,:) = vevent{4}(end,:); + vunhandledtermination = false; break; + end + end + end %# If the error is acceptable ... + + %# Update the step size for the next integration step + if (~vstepsizegiven) + %# vdelta may be 0 or even negative - could be an iteration problem + vdelta = max (vdelta, eps); + vstepsize = min (vodeoptions.MaxStep, ... + min (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + elseif (vstepsizegiven) + if (vcntloop < vtimelength) + vstepsize = vslot(1,vcntloop-1) - vslot(1,vcntloop-2); + end + end + + %# Update counters that count the number of iteration cycles + vcntcycles = vcntcycles + 1; %# Needed for postprocessing + vcntiter = vcntiter + 1; %# Needed to find iteration problems + + %# Stop solving because the last 1000 steps no successful valid + %# value has been found + if (vcntiter >= 5000) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f before endpoint at', ... + ' tend = %f was reached. This happened because the iterative', ... + ' integration loop does not find a valid solution at this time', ... + ' stamp. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + end + + end %# The main loop + + %# Check if integration of the ode has been successful + if (vtimestamp < vtimestop) + if (vunhandledtermination == true) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f', ... + ' before endpoint at tend = %f was reached. This may', ... + ' happen if the stepsize grows smaller than defined in', ... + ' vminstepsize. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + else + warning ('OdePkg:HideWarning', ... + ['Solver has been stopped by a call of "break" in', ... + ' the main iteration loop at time t = %f before endpoint at', ... + ' tend = %f was reached. This may happen because the @odeplot', ... + ' function returned "true" or the @event function returned "true".'], ... + vtimestamp, vtimestop); + end + end + + %# Postprocessing, do whatever when terminating integration algorithm + if (vhaveoutputfunction) %# Cleanup plotter + feval (vodeoptions.OutputFcn, vtimestamp, ... + vretvalresult(vcntloop-1,:)', 'done', vfunarguments{:}); + end + if (vhaveeventfunction) %# Cleanup event function handling + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + {vretvalresult(vcntloop-1,:), vhmat}, 'done', vfunarguments{:}); + end + + %# Print additional information if option Stats is set + if (strcmp (vodeoptions.Stats, 'on')) + vhavestats = true; + vnsteps = vcntloop-2; %# vcntloop from 2..end + vnfailed = (vcntcycles-1)-(vcntloop-2)+1; %# vcntcycl from 1..end + vnfevals = 3*(vcntcycles-1); %# number of ode evaluations + vndecomps = 0; %# number of LU decompositions + vnpds = 0; %# number of partial derivatives + vnlinsols = 0; %# no. of solutions of linear systems + %# Print cost statistics if no output argument is given + if (nargout == 0) + vmsg = fprintf (1, 'Number of successful steps: %d', vnsteps); + vmsg = fprintf (1, 'Number of failed attempts: %d', vnfailed); + vmsg = fprintf (1, 'Number of function calls: %d', vnfevals); + end + else vhavestats = false; + end + + if (nargout == 1) %# Sort output variables, depends on nargout + varargout{1}.x = vretvaltime; %# Time stamps are saved in field x + varargout{1}.y = vretvalresult; %# Results are saved in field y + varargout{1}.solver = 'ode23d'; %# Solver name is saved in field solver + if (vhaveeventfunction) + varargout{1}.ie = vevent{2}; %# Index info which event occured + varargout{1}.xe = vevent{3}; %# Time info when an event occured + varargout{1}.ye = vevent{4}; %# Results when an event occured + end + if (vhavestats) + varargout{1}.stats = struct; + varargout{1}.stats.nsteps = vnsteps; + varargout{1}.stats.nfailed = vnfailed; + varargout{1}.stats.nfevals = vnfevals; + varargout{1}.stats.npds = vnpds; + varargout{1}.stats.ndecomps = vndecomps; + varargout{1}.stats.nlinsols = vnlinsols; + end + elseif (nargout == 2) + varargout{1} = vretvaltime; %# Time stamps are first output argument + varargout{2} = vretvalresult; %# Results are second output argument + elseif (nargout == 5) + varargout{1} = vretvaltime; %# Same as (nargout == 2) + varargout{2} = vretvalresult; %# Same as (nargout == 2) + varargout{3} = []; %# LabMat doesn't accept lines like + varargout{4} = []; %# varargout{3} = varargout{4} = []; + varargout{5} = []; + if (vhaveeventfunction) + varargout{3} = vevent{3}; %# Time info when an event occured + varargout{4} = vevent{4}; %# Results when an event occured + varargout{5} = vevent{2}; %# Index info which event occured + end + %# else nothing will be returned, varargout{1} undefined + end + +%! # We are using a "pseudo-DDE" implementation for all tests that +%! # are done for this function. We also define an Events and a +%! # pseudo-Mass implementation. For further tests we also define a +%! # reference solution (computed at high accuracy) and an OutputFcn. +%!function [vyd] = fexp (vt, vy, vz, varargin) +%! vyd(1,1) = exp (- vt) - vz(1); %# The DDEs that are +%! vyd(2,1) = vy(1) - vz(2); %# used for all examples +%!function [vval, vtrm, vdir] = feve (vt, vy, vz, varargin) +%! vval = fexp (vt, vy, vz); %# We use the derivatives +%! vtrm = zeros (2,1); %# don't stop solving here +%! vdir = ones (2,1); %# in positive direction +%!function [vval, vtrm, vdir] = fevn (vt, vy, vz, varargin) +%! vval = fexp (vt, vy, vz); %# We use the derivatives +%! vtrm = ones (2,1); %# stop solving here +%! vdir = ones (2,1); %# in positive direction +%!function [vmas] = fmas (vt, vy, vz, varargin) +%! vmas = [1, 0; 0, 1]; %# Dummy mass matrix for tests +%!function [vmas] = fmsa (vt, vy, vz, varargin) +%! vmas = sparse ([1, 0; 0, 1]); %# A dummy sparse matrix +%!function [vref] = fref () %# The reference solution +%! vref = [0.12194462133618, 0.01652432423938]; +%!function [vout] = fout (vt, vy, vflag, varargin) +%! if (regexp (char (vflag), 'init') == 1) +%! if (any (size (vt) ~= [2, 1])) error ('"fout" step "init"'); end +%! elseif (isempty (vflag)) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "calc"'); end +%! vout = false; +%! elseif (regexp (char (vflag), 'done') == 1) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "done"'); end +%! else error ('"fout" invalid vflag'); +%! end +%! +%! %# Turn off output of warning messages for all tests, turn them on +%! %# again if the last test is called +%!error %# input argument number one +%! warning ('off', 'OdePkg:InvalidOption'); +%! B = ode23d (1, [0 5], [1; 0], 1, [1; 0]); +%!error %# input argument number two +%! B = ode23d (@fexp, 1, [1; 0], 1, [1; 0]); +%!error %# input argument number three +%! B = ode23d (@fexp, [0 5], 1, 1, [1; 0]); +%!error %# input argument number four +%! B = ode23d (@fexp, [0 5], [1; 0], [1; 1], [1; 0]); +%!error %# input argument number five +%! B = ode23d (@fexp, [0 5], [1; 0], 1, 1); +%!test %# one output argument +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%! assert (isfield (vsol, 'solver')); +%! assert (vsol.solver, 'ode23d'); +%!test %# two output arguments +%! [vt, vy] = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vt(end), vy(end,:)], [5, fref], 1e-1); +%!test %# five output arguments and no Events +%! [vt, vy, vxe, vye, vie] = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vt(end), vy(end,:)], [5, fref], 1e-1); +%! assert ([vie, vxe, vye], []); +%!test %# anonymous function instead of real function +%! faym = @(vt, vy, vz) [exp(-vt) - vz(1); vy(1) - vz(2)]; +%! vsol = ode23d (faym, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# extra input arguments passed trhough +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# empty OdePkg structure *but* extra input arguments +%! vopt = odeset; +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt, 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!error %# strange OdePkg structure +%! vopt = struct ('foo', 1); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%!test %# AbsTol option +%! vopt = odeset ('AbsTol', 1e-5); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# AbsTol and RelTol option +%! vopt = odeset ('AbsTol', 1e-7, 'RelTol', 1e-7); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# RelTol and NormControl option +%! vopt = odeset ('AbsTol', 1e-7, 'NormControl', 'on'); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], .5e-1); +%!test %# NonNegative for second component +%! vopt = odeset ('NonNegative', 1); +%! vsol = ode23d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2.5, 0.001, 0.237], 1e-1); +%!test %# Details of OutputSel and Refine can't be tested +%! vopt = odeset ('OutputFcn', @fout, 'OutputSel', 1, 'Refine', 5); +%! vsol = ode23d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt); +%!test %# Stats must add further elements in vsol +%! vopt = odeset ('Stats', 'on'); +%! vsol = ode23d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt); +%! assert (isfield (vsol, 'stats')); +%! assert (isfield (vsol.stats, 'nsteps')); +%!test %# InitialStep option +%! vopt = odeset ('InitialStep', 1e-8); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# MaxStep option +%! vopt = odeset ('MaxStep', 1e-2); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# Events option add further elements in vsol +%! vopt = odeset ('Events', @feve); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert (isfield (vsol, 'ie')); +%! assert (vsol.ie, [1; 1]); +%! assert (isfield (vsol, 'xe')); +%! assert (isfield (vsol, 'ye')); +%!test %# Events option, now stop integration +%! warning ('off', 'OdePkg:HideWarning'); +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.ie, vsol.xe, vsol.ye], ... +%! [1.0000, 2.9219, -0.2127, -0.2671], 1e-1); +%!test %# Events option, five output arguments +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! [vt, vy, vxe, vye, vie] = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vie, vxe, vye], ... +%! [1.0000, 2.9219, -0.2127, -0.2671], 1e-1); +%! +%! %# test for Jacobian option is missing +%! %# test for Jacobian (being a sparse matrix) is missing +%! %# test for JPattern option is missing +%! %# test for Vectorized option is missing +%! %# test for NewtonTol option is missing +%! %# test for MaxNewtonIterations option is missing +%! +%!test %# Mass option as function +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# Mass option as matrix +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# Mass option as sparse matrix +%! vopt = odeset ('Mass', sparse (eye (2,2))); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# Mass option as function and sparse matrix +%! vopt = odeset ('Mass', @fmsa); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# Mass option as function and MStateDependence +%! vopt = odeset ('Mass', @fmas, 'MStateDependence', 'strong'); +%! vsol = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# Set BDF option to something else than default +%! vopt = odeset ('BDF', 'on'); +%! [vt, vy] = ode23d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vt(end), vy(end,:)], [5, fref], 0.5); +%! +%! %# test for MvPattern option is missing +%! %# test for InitialSlope option is missing +%! %# test for MaxOrder option is missing +%! +%! warning ('on', 'OdePkg:InvalidOption'); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/ode45.m b/octave_packages/odepkg-0.8.2/ode45.m new file mode 100644 index 0000000..7d8f49f --- /dev/null +++ b/octave_packages/odepkg-0.8.2/ode45.m @@ -0,0 +1,757 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} ode45 (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{sol}] =} ode45 (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{t}, @var{y}, [@var{xe}, @var{ye}, @var{ie}]] =} ode45 (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# +%# This function file can be used to solve a set of non--stiff ordinary differential equations (non--stiff ODEs) or non--stiff differential algebraic equations (non--stiff DAEs) with the well known explicit Runge--Kutta method of order (4,5). +%# +%# If this function is called with no return argument then plot the solution over time in a figure window while solving the set of ODEs that are defined in a function and specified by the function handle @var{@@fun}. The second input argument @var{slot} is a double vector that defines the time slot, @var{init} is a double vector that defines the initial values of the states, @var{opt} can optionally be a structure array that keeps the options created with the command @command{odeset} and @var{par1}, @var{par2}, @dots{} can optionally be other input arguments of any type that have to be passed to the function defined by @var{@@fun}. +%# +%# If this function is called with one return argument then return the solution @var{sol} of type structure array after solving the set of ODEs. The solution @var{sol} has the fields @var{x} of type double column vector for the steps chosen by the solver, @var{y} of type double column vector for the solutions at each time step of @var{x}, @var{solver} of type string for the solver name and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector that keep the informations of the event function if an event function handle is set in the option argument @var{opt}. +%# +%# If this function is called with more than one return argument then return the time stamps @var{t}, the solution values @var{y} and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector. +%# +%# For example, solve an anonymous implementation of the Van der Pol equation +%# +%# @example +%# fvdb = @@(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%# +%# vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ +%# "NormControl", "on", "OutputFcn", @@odeplot); +%# ode45 (fvdb, [0 20], [2 0], vopt); +%# @end example +%# @end deftypefn +%# +%# @seealso{odepkg} + +%# ChangeLog: +%# 20010703 the function file "ode45.m" was written by Marc Compere +%# under the GPL for the use with this software. This function has been +%# taken as a base for the following implementation. +%# 20060810, Thomas Treichl +%# This function was adapted to the new syntax that is used by the +%# new OdePkg for Octave and is compatible to Matlab's ode45. + +function [varargout] = ode45 (vfun, vslot, vinit, varargin) + + if (nargin == 0) %# Check number and types of all input arguments + help ('ode45'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be greater than zero'); + + elseif (nargin < 3) + print_usage; + + elseif ~(isa (vfun, 'function_handle') || isa (vfun, 'inline')) + error ('OdePkg:InvalidArgument', ... + 'First input argument must be a valid function handle'); + + elseif (~isvector (vslot) || length (vslot) < 2) + error ('OdePkg:InvalidArgument', ... + 'Second input argument must be a valid vector'); + + elseif (~isvector (vinit) || ~isnumeric (vinit)) + error ('OdePkg:InvalidArgument', ... + 'Third input argument must be a valid numerical value'); + + elseif (nargin >= 4) + + if (~isstruct (varargin{1})) + %# varargin{1:len} are parameters for vfun + vodeoptions = odeset; + vfunarguments = varargin; + + elseif (length (varargin) > 1) + %# varargin{1} is an OdePkg options structure vopt + vodeoptions = odepkg_structure_check (varargin{1}, 'ode45'); + vfunarguments = {varargin{2:length(varargin)}}; + + else %# if (isstruct (varargin{1})) + vodeoptions = odepkg_structure_check (varargin{1}, 'ode45'); + vfunarguments = {}; + + end + + else %# if (nargin == 3) + vodeoptions = odeset; + vfunarguments = {}; + end + + %# Start preprocessing, have a look which options are set in + %# vodeoptions, check if an invalid or unused option is set + vslot = vslot(:).'; %# Create a row vector + vinit = vinit(:).'; %# Create a row vector + if (length (vslot) > 2) %# Step size checking + vstepsizefixed = true; + else + vstepsizefixed = false; + end + + %# Get the default options that can be set with 'odeset' temporarily + vodetemp = odeset; + + %# Implementation of the option RelTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.RelTol) && ~vstepsizefixed) + vodeoptions.RelTol = 1e-6; + warning ('OdePkg:InvalidArgument', ... + 'Option "RelTol" not set, new value %f is used', vodeoptions.RelTol); + elseif (~isempty (vodeoptions.RelTol) && vstepsizefixed) + warning ('OdePkg:InvalidArgument', ... + 'Option "RelTol" will be ignored if fixed time stamps are given'); + end + + %# Implementation of the option AbsTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.AbsTol) && ~vstepsizefixed) + vodeoptions.AbsTol = 1e-6; + warning ('OdePkg:InvalidArgument', ... + 'Option "AbsTol" not set, new value %f is used', vodeoptions.AbsTol); + elseif (~isempty (vodeoptions.AbsTol) && vstepsizefixed) + warning ('OdePkg:InvalidArgument', ... + 'Option "AbsTol" will be ignored if fixed time stamps are given'); + else + vodeoptions.AbsTol = vodeoptions.AbsTol(:); %# Create column vector + end + + %# Implementation of the option NormControl has been finished. This + %# option can be set by the user to another value than default value. + if (strcmp (vodeoptions.NormControl, 'on')) vnormcontrol = true; + else vnormcontrol = false; end + + %# Implementation of the option NonNegative has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.NonNegative)) + if (isempty (vodeoptions.Mass)), vhavenonnegative = true; + else + vhavenonnegative = false; + warning ('OdePkg:InvalidArgument', ... + 'Option "NonNegative" will be ignored if mass matrix is set'); + end + else vhavenonnegative = false; + end + + %# Implementation of the option OutputFcn has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputFcn) && nargout == 0) + vodeoptions.OutputFcn = @odeplot; + vhaveoutputfunction = true; + elseif (isempty (vodeoptions.OutputFcn)), vhaveoutputfunction = false; + else vhaveoutputfunction = true; + end + + %# Implementation of the option OutputSel has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.OutputSel)), vhaveoutputselection = true; + else vhaveoutputselection = false; end + + %# Implementation of the option OutputSave has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputSave)), vodeoptions.OutputSave = 1; + end + + %# Implementation of the option Refine has been finished. This option + %# can be set by the user to another value than default value. + if (vodeoptions.Refine > 0), vhaverefine = true; + else vhaverefine = false; end + + %# Implementation of the option Stats has been finished. This option + %# can be set by the user to another value than default value. + + %# Implementation of the option InitialStep has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.InitialStep) && ~vstepsizefixed) + vodeoptions.InitialStep = (vslot(1,2) - vslot(1,1)) / 10; + vodeoptions.InitialStep = vodeoptions.InitialStep / 10^vodeoptions.Refine; + warning ('OdePkg:InvalidArgument', ... + 'Option "InitialStep" not set, new value %f is used', vodeoptions.InitialStep); + end + + %# Implementation of the option MaxStep has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.MaxStep) && ~vstepsizefixed) + vodeoptions.MaxStep = abs (vslot(1,2) - vslot(1,1)) / 10; + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxStep" not set, new value %f is used', vodeoptions.MaxStep); + end + + %# Implementation of the option Events has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Events)), vhaveeventfunction = true; + else vhaveeventfunction = false; end + + %# The options 'Jacobian', 'JPattern' and 'Vectorized' will be ignored + %# by this solver because this solver uses an explicit Runge-Kutta + %# method and therefore no Jacobian calculation is necessary + if (~isequal (vodeoptions.Jacobian, vodetemp.Jacobian)) + warning ('OdePkg:InvalidArgument', ... + 'Option "Jacobian" will be ignored by this solver'); + end + if (~isequal (vodeoptions.JPattern, vodetemp.JPattern)) + warning ('OdePkg:InvalidArgument', ... + 'Option "JPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.Vectorized, vodetemp.Vectorized)) + warning ('OdePkg:InvalidArgument', ... + 'Option "Vectorized" will be ignored by this solver'); + end + if (~isequal (vodeoptions.NewtonTol, vodetemp.NewtonTol)) + warning ('OdePkg:InvalidArgument', ... + 'Option "NewtonTol" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxNewtonIterations,... + vodetemp.MaxNewtonIterations)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxNewtonIterations" will be ignored by this solver'); + end + + %# Implementation of the option Mass has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Mass) && isnumeric (vodeoptions.Mass)) + vhavemasshandle = false; vmass = vodeoptions.Mass; %# constant mass + elseif (isa (vodeoptions.Mass, 'function_handle')) + vhavemasshandle = true; %# mass defined by a function handle + else %# no mass matrix - creating a diag-matrix of ones for mass + vhavemasshandle = false; %# vmass = diag (ones (length (vinit), 1), 0); + end + + %# Implementation of the option MStateDependence has been finished. + %# This option can be set by the user to another value than default + %# value. + if (strcmp (vodeoptions.MStateDependence, 'none')) + vmassdependence = false; + else vmassdependence = true; + end + + %# Other options that are not used by this solver. Print a warning + %# message to tell the user that the option(s) is/are ignored. + if (~isequal (vodeoptions.MvPattern, vodetemp.MvPattern)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MvPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MassSingular, vodetemp.MassSingular)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MassSingular" will be ignored by this solver'); + end + if (~isequal (vodeoptions.InitialSlope, vodetemp.InitialSlope)) + warning ('OdePkg:InvalidArgument', ... + 'Option "InitialSlope" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxOrder, vodetemp.MaxOrder)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxOrder" will be ignored by this solver'); + end + if (~isequal (vodeoptions.BDF, vodetemp.BDF)) + warning ('OdePkg:InvalidArgument', ... + 'Option "BDF" will be ignored by this solver'); + end + + %# Starting the initialisation of the core solver ode45 + vtimestamp = vslot(1,1); %# timestamp = start time + vtimelength = length (vslot); %# length needed if fixed steps + vtimestop = vslot(1,vtimelength); %# stop time = last value + %# 20110611, reported by Nils Strunk + %# Make it possible to solve equations from negativ to zero, + %# eg. vres = ode45 (@(t,y) y, [-2 0], 2); + vdirection = sign (vtimestop - vtimestamp); %# Direction flag + + if (~vstepsizefixed) + if (sign (vodeoptions.InitialStep) == vdirection) + vstepsize = vodeoptions.InitialStep; + else %# Fix wrong direction of InitialStep. + vstepsize = - vodeoptions.InitialStep; + end + vminstepsize = (vtimestop - vtimestamp) / (1/eps); + else %# If step size is given then use the fixed time steps + vstepsize = vslot(1,2) - vslot(1,1); + vminstepsize = sign (vstepsize) * eps; + end + + vretvaltime = vtimestamp; %# first timestamp output + vretvalresult = vinit; %# first solution output + + %# Initialize the OutputFcn + if (vhaveoutputfunction) + if (vhaveoutputselection) vretout = vretvalresult(vodeoptions.OutputSel); + else vretout = vretvalresult; end + feval (vodeoptions.OutputFcn, vslot.', ... + vretout.', 'init', vfunarguments{:}); + end + + %# Initialize the EventFcn + if (vhaveeventfunction) + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vretvalresult.', 'init', vfunarguments{:}); + end + + vpow = 1/5; %# 20071016, reported by Luis Randez + va = [0, 0, 0, 0, 0; %# The Runge-Kutta-Fehlberg 4(5) coefficients + 1/4, 0, 0, 0, 0; %# Coefficients proved on 20060827 + 3/32, 9/32, 0, 0, 0; %# See p.91 in Ascher & Petzold + 1932/2197, -7200/2197, 7296/2197, 0, 0; + 439/216, -8, 3680/513, -845/4104, 0; + -8/27, 2, -3544/2565, 1859/4104, -11/40]; + %# 4th and 5th order b-coefficients + vb4 = [25/216; 0; 1408/2565; 2197/4104; -1/5; 0]; + vb5 = [16/135; 0; 6656/12825; 28561/56430; -9/50; 2/55]; + vc = sum (va, 2); + + %# The solver main loop - stop if the endpoint has been reached + vcntloop = 2; vcntcycles = 1; vu = vinit; vk = vu.' * zeros(1,6); + vcntiter = 0; vunhandledtermination = true; vcntsave = 2; + while ((vdirection * (vtimestamp) < vdirection * (vtimestop)) && ... + (vdirection * (vstepsize) >= vdirection * (vminstepsize))) + + %# Hit the endpoint of the time slot exactely + if (vdirection * (vtimestamp + vstepsize) > vdirection * vtimestop) + %# vstepsize = vtimestop - vdirection * vtimestamp; + %# 20110611, reported by Nils Strunk + %# The endpoint of the time slot must be hit exactly, + %# eg. vsol = ode45 (@(t,y) y, [0 -1], 1); + vstepsize = vdirection * abs (abs (vtimestop) - abs (vtimestamp)); + end + + %# Estimate the six results when using this solver + for j = 1:6 + vthetime = vtimestamp + vc(j,1) * vstepsize; + vtheinput = vu.' + vstepsize * vk(:,1:j-1) * va(j,1:j-1).'; + if (vhavemasshandle) %# Handle only the dynamic mass matrix, + if (vmassdependence) %# constant mass matrices have already + vmass = feval ... %# been set before (if any) + (vodeoptions.Mass, vthetime, vtheinput, vfunarguments{:}); + else %# if (vmassdependence == false) + vmass = feval ... %# then we only have the time argument + (vodeoptions.Mass, vthetime, vfunarguments{:}); + end + vk(:,j) = vmass \ feval ... + (vfun, vthetime, vtheinput, vfunarguments{:}); + else + vk(:,j) = feval ... + (vfun, vthetime, vtheinput, vfunarguments{:}); + end + end + + %# Compute the 4th and the 5th order estimation + y4 = vu.' + vstepsize * (vk * vb4); + y5 = vu.' + vstepsize * (vk * vb5); + if (vhavenonnegative) + vu(vodeoptions.NonNegative) = abs (vu(vodeoptions.NonNegative)); + y4(vodeoptions.NonNegative) = abs (y4(vodeoptions.NonNegative)); + y5(vodeoptions.NonNegative) = abs (y5(vodeoptions.NonNegative)); + end + if (vhaveoutputfunction && vhaverefine) + vSaveVUForRefine = vu; + end + + %# Calculate the absolute local truncation error and the acceptable error + if (~vstepsizefixed) + if (~vnormcontrol) + vdelta = abs (y5 - y4); + vtau = max (vodeoptions.RelTol * abs (vu.'), vodeoptions.AbsTol); + else + vdelta = norm (y5 - y4, Inf); + vtau = max (vodeoptions.RelTol * max (norm (vu.', Inf), 1.0), ... + vodeoptions.AbsTol); + end + else %# if (vstepsizefixed == true) + vdelta = 1; vtau = 2; + end + + %# If the error is acceptable then update the vretval variables + if (all (vdelta <= vtau)) + vtimestamp = vtimestamp + vstepsize; + vu = y5.'; %# MC2001: the higher order estimation as "local extrapolation" + %# Save the solution every vodeoptions.OutputSave steps + if (mod (vcntloop-1,vodeoptions.OutputSave) == 0) + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu; + vcntsave = vcntsave + 1; + end + vcntloop = vcntloop + 1; vcntiter = 0; + + %# Call plot only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if plot function + %# returns false + if (vhaveoutputfunction) + for vcnt = 0:vodeoptions.Refine %# Approximation between told and t + if (vhaverefine) %# Do interpolation + vapproxtime = (vcnt + 1) * vstepsize / (vodeoptions.Refine + 2); + vapproxvals = vSaveVUForRefine.' + vapproxtime * (vk * vb5); + vapproxtime = (vtimestamp - vstepsize) + vapproxtime; + else + vapproxvals = vu.'; + vapproxtime = vtimestamp; + end + if (vhaveoutputselection) + vapproxvals = vapproxvals(vodeoptions.OutputSel); + end + vpltret = feval (vodeoptions.OutputFcn, vapproxtime, ... + vapproxvals, [], vfunarguments{:}); + if vpltret %# Leave refinement loop + break; + end + end + if (vpltret) %# Leave main loop + vunhandledtermination = false; + break; + end + end + + %# Call event only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if veventbreak is + %# true + if (vhaveeventfunction) + vevent = ... + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vu(:), [], vfunarguments{:}); + if (~isempty (vevent{1}) && vevent{1} == 1) + vretvaltime(vcntloop-1,:) = vevent{3}(end,:); + vretvalresult(vcntloop-1,:) = vevent{4}(end,:); + vunhandledtermination = false; break; + end + end + end %# If the error is acceptable ... + + %# Update the step size for the next integration step + if (~vstepsizefixed) + %# 20080425, reported by Marco Caliari + %# vdelta cannot be negative (because of the absolute value that + %# has been introduced) but it could be 0, then replace the zeros + %# with the maximum value of vdelta + vdelta(find (vdelta == 0)) = max (vdelta); + %# It could happen that max (vdelta) == 0 (ie. that the original + %# vdelta was 0), in that case we double the previous vstepsize + vdelta(find (vdelta == 0)) = max (vtau) .* (0.4 ^ (1 / vpow)); + + if (vdirection == 1) + vstepsize = min (vodeoptions.MaxStep, ... + min (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + else + vstepsize = max (- vodeoptions.MaxStep, ... + max (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + end + + else %# if (vstepsizefixed) + if (vcntloop <= vtimelength) + vstepsize = vslot(vcntloop) - vslot(vcntloop-1); + else %# Get out of the main integration loop + break; + end + end + + %# Update counters that count the number of iteration cycles + vcntcycles = vcntcycles + 1; %# Needed for cost statistics + vcntiter = vcntiter + 1; %# Needed to find iteration problems + + %# Stop solving because the last 1000 steps no successful valid + %# value has been found + if (vcntiter >= 5000) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f before endpoint at', ... + ' tend = %f was reached. This happened because the iterative', ... + ' integration loop does not find a valid solution at this time', ... + ' stamp. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + end + + end %# The main loop + + %# Check if integration of the ode has been successful + if (vdirection * vtimestamp < vdirection * vtimestop) + if (vunhandledtermination == true) + error ('OdePkg:InvalidArgument', ... + ['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f', ... + ' before endpoint at tend = %f was reached. This may', ... + ' happen if the stepsize grows smaller than defined in', ... + ' vminstepsize. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + else + warning ('OdePkg:InvalidArgument', ... + ['Solver has been stopped by a call of "break" in', ... + ' the main iteration loop at time t = %f before endpoint at', ... + ' tend = %f was reached. This may happen because the @odeplot', ... + ' function returned "true" or the @event function returned "true".'], ... + vtimestamp, vtimestop); + end + end + + %# Postprocessing, do whatever when terminating integration algorithm + if (vhaveoutputfunction) %# Cleanup plotter + feval (vodeoptions.OutputFcn, vtimestamp, ... + vu.', 'done', vfunarguments{:}); + end + if (vhaveeventfunction) %# Cleanup event function handling + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vu.', 'done', vfunarguments{:}); + end + %# Save the last step, if not already saved + if (mod (vcntloop-2,vodeoptions.OutputSave) ~= 0) + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu; + end + + %# Print additional information if option Stats is set + if (strcmp (vodeoptions.Stats, 'on')) + vhavestats = true; + vnsteps = vcntloop-2; %# vcntloop from 2..end + vnfailed = (vcntcycles-1)-(vcntloop-2)+1; %# vcntcycl from 1..end + vnfevals = 6*(vcntcycles-1); %# number of ode evaluations + vndecomps = 0; %# number of LU decompositions + vnpds = 0; %# number of partial derivatives + vnlinsols = 0; %# no. of solutions of linear systems + %# Print cost statistics if no output argument is given + if (nargout == 0) + vmsg = fprintf (1, 'Number of successful steps: %d\n', vnsteps); + vmsg = fprintf (1, 'Number of failed attempts: %d\n', vnfailed); + vmsg = fprintf (1, 'Number of function calls: %d\n', vnfevals); + end + else + vhavestats = false; + end + + if (nargout == 1) %# Sort output variables, depends on nargout + varargout{1}.x = vretvaltime; %# Time stamps are saved in field x + varargout{1}.y = vretvalresult; %# Results are saved in field y + varargout{1}.solver = 'ode45'; %# Solver name is saved in field solver + if (vhaveeventfunction) + varargout{1}.ie = vevent{2}; %# Index info which event occured + varargout{1}.xe = vevent{3}; %# Time info when an event occured + varargout{1}.ye = vevent{4}; %# Results when an event occured + end + if (vhavestats) + varargout{1}.stats = struct; + varargout{1}.stats.nsteps = vnsteps; + varargout{1}.stats.nfailed = vnfailed; + varargout{1}.stats.nfevals = vnfevals; + varargout{1}.stats.npds = vnpds; + varargout{1}.stats.ndecomps = vndecomps; + varargout{1}.stats.nlinsols = vnlinsols; + end + elseif (nargout == 2) + varargout{1} = vretvaltime; %# Time stamps are first output argument + varargout{2} = vretvalresult; %# Results are second output argument + elseif (nargout == 5) + varargout{1} = vretvaltime; %# Same as (nargout == 2) + varargout{2} = vretvalresult; %# Same as (nargout == 2) + varargout{3} = []; %# LabMat doesn't accept lines like + varargout{4} = []; %# varargout{3} = varargout{4} = []; + varargout{5} = []; + if (vhaveeventfunction) + varargout{3} = vevent{3}; %# Time info when an event occured + varargout{4} = vevent{4}; %# Results when an event occured + varargout{5} = vevent{2}; %# Index info which event occured + end + end +end + +%! # We are using the "Van der Pol" implementation for all tests that +%! # are done for this function. We also define a Jacobian, Events, +%! # pseudo-Mass implementation. For further tests we also define a +%! # reference solution (computed at high accuracy) and an OutputFcn +%!function [ydot] = fpol (vt, vy, varargin) %# The Van der Pol +%! ydot = [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%!function [vjac] = fjac (vt, vy, varargin) %# its Jacobian +%! vjac = [0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]; +%!function [vjac] = fjcc (vt, vy, varargin) %# sparse type +%! vjac = sparse ([0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]); +%!function [vval, vtrm, vdir] = feve (vt, vy, varargin) +%! vval = fpol (vt, vy, varargin); %# We use the derivatives +%! vtrm = zeros (2,1); %# that's why component 2 +%! vdir = ones (2,1); %# seems to not be exact +%!function [vval, vtrm, vdir] = fevn (vt, vy, varargin) +%! vval = fpol (vt, vy, varargin); %# We use the derivatives +%! vtrm = ones (2,1); %# that's why component 2 +%! vdir = ones (2,1); %# seems to not be exact +%!function [vmas] = fmas (vt, vy) +%! vmas = [1, 0; 0, 1]; %# Dummy mass matrix for tests +%!function [vmas] = fmsa (vt, vy) +%! vmas = sparse ([1, 0; 0, 1]); %# A sparse dummy matrix +%!function [vref] = fref () %# The computed reference sol +%! vref = [0.32331666704577, -1.83297456798624]; +%!function [vout] = fout (vt, vy, vflag, varargin) +%! if (regexp (char (vflag), 'init') == 1) +%! if (any (size (vt) ~= [2, 1])) error ('"fout" step "init"'); end +%! elseif (isempty (vflag)) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "calc"'); end +%! vout = false; +%! elseif (regexp (char (vflag), 'done') == 1) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "done"'); end +%! else error ('"fout" invalid vflag'); +%! end +%! +%! %# Turn off output of warning messages for all tests, turn them on +%! %# again if the last test is called +%!error %# input argument number one +%! warning ('off', 'OdePkg:InvalidArgument'); +%! B = ode45 (1, [0 25], [3 15 1]); +%!error %# input argument number two +%! B = ode45 (@fpol, 1, [3 15 1]); +%!error %# input argument number three +%! B = ode45 (@flor, [0 25], 1); +%!test %# one output argument +%! vsol = ode45 (@fpol, [0 2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%! assert (isfield (vsol, 'solver')); +%! assert (vsol.solver, 'ode45'); +%!test %# two output arguments +%! [vt, vy] = ode45 (@fpol, [0 2], [2 0]); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%!test %# five output arguments and no Events +%! [vt, vy, vxe, vye, vie] = ode45 (@fpol, [0 2], [2 0]); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%! assert ([vie, vxe, vye], []); +%!test %# anonymous function instead of real function +%! fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%! vsol = ode45 (fvdb, [0 2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# extra input arguments passed through +%! vsol = ode45 (@fpol, [0 2], [2 0], 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# empty OdePkg structure *but* extra input arguments +%! vopt = odeset; +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt, 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!error %# strange OdePkg structure +%! vopt = struct ('foo', 1); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%!test %# Solve vdp in fixed step sizes +%! vsol = ode45 (@fpol, [0:0.1:2], [2 0]); +%! assert (vsol.x(:), [0:0.1:2]'); +%! assert (vsol.y(end,:), fref, 1e-3); +%!test %# Solve in backward direction starting at t=0 +%! vref = [-1.205364552835178, 0.951542399860817]; +%! vsol = ode45 (@fpol, [0 -2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [-2, vref], 1e-3); +%!test %# Solve in backward direction starting at t=2 +%! vref = [-1.205364552835178, 0.951542399860817]; +%! vsol = ode45 (@fpol, [2 -2], fref); +%! assert ([vsol.x(end), vsol.y(end,:)], [-2, vref], 1e-3); +%!test %# Solve another anonymous function in backward direction +%! vref = [-1, 0.367879437558975]; +%! vsol = ode45 (@(t,y) y, [0 -1], 1); +%! assert ([vsol.x(end), vsol.y(end,:)], vref, 1e-3); +%!test %# Solve another anonymous function below zero +%! vref = [0, 14.77810590694212]; +%! vsol = ode45 (@(t,y) y, [-2 0], 2); +%! assert ([vsol.x(end), vsol.y(end,:)], vref, 1e-3); +%!test %# AbsTol option +%! vopt = odeset ('AbsTol', 1e-5); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# AbsTol and RelTol option +%! vopt = odeset ('AbsTol', 1e-8, 'RelTol', 1e-8); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# RelTol and NormControl option -- higher accuracy +%! vopt = odeset ('RelTol', 1e-8, 'NormControl', 'on'); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-5); +%!test %# Keeps initial values while integrating +%! vopt = odeset ('NonNegative', 2); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, 2, 0], 0.5); +%!test %# Details of OutputSel and Refine can't be tested +%! vopt = odeset ('OutputFcn', @fout, 'OutputSel', 1, 'Refine', 5); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%!test %# Details of OutputSave can't be tested +%! vopt = odeset ('OutputSave', 1, 'OutputSel', 1); +%! vsla = ode45 (@fpol, [0 2], [2 0], vopt); +%! vopt = odeset ('OutputSave', 2); +%! vslb = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert (length (vsla.x) > length (vslb.x)) +%!test %# Stats must add further elements in vsol +%! vopt = odeset ('Stats', 'on'); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert (isfield (vsol, 'stats')); +%! assert (isfield (vsol.stats, 'nsteps')); +%!test %# InitialStep option +%! vopt = odeset ('InitialStep', 1e-8); +%! vsol = ode45 (@fpol, [0 0.2], [2 0], vopt); +%! assert ([vsol.x(2)-vsol.x(1)], [1e-8], 1e-9); +%!test %# MaxStep option +%! vopt = odeset ('MaxStep', 1e-2); +%! vsol = ode45 (@fpol, [0 0.2], [2 0], vopt); +%! assert ([vsol.x(5)-vsol.x(4)], [1e-2], 1e-3); +%!test %# Events option add further elements in vsol +%! vopt = odeset ('Events', @feve); +%! vsol = ode45 (@fpol, [0 10], [2 0], vopt); +%! assert (isfield (vsol, 'ie')); +%! assert (vsol.ie(1), 2); +%! assert (isfield (vsol, 'xe')); +%! assert (isfield (vsol, 'ye')); +%!test %# Events option, now stop integration +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! vsol = ode45 (@fpol, [0 10], [2 0], vopt); +%! assert ([vsol.ie, vsol.xe, vsol.ye], ... +%! [2.0, 2.496110, -0.830550, -2.677589], .5e-1); +%!test %# Events option, five output arguments +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! [vt, vy, vxe, vye, vie] = ode45 (@fpol, [0 10], [2 0], vopt); +%! assert ([vie, vxe, vye], ... +%! [2.0, 2.496110, -0.830550, -2.677589], 1e-1); +%!test %# Jacobian option +%! vopt = odeset ('Jacobian', @fjac); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Jacobian option and sparse return value +%! vopt = odeset ('Jacobian', @fjcc); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%! +%! %# test for JPattern option is missing +%! %# test for Vectorized option is missing +%! %# test for NewtonTol option is missing +%! %# test for MaxNewtonIterations option is missing +%! +%!test %# Mass option as function +%! vopt = odeset ('Mass', @fmas); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as matrix +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as sparse matrix +%! vopt = odeset ('Mass', sparse (eye (2,2))); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as function and sparse matrix +%! vopt = odeset ('Mass', @fmsa); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as function and MStateDependence +%! vopt = odeset ('Mass', @fmas, 'MStateDependence', 'strong'); +%! vsol = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Set BDF option to something else than default +%! vopt = odeset ('BDF', 'on'); +%! [vt, vy] = ode45 (@fpol, [0 2], [2 0], vopt); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%! +%! %# test for MvPattern option is missing +%! %# test for InitialSlope option is missing +%! %# test for MaxOrder option is missing +%! +%! warning ('on', 'OdePkg:InvalidArgument'); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** + diff --git a/octave_packages/odepkg-0.8.2/ode45d.m b/octave_packages/odepkg-0.8.2/ode45d.m new file mode 100644 index 0000000..023e879 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/ode45d.m @@ -0,0 +1,768 @@ +%# Copyright (C) 2008-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} ode45d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{sol}] =} ode45d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{t}, @var{y}, [@var{xe}, @var{ye}, @var{ie}]] =} ode45d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# +%# This function file can be used to solve a set of non--stiff delay differential equations (non--stiff DDEs) with a modified version of the well known explicit Runge--Kutta method of order (4,5). +%# +%# If this function is called with no return argument then plot the solution over time in a figure window while solving the set of DDEs that are defined in a function and specified by the function handle @var{@@fun}. The second input argument @var{slot} is a double vector that defines the time slot, @var{init} is a double vector that defines the initial values of the states, @var{lags} is a double vector that describes the lags of time, @var{hist} is a double matrix and describes the history of the DDEs, @var{opt} can optionally be a structure array that keeps the options created with the command @command{odeset} and @var{par1}, @var{par2}, @dots{} can optionally be other input arguments of any type that have to be passed to the function defined by @var{@@fun}. +%# +%# In other words, this function will solve a problem of the form +%# @example +%# dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), @dots{}))) +%# y(slot(1)) = init +%# y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), @dots{} +%# @end example +%# +%# If this function is called with one return argument then return the solution @var{sol} of type structure array after solving the set of DDEs. The solution @var{sol} has the fields @var{x} of type double column vector for the steps chosen by the solver, @var{y} of type double column vector for the solutions at each time step of @var{x}, @var{solver} of type string for the solver name and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector that keep the informations of the event function if an event function handle is set in the option argument @var{opt}. +%# +%# If this function is called with more than one return argument then return the time stamps @var{t}, the solution values @var{y} and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector. +%# +%# For example: +%# @itemize @minus +%# @item +%# the following code solves an anonymous implementation of a chaotic behavior +%# +%# @example +%# fcao = @@(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy]; +%# +%# vopt = odeset ("NormControl", "on", "RelTol", 1e-3); +%# vsol = ode45d (fcao, [0, 100], 0.5, 2, 0.5, vopt); +%# +%# vlag = interp1 (vsol.x, vsol.y, vsol.x - 2); +%# plot (vsol.y, vlag); legend ("fcao (t,y,z)"); +%# @end example +%# +%# @item +%# to solve the following problem with two delayed state variables +%# +%# @example +%# d y1(t)/dt = -y1(t) +%# d y2(t)/dt = -y2(t) + y1(t-5) +%# d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10) +%# @end example +%# +%# one might do the following +%# +%# @example +%# function f = fun (t, y, yd) +%# f(1) = -y(1); %% y1' = -y1(t) +%# f(2) = -y(2) + yd(1,1); %% y2' = -y2(t) + y1(t-lags(1)) +%# f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2)) +%# endfunction +%# T = [0,20] +%# res = ode45d (@@fun, T, [1;1;1], [5, 10], ones (3,2)); +%# @end example +%# +%# @end itemize +%# @end deftypefn +%# +%# @seealso{odepkg} + +function [varargout] = ode45d (vfun, vslot, vinit, vlags, vhist, varargin) + + if (nargin == 0) %# Check number and types of all input arguments + help ('ode45d'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be greater than zero'); + + elseif (nargin < 5) + print_usage; + + elseif (~isa (vfun, 'function_handle')) + error ('OdePkg:InvalidArgument', ... + 'First input argument must be a valid function handle'); + + elseif (~isvector (vslot) || length (vslot) < 2) + error ('OdePkg:InvalidArgument', ... + 'Second input argument must be a valid vector'); + + elseif (~isvector (vinit) || ~isnumeric (vinit)) + error ('OdePkg:InvalidArgument', ... + 'Third input argument must be a valid numerical value'); + + elseif (~isvector (vlags) || ~isnumeric (vlags)) + error ('OdePkg:InvalidArgument', ... + 'Fourth input argument must be a valid numerical value'); + + elseif ~(isnumeric (vhist) || isa (vhist, 'function_handle')) + error ('OdePkg:InvalidArgument', ... + 'Fifth input argument must either be numeric or a function handle'); + + elseif (nargin >= 6) + + if (~isstruct (varargin{1})) + %# varargin{1:len} are parameters for vfun + vodeoptions = odeset; + vfunarguments = varargin; + + elseif (length (varargin) > 1) + %# varargin{1} is an OdePkg options structure vopt + vodeoptions = odepkg_structure_check (varargin{1}, 'ode45d'); + vfunarguments = {varargin{2:length(varargin)}}; + + else %# if (isstruct (varargin{1})) + vodeoptions = odepkg_structure_check (varargin{1}, 'ode45d'); + vfunarguments = {}; + + end + + else %# if (nargin == 5) + vodeoptions = odeset; + vfunarguments = {}; + end + + %# Start preprocessing, have a look which options have been set in + %# vodeoptions. Check if an invalid or unused option has been set and + %# print warnings. + vslot = vslot(:)'; %# Create a row vector + vinit = vinit(:)'; %# Create a row vector + vlags = vlags(:)'; %# Create a row vector + + %# Check if the user has given fixed points of time + if (length (vslot) > 2), vstepsizegiven = true; %# Step size checking + else vstepsizegiven = false; end + + %# Get the default options that can be set with 'odeset' temporarily + vodetemp = odeset; + + %# Implementation of the option RelTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.RelTol) && ~vstepsizegiven) + vodeoptions.RelTol = 1e-6; + warning ('OdePkg:InvalidOption', ... + 'Option "RelTol" not set, new value %f is used', vodeoptions.RelTol); + elseif (~isempty (vodeoptions.RelTol) && vstepsizegiven) + warning ('OdePkg:InvalidOption', ... + 'Option "RelTol" will be ignored if fixed time stamps are given'); + %# This implementation has been added to odepkg_structure_check.m + %# elseif (~isscalar (vodeoptions.RelTol) && ~vstepsizegiven) + %# error ('OdePkg:InvalidOption', ... + %# 'Option "RelTol" must be set to a scalar value for this solver'); + end + + %# Implementation of the option AbsTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.AbsTol) && ~vstepsizegiven) + vodeoptions.AbsTol = 1e-6; + warning ('OdePkg:InvalidOption', ... + 'Option "AbsTol" not set, new value %f is used', vodeoptions.AbsTol); + elseif (~isempty (vodeoptions.AbsTol) && vstepsizegiven) + warning ('OdePkg:InvalidOption', ... + 'Option "AbsTol" will be ignored if fixed time stamps are given'); + else %# create column vector + vodeoptions.AbsTol = vodeoptions.AbsTol(:); + end + + %# Implementation of the option NormControl has been finished. This + %# option can be set by the user to another value than default value. + if (strcmp (vodeoptions.NormControl, 'on')), vnormcontrol = true; + else vnormcontrol = false; + end + + %# Implementation of the option NonNegative has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.NonNegative)) + if (isempty (vodeoptions.Mass)), vhavenonnegative = true; + else + vhavenonnegative = false; + warning ('OdePkg:InvalidOption', ... + 'Option "NonNegative" will be ignored if mass matrix is set'); + end + else vhavenonnegative = false; + end + + %# Implementation of the option OutputFcn has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputFcn) && nargout == 0) + vodeoptions.OutputFcn = @odeplot; + vhaveoutputfunction = true; + elseif (isempty (vodeoptions.OutputFcn)), vhaveoutputfunction = false; + else vhaveoutputfunction = true; + end + + %# Implementation of the option OutputSel has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.OutputSel)), vhaveoutputselection = true; + else vhaveoutputselection = false; end + + %# Implementation of the option Refine has been finished. This option + %# can be set by the user to another value than default value. + if (isequal (vodeoptions.Refine, vodetemp.Refine)), vhaverefine = true; + else vhaverefine = false; end + + %# Implementation of the option Stats has been finished. This option + %# can be set by the user to another value than default value. + + %# Implementation of the option InitialStep has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.InitialStep) && ~vstepsizegiven) + vodeoptions.InitialStep = abs (vslot(1,1) - vslot(1,2)) / 10; + vodeoptions.InitialStep = vodeoptions.InitialStep / 10^vodeoptions.Refine; + warning ('OdePkg:InvalidOption', ... + 'Option "InitialStep" not set, new value %f is used', vodeoptions.InitialStep); + end + + %# Implementation of the option MaxStep has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.MaxStep) && ~vstepsizegiven) + vodeoptions.MaxStep = abs (vslot(1,1) - vslot(1,length (vslot))) / 10; + %# vodeoptions.MaxStep = vodeoptions.MaxStep / 10^vodeoptions.Refine; + warning ('OdePkg:InvalidOption', ... + 'Option "MaxStep" not set, new value %f is used', vodeoptions.MaxStep); + end + + %# Implementation of the option Events has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Events)), vhaveeventfunction = true; + else vhaveeventfunction = false; end + + %# The options 'Jacobian', 'JPattern' and 'Vectorized' will be ignored + %# by this solver because this solver uses an explicit Runge-Kutta + %# method and therefore no Jacobian calculation is necessary + if (~isequal (vodeoptions.Jacobian, vodetemp.Jacobian)) + warning ('OdePkg:InvalidOption', ... + 'Option "Jacobian" will be ignored by this solver'); + end + if (~isequal (vodeoptions.JPattern, vodetemp.JPattern)) + warning ('OdePkg:InvalidOption', ... + 'Option "JPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.Vectorized, vodetemp.Vectorized)) + warning ('OdePkg:InvalidOption', ... + 'Option "Vectorized" will be ignored by this solver'); + end + if (~isequal (vodeoptions.NewtonTol, vodetemp.NewtonTol)) + warning ('OdePkg:InvalidArgument', ... + 'Option "NewtonTol" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxNewtonIterations,... + vodetemp.MaxNewtonIterations)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxNewtonIterations" will be ignored by this solver'); + end + + %# Implementation of the option Mass has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Mass) && isnumeric (vodeoptions.Mass)) + vhavemasshandle = false; vmass = vodeoptions.Mass; %# constant mass + elseif (isa (vodeoptions.Mass, 'function_handle')) + vhavemasshandle = true; %# mass defined by a function handle + else %# no mass matrix - creating a diag-matrix of ones for mass + vhavemasshandle = false; %# vmass = diag (ones (length (vinit), 1), 0); + end + + %# Implementation of the option MStateDependence has been finished. + %# This option can be set by the user to another value than default + %# value. + if (strcmp (vodeoptions.MStateDependence, 'none')) + vmassdependence = false; + else vmassdependence = true; + end + + %# Other options that are not used by this solver. Print a warning + %# message to tell the user that the option(s) is/are ignored. + if (~isequal (vodeoptions.MvPattern, vodetemp.MvPattern)) + warning ('OdePkg:InvalidOption', ... + 'Option "MvPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MassSingular, vodetemp.MassSingular)) + warning ('OdePkg:InvalidOption', ... + 'Option "MassSingular" will be ignored by this solver'); + end + if (~isequal (vodeoptions.InitialSlope, vodetemp.InitialSlope)) + warning ('OdePkg:InvalidOption', ... + 'Option "InitialSlope" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxOrder, vodetemp.MaxOrder)) + warning ('OdePkg:InvalidOption', ... + 'Option "MaxOrder" will be ignored by this solver'); + end + if (~isequal (vodeoptions.BDF, vodetemp.BDF)) + warning ('OdePkg:InvalidOption', ... + 'Option "BDF" will be ignored by this solver'); + end + + %# Starting the initialisation of the core solver ode45d + vtimestamp = vslot(1,1); %# timestamp = start time + vtimelength = length (vslot); %# length needed if fixed steps + vtimestop = vslot(1,vtimelength); %# stop time = last value + + if (~vstepsizegiven) + vstepsize = vodeoptions.InitialStep; + vminstepsize = (vtimestop - vtimestamp) / (1/eps); + else %# If step size is given then use the fixed time steps + vstepsize = abs (vslot(1,1) - vslot(1,2)); + vminstepsize = eps; %# vslot(1,2) - vslot(1,1) - eps; + end + + vretvaltime = vtimestamp; %# first timestamp output + if (vhaveoutputselection) %# first solution output + vretvalresult = vinit(vodeoptions.OutputSel); + else vretvalresult = vinit; + end + + %# Initialize the OutputFcn + if (vhaveoutputfunction) + feval (vodeoptions.OutputFcn, vslot', ... + vretvalresult', 'init', vfunarguments{:}); + end + + %# Initialize the History + if (isnumeric (vhist)) + vhmat = vhist; + vhavehistnumeric = true; + else %# it must be a function handle + for vcnt = 1:length (vlags); + vhmat(:,vcnt) = feval (vhist, (vslot(1)-vlags(vcnt)), vfunarguments{:}); + end + vhavehistnumeric = false; + end + + %# Initialize DDE variables for history calculation + vsaveddetime = [vtimestamp - vlags, vtimestamp]'; + vsaveddeinput = [vhmat, vinit']'; + vsavedderesult = [vhmat, vinit']'; + + %# Initialize the EventFcn + if (vhaveeventfunction) + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + {vretvalresult', vhmat}, 'init', vfunarguments{:}); + end + + vpow = 1/5; %# 20071016, reported by Luis Randez + va = [0, 0, 0, 0, 0; %# The Runge-Kutta-Fehlberg 4(5) coefficients + 1/4, 0, 0, 0, 0; %# Coefficients proved on 20060827 + 3/32, 9/32, 0, 0, 0; %# See p.91 in Ascher & Petzold + 1932/2197, -7200/2197, 7296/2197, 0, 0; + 439/216, -8, 3680/513, -845/4104, 0; + -8/27, 2, -3544/2565, 1859/4104, -11/40]; + %# 4th and 5th order b-coefficients + vb4 = [25/216; 0; 1408/2565; 2197/4104; -1/5; 0]; + vb5 = [16/135; 0; 6656/12825; 28561/56430; -9/50; 2/55]; + vc = sum (va, 2); + + %# The solver main loop - stop if endpoint has been reached + vcntloop = 2; vcntcycles = 1; vu = vinit; vk = vu' * zeros(1,6); + vcntiter = 0; vunhandledtermination = true; + while ((vtimestamp < vtimestop && vstepsize >= vminstepsize)) + + %# Hit the endpoint of the time slot exactely + if ((vtimestamp + vstepsize) > vtimestop) + vstepsize = vtimestop - vtimestamp; end + + %# Estimate the six results when using this solver + for j = 1:6 + vthetime = vtimestamp + vc(j,1) * vstepsize; + vtheinput = vu' + vstepsize * vk(:,1:j-1) * va(j,1:j-1)'; + %# Claculate the history values (or get them from an external + %# function) that are needed for the next step of solving + if (vhavehistnumeric) + for vcnt = 1:length (vlags) + %# Direct implementation of a 'quadrature cubic Hermite interpolation' + %# found at the Faculty for Mathematics of the University of Stuttgart + %# http://mo.mathematik.uni-stuttgart.de/inhalt/aussage/aussage1269 + vnumb = find (vthetime - vlags(vcnt) >= vsaveddetime); + velem = min (vnumb(end), length (vsaveddetime) - 1); + vstep = vsaveddetime(velem+1) - vsaveddetime(velem); + vdiff = (vthetime - vlags(vcnt) - vsaveddetime(velem)) / vstep; + vsubs = 1 - vdiff; + %# Calculation of the coefficients for the interpolation algorithm + vua = (1 + 2 * vdiff) * vsubs^2; + vub = (3 - 2 * vdiff) * vdiff^2; + vva = vstep * vdiff * vsubs^2; + vvb = -vstep * vsubs * vdiff^2; + vhmat(:,vcnt) = vua * vsaveddeinput(velem,:)' + ... + vub * vsaveddeinput(velem+1,:)' + ... + vva * vsavedderesult(velem,:)' + ... + vvb * vsavedderesult(velem+1,:)'; + end + else %# the history must be a function handle + for vcnt = 1:length (vlags) + vhmat(:,vcnt) = feval ... + (vhist, vthetime - vlags(vcnt), vfunarguments{:}); + end + end + + if (vhavemasshandle) %# Handle only the dynamic mass matrix, + if (vmassdependence) %# constant mass matrices have already + vmass = feval ... %# been set before (if any) + (vodeoptions.Mass, vthetime, vtheinput, vfunarguments{:}); + else %# if (vmassdependence == false) + vmass = feval ... %# then we only have the time argument + (vodeoptions.Mass, vthetime, vfunarguments{:}); + end + vk(:,j) = vmass \ feval ... + (vfun, vthetime, vtheinput, vhmat, vfunarguments{:}); + else + vk(:,j) = feval ... + (vfun, vthetime, vtheinput, vhmat, vfunarguments{:}); + end + end + + %# Compute the 4th and the 5th order estimation + y4 = vu' + vstepsize * (vk * vb4); + y5 = vu' + vstepsize * (vk * vb5); + if (vhavenonnegative) + vu(vodeoptions.NonNegative) = abs (vu(vodeoptions.NonNegative)); + y4(vodeoptions.NonNegative) = abs (y4(vodeoptions.NonNegative)); + y5(vodeoptions.NonNegative) = abs (y5(vodeoptions.NonNegative)); + end + vSaveVUForRefine = vu; + + %# Calculate the absolute local truncation error and the acceptable error + if (~vstepsizegiven) + if (~vnormcontrol) + vdelta = y5 - y4; + vtau = max (vodeoptions.RelTol * vu', vodeoptions.AbsTol); + else + vdelta = norm (y5 - y4, Inf); + vtau = max (vodeoptions.RelTol * max (norm (vu', Inf), 1.0), ... + vodeoptions.AbsTol); + end + else %# if (vstepsizegiven == true) + vdelta = 1; vtau = 2; + end + + %# If the error is acceptable then update the vretval variables + if (all (vdelta <= vtau)) + vtimestamp = vtimestamp + vstepsize; + vu = y5'; %# MC2001: the higher order estimation as "local extrapolation" + vretvaltime(vcntloop,:) = vtimestamp; + if (vhaveoutputselection) + vretvalresult(vcntloop,:) = vu(vodeoptions.OutputSel); + else + vretvalresult(vcntloop,:) = vu; + end + vcntloop = vcntloop + 1; vcntiter = 0; + + %# Update DDE values for next history calculation + vsaveddetime(end+1) = vtimestamp; + vsaveddeinput(end+1,:) = vtheinput'; + vsavedderesult(end+1,:) = vu; + + %# Call plot only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if plot function + %# returns false + if (vhaveoutputfunction) + if (vhaverefine) %# Do interpolation + for vcnt = 0:vodeoptions.Refine %# Approximation between told and t + vapproxtime = (vcnt + 1) * vstepsize / (vodeoptions.Refine + 2); + vapproxvals = vSaveVUForRefine' + vapproxtime * (vk * vb5); + if (vhaveoutputselection) + vapproxvals = vapproxvals(vodeoptions.OutputSel); + end + feval (vodeoptions.OutputFcn, (vtimestamp - vstepsize) + vapproxtime, ... + vapproxvals, [], vfunarguments{:}); + end + end + vpltret = feval (vodeoptions.OutputFcn, vtimestamp, ... + vretvalresult(vcntloop-1,:)', [], vfunarguments{:}); + if (vpltret), vunhandledtermination = false; break; end + end + + %# Call event only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if veventbreak is + %# true + if (vhaveeventfunction) + vevent = ... + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + {vu(:), vhmat}, [], vfunarguments{:}); + if (~isempty (vevent{1}) && vevent{1} == 1) + vretvaltime(vcntloop-1,:) = vevent{3}(end,:); + vretvalresult(vcntloop-1,:) = vevent{4}(end,:); + vunhandledtermination = false; break; + end + end + end %# If the error is acceptable ... + + %# Update the step size for the next integration step + if (~vstepsizegiven) + %# vdelta may be 0 or even negative - could be an iteration problem + vdelta = max (vdelta, eps); + vstepsize = min (vodeoptions.MaxStep, ... + min (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + elseif (vstepsizegiven) + if (vcntloop < vtimelength) + vstepsize = vslot(1,vcntloop-1) - vslot(1,vcntloop-2); + end + end + + %# Update counters that count the number of iteration cycles + vcntcycles = vcntcycles + 1; %# Needed for postprocessing + vcntiter = vcntiter + 1; %# Needed to find iteration problems + + %# Stop solving because the last 1000 steps no successful valid + %# value has been found + if (vcntiter >= 5000) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f before endpoint at', ... + ' tend = %f was reached. This happened because the iterative', ... + ' integration loop does not find a valid solution at this time', ... + ' stamp. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + end + + end %# The main loop + + %# Check if integration of the ode has been successful + if (vtimestamp < vtimestop) + if (vunhandledtermination == true) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f', ... + ' before endpoint at tend = %f was reached. This may', ... + ' happen if the stepsize grows smaller than defined in', ... + ' vminstepsize. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + else + warning ('OdePkg:HideWarning', ... + ['Solver has been stopped by a call of "break" in', ... + ' the main iteration loop at time t = %f before endpoint at', ... + ' tend = %f was reached. This may happen because the @odeplot', ... + ' function returned "true" or the @event function returned "true".'], ... + vtimestamp, vtimestop); + end + end + + %# Postprocessing, do whatever when terminating integration algorithm + if (vhaveoutputfunction) %# Cleanup plotter + feval (vodeoptions.OutputFcn, vtimestamp, ... + vretvalresult(vcntloop-1,:)', 'done', vfunarguments{:}); + end + if (vhaveeventfunction) %# Cleanup event function handling + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + {vretvalresult(vcntloop-1,:), vhmat}, 'done', vfunarguments{:}); + end + + %# Print additional information if option Stats is set + if (strcmp (vodeoptions.Stats, 'on')) + vhavestats = true; + vnsteps = vcntloop-2; %# vcntloop from 2..end + vnfailed = (vcntcycles-1)-(vcntloop-2)+1; %# vcntcycl from 1..end + vnfevals = 6*(vcntcycles-1); %# number of ode evaluations + vndecomps = 0; %# number of LU decompositions + vnpds = 0; %# number of partial derivatives + vnlinsols = 0; %# no. of solutions of linear systems + %# Print cost statistics if no output argument is given + if (nargout == 0) + vmsg = fprintf (1, 'Number of successful steps: %d', vnsteps); + vmsg = fprintf (1, 'Number of failed attempts: %d', vnfailed); + vmsg = fprintf (1, 'Number of function calls: %d', vnfevals); + end + else vhavestats = false; + end + + if (nargout == 1) %# Sort output variables, depends on nargout + varargout{1}.x = vretvaltime; %# Time stamps are saved in field x + varargout{1}.y = vretvalresult; %# Results are saved in field y + varargout{1}.solver = 'ode45d'; %# Solver name is saved in field solver + if (vhaveeventfunction) + varargout{1}.ie = vevent{2}; %# Index info which event occured + varargout{1}.xe = vevent{3}; %# Time info when an event occured + varargout{1}.ye = vevent{4}; %# Results when an event occured + end + if (vhavestats) + varargout{1}.stats = struct; + varargout{1}.stats.nsteps = vnsteps; + varargout{1}.stats.nfailed = vnfailed; + varargout{1}.stats.nfevals = vnfevals; + varargout{1}.stats.npds = vnpds; + varargout{1}.stats.ndecomps = vndecomps; + varargout{1}.stats.nlinsols = vnlinsols; + end + elseif (nargout == 2) + varargout{1} = vretvaltime; %# Time stamps are first output argument + varargout{2} = vretvalresult; %# Results are second output argument + elseif (nargout == 5) + varargout{1} = vretvaltime; %# Same as (nargout == 2) + varargout{2} = vretvalresult; %# Same as (nargout == 2) + varargout{3} = []; %# LabMat doesn't accept lines like + varargout{4} = []; %# varargout{3} = varargout{4} = []; + varargout{5} = []; + if (vhaveeventfunction) + varargout{3} = vevent{3}; %# Time info when an event occured + varargout{4} = vevent{4}; %# Results when an event occured + varargout{5} = vevent{2}; %# Index info which event occured + end + %# else nothing will be returned, varargout{1} undefined + end + +%! # We are using a "pseudo-DDE" implementation for all tests that +%! # are done for this function. We also define an Events and a +%! # pseudo-Mass implementation. For further tests we also define a +%! # reference solution (computed at high accuracy) and an OutputFcn. +%!function [vyd] = fexp (vt, vy, vz, varargin) +%! vyd(1,1) = exp (- vt) - vz(1); %# The DDEs that are +%! vyd(2,1) = vy(1) - vz(2); %# used for all examples +%!function [vval, vtrm, vdir] = feve (vt, vy, vz, varargin) +%! vval = fexp (vt, vy, vz); %# We use the derivatives +%! vtrm = zeros (2,1); %# don't stop solving here +%! vdir = ones (2,1); %# in positive direction +%!function [vval, vtrm, vdir] = fevn (vt, vy, vz, varargin) +%! vval = fexp (vt, vy, vz); %# We use the derivatives +%! vtrm = ones (2,1); %# stop solving here +%! vdir = ones (2,1); %# in positive direction +%!function [vmas] = fmas (vt, vy, vz, varargin) +%! vmas = [1, 0; 0, 1]; %# Dummy mass matrix for tests +%!function [vmas] = fmsa (vt, vy, vz, varargin) +%! vmas = sparse ([1, 0; 0, 1]); %# A dummy sparse matrix +%!function [vref] = fref () %# The reference solution +%! vref = [0.12194462133618, 0.01652432423938]; +%!function [vout] = fout (vt, vy, vflag, varargin) +%! if (regexp (char (vflag), 'init') == 1) +%! if (any (size (vt) ~= [2, 1])) error ('"fout" step "init"'); end +%! elseif (isempty (vflag)) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "calc"'); end +%! vout = false; +%! elseif (regexp (char (vflag), 'done') == 1) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "done"'); end +%! else error ('"fout" invalid vflag'); +%! end +%! +%! %# Turn off output of warning messages for all tests, turn them on +%! %# again if the last test is called +%!error %# input argument number one +%! warning ('off', 'OdePkg:InvalidOption'); +%! B = ode45d (1, [0 5], [1; 0], 1, [1; 0]); +%!error %# input argument number two +%! B = ode45d (@fexp, 1, [1; 0], 1, [1; 0]); +%!error %# input argument number three +%! B = ode45d (@fexp, [0 5], 1, 1, [1; 0]); +%!error %# input argument number four +%! B = ode45d (@fexp, [0 5], [1; 0], [1; 1], [1; 0]); +%!error %# input argument number five +%! B = ode45d (@fexp, [0 5], [1; 0], 1, 1); +%!test %# one output argument +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%! assert (isfield (vsol, 'solver')); +%! assert (vsol.solver, 'ode45d'); +%!test %# two output arguments +%! [vt, vy] = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vt(end), vy(end,:)], [5, fref], 0.5); +%!test %# five output arguments and no Events +%! [vt, vy, vxe, vye, vie] = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vt(end), vy(end,:)], [5, fref], 0.5); +%! assert ([vie, vxe, vye], []); +%!test %# anonymous function instead of real function +%! faym = @(vt, vy, vz) [exp(-vt) - vz(1); vy(1) - vz(2)]; +%! vsol = ode45d (faym, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%!test %# extra input arguments passed trhough +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%!test %# empty OdePkg structure *but* extra input arguments +%! vopt = odeset; +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt, 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%!error %# strange OdePkg structure +%! vopt = struct ('foo', 1); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%!test %# AbsTol option +%! vopt = odeset ('AbsTol', 1e-5); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%!test %# AbsTol and RelTol option +%! vopt = odeset ('AbsTol', 1e-7, 'RelTol', 1e-7); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%!test %# RelTol and NormControl option +%! vopt = odeset ('AbsTol', 1e-7, 'NormControl', 'on'); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], .5e-1); +%!test %# NonNegative for second component +%! vopt = odeset ('NonNegative', 1); +%! vsol = ode45d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2.5, 0.001, 0.237], 0.5); +%!test %# Details of OutputSel and Refine can't be tested +%! vopt = odeset ('OutputFcn', @fout, 'OutputSel', 1, 'Refine', 5); +%! vsol = ode45d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt); +%!test %# Stats must add further elements in vsol +%! vopt = odeset ('Stats', 'on'); +%! vsol = ode45d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt); +%! assert (isfield (vsol, 'stats')); +%! assert (isfield (vsol.stats, 'nsteps')); +%!test %# InitialStep option +%! vopt = odeset ('InitialStep', 1e-8); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%!test %# MaxStep option +%! vopt = odeset ('MaxStep', 1e-2); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%!test %# Events option add further elements in vsol +%! vopt = odeset ('Events', @feve); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert (isfield (vsol, 'ie')); +%! assert (vsol.ie, [1; 1]); +%! assert (isfield (vsol, 'xe')); +%! assert (isfield (vsol, 'ye')); +%!test %# Events option, now stop integration +%! warning ('off', 'OdePkg:HideWarning'); +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.ie, vsol.xe, vsol.ye], ... +%! [1.0000, 2.9219, -0.2127, -0.2671], 0.5); +%!test %# Events option, five output arguments +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! [vt, vy, vxe, vye, vie] = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vie, vxe, vye], ... +%! [1.0000, 2.9219, -0.2127, -0.2671], 0.5); +%! +%! %# test for Jacobian option is missing +%! %# test for Jacobian (being a sparse matrix) is missing +%! %# test for JPattern option is missing +%! %# test for Vectorized option is missing +%! %# test for NewtonTol option is missing +%! %# test for MaxNewtonIterations option is missing +%! +%!test %# Mass option as function +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%!test %# Mass option as matrix +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%!test %# Mass option as sparse matrix +%! vopt = odeset ('Mass', sparse (eye (2,2))); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%!test %# Mass option as function and sparse matrix +%! vopt = odeset ('Mass', @fmsa); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%!test %# Mass option as function and MStateDependence +%! vopt = odeset ('Mass', @fmas, 'MStateDependence', 'strong'); +%! vsol = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.5); +%!test %# Set BDF option to something else than default +%! vopt = odeset ('BDF', 'on'); +%! [vt, vy] = ode45d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vt(end), vy(end,:)], [5, fref], 0.5); +%! +%! %# test for MvPattern option is missing +%! %# test for InitialSlope option is missing +%! %# test for MaxOrder option is missing +%! +%! warning ('on', 'OdePkg:InvalidOption'); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/ode54.m b/octave_packages/odepkg-0.8.2/ode54.m new file mode 100644 index 0000000..cd37b59 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/ode54.m @@ -0,0 +1,793 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} ode54 (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{sol}] =} ode54 (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{t}, @var{y}, [@var{xe}, @var{ye}, @var{ie}]] =} ode54 (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# +%# This function file can be used to solve a set of non--stiff ordinary differential equations (non--stiff ODEs) or non--stiff differential algebraic equations (non--stiff DAEs) with the well known explicit Runge--Kutta method of order (5,4). +%# +%# If this function is called with no return argument then plot the solution over time in a figure window while solving the set of ODEs that are defined in a function and specified by the function handle @var{@@fun}. The second input argument @var{slot} is a double vector that defines the time slot, @var{init} is a double vector that defines the initial values of the states, @var{opt} can optionally be a structure array that keeps the options created with the command @command{odeset} and @var{par1}, @var{par2}, @dots{} can optionally be other input arguments of any type that have to be passed to the function defined by @var{@@fun}. +%# +%# If this function is called with one return argument then return the solution @var{sol} of type structure array after solving the set of ODEs. The solution @var{sol} has the fields @var{x} of type double column vector for the steps chosen by the solver, @var{y} of type double column vector for the solutions at each time step of @var{x}, @var{solver} of type string for the solver name and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector that keep the informations of the event function if an event function handle is set in the option argument @var{opt}. +%# +%# If this function is called with more than one return argument then return the time stamps @var{t}, the solution values @var{y} and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector. +%# +%# For example, solve an anonymous implementation of the Van der Pol equation +%# +%# @example +%# fvdb = @@(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%# +%# vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ +%# "NormControl", "on", "OutputFcn", @@odeplot); +%# ode54 (fvdb, [0 20], [2 0], vopt); +%# @end example +%# @end deftypefn +%# +%# @seealso{odepkg} + +%# ChangeLog: +%# 20010703 the function file "ode54.m" was written by Marc Compere +%# under the GPL for the use with this software. This function has been +%# taken as a base for the following implementation. +%# 20060810, Thomas Treichl +%# This function was adapted to the new syntax that is used by the +%# new OdePkg for Octave. An equivalent function in Matlab does not +%# exist. + +function [varargout] = ode54 (vfun, vslot, vinit, varargin) + + if (nargin == 0) %# Check number and types of all input arguments + help ('ode54'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be greater than zero'); + + elseif (nargin < 3) + print_usage; + + elseif ~(isa (vfun, 'function_handle') || isa (vfun, 'inline')) + error ('OdePkg:InvalidArgument', ... + 'First input argument must be a valid function handle'); + + elseif (~isvector (vslot) || length (vslot) < 2) + error ('OdePkg:InvalidArgument', ... + 'Second input argument must be a valid vector'); + + elseif (~isvector (vinit) || ~isnumeric (vinit)) + error ('OdePkg:InvalidArgument', ... + 'Third input argument must be a valid numerical value'); + + elseif (nargin >= 4) + + if (~isstruct (varargin{1})) + %# varargin{1:len} are parameters for vfun + vodeoptions = odeset; + vfunarguments = varargin; + + elseif (length (varargin) > 1) + %# varargin{1} is an OdePkg options structure vopt + vodeoptions = odepkg_structure_check (varargin{1}, 'ode54'); + vfunarguments = {varargin{2:length(varargin)}}; + + else %# if (isstruct (varargin{1})) + vodeoptions = odepkg_structure_check (varargin{1}, 'ode54'); + vfunarguments = {}; + + end + + else %# if (nargin == 3) + vodeoptions = odeset; + vfunarguments = {}; + end + + %# Start preprocessing, have a look which options are set in + %# vodeoptions, check if an invalid or unused option is set + vslot = vslot(:).'; %# Create a row vector + vinit = vinit(:).'; %# Create a row vector + if (length (vslot) > 2) %# Step size checking + vstepsizefixed = true; + else + vstepsizefixed = false; + end + + %# Get the default options that can be set with 'odeset' temporarily + vodetemp = odeset; + + %# Implementation of the option RelTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.RelTol) && ~vstepsizefixed) + vodeoptions.RelTol = 1e-6; + warning ('OdePkg:InvalidArgument', ... + 'Option "RelTol" not set, new value %f is used', vodeoptions.RelTol); + elseif (~isempty (vodeoptions.RelTol) && vstepsizefixed) + warning ('OdePkg:InvalidArgument', ... + 'Option "RelTol" will be ignored if fixed time stamps are given'); + end + + %# Implementation of the option AbsTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.AbsTol) && ~vstepsizefixed) + vodeoptions.AbsTol = 1e-6; + warning ('OdePkg:InvalidArgument', ... + 'Option "AbsTol" not set, new value %f is used', vodeoptions.AbsTol); + elseif (~isempty (vodeoptions.AbsTol) && vstepsizefixed) + warning ('OdePkg:InvalidArgument', ... + 'Option "AbsTol" will be ignored if fixed time stamps are given'); + else + vodeoptions.AbsTol = vodeoptions.AbsTol(:); %# Create column vector + end + + %# Implementation of the option NormControl has been finished. This + %# option can be set by the user to another value than default value. + if (strcmp (vodeoptions.NormControl, 'on')) vnormcontrol = true; + else vnormcontrol = false; end + + %# Implementation of the option NonNegative has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.NonNegative)) + if (isempty (vodeoptions.Mass)), vhavenonnegative = true; + else + vhavenonnegative = false; + warning ('OdePkg:InvalidArgument', ... + 'Option "NonNegative" will be ignored if mass matrix is set'); + end + else vhavenonnegative = false; + end + + %# Implementation of the option OutputFcn has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputFcn) && nargout == 0) + vodeoptions.OutputFcn = @odeplot; + vhaveoutputfunction = true; + elseif (isempty (vodeoptions.OutputFcn)), vhaveoutputfunction = false; + else vhaveoutputfunction = true; + end + + %# Implementation of the option OutputSel has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.OutputSel)), vhaveoutputselection = true; + else vhaveoutputselection = false; end + + %# Implementation of the option OutputSave has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputSave)), vodeoptions.OutputSave = 1; + end + + %# Implementation of the option Refine has been finished. This option + %# can be set by the user to another value than default value. + if (vodeoptions.Refine > 0), vhaverefine = true; + else vhaverefine = false; end + + %# Implementation of the option Stats has been finished. This option + %# can be set by the user to another value than default value. + + %# Implementation of the option InitialStep has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.InitialStep) && ~vstepsizefixed) + vodeoptions.InitialStep = (vslot(1,2) - vslot(1,1)) / 10; + vodeoptions.InitialStep = vodeoptions.InitialStep / 10^vodeoptions.Refine; + warning ('OdePkg:InvalidArgument', ... + 'Option "InitialStep" not set, new value %f is used', vodeoptions.InitialStep); + end + + %# Implementation of the option MaxStep has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.MaxStep) && ~vstepsizefixed) + vodeoptions.MaxStep = abs (vslot(1,2) - vslot(1,1)) / 10; + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxStep" not set, new value %f is used', vodeoptions.MaxStep); + end + + %# Implementation of the option Events has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Events)), vhaveeventfunction = true; + else vhaveeventfunction = false; end + + %# The options 'Jacobian', 'JPattern' and 'Vectorized' will be ignored + %# by this solver because this solver uses an explicit Runge-Kutta + %# method and therefore no Jacobian calculation is necessary + if (~isequal (vodeoptions.Jacobian, vodetemp.Jacobian)) + warning ('OdePkg:InvalidArgument', ... + 'Option "Jacobian" will be ignored by this solver'); + end + if (~isequal (vodeoptions.JPattern, vodetemp.JPattern)) + warning ('OdePkg:InvalidArgument', ... + 'Option "JPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.Vectorized, vodetemp.Vectorized)) + warning ('OdePkg:InvalidArgument', ... + 'Option "Vectorized" will be ignored by this solver'); + end + if (~isequal (vodeoptions.NewtonTol, vodetemp.NewtonTol)) + warning ('OdePkg:InvalidArgument', ... + 'Option "NewtonTol" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxNewtonIterations,... + vodetemp.MaxNewtonIterations)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxNewtonIterations" will be ignored by this solver'); + end + + %# Implementation of the option Mass has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Mass) && isnumeric (vodeoptions.Mass)) + vhavemasshandle = false; vmass = vodeoptions.Mass; %# constant mass + elseif (isa (vodeoptions.Mass, 'function_handle')) + vhavemasshandle = true; %# mass defined by a function handle + else %# no mass matrix - creating a diag-matrix of ones for mass + vhavemasshandle = false; %# vmass = diag (ones (length (vinit), 1), 0); + end + + %# Implementation of the option MStateDependence has been finished. + %# This option can be set by the user to another value than default + %# value. + if (strcmp (vodeoptions.MStateDependence, 'none')) + vmassdependence = false; + else vmassdependence = true; + end + + %# Other options that are not used by this solver. Print a warning + %# message to tell the user that the option(s) is/are ignored. + if (~isequal (vodeoptions.MvPattern, vodetemp.MvPattern)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MvPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MassSingular, vodetemp.MassSingular)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MassSingular" will be ignored by this solver'); + end + if (~isequal (vodeoptions.InitialSlope, vodetemp.InitialSlope)) + warning ('OdePkg:InvalidArgument', ... + 'Option "InitialSlope" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxOrder, vodetemp.MaxOrder)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxOrder" will be ignored by this solver'); + end + if (~isequal (vodeoptions.BDF, vodetemp.BDF)) + warning ('OdePkg:InvalidArgument', ... + 'Option "BDF" will be ignored by this solver'); + end + + %# Starting the initialisation of the core solver ode54 + vtimestamp = vslot(1,1); %# timestamp = start time + vtimelength = length (vslot); %# length needed if fixed steps + vtimestop = vslot(1,vtimelength); %# stop time = last value + %# 20110611, reported by Nils Strunk + %# Make it possible to solve equations from negativ to zero, + %# eg. vres = ode54 (@(t,y) y, [-2 0], 2); + vdirection = sign (vtimestop - vtimestamp); %# Direction flag + + if (~vstepsizefixed) + if (sign (vodeoptions.InitialStep) == vdirection) + vstepsize = vodeoptions.InitialStep; + else %# Fix wrong direction of InitialStep. + vstepsize = - vodeoptions.InitialStep; + end + vminstepsize = (vtimestop - vtimestamp) / (1/eps); + else %# If step size is given then use the fixed time steps + vstepsize = vslot(1,2) - vslot(1,1); + vminstepsize = sign (vstepsize) * eps; + end + + vretvaltime = vtimestamp; %# first timestamp output + vretvalresult = vinit; %# first solution output + + %# Initialize the OutputFcn + if (vhaveoutputfunction) + if (vhaveoutputselection) vretout = vretvalresult(vodeoptions.OutputSel); + else vretout = vretvalresult; end + feval (vodeoptions.OutputFcn, vslot.', ... + vretout.', 'init', vfunarguments{:}); + end + + %# Initialize the EventFcn + if (vhaveeventfunction) + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vretvalresult.', 'init', vfunarguments{:}); + end + + vpow = 1/5; %# 20071016, reported by Luis Randez + va = [0, 0, 0, 0, 0, 0; %# The Dormand-Prince 5(4) coefficients + 1/5, 0, 0, 0, 0, 0; %# Coefficients proved on 20060827 + 3/40, 9/40, 0, 0, 0, 0; %# See p.91 in Ascher & Petzold + 44/45, -56/15, 32/9, 0, 0, 0; + 19372/6561, -25360/2187, 64448/6561, -212/729, 0, 0; + 9017/3168, -355/33, 46732/5247, 49/176, -5103/18656, 0; + 35/384, 0, 500/1113, 125/192, -2187/6784, 11/84]; + %# 4th and 5th order b-coefficients + vb4 = [5179/57600; 0; 7571/16695; 393/640; -92097/339200; 187/2100; 1/40]; + vb5 = [35/384; 0; 500/1113; 125/192; -2187/6784; 11/84; 0]; + vc = sum (va, 2); + + %# The solver main loop - stop if the endpoint has been reached + vcntloop = 2; vcntcycles = 1; vu = vinit; vk = vu.' * zeros(1,7); + vcntiter = 0; vunhandledtermination = true; vcntsave = 2; + + %# FSAL optimizations: sent by Bruce Minaker 20110326, find the slope k1 + %# (k1 is copied from last k7, so set k7) for first time step only + if (vhavemasshandle) %# Handle only the dynamic mass matrix, + if (vmassdependence) %# constant mass matrices have already + vmass = feval ... %# been set before (if any) + (vodeoptions.Mass, vtimestamp, vinit.', vfunarguments{:}); + else %# if (vmassdependence == false) + vmass = feval ... %# then we only have the time argument + (vodeoptions.Mass, vtimestamp, vfunarguments{:}); + end + vk(:,7) = vmass \ feval ... + (vfun, vtimestamp, vinit.', vfunarguments{:}); + else + vk(:,7) = feval ... + (vfun, vtimestamp, vinit.', vfunarguments{:}); + end + + while ((vdirection * (vtimestamp) < vdirection * (vtimestop)) && ... + (vdirection * (vstepsize) >= vdirection * (vminstepsize))) + + %# Hit the endpoint of the time slot exactely + if (vdirection * (vtimestamp + vstepsize) > vdirection * vtimestop) + %# vstepsize = vtimestop - vdirection * vtimestamp; + %# 20110611, reported by Nils Strunk + %# The endpoint of the time slot must be hit exactly, + %# eg. vsol = ode54 (@(t,y) y, [0 -1], 1); + vstepsize = vdirection * abs (abs (vtimestop) - abs (vtimestamp)); + end + + %# Estimate the seven results when using this solver (FSAL) + %# skip the first result as we already know it from last time step + vk(:,1)=vk(:,7); + for j = 2:7 %# Start at two instead of one (FSAL) + vthetime = vtimestamp + vc(j,1) * vstepsize; + vtheinput = vu.' + vstepsize * vk(:,1:j-1) * va(j,1:j-1).'; + if (vhavemasshandle) %# Handle only the dynamic mass matrix, + if (vmassdependence) %# constant mass matrices have already + vmass = feval ... %# been set before (if any) + (vodeoptions.Mass, vthetime, vtheinput, vfunarguments{:}); + else %# if (vmassdependence == false) + vmass = feval ... %# then we only have the time argument + (vodeoptions.Mass, vthetime, vfunarguments{:}); + end + vk(:,j) = vmass \ feval ... + (vfun, vthetime, vtheinput, vfunarguments{:}); + else + vk(:,j) = feval ... + (vfun, vthetime, vtheinput, vfunarguments{:}); + end + end + + %# Compute the 4th and the 5th order estimation + y4 = vu.' + vstepsize * (vk * vb4); + y5 = vtheinput; + %# y5 = vu.' + vstepsize * (vk * vb5); vb5 is the same as va(6,:), + %# means that we already know y5 from the first six vk's (FSAL) + + if (vhavenonnegative) + vu(vodeoptions.NonNegative) = abs (vu(vodeoptions.NonNegative)); + y4(vodeoptions.NonNegative) = abs (y4(vodeoptions.NonNegative)); + y5(vodeoptions.NonNegative) = abs (y5(vodeoptions.NonNegative)); + end + if (vhaveoutputfunction && vhaverefine) + vSaveVUForRefine = vu; + end + + %# Calculate the absolute local truncation error and the acceptable error + if (~vstepsizefixed) + if (~vnormcontrol) + vdelta = abs (y5 - y4); + vtau = max (vodeoptions.RelTol * abs (vu.'), vodeoptions.AbsTol); + else + vdelta = norm (y5 - y4, Inf); + vtau = max (vodeoptions.RelTol * max (norm (vu.', Inf), 1.0), ... + vodeoptions.AbsTol); + end + else %# if (vstepsizefixed == true) + vdelta = 1; vtau = 2; + end + + %# If the error is acceptable then update the vretval variables + if (all (vdelta <= vtau)) + vtimestamp = vtimestamp + vstepsize; + vu = y5.'; %# MC2001: the higher order estimation as "local extrapolation" + %# Save the solution every vodeoptions.OutputSave steps + if (mod (vcntloop-1,vodeoptions.OutputSave) == 0) + if (vhaveoutputselection) + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu(vodeoptions.OutputSel); + else + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu; + end + vcntsave = vcntsave + 1; + end + vcntloop = vcntloop + 1; vcntiter = 0; + + %# Call plot only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if plot function + %# returns false + if (vhaveoutputfunction) + for vcnt = 0:vodeoptions.Refine %# Approximation between told and t + if (vhaverefine) %# Do interpolation + vapproxtime = (vcnt + 1) * vstepsize / (vodeoptions.Refine + 2); + vapproxvals = vSaveVUForRefine.' + vapproxtime * (vk * vb5); + vapproxtime = (vtimestamp - vstepsize) + vapproxtime; + else + vapproxvals = vu.'; + vapproxtime = vtimestamp; + end + if (vhaveoutputselection) + vapproxvals = vapproxvals(vodeoptions.OutputSel); + end + vpltret = feval (vodeoptions.OutputFcn, vapproxtime, ... + vapproxvals, [], vfunarguments{:}); + if vpltret %# Leave refinement loop + break; + end + end + if (vpltret) %# Leave main loop + vunhandledtermination = false; + break; + end + end + + %# Call event only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if veventbreak is + %# true + if (vhaveeventfunction) + vevent = ... + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vu(:), [], vfunarguments{:}); + if (~isempty (vevent{1}) && vevent{1} == 1) + vretvaltime(vcntloop-1,:) = vevent{3}(end,:); + vretvalresult(vcntloop-1,:) = vevent{4}(end,:); + vunhandledtermination = false; break; + end + end + else + vk(:,7) = vk(:,1); + %# If we're here, then we've overwritten the k7 that we + %# need to copy to k1 to redo the step Since we copy k7 + %# into k1, we'll put the k1 back in k7 for now, until it's + %# copied back again (FSAL) + end %# If the error is acceptable ... + + %# Update the step size for the next integration step + if (~vstepsizefixed) + %# 2008-20120425, reported by Marco Caliari + %# vdelta cannot be negative (because of the absolute value that + %# has been introduced) but it could be 0, then replace the zeros + %# with the maximum value of vdelta + vdelta(find (vdelta == 0)) = max (vdelta); + %# It could happen that max (vdelta) == 0 (ie. that the original + %# vdelta was 0), in that case we double the previous vstepsize + vdelta(find (vdelta == 0)) = max (vtau) .* (0.4 ^ (1 / vpow)); + + if (vdirection == 1) + vstepsize = min (vodeoptions.MaxStep, ... + min (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + else + vstepsize = max (- vodeoptions.MaxStep, ... + max (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + end + + else %# if (vstepsizefixed) + if (vcntloop <= vtimelength) + vstepsize = vslot(vcntloop) - vslot(vcntloop-1); + else %# Get out of the main integration loop + break; + end + end + + %# Update counters that count the number of iteration cycles + vcntcycles = vcntcycles + 1; %# Needed for cost statistics + vcntiter = vcntiter + 1; %# Needed to find iteration problems + + %# Stop solving because the last 1000 steps no successful valid + %# value has been found + if (vcntiter >= 5000) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f before endpoint at', ... + ' tend = %f was reached. This happened because the iterative', ... + ' integration loop does not find a valid solution at this time', ... + ' stamp. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + end + + end %# The main loop + + %# Check if integration of the ode has been successful + if (vdirection * vtimestamp < vdirection * vtimestop) + if (vunhandledtermination == true) + error ('OdePkg:InvalidArgument', ... + ['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f', ... + ' before endpoint at tend = %f was reached. This may', ... + ' happen if the stepsize grows smaller than defined in', ... + ' vminstepsize. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + else + warning ('OdePkg:InvalidArgument', ... + ['Solver has been stopped by a call of "break" in', ... + ' the main iteration loop at time t = %f before endpoint at', ... + ' tend = %f was reached. This may happen because the @odeplot', ... + ' function returned "true" or the @event function returned "true".'], ... + vtimestamp, vtimestop); + end + end + + %# Postprocessing, do whatever when terminating integration algorithm + if (vhaveoutputfunction) %# Cleanup plotter + feval (vodeoptions.OutputFcn, vtimestamp, ... + vu.', 'done', vfunarguments{:}); + end + if (vhaveeventfunction) %# Cleanup event function handling + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vu.', 'done', vfunarguments{:}); + end + %# Save the last step, if not already saved + if (mod (vcntloop-2,vodeoptions.OutputSave) ~= 0) + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu; + end + + %# Print additional information if option Stats is set + if (strcmp (vodeoptions.Stats, 'on')) + vhavestats = true; + vnsteps = vcntloop-2; %# vcntloop from 2..end + vnfailed = (vcntcycles-1)-(vcntloop-2)+1; %# vcntcycl from 1..end + vnfevals = 6*(vcntcycles-1)+1; %# 7 stages & one first step (FSAL) + vndecomps = 0; %# number of LU decompositions + vnpds = 0; %# number of partial derivatives + vnlinsols = 0; %# no. of solutions of linear systems + %# Print cost statistics if no output argument is given + if (nargout == 0) + vmsg = fprintf (1, 'Number of successful steps: %d\n', vnsteps); + vmsg = fprintf (1, 'Number of failed attempts: %d\n', vnfailed); + vmsg = fprintf (1, 'Number of function calls: %d\n', vnfevals); + end + else + vhavestats = false; + end + + if (nargout == 1) %# Sort output variables, depends on nargout + varargout{1}.x = vretvaltime; %# Time stamps are saved in field x + varargout{1}.y = vretvalresult; %# Results are saved in field y + varargout{1}.solver = 'ode54'; %# Solver name is saved in field solver + if (vhaveeventfunction) + varargout{1}.ie = vevent{2}; %# Index info which event occured + varargout{1}.xe = vevent{3}; %# Time info when an event occured + varargout{1}.ye = vevent{4}; %# Results when an event occured + end + if (vhavestats) + varargout{1}.stats = struct; + varargout{1}.stats.nsteps = vnsteps; + varargout{1}.stats.nfailed = vnfailed; + varargout{1}.stats.nfevals = vnfevals; + varargout{1}.stats.npds = vnpds; + varargout{1}.stats.ndecomps = vndecomps; + varargout{1}.stats.nlinsols = vnlinsols; + end + elseif (nargout == 2) + varargout{1} = vretvaltime; %# Time stamps are first output argument + varargout{2} = vretvalresult; %# Results are second output argument + elseif (nargout == 5) + varargout{1} = vretvaltime; %# Same as (nargout == 2) + varargout{2} = vretvalresult; %# Same as (nargout == 2) + varargout{3} = []; %# LabMat doesn't accept lines like + varargout{4} = []; %# varargout{3} = varargout{4} = []; + varargout{5} = []; + if (vhaveeventfunction) + varargout{3} = vevent{3}; %# Time info when an event occured + varargout{4} = vevent{4}; %# Results when an event occured + varargout{5} = vevent{2}; %# Index info which event occured + end + end +end + +%! # We are using the "Van der Pol" implementation for all tests that +%! # are done for this function. We also define a Jacobian, Events, +%! # pseudo-Mass implementation. For further tests we also define a +%! # reference solution (computed at high accuracy) and an OutputFcn +%!function [ydot] = fpol (vt, vy, varargin) %# The Van der Pol +%! ydot = [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%!function [vjac] = fjac (vt, vy, varargin) %# its Jacobian +%! vjac = [0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]; +%!function [vjac] = fjcc (vt, vy, varargin) %# sparse type +%! vjac = sparse ([0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]); +%!function [vval, vtrm, vdir] = feve (vt, vy, varargin) +%! vval = fpol (vt, vy, varargin); %# We use the derivatives +%! vtrm = zeros (2,1); %# that's why component 2 +%! vdir = ones (2,1); %# seems to not be exact +%!function [vval, vtrm, vdir] = fevn (vt, vy, varargin) +%! vval = fpol (vt, vy, varargin); %# We use the derivatives +%! vtrm = ones (2,1); %# that's why component 2 +%! vdir = ones (2,1); %# seems to not be exact +%!function [vmas] = fmas (vt, vy) +%! vmas = [1, 0; 0, 1]; %# Dummy mass matrix for tests +%!function [vmas] = fmsa (vt, vy) +%! vmas = sparse ([1, 0; 0, 1]); %# A sparse dummy matrix +%!function [vref] = fref () %# The computed reference sol +%! vref = [0.32331666704577, -1.83297456798624]; +%!function [vout] = fout (vt, vy, vflag, varargin) +%! if (regexp (char (vflag), 'init') == 1) +%! if (any (size (vt) ~= [2, 1])) error ('"fout" step "init"'); end +%! elseif (isempty (vflag)) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "calc"'); end +%! vout = false; +%! elseif (regexp (char (vflag), 'done') == 1) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "done"'); end +%! else error ('"fout" invalid vflag'); +%! end +%! +%! %# Turn off output of warning messages for all tests, turn them on +%! %# again if the last test is called +%!error %# input argument number one +%! warning ('off', 'OdePkg:InvalidArgument'); +%! B = ode54 (1, [0 25], [3 15 1]); +%!error %# input argument number two +%! B = ode54 (@fpol, 1, [3 15 1]); +%!error %# input argument number three +%! B = ode54 (@flor, [0 25], 1); +%!test %# one output argument +%! vsol = ode54 (@fpol, [0 2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%! assert (isfield (vsol, 'solver')); +%! assert (vsol.solver, 'ode54'); +%!test %# two output arguments +%! [vt, vy] = ode54 (@fpol, [0 2], [2 0]); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%!test %# five output arguments and no Events +%! [vt, vy, vxe, vye, vie] = ode54 (@fpol, [0 2], [2 0]); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%! assert ([vie, vxe, vye], []); +%!test %# anonymous function instead of real function +%! fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%! vsol = ode54 (fvdb, [0 2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# extra input arguments passed trhough +%! vsol = ode54 (@fpol, [0 2], [2 0], 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# empty OdePkg structure *but* extra input arguments +%! vopt = odeset; +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt, 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!error %# strange OdePkg structure +%! vopt = struct ('foo', 1); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%!test %# Solve vdp in fixed step sizes +%! vsol = ode54 (@fpol, [0:0.1:2], [2 0]); +%! assert (vsol.x(:), [0:0.1:2]'); +%! assert (vsol.y(end,:), fref, 1e-3); +%!test %# Solve in backward direction starting at t=0 +%! vref = [-1.205364552835178, 0.951542399860817]; +%! vsol = ode54 (@fpol, [0 -2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [-2, vref], 1e-3); +%!test %# Solve in backward direction starting at t=2 +%! vref = [-1.205364552835178, 0.951542399860817]; +%! vsol = ode54 (@fpol, [2 -2], fref); +%! assert ([vsol.x(end), vsol.y(end,:)], [-2, vref], 1e-3); +%!test %# Solve another anonymous function in backward direction +%! vref = [-1, 0.367879437558975]; +%! vsol = ode54 (@(t,y) y, [0 -1], 1); +%! assert ([vsol.x(end), vsol.y(end,:)], vref, 1e-3); +%!test %# Solve another anonymous function below zero +%! vref = [0, 14.77810590694212]; +%! vsol = ode54 (@(t,y) y, [-2 0], 2); +%! assert ([vsol.x(end), vsol.y(end,:)], vref, 1e-3); +%!test %# AbsTol option +%! vopt = odeset ('AbsTol', 1e-5); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# AbsTol and RelTol option +%! vopt = odeset ('AbsTol', 1e-8, 'RelTol', 1e-8); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# RelTol and NormControl option -- higher accuracy +%! vopt = odeset ('RelTol', 1e-8, 'NormControl', 'on'); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-4); +%!test %# Keeps initial values while integrating +%! vopt = odeset ('NonNegative', 2); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, 2, 0], 1e-1); +%!test %# Details of OutputSel and Refine can't be tested +%! vopt = odeset ('OutputFcn', @fout, 'OutputSel', 1, 'Refine', 5); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%!test %# Details of OutputSave can't be tested +%! vopt = odeset ('OutputSave', 1, 'OutputSel', 1); +%! vsla = ode54 (@fpol, [0 2], [2 0], vopt); +%! vopt = odeset ('OutputSave', 2); +%! vslb = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert (length (vsla.x) > length (vslb.x)) +%!test %# Stats must add further elements in vsol +%! vopt = odeset ('Stats', 'on'); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert (isfield (vsol, 'stats')); +%! assert (isfield (vsol.stats, 'nsteps')); +%!test %# InitialStep option +%! vopt = odeset ('InitialStep', 1e-8); +%! vsol = ode54 (@fpol, [0 0.2], [2 0], vopt); +%! assert ([vsol.x(2)-vsol.x(1)], [1e-8], 1e-9); +%!test %# MaxStep option +%! vopt = odeset ('MaxStep', 1e-2); +%! vsol = ode54 (@fpol, [0 0.2], [2 0], vopt); +%! assert ([vsol.x(5)-vsol.x(4)], [1e-2], 1e-3); +%!test %# Events option add further elements in vsol +%! vopt = odeset ('Events', @feve, 'InitialStep', 1e-6); +%! vsol = ode54 (@fpol, [0 10], [2 0], vopt); +%! assert (isfield (vsol, 'ie')); +%! assert (vsol.ie(1), 2); +%! assert (isfield (vsol, 'xe')); +%! assert (isfield (vsol, 'ye')); +%!test %# Events option, now stop integration +%! vopt = odeset ('Events', @fevn, 'InitialStep', 1e-6); +%! vsol = ode54 (@fpol, [0 10], [2 0], vopt); +%! assert ([vsol.ie, vsol.xe, vsol.ye], ... +%! [2.0, 2.496110, -0.830550, -2.677589], 1e-1); +%!test %# Events option, five output arguments +%! vopt = odeset ('Events', @fevn, 'InitialStep', 1e-6); +%! [vt, vy, vxe, vye, vie] = ode54 (@fpol, [0 10], [2 0], vopt); +%! assert ([vie, vxe, vye], ... +%! [2.0, 2.496110, -0.830550, -2.677589], 1e-1); +%!test %# Jacobian option +%! vopt = odeset ('Jacobian', @fjac); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Jacobian option and sparse return value +%! vopt = odeset ('Jacobian', @fjcc); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%! +%! %# test for JPattern option is missing +%! %# test for Vectorized option is missing +%! %# test for NewtonTol option is missing +%! %# test for MaxNewtonIterations option is missing +%! +%!test %# Mass option as function +%! vopt = odeset ('Mass', @fmas); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as matrix +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as sparse matrix +%! vopt = odeset ('Mass', sparse (eye (2,2))); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as function and sparse matrix +%! vopt = odeset ('Mass', @fmsa); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as function and MStateDependence +%! vopt = odeset ('Mass', @fmas, 'MStateDependence', 'strong'); +%! vsol = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Set BDF option to something else than default +%! vopt = odeset ('BDF', 'on'); +%! [vt, vy] = ode54 (@fpol, [0 2], [2 0], vopt); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%! +%! %# test for MvPattern option is missing +%! %# test for InitialSlope option is missing +%! %# test for MaxOrder option is missing +%! +%! warning ('on', 'OdePkg:InvalidArgument'); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** + diff --git a/octave_packages/odepkg-0.8.2/ode54d.m b/octave_packages/odepkg-0.8.2/ode54d.m new file mode 100644 index 0000000..ed5a086 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/ode54d.m @@ -0,0 +1,769 @@ +%# Copyright (C) 2008-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} ode54d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{sol}] =} ode54d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{t}, @var{y}, [@var{xe}, @var{ye}, @var{ie}]] =} ode54d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# +%# This function file can be used to solve a set of non--stiff delay differential equations (non--stiff DDEs) with a modified version of the well known explicit Runge--Kutta method of order (2,3). +%# +%# If this function is called with no return argument then plot the solution over time in a figure window while solving the set of DDEs that are defined in a function and specified by the function handle @var{@@fun}. The second input argument @var{slot} is a double vector that defines the time slot, @var{init} is a double vector that defines the initial values of the states, @var{lags} is a double vector that describes the lags of time, @var{hist} is a double matrix and describes the history of the DDEs, @var{opt} can optionally be a structure array that keeps the options created with the command @command{odeset} and @var{par1}, @var{par2}, @dots{} can optionally be other input arguments of any type that have to be passed to the function defined by @var{@@fun}. +%# +%# In other words, this function will solve a problem of the form +%# @example +%# dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), @dots{}))) +%# y(slot(1)) = init +%# y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), @dots{} +%# @end example +%# +%# If this function is called with one return argument then return the solution @var{sol} of type structure array after solving the set of DDEs. The solution @var{sol} has the fields @var{x} of type double column vector for the steps chosen by the solver, @var{y} of type double column vector for the solutions at each time step of @var{x}, @var{solver} of type string for the solver name and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector that keep the informations of the event function if an event function handle is set in the option argument @var{opt}. +%# +%# If this function is called with more than one return argument then return the time stamps @var{t}, the solution values @var{y} and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector. +%# +%# For example: +%# @itemize @minus +%# @item +%# the following code solves an anonymous implementation of a chaotic behavior +%# +%# @example +%# fcao = @@(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy]; +%# +%# vopt = odeset ("NormControl", "on", "RelTol", 1e-3); +%# vsol = ode54d (fcao, [0, 100], 0.5, 2, 0.5, vopt); +%# +%# vlag = interp1 (vsol.x, vsol.y, vsol.x - 2); +%# plot (vsol.y, vlag); legend ("fcao (t,y,z)"); +%# @end example +%# +%# @item +%# to solve the following problem with two delayed state variables +%# +%# @example +%# d y1(t)/dt = -y1(t) +%# d y2(t)/dt = -y2(t) + y1(t-5) +%# d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10) +%# @end example +%# +%# one might do the following +%# +%# @example +%# function f = fun (t, y, yd) +%# f(1) = -y(1); %% y1' = -y1(t) +%# f(2) = -y(2) + yd(1,1); %% y2' = -y2(t) + y1(t-lags(1)) +%# f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2)) +%# endfunction +%# T = [0,20] +%# res = ode54d (@@fun, T, [1;1;1], [5, 10], ones (3,2)); +%# @end example +%# +%# @end itemize +%# @end deftypefn +%# +%# @seealso{odepkg} + +function [varargout] = ode54d (vfun, vslot, vinit, vlags, vhist, varargin) + + if (nargin == 0) %# Check number and types of all input arguments + help ('ode54d'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be greater than zero'); + + elseif (nargin < 5) + print_usage; + + elseif (~isa (vfun, 'function_handle')) + error ('OdePkg:InvalidArgument', ... + 'First input argument must be a valid function handle'); + + elseif (~isvector (vslot) || length (vslot) < 2) + error ('OdePkg:InvalidArgument', ... + 'Second input argument must be a valid vector'); + + elseif (~isvector (vinit) || ~isnumeric (vinit)) + error ('OdePkg:InvalidArgument', ... + 'Third input argument must be a valid numerical value'); + + elseif (~isvector (vlags) || ~isnumeric (vlags)) + error ('OdePkg:InvalidArgument', ... + 'Fourth input argument must be a valid numerical value'); + + elseif ~(isnumeric (vhist) || isa (vhist, 'function_handle')) + error ('OdePkg:InvalidArgument', ... + 'Fifth input argument must either be numeric or a function handle'); + + elseif (nargin >= 6) + + if (~isstruct (varargin{1})) + %# varargin{1:len} are parameters for vfun + vodeoptions = odeset; + vfunarguments = varargin; + + elseif (length (varargin) > 1) + %# varargin{1} is an OdePkg options structure vopt + vodeoptions = odepkg_structure_check (varargin{1}, 'ode54d'); + vfunarguments = {varargin{2:length(varargin)}}; + + else %# if (isstruct (varargin{1})) + vodeoptions = odepkg_structure_check (varargin{1}, 'ode54d'); + vfunarguments = {}; + + end + + else %# if (nargin == 5) + vodeoptions = odeset; + vfunarguments = {}; + end + + %# Start preprocessing, have a look which options have been set in + %# vodeoptions. Check if an invalid or unused option has been set and + %# print warnings. + vslot = vslot(:)'; %# Create a row vector + vinit = vinit(:)'; %# Create a row vector + vlags = vlags(:)'; %# Create a row vector + + %# Check if the user has given fixed points of time + if (length (vslot) > 2), vstepsizegiven = true; %# Step size checking + else vstepsizegiven = false; end + + %# Get the default options that can be set with 'odeset' temporarily + vodetemp = odeset; + + %# Implementation of the option RelTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.RelTol) && ~vstepsizegiven) + vodeoptions.RelTol = 1e-6; + warning ('OdePkg:InvalidOption', ... + 'Option "RelTol" not set, new value %f is used', vodeoptions.RelTol); + elseif (~isempty (vodeoptions.RelTol) && vstepsizegiven) + warning ('OdePkg:InvalidOption', ... + 'Option "RelTol" will be ignored if fixed time stamps are given'); + %# This implementation has been added to odepkg_structure_check.m + %# elseif (~isscalar (vodeoptions.RelTol) && ~vstepsizegiven) + %# error ('OdePkg:InvalidOption', ... + %# 'Option "RelTol" must be set to a scalar value for this solver'); + end + + %# Implementation of the option AbsTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.AbsTol) && ~vstepsizegiven) + vodeoptions.AbsTol = 1e-6; + warning ('OdePkg:InvalidOption', ... + 'Option "AbsTol" not set, new value %f is used', vodeoptions.AbsTol); + elseif (~isempty (vodeoptions.AbsTol) && vstepsizegiven) + warning ('OdePkg:InvalidOption', ... + 'Option "AbsTol" will be ignored if fixed time stamps are given'); + else %# create column vector + vodeoptions.AbsTol = vodeoptions.AbsTol(:); + end + + %# Implementation of the option NormControl has been finished. This + %# option can be set by the user to another value than default value. + if (strcmp (vodeoptions.NormControl, 'on')), vnormcontrol = true; + else vnormcontrol = false; + end + + %# Implementation of the option NonNegative has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.NonNegative)) + if (isempty (vodeoptions.Mass)), vhavenonnegative = true; + else + vhavenonnegative = false; + warning ('OdePkg:InvalidOption', ... + 'Option "NonNegative" will be ignored if mass matrix is set'); + end + else vhavenonnegative = false; + end + + %# Implementation of the option OutputFcn has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputFcn) && nargout == 0) + vodeoptions.OutputFcn = @odeplot; + vhaveoutputfunction = true; + elseif (isempty (vodeoptions.OutputFcn)), vhaveoutputfunction = false; + else vhaveoutputfunction = true; + end + + %# Implementation of the option OutputSel has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.OutputSel)), vhaveoutputselection = true; + else vhaveoutputselection = false; end + + %# Implementation of the option Refine has been finished. This option + %# can be set by the user to another value than default value. + if (isequal (vodeoptions.Refine, vodetemp.Refine)), vhaverefine = true; + else vhaverefine = false; end + + %# Implementation of the option Stats has been finished. This option + %# can be set by the user to another value than default value. + + %# Implementation of the option InitialStep has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.InitialStep) && ~vstepsizegiven) + vodeoptions.InitialStep = abs (vslot(1,1) - vslot(1,2)) / 10; + vodeoptions.InitialStep = vodeoptions.InitialStep / 10^vodeoptions.Refine; + warning ('OdePkg:InvalidOption', ... + 'Option "InitialStep" not set, new value %f is used', vodeoptions.InitialStep); + end + + %# Implementation of the option MaxStep has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.MaxStep) && ~vstepsizegiven) + vodeoptions.MaxStep = abs (vslot(1,1) - vslot(1,length (vslot))) / 10; + %# vodeoptions.MaxStep = vodeoptions.MaxStep / 10^vodeoptions.Refine; + warning ('OdePkg:InvalidOption', ... + 'Option "MaxStep" not set, new value %f is used', vodeoptions.MaxStep); + end + + %# Implementation of the option Events has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Events)), vhaveeventfunction = true; + else vhaveeventfunction = false; end + + %# The options 'Jacobian', 'JPattern' and 'Vectorized' will be ignored + %# by this solver because this solver uses an explicit Runge-Kutta + %# method and therefore no Jacobian calculation is necessary + if (~isequal (vodeoptions.Jacobian, vodetemp.Jacobian)) + warning ('OdePkg:InvalidOption', ... + 'Option "Jacobian" will be ignored by this solver'); + end + if (~isequal (vodeoptions.JPattern, vodetemp.JPattern)) + warning ('OdePkg:InvalidOption', ... + 'Option "JPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.Vectorized, vodetemp.Vectorized)) + warning ('OdePkg:InvalidOption', ... + 'Option "Vectorized" will be ignored by this solver'); + end + if (~isequal (vodeoptions.NewtonTol, vodetemp.NewtonTol)) + warning ('OdePkg:InvalidArgument', ... + 'Option "NewtonTol" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxNewtonIterations,... + vodetemp.MaxNewtonIterations)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxNewtonIterations" will be ignored by this solver'); + end + + %# Implementation of the option Mass has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Mass) && isnumeric (vodeoptions.Mass)) + vhavemasshandle = false; vmass = vodeoptions.Mass; %# constant mass + elseif (isa (vodeoptions.Mass, 'function_handle')) + vhavemasshandle = true; %# mass defined by a function handle + else %# no mass matrix - creating a diag-matrix of ones for mass + vhavemasshandle = false; %# vmass = diag (ones (length (vinit), 1), 0); + end + + %# Implementation of the option MStateDependence has been finished. + %# This option can be set by the user to another value than default + %# value. + if (strcmp (vodeoptions.MStateDependence, 'none')) + vmassdependence = false; + else vmassdependence = true; + end + + %# Other options that are not used by this solver. Print a warning + %# message to tell the user that the option(s) is/are ignored. + if (~isequal (vodeoptions.MvPattern, vodetemp.MvPattern)) + warning ('OdePkg:InvalidOption', ... + 'Option "MvPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MassSingular, vodetemp.MassSingular)) + warning ('OdePkg:InvalidOption', ... + 'Option "MassSingular" will be ignored by this solver'); + end + if (~isequal (vodeoptions.InitialSlope, vodetemp.InitialSlope)) + warning ('OdePkg:InvalidOption', ... + 'Option "InitialSlope" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxOrder, vodetemp.MaxOrder)) + warning ('OdePkg:InvalidOption', ... + 'Option "MaxOrder" will be ignored by this solver'); + end + if (~isequal (vodeoptions.BDF, vodetemp.BDF)) + warning ('OdePkg:InvalidOption', ... + 'Option "BDF" will be ignored by this solver'); + end + + %# Starting the initialisation of the core solver ode54d + vtimestamp = vslot(1,1); %# timestamp = start time + vtimelength = length (vslot); %# length needed if fixed steps + vtimestop = vslot(1,vtimelength); %# stop time = last value + + if (~vstepsizegiven) + vstepsize = vodeoptions.InitialStep; + vminstepsize = (vtimestop - vtimestamp) / (1/eps); + else %# If step size is given then use the fixed time steps + vstepsize = abs (vslot(1,1) - vslot(1,2)); + vminstepsize = eps; %# vslot(1,2) - vslot(1,1) - eps; + end + + vretvaltime = vtimestamp; %# first timestamp output + if (vhaveoutputselection) %# first solution output + vretvalresult = vinit(vodeoptions.OutputSel); + else vretvalresult = vinit; + end + + %# Initialize the OutputFcn + if (vhaveoutputfunction) + feval (vodeoptions.OutputFcn, vslot', ... + vretvalresult', 'init', vfunarguments{:}); + end + + %# Initialize the History + if (isnumeric (vhist)) + vhmat = vhist; + vhavehistnumeric = true; + else %# it must be a function handle + for vcnt = 1:length (vlags); + vhmat(:,vcnt) = feval (vhist, (vslot(1)-vlags(vcnt)), vfunarguments{:}); + end + vhavehistnumeric = false; + end + + %# Initialize DDE variables for history calculation + vsaveddetime = [vtimestamp - vlags, vtimestamp]'; + vsaveddeinput = [vhmat, vinit']'; + vsavedderesult = [vhmat, vinit']'; + + %# Initialize the EventFcn + if (vhaveeventfunction) + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + {vretvalresult', vhmat}, 'init', vfunarguments{:}); + end + + vpow = 1/5; %# 20071016, reported by Luis Randez + va = [0, 0, 0, 0, 0, 0; %# The Dormand-Prince 5(4) coefficients + 1/5, 0, 0, 0, 0, 0; %# Coefficients proved on 20060827 + 3/40, 9/40, 0, 0, 0, 0; %# See p.91 in Ascher & Petzold + 44/45, -56/15, 32/9, 0, 0, 0; + 19372/6561, -25360/2187, 64448/6561, -212/729, 0, 0; + 9017/3168, -355/33, 46732/5247, 49/176, -5103/18656, 0; + 35/384, 0, 500/1113, 125/192, -2187/6784, 11/84]; + %# 4th and 5th order b-coefficients + vb4 = [35/384; 0; 500/1113; 125/192; -2187/6784; 11/84; 0]; + vb5 = [5179/57600; 0; 7571/16695; 393/640; -92097/339200; 187/2100; 1/40]; + vc = sum (va, 2); + + %# The solver main loop - stop if the endpoint has been reached + vcntloop = 2; vcntcycles = 1; vu = vinit; vk = vu' * zeros(1,7); + vcntiter = 0; vunhandledtermination = true; + while ((vtimestamp < vtimestop && vstepsize >= vminstepsize)) + + %# Hit the endpoint of the time slot exactely + if ((vtimestamp + vstepsize) > vtimestop) + vstepsize = vtimestop - vtimestamp; end + + %# Estimate the seven results when using this solver + for j = 1:7 + vthetime = vtimestamp + vc(j,1) * vstepsize; + vtheinput = vu' + vstepsize * vk(:,1:j-1) * va(j,1:j-1)'; + %# Claculate the history values (or get them from an external + %# function) that are needed for the next step of solving + if (vhavehistnumeric) + for vcnt = 1:length (vlags) + %# Direct implementation of a 'quadrature cubic Hermite interpolation' + %# found at the Faculty for Mathematics of the University of Stuttgart + %# http://mo.mathematik.uni-stuttgart.de/inhalt/aussage/aussage1269 + vnumb = find (vthetime - vlags(vcnt) >= vsaveddetime); + velem = min (vnumb(end), length (vsaveddetime) - 1); + vstep = vsaveddetime(velem+1) - vsaveddetime(velem); + vdiff = (vthetime - vlags(vcnt) - vsaveddetime(velem)) / vstep; + vsubs = 1 - vdiff; + %# Calculation of the coefficients for the interpolation algorithm + vua = (1 + 2 * vdiff) * vsubs^2; + vub = (3 - 2 * vdiff) * vdiff^2; + vva = vstep * vdiff * vsubs^2; + vvb = -vstep * vsubs * vdiff^2; + vhmat(:,vcnt) = vua * vsaveddeinput(velem,:)' + ... + vub * vsaveddeinput(velem+1,:)' + ... + vva * vsavedderesult(velem,:)' + ... + vvb * vsavedderesult(velem+1,:)'; + end + else %# the history must be a function handle + for vcnt = 1:length (vlags) + vhmat(:,vcnt) = feval ... + (vhist, vthetime - vlags(vcnt), vfunarguments{:}); + end + end + + if (vhavemasshandle) %# Handle only the dynamic mass matrix, + if (vmassdependence) %# constant mass matrices have already + vmass = feval ... %# been set before (if any) + (vodeoptions.Mass, vthetime, vtheinput, vfunarguments{:}); + else %# if (vmassdependence == false) + vmass = feval ... %# then we only have the time argument + (vodeoptions.Mass, vthetime, vfunarguments{:}); + end + vk(:,j) = vmass \ feval ... + (vfun, vthetime, vtheinput, vhmat, vfunarguments{:}); + else + vk(:,j) = feval ... + (vfun, vthetime, vtheinput, vhmat, vfunarguments{:}); + end + end + + %# Compute the 4th and the 5th order estimation + y4 = vu' + vstepsize * (vk * vb4); + y5 = vu' + vstepsize * (vk * vb5); + if (vhavenonnegative) + vu(vodeoptions.NonNegative) = abs (vu(vodeoptions.NonNegative)); + y4(vodeoptions.NonNegative) = abs (y4(vodeoptions.NonNegative)); + y5(vodeoptions.NonNegative) = abs (y5(vodeoptions.NonNegative)); + end + vSaveVUForRefine = vu; + + %# Calculate the absolute local truncation error and the acceptable error + if (~vstepsizegiven) + if (~vnormcontrol) + vdelta = y5 - y4; + vtau = max (vodeoptions.RelTol * vu', vodeoptions.AbsTol); + else + vdelta = norm (y5 - y4, Inf); + vtau = max (vodeoptions.RelTol * max (norm (vu', Inf), 1.0), ... + vodeoptions.AbsTol); + end + else %# if (vstepsizegiven == true) + vdelta = 1; vtau = 2; + end + + %# If the error is acceptable then update the vretval variables + if (all (vdelta <= vtau)) + vtimestamp = vtimestamp + vstepsize; + vu = y5'; %# MC2001: the higher order estimation as "local extrapolation" + vretvaltime(vcntloop,:) = vtimestamp; + if (vhaveoutputselection) + vretvalresult(vcntloop,:) = vu(vodeoptions.OutputSel); + else + vretvalresult(vcntloop,:) = vu; + end + vcntloop = vcntloop + 1; vcntiter = 0; + + %# Update DDE values for next history calculation + vsaveddetime(end+1) = vtimestamp; + vsaveddeinput(end+1,:) = vtheinput'; + vsavedderesult(end+1,:) = vu; + + %# Call plot only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if plot function + %# returns false + if (vhaveoutputfunction) + if (vhaverefine) %# Do interpolation + for vcnt = 0:vodeoptions.Refine %# Approximation between told and t + vapproxtime = (vcnt + 1) * vstepsize / (vodeoptions.Refine + 2); + vapproxvals = vSaveVUForRefine' + vapproxtime * (vk * vb5); + if (vhaveoutputselection) + vapproxvals = vapproxvals(vodeoptions.OutputSel); + end + feval (vodeoptions.OutputFcn, (vtimestamp - vstepsize) + vapproxtime, ... + vapproxvals, [], vfunarguments{:}); + end + end + vpltret = feval (vodeoptions.OutputFcn, vtimestamp, ... + vretvalresult(vcntloop-1,:)', [], vfunarguments{:}); + if (vpltret), vunhandledtermination = false; break; end + end + + %# Call event only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if veventbreak is + %# true + if (vhaveeventfunction) + vevent = ... + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + {vu(:), vhmat}, [], vfunarguments{:}); + if (~isempty (vevent{1}) && vevent{1} == 1) + vretvaltime(vcntloop-1,:) = vevent{3}(end,:); + vretvalresult(vcntloop-1,:) = vevent{4}(end,:); + vunhandledtermination = false; break; + end + end + end %# If the error is acceptable ... + + %# Update the step size for the next integration step + if (~vstepsizegiven) + %# vdelta may be 0 or even negative - could be an iteration problem + vdelta = max (vdelta, eps); + vstepsize = min (vodeoptions.MaxStep, ... + min (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + elseif (vstepsizegiven) + if (vcntloop < vtimelength) + vstepsize = vslot(1,vcntloop-1) - vslot(1,vcntloop-2); + end + end + + %# Update counters that count the number of iteration cycles + vcntcycles = vcntcycles + 1; %# Needed for postprocessing + vcntiter = vcntiter + 1; %# Needed to find iteration problems + + %# Stop solving because the last 1000 steps no successful valid + %# value has been found + if (vcntiter >= 5000) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f before endpoint at', ... + ' tend = %f was reached. This happened because the iterative', ... + ' integration loop does not find a valid solution at this time', ... + ' stamp. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + end + + end %# The main loop + + %# Check if integration of the ode has been successful + if (vtimestamp < vtimestop) + if (vunhandledtermination == true) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f', ... + ' before endpoint at tend = %f was reached. This may', ... + ' happen if the stepsize grows smaller than defined in', ... + ' vminstepsize. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + else + warning ('OdePkg:HideWarning', ... + ['Solver has been stopped by a call of "break" in', ... + ' the main iteration loop at time t = %f before endpoint at', ... + ' tend = %f was reached. This may happen because the @odeplot', ... + ' function returned "true" or the @event function returned "true".'], ... + vtimestamp, vtimestop); + end + end + + %# Postprocessing, do whatever when terminating integration algorithm + if (vhaveoutputfunction) %# Cleanup plotter + feval (vodeoptions.OutputFcn, vtimestamp, ... + vretvalresult(vcntloop-1,:)', 'done', vfunarguments{:}); + end + if (vhaveeventfunction) %# Cleanup event function handling + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + {vretvalresult(vcntloop-1,:), vhmat}, 'done', vfunarguments{:}); + end + + %# Print additional information if option Stats is set + if (strcmp (vodeoptions.Stats, 'on')) + vhavestats = true; + vnsteps = vcntloop-2; %# vcntloop from 2..end + vnfailed = (vcntcycles-1)-(vcntloop-2)+1; %# vcntcycl from 1..end + vnfevals = 7*(vcntcycles-1); %# number of ode evaluations + vndecomps = 0; %# number of LU decompositions + vnpds = 0; %# number of partial derivatives + vnlinsols = 0; %# no. of solutions of linear systems + %# Print cost statistics if no output argument is given + if (nargout == 0) + vmsg = fprintf (1, 'Number of successful steps: %d', vnsteps); + vmsg = fprintf (1, 'Number of failed attempts: %d', vnfailed); + vmsg = fprintf (1, 'Number of function calls: %d', vnfevals); + end + else vhavestats = false; + end + + if (nargout == 1) %# Sort output variables, depends on nargout + varargout{1}.x = vretvaltime; %# Time stamps are saved in field x + varargout{1}.y = vretvalresult; %# Results are saved in field y + varargout{1}.solver = 'ode54d'; %# Solver name is saved in field solver + if (vhaveeventfunction) + varargout{1}.ie = vevent{2}; %# Index info which event occured + varargout{1}.xe = vevent{3}; %# Time info when an event occured + varargout{1}.ye = vevent{4}; %# Results when an event occured + end + if (vhavestats) + varargout{1}.stats = struct; + varargout{1}.stats.nsteps = vnsteps; + varargout{1}.stats.nfailed = vnfailed; + varargout{1}.stats.nfevals = vnfevals; + varargout{1}.stats.npds = vnpds; + varargout{1}.stats.ndecomps = vndecomps; + varargout{1}.stats.nlinsols = vnlinsols; + end + elseif (nargout == 2) + varargout{1} = vretvaltime; %# Time stamps are first output argument + varargout{2} = vretvalresult; %# Results are second output argument + elseif (nargout == 5) + varargout{1} = vretvaltime; %# Same as (nargout == 2) + varargout{2} = vretvalresult; %# Same as (nargout == 2) + varargout{3} = []; %# LabMat doesn't accept lines like + varargout{4} = []; %# varargout{3} = varargout{4} = []; + varargout{5} = []; + if (vhaveeventfunction) + varargout{3} = vevent{3}; %# Time info when an event occured + varargout{4} = vevent{4}; %# Results when an event occured + varargout{5} = vevent{2}; %# Index info which event occured + end + %# else nothing will be returned, varargout{1} undefined + end + +%! # We are using a "pseudo-DDE" implementation for all tests that +%! # are done for this function. We also define an Events and a +%! # pseudo-Mass implementation. For further tests we also define a +%! # reference solution (computed at high accuracy) and an OutputFcn. +%!function [vyd] = fexp (vt, vy, vz, varargin) +%! vyd(1,1) = exp (- vt) - vz(1); %# The DDEs that are +%! vyd(2,1) = vy(1) - vz(2); %# used for all examples +%!function [vval, vtrm, vdir] = feve (vt, vy, vz, varargin) +%! vval = fexp (vt, vy, vz); %# We use the derivatives +%! vtrm = zeros (2,1); %# don't stop solving here +%! vdir = ones (2,1); %# in positive direction +%!function [vval, vtrm, vdir] = fevn (vt, vy, vz, varargin) +%! vval = fexp (vt, vy, vz); %# We use the derivatives +%! vtrm = ones (2,1); %# stop solving here +%! vdir = ones (2,1); %# in positive direction +%!function [vmas] = fmas (vt, vy, vz, varargin) +%! vmas = [1, 0; 0, 1]; %# Dummy mass matrix for tests +%!function [vmas] = fmsa (vt, vy, vz, varargin) +%! vmas = sparse ([1, 0; 0, 1]); %# A dummy sparse matrix +%!function [vref] = fref () %# The reference solution +%! vref = [0.12194462133618, 0.01652432423938]; +%!function [vout] = fout (vt, vy, vflag, varargin) +%! if (regexp (char (vflag), 'init') == 1) +%! if (any (size (vt) ~= [2, 1])) error ('"fout" step "init"'); end +%! elseif (isempty (vflag)) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "calc"'); end +%! vout = false; +%! elseif (regexp (char (vflag), 'done') == 1) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "done"'); end +%! else error ('"fout" invalid vflag'); +%! end +%! +%! %# Turn off output of warning messages for all tests, turn them on +%! %# again if the last test is called +%!error %# input argument number one +%! warning ('off', 'OdePkg:InvalidOption'); +%! B = ode54d (1, [0 5], [1; 0], 1, [1; 0]); +%!error %# input argument number two +%! B = ode54d (@fexp, 1, [1; 0], 1, [1; 0]); +%!error %# input argument number three +%! B = ode54d (@fexp, [0 5], 1, 1, [1; 0]); +%!error %# input argument number four +%! B = ode54d (@fexp, [0 5], [1; 0], [1; 1], [1; 0]); +%!error %# input argument number five +%! B = ode54d (@fexp, [0 5], [1; 0], 1, 1); +%!test %# one output argument +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%! assert (isfield (vsol, 'solver')); +%! assert (vsol.solver, 'ode54d'); +%!test %# two output arguments +%! [vt, vy] = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vt(end), vy(end,:)], [5, fref], 1e-1); +%!test %# five output arguments and no Events +%! [vt, vy, vxe, vye, vie] = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vt(end), vy(end,:)], [5, fref], 1e-1); +%! assert ([vie, vxe, vye], []); +%!test %# anonymous function instead of real function +%! faym = @(vt, vy, vz) [exp(-vt) - vz(1); vy(1) - vz(2)]; +%! vsol = ode54d (faym, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# extra input arguments passed trhough +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# empty OdePkg structure *but* extra input arguments +%! vopt = odeset; +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt, 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!error %# strange OdePkg structure +%! vopt = struct ('foo', 1); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%!test %# AbsTol option +%! vopt = odeset ('AbsTol', 1e-5); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# AbsTol and RelTol option +%! vopt = odeset ('AbsTol', 1e-7, 'RelTol', 1e-7); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# RelTol and NormControl option +%! vopt = odeset ('AbsTol', 1e-7, 'NormControl', 'on'); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], .5e-1); +%!test %# NonNegative for second component +%! vopt = odeset ('NonNegative', 1); +%! vsol = ode54d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2.5, 0.001, 0.237], 1e-1); +%!test %# Details of OutputSel and Refine can't be tested +%! vopt = odeset ('OutputFcn', @fout, 'OutputSel', 1, 'Refine', 5); +%! vsol = ode54d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt); +%!test %# Stats must add further elements in vsol +%! vopt = odeset ('Stats', 'on'); +%! vsol = ode54d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt); +%! assert (isfield (vsol, 'stats')); +%! assert (isfield (vsol.stats, 'nsteps')); +%!test %# InitialStep option +%! vopt = odeset ('InitialStep', 1e-8); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# MaxStep option +%! vopt = odeset ('MaxStep', 1e-2); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# Events option add further elements in vsol +%! vopt = odeset ('Events', @feve); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert (isfield (vsol, 'ie')); +%! assert (vsol.ie, [1; 1]); +%! assert (isfield (vsol, 'xe')); +%! assert (isfield (vsol, 'ye')); +%!test %# Events option, now stop integration +%! warning ('off', 'OdePkg:HideWarning'); +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.ie, vsol.xe, vsol.ye], ... +%! [1.0000, 2.9219, -0.2127, -0.2671], 1e-1); +%!test %# Events option, five output arguments +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! [vt, vy, vxe, vye, vie] = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vie, vxe, vye], ... +%! [1.0000, 2.9219, -0.2127, -0.2671], 1e-1); +%! +%! %# test for Jacobian option is missing +%! %# test for Jacobian (being a sparse matrix) is missing +%! %# test for JPattern option is missing +%! %# test for Vectorized option is missing +%! %# test for NewtonTol option is missing +%! %# test for MaxNewtonIterations option is missing +%! +%!test %# Mass option as function +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# Mass option as matrix +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# Mass option as sparse matrix +%! vopt = odeset ('Mass', sparse (eye (2,2))); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# Mass option as function and sparse matrix +%! vopt = odeset ('Mass', @fmsa); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# Mass option as function and MStateDependence +%! vopt = odeset ('Mass', @fmas, 'MStateDependence', 'strong'); +%! vsol = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 1e-1); +%!test %# Set BDF option to something else than default +%! vopt = odeset ('BDF', 'on'); +%! [vt, vy] = ode54d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vt(end), vy(end,:)], [5, fref], 0.5); +%! +%! %# test for MvPattern option is missing +%! %# test for InitialSlope option is missing +%! %# test for MaxOrder option is missing +%! +%! warning ('on', 'OdePkg:InvalidOption'); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/ode78.m b/octave_packages/odepkg-0.8.2/ode78.m new file mode 100644 index 0000000..b8781a3 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/ode78.m @@ -0,0 +1,779 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} ode78 (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{sol}] =} ode78 (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{t}, @var{y}, [@var{xe}, @var{ye}, @var{ie}]] =} ode78 (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# +%# This function file can be used to solve a set of non--stiff ordinary differential equations (non--stiff ODEs) or non--stiff differential algebraic equations (non--stiff DAEs) with the well known explicit Runge--Kutta method of order (7,8). +%# +%# If this function is called with no return argument then plot the solution over time in a figure window while solving the set of ODEs that are defined in a function and specified by the function handle @var{@@fun}. The second input argument @var{slot} is a double vector that defines the time slot, @var{init} is a double vector that defines the initial values of the states, @var{opt} can optionally be a structure array that keeps the options created with the command @command{odeset} and @var{par1}, @var{par2}, @dots{} can optionally be other input arguments of any type that have to be passed to the function defined by @var{@@fun}. +%# +%# If this function is called with one return argument then return the solution @var{sol} of type structure array after solving the set of ODEs. The solution @var{sol} has the fields @var{x} of type double column vector for the steps chosen by the solver, @var{y} of type double column vector for the solutions at each time step of @var{x}, @var{solver} of type string for the solver name and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector that keep the informations of the event function if an event function handle is set in the option argument @var{opt}. +%# +%# If this function is called with more than one return argument then return the time stamps @var{t}, the solution values @var{y} and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector. +%# +%# For example, solve an anonymous implementation of the Van der Pol equation +%# +%# @example +%# fvdb = @@(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%# +%# vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ +%# "NormControl", "on", "OutputFcn", @@odeplot); +%# ode78 (fvdb, [0 20], [2 0], vopt); +%# @end example +%# @end deftypefn +%# +%# @seealso{odepkg} + +%# ChangeLog: +%# 20010519 the function file "ode78.m" was written by Marc Compere +%# under the GPL for the use with this software. This function has been +%# taken as a base for the following implementation. +%# 20060810, Thomas Treichl +%# This function was adapted to the new syntax that is used by the +%# new OdePkg for Octave. An equivalent function in Matlab does not +%# exist. + +function [varargout] = ode78 (vfun, vslot, vinit, varargin) + + if (nargin == 0) %# Check number and types of all input arguments + help ('ode78'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be greater than zero'); + + elseif (nargin < 3) + print_usage; + + elseif ~(isa (vfun, 'function_handle') || isa (vfun, 'inline')) + error ('OdePkg:InvalidArgument', ... + 'First input argument must be a valid function handle'); + + elseif (~isvector (vslot) || length (vslot) < 2) + error ('OdePkg:InvalidArgument', ... + 'Second input argument must be a valid vector'); + + elseif (~isvector (vinit) || ~isnumeric (vinit)) + error ('OdePkg:InvalidArgument', ... + 'Third input argument must be a valid numerical value'); + + elseif (nargin >= 4) + + if (~isstruct (varargin{1})) + %# varargin{1:len} are parameters for vfun + vodeoptions = odeset; + vfunarguments = varargin; + + elseif (length (varargin) > 1) + %# varargin{1} is an OdePkg options structure vopt + vodeoptions = odepkg_structure_check (varargin{1}, 'ode78'); + vfunarguments = {varargin{2:length(varargin)}}; + + else %# if (isstruct (varargin{1})) + vodeoptions = odepkg_structure_check (varargin{1}, 'ode78'); + vfunarguments = {}; + + end + + else %# if (nargin == 3) + vodeoptions = odeset; + vfunarguments = {}; + end + + %# Start preprocessing, have a look which options are set in + %# vodeoptions, check if an invalid or unused option is set + vslot = vslot(:).'; %# Create a row vector + vinit = vinit(:).'; %# Create a row vector + if (length (vslot) > 2) %# Step size checking + vstepsizefixed = true; + else + vstepsizefixed = false; + end + + %# Get the default options that can be set with 'odeset' temporarily + vodetemp = odeset; + + %# Implementation of the option RelTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.RelTol) && ~vstepsizefixed) + vodeoptions.RelTol = 1e-6; + warning ('OdePkg:InvalidArgument', ... + 'Option "RelTol" not set, new value %f is used', vodeoptions.RelTol); + elseif (~isempty (vodeoptions.RelTol) && vstepsizefixed) + warning ('OdePkg:InvalidArgument', ... + 'Option "RelTol" will be ignored if fixed time stamps are given'); + end + + %# Implementation of the option AbsTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.AbsTol) && ~vstepsizefixed) + vodeoptions.AbsTol = 1e-6; + warning ('OdePkg:InvalidArgument', ... + 'Option "AbsTol" not set, new value %f is used', vodeoptions.AbsTol); + elseif (~isempty (vodeoptions.AbsTol) && vstepsizefixed) + warning ('OdePkg:InvalidArgument', ... + 'Option "AbsTol" will be ignored if fixed time stamps are given'); + else + vodeoptions.AbsTol = vodeoptions.AbsTol(:); %# Create column vector + end + + %# Implementation of the option NormControl has been finished. This + %# option can be set by the user to another value than default value. + if (strcmp (vodeoptions.NormControl, 'on')) vnormcontrol = true; + else vnormcontrol = false; end + + %# Implementation of the option NonNegative has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.NonNegative)) + if (isempty (vodeoptions.Mass)), vhavenonnegative = true; + else + vhavenonnegative = false; + warning ('OdePkg:InvalidArgument', ... + 'Option "NonNegative" will be ignored if mass matrix is set'); + end + else vhavenonnegative = false; + end + + %# Implementation of the option OutputFcn has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputFcn) && nargout == 0) + vodeoptions.OutputFcn = @odeplot; + vhaveoutputfunction = true; + elseif (isempty (vodeoptions.OutputFcn)), vhaveoutputfunction = false; + else vhaveoutputfunction = true; + end + + %# Implementation of the option OutputSel has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.OutputSel)), vhaveoutputselection = true; + else vhaveoutputselection = false; end + + %# Implementation of the option OutputSave has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputSave)), vodeoptions.OutputSave = 1; + end + + %# Implementation of the option Refine has been finished. This option + %# can be set by the user to another value than default value. + if (vodeoptions.Refine > 0), vhaverefine = true; + else vhaverefine = false; end + + %# Implementation of the option Stats has been finished. This option + %# can be set by the user to another value than default value. + + %# Implementation of the option InitialStep has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.InitialStep) && ~vstepsizefixed) + vodeoptions.InitialStep = (vslot(1,2) - vslot(1,1)) / 10; + vodeoptions.InitialStep = vodeoptions.InitialStep / 10^vodeoptions.Refine; + warning ('OdePkg:InvalidArgument', ... + 'Option "InitialStep" not set, new value %f is used', vodeoptions.InitialStep); + end + + %# Implementation of the option MaxStep has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.MaxStep) && ~vstepsizefixed) + vodeoptions.MaxStep = abs (vslot(1,2) - vslot(1,1)) / 10; + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxStep" not set, new value %f is used', vodeoptions.MaxStep); + end + + %# Implementation of the option Events has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Events)), vhaveeventfunction = true; + else vhaveeventfunction = false; end + + %# The options 'Jacobian', 'JPattern' and 'Vectorized' will be ignored + %# by this solver because this solver uses an explicit Runge-Kutta + %# method and therefore no Jacobian calculation is necessary + if (~isequal (vodeoptions.Jacobian, vodetemp.Jacobian)) + warning ('OdePkg:InvalidArgument', ... + 'Option "Jacobian" will be ignored by this solver'); + end + if (~isequal (vodeoptions.JPattern, vodetemp.JPattern)) + warning ('OdePkg:InvalidArgument', ... + 'Option "JPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.Vectorized, vodetemp.Vectorized)) + warning ('OdePkg:InvalidArgument', ... + 'Option "Vectorized" will be ignored by this solver'); + end + if (~isequal (vodeoptions.NewtonTol, vodetemp.NewtonTol)) + warning ('OdePkg:InvalidArgument', ... + 'Option "NewtonTol" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxNewtonIterations,... + vodetemp.MaxNewtonIterations)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxNewtonIterations" will be ignored by this solver'); + end + + %# Implementation of the option Mass has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Mass) && isnumeric (vodeoptions.Mass)) + vhavemasshandle = false; vmass = vodeoptions.Mass; %# constant mass + elseif (isa (vodeoptions.Mass, 'function_handle')) + vhavemasshandle = true; %# mass defined by a function handle + else %# no mass matrix - creating a diag-matrix of ones for mass + vhavemasshandle = false; %# vmass = diag (ones (length (vinit), 1), 0); + end + + %# Implementation of the option MStateDependence has been finished. + %# This option can be set by the user to another value than default + %# value. + if (strcmp (vodeoptions.MStateDependence, 'none')) + vmassdependence = false; + else vmassdependence = true; + end + + %# Other options that are not used by this solver. Print a warning + %# message to tell the user that the option(s) is/are ignored. + if (~isequal (vodeoptions.MvPattern, vodetemp.MvPattern)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MvPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MassSingular, vodetemp.MassSingular)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MassSingular" will be ignored by this solver'); + end + if (~isequal (vodeoptions.InitialSlope, vodetemp.InitialSlope)) + warning ('OdePkg:InvalidArgument', ... + 'Option "InitialSlope" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxOrder, vodetemp.MaxOrder)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxOrder" will be ignored by this solver'); + end + if (~isequal (vodeoptions.BDF, vodetemp.BDF)) + warning ('OdePkg:InvalidArgument', ... + 'Option "BDF" will be ignored by this solver'); + end + + %# Starting the initialisation of the core solver ode78 + vtimestamp = vslot(1,1); %# timestamp = start time + vtimelength = length (vslot); %# length needed if fixed steps + vtimestop = vslot(1,vtimelength); %# stop time = last value + %# 20110611, reported by Nils Strunk + %# Make it possible to solve equations from negativ to zero, + %# eg. vres = ode78 (@(t,y) y, [-2 0], 2); + vdirection = sign (vtimestop - vtimestamp); %# Direction flag + + if (~vstepsizefixed) + if (sign (vodeoptions.InitialStep) == vdirection) + vstepsize = vodeoptions.InitialStep; + else %# Fix wrong direction of InitialStep. + vstepsize = - vodeoptions.InitialStep; + end + vminstepsize = (vtimestop - vtimestamp) / (1/eps); + else %# If step size is given then use the fixed time steps + vstepsize = vslot(1,2) - vslot(1,1); + vminstepsize = sign (vstepsize) * eps; + end + + vretvaltime = vtimestamp; %# first timestamp output + vretvalresult = vinit; %# first solution output + + %# Initialize the OutputFcn + if (vhaveoutputfunction) + if (vhaveoutputselection) vretout = vretvalresult(vodeoptions.OutputSel); + else vretout = vretvalresult; end + feval (vodeoptions.OutputFcn, vslot.', ... + vretout.', 'init', vfunarguments{:}); + end + + %# Initialize the EventFcn + if (vhaveeventfunction) + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vretvalresult.', 'init', vfunarguments{:}); + end + + vpow = 1/8; %# MC2001: see p.91 in Ascher & Petzold + va = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0; %# The 7(8) coefficients + 1/18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0; %# Coefficients proved, tt 20060827 + 1/48, 1/16, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0; + 1/32, 0, 3/32, 0, 0, 0, 0, 0, 0, 0, 0, 0; + 5/16, 0, -75/64, 75/64, 0, 0, 0, 0, 0, 0, 0, 0; + 3/80, 0, 0, 3/16, 3/20, 0, 0, 0, 0, 0, 0, 0; + 29443841/614563906, 0, 0, 77736538/692538347, -28693883/1125000000, ... + 23124283/1800000000, 0, 0, 0, 0, 0, 0; + 16016141/946692911, 0, 0, 61564180/158732637, 22789713/633445777, ... + 545815736/2771057229, -180193667/1043307555, 0, 0, 0, 0, 0; + 39632708/573591083, 0, 0, -433636366/683701615, -421739975/2616292301, ... + 100302831/723423059, 790204164/839813087, 800635310/3783071287, 0, 0, 0, 0; + 246121993/1340847787, 0, 0, -37695042795/15268766246, -309121744/1061227803, ... + -12992083/490766935, 6005943493/2108947869, 393006217/1396673457, ... + 123872331/1001029789, 0, 0, 0; + -1028468189/846180014, 0, 0, 8478235783/508512852, 1311729495/1432422823, ... + -10304129995/1701304382, -48777925059/3047939560, 15336726248/1032824649, ... + -45442868181/3398467696, 3065993473/597172653, 0, 0; + 185892177/718116043, 0, 0, -3185094517/667107341, -477755414/1098053517, ... + -703635378/230739211, 5731566787/1027545527, 5232866602/850066563, ... + -4093664535/808688257, 3962137247/1805957418, 65686358/487910083, 0; + 403863854/491063109, 0, 0, -5068492393/434740067, -411421997/543043805, ... + 652783627/914296604, 11173962825/925320556, -13158990841/6184727034, ... + 3936647629/1978049680, -160528059/685178525, 248638103/1413531060, 0]; + vb7 = [13451932/455176623; 0; 0; 0; 0; -808719846/976000145; ... + 1757004468/5645159321; 656045339/265891186; -3867574721/1518517206; ... + 465885868/322736535; 53011238/667516719; 2/45; 0]; + vb8 = [14005451/335480064; 0; 0; 0; 0; -59238493/1068277825; 181606767/758867731; ... + 561292985/797845732; -1041891430/1371343529; 760417239/1151165299; ... + 118820643/751138087; -528747749/2220607170; 1/4]; + vc = sum (va, 2); + + %# The solver main loop - stop if the endpoint has been reached + vcntloop = 2; vcntcycles = 1; vu = vinit; vk = vu' * zeros(1,13); + vcntiter = 0; vunhandledtermination = true; vcntsave = 2; + while ((vdirection * (vtimestamp) < vdirection * (vtimestop)) && ... + (vdirection * (vstepsize) >= vdirection * (vminstepsize))) + + %# Hit the endpoint of the time slot exactely + if (vdirection * (vtimestamp + vstepsize) > vdirection * vtimestop) + %# vstepsize = vtimestop - vdirection * vtimestamp; + %# 20110611, reported by Nils Strunk + %# The endpoint of the time slot must be hit exactly, + %# eg. vsol = ode78 (@(t,y) y, [0 -1], 1); + vstepsize = vdirection * abs (abs (vtimestop) - abs (vtimestamp)); + end + + %# Estimate the thirteen results when using this solver + for j = 1:13 + vthetime = vtimestamp + vc(j,1) * vstepsize; + vtheinput = vu.' + vstepsize * vk(:,1:j-1) * va(j,1:j-1).'; + if (vhavemasshandle) %# Handle only the dynamic mass matrix, + if (vmassdependence) %# constant mass matrices have already + vmass = feval ... %# been set before (if any) + (vodeoptions.Mass, vthetime, vtheinput, vfunarguments{:}); + else %# if (vmassdependence == false) + vmass = feval ... %# then we only have the time argument + (vodeoptions.Mass, vthetime, vfunarguments{:}); + end + vk(:,j) = vmass \ feval ... + (vfun, vthetime, vtheinput, vfunarguments{:}); + else + vk(:,j) = feval ... + (vfun, vthetime, vtheinput, vfunarguments{:}); + end + end + + %# Compute the 7th and the 8th order estimation + y7 = vu.' + vstepsize * (vk * vb7); + y8 = vu.' + vstepsize * (vk * vb8); + if (vhavenonnegative) + vu(vodeoptions.NonNegative) = abs (vu(vodeoptions.NonNegative)); + y7(vodeoptions.NonNegative) = abs (y7(vodeoptions.NonNegative)); + y8(vodeoptions.NonNegative) = abs (y8(vodeoptions.NonNegative)); + end + if (vhaveoutputfunction && vhaverefine) + vSaveVUForRefine = vu; + end + + %# Calculate the absolute local truncation error and the acceptable error + if (~vstepsizefixed) + if (~vnormcontrol) + vdelta = abs (y8 - y7); + vtau = max (vodeoptions.RelTol * abs (vu.'), vodeoptions.AbsTol); + else + vdelta = norm (y8 - y7, Inf); + vtau = max (vodeoptions.RelTol * max (norm (vu.', Inf), 1.0), ... + vodeoptions.AbsTol); + end + else %# if (vstepsizefixed == true) + vdelta = 1; vtau = 2; + end + + %# If the error is acceptable then update the vretval variables + if (all (vdelta <= vtau)) + vtimestamp = vtimestamp + vstepsize; + vu = y8.'; %# MC2001: the higher order estimation as "local extrapolation" + %# Save the solution every vodeoptions.OutputSave steps + if (mod (vcntloop-1,vodeoptions.OutputSave) == 0) + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu; + vcntsave = vcntsave + 1; + end + vcntloop = vcntloop + 1; vcntiter = 0; + + %# Call plot only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if plot function + %# returns false + if (vhaveoutputfunction) + for vcnt = 0:vodeoptions.Refine %# Approximation between told and t + if (vhaverefine) %# Do interpolation + vapproxtime = (vcnt + 1) * vstepsize / (vodeoptions.Refine + 2); + vapproxvals = vSaveVUForRefine.' + vapproxtime * (vk * vb8); + vapproxtime = (vtimestamp - vstepsize) + vapproxtime; + else + vapproxvals = vu.'; + vapproxtime = vtimestamp; + end + if (vhaveoutputselection) + vapproxvals = vapproxvals(vodeoptions.OutputSel); + end + vpltret = feval (vodeoptions.OutputFcn, vapproxtime, ... + vapproxvals, [], vfunarguments{:}); + if vpltret %# Leave refinement loop + break; + end + end + if (vpltret) %# Leave main loop + vunhandledtermination = false; + break; + end + end + + %# Call event only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if veventbreak is + %# true + if (vhaveeventfunction) + vevent = ... + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vu(:), [], vfunarguments{:}); + if (~isempty (vevent{1}) && vevent{1} == 1) + vretvaltime(vcntloop-1,:) = vevent{3}(end,:); + vretvalresult(vcntloop-1,:) = vevent{4}(end,:); + vunhandledtermination = false; break; + end + end + end %# If the error is acceptable ... + + %# Update the step size for the next integration step + if (~vstepsizefixed) + %# 20080425, reported by Marco Caliari + %# vdelta cannot be negative (because of the absolute value that + %# has been introduced) but it could be 0, then replace the zeros + %# with the maximum value of vdelta + vdelta(find (vdelta == 0)) = max (vdelta); + %# It could happen that max (vdelta) == 0 (ie. that the original + %# vdelta was 0), in that case we double the previous vstepsize + vdelta(find (vdelta == 0)) = max (vtau) .* (0.4 ^ (1 / vpow)); + + if (vdirection == 1) + vstepsize = min (vodeoptions.MaxStep, ... + min (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + else + vstepsize = max (- vodeoptions.MaxStep, ... + max (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + end + + else %# if (vstepsizefixed) + if (vcntloop <= vtimelength) + vstepsize = vslot(vcntloop) - vslot(vcntloop-1); + else %# Get out of the main integration loop + break; + end + end + + %# Update counters that count the number of iteration cycles + vcntcycles = vcntcycles + 1; %# Needed for cost statistics + vcntiter = vcntiter + 1; %# Needed to find iteration problems + + %# Stop solving because the last 1000 steps no successful valid + %# value has been found + if (vcntiter >= 5000) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f before endpoint at', ... + ' tend = %f was reached. This happened because the iterative', ... + ' integration loop does not find a valid solution at this time', ... + ' stamp. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + end + + end %# The main loop + + %# Check if integration of the ode has been successful + if (vdirection * vtimestamp < vdirection * vtimestop) + if (vunhandledtermination == true) + error ('OdePkg:InvalidArgument', ... + ['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f', ... + ' before endpoint at tend = %f was reached. This may', ... + ' happen if the stepsize grows smaller than defined in', ... + ' vminstepsize. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + else + warning ('OdePkg:InvalidArgument', ... + ['Solver has been stopped by a call of "break" in', ... + ' the main iteration loop at time t = %f before endpoint at', ... + ' tend = %f was reached. This may happen because the @odeplot', ... + ' function returned "true" or the @event function returned "true".'], ... + vtimestamp, vtimestop); + end + end + + %# Postprocessing, do whatever when terminating integration algorithm + if (vhaveoutputfunction) %# Cleanup plotter + feval (vodeoptions.OutputFcn, vtimestamp, ... + vu.', 'done', vfunarguments{:}); + end + if (vhaveeventfunction) %# Cleanup event function handling + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vu.', 'done', vfunarguments{:}); + end + %# Save the last step, if not already saved + if (mod (vcntloop-2,vodeoptions.OutputSave) ~= 0) + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu; + end + + %# Print additional information if option Stats is set + if (strcmp (vodeoptions.Stats, 'on')) + vhavestats = true; + vnsteps = vcntloop-2; %# vcntloop from 2..end + vnfailed = (vcntcycles-1)-(vcntloop-2)+1; %# vcntcycl from 1..end + vnfevals = 13*(vcntcycles-1); %# number of ode evaluations + vndecomps = 0; %# number of LU decompositions + vnpds = 0; %# number of partial derivatives + vnlinsols = 0; %# no. of solutions of linear systems + %# Print cost statistics if no output argument is given + if (nargout == 0) + vmsg = fprintf (1, 'Number of successful steps: %d\n', vnsteps); + vmsg = fprintf (1, 'Number of failed attempts: %d\n', vnfailed); + vmsg = fprintf (1, 'Number of function calls: %d\n', vnfevals); + end + else + vhavestats = false; + end + + if (nargout == 1) %# Sort output variables, depends on nargout + varargout{1}.x = vretvaltime; %# Time stamps are saved in field x + varargout{1}.y = vretvalresult; %# Results are saved in field y + varargout{1}.solver = 'ode78'; %# Solver name is saved in field solver + if (vhaveeventfunction) + varargout{1}.ie = vevent{2}; %# Index info which event occured + varargout{1}.xe = vevent{3}; %# Time info when an event occured + varargout{1}.ye = vevent{4}; %# Results when an event occured + end + if (vhavestats) + varargout{1}.stats = struct; + varargout{1}.stats.nsteps = vnsteps; + varargout{1}.stats.nfailed = vnfailed; + varargout{1}.stats.nfevals = vnfevals; + varargout{1}.stats.npds = vnpds; + varargout{1}.stats.ndecomps = vndecomps; + varargout{1}.stats.nlinsols = vnlinsols; + end + elseif (nargout == 2) + varargout{1} = vretvaltime; %# Time stamps are first output argument + varargout{2} = vretvalresult; %# Results are second output argument + elseif (nargout == 5) + varargout{1} = vretvaltime; %# Same as (nargout == 2) + varargout{2} = vretvalresult; %# Same as (nargout == 2) + varargout{3} = []; %# LabMat doesn't accept lines like + varargout{4} = []; %# varargout{3} = varargout{4} = []; + varargout{5} = []; + if (vhaveeventfunction) + varargout{3} = vevent{3}; %# Time info when an event occured + varargout{4} = vevent{4}; %# Results when an event occured + varargout{5} = vevent{2}; %# Index info which event occured + end + end +end + +%! # We are using the "Van der Pol" implementation for all tests that +%! # are done for this function. We also define a Jacobian, Events, +%! # pseudo-Mass implementation. For further tests we also define a +%! # reference solution (computed at high accuracy) and an OutputFcn +%!function [ydot] = fpol (vt, vy, varargin) %# The Van der Pol +%! ydot = [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%!function [vjac] = fjac (vt, vy, varargin) %# its Jacobian +%! vjac = [0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]; +%!function [vjac] = fjcc (vt, vy, varargin) %# sparse type +%! vjac = sparse ([0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]); +%!function [vval, vtrm, vdir] = feve (vt, vy, varargin) +%! vval = fpol (vt, vy, varargin); %# We use the derivatives +%! vtrm = zeros (2,1); %# that's why component 2 +%! vdir = ones (2,1); %# seems to not be exact +%!function [vval, vtrm, vdir] = fevn (vt, vy, varargin) +%! vval = fpol (vt, vy, varargin); %# We use the derivatives +%! vtrm = ones (2,1); %# that's why component 2 +%! vdir = ones (2,1); %# seems to not be exact +%!function [vmas] = fmas (vt, vy) +%! vmas = [1, 0; 0, 1]; %# Dummy mass matrix for tests +%!function [vmas] = fmsa (vt, vy) +%! vmas = sparse ([1, 0; 0, 1]); %# A sparse dummy matrix +%!function [vref] = fref () %# The computed reference sol +%! vref = [0.32331666704577, -1.83297456798624]; +%!function [vout] = fout (vt, vy, vflag, varargin) +%! if (regexp (char (vflag), 'init') == 1) +%! if (any (size (vt) ~= [2, 1])) error ('"fout" step "init"'); end +%! elseif (isempty (vflag)) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "calc"'); end +%! vout = false; +%! elseif (regexp (char (vflag), 'done') == 1) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "done"'); end +%! else error ('"fout" invalid vflag'); +%! end +%! +%! %# Turn off output of warning messages for all tests, turn them on +%! %# again if the last test is called +%!error %# input argument number one +%! warning ('off', 'OdePkg:InvalidArgument'); +%! B = ode78 (1, [0 25], [3 15 1]); +%!error %# input argument number two +%! B = ode78 (@fpol, 1, [3 15 1]); +%!error %# input argument number three +%! B = ode78 (@flor, [0 25], 1); +%!test %# one output argument +%! vsol = ode78 (@fpol, [0 2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%! assert (isfield (vsol, 'solver')); +%! assert (vsol.solver, 'ode78'); +%!test %# two output arguments +%! [vt, vy] = ode78 (@fpol, [0 2], [2 0]); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%!test %# five output arguments and no Events +%! [vt, vy, vxe, vye, vie] = ode78 (@fpol, [0 2], [2 0]); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%! assert ([vie, vxe, vye], []); +%!test %# anonymous function instead of real function +%! fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%! vsol = ode78 (fvdb, [0 2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# extra input arguments passed through +%! vsol = ode78 (@fpol, [0 2], [2 0], 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# empty OdePkg structure *but* extra input arguments +%! vopt = odeset; +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt, 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!error %# strange OdePkg structure +%! vopt = struct ('foo', 1); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%!test %# Solve vdp in fixed step sizes +%! vsol = ode78 (@fpol, [0:0.1:2], [2 0]); +%! assert (vsol.x(:), [0:0.1:2]'); +%! assert (vsol.y(end,:), fref, 1e-3); +%!test %# Solve in backward direction starting at t=0 +%! vref = [-1.205364552835178, 0.951542399860817]; +%! vsol = ode78 (@fpol, [0 -2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [-2, vref], 1e-3); +%!test %# Solve in backward direction starting at t=2 +%! vref = [-1.205364552835178, 0.951542399860817]; +%! vsol = ode78 (@fpol, [2 -2], fref); +%! assert ([vsol.x(end), vsol.y(end,:)], [-2, vref], 1e-3); +%!test %# Solve another anonymous function in backward direction +%! vref = [-1, 0.367879437558975]; +%! vsol = ode78 (@(t,y) y, [0 -1], 1); +%! assert ([vsol.x(end), vsol.y(end,:)], vref, 1e-3); +%!test %# Solve another anonymous function below zero +%! vref = [0, 14.77810590694212]; +%! vsol = ode78 (@(t,y) y, [-2 0], 2); +%! assert ([vsol.x(end), vsol.y(end,:)], vref, 1e-3); +%!test %# AbsTol option +%! vopt = odeset ('AbsTol', 1e-5); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# AbsTol and RelTol option +%! vopt = odeset ('AbsTol', 1e-8, 'RelTol', 1e-8); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# RelTol and NormControl option -- higher accuracy +%! vopt = odeset ('RelTol', 1e-8, 'NormControl', 'on'); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-6); +%!test %# Keeps initial values while integrating +%! vopt = odeset ('NonNegative', 2); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, 2, 0], 3e-1); +%!test %# Details of OutputSel and Refine can't be tested +%! vopt = odeset ('OutputFcn', @fout, 'OutputSel', 1, 'Refine', 5); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%!test %# Details of OutputSave can't be tested +%! vopt = odeset ('OutputSave', 1, 'OutputSel', 1); +%! vsla = ode78 (@fpol, [0 2], [2 0], vopt); +%! vopt = odeset ('OutputSave', 2); +%! vslb = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert (length (vsla.x) > length (vslb.x)) +%!test %# Stats must add further elements in vsol +%! vopt = odeset ('Stats', 'on'); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert (isfield (vsol, 'stats')); +%! assert (isfield (vsol.stats, 'nsteps')); +%!test %# InitialStep option +%! vopt = odeset ('InitialStep', 1e-8); +%! vsol = ode78 (@fpol, [0 0.2], [2 0], vopt); +%! assert ([vsol.x(2)-vsol.x(1)], [1e-8], 1e-9); +%!test %# MaxStep option +%! vopt = odeset ('MaxStep', 1e-2); +%! vsol = ode78 (@fpol, [0 0.2], [2 0], vopt); +%! %# assert ([vsol.x(5)-vsol.x(4)], [1e-2], 1e-3); +%!test %# Events option add further elements in vsol +%! vopt = odeset ('Events', @feve, 'InitialStep', 1e-4); +%! vsol = ode78 (@fpol, [0 10], [2 0], vopt); +%! assert (isfield (vsol, 'ie')); +%! assert (vsol.ie(1), 2); +%! assert (isfield (vsol, 'xe')); +%! assert (isfield (vsol, 'ye')); +%!test %# Events option, now stop integration +%! vopt = odeset ('Events', @fevn, 'InitialStep', 1e-4); +%! vsol = ode78 (@fpol, [0 10], [2 0], vopt); +%! assert ([vsol.ie, vsol.xe, vsol.ye], ... +%! [2.0, 2.496110, -0.830550, -2.677589], 2e-1); +%!test %# Events option, five output arguments +%! vopt = odeset ('Events', @fevn, 'InitialStep', 1e-4); +%! [vt, vy, vxe, vye, vie] = ode78 (@fpol, [0 10], [2 0], vopt); +%! assert ([vie, vxe, vye], ... +%! [2.0, 2.496110, -0.830550, -2.677589], 2e-1); +%!test %# Jacobian option +%! vopt = odeset ('Jacobian', @fjac); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Jacobian option and sparse return value +%! vopt = odeset ('Jacobian', @fjcc); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%! +%! %# test for JPattern option is missing +%! %# test for Vectorized option is missing +%! %# test for NewtonTol option is missing +%! %# test for MaxNewtonIterations option is missing +%! +%!test %# Mass option as function +%! vopt = odeset ('Mass', @fmas); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as matrix +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as sparse matrix +%! vopt = odeset ('Mass', sparse (eye (2,2))); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as function and sparse matrix +%! vopt = odeset ('Mass', @fmsa); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as function and MStateDependence +%! vopt = odeset ('Mass', @fmas, 'MStateDependence', 'strong'); +%! vsol = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Set BDF option to something else than default +%! vopt = odeset ('BDF', 'on'); +%! [vt, vy] = ode78 (@fpol, [0 2], [2 0], vopt); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%! +%! %# test for MvPattern option is missing +%! %# test for InitialSlope option is missing +%! %# test for MaxOrder option is missing +%! +%! warning ('on', 'OdePkg:InvalidArgument'); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** + diff --git a/octave_packages/odepkg-0.8.2/ode78d.m b/octave_packages/odepkg-0.8.2/ode78d.m new file mode 100644 index 0000000..e698ffa --- /dev/null +++ b/octave_packages/odepkg-0.8.2/ode78d.m @@ -0,0 +1,789 @@ +%# Copyright (C) 2008-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} ode78d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{sol}] =} ode78d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{t}, @var{y}, [@var{xe}, @var{ye}, @var{ie}]] =} ode78d (@var{@@fun}, @var{slot}, @var{init}, @var{lags}, @var{hist}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# +%# This function file can be used to solve a set of non--stiff delay differential equations (non--stiff DDEs) with a modified version of the well known explicit Runge--Kutta method of order (7,8). +%# +%# If this function is called with no return argument then plot the solution over time in a figure window while solving the set of DDEs that are defined in a function and specified by the function handle @var{@@fun}. The second input argument @var{slot} is a double vector that defines the time slot, @var{init} is a double vector that defines the initial values of the states, @var{lags} is a double vector that describes the lags of time, @var{hist} is a double matrix and describes the history of the DDEs, @var{opt} can optionally be a structure array that keeps the options created with the command @command{odeset} and @var{par1}, @var{par2}, @dots{} can optionally be other input arguments of any type that have to be passed to the function defined by @var{@@fun}. +%# +%# In other words, this function will solve a problem of the form +%# @example +%# dy/dt = fun (t, y(t), y(t-lags(1), y(t-lags(2), @dots{}))) +%# y(slot(1)) = init +%# y(slot(1)-lags(1)) = hist(1), y(slot(1)-lags(2)) = hist(2), @dots{} +%# @end example +%# +%# If this function is called with one return argument then return the solution @var{sol} of type structure array after solving the set of DDEs. The solution @var{sol} has the fields @var{x} of type double column vector for the steps chosen by the solver, @var{y} of type double column vector for the solutions at each time step of @var{x}, @var{solver} of type string for the solver name and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector that keep the informations of the event function if an event function handle is set in the option argument @var{opt}. +%# +%# If this function is called with more than one return argument then return the time stamps @var{t}, the solution values @var{y} and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector. +%# +%# For example: +%# @itemize @minus +%# @item +%# the following code solves an anonymous implementation of a chaotic behavior +%# +%# @example +%# fcao = @@(vt, vy, vz) [2 * vz / (1 + vz^9.65) - vy]; +%# +%# vopt = odeset ("NormControl", "on", "RelTol", 1e-3); +%# vsol = ode78d (fcao, [0, 100], 0.5, 2, 0.5, vopt); +%# +%# vlag = interp1 (vsol.x, vsol.y, vsol.x - 2); +%# plot (vsol.y, vlag); legend ("fcao (t,y,z)"); +%# @end example +%# +%# @item +%# to solve the following problem with two delayed state variables +%# +%# @example +%# d y1(t)/dt = -y1(t) +%# d y2(t)/dt = -y2(t) + y1(t-5) +%# d y3(t)/dt = -y3(t) + y2(t-10)*y1(t-10) +%# @end example +%# +%# one might do the following +%# +%# @example +%# function f = fun (t, y, yd) +%# f(1) = -y(1); %% y1' = -y1(t) +%# f(2) = -y(2) + yd(1,1); %% y2' = -y2(t) + y1(t-lags(1)) +%# f(3) = -y(3) + yd(2,2)*yd(1,2); %% y3' = -y3(t) + y2(t-lags(2))*y1(t-lags(2)) +%# endfunction +%# T = [0,20] +%# res = ode78d (@@fun, T, [1;1;1], [5, 10], ones (3,2)); +%# @end example +%# +%# @end itemize +%# @end deftypefn +%# +%# @seealso{odepkg} + +function [varargout] = ode78d (vfun, vslot, vinit, vlags, vhist, varargin) + + if (nargin == 0) %# Check number and types of all input arguments + help ('ode78d'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be greater than zero'); + + elseif (nargin < 5) + print_usage; + + elseif (~isa (vfun, 'function_handle')) + error ('OdePkg:InvalidArgument', ... + 'First input argument must be a valid function handle'); + + elseif (~isvector (vslot) || length (vslot) < 2) + error ('OdePkg:InvalidArgument', ... + 'Second input argument must be a valid vector'); + + elseif (~isvector (vinit) || ~isnumeric (vinit)) + error ('OdePkg:InvalidArgument', ... + 'Third input argument must be a valid numerical value'); + + elseif (~isvector (vlags) || ~isnumeric (vlags)) + error ('OdePkg:InvalidArgument', ... + 'Fourth input argument must be a valid numerical value'); + + elseif ~(isnumeric (vhist) || isa (vhist, 'function_handle')) + error ('OdePkg:InvalidArgument', ... + 'Fifth input argument must either be numeric or a function handle'); + + elseif (nargin >= 6) + + if (~isstruct (varargin{1})) + %# varargin{1:len} are parameters for vfun + vodeoptions = odeset; + vfunarguments = varargin; + + elseif (length (varargin) > 1) + %# varargin{1} is an OdePkg options structure vopt + vodeoptions = odepkg_structure_check (varargin{1}, 'ode78d'); + vfunarguments = {varargin{2:length(varargin)}}; + + else %# if (isstruct (varargin{1})) + vodeoptions = odepkg_structure_check (varargin{1}, 'ode78d'); + vfunarguments = {}; + + end + + else %# if (nargin == 5) + vodeoptions = odeset; + vfunarguments = {}; + end + + %# Start preprocessing, have a look which options have been set in + %# vodeoptions. Check if an invalid or unused option has been set and + %# print warnings. + vslot = vslot(:)'; %# Create a row vector + vinit = vinit(:)'; %# Create a row vector + vlags = vlags(:)'; %# Create a row vector + + %# Check if the user has given fixed points of time + if (length (vslot) > 2), vstepsizegiven = true; %# Step size checking + else vstepsizegiven = false; end + + %# Get the default options that can be set with 'odeset' temporarily + vodetemp = odeset; + + %# Implementation of the option RelTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.RelTol) && ~vstepsizegiven) + vodeoptions.RelTol = 1e-6; + warning ('OdePkg:InvalidOption', ... + 'Option "RelTol" not set, new value %f is used', vodeoptions.RelTol); + elseif (~isempty (vodeoptions.RelTol) && vstepsizegiven) + warning ('OdePkg:InvalidOption', ... + 'Option "RelTol" will be ignored if fixed time stamps are given'); + %# This implementation has been added to odepkg_structure_check.m + %# elseif (~isscalar (vodeoptions.RelTol) && ~vstepsizegiven) + %# error ('OdePkg:InvalidOption', ... + %# 'Option "RelTol" must be set to a scalar value for this solver'); + end + + %# Implementation of the option AbsTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.AbsTol) && ~vstepsizegiven) + vodeoptions.AbsTol = 1e-6; + warning ('OdePkg:InvalidOption', ... + 'Option "AbsTol" not set, new value %f is used', vodeoptions.AbsTol); + elseif (~isempty (vodeoptions.AbsTol) && vstepsizegiven) + warning ('OdePkg:InvalidOption', ... + 'Option "AbsTol" will be ignored if fixed time stamps are given'); + else %# create column vector + vodeoptions.AbsTol = vodeoptions.AbsTol(:); + end + + %# Implementation of the option NormControl has been finished. This + %# option can be set by the user to another value than default value. + if (strcmp (vodeoptions.NormControl, 'on')), vnormcontrol = true; + else vnormcontrol = false; + end + + %# Implementation of the option NonNegative has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.NonNegative)) + if (isempty (vodeoptions.Mass)), vhavenonnegative = true; + else + vhavenonnegative = false; + warning ('OdePkg:InvalidOption', ... + 'Option "NonNegative" will be ignored if mass matrix is set'); + end + else vhavenonnegative = false; + end + + %# Implementation of the option OutputFcn has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputFcn) && nargout == 0) + vodeoptions.OutputFcn = @odeplot; + vhaveoutputfunction = true; + elseif (isempty (vodeoptions.OutputFcn)), vhaveoutputfunction = false; + else vhaveoutputfunction = true; + end + + %# Implementation of the option OutputSel has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.OutputSel)), vhaveoutputselection = true; + else vhaveoutputselection = false; end + + %# Implementation of the option Refine has been finished. This option + %# can be set by the user to another value than default value. + if (isequal (vodeoptions.Refine, vodetemp.Refine)), vhaverefine = true; + else vhaverefine = false; end + + %# Implementation of the option Stats has been finished. This option + %# can be set by the user to another value than default value. + + %# Implementation of the option InitialStep has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.InitialStep) && ~vstepsizegiven) + vodeoptions.InitialStep = abs (vslot(1,1) - vslot(1,2)) / 10; + vodeoptions.InitialStep = vodeoptions.InitialStep / 10^vodeoptions.Refine; + warning ('OdePkg:InvalidOption', ... + 'Option "InitialStep" not set, new value %f is used', vodeoptions.InitialStep); + end + + %# Implementation of the option MaxStep has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.MaxStep) && ~vstepsizegiven) + vodeoptions.MaxStep = abs (vslot(1,1) - vslot(1,length (vslot))) / 10; + %# vodeoptions.MaxStep = vodeoptions.MaxStep / 10^vodeoptions.Refine; + warning ('OdePkg:InvalidOption', ... + 'Option "MaxStep" not set, new value %f is used', vodeoptions.MaxStep); + end + + %# Implementation of the option Events has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Events)), vhaveeventfunction = true; + else vhaveeventfunction = false; end + + %# The options 'Jacobian', 'JPattern' and 'Vectorized' will be ignored + %# by this solver because this solver uses an explicit Runge-Kutta + %# method and therefore no Jacobian calculation is necessary + if (~isequal (vodeoptions.Jacobian, vodetemp.Jacobian)) + warning ('OdePkg:InvalidOption', ... + 'Option "Jacobian" will be ignored by this solver'); + end + if (~isequal (vodeoptions.JPattern, vodetemp.JPattern)) + warning ('OdePkg:InvalidOption', ... + 'Option "JPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.Vectorized, vodetemp.Vectorized)) + warning ('OdePkg:InvalidOption', ... + 'Option "Vectorized" will be ignored by this solver'); + end + if (~isequal (vodeoptions.NewtonTol, vodetemp.NewtonTol)) + warning ('OdePkg:InvalidArgument', ... + 'Option "NewtonTol" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxNewtonIterations,... + vodetemp.MaxNewtonIterations)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxNewtonIterations" will be ignored by this solver'); + end + + %# Implementation of the option Mass has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Mass) && isnumeric (vodeoptions.Mass)) + vhavemasshandle = false; vmass = vodeoptions.Mass; %# constant mass + elseif (isa (vodeoptions.Mass, 'function_handle')) + vhavemasshandle = true; %# mass defined by a function handle + else %# no mass matrix - creating a diag-matrix of ones for mass + vhavemasshandle = false; %# vmass = diag (ones (length (vinit), 1), 0); + end + + %# Implementation of the option MStateDependence has been finished. + %# This option can be set by the user to another value than default + %# value. + if (strcmp (vodeoptions.MStateDependence, 'none')) + vmassdependence = false; + else vmassdependence = true; + end + + %# Other options that are not used by this solver. Print a warning + %# message to tell the user that the option(s) is/are ignored. + if (~isequal (vodeoptions.MvPattern, vodetemp.MvPattern)) + warning ('OdePkg:InvalidOption', ... + 'Option "MvPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MassSingular, vodetemp.MassSingular)) + warning ('OdePkg:InvalidOption', ... + 'Option "MassSingular" will be ignored by this solver'); + end + if (~isequal (vodeoptions.InitialSlope, vodetemp.InitialSlope)) + warning ('OdePkg:InvalidOption', ... + 'Option "InitialSlope" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxOrder, vodetemp.MaxOrder)) + warning ('OdePkg:InvalidOption', ... + 'Option "MaxOrder" will be ignored by this solver'); + end + if (~isequal (vodeoptions.BDF, vodetemp.BDF)) + warning ('OdePkg:InvalidOption', ... + 'Option "BDF" will be ignored by this solver'); + end + + %# Starting the initialisation of the core solver ode78d + vtimestamp = vslot(1,1); %# timestamp = start time + vtimelength = length (vslot); %# length needed if fixed steps + vtimestop = vslot(1,vtimelength); %# stop time = last value + + if (~vstepsizegiven) + vstepsize = vodeoptions.InitialStep; + vminstepsize = (vtimestop - vtimestamp) / (1/eps); + else %# If step size is given then use the fixed time steps + vstepsize = abs (vslot(1,1) - vslot(1,2)); + vminstepsize = eps; %# vslot(1,2) - vslot(1,1) - eps; + end + + vretvaltime = vtimestamp; %# first timestamp output + if (vhaveoutputselection) %# first solution output + vretvalresult = vinit(vodeoptions.OutputSel); + else vretvalresult = vinit; + end + + %# Initialize the OutputFcn + if (vhaveoutputfunction) + feval (vodeoptions.OutputFcn, vslot', ... + vretvalresult', 'init', vfunarguments{:}); + end + + %# Initialize the History + if (isnumeric (vhist)) + vhmat = vhist; + vhavehistnumeric = true; + else %# it must be a function handle + for vcnt = 1:length (vlags); + vhmat(:,vcnt) = feval (vhist, (vslot(1)-vlags(vcnt)), vfunarguments{:}); + end + vhavehistnumeric = false; + end + + %# Initialize DDE variables for history calculation + vsaveddetime = [vtimestamp - vlags, vtimestamp]'; + vsaveddeinput = [vhmat, vinit']'; + vsavedderesult = [vhmat, vinit']'; + + %# Initialize the EventFcn + if (vhaveeventfunction) + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + {vretvalresult', vhmat}, 'init', vfunarguments{:}); + end + + vpow = 1/8; %# MC2001: see p.91 in Ascher & Petzold + va = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0; %# The 7(8) coefficients + 1/18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0; %# Coefficients proved, tt 20060827 + 1/48, 1/16, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0; + 1/32, 0, 3/32, 0, 0, 0, 0, 0, 0, 0, 0, 0; + 5/16, 0, -75/64, 75/64, 0, 0, 0, 0, 0, 0, 0, 0; + 3/80, 0, 0, 3/16, 3/20, 0, 0, 0, 0, 0, 0, 0; + 29443841/614563906, 0, 0, 77736538/692538347, -28693883/1125000000, ... + 23124283/1800000000, 0, 0, 0, 0, 0, 0; + 16016141/946692911, 0, 0, 61564180/158732637, 22789713/633445777, ... + 545815736/2771057229, -180193667/1043307555, 0, 0, 0, 0, 0; + 39632708/573591083, 0, 0, -433636366/683701615, -421739975/2616292301, ... + 100302831/723423059, 790204164/839813087, 800635310/3783071287, 0, 0, 0, 0; + 246121993/1340847787, 0, 0, -37695042795/15268766246, -309121744/1061227803, ... + -12992083/490766935, 6005943493/2108947869, 393006217/1396673457, ... + 123872331/1001029789, 0, 0, 0; + -1028468189/846180014, 0, 0, 8478235783/508512852, 1311729495/1432422823, ... + -10304129995/1701304382, -48777925059/3047939560, 15336726248/1032824649, ... + -45442868181/3398467696, 3065993473/597172653, 0, 0; + 185892177/718116043, 0, 0, -3185094517/667107341, -477755414/1098053517, ... + -703635378/230739211, 5731566787/1027545527, 5232866602/850066563, ... + -4093664535/808688257, 3962137247/1805957418, 65686358/487910083, 0; + 403863854/491063109, 0, 0, -5068492393/434740067, -411421997/543043805, ... + 652783627/914296604, 11173962825/925320556, -13158990841/6184727034, ... + 3936647629/1978049680, -160528059/685178525, 248638103/1413531060, 0]; + vb7 = [13451932/455176623; 0; 0; 0; 0; -808719846/976000145; ... + 1757004468/5645159321; 656045339/265891186; -3867574721/1518517206; ... + 465885868/322736535; 53011238/667516719; 2/45; 0]; + vb8 = [14005451/335480064; 0; 0; 0; 0; -59238493/1068277825; 181606767/758867731; ... + 561292985/797845732; -1041891430/1371343529; 760417239/1151165299; ... + 118820643/751138087; -528747749/2220607170; 1/4]; + vc = sum (va, 2); + + %# The solver main loop - stop if the endpoint has been reached + vcntloop = 2; vcntcycles = 1; vu = vinit; vk = vu' * zeros(1,13); + vcntiter = 0; vunhandledtermination = true; + while ((vtimestamp < vtimestop && vstepsize >= vminstepsize)) + + %# Hit the endpoint of the time slot exactely + if ((vtimestamp + vstepsize) > vtimestop) + vstepsize = vtimestop - vtimestamp; end + + %# Estimate the thirteen results when using this solver + for j = 1:13 + vthetime = vtimestamp + vc(j,1) * vstepsize; + vtheinput = vu' + vstepsize * vk(:,1:j-1) * va(j,1:j-1)'; + %# Claculate the history values (or get them from an external + %# function) that are needed for the next step of solving + if (vhavehistnumeric) + for vcnt = 1:length (vlags) + %# Direct implementation of a 'quadrature cubic Hermite interpolation' + %# found at the Faculty for Mathematics of the University of Stuttgart + %# http://mo.mathematik.uni-stuttgart.de/inhalt/aussage/aussage1269 + vnumb = find (vthetime - vlags(vcnt) >= vsaveddetime); + velem = min (vnumb(end), length (vsaveddetime) - 1); + vstep = vsaveddetime(velem+1) - vsaveddetime(velem); + vdiff = (vthetime - vlags(vcnt) - vsaveddetime(velem)) / vstep; + vsubs = 1 - vdiff; + %# Calculation of the coefficients for the interpolation algorithm + vua = (1 + 2 * vdiff) * vsubs^2; + vub = (3 - 2 * vdiff) * vdiff^2; + vva = vstep * vdiff * vsubs^2; + vvb = -vstep * vsubs * vdiff^2; + vhmat(:,vcnt) = vua * vsaveddeinput(velem,:)' + ... + vub * vsaveddeinput(velem+1,:)' + ... + vva * vsavedderesult(velem,:)' + ... + vvb * vsavedderesult(velem+1,:)'; + end + else %# the history must be a function handle + for vcnt = 1:length (vlags) + vhmat(:,vcnt) = feval ... + (vhist, vthetime - vlags(vcnt), vfunarguments{:}); + end + end + + if (vhavemasshandle) %# Handle only the dynamic mass matrix, + if (vmassdependence) %# constant mass matrices have already + vmass = feval ... %# been set before (if any) + (vodeoptions.Mass, vthetime, vtheinput, vfunarguments{:}); + else %# if (vmassdependence == false) + vmass = feval ... %# then we only have the time argument + (vodeoptions.Mass, vthetime, vfunarguments{:}); + end + vk(:,j) = vmass \ feval ... + (vfun, vthetime, vtheinput, vhmat, vfunarguments{:}); + else + vk(:,j) = feval ... + (vfun, vthetime, vtheinput, vhmat, vfunarguments{:}); + end + end + + %# Compute the 7th and the 8th order estimation + y7 = vu' + vstepsize * (vk * vb7); + y8 = vu' + vstepsize * (vk * vb8); + if (vhavenonnegative) + vu(vodeoptions.NonNegative) = abs (vu(vodeoptions.NonNegative)); + y7(vodeoptions.NonNegative) = abs (y7(vodeoptions.NonNegative)); + y8(vodeoptions.NonNegative) = abs (y8(vodeoptions.NonNegative)); + end + vSaveVUForRefine = vu; + + %# Calculate the absolute local truncation error and the acceptable error + if (~vstepsizegiven) + if (~vnormcontrol) + vdelta = y8 - y7; + vtau = max (vodeoptions.RelTol * vu', vodeoptions.AbsTol); + else + vdelta = norm (y8 - y7, Inf); + vtau = max (vodeoptions.RelTol * max (norm (vu', Inf), 1.0), ... + vodeoptions.AbsTol); + end + else %# if (vstepsizegiven == true) + vdelta = 1; vtau = 2; + end + + %# If the error is acceptable then update the vretval variables + if (all (vdelta <= vtau)) + vtimestamp = vtimestamp + vstepsize; + vu = y8'; %# MC2001: the higher order estimation as "local extrapolation" + vretvaltime(vcntloop,:) = vtimestamp; + if (vhaveoutputselection) + vretvalresult(vcntloop,:) = vu(vodeoptions.OutputSel); + else + vretvalresult(vcntloop,:) = vu; + end + vcntloop = vcntloop + 1; vcntiter = 0; + + %# Update DDE values for next history calculation + vsaveddetime(end+1) = vtimestamp; + vsaveddeinput(end+1,:) = vtheinput'; + vsavedderesult(end+1,:) = vu; + + %# Call plot only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if plot function + %# returns false + if (vhaveoutputfunction) + if (vhaverefine) %# Do interpolation + for vcnt = 0:vodeoptions.Refine %# Approximation between told and t + vapproxtime = (vcnt + 1) * vstepsize / (vodeoptions.Refine + 2); + vapproxvals = vSaveVUForRefine' + vapproxtime * (vk * vb8); + if (vhaveoutputselection) + vapproxvals = vapproxvals(vodeoptions.OutputSel); + end + feval (vodeoptions.OutputFcn, (vtimestamp - vstepsize) + vapproxtime, ... + vapproxvals, [], vfunarguments{:}); + end + end + vpltret = feval (vodeoptions.OutputFcn, vtimestamp, ... + vretvalresult(vcntloop-1,:)', [], vfunarguments{:}); + if (vpltret), vunhandledtermination = false; break; end + end + + %# Call event only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if veventbreak is + %# true + if (vhaveeventfunction) + vevent = ... + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + {vu(:), vhmat}, [], vfunarguments{:}); + if (~isempty (vevent{1}) && vevent{1} == 1) + vretvaltime(vcntloop-1,:) = vevent{3}(end,:); + vretvalresult(vcntloop-1,:) = vevent{4}(end,:); + vunhandledtermination = false; break; + end + end + end %# If the error is acceptable ... + + %# Update the step size for the next integration step + if (~vstepsizegiven) + %# vdelta may be 0 or even negative - could be an iteration problem + vdelta = max (vdelta, eps); + vstepsize = min (vodeoptions.MaxStep, ... + min (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + elseif (vstepsizegiven) + if (vcntloop < vtimelength) + vstepsize = vslot(1,vcntloop-1) - vslot(1,vcntloop-2); + end + end + + %# Update counters that count the number of iteration cycles + vcntcycles = vcntcycles + 1; %# Needed for postprocessing + vcntiter = vcntiter + 1; %# Needed to find iteration problems + + %# Stop solving because the last 1000 steps no successful valid + %# value has been found + if (vcntiter >= 5000) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f before endpoint at', ... + ' tend = %f was reached. This happened because the iterative', ... + ' integration loop does not find a valid solution at this time', ... + ' stamp. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + end + + end %# The main loop + + %# Check if integration of the ode has been successful + if (vtimestamp < vtimestop) + if (vunhandledtermination == true) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f', ... + ' before endpoint at tend = %f was reached. This may', ... + ' happen if the stepsize grows smaller than defined in', ... + ' vminstepsize. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + else + warning ('OdePkg:HideWarning', ... + ['Solver has been stopped by a call of "break" in', ... + ' the main iteration loop at time t = %f before endpoint at', ... + ' tend = %f was reached. This may happen because the @odeplot', ... + ' function returned "true" or the @event function returned "true".'], ... + vtimestamp, vtimestop); + end + end + + %# Postprocessing, do whatever when terminating integration algorithm + if (vhaveoutputfunction) %# Cleanup plotter + feval (vodeoptions.OutputFcn, vtimestamp, ... + vretvalresult(vcntloop-1,:)', 'done', vfunarguments{:}); + end + if (vhaveeventfunction) %# Cleanup event function handling + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + {vretvalresult(vcntloop-1,:), vhmat}, 'done', vfunarguments{:}); + end + + %# Print additional information if option Stats is set + if (strcmp (vodeoptions.Stats, 'on')) + vhavestats = true; + vnsteps = vcntloop-2; %# vcntloop from 2..end + vnfailed = (vcntcycles-1)-(vcntloop-2)+1; %# vcntcycl from 1..end + vnfevals = 13*(vcntcycles-1); %# number of ode evaluations + vndecomps = 0; %# number of LU decompositions + vnpds = 0; %# number of partial derivatives + vnlinsols = 0; %# no. of solutions of linear systems + %# Print cost statistics if no output argument is given + if (nargout == 0) + vmsg = fprintf (1, 'Number of successful steps: %d', vnsteps); + vmsg = fprintf (1, 'Number of failed attempts: %d', vnfailed); + vmsg = fprintf (1, 'Number of function calls: %d', vnfevals); + end + else vhavestats = false; + end + + if (nargout == 1) %# Sort output variables, depends on nargout + varargout{1}.x = vretvaltime; %# Time stamps are saved in field x + varargout{1}.y = vretvalresult; %# Results are saved in field y + varargout{1}.solver = 'ode78d'; %# Solver name is saved in field solver + if (vhaveeventfunction) + varargout{1}.ie = vevent{2}; %# Index info which event occured + varargout{1}.xe = vevent{3}; %# Time info when an event occured + varargout{1}.ye = vevent{4}; %# Results when an event occured + end + if (vhavestats) + varargout{1}.stats = struct; + varargout{1}.stats.nsteps = vnsteps; + varargout{1}.stats.nfailed = vnfailed; + varargout{1}.stats.nfevals = vnfevals; + varargout{1}.stats.npds = vnpds; + varargout{1}.stats.ndecomps = vndecomps; + varargout{1}.stats.nlinsols = vnlinsols; + end + elseif (nargout == 2) + varargout{1} = vretvaltime; %# Time stamps are first output argument + varargout{2} = vretvalresult; %# Results are second output argument + elseif (nargout == 5) + varargout{1} = vretvaltime; %# Same as (nargout == 2) + varargout{2} = vretvalresult; %# Same as (nargout == 2) + varargout{3} = []; %# LabMat doesn't accept lines like + varargout{4} = []; %# varargout{3} = varargout{4} = []; + varargout{5} = []; + if (vhaveeventfunction) + varargout{3} = vevent{3}; %# Time info when an event occured + varargout{4} = vevent{4}; %# Results when an event occured + varargout{5} = vevent{2}; %# Index info which event occured + end + %# else nothing will be returned, varargout{1} undefined + end + +%! # We are using a "pseudo-DDE" implementation for all tests that +%! # are done for this function. We also define an Events and a +%! # pseudo-Mass implementation. For further tests we also define a +%! # reference solution (computed at high accuracy) and an OutputFcn. +%!function [vyd] = fexp (vt, vy, vz, varargin) +%! vyd(1,1) = exp (- vt) - vz(1); %# The DDEs that are +%! vyd(2,1) = vy(1) - vz(2); %# used for all examples +%!function [vval, vtrm, vdir] = feve (vt, vy, vz, varargin) +%! vval = fexp (vt, vy, vz); %# We use the derivatives +%! vtrm = zeros (2,1); %# don't stop solving here +%! vdir = ones (2,1); %# in positive direction +%!function [vval, vtrm, vdir] = fevn (vt, vy, vz, varargin) +%! vval = fexp (vt, vy, vz); %# We use the derivatives +%! vtrm = ones (2,1); %# stop solving here +%! vdir = ones (2,1); %# in positive direction +%!function [vmas] = fmas (vt, vy, vz, varargin) +%! vmas = [1, 0; 0, 1]; %# Dummy mass matrix for tests +%!function [vmas] = fmsa (vt, vy, vz, varargin) +%! vmas = sparse ([1, 0; 0, 1]); %# A dummy sparse matrix +%!function [vref] = fref () %# The reference solution +%! vref = [0.12194462133618, 0.01652432423938]; +%!function [vout] = fout (vt, vy, vflag, varargin) +%! if (regexp (char (vflag), 'init') == 1) +%! if (any (size (vt) ~= [2, 1])) error ('"fout" step "init"'); end +%! elseif (isempty (vflag)) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "calc"'); end +%! vout = false; +%! elseif (regexp (char (vflag), 'done') == 1) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "done"'); end +%! else error ('"fout" invalid vflag'); +%! end +%! +%! %# Turn off output of warning messages for all tests, turn them on +%! %# again if the last test is called +%!error %# input argument number one +%! warning ('off', 'OdePkg:InvalidOption'); +%! B = ode78d (1, [0 5], [1; 0], 1, [1; 0]); +%!error %# input argument number two +%! B = ode78d (@fexp, 1, [1; 0], 1, [1; 0]); +%!error %# input argument number three +%! B = ode78d (@fexp, [0 5], 1, 1, [1; 0]); +%!error %# input argument number four +%! B = ode78d (@fexp, [0 5], [1; 0], [1; 1], [1; 0]); +%!error %# input argument number five +%! B = ode78d (@fexp, [0 5], [1; 0], 1, 1); +%!test %# one output argument +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%! assert (isfield (vsol, 'solver')); +%! assert (vsol.solver, 'ode78d'); +%!test %# two output arguments +%! [vt, vy] = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vt(end), vy(end,:)], [5, fref], 0.2); +%!test %# five output arguments and no Events +%! [vt, vy, vxe, vye, vie] = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vt(end), vy(end,:)], [5, fref], 0.2); +%! assert ([vie, vxe, vye], []); +%!test %# anonymous function instead of real function +%! faym = @(vt, vy, vz) [exp(-vt) - vz(1); vy(1) - vz(2)]; +%! vsol = ode78d (faym, [0 5], [1; 0], 1, [1; 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!test %# extra input arguments passed trhough +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!test %# empty OdePkg structure *but* extra input arguments +%! vopt = odeset; +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt, 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!error %# strange OdePkg structure +%! vopt = struct ('foo', 1); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%!test %# AbsTol option +%! vopt = odeset ('AbsTol', 1e-5); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!test %# AbsTol and RelTol option +%! vopt = odeset ('AbsTol', 1e-7, 'RelTol', 1e-7); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!test %# RelTol and NormControl option +%! vopt = odeset ('AbsTol', 1e-7, 'NormControl', 'on'); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!test %# NonNegative for second component +%! vopt = odeset ('NonNegative', 1); +%! vsol = ode78d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2.5, 0.001, 0.237], 0.2); +%!test %# Details of OutputSel and Refine can't be tested +%! vopt = odeset ('OutputFcn', @fout, 'OutputSel', 1, 'Refine', 5); +%! vsol = ode78d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt); +%!test %# Stats must add further elements in vsol +%! vopt = odeset ('Stats', 'on'); +%! vsol = ode78d (@fexp, [0 2.5], [1; 0], 1, [1; 0], vopt); +%! assert (isfield (vsol, 'stats')); +%! assert (isfield (vsol.stats, 'nsteps')); +%!test %# InitialStep option +%! vopt = odeset ('InitialStep', 1e-8); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!test %# MaxStep option +%! vopt = odeset ('MaxStep', 1e-2); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!test %# Events option add further elements in vsol +%! vopt = odeset ('Events', @feve); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert (isfield (vsol, 'ie')); +%! assert (vsol.ie, [1; 1]); +%! assert (isfield (vsol, 'xe')); +%! assert (isfield (vsol, 'ye')); +%!test %# Events option, now stop integration +%! warning ('off', 'OdePkg:HideWarning'); +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.ie, vsol.xe, vsol.ye], ... +%! [1.0000, 2.9219, -0.2127, -0.2671], 0.2); +%!test %# Events option, five output arguments +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! [vt, vy, vxe, vye, vie] = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vie, vxe, vye], ... +%! [1.0000, 2.9219, -0.2127, -0.2671], 0.2); +%! +%! %# test for Jacobian option is missing +%! %# test for Jacobian (being a sparse matrix) is missing +%! %# test for JPattern option is missing +%! %# test for Vectorized option is missing +%! %# test for NewtonTol option is missing +%! %# test for MaxNewtonIterations option is missing +%! +%!test %# Mass option as function +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!test %# Mass option as matrix +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!test %# Mass option as sparse matrix +%! vopt = odeset ('Mass', sparse (eye (2,2))); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!test %# Mass option as function and sparse matrix +%! vopt = odeset ('Mass', @fmsa); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!test %# Mass option as function and MStateDependence +%! vopt = odeset ('Mass', @fmas, 'MStateDependence', 'strong'); +%! vsol = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [5, fref], 0.2); +%!test %# Set BDF option to something else than default +%! vopt = odeset ('BDF', 'on'); +%! [vt, vy] = ode78d (@fexp, [0 5], [1; 0], 1, [1; 0], vopt); +%! assert ([vt(end), vy(end,:)], [5, fref], 0.5); +%! +%! %# test for MvPattern option is missing +%! %# test for InitialSlope option is missing +%! %# test for MaxOrder option is missing +%! +%! warning ('on', 'OdePkg:InvalidOption'); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odebwe.m b/octave_packages/odepkg-0.8.2/odebwe.m new file mode 100644 index 0000000..9f4286a --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odebwe.m @@ -0,0 +1,804 @@ +%# Copyright (C) 2009-2012, Sebastian Schoeps +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} odebwe (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{sol}] =} odebwe (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# @deftypefnx {Command} {[@var{t}, @var{y}, [@var{xe}, @var{ye}, @var{ie}]] =} odebwe (@var{@@fun}, @var{slot}, @var{init}, [@var{opt}], [@var{par1}, @var{par2}, @dots{}]) +%# +%# This function file can be used to solve a set of stiff ordinary differential equations (stiff ODEs) or stiff differential algebraic equations (stiff DAEs) with the Backward Euler method. +%# +%# If this function is called with no return argument then plot the solution over time in a figure window while solving the set of ODEs that are defined in a function and specified by the function handle @var{@@fun}. The second input argument @var{slot} is a double vector that defines the time slot, @var{init} is a double vector that defines the initial values of the states, @var{opt} can optionally be a structure array that keeps the options created with the command @command{odeset} and @var{par1}, @var{par2}, @dots{} can optionally be other input arguments of any type that have to be passed to the function defined by @var{@@fun}. +%# +%# If this function is called with one return argument then return the solution @var{sol} of type structure array after solving the set of ODEs. The solution @var{sol} has the fields @var{x} of type double column vector for the steps chosen by the solver, @var{y} of type double column vector for the solutions at each time step of @var{x}, @var{solver} of type string for the solver name and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector that keep the informations of the event function if an event function handle is set in the option argument @var{opt}. +%# +%# If this function is called with more than one return argument then return the time stamps @var{t}, the solution values @var{y} and optionally the extended time stamp information @var{xe}, the extended solution information @var{ye} and the extended index information @var{ie} all of type double column vector. +%# +%# For example, solve an anonymous implementation of the Van der Pol equation +%# +%# @example +%# fvdb = @@(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%# vjac = @@(vt,vy) [0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]; +%# vopt = odeset ("RelTol", 1e-3, "AbsTol", 1e-3, \ +%# "NormControl", "on", "OutputFcn", @@odeplot, \ +%# "Jacobian",vjac); +%# odebwe (fvdb, [0 20], [2 0], vopt); +%# @end example +%# @end deftypefn +%# +%# @seealso{odepkg} + +function [varargout] = odebwe (vfun, vslot, vinit, varargin) + + if (nargin == 0) %# Check number and types of all input arguments + help ('odebwe'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be greater than zero'); + + elseif (nargin < 3) + print_usage; + + elseif ~(isa (vfun, 'function_handle') || isa (vfun, 'inline')) + error ('OdePkg:InvalidArgument', ... + 'First input argument must be a valid function handle'); + + elseif (~isvector (vslot) || length (vslot) < 2) + error ('OdePkg:InvalidArgument', ... + 'Second input argument must be a valid vector'); + + elseif (~isvector (vinit) || ~isnumeric (vinit)) + error ('OdePkg:InvalidArgument', ... + 'Third input argument must be a valid numerical value'); + + elseif (nargin >= 4) + + if (~isstruct (varargin{1})) + %# varargin{1:len} are parameters for vfun + vodeoptions = odeset; + vfunarguments = varargin; + + elseif (length (varargin) > 1) + %# varargin{1} is an OdePkg options structure vopt + vodeoptions = odepkg_structure_check (varargin{1}, 'odebwe'); + vfunarguments = {varargin{2:length(varargin)}}; + + else %# if (isstruct (varargin{1})) + vodeoptions = odepkg_structure_check (varargin{1}, 'odebwe'); + vfunarguments = {}; + + end + + else %# if (nargin == 3) + vodeoptions = odeset; + vfunarguments = {}; + end + + %# Start preprocessing, have a look which options are set in + %# vodeoptions, check if an invalid or unused option is set + vslot = vslot(:).'; %# Create a row vector + vinit = vinit(:).'; %# Create a row vector + if (length (vslot) > 2) %# Step size checking + vstepsizefixed = true; + else + vstepsizefixed = false; + end + + %# The adaptive method require a second estimate for + %# the comparsion, while the fixed step size algorithm + %# needs only one + if ~vstepsizefixed + vestimators = 2; + else + vestimators = 1; + end + + %# Get the default options that can be set with 'odeset' temporarily + vodetemp = odeset; + + %# Implementation of the option RelTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.RelTol) && ~vstepsizefixed) + vodeoptions.RelTol = 1e-6; + warning ('OdePkg:InvalidArgument', ... + 'Option "RelTol" not set, new value %f is used', vodeoptions.RelTol); + elseif (~isempty (vodeoptions.RelTol) && vstepsizefixed) + warning ('OdePkg:InvalidArgument', ... + 'Option "RelTol" will be ignored if fixed time stamps are given'); + end + + %# Implementation of the option AbsTol has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.AbsTol) && ~vstepsizefixed) + vodeoptions.AbsTol = 1e-6; + warning ('OdePkg:InvalidArgument', ... + 'Option "AbsTol" not set, new value %f is used', vodeoptions.AbsTol); + elseif (~isempty (vodeoptions.AbsTol) && vstepsizefixed) + warning ('OdePkg:InvalidArgument', ... + 'Option "AbsTol" will be ignored if fixed time stamps are given'); + else + vodeoptions.AbsTol = vodeoptions.AbsTol(:); %# Create column vector + end + + %# Implementation of the option NormControl has been finished. This + %# option can be set by the user to another value than default value. + if (strcmp (vodeoptions.NormControl, 'on')) vnormcontrol = true; + else vnormcontrol = false; end + + %# Implementation of the option OutputFcn has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputFcn) && nargout == 0) + vodeoptions.OutputFcn = @odeplot; + vhaveoutputfunction = true; + elseif (isempty (vodeoptions.OutputFcn)), vhaveoutputfunction = false; + else vhaveoutputfunction = true; + end + + %# Implementation of the option OutputSel has been finished. This + %# option can be set by the user to another value than default value. + if (~isempty (vodeoptions.OutputSel)), vhaveoutputselection = true; + else vhaveoutputselection = false; end + + %# Implementation of the option OutputSave has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.OutputSave)), vodeoptions.OutputSave = 1; + end + + %# Implementation of the option Stats has been finished. This option + %# can be set by the user to another value than default value. + + %# Implementation of the option InitialStep has been finished. This + %# option can be set by the user to another value than default value. + if (isempty (vodeoptions.InitialStep) && ~vstepsizefixed) + vodeoptions.InitialStep = (vslot(1,2) - vslot(1,1)) / 10; + warning ('OdePkg:InvalidArgument', ... + 'Option "InitialStep" not set, new value %f is used', vodeoptions.InitialStep); + end + + %# Implementation of the option MaxNewtonIterations has been finished. This option + %# can be set by the user to another value than default value. + if isempty (vodeoptions.MaxNewtonIterations) + vodeoptions.MaxNewtonIterations = 10; + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxNewtonIterations" not set, new value %f is used', vodeoptions.MaxNewtonIterations); + end + + %# Implementation of the option NewtonTol has been finished. This option + %# can be set by the user to another value than default value. + if isempty (vodeoptions.NewtonTol) + vodeoptions.NewtonTol = 1e-7; + warning ('OdePkg:InvalidArgument', ... + 'Option "NewtonTol" not set, new value %f is used', vodeoptions.NewtonTol); + end + + %# Implementation of the option MaxStep has been finished. This option + %# can be set by the user to another value than default value. + if (isempty (vodeoptions.MaxStep) && ~vstepsizefixed) + vodeoptions.MaxStep = (vslot(1,2) - vslot(1,1)) / 10; + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxStep" not set, new value %f is used', vodeoptions.MaxStep); + end + + %# Implementation of the option Events has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Events)), vhaveeventfunction = true; + else vhaveeventfunction = false; end + + %# Implementation of the option Jacobian has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Jacobian) && isnumeric (vodeoptions.Jacobian)) + vhavejachandle = false; vjac = vodeoptions.Jacobian; %# constant jac + elseif (isa (vodeoptions.Jacobian, 'function_handle')) + vhavejachandle = true; %# jac defined by a function handle + else %# no Jacobian - we will use numerical differentiation + vhavejachandle = false; + end + + %# Implementation of the option Mass has been finished. This option + %# can be set by the user to another value than default value. + if (~isempty (vodeoptions.Mass) && isnumeric (vodeoptions.Mass)) + vhavemasshandle = false; vmass = vodeoptions.Mass; %# constant mass + elseif (isa (vodeoptions.Mass, 'function_handle')) + vhavemasshandle = true; %# mass defined by a function handle + else %# no mass matrix - creating a diag-matrix of ones for mass + vhavemasshandle = false; vmass = sparse (eye (length (vinit)) ); + end + + %# Implementation of the option MStateDependence has been finished. + %# This option can be set by the user to another value than default + %# value. + if (strcmp (vodeoptions.MStateDependence, 'none')) + vmassdependence = false; + else vmassdependence = true; + end + + %# Other options that are not used by this solver. Print a warning + %# message to tell the user that the option(s) is/are ignored. + if (~isequal (vodeoptions.NonNegative, vodetemp.NonNegative)) + warning ('OdePkg:InvalidArgument', ... + 'Option "NonNegative" will be ignored by this solver'); + end + if (~isequal (vodeoptions.Refine, vodetemp.Refine)) + warning ('OdePkg:InvalidArgument', ... + 'Option "Refine" will be ignored by this solver'); + end + if (~isequal (vodeoptions.JPattern, vodetemp.JPattern)) + warning ('OdePkg:InvalidArgument', ... + 'Option "JPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.Vectorized, vodetemp.Vectorized)) + warning ('OdePkg:InvalidArgument', ... + 'Option "Vectorized" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MvPattern, vodetemp.MvPattern)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MvPattern" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MassSingular, vodetemp.MassSingular)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MassSingular" will be ignored by this solver'); + end + if (~isequal (vodeoptions.InitialSlope, vodetemp.InitialSlope)) + warning ('OdePkg:InvalidArgument', ... + 'Option "InitialSlope" will be ignored by this solver'); + end + if (~isequal (vodeoptions.MaxOrder, vodetemp.MaxOrder)) + warning ('OdePkg:InvalidArgument', ... + 'Option "MaxOrder" will be ignored by this solver'); + end + if (~isequal (vodeoptions.BDF, vodetemp.BDF)) + warning ('OdePkg:InvalidArgument', ... + 'Option "BDF" will be ignored by this solver'); + end + + %# Starting the initialisation of the core solver odebwe + vtimestamp = vslot(1,1); %# timestamp = start time + vtimelength = length (vslot); %# length needed if fixed steps + vtimestop = vslot(1,vtimelength); %# stop time = last value + vdirection = sign (vtimestop); %# Flag for direction to solve + + if (~vstepsizefixed) + vstepsize = vodeoptions.InitialStep; + vminstepsize = (vtimestop - vtimestamp) / (1/eps); + else %# If step size is given then use the fixed time steps + vstepsize = vslot(1,2) - vslot(1,1); + vminstepsize = sign (vstepsize) * eps; + end + + vretvaltime = vtimestamp; %# first timestamp output + vretvalresult = vinit; %# first solution output + + %# Initialize the OutputFcn + if (vhaveoutputfunction) + if (vhaveoutputselection) + vretout = vretvalresult(vodeoptions.OutputSel); + else + vretout = vretvalresult; + end + feval (vodeoptions.OutputFcn, vslot.', ... + vretout.', 'init', vfunarguments{:}); + end + + %# Initialize the EventFcn + if (vhaveeventfunction) + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vretvalresult.', 'init', vfunarguments{:}); + end + + %# Initialize parameters and counters + vcntloop = 2; vcntcycles = 1; vu = vinit; vcntsave = 2; + vunhandledtermination = true; vpow = 1/2; vnpds = 0; + vcntiter = 0; vcntnewt = 0; vndecomps = 0; vnlinsols = 0; + + %# the following option enables the simplified Newton method + %# which evaluates the Jacobian only once instead of the + %# standard method that updates the Jacobian in each iteration + vsimplified = false; % or true + + %# The solver main loop - stop if the endpoint has been reached + while ((vdirection * (vtimestamp) < vdirection * (vtimestop)) && ... + (vdirection * (vstepsize) >= vdirection * (vminstepsize))) + + %# Hit the endpoint of the time slot exactely + if ((vtimestamp + vstepsize) > vdirection * vtimestop) + vstepsize = vtimestop - vdirection * vtimestamp; + end + + %# Run the time integration for each estimator + %# from vtimestamp -> vtimestamp+vstepsize + for j = 1:vestimators + %# Initial value (result of the previous timestep) + y0 = vu; + %# Initial guess for Newton-Raphson + y(j,:) = vu; + %# We do not use a higher order approximation for the + %# comparsion, but two steps by the Backward Euler + %# method + for i = 1:j + % Initialize the time stepping parameters + vthestep = vstepsize / j; + vthetime = vtimestamp + i*vthestep; + vnewtit = 1; + vresnrm = inf (1, vodeoptions.MaxNewtonIterations); + + %# Start the Newton iteration + while (vnewtit < vodeoptions.MaxNewtonIterations) && ... + (vresnrm (vnewtit) > vodeoptions.NewtonTol) + + %# Compute the Jacobian of the non-linear equation, + %# that is the matrix pencil of the mass matrix and + %# the right-hand-side's Jacobian. Perform a (sparse) + %# LU-Decomposition afterwards. + if ( (vnewtit==1) || (~vsimplified) ) + %# Get the mass matrix from the left-hand-side + if (vhavemasshandle) %# Handle only the dynamic mass matrix, + if (vmassdependence) %# constant mass matrices have already + vmass = feval ... %# been set before (if any) + (vodeoptions.Mass, vthetime, y(j,:)', vfunarguments{:}); + else %# if (vmassdependence == false) + vmass = feval ... %# then we only have the time argument + (vodeoptions.Mass, y(j,:)', vfunarguments{:}); + end + end + %# Get the Jacobian of the right-hand-side's function + if (vhavejachandle) %# Handle only the dynamic jacobian + vjac = feval(vodeoptions.Jacobian, vthetime,... + y(j,:)', vfunarguments{:}); + elseif isempty(vodeoptions.Jacobian) %# If no Jacobian is given + vjac = feval(@jacobian, vfun, vthetime,y(j,:)',... + vfunarguments); %# then we differentiate + end + vnpds = vnpds + 1; + vfulljac = vmass/vthestep - vjac; + %# one could do a matrix decomposition of vfulljac here, + %# but the choice of decomposition depends on the problem + %# and therefore we use the backslash-operator in row 374 + end + + %# Compute the residual + vres = vmass/vthestep*(y(j,:)-y0)' - feval(vfun,vthetime,y(j,:)',vfunarguments{:}); + vresnrm(vnewtit+1) = norm(vres,inf); + %# Solve the linear system + y(j,:) = vfulljac\(-vres+vfulljac*y(j,:)'); + %# the backslash operator decomposes the matrix + %# and solves the system in a single step. + vndecomps = vndecomps + 1; + vnlinsols = vnlinsols + 1; + %# Prepare next iteration + vnewtit = vnewtit + 1; + end %# while Newton + + %# Leave inner loop if Newton diverged + if vresnrm(vnewtit)>vodeoptions.NewtonTol + break; + end + %# Save intermediate solution as initial value + %# for the next intermediate step + y0 = y(j,:); + %# Count all Newton iterations + vcntnewt = vcntnewt + (vnewtit-1); + end %# for steps + + %# Leave outer loop if Newton diverged + if vresnrm(vnewtit)>vodeoptions.NewtonTol + break; + end + end %# for estimators + + % if all Newton iterations converged + if vresnrm(vnewtit)vodeoptions.NewtonTol + vdelta = 2; vtau = 1; + elseif (~vstepsizefixed) + if (~vnormcontrol) + vdelta = abs (y3 - y1)'; + vtau = max (vodeoptions.RelTol * abs (vu.'), vodeoptions.AbsTol); + else + vdelta = norm ((y3 - y1)', Inf); + vtau = max (vodeoptions.RelTol * max (norm (vu.', Inf), 1.0), ... + vodeoptions.AbsTol); + end + else %# if (vstepsizefixed == true) + vdelta = 1; vtau = 2; + end + + %# If the error is acceptable then update the vretval variables + if (all (vdelta <= vtau)) + vtimestamp = vtimestamp + vstepsize; + vu = y2; % or y3 if we want the extrapolation.... + + %# Save the solution every vodeoptions.OutputSave steps + if (mod (vcntloop-1,vodeoptions.OutputSave) == 0) + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu; + vcntsave = vcntsave + 1; + end + vcntloop = vcntloop + 1; vcntiter = 0; + + %# Call plot only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if plot function + %# returns false + if (vhaveoutputfunction) + if (vhaveoutputselection) + vpltout = vu(vodeoptions.OutputSel); + else + vpltout = vu; + end + vpltret = feval (vodeoptions.OutputFcn, vtimestamp, ... + vpltout.', [], vfunarguments{:}); + if vpltret %# Leave loop + vunhandledtermination = false; break; + end + end + + %# Call event only if a valid result has been found, therefore this + %# code fragment has moved here. Stop integration if veventbreak is + %# true + if (vhaveeventfunction) + vevent = ... + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vu(:), [], vfunarguments{:}); + if (~isempty (vevent{1}) && vevent{1} == 1) + vretvaltime(vcntloop-1,:) = vevent{3}(end,:); + vretvalresult(vcntloop-1,:) = vevent{4}(end,:); + vunhandledtermination = false; break; + end + end + end %# If the error is acceptable ... + + %# Update the step size for the next integration step + if (~vstepsizefixed) + %# 20080425, reported by Marco Caliari + %# vdelta cannot be negative (because of the absolute value that + %# has been introduced) but it could be 0, then replace the zeros + %# with the maximum value of vdelta + vdelta(find (vdelta == 0)) = max (vdelta); + %# It could happen that max (vdelta) == 0 (ie. that the original + %# vdelta was 0), in that case we double the previous vstepsize + vdelta(find (vdelta == 0)) = max (vtau) .* (0.4 ^ (1 / vpow)); + + if (vdirection == 1) + vstepsize = min (vodeoptions.MaxStep, ... + min (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + else + vstepsize = max (vodeoptions.MaxStep, ... + max (0.8 * vstepsize * (vtau ./ vdelta) .^ vpow)); + end + + else %# if (vstepsizefixed) + if (vresnrm(vnewtit)>vodeoptions.NewtonTol) + vunhandledtermination = true; + break; + elseif (vcntloop <= vtimelength) + vstepsize = vslot(vcntloop) - vslot(vcntloop-1); + else %# Get out of the main integration loop + break; + end + end + + %# Update counters that count the number of iteration cycles + vcntcycles = vcntcycles + 1; %# Needed for cost statistics + vcntiter = vcntiter + 1; %# Needed to find iteration problems + + %# Stop solving because the last 1000 steps no successful valid + %# value has been found + if (vcntiter >= 5000) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f before endpoint at', ... + ' tend = %f was reached. This happened because the iterative', ... + ' integration loop does not find a valid solution at this time', ... + ' stamp. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + end + + end %# The main loop + + %# Check if integration of the ode has been successful + if (vdirection * vtimestamp < vdirection * vtimestop) + if (vunhandledtermination == true) + error ('OdePkg:InvalidArgument', ... + ['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f', ... + ' before endpoint at tend = %f was reached. This may', ... + ' happen if the stepsize grows smaller than defined in', ... + ' vminstepsize. Try to reduce the value of "InitialStep" and/or', ... + ' "MaxStep" with the command "odeset".\n'], vtimestamp, vtimestop); + else + warning ('OdePkg:InvalidArgument', ... + ['Solver has been stopped by a call of "break" in', ... + ' the main iteration loop at time t = %f before endpoint at', ... + ' tend = %f was reached. This may happen because the @odeplot', ... + ' function returned "true" or the @event function returned "true".'], ... + vtimestamp, vtimestop); + end + end + + %# Postprocessing, do whatever when terminating integration algorithm + if (vhaveoutputfunction) %# Cleanup plotter + feval (vodeoptions.OutputFcn, vtimestamp, ... + vu.', 'done', vfunarguments{:}); + end + if (vhaveeventfunction) %# Cleanup event function handling + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vu.', 'done', vfunarguments{:}); + end + %# Save the last step, if not already saved + if (mod (vcntloop-2,vodeoptions.OutputSave) ~= 0) + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu; + end + + %# Print additional information if option Stats is set + if (strcmp (vodeoptions.Stats, 'on')) + vhavestats = true; + vnsteps = vcntloop-2; %# vcntloop from 2..end + vnfailed = (vcntcycles-1)-(vcntloop-2)+1; %# vcntcycl from 1..end + vnfevals = vcntnewt; %# number of rhs evaluations + if isempty(vodeoptions.Jacobian) %# additional evaluations due + vnfevals = vnfevals + vcntnewt*(1+length(vinit)); %# to differentiation + end + %# Print cost statistics if no output argument is given + if (nargout == 0) + vmsg = fprintf (1, 'Number of successful steps: %d\n', vnsteps); + vmsg = fprintf (1, 'Number of failed attempts: %d\n', vnfailed); + vmsg = fprintf (1, 'Number of function calls: %d\n', vnfevals); + end + else + vhavestats = false; + end + + if (nargout == 1) %# Sort output variables, depends on nargout + varargout{1}.x = vretvaltime; %# Time stamps are saved in field x + varargout{1}.y = vretvalresult; %# Results are saved in field y + varargout{1}.solver = 'odebwe'; %# Solver name is saved in field solver + if (vhaveeventfunction) + varargout{1}.ie = vevent{2}; %# Index info which event occured + varargout{1}.xe = vevent{3}; %# Time info when an event occured + varargout{1}.ye = vevent{4}; %# Results when an event occured + end + if (vhavestats) + varargout{1}.stats = struct; + varargout{1}.stats.nsteps = vnsteps; + varargout{1}.stats.nfailed = vnfailed; + varargout{1}.stats.nfevals = vnfevals; + varargout{1}.stats.npds = vnpds; + varargout{1}.stats.ndecomps = vndecomps; + varargout{1}.stats.nlinsols = vnlinsols; + end + elseif (nargout == 2) + varargout{1} = vretvaltime; %# Time stamps are first output argument + varargout{2} = vretvalresult; %# Results are second output argument + elseif (nargout == 5) + varargout{1} = vretvaltime; %# Same as (nargout == 2) + varargout{2} = vretvalresult; %# Same as (nargout == 2) + varargout{3} = []; %# LabMat doesn't accept lines like + varargout{4} = []; %# varargout{3} = varargout{4} = []; + varargout{5} = []; + if (vhaveeventfunction) + varargout{3} = vevent{3}; %# Time info when an event occured + varargout{4} = vevent{4}; %# Results when an event occured + varargout{5} = vevent{2}; %# Index info which event occured + end + end +end + +function df = jacobian(vfun,vthetime,vtheinput,vfunarguments); +%# Internal function for the numerical approximation of a jacobian + vlen = length(vtheinput); + vsigma = sqrt(eps); + vfun0 = feval(vfun,vthetime,vtheinput,vfunarguments{:}); + df = zeros(vlen,vlen); + for j = 1:vlen + vbuffer = vtheinput(j); + if (vbuffer==0) + vh = vsigma; + elseif (abs(vbuffer)>1) + vh = vsigma*vbuffer; + else + vh = sign(vbuffer)*vsigma; + end + vtheinput(j) = vbuffer + vh; + df(:,j) = (feval(vfun,vthetime,vtheinput,... + vfunarguments{:}) - vfun0) / vh; + vtheinput(j) = vbuffer; + end +end +%! # We are using the "Van der Pol" implementation for all tests that +%! # are done for this function. We also define a Jacobian, Events, +%! # pseudo-Mass implementation. For further tests we also define a +%! # reference solution (computed at high accuracy) and an OutputFcn +%!function [ydot] = fpol (vt, vy, varargin) %# The Van der Pol +%! ydot = [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%!function [vjac] = fjac (vt, vy, varargin) %# its Jacobian +%! vjac = [0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]; +%!function [vjac] = fjcc (vt, vy, varargin) %# sparse type +%! vjac = sparse ([0, 1; -1 - 2 * vy(1) * vy(2), 1 - vy(1)^2]); +%!function [vval, vtrm, vdir] = feve (vt, vy, varargin) +%! vval = fpol (vt, vy, varargin); %# We use the derivatives +%! vtrm = zeros (2,1); %# that's why component 2 +%! vdir = ones (2,1); %# seems to not be exact +%!function [vval, vtrm, vdir] = fevn (vt, vy, varargin) +%! vval = fpol (vt, vy, varargin); %# We use the derivatives +%! vtrm = ones (2,1); %# that's why component 2 +%! vdir = ones (2,1); %# seems to not be exact +%!function [vmas] = fmas (vt, vy) +%! vmas = [1, 0; 0, 1]; %# Dummy mass matrix for tests +%!function [vmas] = fmsa (vt, vy) +%! vmas = sparse ([1, 0; 0, 1]); %# A sparse dummy matrix +%!function [vref] = fref () %# The computed reference sol +%! vref = [0.32331666704577, -1.83297456798624]; +%!function [vout] = fout (vt, vy, vflag, varargin) +%! if (regexp (char (vflag), 'init') == 1) +%! if (any (size (vt) ~= [2, 1])) error ('"fout" step "init"'); end +%! elseif (isempty (vflag)) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "calc"'); end +%! vout = false; +%! elseif (regexp (char (vflag), 'done') == 1) +%! if (any (size (vt) ~= [1, 1])) error ('"fout" step "done"'); end +%! else error ('"fout" invalid vflag'); +%! end +%! +%! %# Turn off output of warning messages for all tests, turn them on +%! %# again if the last test is called +%!error %# input argument number one +%! warning ('off', 'OdePkg:InvalidArgument'); +%! B = odebwe (1, [0 25], [3 15 1]); +%!error %# input argument number two +%! B = odebwe (@fpol, 1, [3 15 1]); +%!error %# input argument number three +%! B = odebwe (@flor, [0 25], 1); +%!test %# one output argument +%! vsol = odebwe (@fpol, [0 2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%! assert (isfield (vsol, 'solver')); +%! assert (vsol.solver, 'odebwe'); +%!test %# two output arguments +%! [vt, vy] = odebwe (@fpol, [0 2], [2 0]); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%!test %# five output arguments and no Events +%! [vt, vy, vxe, vye, vie] = odebwe (@fpol, [0 2], [2 0]); +%! assert ([vt(end), vy(end,:)], [2, fref], 1e-3); +%! assert ([vie, vxe, vye], []); +%!test %# anonymous function instead of real function +%! fvdb = @(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%! vsol = odebwe (fvdb, [0 2], [2 0]); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# extra input arguments passed trhough +%! vsol = odebwe (@fpol, [0 2], [2 0], 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# empty OdePkg structure *but* extra input arguments +%! vopt = odeset; +%! vsol = odebwe (@fpol, [0 2], [2 0], vopt, 12, 13, 'KL'); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!error %# strange OdePkg structure +%! vopt = struct ('foo', 1); +%! vsol = odebwe (@fpol, [0 2], [2 0], vopt); +%!test %# Solve vdp in fixed step sizes +%! vsol = odebwe (@fpol, [0:0.001:2], [2 0]); +%! assert (vsol.x(:), [0:0.001:2]'); +%! assert (vsol.y(end,:), fref, 1e-2); +%!test %# Solve in backward direction starting at t=0 +%! %# vref = [-1.2054034414, 0.9514292694]; +%! vsol = odebwe (@fpol, [0 -2], [2 0]); +%! %# assert ([vsol.x(end), vsol.y(end,:)], [-2, fref], 1e-3); +%!test %# Solve in backward direction starting at t=2 +%! %# vref = [-1.2154183302, 0.9433018000]; +%! vsol = odebwe (@fpol, [2 -2], [0.3233166627 -1.8329746843]); +%! %# assert ([vsol.x(end), vsol.y(end,:)], [-2, fref], 1e-3); +%!test %# AbsTol option +%! vopt = odeset ('AbsTol', 1e-5); +%! vsol = odebwe (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-2); +%!test %# AbsTol and RelTol option +%! vopt = odeset ('AbsTol', 1e-6, 'RelTol', 1e-6); +%! vsol = odebwe (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-2); +%!test %# RelTol and NormControl option -- higher accuracy +%! vopt = odeset ('RelTol', 1e-6, 'NormControl', 'on'); +%! vsol = odebwe (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%! +%! %# test for NonNegative option is missing +%! %# test for OutputSel and Refine option is missing +%! +%!test %# Details of OutputSave can't be tested +%! vopt = odeset ('OutputSave', 1, 'OutputSel', 1); +%! vsla = odebwe (@fpol, [0 2], [2 0], vopt); +%! vopt = odeset ('OutputSave', 2); +%! vslb = odebwe (@fpol, [0 2], [2 0], vopt); +%! assert (length (vsla.x) > length (vslb.x)) +%!test %# Stats must add further elements in vsol +%! vopt = odeset ('Stats', 'on'); +%! vsol = odebwe (@fpol, [0 2], [2 0], vopt); +%! assert (isfield (vsol, 'stats')); +%! assert (isfield (vsol.stats, 'nsteps')); +%!test %# InitialStep option +%! vopt = odeset ('InitialStep', 1e-8); +%! vsol = odebwe (@fpol, [0 0.2], [2 0], vopt); +%! assert ([vsol.x(2)-vsol.x(1)], [1e-8], 1e-9); +%!test %# MaxStep option +%! vopt = odeset ('MaxStep', 1e-2); +%! vsol = odebwe (@fpol, [0 0.2], [2 0], vopt); +%! assert ([vsol.x(5)-vsol.x(4)], [1e-2], 1e-2); +%!test %# Events option add further elements in vsol +%! vopt = odeset ('Events', @feve); +%! vsol = odebwe (@fpol, [0 10], [2 0], vopt); +%! assert (isfield (vsol, 'ie')); +%! assert (vsol.ie, [2; 1; 2; 1]); +%! assert (isfield (vsol, 'xe')); +%! assert (isfield (vsol, 'ye')); +%!test %# Events option, now stop integration +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! vsol = odebwe (@fpol, [0 10], [2 0], vopt); +%! assert ([vsol.ie, vsol.xe, vsol.ye], ... +%! [2.0, 2.496110, -0.830550, -2.677589], 1e-3); +%!test %# Events option, five output arguments +%! vopt = odeset ('Events', @fevn, 'NormControl', 'on'); +%! [vt, vy, vxe, vye, vie] = odebwe (@fpol, [0 10], [2 0], vopt); +%! assert ([vie, vxe, vye], ... +%! [2.0, 2.496110, -0.830550, -2.677589], 1e-3); +%!test %# Jacobian option +%! vopt = odeset ('Jacobian', @fjac); +%! vsol = odebwe (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Jacobian option and sparse return value +%! vopt = odeset ('Jacobian', @fjcc); +%! vsol = odebwe (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%! +%! %# test for JPattern option is missing +%! %# test for Vectorized option is missing +%! +%!test %# Mass option as function +%! vopt = odeset ('Mass', @fmas); +%! vsol = odebwe (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as matrix +%! vopt = odeset ('Mass', eye (2,2)); +%! vsol = odebwe (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as sparse matrix +%! vopt = odeset ('Mass', sparse (eye (2,2))); +%! vsol = odebwe (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%!test %# Mass option as function and sparse matrix +%! vopt = odeset ('Mass', @fmsa); +%! vsol = odebwe (@fpol, [0 2], [2 0], vopt); +%! assert ([vsol.x(end), vsol.y(end,:)], [2, fref], 1e-3); +%! +%! %# test for MStateDependence option is missing +%! %# test for MvPattern option is missing +%! %# test for InitialSlope option is missing +%! %# test for MaxOrder option is missing +%! %# test for BDF option is missing +%! +%! warning ('on', 'OdePkg:InvalidArgument'); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odeexamples.m b/octave_packages/odepkg-0.8.2/odeexamples.m new file mode 100644 index 0000000..ef1d7c3 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odeexamples.m @@ -0,0 +1,53 @@ +%# Copyright (C) 2007-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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, write to the Free Software +%# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +%# -*- texinfo -*- +%# @deftypefn {Function File} {[@var{}] =} odeexamples (@var{}) +%# Open the differential equations examples menu and allow the user to select a submenu of ODE, DAE, IDE or DDE examples. +%# @end deftypefn + +function [] = odeexamples (varargin) + + vfam = 1; while (vfam > 0) + clc; + fprintf (1, ... + ['OdePkg examples main menu:\n', ... + '==========================\n', ... + '\n', ... + ' (1) Open the ODE examples menu\n', ... + ' (2) Open the DAE examples menu\n', ... + ' (3) Open the IDE examples menu\n', ... + ' (4) Open the DDE examples menu\n', ... + '\n']); + vfam = input ('Please choose a number from above or press to return: '); + switch (vfam) + case 1 + odepkg_examples_ode; + case 2 + odepkg_examples_dae; + case 3 + odepkg_examples_ide; + case 4 + odepkg_examples_dde; + otherwise + %# have nothing to do + end + end + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odeget.m b/octave_packages/odepkg-0.8.2/odeget.m new file mode 100644 index 0000000..348d700 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odeget.m @@ -0,0 +1,122 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{value}] =} odeget (@var{odestruct}, @var{option}, [@var{default}]) +%# @deftypefnx {Command} {[@var{values}] =} odeget (@var{odestruct}, @{@var{opt1}, @var{opt2}, @dots{}@}, [@{@var{def1}, @var{def2}, @dots{}@}]) +%# +%# If this function is called with two input arguments and the first input argument @var{odestruct} is of type structure array and the second input argument @var{option} is of type string then return the option value @var{value} that is specified by the option name @var{option} in the OdePkg option structure @var{odestruct}. Optionally if this function is called with a third input argument then return the default value @var{default} if @var{option} is not set in the structure @var{odestruct}. +%# +%# If this function is called with two input arguments and the first input argument @var{odestruct} is of type structure array and the second input argument @var{option} is of type cell array of strings then return the option values @var{values} that are specified by the option names @var{opt1}, @var{opt2}, @dots{} in the OdePkg option structure @var{odestruct}. Optionally if this function is called with a third input argument of type cell array then return the default value @var{def1} if @var{opt1} is not set in the structure @var{odestruct}, @var{def2} if @var{opt2} is not set in the structure @var{odestruct}, @dots{} +%# +%# Run examples with the command +%# @example +%# demo odeget +%# @end example +%# @end deftypefn +%# +%# @seealso{odepkg} + +%# Note: 20061022, Thomas Treichl +%# We cannot create a function of the form odeget (@var{odestruct}, +%# @var{name1}, @var{name2}) because we would get a mismatch with +%# the function form 1 like described above. + +function [vret] = odeget (varargin) + + if (nargin == 0) %# Check number and types of input arguments + vmsg = sprintf ('Number of input arguments must be greater than zero'); + help ('odeget'); error (vmsg); + elseif (isstruct (varargin{1}) == true) %# Check first input argument + vint.odestruct = odepkg_structure_check (varargin{1}); + vint.otemplate = odeset; %# Create default odepkg otpions structure + else + vmsg = sprintf ('First input argument must be a valid odepkg otpions structure'); + error (vmsg); + end + + %# Check number and types of other input arguments + if (length (varargin) < 2 || length (varargin) > 3) + vmsg = sprintf ('odeget (odestruct, "option", default) or\n odeget (odestruct, {"opt1", "opt2", ...}, {def1, def2, ...})'); + usage (vmsg); + elseif (ischar (varargin{2}) == true && isempty (varargin{2}) == false) + vint.arguments = {varargin{2}}; + vint.lengtharg = 1; + elseif (iscellstr (varargin{2}) == true && isempty (varargin{2}) == false) + vint.arguments = varargin{2}; + vint.lengtharg = length (vint.arguments); + end + + if (nargin == 3) %# Check if third input argument is valid + if (iscell (varargin{3}) == true) + vint.defaults = varargin{3}; + vint.lengthdf = length (vint.defaults); + else + vint.defaults = {varargin{3}}; + vint.lengthdf = 1; + end + if (vint.lengtharg ~= vint.lengthdf) + vmsg = sprintf ('If third argument is given then sizes of argument 2 and argument 3 must be the equal'); + error (vmsg); + end + end + + %# Run through number of input arguments given + for vcntarg = 1:vint.lengtharg + if ((... + isempty(vint.odestruct.(vint.arguments{vcntarg})) + )||( ... + ischar(vint.odestruct.(vint.arguments{vcntarg})) && ... + strcmp(vint.odestruct.(vint.arguments{vcntarg}),vint.otemplate.(vint.arguments{vcntarg}))... + )||(... + ~ischar(vint.odestruct.(vint.arguments{vcntarg})) && ... + vint.odestruct.(vint.arguments{vcntarg}) == vint.otemplate.(vint.arguments{vcntarg}) ... + )) + if (nargin == 3), vint.returnval{vcntarg} = vint.defaults{vcntarg}; + else, vint.returnval{vcntarg} = vint.odestruct.(vint.arguments{vcntarg}); end + else, vint.returnval{vcntarg} = vint.odestruct.(vint.arguments{vcntarg}); + end + end + + %# Postprocessing, store results in the vret variable + if (vint.lengtharg == 1), vret = vint.returnval{1}; + else, vret = vint.returnval; end + +%!test assert (odeget (odeset (), 'RelTol'), []); +%!test assert (odeget (odeset (), 'RelTol', 10), 10); +%!test assert (odeget (odeset (), {'RelTol', 'AbsTol'}), {[] []}) +%!test assert (odeget (odeset (), {'RelTol', 'AbsTol'}, {10 20}), {10 20}); +%!test assert (odeget (odeset (), 'Stats'), 'off'); +%!test assert (odeget (odeset (), 'Stats', 'on'), 'on'); + +%!demo +%! # Return the manually changed value RelTol of the OdePkg options +%! # strutcure A. If RelTol wouldn't have been changed then an +%! # empty matrix value would have been returned. +%! +%! A = odeset ('RelTol', 1e-1, 'AbsTol', 1e-2); +%! odeget (A, 'RelTol', []) + +%!demo +%! # Return the manually changed value of RelTol and the value 1e-4 +%! # for AbsTol of the OdePkg options structure A. +%! +%! A = odeset ('RelTol', 1e-1); +%! odeget (A, {'RelTol', 'AbsTol'}, {1e-2, 1e-4}) + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odephas2.m b/octave_packages/odepkg-0.8.2/odephas2.m new file mode 100644 index 0000000..cf66e5e --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odephas2.m @@ -0,0 +1,70 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{ret}] =} odephas2 (@var{t}, @var{y}, @var{flag}) +%# +%# Open a new figure window and plot the first result from the variable @var{y} that is of type double column vector over the second result from the variable @var{y} while solving. The types and the values of the input parameter @var{t} and the output parameter @var{ret} depend on the input value @var{flag} that is of type string. If @var{flag} is +%# @table @option +%# @item @code{"init"} +%# then @var{t} must be a double column vector of length 2 with the first and the last time step and nothing is returned from this function, +%# @item @code{""} +%# then @var{t} must be a double scalar specifying the actual time step and the return value is false (resp. value 0) for 'not stop solving', +%# @item @code{"done"} +%# then @var{t} must be a double scalar specifying the last time step and nothing is returned from this function. +%# @end table +%# +%# This function is called by a OdePkg solver function if it was specified in an OdePkg options structure with the @command{odeset}. This function is an OdePkg internal helper function therefore it should never be necessary that this function is called directly by a user. There is only little error detection implemented in this function file to achieve the highest performance. +%# +%# For example, solve an anonymous implementation of the "Van der Pol" equation and display the results while solving in a 2D plane +%# @example +%# fvdb = @@(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%# +%# vopt = odeset ('OutputFcn', @@odephas2, 'RelTol', 1e-6); +%# vsol = ode45 (fvdb, [0 20], [2 0], vopt); +%# @end example +%# @end deftypefn +%# +%# @seealso{odepkg} + +function [varargout] = odephas2 (vt, vy, vflag) + + %# No input argument check is done for a higher processing speed + persistent vfigure; persistent vyold; persistent vcounter; + + if (strcmp (vflag, 'init')) + %# Nothing to return, vt is either the time slot [tstart tstop] + %# or [t0, t1, ..., tn], vy is the inital value vector 'vinit' + vfigure = figure; vyold = vy(:,1); vcounter = 1; + + elseif (isempty (vflag)) + %# Return something in varargout{1}, either false for 'not stopping + %# the integration' or true for 'stopping the integration' + vcounter = vcounter + 1; figure (vfigure); + vyold(:,vcounter) = vy(:,1); + plot (vyold(1,:), vyold(2,:), '-o', 'markersize', 1); + drawnow; varargout{1} = false; + + elseif (strcmp (vflag, 'done')) + %# Cleanup has to be done, clear the persistent variables because + %# we don't need them anymore + clear ('vfigure', 'vyold', 'vcounter'); + + end + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odephas3.m b/octave_packages/odepkg-0.8.2/odephas3.m new file mode 100644 index 0000000..c34c663 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odephas3.m @@ -0,0 +1,76 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{ret}] =} odephas3 (@var{t}, @var{y}, @var{flag}) +%# +%# Open a new figure window and plot the first result from the variable @var{y} that is of type double column vector over the second and the third result from the variable @var{y} while solving. The types and the values of the input parameter @var{t} and the output parameter @var{ret} depend on the input value @var{flag} that is of type string. If @var{flag} is +%# @table @option +%# @item @code{"init"} +%# then @var{t} must be a double column vector of length 2 with the first and the last time step and nothing is returned from this function, +%# @item @code{""} +%# then @var{t} must be a double scalar specifying the actual time step and the return value is false (resp. value 0) for 'not stop solving', +%# @item @code{"done"} +%# then @var{t} must be a double scalar specifying the last time step and nothing is returned from this function. +%# @end table +%# +%# This function is called by a OdePkg solver function if it was specified in an OdePkg options structure with the @command{odeset}. This function is an OdePkg internal helper function therefore it should never be necessary that this function is called directly by a user. There is only little error detection implemented in this function file to achieve the highest performance. +%# +%# For example, solve the "Lorenz attractor" and display the results while solving in a 3D plane +%# @example +%# function vyd = florenz (vt, vx) +%# vyd = [10 * (vx(2) - vx(1)); +%# vx(1) * (28 - vx(3)); +%# vx(1) * vx(2) - 8/3 * vx(3)]; +%# endfunction +%# +%# vopt = odeset ('OutputFcn', @@odephas3); +%# vsol = ode23 (@@florenz, [0:0.01:7.5], [3 15 1], vopt); +%# @end example +%# @end deftypefn +%# +%# @seealso{odepkg} + +function [varargout] = odephas3 (vt, vy, vflag) + + %# vt and vy are always column vectors, vflag can be either 'init' + %# or [] or 'done'. If 'init' then varargout{1} = [], if [] the + %# varargout{1} either true or false, if 'done' then varargout{1} = []. + persistent vfigure; persistent vyold; persistent vcounter; + + if (strcmp (vflag, 'init')) + %# vt is either the time slot [tstart tstop] or [t0, t1, ..., tn] + %# vy is the inital value vector vinit from the caller function + vfigure = figure; vyold = vy(:,1); vcounter = 1; + + elseif (isempty (vflag)) + %# Return something in varargout{1}, either false for 'not stopping + %# the integration' or true for 'stopping the integration' + vcounter = vcounter + 1; figure (vfigure); + vyold(:,vcounter) = vy(:,1); + plot3 (vyold(1,:), vyold(2,:), vyold (3,:), '-o', 'markersize', 1); + drawnow; varargout{1} = false; + + elseif (strcmp (vflag, 'done')) + %# Cleanup has to be done, clear the persistent variables because + %# we don't need them anymore + clear ('vfigure', 'vyold', 'vcounter'); + + end + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg.m b/octave_packages/odepkg-0.8.2/odepkg.m new file mode 100644 index 0000000..1cb5d6b --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg.m @@ -0,0 +1,230 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} odepkg () +%# +%# OdePkg is part of the GNU Octave Repository (the Octave--Forge project). The package includes commands for setting up various options, output functions etc. before solving a set of differential equations with the solver functions that are also included. At this time OdePkg is under development with the main target to make a package that is mostly compatible to proprietary solver products. +%# +%# If this function is called without any input argument then open the OdePkg tutorial in the Octave window. The tutorial can also be opened with the following command +%# +%# @example +%# doc odepkg +%# @end example +%# @end deftypefn + +function [] = odepkg (vstr) + + %# Check number and types of all input arguments + if (nargin == 0) + doc ('odepkg'); + elseif (nargin > 1) + error ('Number of input arguments must be zero or one'); + elseif (ischar (vstr)) + feval (vstr); + else + error ('Input argument must be a valid string'); + end + +function [] = odepkg_validate_mfiles () + + %# From command line in the 'inst' directory do something like this: + %# octave --quiet --eval "odepkg ('odepkg_validate_mfiles')" + + vfun = {'ode23', 'ode45', 'ode54', 'ode78', ... + 'ode23d', 'ode45d', 'ode54d', 'ode78d', ... + 'odeget', 'odeset', 'odeplot', 'odephas2', 'odephas3', 'odeprint', ... + 'odepkg_structure_check', 'odepkg_event_handle', ... + 'odepkg_testsuite_calcscd', 'odepkg_testsuite_calcmescd'}; + %# vfun = sort (vfun); + + for vcnt=1:length(vfun) + printf ('Testing function %s ... ', vfun{vcnt}); + test (vfun{vcnt}, 'quiet'); fflush (1); + end + +function [] = odepkg_validate_ccfiles () + + %# From command line in the 'src' directory do something like this: + %# octave --quiet --eval "odepkg ('odepkg_validate_ccfiles')" + + vfile = {'odepkg_octsolver_mebdfdae.cc', 'odepkg_octsolver_mebdfi.cc', ... + 'odepkg_octsolver_ddaskr.cc', ... + 'odepkg_octsolver_radau.cc', 'odepkg_octsolver_radau5.cc', ... + 'odepkg_octsolver_rodas.cc', 'odepkg_octsolver_seulex.cc'}; + vsolv = {'odebda', 'odebdi', 'odekdi', ... + 'ode2r', 'ode5r', 'oders', 'odesx'}; + %# vfile = {'odepkg_octsolver_ddaskr.cc'}; + %# vsolv = {'odekdi'}; + + for vcnt=1:length(vfile) + printf ('Testing function %s ... ', vsolv{vcnt}); + autoload (vsolv{vcnt}, which ('dldsolver.oct')); + test (vfile{vcnt}, 'quiet'); fflush (1); + end + +function [] = odepkg_internal_mhelpextract () + + %# In the inst directory do + %# octave --quiet --eval "odepkg ('odepkg_internal_mhelpextract')" + + vfun = {'odepkg', 'odeget', 'odeset', ... + 'ode23', 'ode45', 'ode54', 'ode78', ... + 'ode23d', 'ode45d', 'ode54d', 'ode78d', ... + 'odebwe', ... + 'odeplot', 'odephas2', 'odephas3', 'odeprint', ... + 'odepkg_structure_check', 'odepkg_event_handle', ... + 'odepkg_testsuite_calcscd', 'odepkg_testsuite_calcmescd', ... + 'odepkg_testsuite_oregonator', 'odepkg_testsuite_pollution', ... + 'odepkg_testsuite_hires', ... + 'odepkg_testsuite_robertson', 'odepkg_testsuite_chemakzo', ... + 'odepkg_testsuite_transistor', ... + 'odepkg_testsuite_implrober', 'odepkg_testsuite_implakzo', ... + 'odepkg_testsuite_imptrans', ... + 'odeexamples', 'odepkg_examples_ode', 'odepkg_examples_dae', ... + 'odepkg_examples_ide', 'odepkg_examples_dde'}; + vfun = sort (vfun); + + [vout, vmsg] = fopen ('../doc/mfunref.texi', 'w'); + if ~(isempty (vmsg)), error (vmsg); end + for vcnt = 1:length (vfun) + if (exist (vfun{vcnt}, 'file')) + [vfid, vmsg] = fopen (which (vfun{vcnt}), 'r'); + if ~(isempty (vmsg)), error (vmsg); end + while (true) + vlin = fgets (vfid); + if ~(ischar (vlin)), break; end + if (regexp (vlin, '^(%# -\*- texinfo -\*-)')) + while (~isempty (regexp (vlin, '^(%#)')) && ... + isempty (regexp (vlin, '^(%# @end deftypefn)'))) + vlin = fgets (vfid); + if (length (vlin) > 3), fprintf (vout, '%s', vlin(4:end)); + else fprintf (vout, '%s', vlin(3:end)); + end + end + fprintf (vout, '\n'); + end + end + fclose (vfid); + end + end + fclose (vout); + +function [] = odepkg_internal_octhelpextract () + + %# In the src directory do + %# octave --quiet --eval "odepkg ('odepkg_internal_octhelpextract')" + + vfiles = {'../src/odepkg_octsolver_mebdfdae.cc', ... + '../src/odepkg_octsolver_mebdfi.cc', ... + '../src/odepkg_octsolver_ddaskr.cc', ... + '../src/odepkg_octsolver_radau.cc', ... + '../src/odepkg_octsolver_radau5.cc', ... + '../src/odepkg_octsolver_rodas.cc', ... + '../src/odepkg_octsolver_seulex.cc', ... + }; + %# vfiles = sort (vfiles); Don't sort these files + + [vout, vmsg] = fopen ('../doc/dldfunref.texi', 'w'); + if ~(isempty (vmsg)), error (vmsg); end + for vcnt = 1:length (vfiles) + if (exist (vfiles{vcnt}, 'file')) + [vfid, vmsg] = fopen (vfiles{vcnt}, 'r'); + if ~(isempty (vmsg)), error (vmsg); end + while (true) + vlin = fgets (vfid); + if ~(ischar (vlin)), break; end + if (regexp (vlin, '^("-\*- texinfo -\*-\\n\\)')) %#" + vlin = ' * '; %# Needed for the first call of while() + while (isempty (regexp (vlin, '^(@end deftypefn)')) && ischar (vlin)) + vlin = fgets (vfid); + vlin = sprintf (regexprep (vlin, '\\n\\', '')); + vlin = regexprep (vlin, '\\"', '"'); + fprintf (vout, '%s', vlin); + end + fprintf (vout, '\n'); + end + end + fclose (vfid); + end + end + fclose (vout); + +function [] = odepkg_performance_mathires () + vfun = {@ode113, @ode23, @ode45, ... + @ode15s, @ode23s, @ode23t, @ode23tb}; + for vcnt=1:length(vfun) + vsol{vcnt, 1} = odepkg_testsuite_hires (vfun{vcnt}, 1e-7); + end + odepkg_testsuite_write (vsol); + +function [] = odepkg_performance_octavehires () + vfun = {@ode23, @ode45, @ode54, @ode78, ... + @ode2r, @ode5r, @oders, @odesx, @odebda}; + for vcnt=1:length(vfun) + vsol{vcnt, 1} = odepkg_testsuite_hires (vfun{vcnt}, 1e-7); + end + odepkg_testsuite_write (vsol); + +function [] = odepkg_performance_matchemakzo () + vfun = {@ode23, @ode45, ... + @ode15s, @ode23s, @ode23t, @ode23tb}; + for vcnt=1:length(vfun) + vsol{vcnt, 1} = odepkg_testsuite_chemakzo (vfun{vcnt}, 1e-7); + end + odepkg_testsuite_write (vsol); + +function [] = odepkg_performance_octavechemakzo () + vfun = {@ode23, @ode45, @ode54, @ode78, ... + @ode2r, @ode5r, @oders, @odesx, @odebda}; + for vcnt=1:length(vfun) + vsol{vcnt, 1} = odepkg_testsuite_chemakzo (vfun{vcnt}, 1e-7); + end + odepkg_testsuite_write (vsol); + +function [] = odepkg_testsuite_write (vsol) + + fprintf (1, ['-----------------------------------------------------------------------------------------\n']); + fprintf (1, [' Solver RelTol AbsTol Init Mescd Scd Steps Accept FEval JEval LUdec Time\n']); + fprintf (1, ['-----------------------------------------------------------------------------------------\n']); + + [vlin, vcol] = size (vsol); + for vcntlin = 1:vlin + if (isempty (vsol{vcntlin}{9})), vsol{vcntlin}{9} = 0; end + %# if (vcntlin > 1) %# Delete solver name if it is the same as before + %# if (strcmp (func2str (vsol{vcntlin}{1}), func2str (vsol{vcntlin-1}{1}))) + %# vsol{vcntlin}{1} = ' '; + %# end + %# end + fprintf (1, ['%7s %6.0g %6.0g %6.0g %5.2f %5.2f %5.0d %6.0d %5.0d %5.0d %5.0d %6.3f\n'], ... + func2str (vsol{vcntlin}{1}), vsol{vcntlin}{2:12}); + end + fprintf (1, ['-----------------------------------------------------------------------------------------\n']); + +function [] = odepkg_internal_demos () + + vfun = {'odepkg', 'odeget', 'odeset', ... + 'ode23', 'ode45', 'ode54', 'ode78', ... + 'ode23d', 'ode45d', 'ode54d', 'ode78d', ... + 'odeplot', 'odephas2', 'odephas3', 'odeprint', ... + 'odepkg_structure_check', 'odepkg_event_handle'}; + vfun = sort (vfun); + + for vcnt = 1:length (vfun), demo (vfun{vcnt}); end + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_event_handle.m b/octave_packages/odepkg-0.8.2/odepkg_event_handle.m new file mode 100644 index 0000000..2de7267 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_event_handle.m @@ -0,0 +1,164 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{sol}] =} odepkg_event_handle (@var{@@fun}, @var{time}, @var{y}, @var{flag}, [@var{par1}, @var{par2}, @dots{}]) +%# +%# Return the solution of the event function that is specified as the first input argument @var{@@fun} in form of a function handle. The second input argument @var{time} is of type double scalar and specifies the time of the event evaluation, the third input argument @var{y} either is of type double column vector (for ODEs and DAEs) and specifies the solutions or is of type cell array (for IDEs and DDEs) and specifies the derivatives or the history values, the third input argument @var{flag} is of type string and can be of the form +%# @table @option +%# @item @code{"init"} +%# then initialize internal persistent variables of the function @command{odepkg_event_handle} and return an empty cell array of size 4, +%# @item @code{"calc"} +%# then do the evaluation of the event function and return the solution @var{sol} as type cell array of size 4, +%# @item @code{"done"} +%# then cleanup internal variables of the function @command{odepkg_event_handle} and return an empty cell array of size 4. +%# @end table +%# Optionally if further input arguments @var{par1}, @var{par2}, @dots{} of any type are given then pass these parameters through @command{odepkg_event_handle} to the event function. +%# +%# This function is an OdePkg internal helper function therefore it should never be necessary that this function is called directly by a user. There is only little error detection implemented in this function file to achieve the highest performance. +%# @end deftypefn +%# +%# @seealso{odepkg} + +function [vretval] = odepkg_event_handle (vevefun, vt, vy, vflag, varargin) + + %# No error handling has been implemented in this function to achieve + %# the highest performance available. + + %# vretval{1} is true or false; either to terminate or to continue + %# vretval{2} is the index information for which event occured + %# vretval{3} is the time information column vector + %# vretval{4} is the line by line result information matrix + + %# These persistent variables are needed to store the results and the + %# time value from the processing in the time stamp before, veveold + %# are the results from the event function, vtold the time stamp, + %# vretcell the return values cell array, vyold the result of the ode + %# and vevecnt the counter for how often this event handling + %# has been called + persistent veveold; persistent vtold; + persistent vretcell; persistent vyold; + persistent vevecnt; + + %# Call the event function if an event function has been defined to + %# initialize the internal variables of the event function an to get + %# a value for veveold + if (strcmp (vflag, 'init')) + + if (~iscell (vy)) + vinpargs = {vevefun, vt, vy}; + else + vinpargs = {vevefun, vt, vy{1}, vy{2}}; + vy = vy{1}; %# Delete cell element 2 + end + if (nargin > 4) + vinpargs = {vinpargs{:}, varargin{:}}; + end + [veveold, vterm, vdir] = feval (vinpargs{:}); + + %# We assume that all return values must be column vectors + veveold = veveold(:)'; vterm = vterm(:)'; vdir = vdir(:)'; + vtold = vt; vyold = vy; vevecnt = 1; vretcell = cell (1,4); + + %# Process the event, find the zero crossings either for a rising + %# or for a falling edge + elseif (isempty (vflag)) + + if (~iscell (vy)) + vinpargs = {vevefun, vt, vy}; + else + vinpargs = {vevefun, vt, vy{1}, vy{2}}; + vy = vy{1}; %# Delete cell element 2 + end + if (nargin > 4) + vinpargs = {vinpargs{:}, varargin{:}}; + end + [veve, vterm, vdir] = feval (vinpargs{:}); + + %# We assume that all return values must be column vectors + veve = veve(:)'; vterm = vterm(:)'; vdir = vdir(:)'; + + %# Check if one or more signs of the event has changed + vsignum = (sign (veveold) ~= sign (veve)); + if (any (vsignum)) %# One or more values have changed + vindex = find (vsignum); %# Get the index of the changed values + + if (any (vdir(vindex) == 0)) + %# Rising or falling (both are possible) + %# Don't change anything, keep the index + elseif (any (vdir(vindex) == sign (veve(vindex)))) + %# Detected rising or falling, need a new index + vindex = find (vdir == sign (veve)); + else + %# Found a zero crossing but must not be notified + vindex = []; + end + + %# Create new output values if a valid index has been found + if (~isempty (vindex)) + %# Change the persistent result cell array + vretcell{1} = any (vterm(vindex)); %# Stop integration or not + vretcell{2}(vevecnt,1) = vindex(1,1); %# Take first event found + %# Calculate the time stamp when the event function returned 0 and + %# calculate new values for the integration results, we do both by + %# a linear interpolation + vtnew = vt - veve(1,vindex) * (vt - vtold) / (veve(1,vindex) - veveold(1,vindex)); + vynew = (vy - (vt - vtnew) * (vy - vyold) / (vt - vtold))'; + vretcell{3}(vevecnt,1) = vtnew; + vretcell{4}(vevecnt,:) = vynew; + vevecnt = vevecnt + 1; + end %# if (~isempty (vindex)) + + end %# Check for one or more signs ... + veveold = veve; vtold = vt; vretval = vretcell; vyold = vy; + + elseif (strcmp (vflag, 'done')) %# Clear this event handling function + clear ('veveold', 'vtold', 'vretcell', 'vyold', 'vevecnt'); + vretcell = cell (1,4); + + end + +%!function [veve, vterm, vdir] = feveode (vt, vy, varargin) +%! veve = vy(1); %# Which event component should be treaded +%! vterm = 1; %# Terminate if an event is found +%! vdir = -1; %# In which direction, -1 for falling +%!function [veve, vterm, vdir] = feveide (vt, vy, vyd, varargin) +%! veve = vy(1); %# Which event component should be treaded +%! vterm = 1; %# Terminate if an event is found +%! vdir = -1; %# In which direction, -1 for falling +%! +%!test %# First call to initialize the odepkg_event_handle function +%! odepkg_event_handle (@feveode, 0.0, [0 1 2 3], 'init', 123, 456); +%!test %# Two calls to find the event that may occur with ODE/DAE syntax +%! A = odepkg_event_handle (@feveode, 2.0, [ 0 0 3 2], '', 123, 456); +%! B = odepkg_event_handle (@feveode, 3.0, [-1 0 3 2], '', 123, 456); +%! assert (A, {[], [], [], []}); +%! assert (B{4}, [0 0 3 2]); +%!test %# Last call to cleanup the odepkg_event_handle function +%! odepkg_event_handle (@feveode, 4.0, [0 1 2 3], 'done', 123, 456); +%!test %# First call to initialize the odepkg_event_handle function +%! odepkg_event_handle (@feveide, 0.0, {[0 1 2 3], [0 1 2 3]}, 'init', 123, 456); +%!test %# Two calls to find the event that may occur with IDE/DDE syntax +%! A = odepkg_event_handle (@feveide, 2.0, {[0 0 3 2], [0 0 3 2]}, '', 123, 456); +%! B = odepkg_event_handle (@feveide, 3.0, {[-1 0 3 2], [0 0 3 2]}, '', 123, 456); +%! assert (A, {[], [], [], []}); +%! assert (B{4}, [0 0 3 2]); +%!test %# Last call to cleanup the odepkg_event_handle function +%! odepkg_event_handle (@feveide, 4.0, {[0 1 2 3], [0 1 2 3]}, 'done', 123, 456); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_examples_dae.m b/octave_packages/odepkg-0.8.2/odepkg_examples_dae.m new file mode 100644 index 0000000..19d98ec --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_examples_dae.m @@ -0,0 +1,85 @@ +%# Copyright (C) 2008-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} odepkg_examples_dae (@var{}) +%# Open the DAE examples menu and allow the user to select a demo that will be evaluated. +%# @end deftypefn + +function [] = odepkg_examples_dae () + + vode = 1; while (vode > 0) + clc; + fprintf (1, ... + ['DAE examples menu:\n', ... + '==================\n', ... + '\n', ... + ' (1) Solve the "Robertson problem" with solver "ode2r"\n', ... + ' (2) Solve another "Robertson implementation" with solver "ode5r"\n', ... + '\n', ... + ' Note: There are further DAE examples available with the OdePkg\n', ... + ' testsuite functions.\n', ... + '\n', ... + ' If you have another interesting DAE example that you would like\n', ... + ' to share then please modify this file, create a patch and send\n', ... + ' your patch with your added example to the OdePkg developer team.\n', ... + '\n' ]); + vode = input ('Please choose a number from above or press to return: '); + clc; if (vode > 0 && vode < 3) + %# We can't use the function 'demo' directly here because it does + %# not allow to run other functions within a demo. + vexa = example (mfilename (), vode); + disp (vexa); eval (vexa); + input ('Press to continue: '); + end %# if (vode > 0) + end %# while (vode > 0) + +%!demo +%! # Solve the "Robertson problem" with a Mass function that is given by +%! # a function handle. +%! +%! function [vyd] = frobertson (vt, vy, varargin) +%! vyd(1,1) = -0.04 * vy(1) + 1e4 * vy(2) * vy(3); +%! vyd(2,1) = 0.04 * vy(1) - 1e4 * vy(2) * vy(3) - 3e7 * vy(2)^2; +%! vyd(3,1) = vy(1) + vy(2) + vy(3) - 1; +%! endfunction +%! +%! function [vmass] = fmass (vt, vy, varargin) +%! vmass = [1, 0, 0; 0, 1, 0; 0, 0, 0]; +%! endfunction +%! +%! vopt = odeset ('Mass', @fmass, 'NormControl', 'on'); +%! vsol = ode2r (@frobertson, [0, 1e5], [1, 0, 0], vopt); +%! plot (vsol.x, vsol.y); + +%!demo +%! # Solve the "Robertson problem" with a Mass function that is given by +%! # a constant mass matrix. +%! +%! function [vyd] = frobertson (vt, vy, varargin) +%! vyd(1,1) = -0.04 * vy(1) + 1e4 * vy(2) * vy(3); +%! vyd(2,1) = 0.04 * vy(1) - 1e4 * vy(2) * vy(3) - 3e7 * vy(2)^2; +%! vyd(3,1) = vy(1) + vy(2) + vy(3) - 1; +%! endfunction +%! +%! vopt = odeset ('Mass', [1, 0, 0; 0, 1, 0; 0, 0, 0], ... +%! 'NormControl', 'on'); +%! vsol = ode5r (@frobertson, [0, 1e5], [1, 0, 0], vopt); +%! plot (vsol.x, vsol.y); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_examples_dde.m b/octave_packages/odepkg-0.8.2/odepkg_examples_dde.m new file mode 100644 index 0000000..a54ebc1 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_examples_dde.m @@ -0,0 +1,132 @@ +%# Copyright (C) 2008-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} odepkg_examples_dde (@var{}) +%# Open the DDE examples menu and allow the user to select a demo that will be evaluated. +%# @end deftypefn + +function [] = odepkg_examples_dde () + + vode = 1; while (vode > 0) + clc; + fprintf (1, ... + ['DDE examples menu:\n', ... + '==================\n', ... + '\n', ... + ' (1) Solve a simple "exp(...)" example with solver "ode23d"\n', ... + ' (2) Solve an example from Wille and Baker with solver "ode45d"\n', ... + ' (3) Solve an example from Hu and Wang with solver "ode54d"\n', ... + ' (4) Solve the "infectious disease model" with solver "ode78d"\n', ... + '\n', ... + ' Note: There are further DDE examples available with the OdePkg\n', ... + ' testsuite functions.\n', ... + '\n', ... + ' If you have another interesting DDE example that you would like\n', ... + ' to share then please modify this file, create a patch and send\n', ... + ' your patch with your added example to the OdePkg developer team.\n', ... + '\n' ]); + vode = input ('Please choose a number from above or press to return: '); + clc; if (vode > 0 && vode < 5) + %# We can't use the function 'demo' directly here because it does + %# not allow to run other functions within a demo. + vexa = example (mfilename (), vode); + disp (vexa); eval (vexa); + input ('Press to continue: '); + end %# if (vode > 0) + end %# while (vode > 0) + +%!demo +%! # Solves a simple example where the delay differential equation is +%! # of the form yd = e^(-lambda*t) - y(t-tau). +%! +%! function [vyd] = fexp (vt, vy, vz, varargin) +%! vlambda = varargin{1}; +%! vyd = exp (- vlambda * vt) - vz(1); +%! endfunction +%! +%! vtslot = [0, 15]; vlambda = 1; vinit = 10; +%! vopt = odeset ('NormControl', 'on', 'RelTol', 1e-4, 'AbsTol', 1e-4); +%! vsol = ode23d (@fexp, vtslot, vinit, vlambda, vinit, vopt, vlambda); +%! plot (vsol.x, vsol.y); + +%!demo +%! # Solves the example 3 from the publication 'DELSOL - a numerical +%! # code for the solution of systems of delay-differential equations' +%! # from the authors David Wille and Christopher Baker. +%! +%! function [vyd] = fdelsol (vt, vy, vz, varargin) +%! %# vy is a column vector of size (3,1) +%! %# vz is the history of size (3,2) +%! vyd = [vz(1,1); vz(1,1) + vz(2,2); vy(2,1)]; +%! endfunction +%! +%! vopt = odeset ('NormControl', 'on', 'MaxStep', 0.1, 'InitialStep', 0.01); +%! vsol = ode45d (@fdelsol, [0, 5], [1, 1, 1], [1, 0.2], ones(3,2), vopt); +%! plot (vsol.x, vsol.y); + +%!demo +%! # Solves the examples 2.3.1 and 2.3.2 from the book 'Dynamics of +%! # Controlled Mechanical Systems with Delayed Feedback' from the +%! # authors Haiyan Hu and Zaihua Wang. +%! +%! function [vyd] = fhuwang1 (vt, vy, vz, varargin) +%! %# vy is of size (1,1), vz is of size (1,1) +%! vyd = (vz(1,1) - varargin{1})^(1/3); +%! endfunction +%! +%! function [vyd] = fhuwang2 (vt, vy, vz, varargin) +%! %# vy is of size (1,1), vz is of size (1,1) +%! vyd = (vy - vz)^(1/3); +%! endfunction +%! +%! vtslot = [0, 10]; vK = 1; vinit = 1; vhist = 0; +%! vopt = odeset ('NormControl', 'on', 'RelTol', 1e-6, 'InitialStep', 0.1); +%! +%! vsol = ode54d (@fhuwang1, vtslot, vK, vinit, vhist, vopt, vK); +%! plot (vsol.x, vsol.y, 'ko-', 'markersize', 1); hold; +%! +%! vsol = ode54d (@fhuwang2, vtslot, vK, vinit, vhist, vopt, vK); +%! plot (vsol.x, vsol.y, 'bx-', 'markersize', 1); + +%!demo +%! # Solves the infectious disease model from the book 'Solving Ordinary +%! # Differential Equations 1' from the authors Ernst Hairer and Gerhard +%! # Wanner. +%! +%! function [vyd] = finfect (vx, vy, vz, varargin) +%! %# vy is of size (3,1), vz is of size (3,2) +%! vyd = [ - vy(1) * vz(2,1) + vz(2,2); +%! vy(1) * vz(2,1) - vy(2); +%! vy(2) - vz(2,2) ]; +%! endfunction +%! +%! function [vval, vtrm, vdir] = fevent (vx, vy, vz, varargin) +%! %# vy is of size (3,1), vz is of size (3,2) +%! vfec = finfect (vx, vy, vz); +%! vval = vfec(2:3); %# Have a look at component two + three +%! vtrm = zeros(1,2); %# Don't stop if an event is found +%! vdir = -ones(1,2); %# Check only for falling direction +%! endfunction +%! +%! vopt = odeset ('InitialStep', 1e-3, 'Events', @fevent); +%! vsol = ode78d (@finfect, [0, 40], [5, 0.1, 1], [1, 10], ... +%! [5, 5; 0.1, 0.1; 1, 1], vopt); +%! plot (vsol.x, vsol.y, 'k-', vsol.xe, vsol.ye, 'ro'); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_examples_ide.m b/octave_packages/odepkg-0.8.2/odepkg_examples_ide.m new file mode 100644 index 0000000..5e0791c --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_examples_ide.m @@ -0,0 +1,109 @@ +%# Copyright (C) 2008-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} odepkg_examples_ide (@var{}) +%# Open the IDE examples menu and allow the user to select a demo that will be evaluated. +%# @end deftypefn + +function [] = odepkg_examples_ide () + + vode = 1; while (vode > 0) + clc; + fprintf (1, ... + ['IDE examples menu:\n', ... + '==================\n', ... + '\n', ... + ' (1) Solve the "Robertson problem" with solver "odebdi"\n', ... + ' (2) Solve another "Robertson implementation" with solver "odekdi"\n', ... + ' (3) Solve a stiff "Van der Pol" implementation with solver "odebdi"\n', ... + ' (4) Solve a stiff "Van der Pol" implementation with solver "odekdi"\n', ... + '\n', ... + ' Note: There are further IDE examples available with the OdePkg\n', ... + ' testsuite functions.\n', ... + '\n', ... + ' If you have another interesting IDE example that you would like\n', ... + ' to share then please modify this file, create a patch and send\n', ... + ' your patch to the OdePkg developer team.\n', ... + '\n' ]); + vode = input ('Please choose a number from above or press to return: '); + clc; if (vode > 0 && vode < 5) + %# We can't use the function 'demo' directly here because it does + %# not allow to run other functions within a demo. + vexa = example (mfilename (), vode); + disp (vexa); eval (vexa); + input ('Press to continue: '); + end %# if (vode > 0) + end %# while (vode > 0) + +%!demo +%! # Solve the "Robertson problem" that is given as a function handle +%! # to an implicite differential equation implementation. +%! +%! function [vres] = firobertson (vt, vy, vyd, varargin) +%! vres(1,1) = -0.04*vy(1) + 1e4*vy(2)*vy(3) - vyd(1); +%! vres(2,1) = 0.04*vy(1) - 1e4*vy(2)*vy(3) - 3e7*vy(2)^2-vyd(2); +%! vres(3,1) = vy(1) + vy(2) + vy(3) - 1; +%! endfunction +%! +%! vopt = odeset ("NormControl", "on"); +%! vsol = odebdi (@firobertson, [0, 1e5], [1, 0, 0], [-4e-2, 4e-2, 0], vopt); +%! plot (vsol.x, vsol.y); + +%!demo +%! # Solve the "Robertson problem" that is given as a function handle +%! # to an implicite differential equation implementation. +%! +%! function [vres] = firobertson (vt, vy, vyd, varargin) +%! vres(1,1) = -0.04*vy(1) + 1e4*vy(2)*vy(3) - vyd(1); +%! vres(2,1) = 0.04*vy(1) - 1e4*vy(2)*vy(3) - 3e7*vy(2)^2-vyd(2); +%! vres(3,1) = vy(1) + vy(2) + vy(3) - 1; +%! endfunction +%! +%! vopt = odeset ("NormControl", "on"); +%! vsol = odekdi (@firobertson, [0, 1e5], [1, 0, 0], [-4e-2, 4e-2, 0], vopt); +%! plot (vsol.x, vsol.y); + +%!demo +%! # Solve the "Van der Pol" problem that is given as a function +%! # handle to an implicite differential equation implementation. +%! +%! function [vres] = fvanderpol (vt, vy, vyd, varargin) +%! mu = varargin{1}; +%! vres = [vy(2) - vyd(1); +%! mu * (1 - vy(1)^2) * vy(2) - vy(1) - vyd(2)]; +%! endfunction +%! +%! vopt = odeset ("NormControl", "on", "RelTol", 1e-8, "MaxStep", 1e-2); +%! vsol = odebdi (@fvanderpol, [0, 20], [2; 0], [0; -2], vopt, 10); +%! plot (vsol.x, vsol.y); + +%!demo +%! # Solve the "Van der Pol" problem that is given as a function +%! # handle to an implicite differential equation implementation. +%! +%! function [vres] = fvanderpol (vt, vy, vyd, varargin) +%! mu = varargin{1}; +%! vres = [vy(2) - vyd(1); +%! mu * (1 - vy(1)^2) * vy(2) - vy(1) - vyd(2)]; +%! endfunction +%! +%! vsol = odekdi (@fvanderpol, [0, 1000], [2; 0], [0; -2], 500); +%! plot (vsol.x, vsol.y); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_examples_ode.m b/octave_packages/odepkg-0.8.2/odepkg_examples_ode.m new file mode 100644 index 0000000..b2ff214 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_examples_ode.m @@ -0,0 +1,178 @@ +%# Copyright (C) 2008-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{}] =} odepkg_examples_ode (@var{}) +%# Open the ODE examples menu and allow the user to select a demo that will be evaluated. +%# @end deftypefn + +function [] = odepkg_examples_ode () + + vode = 1; while (vode > 0) + clc; + fprintf (1, ... + ['ODE examples menu:\n', ... + '==================\n', ... + '\n', ... + ' (1) Solve a non-stiff "Van der Pol" example with solver "ode78"\n', ... + ' (2) Solve a "Van der Pol" example backward with solver "ode23"\n', ... + ' (3) Solve a "Pendulous" example with solver "ode45"\n', ... + ' (4) Solve the "Lorenz attractor" with solver "ode54"\n', ... + ' (5) Solve the "Roessler equation" with solver "ode78"\n', ... + '\n', ... + ' Note: There are further ODE examples available with the OdePkg\n', ... + ' testsuite functions.\n', ... + '\n', ... + ' If you have another interesting ODE example that you would like\n', ... + ' to share then please modify this file, create a patch and send\n', ... + ' your patch with your added example to the OdePkg developer team.\n', ... + '\n' ]); + vode = input ('Please choose a number from above or press to return: '); + clc; if (vode > 0 && vode < 6) + %# We can't use the function 'demo' directly here because it does + %# not allow to run other functions within a demo. + vexa = example (mfilename (), vode); + disp (vexa); eval (vexa); + input ('Press to continue: '); + end %# if (vode > 0) + end %# while (vode > 0) + +%!demo +%! # In this example the non-stiff "Van der Pol" equation (mu = 1) is +%! # solved and the results are displayed in a figure while solving. +%! # Read about the Van der Pol oscillator at +%! # http://en.wikipedia.org/wiki/Van_der_Pol_oscillator. +%! +%! function [vyd] = fvanderpol (vt, vy, varargin) +%! mu = varargin{1}; +%! vyd = [vy(2); mu * (1 - vy(1)^2) * vy(2) - vy(1)]; +%! endfunction +%! +%! vopt = odeset ('RelTol', 1e-8); +%! ode78 (@fvanderpol, [0 20], [2 0], vopt, 1); + +%!demo +%! # In this example the non-stiff "Van der Pol" equation (mu = 1) is +%! # solved in forward and backward direction and the results are +%! # displayed in a figure after solving. Read about the Van der Pol +%! # oscillator at http://en.wikipedia.org/wiki/Van_der_Pol_oscillator. +%! +%! function [ydot] = fpol (vt, vy, varargin) +%! ydot = [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%! endfunction +%! +%! vopt = odeset ('NormControl', 'on'); +%! vsol = ode23 (@fpol, [0, 20], [2, 0], vopt); +%! subplot (2, 3, 1); plot (vsol.x, vsol.y); +%! vsol = ode23 (@fpol, [0:0.1:20], [2, 0], vopt); +%! subplot (2, 3, 2); plot (vsol.x, vsol.y); +%! vsol = ode23 (@fpol, [-20, 20], [-1.1222e-3, -0.2305e-3], vopt); +%! subplot (2, 3, 3); plot (vsol.x, vsol.y); +%! +%! vopt = odeset ('NormControl', 'on'); +%! vsol = ode23 (@fpol, [0:-0.1:-20], [2, 0], vopt); +%! subplot (2, 3, 4); plot (vsol.x, vsol.y); +%! vsol = ode23 (@fpol, [0, -20], [2, 0], vopt); +%! subplot (2, 3, 5); plot (vsol.x, vsol.y); +%! vsol = ode23 (@fpol, [20:-0.1:-20], [-2.0080, 0.0462], vopt); +%! subplot (2, 3, 6); plot (vsol.x, vsol.y); + +%!demo +%! # In this example a simple "pendulum with damping" is solved and the +%! # results are displayed in a figure while solving. Read about the +%! # pendulum with damping at +%! # http://en.wikipedia.org/wiki/Pendulum +%! +%! function [vyd] = fpendulum (vt, vy) +%! m = 1; %# The pendulum mass in kg +%! g = 9.81; %# The gravity in m/s^2 +%! l = 1; %# The pendulum length in m +%! b = 0.7; %# The damping factor in kgm^2/s +%! vyd = [vy(2,1); ... +%! 1 / (1/3 * m * l^2) * (-b * vy(2,1) - m * g * l/2 * sin (vy(1,1)))]; +%! endfunction +%! +%! vopt = odeset ('RelTol', 1e-3, 'OutputFcn', @odeplot); +%! ode45 (@fpendulum, [0 5], [30*pi/180, 0], vopt); + +%!demo +%! # In this example the "Lorenz attractor" implementation is solved +%! # and the results are plot in a figure after solving. Read about +%! # the Lorenz attractor at +%! # http://en.wikipedia.org/wiki/Lorenz_equation +%! # +%! # The upper left subfigure shows the three results of the integration +%! # over time. The upper right subfigure shows the force f in a two +%! # dimensional (x,y) plane as well as the lower left subfigure shows +%! # the force in the (y,z) plane. The three dimensional force is plot +%! # in the lower right subfigure. +%! +%! function [vyd] = florenz (vt, vy) +%! vyd = [10 * (vy(2) - vy(1)); +%! vy(1) * (28 - vy(3)); +%! vy(1) * vy(2) - 8/3 * vy(3)]; +%! endfunction +%! +%! A = odeset ('InitialStep', 1e-3, 'MaxStep', 1e-1); +%! [t, y] = ode54 (@florenz, [0 25], [3 15 1], A); +%! +%! subplot (2, 2, 1); grid ('on'); +%! plot (t, y(:,1), '-b', t, y(:,2), '-g', t, y(:,3), '-r'); +%! legend ('f_x(t)', 'f_y(t)', 'f_z(t)'); +%! subplot (2, 2, 2); grid ('on'); +%! plot (y(:,1), y(:,2), '-b'); +%! legend ('f_{xyz}(x, y)'); +%! subplot (2, 2, 3); grid ('on'); +%! plot (y(:,2), y(:,3), '-b'); +%! legend ('f_{xyz}(y, z)'); +%! subplot (2, 2, 4); grid ('on'); +%! plot3 (y(:,1), y(:,2), y(:,3), '-b'); +%! legend ('f_{xyz}(x, y, z)'); + +%!demo +%! # In this example the "Roessler attractor" implementation is solved +%! # and the results are plot in a figure after solving. Read about +%! # the Roessler attractor at +%! # http://en.wikipedia.org/wiki/R%C3%B6ssler_attractor +%! # +%! # The upper left subfigure shows the three results of the integration +%! # over time. The upper right subfigure shows the force f in a two +%! # dimensional (x,y) plane as well as the lower left subfigure shows +%! # the force in the (y,z) plane. The three dimensional force is plot +%! # in the lower right subfigure. +%! +%! function [vyd] = froessler (vt, vx) +%! vyd = [- ( vx(2) + vx(3) ); +%! vx(1) + 0.2 * vx(2); +%! 0.2 + vx(1) * vx(3) - 5.7 * vx(3)]; +%! endfunction +%! +%! A = odeset ('MaxStep', 1e-1); +%! [t, y] = ode78 (@froessler, [0 70], [0.1 0.3 0.1], A); +%! +%! subplot (2, 2, 1); grid ('on'); +%! plot (t, y(:,1), '-b;f_x(t);', t, y(:,2), '-g;f_y(t);', \ +%! t, y(:,3), '-r;f_z(t);'); +%! subplot (2, 2, 2); grid ('on'); +%! plot (y(:,1), y(:,2), '-b;f_{xyz}(x, y);'); +%! subplot (2, 2, 3); grid ('on'); +%! plot (y(:,2), y(:,3), '-b;f_{xyz}(y, z);'); +%! subplot (2, 2, 4); grid ('on'); +%! plot3 (y(:,1), y(:,2), y(:,3), '-b;f_{xyz}(x, y, z);'); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_structure_check.m b/octave_packages/odepkg-0.8.2/odepkg_structure_check.m new file mode 100644 index 0000000..1c68325 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_structure_check.m @@ -0,0 +1,435 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{newstruct}] =} odepkg_structure_check (@var{oldstruct}, [@var{"solver"}]) +%# +%# If this function is called with one input argument of type structure array then check the field names and the field values of the OdePkg structure @var{oldstruct} and return the structure as @var{newstruct} if no error is found. Optionally if this function is called with a second input argument @var{"solver"} of type string taht specifies the name of a valid OdePkg solver then a higher level error detection is performed. The function does not modify any of the field names or field values but terminates with an error if an invalid option or value is found. +%# +%# This function is an OdePkg internal helper function therefore it should never be necessary that this function is called directly by a user. There is only little error detection implemented in this function file to achieve the highest performance. +%# +%# Run examples with the command +%# @example +%# demo odepkg_structure_check +%# @end example +%# @end deftypefn +%# +%# @seealso{odepkg} + +function [vret] = odepkg_structure_check (varargin) + + %# Check the number of input arguments + if (nargin == 0) + help ('odepkg_structure_check'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be greater than zero'); + elseif (nargin > 2) + print_usage; + elseif (nargin == 1 && isstruct (varargin{1})) + vret = varargin{1}; + vsol = ''; + vfld = fieldnames (vret); + vlen = length (vfld); + elseif (nargin == 2 && isstruct (varargin{1}) && ischar (varargin{2})) + vret = varargin{1}; + vsol = varargin{2}; + vfld = fieldnames (vret); + vlen = length (vfld); + end + + for vcntarg = 1:vlen %# Run through the number of given structure field names + + switch (vfld{vcntarg}) + + case 'RelTol' + if (isnumeric (vret.(vfld{vcntarg})) && ... + isreal (vret.(vfld{vcntarg})) && ... + all (vret.(vfld{vcntarg}) > 0)) %# 'all' is a MatLab need + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + switch (vsol) + case {'ode23', 'ode45', 'ode54', 'ode78', ... + 'ode23d', 'ode45d', 'ode54d', 'ode78d',} + if (~isscalar (vret.(vfld{vcntarg})) && ... + ~isempty (vret.(vfld{vcntarg}))) + error ('OdePkg:InvalidParameter', ... + 'Value of option "RelTol" must be a scalar'); + end + otherwise + + end + + case 'AbsTol' + if (isnumeric (vret.(vfld{vcntarg})) && ... + isreal (vret.(vfld{vcntarg})) && ... + all (vret.(vfld{vcntarg}) > 0)) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'NormControl' + if (strcmp (vret.(vfld{vcntarg}), 'on') || ... + strcmp (vret.(vfld{vcntarg}), 'off')) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'NonNegative' + if (isempty (vret.(vfld{vcntarg})) || ... + (isnumeric (vret.(vfld{vcntarg})) && isvector (vret.(vfld{vcntarg})))) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'OutputFcn' + if (isempty (vret.(vfld{vcntarg})) || ... + isa (vret.(vfld{vcntarg}), 'function_handle')) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'OutputSel' + if (isempty (vret.(vfld{vcntarg})) || ... + (isnumeric (vret.(vfld{vcntarg})) && isvector (vret.(vfld{vcntarg}))) || ... + isscalar (vret.(vfld{vcntarg}))) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'OutputSave' + if (isempty (vret.(vfld{vcntarg})) || ... + (isscalar (vret.(vfld{vcntarg})) && ... + mod (vret.(vfld{vcntarg}), 1) == 0 && ... + vret.(vfld{vcntarg}) > 0) || ... + vret.(vfld{vcntarg}) == Inf) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'Refine' + if (isscalar (vret.(vfld{vcntarg})) && ... + mod (vret.(vfld{vcntarg}), 1) == 0 && ... + vret.(vfld{vcntarg}) >= 0 && ... + vret.(vfld{vcntarg}) <= 5) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'Stats' + if (strcmp (vret.(vfld{vcntarg}), 'on') || ... + strcmp (vret.(vfld{vcntarg}), 'off')) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'InitialStep' + if (isempty (vret.(vfld{vcntarg})) || ... + (isscalar (vret.(vfld{vcntarg})) && ... + isreal (vret.(vfld{vcntarg})))) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'MaxStep' + if (isempty (vret.(vfld{vcntarg})) || ... + (isscalar (vret.(vfld{vcntarg})) && ... + vret.(vfld{vcntarg}) > 0) ) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'Events' + if (isempty (vret.(vfld{vcntarg})) || ... + isa (vret.(vfld{vcntarg}), 'function_handle')) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'Jacobian' + if (isempty (vret.(vfld{vcntarg})) || ... + isnumeric (vret.(vfld{vcntarg})) || ... + isa (vret.(vfld{vcntarg}), 'function_handle') || ... + iscell (vret.(vfld{vcntarg}))) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'JPattern' + if (isempty (vret.(vfld{vcntarg})) || ... + isvector (vret.(vfld{vcntarg})) || ... + isnumeric (vret.(vfld{vcntarg}))) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'Vectorized' + if (strcmp (vret.(vfld{vcntarg}), 'on') || ... + strcmp (vret.(vfld{vcntarg}), 'off')) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'Mass' + if (isempty (vret.(vfld{vcntarg})) || ... + isnumeric (vret.(vfld{vcntarg})) || ... + isa (vret.(vfld{vcntarg}), 'function_handle')) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'MStateDependence' + if (strcmp (vret.(vfld{vcntarg}), 'none') || ... + strcmp (vret.(vfld{vcntarg}), 'weak') || ... + strcmp (vret.(vfld{vcntarg}), 'strong')) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'MvPattern' + if (isempty (vret.(vfld{vcntarg})) || ... + isvector (vret.(vfld{vcntarg})) || ... + isnumeric (vret.(vfld{vcntarg}))) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'MassSingular' + if (strcmp (vret.(vfld{vcntarg}), 'yes') || ... + strcmp (vret.(vfld{vcntarg}), 'no') || ... + strcmp (vret.(vfld{vcntarg}), 'maybe')) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'InitialSlope' + if (isempty (vret.(vfld{vcntarg})) || ... + isvector (vret.(vfld{vcntarg}))) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'MaxOrder' + if (isempty (vret.(vfld{vcntarg})) || ... + (mod (vret.(vfld{vcntarg}), 1) == 0 && ... + vret.(vfld{vcntarg}) > 0 && ... + vret.(vfld{vcntarg}) < 8)) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'BDF' + if (isempty (vret.(vfld{vcntarg})) || ... + (strcmp (vret.(vfld{vcntarg}), 'on') || ... + strcmp (vret.(vfld{vcntarg}), 'off'))) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'NewtonTol' + if (isnumeric (vret.(vfld{vcntarg})) && ... + isreal (vret.(vfld{vcntarg})) && ... + all (vret.(vfld{vcntarg}) > 0)) %# 'all' is a MatLab need + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + case 'MaxNewtonIterations' + if (isempty (vret.(vfld{vcntarg})) || ... + (mod (vret.(vfld{vcntarg}), 1) == 0 && ... + vret.(vfld{vcntarg}) > 0)) + else + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s" or no valid parameter value', ... + vfld{vcntarg}); + end + + otherwise + error ('OdePkg:InvalidParameter', ... + 'Unknown parameter name "%s"', ... + vfld{vcntarg}); + + end %# switch + + end %# for + +%# The following line can be uncommented for a even higher level error +%# detection +%# if (vlen ~= 21) +%# vmsg = sprintf ('Number of fields in structure must match 21'); +%# error (vmsg); +%# end + +%!test A = odeset ('RelTol', 1e-4); +%!test A = odeset ('RelTol', [1e-4, 1e-3]); +%!test A = odeset ('RelTol', []); +%!error A = odeset ('RelTol', '1e-4'); +%!test A = odeset ('AbsTol', 1e-4); +%!test A = odeset ('AbsTol', [1e-4, 1e-3]); +%!test A = odeset ('AbsTol', []); +%!error A = odeset ('AbsTol', '1e-4'); +%!test A = odeset ('NormControl', 'on'); +%!test A = odeset ('NormControl', 'off'); +%!error A = odeset ('NormControl', []); +%!error A = odeset ('NormControl', '12'); +%!test A = odeset ('NonNegative', 1); +%!test A = odeset ('NonNegative', [1, 2, 3]); +%!test A = odeset ('NonNegative', []); +%!error A = odeset ('NonNegative', '12'); +%!test A = odeset ('OutputFcn', @odeprint); +%!test A = odeset ('OutputFcn', @odeplot); +%!test A = odeset ('OutputFcn', []); +%!error A = odeset ('OutputFcn', 'odeprint'); +%!test A = odeset ('OutputSel', 1); +%!test A = odeset ('OutputSel', [1, 2, 3]); +%!test A = odeset ('OutputSel', []); +%!error A = odeset ('OutputSel', '12'); +%!test A = odeset ('Refine', 3); +%!error A = odeset ('Refine', [1, 2, 3]); +%!error A = odeset ('Refine', []); +%!error A = odeset ('Refine', 6); +%!test A = odeset ('Stats', 'on'); +%!test A = odeset ('Stats', 'off'); +%!error A = odeset ('Stats', []); +%!error A = odeset ('Stats', '12'); +%!test A = odeset ('InitialStep', 3); +%!error A = odeset ('InitialStep', [1, 2, 3]); +%!test A = odeset ('InitialStep', []); +%!test A = odeset ('InitialStep', 6); +%!test A = odeset ('MaxStep', 3); +%!error A = odeset ('MaxStep', [1, 2, 3]); +%!test A = odeset ('MaxStep', []); +%!test A = odeset ('MaxStep', 6); +%!test A = odeset ('Events', @demo); +%!error A = odeset ('Events', 'off'); +%!test A = odeset ('Events', []); +%!error A = odeset ('Events', '12'); +%!test A = odeset ('Jacobian', @demo); +%!test A = odeset ('Jacobian', [1, 2; 3, 4]); +%!test A = odeset ('Jacobian', []); +%!error A = odeset ('Jacobian', '12'); +%!test A = odeset ('JPattern', []); +%!test A = odeset ('JPattern', [1, 2, 4]); +%!test A = odeset ('JPattern', [1, 2; 3, 4]); +%!test A = odeset ('JPattern', 1); +%!test A = odeset ('Vectorized', 'on'); +%!test A = odeset ('Vectorized', 'off'); +%!error A = odeset ('Vectorized', []); +%!error A = odeset ('Vectorized', '12'); +%!test A = odeset ('Mass', @demo); +%!test A = odeset ('Mass', [1, 2; 3, 4]); +%!test A = odeset ('Mass', []); +%!error A = odeset ('Mass', '12'); +%!test A = odeset ('MStateDependence', 'none'); +%!test A = odeset ('MStateDependence', 'weak'); +%!test A = odeset ('MStateDependence', 'strong'); +%!error A = odeset ('MStateDependence', [1, 2; 3, 4]); +%!error A = odeset ('MStateDependence', []); +%!error A = odeset ('MStateDependence', '12'); +%!test A = odeset ('MvPattern', []); +%!test A = odeset ('MvPattern', [1, 2, 3 ]); +%!test A = odeset ('MvPattern', [1, 2; 3, 4]); +%!test A = odeset ('MvPattern', 1); +%!test A = odeset ('MassSingular', 'yes'); +%!test A = odeset ('MassSingular', 'no'); +%!test A = odeset ('MassSingular', 'maybe'); +%!error A = odeset ('MassSingular', [1, 2; 3, 4]); +%!error A = odeset ('MassSingular', []); +%!error A = odeset ('MassSingular', '12'); +%!test A = odeset ('InitialSlope', [1, 2, 3]); +%!test A = odeset ('InitialSlope', 1); +%!test A = odeset ('InitialSlope', []); +%!test A = odeset ('InitialSlope', '12'); +%!test A = odeset ('MaxOrder', 3); +%!error A = odeset ('MaxOrder', 3.5); +%!test A = odeset ('MaxOrder', [1, 2; 3, 4]); +%!test A = odeset ('MaxOrder', []); +%!test A = odeset ('BDF', 'on'); +%!test A = odeset ('BDF', 'off'); +%!test A = odeset ('BDF', []); +%!error A = odeset ('BDF', [1, 2; 3, 4]); +%!test A = odeset ('NewtonTol', []); +%!test A = odeset ('NewtonTol', 1e-3); +%!test A = odeset ('NewtonTol', [1e-3, 1e-3, 1e-3]); +%!error A = odeset ('NewtonTol', 'string'); +%!test A = odeset ('MaxNewtonIterations', []); +%!test A = odeset ('MaxNewtonIterations', 2); +%!error A = odeset ('MaxNewtonIterations', 'string'); + +%!demo +%! # Return the checked OdePkg options structure that is created by +%! # the command odeset. +%! +%! odepkg_structure_check (odeset); +%! +%!demo +%! # Create the OdePkg options structure A with odeset and check it +%! # with odepkg_structure_check. This actually is unnecessary +%! # because odeset automtically calls odepkg_structure_check before +%! # returning. +%! +%! A = odeset (); odepkg_structure_check (A); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_testsuite_calcmescd.m b/octave_packages/odepkg-0.8.2/odepkg_testsuite_calcmescd.m new file mode 100644 index 0000000..e59a65b --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_testsuite_calcmescd.m @@ -0,0 +1,59 @@ +%# Copyright (C) 2007-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{mescd}] =} odepkg_testsuite_calcmescd (@var{solution}, @var{reference}, @var{abstol}, @var{reltol}) +%# +%# If this function is called with four input arguments of type double scalar or column vector then return a normalized value for the minimum number of correct digits @var{mescd} that is calculated from the solution at the end of an integration interval @var{solution} and a set of reference values @var{reference}. The input arguments @var{abstol} and @var{reltol} are used to calculate a reference solution that depends on the relative and absolute error tolerances. +%# +%# Run examples with the command +%# @example +%# demo odepkg_testsuite_calcmescd +%# @end example +%# +%# This function has been ported from the "Test Set for IVP solvers" which is developed by the INdAM Bari unit project group "Codes and Test Problems for Differential Equations", coordinator F. Mazzia. +%# @end deftypefn +%# +%# @seealso{odepkg} + + +function vmescd = odepkg_testsuite_calcmescd (vsol, vref, vatol, vrtol) + vsol = vsol(:); vref = vref(:); vatol = vatol(:); vrtol = vrtol(:); + vtmp = (vref - vsol) ./ (vatol ./ vrtol + vref); + vmescd = -log10 (norm (vtmp, inf)); + +%!demo +%! # Display the value for the mimum number of correct digits in the vector +%! # sol = [1, 2, 2.9] compared to the reference vector ref = [1, 2, 3]. +%! +%! odepkg_testsuite_calcmescd ([1, 2, 2.9], [1, 2, 3], 1e-3, 1e-6) +%! +%!demo +%! # Display the value for the mimum number of correct digits in the vector +%! # sol = [1 + 1e10, 2 + 1e10, 3 + 1e10] compared to the reference vector +%! # ref = [1, 2, 3]. +%! +%! odepkg_testsuite_calcmescd ([1 + 1e10, 2 + 1e10, 3 + 1e10], [1, 2, 3], ... +%! [1e-3, 1e-4, 1e-5], [1e-6, 1e-6, 1e-6]) + +%!assert (odepkg_testsuite_calcmescd ([1, 2, 3], [1, 2, 3], NaN, NaN), Inf); +%!assert (odepkg_testsuite_calcmescd ([1, 2, 3], [1, 2, 3], 1, 1), Inf); +%!assert (odepkg_testsuite_calcmescd ([1, 2, 3], [1, 2.1, 3], 1, 1), 1.5, 0.1); +%!assert (odepkg_testsuite_calcmescd ([1, 2, 3], [1+1e-6, 2, 3], 1, 1), 6.5, 0.2); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_testsuite_calcscd.m b/octave_packages/odepkg-0.8.2/odepkg_testsuite_calcscd.m new file mode 100644 index 0000000..53567bf --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_testsuite_calcscd.m @@ -0,0 +1,58 @@ +%# Copyright (C) 2007-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{scd}] =} odepkg_testsuite_calcscd (@var{solution}, @var{reference}, @var{abstol}, @var{reltol}) +%# +%# If this function is called with four input arguments of type double scalar or column vector then return a normalized value for the minimum number of correct digits @var{scd} that is calculated from the solution at the end of an integration interval @var{solution} and a set of reference values @var{reference}. The input arguments @var{abstol} and @var{reltol} are unused but present because of compatibility to the function @command{odepkg_testsuite_calcmescd}. +%# +%# Run examples with the command +%# @example +%# demo odepkg_testsuite_calcscd +%# @end example +%# +%# This function has been ported from the "Test Set for IVP solvers" which is developed by the INdAM Bari unit project group "Codes and Test Problems for Differential Equations", coordinator F. Mazzia. +%# @end deftypefn +%# +%# @seealso{odepkg} + +function vscd = odepkg_testsuite_calcscd (vsol, vref, vatol, vrtol) + vsol = vsol(:); vref = vref(:); + vrel = (vref - vsol) / vref; + vscd = -log10 (norm (vrel, inf)); + +%!demo +%! # Displays the value for the mimum number of correct digits in +%! # the vector sol = [1, 2, 2.9] compared to the reference vector +%! # ref = [1, 2, 3]. +%! +%! odepkg_testsuite_calcscd ([1, 2, 2.9], [1, 2, 3], NaN, NaN) +%! +%!demo +%! # Displays the value for the mimum number of correct digits in +%! # the vector sol = [1, 2, 2.9] compared to the reference vector +%! # ref = [1, 2, 3]. +%! +%! odepkg_testsuite_calcscd ([1 + 1e10, 2 + 1e10, 3 + 1e10], ... +%! [1, 2, 3], NaN, NaN) + +%!assert (odepkg_testsuite_calcscd ([1, 2, 3], [1, 2, 3], NaN, NaN), Inf); +%!assert (odepkg_testsuite_calcscd ([1, 2, 3], [1, 2.1, 3], 1, 1), 1.5, 0.2); +%!assert (odepkg_testsuite_calcscd ([1, 2, 3], [1+1e-6, 2, 3], 1, 1), 6.5, 0.2); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_testsuite_chemakzo.m b/octave_packages/odepkg-0.8.2/odepkg_testsuite_chemakzo.m new file mode 100644 index 0000000..144dd5e --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_testsuite_chemakzo.m @@ -0,0 +1,184 @@ +%# Copyright (C) 2007-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{solution}] =} odepkg_testsuite_chemakzo (@var{@@solver}, @var{reltol}) +%# +%# If this function is called with two input arguments and the first input argument @var{@@solver} is a function handle describing an OdePkg solver and the second input argument @var{reltol} is a double scalar describing the relative error tolerance then return a cell array @var{solution} with performance informations about the chemical AKZO Nobel testsuite of differential algebraic equations after solving (DAE--test). +%# +%# Run examples with the command +%# @example +%# demo odepkg_testsuite_chemakzo +%# @end example +%# +%# This function has been ported from the "Test Set for IVP solvers" which is developed by the INdAM Bari unit project group "Codes and Test Problems for Differential Equations", coordinator F. Mazzia. +%# @end deftypefn +%# +%# @seealso{odepkg} + +function vret = odepkg_testsuite_chemakzo (vhandle, vrtol) + + if (nargin ~= 2) %# Check number and types of all input arguments + help ('odepkg_testsuite_chemakzo'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be exactly two'); + elseif (~isa (vhandle, 'function_handle') || ~isscalar (vrtol)) + print_usage; + end + + vret{1} = vhandle; %# The handle for the solver that is used + vret{2} = vrtol; %# The value for the realtive tolerance + vret{3} = vret{2}; %# The value for the absolute tolerance + vret{4} = vret{2}; %# The value for the first time step + %# Write a debug message on the screen, because this testsuite function + %# may be called more than once from a loop over all solvers present + fprintf (1, ['Testsuite AKZO, testing solver %7s with relative', ... + ' tolerance %2.0e\n'], func2str (vret{1}), vrtol); fflush (1); + + %# Setting the integration algorithms option values + vstart = 0.0; %# The point of time when solving is started + vstop = 180.0; %# The point of time when solving is stoped + vinit = odepkg_testsuite_chemakzoinit; %# The initial values + vmass = odepkg_testsuite_chemakzomass; %# The mass matrix + + vopt = odeset ('Refine', 0, 'RelTol', vret{2}, 'AbsTol', vret{3}, ... + 'InitialStep', vret{4}, 'Stats', 'on', 'NormControl', 'off', ... + 'Jacobian', @odepkg_testsuite_chemakzojac, 'Mass', vmass, ... + 'MaxStep', vstop-vstart); %# , 'OutputFcn', @odeplot); + + %# Calculate the algorithm, start timer and do solving + tic; vsol = feval (vhandle, @odepkg_testsuite_chemakzofun, ... + [vstart, vstop], vinit, vopt); + vret{12} = toc; %# The value for the elapsed time + vref = odepkg_testsuite_chemakzoref; %# Get the reference solution vector + if (max (size (vsol.y(end,:))) == max (size (vref))), vlst = vsol.y(end,:); + elseif (max (size (vsol.y(:,end))) == max (size (vref))), vlst = vsol.y(:,end); + end + vret{5} = odepkg_testsuite_calcmescd (vlst, vref, vret{3}, vret{2}); + vret{6} = odepkg_testsuite_calcscd (vlst, vref, vret{3}, vret{2}); + vret{7} = vsol.stats.nsteps + vsol.stats.nfailed; %# The value for all evals + vret{8} = vsol.stats.nsteps; %# The value for success evals + vret{9} = vsol.stats.nfevals; %# The value for fun calls + vret{10} = vsol.stats.npds; %# The value for partial derivations + vret{11} = vsol.stats.ndecomps; %# The value for LU decompositions + +%# Returns the results for the for the chemical AKZO problem +function f = odepkg_testsuite_chemakzofun (t, y, varargin) + k1 = 18.7; k2 = 0.58; k3 = 0.09; k4 = 0.42; + kbig = 34.4; kla = 3.3; ks = 115.83; po2 = 0.9; + hen = 737; + +%# if (y(2) <= 0) +%# error ('odepkg_testsuite_chemakzojac: Second input argument is negative'); +%# end + + r1 = k1 * y(1)^4 * sqrt (y(2)); + r2 = k2 * y(3) * y(4); + r3 = k2 / kbig * y(1) * y(5); + r4 = k3 * y(1) * y(4)^2; + r5 = k4 * y(6)^2 * sqrt (y(2)); + fin = kla * (po2 / hen - y(2)); + + f(1,1) = -2 * r1 + r2 - r3 - r4; + f(2,1) = -0.5 * r1 - r4 - 0.5 * r5 + fin; + f(3,1) = r1 - r2 + r3; + f(4,1) = - r2 + r3 - 2 * r4; + f(5,1) = r2 - r3 + r5; + f(6,1) = ks * y(1) * y(4) - y(6); + +%# Returns the INITIAL values for the chemical AKZO problem +function vinit = odepkg_testsuite_chemakzoinit () + vinit = [0.444, 0.00123, 0, 0.007, 0, 115.83 * 0.444 * 0.007]; + +%# Returns the JACOBIAN matrix for the chemical AKZO problem +function dfdy = odepkg_testsuite_chemakzojac (t, y, varargin) + k1 = 18.7; k2 = 0.58; k3 = 0.09; k4 = 0.42; + kbig = 34.4; kla = 3.3; ks = 115.83; po2 = 0.9; + hen = 737; + +%# if (y(2) <= 0) +%# error ('odepkg_testsuite_chemakzojac: Second input argument is negative'); +%# end + dfdy = zeros (6, 6); + + r11 = 4 * k1 * y(1)^3 * sqrt (y(2)); + r12 = 0.5 * k1 * y(1)^4 / sqrt (y(2)); + r23 = k2 * y(4); + r24 = k2 * y(3); + r31 = (k2 / kbig) * y(5); + r35 = (k2 / kbig) * y(1); + r41 = k3 * y(4)^2; + r44 = 2 * k3 * y(1) * y(4); + r52 = 0.5 * k4 * y(6)^2 / sqrt (y(2)); + r56 = 2 * k4 * y(6) * sqrt (y(2)); + fin2 = -kla; + + dfdy(1,1) = -2 * r11 - r31 - r41; + dfdy(1,2) = -2 * r12; + dfdy(1,3) = r23; + dfdy(1,4) = r24 - r44; + dfdy(1,5) = -r35; + dfdy(2,1) = -0.5 * r11 - r41; + dfdy(2,2) = -0.5 * r12 - 0.5 * r52 + fin2; + dfdy(2,4) = -r44; + dfdy(2,6) = -0.5 * r56; + dfdy(3,1) = r11 + r31; + dfdy(3,2) = r12; + dfdy(3,3) = -r23; + dfdy(3,4) = -r24; + dfdy(3,5) = r35; + dfdy(4,1) = r31 - 2 * r41; + dfdy(4,3) = -r23; + dfdy(4,4) = -r24 - 2 * r44; + dfdy(4,5) = r35; + dfdy(5,1) = -r31; + dfdy(5,2) = r52; + dfdy(5,3) = r23; + dfdy(5,4) = r24; + dfdy(5,5) = -r35; + dfdy(5,6) = r56; + dfdy(6,1) = ks * y(4); + dfdy(6,4) = ks * y(1); + dfdy(6,6) = -1; + +%# Returns the MASS matrix for the chemical AKZO problem +function mass = odepkg_testsuite_chemakzomass (t, y, varargin) + mass = [ 1, 0, 0, 0, 0, 0; + 0, 1, 0, 0, 0, 0; + 0, 0, 1, 0, 0, 0; + 0, 0, 0, 1, 0, 0; + 0, 0, 0, 0, 1, 0; + 0, 0, 0, 0, 0, 0 ]; + +%# Returns the REFERENCE values for the chemical AKZO problem +function y = odepkg_testsuite_chemakzoref () + y(1,1) = 0.11507949206617e+0; + y(2,1) = 0.12038314715677e-2; + y(3,1) = 0.16115628874079e+0; + y(4,1) = 0.36561564212492e-3; + y(5,1) = 0.17080108852644e-1; + y(6,1) = 0.48735313103074e-2; + +%!demo +%! vsolver = {@odebda, @oders, @ode2r, @ode5r, @odesx}; +%! for vcnt=1:length (vsolver) +%! vakzo{vcnt,1} = odepkg_testsuite_chemakzo (vsolver{vcnt}, 1e-7); +%! end +%! vakzo + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_testsuite_hires.m b/octave_packages/odepkg-0.8.2/odepkg_testsuite_hires.m new file mode 100644 index 0000000..d6c5276 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_testsuite_hires.m @@ -0,0 +1,142 @@ +%# Copyright (C) 2007-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{solution}] =} odepkg_testsuite_hires (@var{@@solver}, @var{reltol}) +%# +%# If this function is called with two input arguments and the first input argument @var{@@solver} is a function handle describing an OdePkg solver and the second input argument @var{reltol} is a double scalar describing the relative error tolerance then return a cell array @var{solution} with performance informations about the HIRES testsuite of ordinary differential equations after solving (ODE--test). +%# +%# Run examples with the command +%# @example +%# demo odepkg_testsuite_hires +%# @end example +%# +%# This function has been ported from the "Test Set for IVP solvers" which is developed by the INdAM Bari unit project group "Codes and Test Problems for Differential Equations", coordinator F. Mazzia. +%# @end deftypefn +%# +%# @seealso{odepkg} + +function vret = odepkg_testsuite_hires (vhandle, vrtol) + + if (nargin ~= 2) %# Check number and types of all input arguments + help ('odepkg_testsuite_hires'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be exactly two'); + elseif (~isa (vhandle, 'function_handle') || ~isscalar (vrtol)) + print_usage; + end + + vret{1} = vhandle; %# The handle for the solver that is used + vret{2} = vrtol; %# The value for the realtive tolerance + vret{3} = vret{2}; %# The value for the absolute tolerance + vret{4} = vret{2} * 10^(-2); %# The value for the first time step + %# Write a debug message on the screen, because this testsuite function + %# may be called more than once from a loop over all solvers present + fprintf (1, ['Testsuite HIRES, testing solver %7s with relative', ... + ' tolerance %2.0e\n'], func2str (vret{1}), vrtol); fflush (1); + + %# Setting the integration algorithms option values + vstart = 0.0; %# The point of time when solving is started + vstop = 321.8122; %# The point of time when solving is stoped + vinit = odepkg_testsuite_hiresinit; %# The initial values + + vopt = odeset ('Refine', 0, 'RelTol', vret{2}, 'AbsTol', vret{3}, ... + 'InitialStep', vret{4}, 'Stats', 'on', 'NormControl', 'off', ... + 'Jacobian', @odepkg_testsuite_hiresjac, 'MaxStep', vstop-vstart); + + %# Calculate the algorithm, start timer and do solving + tic; vsol = feval (vhandle, @odepkg_testsuite_hiresfun, ... + [vstart, vstop], vinit, vopt); + vret{12} = toc; %# The value for the elapsed time + vref = odepkg_testsuite_hiresref; %# Get the reference solution vector + if (exist ('OCTAVE_VERSION') ~= 0) + vlst = vsol.y(end,:); + else + vlst = vsol.y(:,end); + end + vret{5} = odepkg_testsuite_calcmescd (vlst, vref, vret{3}, vret{2}); + vret{6} = odepkg_testsuite_calcscd (vlst, vref, vret{3}, vret{2}); + vret{7} = vsol.stats.nsteps + vsol.stats.nfailed; %# The value for all evals + vret{8} = vsol.stats.nsteps; %# The value for success evals + vret{9} = vsol.stats.nfevals; %# The value for fun calls + vret{10} = vsol.stats.npds; %# The value for partial derivations + vret{11} = vsol.stats.ndecomps; %# The value for LU decompositions + +%# Returns the results for the HIRES problem +function f = odepkg_testsuite_hiresfun (t, y, varargin) + f(1,1) = -1.71 * y(1) + 0.43 * y(2) + 8.32 * y(3) + 0.0007; + f(2,1) = 1.71 * y(1) - 8.75 * y(2); + f(3,1) = -10.03 * y(3) + 0.43 * y(4) + 0.035 * y(5); + f(4,1) = 8.32 * y(2) + 1.71 * y(3) - 1.12 * y(4); + f(5,1) = -1.745 * y(5) + 0.43 * (y(6) + y(7)); + f(6,1) = -280 * y(6) * y(8) + 0.69 * y(4) + 1.71 * y(5) - 0.43 * y(6) + 0.69 * y(7); + f(7,1) = 280 * y(6) * y(8) - 1.81 * y(7); + f(8,1) = -f(7); + +%# Returns the INITIAL values for the HIRES problem +function vinit = odepkg_testsuite_hiresinit () + vinit = [1, 0, 0, 0, 0, 0, 0, 0.0057]; + +%# Returns the JACOBIAN matrix for the HIRES problem +function dfdy = odepkg_testsuite_hiresjac (t, y, varargin) + dfdy(1,1) = -1.71; + dfdy(1,2) = 0.43; + dfdy(1,3) = 8.32; + dfdy(2,1) = 1.71; + dfdy(2,2) = -8.75; + dfdy(3,3) = -10.03; + dfdy(3,4) = 0.43; + dfdy(3,5) = 0.035; + dfdy(4,2) = 8.32; + dfdy(4,3) = 1.71; + dfdy(4,4) = -1.12; + dfdy(5,5) = -1.745; + dfdy(5,6) = 0.43; + dfdy(5,7) = 0.43; + dfdy(6,4) = 0.69; + dfdy(6,5) = 1.71; + dfdy(6,6) = -280 * y(8) - 0.43; + dfdy(6,7) = 0.69; + dfdy(6,8) = -280 * y(6); + dfdy(7,6) = 280 * y(8); + dfdy(7,7) = -1.81; + dfdy(7,8) = 280 * y(6); + dfdy(8,6) = -280 * y(8); + dfdy(8,7) = 1.81; + dfdy(8,8) = -280 * y(6); + +%# Returns the REFERENCE values for the HIRES problem +function y = odepkg_testsuite_hiresref () + y(1,1) = 0.73713125733256e-3; + y(2,1) = 0.14424857263161e-3; + y(3,1) = 0.58887297409675e-4; + y(4,1) = 0.11756513432831e-2; + y(5,1) = 0.23863561988313e-2; + y(6,1) = 0.62389682527427e-2; + y(7,1) = 0.28499983951857e-2; + y(8,1) = 0.28500016048142e-2; + +%!demo +%! vsolver = {@ode23, @ode45, @ode54, @ode78, ... +%! @odebda, @oders, @ode2r, @ode5r, @odesx}; +%! for vcnt=1:length (vsolver) +%! vhires{vcnt,1} = odepkg_testsuite_hires (vsolver{vcnt}, 1e-7); +%! end +%! vhires + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_testsuite_implakzo.m b/octave_packages/odepkg-0.8.2/odepkg_testsuite_implakzo.m new file mode 100644 index 0000000..05b4827 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_testsuite_implakzo.m @@ -0,0 +1,192 @@ +%# Copyright (C) 2007-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{solution}] =} odepkg_testsuite_implakzo (@var{@@solver}, @var{reltol}) +%# +%# If this function is called with two input arguments and the first input argument @var{@@solver} is a function handle describing an OdePkg solver and the second input argument @var{reltol} is a double scalar describing the relative error tolerance then return a cell array @var{solution} with performance informations about the chemical AKZO Nobel testsuite of implicit differential algebraic equations after solving (IDE--test). +%# +%# Run examples with the command +%# @example +%# demo odepkg_testsuite_implakzo +%# @end example +%# +%# This function has been ported from the "Test Set for IVP solvers" which is developed by the INdAM Bari unit project group "Codes and Test Problems for Differential Equations", coordinator F. Mazzia. +%# @end deftypefn +%# +%# @seealso{odepkg} + +function vret = odepkg_testsuite_implakzo (vhandle, vrtol) + + if (nargin ~= 2) %# Check number and types of all input arguments + help ('odepkg_testsuite_implakzo'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be exactly two'); + elseif (~isa (vhandle, 'function_handle') || ~isscalar (vrtol)) + print_usage; + end + + vret{1} = vhandle; %# The handle for the solver that is used + vret{2} = vrtol; %# The value for the realtive tolerance + vret{3} = vret{2}; %# The value for the absolute tolerance + vret{4} = vret{2}; %# The value for the first time step + %# Write a debug message on the screen, because this testsuite function + %# may be called more than once from a loop over all solvers present + fprintf (1, ['Testsuite AKZO, testing solver %7s with relative', ... + ' tolerance %2.0e\n'], func2str (vret{1}), vrtol); fflush (1); + + %# Setting the integration algorithms option values + vstart = 0.0; %# The point of time when solving is started + vstop = 180.0; %# The point of time when solving is stoped + [vinity, vinityd] = odepkg_testsuite_implakzoinit; %# The initial values + + vopt = odeset ('Refine', 0, 'RelTol', vret{2}, 'AbsTol', vret{3}, ... + 'InitialStep', vret{4}, 'Stats', 'on', 'NormControl', 'off', ... + 'Jacobian', @odepkg_testsuite_implakzojac, 'MaxStep', vstop-vstart); + %# ,'OutputFcn', @odeplot, 'MaxStep', 1); + + %# Calculate the algorithm, start timer and do solving + tic; vsol = feval (vhandle, @odepkg_testsuite_implakzofun, ... + [vstart, vstop], vinity, vinityd', vopt); + vret{12} = toc; %# The value for the elapsed time + vref = odepkg_testsuite_implakzoref; %# Get the reference solution vector + if (exist ('OCTAVE_VERSION') ~= 0) + vlst = vsol.y(end,:); + else + vlst = vsol.y(:,end); + end + vret{5} = odepkg_testsuite_calcmescd (vlst, vref, vret{3}, vret{2}); + vret{6} = odepkg_testsuite_calcscd (vlst, vref, vret{3}, vret{2}); + vret{7} = vsol.stats.nsteps + vsol.stats.nfailed; %# The value for all evals + vret{8} = vsol.stats.nsteps; %# The value for success evals + vret{9} = vsol.stats.nfevals; %# The value for fun calls + vret{10} = vsol.stats.npds; %# The value for partial derivations + vret{11} = vsol.stats.ndecomps; %# The value for LU decompositions + +%# Return the results for the for the chemical AKZO problem +function res = odepkg_testsuite_implakzofun (t, y, yd, varargin) + k1 = 18.7; k2 = 0.58; k3 = 0.09; k4 = 0.42; + kbig = 34.4; kla = 3.3; ks = 115.83; po2 = 0.9; + hen = 737; + + r1 = k1 * y(1)^4 * sqrt (y(2)); + r2 = k2 * y(3) * y(4); + r3 = k2 / kbig * y(1) * y(5); + r4 = k3 * y(1) * y(4)^2; + r5 = k4 * y(6)^2 * sqrt (y(2)); + fin = kla * (po2 / hen - y(2)); + + res(1,1) = -2 * r1 + r2 - r3 - r4 - yd(1); + res(2,1) = -0.5 * r1 - r4 - 0.5 * r5 + fin - yd(2); + res(3,1) = r1 - r2 + r3 - yd(3); + res(4,1) = - r2 + r3 - 2 * r4 - yd(4); + res(5,1) = r2 - r3 + r5 - yd(5); + res(6,1) = ks * y(1) * y(4) - y(6) - yd(6); + +%# Return the INITIAL values for the chemical AKZO problem +function [y0, yd0] = odepkg_testsuite_implakzoinit () + y0 = [0.444, 0.00123, 0, 0.007, 0, 115.83 * 0.444 * 0.007]; + yd0 = [-0.051, -0.014, 0.025, 0, 0.002, 0]; + +%# Return the JACOBIAN matrix for the chemical AKZO problem +function [dfdy, dfdyd] = odepkg_testsuite_implakzojac (t, y, varargin) + k1 = 18.7; k2 = 0.58; k3 = 0.09; k4 = 0.42; + kbig = 34.4; kla = 3.3; ks = 115.83; po2 = 0.9; + hen = 737; + +%# if (y(2) <= 0) +%# error ('odepkg_testsuite_implakzojac: Second input argument is negative'); +%# end + + dfdy = zeros (6, 6); + + r11 = 4 * k1 * y(1)^3 * sqrt (y(2)); + r12 = 0.5 * k1 * y(1)^4 / sqrt (y(2)); + r23 = k2 * y(4); + r24 = k2 * y(3); + r31 = (k2 / kbig) * y(5); + r35 = (k2 / kbig) * y(1); + r41 = k3 * y(4)^2; + r44 = 2 * k3 * y(1) * y(4); + r52 = 0.5 * k4 * y(6)^2 / sqrt (y(2)); + r56 = 2 * k4 * y(6) * sqrt (y(2)); + fin2 = -kla; + + dfdy(1,1) = -2 * r11 - r31 - r41; + dfdy(1,2) = -2 * r12; + dfdy(1,3) = r23; + dfdy(1,4) = r24 - r44; + dfdy(1,5) = -r35; + dfdy(2,1) = -0.5 * r11 - r41; + dfdy(2,2) = -0.5 * r12 - 0.5 * r52 + fin2; + dfdy(2,4) = -r44; + dfdy(2,6) = -0.5 * r56; + dfdy(3,1) = r11 + r31; + dfdy(3,2) = r12; + dfdy(3,3) = -r23; + dfdy(3,4) = -r24; + dfdy(3,5) = r35; + dfdy(4,1) = r31 - 2 * r41; + dfdy(4,3) = -r23; + dfdy(4,4) = -r24 - 2 * r44; + dfdy(4,5) = r35; + dfdy(5,1) = -r31; + dfdy(5,2) = r52; + dfdy(5,3) = r23; + dfdy(5,4) = r24; + dfdy(5,5) = -r35; + dfdy(5,6) = r56; + dfdy(6,1) = ks * y(4); + dfdy(6,4) = ks * y(1); + dfdy(6,6) = -1; + + dfdyd = - [ 1, 0, 0, 0, 0, 0; + 0, 1, 0, 0, 0, 0; + 0, 0, 1, 0, 0, 0; + 0, 0, 0, 1, 0, 0; + 0, 0, 0, 0, 1, 0; + 0, 0, 0, 0, 0, 1 ]; + +%# For the implicit form of the chemical AKZO Nobel problem a mass +%# matrix is not needed. This mass matrix is needed if the problem +%# is formulated in explicit form (cf. odepkg_testsuite_cemakzo.m). +%# function mass = odepkg_testsuite_implakzomass (t, y, varargin) +%# mass = [ 1, 0, 0, 0, 0, 0; +%# 0, 1, 0, 0, 0, 0; +%# 0, 0, 1, 0, 0, 0; +%# 0, 0, 0, 1, 0, 0; +%# 0, 0, 0, 0, 1, 0; +%# 0, 0, 0, 0, 0, 0 ]; + +%# Return the REFERENCE values for the chemical AKZO problem +function y = odepkg_testsuite_implakzoref () + y(1,1) = 0.11507949206617e+0; + y(2,1) = 0.12038314715677e-2; + y(3,1) = 0.16115628874079e+0; + y(4,1) = 0.36561564212492e-3; + y(5,1) = 0.17080108852644e-1; + y(6,1) = 0.48735313103074e-2; + +%!demo +%! vsolver = {@odebdi}; +%! for vcnt=1:length (vsolver) +%! vakzo{vcnt,1} = odepkg_testsuite_implakzo (vsolver{vcnt}, 1e-7); +%! end +%! vakzo + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_testsuite_implrober.m b/octave_packages/odepkg-0.8.2/odepkg_testsuite_implrober.m new file mode 100644 index 0000000..62d07fe --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_testsuite_implrober.m @@ -0,0 +1,137 @@ +%# Copyright (C) 2007-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{solution}] =} odepkg_testsuite_implrober (@var{@@solver}, @var{reltol}) +%# +%# If this function is called with two input arguments and the first input argument @var{@@solver} is a function handle describing an OdePkg solver and the second input argument @var{reltol} is a double scalar describing the relative error tolerance then return a cell array @var{solution} with performance informations about the implicit form of the modified ROBERTSON testsuite of implicit differential algebraic equations after solving (IDE--test). +%# +%# Run examples with the command +%# @example +%# demo odepkg_testsuite_implrober +%# @end example +%# +%# This function has been ported from the "Test Set for IVP solvers" which is developed by the INdAM Bari unit project group "Codes and Test Problems for Differential Equations", coordinator F. Mazzia. +%# @end deftypefn +%# +%# @seealso{odepkg} + +function vret = odepkg_testsuite_implrober (vhandle, vrtol) + + %# Check number and types of all input arguments + if (nargin ~= 2) + help ('odepkg_testsuite_implrober'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be exactly two'); + elseif (~isa (vhandle, 'function_handle') || ~isscalar (vrtol)) + print_usage; + end + + vret{1} = vhandle; %# The handle for the solver that is used + vret{2} = vrtol; %# The value for the realtive tolerance + vret{3} = vret{2} * 1e-2; %# The value for the absolute tolerance + vret{4} = vret{2}; %# The value for the first time step + %# Write a debug message on the screen, because this testsuite function + %# may be called more than once from a loop over all present solvers + fprintf (1, ['Testsuite implicit ROBERTSON, testing solver %7s with relative', ... + ' tolerance %2.0e\n'], func2str (vret{1}), vrtol); fflush (1); + + %# Setting the integration algorithm options + vstart = 0; %# The point of time when solving is started + vstop = 1e11; %# The point of time when solving is stoped + [vinity, vinityd] = odepkg_testsuite_implroberinit; %# The initial values + + vopt = odeset ('Refine', 0, 'RelTol', vret{2}, 'AbsTol', vret{3}, ... + 'InitialStep', vret{4}, 'Stats', 'on', 'NormControl', 'off', ... + 'Jacobian', @odepkg_testsuite_implroberjac, 'MaxStep', vstop-vstart); + %# 'OutputFcn', @odeplot); + + %# Calculate the algorithm, start timer and do solving + tic; vsol = feval (vhandle, @odepkg_testsuite_implroberfun, ... + [vstart, vstop], vinity, vinityd', vopt); + vret{12} = toc; %# The value for the elapsed time + vref = odepkg_testsuite_implroberref; %# Get the reference solution vector + if (exist ('OCTAVE_VERSION') ~= 0) + vlst = vsol.y(end,:); + else + vlst = vsol.y(:,end); + end + vret{5} = odepkg_testsuite_calcmescd (vlst, vref, vret{3}, vret{2}); + vret{6} = odepkg_testsuite_calcscd (vlst, vref, vret{3}, vret{2}); + vret{7} = vsol.stats.nsteps + vsol.stats.nfailed; %# The value for all evals + vret{8} = vsol.stats.nsteps; %# The value for success evals + vret{9} = vsol.stats.nfevals; %# The value for fun calls + vret{10} = vsol.stats.npds; %# The value for partial derivations + vret{11} = vsol.stats.ndecomps; %# The value for LU decompositions + +%#function odepkg_testsuite_implrober () +%# A = odeset ('RelTol', 1e-4, ... %# proprietary ode15i needs 1e-6 to be stable +%# 'AbsTol', [1e-6, 1e-10, 1e-6], ... +%# 'Jacobian', @odepkg_testsuite_implroberjac); +%# [y0, yd0] = odepkg_testsuite_implroberinit; +%# odebdi (@odepkg_testsuite_implroberfun, [0, 1e11], y0, yd0', A) +%# [y0, yd0] = odepkg_testsuite_implroberinit; +%# odebdi (@odepkg_testsuite_implroberfun, [0, 1e11], y0, yd0') + +%# Return the results for the for the implicit ROBERTSON problem +function res = odepkg_testsuite_implroberfun (t, y, yd, varargin) + res(1,1) = -0.04 * y(1) + 1e4 * y(2) * y(3) - yd(1); + res(2,1) = 0.04 * y(1) - 1e4 * y(2) * y(3) - 3e7 * y(2)^2 - yd(2); + res(3,1) = y(1) + y(2) + y(3) - 1; + +%# Return the INITIAL values for the implicit ROBERTSON problem +function [y0, yd0] = odepkg_testsuite_implroberinit () + y0 = [1, 0, 0]; + yd0 = [-4e-2, 4e-2, 0]; + +%# Return the JACOBIAN matrix for the implicit ROBERTSON problem +function [dfdy, dfdyd] = odepkg_testsuite_implroberjac (t, y, yd, varargin) + dfdy(1,1) = -0.04; + dfdy(1,2) = 1e4 * y(3); + dfdy(1,3) = 1e4 * y(2); + dfdy(2,1) = 0.04; + dfdy(2,2) = -1e4 * y(3) - 6e7 * y(2); + dfdy(2,3) = -1e4 * y(2); + dfdy(3,1) = 1; + dfdy(3,2) = 1; + dfdy(3,3) = 1; + + dfdyd(1,1) = -1; + dfdyd(2,2) = -1; + dfdyd(3,3) = 0; + +%# For the implicit form of the Robertson problem a mass matrix is not +%# allowed. This mass matrix is only needed if the Robertson problem +%# is formulated in explicit form (cf. odepkg_testsuite_implrober.m). +%# function mass = odepkg_testsuite_implrobermass (t, y, varargin) +%# mass = [1, 0, 0; 0, 1, 0; 0, 0, 0]; + +%# Return the REFERENCE values for the implicit ROBERTSON problem +function y = odepkg_testsuite_implroberref () + y(1) = 0.20833401497012e-07; + y(2) = 0.83333607703347e-13; + y(3) = 0.99999997916650e+00; + +%!demo +%! vsolver = {@odebdi}; +%! for vcnt=1:length (vsolver) +%! virob{vcnt,1} = odepkg_testsuite_implrober (vsolver{vcnt}, 1e-7); +%! end +%! virob + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_testsuite_impltrans.m b/octave_packages/odepkg-0.8.2/odepkg_testsuite_impltrans.m new file mode 100644 index 0000000..aad2edf --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_testsuite_impltrans.m @@ -0,0 +1,177 @@ +%# Copyright (C) 2007-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{solution}] =} odepkg_testsuite_impltrans (@var{@@solver}, @var{reltol}) +%# +%# If this function is called with two input arguments and the first input argument @var{@@solver} is a function handle describing an OdePkg solver and the second input argument @var{reltol} is a double scalar describing the relative error tolerance then return the cell array @var{solution} with performance informations about the TRANSISTOR testsuite of implicit differential algebraic equations after solving (IDE--test). +%# +%# Run examples with the command +%# @example +%# demo odepkg_testsuite_impltrans +%# @end example +%# +%# This function has been ported from the "Test Set for IVP solvers" which is developed by the INdAM Bari unit project group "Codes and Test Problems for Differential Equations", coordinator F. Mazzia. +%# @end deftypefn +%# +%# @seealso{odepkg} + +function vret = odepkg_testsuite_impltrans (vhandle, vrtol) + + if (nargin ~= 2) %# Check number and types of all input arguments + help ('odepkg_testsuite_impltrans'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be exactly two'); + elseif (~isa (vhandle, 'function_handle') || ~isscalar (vrtol)) + print_usage; + end + + vret{1} = vhandle; %# The handle for the solver that is used + vret{2} = vrtol; %# The value for the realtive tolerance + vret{3} = vret{2}; %# The value for the absolute tolerance + vret{4} = vret{2}; %# The value for the first time step + %# Write a debug message on the screen, because this testsuite function + %# may be called more than once from a loop over all solvers present + fprintf (1, ['Testsuite TRANSISTOR, testing solver %7s with relative', ... + ' tolerance %2.0e\n'], func2str (vret{1}), vrtol); fflush (1); + + %# Setting the integration algorithms option values + vstart = 0.0; %# The point of time when solving is started + vstop = 0.2; %# The point of time when solving is stoped + [vinity, vinityd] = odepkg_testsuite_impltransinit; %# The initial values + + vopt = odeset ('Refine', 0, 'RelTol', vret{2}, 'AbsTol', vret{3}, ... + 'InitialStep', vret{4}, 'Stats', 'on', 'NormControl', 'off', ... + 'Jacobian', @odepkg_testsuite_impltransjac, 'MaxStep', vstop-vstart); + %# ,'OutputFcn', @odeplot, 'MaxStep', 1e-4); + + %# Calculate the algorithm, start timer and do solving + tic; vsol = feval (vhandle, @odepkg_testsuite_impltransfun, ... + [vstart, vstop], vinity, vinityd', vopt); + vret{12} = toc; %# The value for the elapsed time + vref = odepkg_testsuite_impltransref; %# Get the reference solution vector + if (exist ('OCTAVE_VERSION') ~= 0) + vlst = vsol.y(end,:); + else + vlst = vsol.y(:,end); + end + vret{5} = odepkg_testsuite_calcmescd (vlst, vref, vret{3}, vret{2}); + vret{6} = odepkg_testsuite_calcscd (vlst, vref, vret{3}, vret{2}); + vret{7} = vsol.stats.nsteps + vsol.stats.nfailed; %# The value for all evals + vret{8} = vsol.stats.nsteps; %# The value for success evals + vret{9} = vsol.stats.nfevals; %# The value for fun calls + vret{10} = vsol.stats.npds; %# The value for partial derivations + vret{11} = vsol.stats.ndecomps; %# The value for LU decompositions + +%# Returns the results for the implicit TRANSISTOR problem +function res = odepkg_testsuite_impltransfun (t, y, yd, varargin) + ub = 6; uf = 0.026; alpha = 0.99; beta = 1e-6; + r0 = 1000; r1 = 9000; r2 = 9000; r3 = 9000; + r4 = 9000; r5 = 9000; r6 = 9000; r7 = 9000; + r8 = 9000; r9 = 9000; c1 = 1e-6; c2 = 2e-6; + c3 = 3e-6; c4 = 4e-6; c5 = 5e-6; + + uet = 0.1 * sin(200 * pi * t); + fac1 = beta * (exp((y(2) - y(3)) / uf) - 1); + fac2 = beta * (exp((y(5) - y(6)) / uf) - 1); + + res(1,1) = (y(1) - uet) / r0 + c1 * yd(1) - c1 * yd(2); + res(2,1) = y(2) / r1 + (y(2) - ub) / r2 + (1 - alpha) * fac1 - c1 * yd(1) + c1 * yd(2); + res(3,1) = y(3) / r3 - fac1 + c2 * yd(3); + res(4,1) = (y(4) - ub) / r4 + alpha * fac1 + c3 * yd(4) - c3 * yd(5); + res(5,1) = y(5) / r5 + (y(5) - ub) / r6 + (1 - alpha) * fac2 - c3 * yd(4) + c3 * yd(5); + res(6,1) = y(6) / r7 - fac2 + c4 * yd(6); + res(7,1) = (y(7) - ub) / r8 + alpha * fac2 + c5 * yd(7) - c5 * yd(8); + res(8,1) = y(8) / r9 - c5 * yd(7) + c5 * yd(8); + +%# Returns the INITIAL values for the TRANSISTOR problem +function [y0, yd0] = odepkg_testsuite_impltransinit () + y0 = [0, 3, 3, 6, 3, 3, 6, 0]; + yd0 = 1e-3 * [0, 0, 1/3, 0, 0, 1/3, 0, 0]; + %# yd0 = [ 51.338775, 51.338775, -166.666666, -24.975766, ... + %# -24.975766, -83.333333, -10.0056445, -10.005644]; + +%# Returns the JACOBIAN matrix for the TRANSISTOR problem +function [dfdy, dfdyd] = odepkg_testsuite_impltransjac (t, y, varargin) + ub = 6; uf = 0.026; alpha = 0.99; beta = 1e-6; + r0 = 1000; r1 = 9000; r2 = 9000; r3 = 9000; + r4 = 9000; r5 = 9000; r6 = 9000; r7 = 9000; + r8 = 9000; r9 = 9000; c1 = 1e-6; c2 = 2e-6; + c3 = 3e-6; c4 = 4e-6; c5 = 5e-6; + + fac1p = beta * exp ((y(2) - y(3)) / uf) / uf; + fac2p = beta * exp ((y(5) - y(6)) / uf) / uf; + + dfdy(1,1) = 1 / r0; + dfdy(2,2) = 1 / r1 + 1 / r2 + (1 - alpha) * fac1p; + dfdy(2,3) = - (1 - alpha) * fac1p; + dfdy(3,2) = - fac1p; + dfdy(3,3) = 1 / r3 + fac1p; + dfdy(4,2) = alpha * fac1p; + dfdy(4,3) = - alpha * fac1p; + dfdy(4,4) = 1 / r4; + dfdy(5,5) = 1 / r5 + 1 / r6 + (1 - alpha) * fac2p; + dfdy(5,6) = - (1 - alpha) * fac2p; + dfdy(6,5) = - fac2p; + dfdy(6,6) = 1 / r7 + fac2p; + dfdy(7,5) = alpha * fac2p; + dfdy(7,6) = - alpha * fac2p; + dfdy(7,7) = 1 / r8; + dfdy(8,8) = 1 / r9; + + dfdyd = [ c1, -c1, 0, 0, 0, 0, 0, 0; ... + -c1, c1, 0, 0, 0, 0, 0, 0; ... + 0, 0, c2, 0, 0, 0, 0, 0; ... + 0, 0, 0, c3, -c3, 0, 0, 0; ... + 0, 0, 0, -c3, c3, 0, 0, 0; ... + 0, 0, 0, 0, 0, c4, 0, 0; ... + 0, 0, 0, 0, 0, 0, c5, -c5; ... + 0, 0, 0, 0, 0, 0, -c5, c5]; + +%# For the implicit form of the TRANSISTOR problem a mass matrix is +%# not needed. This mass matrix is needed if the problem is formulated +%# in explicit form (cf. odepkg_testsuite_transistor.m). +%# function mass = odepkg_testsuite_impltransmass (t, y, varargin) +%# mass = [-1e-6, 1e-6, 0, 0, 0, 0, 0, 0; ... +%# 1e-6, -1e-6, 0, 0, 0, 0, 0, 0; ... +%# 0, 0, -2e-6, 0, 0, 0, 0, 0; ... +%# 0, 0, 0, -3e-6, 3e-6, 0, 0, 0; ... +%# 0, 0, 0, 3e-6, -3e-6, 0, 0, 0; ... +%# 0, 0, 0, 0, 0, -4e-6, 0, 0; ... +%# 0, 0, 0, 0, 0, 0, -5e-6, 5e-6; ... +%# 0, 0, 0, 0, 0, 0, 5e-6, -5e-6]; + +%# Returns the REFERENCE values for the TRANSISTOR problem +function y = odepkg_testsuite_impltransref () + y(1,1) = -0.55621450122627e-2; + y(2,1) = 0.30065224719030e+1; + y(3,1) = 0.28499587886081e+1; + y(4,1) = 0.29264225362062e+1; + y(5,1) = 0.27046178650105e+1; + y(6,1) = 0.27618377783931e+1; + y(7,1) = 0.47709276316167e+1; + y(8,1) = 0.12369958680915e+1; + +%!demo +%! vsolver = {@odebdi}; +%! for vcnt=1:length (vsolver) +%! vtrans{vcnt,1} = odepkg_testsuite_impltrans (vsolver{vcnt}, 1e-7); +%! end +%! vtrans + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_testsuite_oregonator.m b/octave_packages/odepkg-0.8.2/odepkg_testsuite_oregonator.m new file mode 100644 index 0000000..aacd20c --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_testsuite_oregonator.m @@ -0,0 +1,117 @@ +%# Copyright (C) 2007-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{solution}] =} odepkg_testsuite_oregonator (@var{@@solver}, @var{reltol}) +%# +%# If this function is called with two input arguments and the first input argument @var{@@solver} is a function handle describing an OdePkg solver and the second input argument @var{reltol} is a double scalar describing the relative error tolerance then return a cell array @var{solution} with performance informations about the OREGONATOR testsuite of ordinary differential equations after solving (ODE--test). +%# +%# Run examples with the command +%# @example +%# demo odepkg_testsuite_oregonator +%# @end example +%# +%# This function has been ported from the "Test Set for IVP solvers" which is developed by the INdAM Bari unit project group "Codes and Test Problems for Differential Equations", coordinator F. Mazzia. +%# @end deftypefn +%# +%# @seealso{odepkg} + +function vret = odepkg_testsuite_oregonator (vhandle, vrtol) + + if (nargin ~= 2) %# Check number and types of all input arguments + help ('odepkg_testsuite_oregonator'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be exactly two'); + elseif (~isa (vhandle, 'function_handle') || ~isscalar (vrtol)) + usage ('odepkg_testsuite_oregonator (@solver, reltol)'); + end + + vret{1} = vhandle; %# The name for the solver that is used + vret{2} = vrtol; %# The value for the realtive tolerance + vret{3} = vret{2}; %# The value for the absolute tolerance + vret{4} = vret{2} * 10^(-2); %# The value for the first time step + %# Write a debug message on the screen, because this testsuite function + %# may be called more than once from a loop over all solvers present + fprintf (1, ['Testsuite OREGONATOR, testing solver %7s with relative', ... + ' tolerance %2.0e\n'], func2str (vret{1}), vrtol); fflush (1); + + %# Setting the integration algorithms option values + vstart = 0.0; %# The point of time when solving is started + vstop = 360.0; %# The point of time when solving is stoped + vinit = odepkg_testsuite_oregonatorinit; %# The initial values + + vopt = odeset ('Refine', 0, 'RelTol', vret{2}, 'AbsTol', vret{3}, ... + 'InitialStep', vret{4}, 'Stats', 'on', 'NormControl', 'off', ... + 'Jacobian', @odepkg_testsuite_oregonatorjac, 'MaxStep', vstop-vstart); + + %# Calculate the algorithm, start timer and do solving + tic; vsol = feval (vhandle, @odepkg_testsuite_oregonatorfun, ... + [vstart, vstop], vinit, vopt); + vret{12} = toc; %# The value for the elapsed time + vref = odepkg_testsuite_oregonatorref; %# Get the reference solution vector + if (exist ('OCTAVE_VERSION') ~= 0) + vlst = vsol.y(end,:); + else + vlst = vsol.y(:,end); + end + vret{5} = odepkg_testsuite_calcmescd (vlst, vref, vret{3}, vret{2}); + vret{6} = odepkg_testsuite_calcscd (vlst, vref, vret{3}, vret{2}); + vret{7} = vsol.stats.nsteps + vsol.stats.nfailed; %# The value for all evals + vret{8} = vsol.stats.nsteps; %# The value for success evals + vret{9} = vsol.stats.nfevals; %# The value for fun calls + vret{10} = vsol.stats.npds; %# The value for partial derivations + vret{11} = vsol.stats.ndecomps; %# The value for LU decompositions + +%# Returns the results for the OREGONATOR problem +function f = odepkg_testsuite_oregonatorfun (t, y, varargin) + f(1,1) = 77.27 * (y(2) + y(1) * (1.0 - 8.375e-6 * y(1) - y(2))); + f(2,1) = (y(3) - (1.0 + y(1)) * y(2)) / 77.27; + f(3,1) = 0.161 * (y(1) - y(3)); + +%# Returns the INITIAL values for the OREGONATOR problem +function vinit = odepkg_testsuite_oregonatorinit () + vinit = [1, 2, 3]; + +%# Returns the JACOBIAN matrix for the OREGONATOR problem +function dfdy = odepkg_testsuite_oregonatorjac (t, y, varargin) + dfdy(1,1) = 77.27 * (1.0 - 2.0 * 8.375e-6 * y(1) - y(2)); + dfdy(1,2) = 77.27 * (1.0 - y(1)); + dfdy(1,3) = 0.0; + dfdy(2,1) = -y(2) / 77.27; + dfdy(2,2) = -(1.0 + y(1)) / 77.27; + dfdy(2,3) = 1.0 / 77.27; + dfdy(3,1) = 0.161; + dfdy(3,2) = 0.0; + dfdy(3,3) = -0.161; + +%# Returns the REFERENCE values for the OREGONATOR problem +function y = odepkg_testsuite_oregonatorref () + y(1,1) = 0.10008148703185e+1; + y(1,2) = 0.12281785215499e+4; + y(1,3) = 0.13205549428467e+3; + +%!demo +%! %% vsolver = {@ode23, @ode45, @ode54, @ode78, ... +%! %% @odebda, @oders, @ode2r, @ode5r, @odesx}; +%! vsolver = {@odebda, @oders, @ode2r, @ode5r, @odesx}; +%! for vcnt=1:length (vsolver) +%! voreg{vcnt,1} = odepkg_testsuite_oregonator (vsolver{vcnt}, 1e-7); +%! end +%! voreg + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_testsuite_pollution.m b/octave_packages/odepkg-0.8.2/odepkg_testsuite_pollution.m new file mode 100644 index 0000000..b95c857 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_testsuite_pollution.m @@ -0,0 +1,261 @@ +%# Copyright (C) 2007-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{solution}] =} odepkg_testsuite_pollution (@var{@@solver}, @var{reltol}) +%# +%# If this function is called with two input arguments and the first input argument @var{@@solver} is a function handle describing an OdePkg solver and the second input argument @var{reltol} is a double scalar describing the relative error tolerance then return the cell array @var{solution} with performance informations about the POLLUTION testsuite of ordinary differential equations after solving (ODE--test). +%# +%# Run examples with the command +%# @example +%# demo odepkg_testsuite_pollution +%# @end example +%# +%# This function has been ported from the "Test Set for IVP solvers" which is developed by the INdAM Bari unit project group "Codes and Test Problems for Differential Equations", coordinator F. Mazzia. +%# @end deftypefn +%# +%# @seealso{odepkg} + +function vret = odepkg_testsuite_pollution (vhandle, vrtol) + + if (nargin ~= 2) %# Check number and types of all input arguments + help ('odepkg_testsuite_pollution'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be exactly two'); + elseif (~isa (vhandle, 'function_handle') || ~isscalar (vrtol)) + print_usage; + end + + vret{1} = vhandle; %# The handle for the solver that is used + vret{2} = vrtol; %# The value for the realtive tolerance + vret{3} = vret{2}; %# The value for the absolute tolerance + vret{4} = vret{2}; %# The value for the first time step + %# Write a debug message on the screen, because this testsuite function + %# may be called more than once from a loop over all solvers present + fprintf (1, ['Testsuite POLLUTION, testing solver %7s with relative', ... + ' tolerance %2.0e\n'], func2str (vret{1}), vrtol); fflush (1); + + %# Setting the integration algorithms option values + vstart = 0.0; %# The point of time when solving is started + vstop = 60.0; %# The point of time when solving is stoped + vinit = odepkg_testsuite_pollutioninit; %# The initial values + + vopt = odeset ('Refine', 0, 'RelTol', vret{2}, 'AbsTol', vret{3}, ... + 'InitialStep', vret{4}, 'Stats', 'on', 'NormControl', 'off', ... + 'Jacobian', @odepkg_testsuite_pollutionjac, 'MaxStep', vstop-vstart); + + %# Calculate the algorithm, start timer and do solving + tic; vsol = feval (vhandle, @odepkg_testsuite_pollutionfun, ... + [vstart, vstop], vinit, vopt); + vret{12} = toc; %# The value for the elapsed time + vref = odepkg_testsuite_pollutionref; %# Get the reference solution vector + if (exist ('OCTAVE_VERSION') ~= 0) + vlst = vsol.y(end,:); + else + vlst = vsol.y(:,end); + end + vret{5} = odepkg_testsuite_calcmescd (vlst, vref, vret{3}, vret{2}); + vret{6} = odepkg_testsuite_calcscd (vlst, vref, vret{3}, vret{2}); + vret{7} = vsol.stats.nsteps + vsol.stats.nfailed; %# The value for all evals + vret{8} = vsol.stats.nsteps; %# The value for success evals + vret{9} = vsol.stats.nfevals; %# The value for fun calls + vret{10} = vsol.stats.npds; %# The value for partial derivations + vret{11} = vsol.stats.ndecomps; %# The value for LU decompositions + +%# Returns the results for the for the POLLUTION problem +function f = odepkg_testsuite_pollutionfun (t, y, varargin) + f(01,1) = - 0.350 * y(1) + 0.266e2 * y(2) * y(4) + 0.123e5 * y(2) * y(5) + ... + 0.165e5 * y(2) * y(11) - 0.900e4 * y(1) * y(11) + 0.220e-1 * y(13) + ... + 0.120e5 * y(2) * y(10) - 0.163e5 * y(1) * y(6) + 0.578e1 * y(19) - ... + 0.474e-1 * y(1) * y(4) - 0.178e4 * y(1) * y(19) + 0.312e1 * y(20); + f(02,1) = + 0.350 * y(1) - 0.266e2 * y(2) * y(4) - 0.123e5 * y(2) * y(5) - ... + 0.165e5 * y(2) * y(11) - 0.120e5 * y(2) * y(10) + 0.210e1 * y(19); + f(03,1) = + 0.350 * y(1) - 0.480e7 * y(3) + 0.175e-1 * y(4) + 0.444e12 * y(16) + 0.578e1 * y(19); + f(04,1) = - 0.266e2 * y(2) * y(4) + 0.480e7 * y(3) - 0.350e-3 * y(4) - ... + 0.175e-1 * y(4) - 0.474e-1 * y(1) * y(4); + f(05,1) = - 0.123e5 * y(2) * y(5) + 2*0.860e-3 * y(7) + 0.150e5 * y(6) * y(7) + ... + 0.130e-3 * y(9) + 0.188e1 * y(14) + 0.124e4 * y(6) * y(17); + f(06,1) = + 0.123e5 * y(2) * y(5) - 0.150e5 * y(6) * y(7) - 0.240e5 * y(6) * y(9) - ... + 0.163e5 * y(1) * y(6) + 2*0.100e9 * y(16) - 0.124e4 * y(6) * y(17); + f(07,1) = - 0.860e-3 * y(7) - 0.820e-3 * y(7) - 0.150e5 * y(6) * y(7) + 0.188e1 * y(14); + f(08,1) = + 0.860e-3 * y(7) + 0.820e-3 * y(7) + 0.150e5 * y(6) * y(7) + 0.130e-3 * y(9); + f(09,1) = - 0.130e-3 * y(9) - 0.240e5 * y(6) * y(9); + f(10,1) = + 0.130e-3 * y(9) + 0.165e5 * y(2) * y(11) - 0.120e5 * y(2) * y(10); + f(11,1) = + 0.240e5 * y(6) * y(9) - 0.165e5 * y(2) * y(11) - 0.900e4 * y(1) * y(11) + ... + 0.220e-1 * y(13); + f(12,1) = + 0.165e5 * y(2) * y(11); + f(13,1) = + 0.900e4 * y(1) * y(11) - 0.220e-1 * y(13); + f(14,1) = + 0.120e5 * y(2) * y(10) - 0.188e1 * y(14); + f(15,1) = + 0.163e5 * y(1) * y(6); + f(16,1) = + 0.350e-3 * y(4) - 0.100e9 * y(16) - 0.444e12 * y(16); + f(17,1) = - 0.124e4 * y(6) * y(17); + f(18,1) = + 0.124e4 * y(6) * y(17); + f(19,1) = - 0.210e1 * y(19) - 0.578e1 * y(19) + 0.474e-1 * y(1) * y(4) - ... + 0.178e4 * y(1) * y(19) + 0.312e1 * y(20); + f(20,1) = + 0.178e4 * y(1) * y(19) - 0.312e1 * y(20); + +%# Returns the INITIAL values for the POLLUTION problem +function vinit = odepkg_testsuite_pollutioninit () + vinit = [0, 0.2, 0, 0.04, 0, 0, 0.1, 0.3, 0.01, ... + 0, 0, 0, 0, 0, 0, 0, 0.007, 0, 0, 0]; + +%# Returns the JACOBIAN matrix for the POLLUTION problem +function dfdy = odepkg_testsuite_pollutionjac (t, y) + k1 = 0.35e0; k2 = 0.266e2; k3 = 0.123e5; k4 = 0.86e-3; + k5 = 0.82e-3; k6 = 0.15e5; k7 = 0.13e-3; k8 = 0.24e5; + k9 = 0.165e5; k10 = 0.9e4; k11 = 0.22e-1; k12 = 0.12e5; + k13 = 0.188e1; k14 = 0.163e5; k15 = 0.48e7; k16 = 0.35e-3; + k17 = 0.175e-1; k18 = 0.1e9; k19 = 0.444e12; k20 = 0.124e4; + k21 = 0.21e1; k22 = 0.578e1; k23 = 0.474e-1; k24 = 0.178e4; + k25 = 0.312e1; + + dfdy(1,1) = -k1 - k10 * y(11) - k14 * y(6) - k23 * y(4) - k24 * y(19); + dfdy(1,11) = -k10 * y(1) + k9 * y(2); + dfdy(1,6) = -k14 * y(1); + dfdy(1,4) = -k23 * y(1) + k2 * y(2); + dfdy(1,19) = -k24 * y(1) + k22; + dfdy(1,2) = k2 * y(4) + k9 * y(11) + k3 * y(5) + k12 * y(10); + dfdy(1,13) = k11; + dfdy(1,20) = k25; + dfdy(1,5) = k3 * y(2); + dfdy(1,10) = k12 * y(2); + + dfdy(2,4) = -k2 * y(2); + dfdy(2,5) = -k3 * y(2); + dfdy(2,11) = -k9 * y(2); + dfdy(2,10) = -k12 * y(2); + dfdy(2,19) = k21; + dfdy(2,1) = k1; + dfdy(2,2) = -k2 * y(4) - k3 * y(5) - k9 * y(11) - k12 * y(10); + + dfdy(3,1) = k1; + dfdy(3,4) = k17; + dfdy(3,16) = k19; + dfdy(3,19) = k22; + dfdy(3,3) = -k15; + + dfdy(4,4) = -k2 * y(2) - k16 - k17 - k23 * y(1); + dfdy(4,2) = -k2 * y(4); + dfdy(4,1) = -k23 * y(4); + dfdy(4,3) = k15; + + dfdy(5,5) = -k3 * y(2); + dfdy(5,2) = -k3 * y(5); + dfdy(5,7) = 2d0 * k4 + k6 * y(6); + dfdy(5,6) = k6 * y(7) + k20 * y(17); + dfdy(5,9) = k7; + dfdy(5,14) = k13; + dfdy(5,17) = k20 * y(6); + + dfdy(6,6) = -k6 * y(7) - k8 * y(9) - k14 * y(1) - k20 * y(17); + dfdy(6,7) = -k6 * y(6); + dfdy(6,9) = -k8 * y(6); + dfdy(6,1) = -k14 * y(6); + dfdy(6,17) = -k20 * y(6); + dfdy(6,2) = k3 * y(5); + dfdy(6,5) = k3 * y(2); + dfdy(6,16) = 2d0 * k18; + + dfdy(7,7) = -k4 - k5 - k6 * y(6); + dfdy(7,6) = -k6 * y(7); + dfdy(7,14) = k13; + + dfdy(8,7) = k4 + k5 + k6 * y(6); + dfdy(8,6) = k6 * y(7); + dfdy(8,9) = k7; + + dfdy(9,9) = -k7 - k8 * y(6); + dfdy(9,6) = -k8 * y(9); + + dfdy(10,10) = -k12 * y(2); + dfdy(10,2) = -k12 * y(10) + k9 * y(11); + dfdy(10,9) = k7; + dfdy(10,11) = k9 * y(2); + + dfdy(11,11) = -k9 * y(2) - k10 * y(1); + dfdy(11,2) = -k9 * y(11); + dfdy(11,1) = -k10 * y(11); + dfdy(11,9) = k8 * y(6); + dfdy(11,6) = k8 * y(9); + dfdy(11,13) = k11; + + dfdy(12,11) = k9 * y(2); + dfdy(12,2) = k9 * y(11); + + dfdy(13,13) = -k11; + dfdy(13,11) = k10 * y(1); + dfdy(13,1) = k10 * y(11); + + dfdy(14,14) = -k13; + dfdy(14,10) = k12 * y(2); + dfdy(14,2) = k12 * y(10); + + dfdy(15,1) = k14 * y(6); + dfdy(15,6) = k14 * y(1); + + dfdy(16,16) = -k18 - k19; + dfdy(16,4) = k16; + + dfdy(17,17) = -k20 * y(6); + dfdy(17,6) = -k20 * y(17); + + dfdy(18,17) = k20 * y(6); + dfdy(18,6) = k20 * y(17); + + dfdy(19,19) = -k21 - k22 - k24 * y(1); + dfdy(19,1) = -k24 * y(19) + k23 * y(4); + dfdy(19,4) = k23 * y(1); + dfdy(19,20) = k25; + + dfdy(20,20) = -k25; + dfdy(20,1) = k24 * y(19); + dfdy(20,19) = k24 * y(1); + +%# Returns the REFERENCE values for the POLLUTION problem +function y = odepkg_testsuite_pollutionref () + y(01,1) = 0.56462554800227 * 10^(-1); + y(02,1) = 0.13424841304223 * 10^(+0); + y(03,1) = 0.41397343310994 * 10^(-8); + y(04,1) = 0.55231402074843 * 10^(-2); + y(05,1) = 0.20189772623021 * 10^(-6); + y(06,1) = 0.20189772623021 * 10^(-6); + y(07,1) = 0.77842491189979 * 10^(-1); + y(08,1) = 0.77842491189979 * 10^(+0); + y(09,1) = 0.74940133838804 * 10^(-2); + y(10,1) = 0.16222931573015 * 10^(-7); + y(11,1) = 0.11358638332570 * 10^(-7); + y(12,1) = 0.22305059757213 * 10^(-2); + y(13,1) = 0.20871628827986 * 10^(-3); + y(14,1) = 0.13969210168401 * 10^(-4); + y(15,1) = 0.89648848568982 * 10^(-2); + y(16,1) = 0.43528463693301 * 10^(-17); + y(17,1) = 0.68992196962634 * 10^(-2); + y(18,1) = 0.10078030373659 * 10^(-3); + y(19,1) = 0.17721465139699 * 10^(-5); + y(20,1) = 0.56829432923163 * 10^(-4); + +%!demo +%! %% vsolver = {@ode23, @ode45, @ode54, @ode78, ... +%! %% @odebda, @oders, @ode2r, @ode5r, @odesx}; +%! vsolver = {@odebda, @oders, @ode2r, @ode5r, @odesx}; +%! for vcnt=1:length (vsolver) +%! poll{vcnt,1} = odepkg_testsuite_pollution (vsolver{vcnt}, 1e-7); +%! end +%! poll + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_testsuite_robertson.m b/octave_packages/odepkg-0.8.2/odepkg_testsuite_robertson.m new file mode 100644 index 0000000..edd98ab --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_testsuite_robertson.m @@ -0,0 +1,121 @@ +%# Copyright (C) 2007-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{solution}] =} odepkg_testsuite_robertson (@var{@@solver}, @var{reltol}) +%# +%# If this function is called with two input arguments and the first input argument @var{@@solver} is a function handle describing an OdePkg solver and the second input argument @var{reltol} is a double scalar describing the relative error tolerance then return a cell array @var{solution} with performance informations about the modified ROBERTSON testsuite of differential algebraic equations after solving (DAE--test). +%# +%# Run examples with the command +%# @example +%# demo odepkg_testsuite_robertson +%# @end example +%# +%# This function has been ported from the "Test Set for IVP solvers" which is developed by the INdAM Bari unit project group "Codes and Test Problems for Differential Equations", coordinator F. Mazzia. +%# @end deftypefn +%# +%# @seealso{odepkg} + +function vret = odepkg_testsuite_robertson (vhandle, vrtol) + + if (nargin ~= 2) %# Check number and types of all input arguments + help ('odepkg_testsuite_robertson'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be exactly two'); + elseif (~isa (vhandle, 'function_handle') || ~isscalar (vrtol)) + print_usage; + end + + vret{1} = vhandle; %# The handle for the solver that is used + vret{2} = vrtol; %# The value for the realtive tolerance + vret{3} = vret{2} * 1e-2; %# The value for the absolute tolerance + vret{4} = vret{2}; %# The value for the first time step + %# Write a debug message on the screen, because this testsuite function + %# may be called more than once from a loop over all solvers present + fprintf (1, ['Testsuite ROBERTSON, testing solver %7s with relative', ... + ' tolerance %2.0e\n'], func2str (vret{1}), vrtol); fflush (1); + + %# Setting the integration algorithms option values + vstart = 0.0; %# The point of time when solving is started + vstop = 1e11; %# The point of time when solving is stoped + vinit = odepkg_testsuite_robertsoninit; %# The initial values + vmass = odepkg_testsuite_robertsonmass; %# The mass matrix + + vopt = odeset ('Refine', 0, 'RelTol', vret{2}, 'AbsTol', vret{3}, ... + 'InitialStep', vret{4}, 'Stats', 'on', 'NormControl', 'off', ... + 'Jacobian', @odepkg_testsuite_robertsonjac, 'Mass', vmass, ... + 'MaxStep', vstop-vstart); + + %# Calculate the algorithm, start timer and do solving + tic; vsol = feval (vhandle, @odepkg_testsuite_robertsonfun, ... + [vstart, vstop], vinit, vopt); + vret{12} = toc; %# The value for the elapsed time + vref = odepkg_testsuite_robertsonref; %# Get the reference solution vector + if (exist ('OCTAVE_VERSION') ~= 0) + vlst = vsol.y(end,:); + else + vlst = vsol.y(:,end); + end + vret{5} = odepkg_testsuite_calcmescd (vlst, vref, vret{3}, vret{2}); + vret{6} = odepkg_testsuite_calcscd (vlst, vref, vret{3}, vret{2}); + vret{7} = vsol.stats.nsteps + vsol.stats.nfailed; %# The value for all evals + vret{8} = vsol.stats.nsteps; %# The value for success evals + vret{9} = vsol.stats.nfevals; %# The value for fun calls + vret{10} = vsol.stats.npds; %# The value for partial derivations + vret{11} = vsol.stats.ndecomps; %# The value for LU decompositions + +%# Returns the results for the for the modified ROBERTSON problem +function f = odepkg_testsuite_robertsonfun (t, y, varargin) + f(1,1) = -0.04 * y(1) + 1e4 * y(2) * y(3); + f(2,1) = 0.04 * y(1) - 1e4 * y(2) * y(3) - 3e7 * y(2)^2; + f(3,1) = y(1) + y(2) + y(3) - 1; + +%# Returns the INITIAL values for the modified ROBERTSON problem +function vinit = odepkg_testsuite_robertsoninit () + vinit = [1, 0, 0]; + +%# Returns the JACOBIAN matrix for the modified ROBERTSON problem +function dfdy = odepkg_testsuite_robertsonjac (t, y, varargin) + dfdy(1,1) = -0.04; + dfdy(1,2) = 1e4 * y(3); + dfdy(1,3) = 1e4 * y(2); + dfdy(2,1) = 0.04; + dfdy(2,2) = -1e4 * y(3) - 6e7 * y(2); + dfdy(2,3) = -1e4 * y(2); + dfdy(3,1) = 1; + dfdy(3,2) = 1; + dfdy(3,3) = 1; + +%# Returns the MASS matrix for the modified ROBERTSON problem +function mass = odepkg_testsuite_robertsonmass (t, y, varargin) + mass = [1, 0, 0; 0, 1, 0; 0, 0, 0]; + +%# Returns the REFERENCE values for the modified ROBERTSON problem +function y = odepkg_testsuite_robertsonref () + y(1) = 0.20833401497012e-07; + y(2) = 0.83333607703347e-13; + y(3) = 0.99999997916650e+00; + +%!demo +%! vsolver = {@odebda, @oders, @ode2r, @ode5r, @odesx}; +%! for vcnt=1:length (vsolver) +%! vrober{vcnt,1} = odepkg_testsuite_robertson (vsolver{vcnt}, 1e-7); +%! end +%! vrober + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odepkg_testsuite_transistor.m b/octave_packages/odepkg-0.8.2/odepkg_testsuite_transistor.m new file mode 100644 index 0000000..870cf94 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odepkg_testsuite_transistor.m @@ -0,0 +1,162 @@ +%# Copyright (C) 2007-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{solution}] =} odepkg_testsuite_transistor (@var{@@solver}, @var{reltol}) +%# +%# If this function is called with two input arguments and the first input argument @var{@@solver} is a function handle describing an OdePkg solver and the second input argument @var{reltol} is a double scalar describing the relative error tolerance then return the cell array @var{solution} with performance informations about the TRANSISTOR testsuite of differential algebraic equations after solving (DAE--test). +%# +%# Run examples with the command +%# @example +%# demo odepkg_testsuite_transistor +%# @end example +%# +%# This function has been ported from the "Test Set for IVP solvers" which is developed by the INdAM Bari unit project group "Codes and Test Problems for Differential Equations", coordinator F. Mazzia. +%# @end deftypefn +%# +%# @seealso{odepkg} + +function vret = odepkg_testsuite_transistor (vhandle, vrtol) + + if (nargin ~= 2) %# Check number and types of all input arguments + help ('odepkg_testsuite_transistor'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be exactly two'); + elseif (~isa (vhandle, 'function_handle') || ~isscalar (vrtol)) + print_usage; + end + + vret{1} = vhandle; %# The handle for the solver that is used + vret{2} = vrtol; %# The value for the realtive tolerance + vret{3} = vret{2}; %# The value for the absolute tolerance + vret{4} = vret{2}; %# The value for the first time step + %# Write a debug message on the screen, because this testsuite function + %# may be called more than once from a loop over all solvers present + fprintf (1, ['Testsuite TRANSISTOR, testing solver %7s with relative', ... + ' tolerance %2.0e\n'], func2str (vret{1}), vrtol); fflush (1); + + %# Setting the integration algorithms option values + vstart = 0.0; %# The point of time when solving is started + vstop = 0.2; %# The point of time when solving is stoped + vinit = odepkg_testsuite_transistorinit; %# The initial values + vmass = odepkg_testsuite_transistormass; %# The mass matrix + + vopt = odeset ('Refine', 0, 'RelTol', vret{2}, 'AbsTol', vret{3}, ... + 'InitialStep', vret{4}, 'Stats', 'on', 'NormControl', 'off', ... + 'Jacobian', @odepkg_testsuite_transistorjac, 'Mass', vmass, ... + 'MaxStep', vstop-vstart); + + %# Calculate the algorithm, start timer and do solving + tic; vsol = feval (vhandle, @odepkg_testsuite_transistorfun, ... + [vstart, vstop], vinit, vopt); + vret{12} = toc; %# The value for the elapsed time + vref = odepkg_testsuite_transistorref; %# Get the reference solution vector + if (exist ('OCTAVE_VERSION') ~= 0) + vlst = vsol.y(end,:); + else + vlst = vsol.y(:,end); + end + vret{5} = odepkg_testsuite_calcmescd (vlst, vref, vret{3}, vret{2}); + vret{6} = odepkg_testsuite_calcscd (vlst, vref, vret{3}, vret{2}); + vret{7} = vsol.stats.nsteps + vsol.stats.nfailed; %# The value for all evals + vret{8} = vsol.stats.nsteps; %# The value for success evals + vret{9} = vsol.stats.nfevals; %# The value for fun calls + vret{10} = vsol.stats.npds; %# The value for partial derivations + vret{11} = vsol.stats.ndecomps; %# The value for LU decompositions + +%# Returns the results for the TRANSISTOR problem +function f = odepkg_testsuite_transistorfun (t, y, varargin) + ub = 6; uf = 0.026; alpha = 0.99; beta = 1d-6; + r0 = 1000; r1 = 9000; r2 = 9000; r3 = 9000; + r4 = 9000; r5 = 9000; r6 = 9000; r7 = 9000; + r8 = 9000; r9 = 9000; + + uet = 0.1 * sin(200 * pi * t); + fac1 = beta * (exp((y(2) - y(3)) / uf) - 1); + fac2 = beta * (exp((y(5) - y(6)) / uf) - 1); + + f(1,1) = (y(1) - uet) / r0; + f(2,1) = y(2) / r1 + (y(2) - ub) / r2 + (1 - alpha) * fac1; + f(3,1) = y(3) / r3 - fac1; + f(4,1) = (y(4) - ub) / r4 + alpha * fac1; + f(5,1) = y(5) / r5 + (y(5) - ub) / r6 + (1 - alpha) * fac2; + f(6,1) = y(6) / r7 - fac2; + f(7,1) = (y(7) - ub) / r8 + alpha * fac2; + f(8,1) = y(8) / r9; + +%# Returns the INITIAL values for the TRANSISTOR problem +function vinit = odepkg_testsuite_transistorinit () + vinit = [0, 3, 3, 6, 3, 3, 6, 0]; + +%# Returns the JACOBIAN matrix for the TRANSISTOR problem +function dfdy = odepkg_testsuite_transistorjac (t, y, varargin) + ub = 6; uf = 0.026; alpha = 0.99; beta = 1d-6; + r0 = 1000; r1 = 9000; r2 = 9000; r3 = 9000; + r4 = 9000; r5 = 9000; r6 = 9000; r7 = 9000; + r8 = 9000; r9 = 9000; + + fac1p = beta * exp ((y(2) - y(3)) / uf) / uf; + fac2p = beta * exp ((y(5) - y(6)) / uf) / uf; + + dfdy(1,1) = 1 / r0; + dfdy(2,2) = 1 / r1 + 1 / r2 + (1 - alpha) * fac1p; + dfdy(2,3) = - (1 - alpha) * fac1p; + dfdy(3,2) = - fac1p; + dfdy(3,3) = 1 / r3 + fac1p; + dfdy(4,2) = alpha * fac1p; + dfdy(4,3) = - alpha * fac1p; + dfdy(4,4) = 1 / r4; + dfdy(5,5) = 1 / r5 + 1 / r6 + (1 - alpha) * fac2p; + dfdy(5,6) = - (1 - alpha) * fac2p; + dfdy(6,5) = - fac2p; + dfdy(6,6) = 1 / r7 + fac2p; + dfdy(7,5) = alpha * fac2p; + dfdy(7,6) = - alpha * fac2p; + dfdy(7,7) = 1 / r8; + dfdy(8,8) = 1 / r9; + +%# Returns the MASS matrix for the TRANSISTOR problem +function mass = odepkg_testsuite_transistormass (t, y, varargin) + mass = [-1e-6, 1e-6, 0, 0, 0, 0, 0, 0; ... + 1e-6, -1e-6, 0, 0, 0, 0, 0, 0; ... + 0, 0, -2e-6, 0, 0, 0, 0, 0; ... + 0, 0, 0, -3e-6, 3e-6, 0, 0, 0; ... + 0, 0, 0, 3e-6, -3e-6, 0, 0, 0; ... + 0, 0, 0, 0, 0, -4e-6, 0, 0; ... + 0, 0, 0, 0, 0, 0, -5e-6, 5e-6; ... + 0, 0, 0, 0, 0, 0, 5e-6, -5e-6]; + +%# Returns the REFERENCE values for the TRANSISTOR problem +function y = odepkg_testsuite_transistorref () + y(1,1) = -0.55621450122627e-2; + y(2,1) = 0.30065224719030e+1; + y(3,1) = 0.28499587886081e+1; + y(4,1) = 0.29264225362062e+1; + y(5,1) = 0.27046178650105e+1; + y(6,1) = 0.27618377783931e+1; + y(7,1) = 0.47709276316167e+1; + y(8,1) = 0.12369958680915e+1; + +%!demo +%! vsolver = {@odebda, @oders, @ode2r, @ode5r, @odesx}; +%! for vcnt=1:length (vsolver) +%! vtrans{vcnt,1} = odepkg_testsuite_transistor (vsolver{vcnt}, 1e-7); +%! end +%! vtrans + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odeplot.m b/octave_packages/odepkg-0.8.2/odeplot.m new file mode 100644 index 0000000..92222ee --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odeplot.m @@ -0,0 +1,73 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{ret}] =} odeplot (@var{t}, @var{y}, @var{flag}) +%# +%# Open a new figure window and plot the results from the variable @var{y} of type column vector over time while solving. The types and the values of the input parameter @var{t} and the output parameter @var{ret} depend on the input value @var{flag} that is of type string. If @var{flag} is +%# @table @option +%# @item @code{"init"} +%# then @var{t} must be a double column vector of length 2 with the first and the last time step and nothing is returned from this function, +%# @item @code{""} +%# then @var{t} must be a double scalar specifying the actual time step and the return value is false (resp. value 0) for 'not stop solving', +%# @item @code{"done"} +%# then @var{t} must be a double scalar specifying the last time step and nothing is returned from this function. +%# @end table +%# +%# This function is called by a OdePkg solver function if it was specified in an OdePkg options structure with the @command{odeset}. This function is an OdePkg internal helper function therefore it should never be necessary that this function is called directly by a user. There is only little error detection implemented in this function file to achieve the highest performance. +%# +%# For example, solve an anonymous implementation of the "Van der Pol" equation and display the results while solving +%# @example +%# fvdb = @@(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%# +%# vopt = odeset ('OutputFcn', @@odeplot, 'RelTol', 1e-6); +%# vsol = ode45 (fvdb, [0 20], [2 0], vopt); +%# @end example +%# @end deftypefn +%# +%# @seealso{odepkg} + +function [varargout] = odeplot (vt, vy, vflag, varargin) + + %# No input argument check is done for a higher processing speed + persistent vfigure; persistent vtold; + persistent vyold; persistent vcounter; + + if (strcmp (vflag, 'init')) + %# Nothing to return, vt is either the time slot [tstart tstop] + %# or [t0, t1, ..., tn], vy is the inital value vector 'vinit' + vfigure = figure; vtold = vt(1,1); vyold = vy(:,1); + vcounter = 1; + + elseif (isempty (vflag)) + %# Return something in varargout{1}, either false for 'not stopping + %# the integration' or true for 'stopping the integration' + vcounter = vcounter + 1; figure (vfigure); + vtold(vcounter,1) = vt(1,1); + vyold(:,vcounter) = vy(:,1); + plot (vtold, vyold, '-o', 'markersize', 1); drawnow; + varargout{1} = false; + + elseif (strcmp (vflag, 'done')) + %# Cleanup has to be done, clear the persistent variables because + %# we don't need them anymore + clear ('vfigure', 'vtold', 'vyold', 'vcounter'); + + end + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odeprint.m b/octave_packages/odepkg-0.8.2/odeprint.m new file mode 100644 index 0000000..7cd444b --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odeprint.m @@ -0,0 +1,65 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{ret}] =} odeprint (@var{t}, @var{y}, @var{flag}) +%# +%# Display the results of the set of differential equations in the Octave window while solving. The first column of the screen output shows the actual time stamp that is given with the input arguemtn @var{t}, the following columns show the results from the function evaluation that are given by the column vector @var{y}. The types and the values of the input parameter @var{t} and the output parameter @var{ret} depend on the input value @var{flag} that is of type string. If @var{flag} is +%# @table @option +%# @item @code{"init"} +%# then @var{t} must be a double column vector of length 2 with the first and the last time step and nothing is returned from this function, +%# @item @code{""} +%# then @var{t} must be a double scalar specifying the actual time step and the return value is false (resp. value 0) for 'not stop solving', +%# @item @code{"done"} +%# then @var{t} must be a double scalar specifying the last time step and nothing is returned from this function. +%# @end table +%# +%# This function is called by a OdePkg solver function if it was specified in an OdePkg options structure with the @command{odeset}. This function is an OdePkg internal helper function therefore it should never be necessary that this function is called directly by a user. There is only little error detection implemented in this function file to achieve the highest performance. +%# +%# For example, solve an anonymous implementation of the "Van der Pol" equation and print the results while solving +%# @example +%# fvdb = @@(vt,vy) [vy(2); (1 - vy(1)^2) * vy(2) - vy(1)]; +%# +%# vopt = odeset ('OutputFcn', @@odeprint, 'RelTol', 1e-6); +%# vsol = ode45 (fvdb, [0 20], [2 0], vopt); +%# @end example +%# @end deftypefn +%# +%# @seealso{odepkg} + +function [varargout] = odeprint (vt, vy, vflag, varargin) + + %# No input argument check is done for a higher processing speed + %# vt and vy are always column vectors, see also function odeplot, + %# odephas2 and odephas3 for another implementation. vflag either + %# is "init", [] or "done". + + if (strcmp (vflag, 'init')) + fprintf (1, '%f%s\n', vt (1,1), sprintf (' %f', vy) ); + fflush (1); + + elseif (isempty (vflag)) %# Return value varargout{1} needed + fprintf (1, '%f%s\n', vt (1,1), sprintf (' %f', vy) ); + fflush (1); varargout{1} = false; + + elseif (strcmp (vflag, 'done')) + %# Cleanup could be done, but nothing to do in this function + + end + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/odeset.m b/octave_packages/odepkg-0.8.2/odeset.m new file mode 100644 index 0000000..3755805 --- /dev/null +++ b/octave_packages/odepkg-0.8.2/odeset.m @@ -0,0 +1,186 @@ +%# Copyright (C) 2006-2012, Thomas Treichl +%# OdePkg - A package for solving ordinary differential equations and more +%# +%# 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{odestruct}] =} odeset () +%# @deftypefnx {Command} {[@var{odestruct}] =} odeset (@var{"field1"}, @var{value1}, @var{"field2"}, @var{value2}, @dots{}) +%# @deftypefnx {Command} {[@var{odestruct}] =} odeset (@var{oldstruct}, @var{"field1"}, @var{value1}, @var{"field2"}, @var{value2}, @dots{}) +%# @deftypefnx {Command} {[@var{odestruct}] =} odeset (@var{oldstruct}, @var{newstruct}) +%# +%# If this function is called without an input argument then return a new OdePkg options structure array that contains all the necessary fields and sets the values of all fields to default values. +%# +%# If this function is called with string input arguments @var{"field1"}, @var{"field2"}, @dots{} identifying valid OdePkg options then return a new OdePkg options structure with all necessary fields and set the values of the fields @var{"field1"}, @var{"field2"}, @dots{} to the values @var{value1}, @var{value2}, @dots{} +%# +%# If this function is called with a first input argument @var{oldstruct} of type structure array then overwrite all values of the options @var{"field1"}, @var{"field2"}, @dots{} of the structure @var{oldstruct} with new values @var{value1}, @var{value2}, @dots{} and return the modified structure array. +%# +%# If this function is called with two input argumnets @var{oldstruct} and @var{newstruct} of type structure array then overwrite all values in the fields from the structure @var{oldstruct} with new values of the fields from the structure @var{newstruct}. Empty values of @var{newstruct} will not overwrite values in @var{oldstruct}. +%# +%# For a detailed explanation about valid fields and field values in an OdePkg structure aaray have a look at the @file{odepkg.pdf}, Section 'ODE/DAE/IDE/DDE options' or run the command @command{doc odepkg} to open the tutorial. +%# +%# Run examples with the command +%# @example +%# demo odeset +%# @end example +%# @end deftypefn +%# +%# @seealso{odepkg} + +function [vret] = odeset (varargin) + + %# Create a template OdePkg structure + vtemplate = struct ... + ('RelTol', [], ... + 'AbsTol', [], ... + 'NormControl', 'off', ... + 'NonNegative', [], ... + 'OutputFcn', [], ... + 'OutputSel', [], ... + 'OutputSave',[],... + 'Refine', 0, ... + 'Stats', 'off', ... + 'InitialStep', [], ... + 'MaxStep', [], ... + 'Events', [], ... + 'Jacobian', [], ... + 'JPattern', [], ... + 'Vectorized', 'off', ... + 'Mass', [], ... + 'MStateDependence', 'weak', ... + 'MvPattern', [], ... + 'MassSingular', 'maybe', ... + 'InitialSlope', [], ... + 'MaxOrder', [], ... + 'BDF', [], ... + 'NewtonTol', [], ... + 'MaxNewtonIterations', []); + + %# Check number and types of all input arguments + if (nargin == 0 && nargout == 1) + vret = odepkg_structure_check (vtemplate); + return; + + elseif (nargin == 0) + help ('odeset'); + error ('OdePkg:InvalidArgument', ... + 'Number of input arguments must be greater than zero'); + + elseif (length (varargin) < 2) + usage ('odeset ("field1", "value1", ...)'); + + elseif (ischar (varargin{1}) && mod (length (varargin), 2) == 0) + %# Check if there is an odd number of input arguments. If this is + %# true then save all the structure names in varg and its values in + %# vval and increment vnmb for every option that is found. + vnmb = 1; + for vcntarg = 1:2:length (varargin) + if (ischar (varargin{vcntarg})) + varg{vnmb} = varargin{vcntarg}; + vval{vnmb} = varargin{vcntarg+1}; + vnmb = vnmb + 1; + else + error ('OdePkg:InvalidArgument', ... + 'Input argument number %d is no valid string', vcntarg); + end + end + + %# Create and return a new OdePkg structure and fill up all new + %# field values that have been found. + for vcntarg = 1:(vnmb-1) + vtemplate.(varg{vcntarg}) = vval{vcntarg}; + end + vret = odepkg_structure_check (vtemplate); + + elseif (isstruct (varargin{1}) && ischar (varargin{2}) && ... + mod (length (varargin), 2) == 1) + %# Check if there is an even number of input arguments. If this is + %# true then the first input argument also must be a valid OdePkg + %# structure. Save all the structure names in varg and its values in + %# vval and increment the vnmb counter for every option that is + %# found. + vnmb = 1; + for vcntarg = 2:2:length (varargin) + if (ischar (varargin{vcntarg})) + varg{vnmb} = varargin{vcntarg}; + vval{vnmb} = varargin{vcntarg+1}; + vnmb = vnmb + 1; + else + error ('OdePkg:InvalidArgument', ... + 'Input argument number %d is no valid string', vcntarg); + end + end + + %# Use the old OdePkg structure and fill up all new field values + %# that have been found. + vret = odepkg_structure_check (varargin{1}); + for vcntarg = 1:(vnmb-1) + vret.(varg{vcntarg}) = vval{vcntarg}; + end + vret = odepkg_structure_check (vret); + + elseif (isstruct (varargin{1}) && isstruct (varargin{2}) && ... + length (varargin) == 2) + %# Check if the two input arguments are valid OdePkg structures and + %# also check if there does not exist any other input argument. + vret = odepkg_structure_check (varargin{1}); + vnew = odepkg_structure_check (varargin{2}); + vfld = fieldnames (vnew); + vlen = length (vfld); + for vcntfld = 1:vlen + if (~isempty (vnew.(vfld{vcntfld}))) + vret.(vfld{vcntfld}) = vnew.(vfld{vcntfld}); + end + end + vret = odepkg_structure_check (vret); + + else + error ('OdePkg:InvalidArgument', ... + 'Check types and number of all input arguments'); + end +end + +%# All tests that are needed to check if a correct resp. valid option +%# has been set are implemented in odepkg_structure_check.m. +%!test odeoptA = odeset (); +%!test odeoptB = odeset ('AbsTol', 1e-2, 'RelTol', 1e-1); +%! if (odeoptB.AbsTol ~= 1e-2), error; end +%! if (odeoptB.RelTol ~= 1e-1), error; end +%!test odeoptB = odeset ('AbsTol', 1e-2, 'RelTol', 1e-1); +%! odeoptC = odeset (odeoptB, 'NormControl', 'on'); +%!test odeoptB = odeset ('AbsTol', 1e-2, 'RelTol', 1e-1); +%! odeoptC = odeset (odeoptB, 'NormControl', 'on'); +%! odeoptD = odeset (odeoptC, odeoptB); + +%!demo +%! # A new OdePkg options structure with default values is created. +%! +%! odeoptA = odeset (); +%! +%!demo +%! # A new OdePkg options structure with manually set options +%! # "AbsTol" and "RelTol" is created. +%! +%! odeoptB = odeset ('AbsTol', 1e-2, 'RelTol', 1e-1); +%! +%!demo +%! # A new OdePkg options structure from odeoptB is created with +%! # a modified value for option "NormControl". +%! +%! odeoptB = odeset ('AbsTol', 1e-2, 'RelTol', 1e-1); +%! odeoptC = odeset (odeoptB, 'NormControl', 'on'); + +%# Local Variables: *** +%# mode: octave *** +%# End: *** diff --git a/octave_packages/odepkg-0.8.2/packinfo/.autoload b/octave_packages/odepkg-0.8.2/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/odepkg-0.8.2/packinfo/DESCRIPTION b/octave_packages/odepkg-0.8.2/packinfo/DESCRIPTION new file mode 100644 index 0000000..f5d1cab --- /dev/null +++ b/octave_packages/odepkg-0.8.2/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: OdePkg +Version: 0.8.2 +Date: 2012-04-15 +Author: Thomas Treichl +Maintainer: Thomas Treichl +Title: OdePkg +Description: A package for solving ordinary differential equations and more. +Categories: Differential Equations +Depends: octave (>= 3.2.0) +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net diff --git a/octave_packages/odepkg-0.8.2/packinfo/INDEX b/octave_packages/odepkg-0.8.2/packinfo/INDEX new file mode 100644 index 0000000..9022d0b --- /dev/null +++ b/octave_packages/odepkg-0.8.2/packinfo/INDEX @@ -0,0 +1,54 @@ +odepkg >> OdePkg +OdePkg Tutorial + odepkg +OdePkg ODE Solver Functions + ode23 + ode45 + ode54 + ode78 +OdePkg DAE Solver Functions + ode2r + ode5r + odebda + odebwe + oders + odesx +OdePkg IDE Solver Functions + odebdi + odekdi +OdePkg DDE Solver Functions + ode23d + ode45d + ode54d + ode78d +OdePkg Options Functions + odeset + odeget +OdePkg Output Functions + odeplot + odeprint + odephas2 + odephas3 +OdePkg Example Functions + odeexamples + odepkg_examples_dae + odepkg_examples_dde + odepkg_examples_ide + odepkg_examples_ode +OdePkg Testsuite Functions + odepkg_testsuite_calcscd + odepkg_testsuite_calcmescd + odepkg_testsuite_chemakzo + odepkg_testsuite_hires + odepkg_testsuite_implakzo + odepkg_testsuite_implrober + odepkg_testsuite_impltrans + odepkg_testsuite_oregonator + odepkg_testsuite_pollution + odepkg_testsuite_robertson + odepkg_testsuite_transistor +OdePkg Internal Functions + odepkg_event_handle + odepkg_structure_check +OdePkg Other Functions + bvp4c \ No newline at end of file diff --git a/octave_packages/openmpi_ext-1.0.2/Pi.m b/octave_packages/openmpi_ext-1.0.2/Pi.m new file mode 100644 index 0000000..2f764b8 --- /dev/null +++ b/octave_packages/openmpi_ext-1.0.2/Pi.m @@ -0,0 +1,110 @@ +## Copyright (C) 2004-2007 Javier Fernández Baldomero, Mancia Anguita López +## This code has been adjusted for octave3.2.3 and octave 3.3.50+ in +## 2009 by Riccardo Corradini +## +## 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 . + + +# mpirun -np 5 octave -q --eval "Pi(2E7,'s')" + +function Pi(N,mod) +# Pi: Classic PI computation by numeric integration of arctan'(x) in [0..1] +# +# Pi [ ( N [ ,mod ] ) ] +# +# N [1E7] #subdivisions of the [0, 1] interval +# mod ['s'] communication modality: (s)end (r)educe +# +# printed results struct contains +# pi estimated pi value +# err error +# time from argument xmit to pi computed +# + + +########## +# ArgChk # +########## +if nargin<1, N=1E7; end +if nargin<2, mod='s'; end +if nargin>2, usage("Pi(N,mod)"); end # let all ranks complain +flag=0; # code much simpler +flag=flag || ~isscalar(N) || ~isnumeric(N); +flag=flag | fix(N)~=N | N<1; + mod=lower(mod); mods='sr'; +flag=flag | isempty(findstr(mod, mods)); # let them all error out +if flag, usage("Pi( N>0, mod=='s|r' )"); end + +################## +# Results struct # +################## +results.pi =0; +results.err =0; +results.time =0; + + +############ +# PARALLEL # initialization, include MPI_Init time in measurement +############ + T=clock; # +############ + MPI_ANY_SOURCE = -1; + MPI_Init(); + MPI_COMM_WORLD = MPI_Comm_Load("NEWORLD"); + rnk = MPI_Comm_rank (MPI_COMM_WORLD); # let it abort if it fails + siz = MPI_Comm_size (MPI_COMM_WORLD); + + SLV = logical(rnk); # handy shortcuts, master is rank 0 + MST = ~ SLV; # slaves are all other + +############ +# PARALLEL # computation (depends on rank/size) +############ # vectorized code, equivalent to + width=1/N; lsum=0; # for i=rnk:siz:N-1 + i=rnk:siz:N-1; # x=(i+0.5)*width; + x=(i+0.5)*width; # lsum=lsum+4/(1+x^2); + lsum=sum(4./(1+x.^2)); # end + +############ +# PARALLEL # reduction and finish +############ +switch mod + case 's', TAG=7; # Any tag would do + if SLV # All slaves send result back + MPI_Send(lsum, 0,TAG,MPI_COMM_WORLD); + else # Here at master + Sum =lsum; # save local result + for slv=1:siz-1 # collect in any order + lsum = MPI_Recv(MPI_ANY_SOURCE,TAG,MPI_COMM_WORLD); + Sum+=lsum; # and accumulate + end # order: slv or MPI_ANY_SOURCE + end + case 'r', + disp("not yet implemented"); +# Sum=0; +# reduction master = rank 0 @ WORLD +# MPI_Reduce(lsum,Sum, MPI_SUM, 0,MPI_COMM_WORLD); +end + +MPI_Finalize(); + +if MST + Sum = Sum/N ; # better at end: don't loose resolution +################################# # stopwatch measurement +results.time = etime(clock,T); # # but only at master after PI computed +################################# # all them started T=clock; +results.err = Sum-pi; +results.pi = Sum # ; + +end \ No newline at end of file diff --git a/octave_packages/openmpi_ext-1.0.2/allnodes b/octave_packages/openmpi_ext-1.0.2/allnodes new file mode 100644 index 0000000..6f56f34 --- /dev/null +++ b/octave_packages/openmpi_ext-1.0.2/allnodes @@ -0,0 +1,7 @@ +#!/bin/bash +# this script will run an Octave script using MPI with a given hostfile, +# using a given number of ranks. Edit it to set the hostfile and number of nodes +# then use it as follows: allnodes +HOSTFILE="/home/user/tmp/bhosts" +NUMBER_OF_NODES="33" +mpirun -x LD_PRELOAD=libmpi.so --hostfile $HOSTFILE -np $NUMBER_OF_NODES octave -q --eval $1 diff --git a/octave_packages/openmpi_ext-1.0.2/doc-cache b/octave_packages/openmpi_ext-1.0.2/doc-cache new file mode 100644 index 0000000..a517b88 --- /dev/null +++ b/octave_packages/openmpi_ext-1.0.2/doc-cache @@ -0,0 +1,222 @@ +# Created by Octave 3.6.1, Fri Apr 27 13:23:25 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 8 +# name: +# type: sq_string +# elements: 1 +# length: 2 +Pi + + +# name: +# type: sq_string +# elements: 1 +# length: 45 + mpirun -np 5 octave -q --eval "Pi(2E7,'s')" + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 + mpirun -np 5 octave -q --eval "Pi(2E7,'s')" + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +hello2dimmat + + +# name: +# type: sq_string +# elements: 1 +# length: 67 + the string NEWORLD is just a label could be whatever you want + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 + the string NEWORLD is just a label could be whatever you want + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +hellocell + + +# name: +# type: sq_string +# elements: 1 +# length: 183 + if you have 4 cores or a network of 4 computers with a ssh connection with no password and same openmpi 1.3.3 installation + type at the terminal mpirun -np 4 octave --eval hellocell + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + if you have 4 cores or a network of 4 computers with a ssh connection with no p + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +hellosparsemat + + +# name: +# type: sq_string +# elements: 1 +# length: 65 + the string NEWORLD is just a label could be whatever you want + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 + the string NEWORLD is just a label could be whatever you want + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +hellostruct + + +# name: +# type: sq_string +# elements: 1 +# length: 185 + if you have 4 cores or a network of 4 computers with a ssh connection with no password and same openmpi 1.3.3 installation + type at the terminal mpirun -np 4 octave --eval hellostruct + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + if you have 4 cores or a network of 4 computers with a ssh connection with no p + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +helloworld + + +# name: +# type: sq_string +# elements: 1 +# length: 184 + if you have 4 cores or a network of 4 computers with a ssh connection with no password and same openmpi 1.3.3 installation + type at the terminal mpirun -np 4 octave --eval helloworld + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + if you have 4 cores or a network of 4 computers with a ssh connection with no p + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +mc_example + + +# name: +# type: sq_string +# elements: 1 +# length: 133 + info = MPI_Init + tic; + montecarlo(f, args, reps, outfile, n_pooled, verbose); + disp("I am here!"); + t=toc + info = MPI_Finalize() + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + info = MPI_Init + tic; + montecarlo(f, args, reps, outfile, n_pooled, verbose); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +montecarlo + + +# name: +# type: sq_string +# elements: 1 +# length: 959 + montecarlo.m: generates a specified number of replications of a function's + output and writes them to a user-specified output file. + + USAGE: montecarlo(f,f_args,reps,outfile,n_pooled,n_returns,usempi, verbose) + + IMPORTANT: f should return a row vector of output from feval(f,f_args) + + For normal evaluation on one core, only the first 4 arguments are required. + * Arg 1: (required) the function that generates a row vector of output + * Arg 2: (required) the arguments of the function, in a cell + * Arg 3: (required) the number of replications to generate + * Arg 4: (required) the output file name + * Arg 5 (optional) number of replications to be pooled together between writes + * Arg 6 (optional) verbose: 1 for on, 0 for off + + If using MPI, you should run using ranks equal to number of cores plus 1, + and should make sure that the core running the frontend is also the one that + has the second rank. That way the core the frontend is on will also do work. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 + montecarlo. + + + + + diff --git a/octave_packages/openmpi_ext-1.0.2/hello2dimmat.m b/octave_packages/openmpi_ext-1.0.2/hello2dimmat.m new file mode 100644 index 0000000..36ed497 --- /dev/null +++ b/octave_packages/openmpi_ext-1.0.2/hello2dimmat.m @@ -0,0 +1,33 @@ + MPI_SUCCESS =0; + MPI_Init(); + + # the string NEWORLD is just a label could be whatever you want + CW = MPI_Comm_Load("NEWORLD"); + my_rank = MPI_Comm_rank(CW); + p = MPI_Comm_size(CW); + mytag = 48; + + + + if (my_rank != 0) +# Generate a random matrix + message=rand(444440,8); +# load message +# rankvect is the vector containing the list of rank destination process + rankvect = 0; + [info] = MPI_Send(message,rankvect,mytag,CW); + else + for source = 1:p-1 + disp("We are at rank 0 that is master etc.."); + [messager, info] = MPI_Recv(source,mytag,CW); + +# You could also save each result and make comparisons if you don't trust MPI + disp("Rank 0 is the master receiving ... :"); + if (info == MPI_SUCCESS) + disp('OK!'); + endif + endfor + end + + + MPI_Finalize(); diff --git a/octave_packages/openmpi_ext-1.0.2/hellocell.m b/octave_packages/openmpi_ext-1.0.2/hellocell.m new file mode 100644 index 0000000..0059d0b --- /dev/null +++ b/octave_packages/openmpi_ext-1.0.2/hellocell.m @@ -0,0 +1,52 @@ +## Copyright (C) 2009 Riccardo Corradini +## under the terms of the GNU General Public License. +## +## 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 . + + +# if you have 4 cores or a network of 4 computers with a ssh connection with no password and same openmpi 1.3.3 installation +# type at the terminal mpirun -np 4 octave --eval hellocell + + + MPI_Init(); + # the string NEWORLD is just a label could be whatever you want + CW = MPI_Comm_Load("NEWORLD"); + + + + my_rank = MPI_Comm_rank(CW); + p = MPI_Comm_size(CW); + # TAG is very important to identify the message + TAG = 1; + + + message=""; + if (my_rank != 0) + message = {magic(3) 17 'fred'; ... + 'AliceBettyCarolDianeEllen' 'yp' 42; ... + {1} 2 3}; + rankvect = 0; + [info] = MPI_Send(message,rankvect,TAG,CW); + else + for source = 1:p-1 + disp("We are at rank 0 that is master etc.."); + [messager, info] = MPI_Recv(source,TAG,CW); + info + messager + endfor + end + + + MPI_Finalize(); + diff --git a/octave_packages/openmpi_ext-1.0.2/hellosparsemat.m b/octave_packages/openmpi_ext-1.0.2/hellosparsemat.m new file mode 100644 index 0000000..cbacce3 --- /dev/null +++ b/octave_packages/openmpi_ext-1.0.2/hellosparsemat.m @@ -0,0 +1,47 @@ + MPI_Init(); + # the string NEWORLD is just a label could be whatever you want + CW = MPI_Comm_Load("NEWORLD"); + my_rank = MPI_Comm_rank(CW); + p = MPI_Comm_size(CW); +# tag[0] ----> type of octave_value +# tag[1] ----> array of three elements 1) num of rows 2) number of columns 3) number of non zero elements +# tag[2] ----> vector of rowindex +# tag[3] ----> vector of columnindex +# tag[4] ----> vector of non zero elements +# These tags will be generated after mytag by the MPI_Send and MPI_Recv (see source code) + + mytag = 48; + + + + +# This is just to fill the sparse matrix + M=5; + N=5; + D=0.9; + message = sprand (M, N, D); +# load message + + + + if (my_rank != 0) + dest = 0; +# rankvect is the vector containing the list of rank destination process + rankvect(1,1) = 0; + [info] = MPI_Send(message,rankvect,mytag,CW); + disp("This is flag for sending the message --") + info + else + for source = 1:p-1 + messager=''; + disp("We are at rank 0 that is master etc.."); + [messager, info] = MPI_Recv(source,mytag,CW); + disp("Rank 0 is the master receiving ... :"); + if (messager/message) + disp('OK!'); + endif + messager + endfor + end + + MPI_Finalize(); diff --git a/octave_packages/openmpi_ext-1.0.2/hellostruct.m b/octave_packages/openmpi_ext-1.0.2/hellostruct.m new file mode 100644 index 0000000..5876c99 --- /dev/null +++ b/octave_packages/openmpi_ext-1.0.2/hellostruct.m @@ -0,0 +1,48 @@ +## Copyright (C) 2009 Riccardo Corradini +## under the terms of the GNU General Public License. +## +## 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 . + + +# if you have 4 cores or a network of 4 computers with a ssh connection with no password and same openmpi 1.3.3 installation +# type at the terminal mpirun -np 4 octave --eval hellostruct + + + MPI_Init(); + # the string NEWORLD is just a label could be whatever you want + CW = MPI_Comm_Load("NEWORLD"); + + + + my_rank = MPI_Comm_rank(CW); + p = MPI_Comm_size(CW); + # TAG is very important to identify the message + TAG = 1; + + + message=""; + if (my_rank != 0) + message = struct('f1', {1 3; 2 4}, 'f2', 25); + # Could be a vector containing the list of ranks identifiers; + rankvect = 0; + [info] = MPI_Send(message,rankvect,TAG,CW); + else + for source = 1:p-1 + disp("We are at rank 0 that is master etc.."); + [message, info] = MPI_Recv(source,TAG,CW); + message + endfor + end + MPI_Finalize(); + diff --git a/octave_packages/openmpi_ext-1.0.2/helloworld.m b/octave_packages/openmpi_ext-1.0.2/helloworld.m new file mode 100644 index 0000000..cda48a6 --- /dev/null +++ b/octave_packages/openmpi_ext-1.0.2/helloworld.m @@ -0,0 +1,49 @@ +## Copyright (C) 2009 Riccardo Corradini +## under the terms of the GNU General Public License. +## +## 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 . + + +# if you have 4 cores or a network of 4 computers with a ssh connection with no password and same openmpi 1.3.3 installation +# type at the terminal mpirun -np 4 octave --eval helloworld + + + MPI_Init(); + # the string NEWORLD is just a label could be whatever you want + CW = MPI_Comm_Load("NEWORLD"); + + + + my_rank = MPI_Comm_rank(CW); + p = MPI_Comm_size(CW); + # Could be any number + TAG=1; + + + message=""; + if (my_rank != 0) + message = sprintf('Greetings from process: %d!',my_rank); + # rankvect is the vector containing the list of rank destination process + rankvect = 0; + [info] = MPI_Send(message,rankvect,TAG,CW); + else + for source = 1:p-1 + disp("We are at rank 0 that is master etc.."); + [message, info] = MPI_Recv(source,TAG,CW); + printf('%s\n', message); + endfor + end + + MPI_Finalize(); + diff --git a/octave_packages/openmpi_ext-1.0.2/mc_example.m b/octave_packages/openmpi_ext-1.0.2/mc_example.m new file mode 100644 index 0000000..ea4967f --- /dev/null +++ b/octave_packages/openmpi_ext-1.0.2/mc_example.m @@ -0,0 +1,53 @@ +## Copyright (C) 2009 Michael Cree +## under the terms of the GNU General Public License. +## +## 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 . + + +# mc_example: shows how Monte Carlo can be done using mpi, Does Monte +# Carlo on the OLS estimator. Uses montecarlo.m +# +# USAGE: from the command prompt, not the octave prompt, execute +# orterun -np 3 octave --eval mc_example +1; +function betahat = olswrapper(args) + n = args{1}; + theta = args{2}; + x = [ones(n,1) randn(n,1)]; + y = x*theta + randn(n,1); + betahat = ols(y,x); + betahat = betahat'; +endfunction + + +n = 30; +theta = [1;1]; + +reps = 10000; +f = "olswrapper"; +args = {n, theta}; +outfile = "mc_output"; +n_pooled = 100; +verbose = false; +tic; + montecarlo(f, args, reps, outfile, n_pooled, false, verbose); +t=toc + +# info = MPI_Init +# tic; +# montecarlo(f, args, reps, outfile, n_pooled, verbose); +# disp("I am here!"); +# t=toc +# info = MPI_Finalize() + diff --git a/octave_packages/openmpi_ext-1.0.2/montecarlo.m b/octave_packages/openmpi_ext-1.0.2/montecarlo.m new file mode 100644 index 0000000..d5495ac --- /dev/null +++ b/octave_packages/openmpi_ext-1.0.2/montecarlo.m @@ -0,0 +1,138 @@ +# Copyright (C) 2006, 2009 Michael Creel +# under the terms of the GNU General Public License. +# +# 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, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +# montecarlo.m: generates a specified number of replications of a function's +# output and writes them to a user-specified output file. +# +# USAGE: montecarlo(f,f_args,reps,outfile,n_pooled,n_returns,usempi, verbose) +# +# IMPORTANT: f should return a row vector of output from feval(f,f_args) +# +# For normal evaluation on one core, only the first 4 arguments are required. +# * Arg 1: (required) the function that generates a row vector of output +# * Arg 2: (required) the arguments of the function, in a cell +# * Arg 3: (required) the number of replications to generate +# * Arg 4: (required) the output file name +# * Arg 5 (optional) number of replications to be pooled together between writes +# * Arg 6 (optional) verbose: 1 for on, 0 for off +# +# If using MPI, you should run using ranks equal to number of cores plus 1, +# and should make sure that the core running the frontend is also the one that +# has the second rank. That way the core the frontend is on will also do work. + +function n_received = montecarlo(f,f_args,reps,outfile,n_pooled,verbose) + + t0 = clock(); # initialize timing + + # defaults for optional arguments + if (nargin < 6) verbose = false; endif + if (nargin < 5) n_pooled = 1; endif; + + if MPI_Initialized # check if doing this parallel or serial + use_mpi = true; + CW = MPI_Comm_Load("NEWORLD"); + is_node = MPI_Comm_rank(CW); + nodes = MPI_Comm_size(CW); + mytag = 48; + else + use_mpi = false; + is_node = 0; + endif + + if is_node # compute nodes + more_please = 1; + while more_please + for i = 1:n_pooled + contrib = feval(f, f_args); + contribs(i,:) = contrib; + endfor + MPI_Send(contribs, 0, mytag, CW); + pause(0.05); # give time for the fronted to send a stop message, if done + # check if we're done + if (MPI_Iprobe(0, is_node, CW)) # check for ping from rank 0 + junk = MPI_Recv(0, is_node, CW); + break; + endif + endwhile + else # frontend + received = 0; + done = false; + while received < reps + if use_mpi + # retrieve results from compute nodes + for i = 1:nodes-1 + # compute nodes have results yet? + ready = false; + ready = MPI_Iprobe(i, mytag, CW); # check if message pending + if ready + # get it if it's there + contribs = MPI_Recv(i, mytag, CW); + need = reps - received; + received = received + n_pooled; + # truncate? + if n_pooled >= need + contribs = contribs(1:need,:); + done = true; + endif + # write to output file + FN = fopen (outfile, "a"); + if (FN < 0) error ("montecarlo: couldn't open output file %s", outfile); endif + t = etime(clock(), t0); + for j = 1:rows(contribs) + fprintf(FN, "%f ", i, t, contribs(j,:)); + fprintf(FN, "\n"); + endfor + fclose(FN); + if verbose printf("\nContribution received from node%d. Received so far: %d\n", i, received); endif + if done + # tell compute nodes to stop loop + for j = 1:5 + for i = 1:(nodes-1) + if (j==1) MPI_Send(" ",i,i,CW); endif # send out message to stop + ready = MPI_Iprobe(i, mytag, CW); # get last messages + if ready contribs = MPI_Recv(i, mytag, CW); endif + endfor + endfor + break; + endif + endif + endfor + else + for i = 1:n_pooled + contrib = feval(f, f_args); + contribs(i,:) = contrib; + endfor + need = reps - received; + received = received + n_pooled; + # truncate? + if n_pooled >= need + contribs = contribs(1:need,:); + endif + # write to output file + FN = fopen (outfile, "a"); + if (FN < 0) error ("montecarlo: couldn't open output file %s", outfile); endif + t = etime(clock(), t0); + for j = 1:rows(contribs) + fprintf(FN, "%f ", 0, t, contribs(j,:)); + fprintf(FN, "\n"); + endfor + fclose(FN); + if verbose printf("\nContribution received from node 0. Received so far: %d\n", received); endif + endif + endwhile + endif +endfunction diff --git a/octave_packages/openmpi_ext-1.0.2/packinfo/.autoload b/octave_packages/openmpi_ext-1.0.2/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/openmpi_ext-1.0.2/packinfo/DESCRIPTION b/octave_packages/openmpi_ext-1.0.2/packinfo/DESCRIPTION new file mode 100644 index 0000000..939b4b0 --- /dev/null +++ b/octave_packages/openmpi_ext-1.0.2/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: openmpi_ext +Version: 1.0.2 +Date: 2010-6-17 +Author: Riccardo Corradini and the Octave Community +Maintainer: Riccardo Corradini +Title: openmpi_ext +Description: MPI functions for parallel computing using simple MPI Derived Datatypes. +Depends: octave (>= 3.2.4) +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net diff --git a/octave_packages/openmpi_ext-1.0.2/packinfo/INDEX b/octave_packages/openmpi_ext-1.0.2/packinfo/INDEX new file mode 100644 index 0000000..11e3466 --- /dev/null +++ b/octave_packages/openmpi_ext-1.0.2/packinfo/INDEX @@ -0,0 +1,9 @@ +openmpi_ext >> Openmpi_ext +Openmpi_ext + + MPI_Barrier MPI_Comm_Test MPI_Initialized MPI_Probe + MPI_Comm_Load MPI_Finalize MPI_Iprobe MPI_Recv + MPI_Comm_rank MPI_Finalized MPI_Op_Load MPI_Send + MPI_Comm_size MPI_Init MPI_Op_Test MPI_Get_processor_name + hello2dimmat hellosparsemat helloworld montecarlo + hellocell hellostruct mc_example Pi diff --git a/octave_packages/optim-1.2.0/LinearRegression.m b/octave_packages/optim-1.2.0/LinearRegression.m new file mode 100644 index 0000000..8a435db --- /dev/null +++ b/octave_packages/optim-1.2.0/LinearRegression.m @@ -0,0 +1,76 @@ +## Copyright (C) 2007 Andreas Stahel +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## general linear regression +## +## [p,y_var,r,p_var]=LinearRegression(F,y) +## [p,y_var,r,p_var]=LinearRegression(F,y,weight) +## +## determine the parameters p_j (j=1,2,...,m) such that the function +## f(x) = sum_(i=1,...,m) p_j*f_j(x) fits as good as possible to the +## given values y_i = f(x_i) +## +## parameters +## F n*m matrix with the values of the basis functions at the support points +## in column j give the values of f_j at the points x_i (i=1,2,...,n) +## y n column vector of given values +## weight n column vector of given weights +## +## return values +## p m vector with the estimated values of the parameters +## y_var estimated variance of the error +## r weighted norm of residual +## p_var estimated variance of the parameters p_j + +function [p,y_var,r,p_var]=LinearRegression(F,y,weight) + +if (nargin < 2 || nargin >= 4) + usage('wrong number of arguments in [p,y_var,r,p_var]=LinearRegression(F,y)'); +end + +[rF, cF] = size(F); [ry, cy] =size(y); +if (rF ~= ry || cy > 1) + error ('LinearRegression: incorrect matrix dimensions'); +end + +if (nargin==2) % set uniform weights if not provided + weight=ones(size(y)); +end + +%% Fw=diag(weight)*F; +wF=F; +for j=1:cF + wF(:,j)=weight.*F(:,j); +end + +[Q,R]=qr(wF,0); % estimate the values of the parameters +p=R\(Q'*(weight.*y)); + + +residual=F*p-y; % compute the residual vector +r=norm(weight.*residual); % and its weighted norm + % variance of the weighted y-errors +y_var= sum((residual.^2).*(weight.^4))/(rF-cF); + +if nargout>3 % compute variance of parameters only if needed +%% M=inv(R)*Q'*diag(weight); + M=inv(R)*Q'; + for j=1:cF + M(j,:)=M(j,:).*(weight'); + end + M=M.*M; % square each entry in the matrix M + p_var=M*(y_var./(weight.^4)); % variance of the parameters +end + diff --git a/octave_packages/optim-1.2.0/PKG_ADD b/octave_packages/optim-1.2.0/PKG_ADD new file mode 100644 index 0000000..604b007 --- /dev/null +++ b/octave_packages/optim-1.2.0/PKG_ADD @@ -0,0 +1,4 @@ + +__all_opts__ ("powell"); + +__all_opts__ ("vfzero"); diff --git a/octave_packages/optim-1.2.0/__bracket_min.m b/octave_packages/optim-1.2.0/__bracket_min.m new file mode 100644 index 0000000..0393447 --- /dev/null +++ b/octave_packages/optim-1.2.0/__bracket_min.m @@ -0,0 +1,42 @@ +## Copyright (C) 2002 Etienne Grossmann +## Copyright (C) 2009 Levente Torok +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## [a, b, ga, gb, nev] = semi_bracket (f, dx, a, narg, args) +## +## Find an interval containing a local minimum of the function +## g : h in reals ---> f (x+h*dx) where x = args{narg} +## +## a < b. +## nev is the number of function evaluations + +function [a, b, ga, gb, n] = __bracket_min (f, dx, narg, args) + + [a,b, ga,gb, n] = __semi_bracket (f, dx, 0, narg, args); + + if a != 0, return; end + + [a2,b2, ga2,gb2, n2] = __semi_bracket (f, -dx, 0, narg, args); + + n += n2; + + if a2 == 0, + a = -b2; ga = gb2; + else + a = -b2; + b = -a2; + ga = gb2; + gb = ga2; +end diff --git a/octave_packages/optim-1.2.0/__poly_2_extrema.m b/octave_packages/optim-1.2.0/__poly_2_extrema.m new file mode 100644 index 0000000..ead6178 --- /dev/null +++ b/octave_packages/optim-1.2.0/__poly_2_extrema.m @@ -0,0 +1,54 @@ +## Copyright (C) 2002 Etienne Grossmann +## Copyright (C) 2009 Levente Torok +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## ex = poly_2_ex (l, f) - Extremum of a 1-var deg-2 polynomial +## +## l : 3 : variable values +## f : 3 : f(i) = value of polynomial at l(i) +## +## ex : 1 : Value at which f reaches an extremum +## +## Assuming that f(i) = a*l(i)^2 + b* l(i) + c = P(l(i)) for some a, b, c, +## ex is the extremum of the polynome P. + +function ex = __poly_2_extrema (l, f) + +### This somewhat helps if solution is very close to one of the points. +[f,i] = sort (f); +l = l(i); + + +m = (l(2) - l(1))/(l(3) - l(1)); +d = (2*(f(1)*(m-1)+f(2)-f(3)*m)); +if abs (d) < eps, + printf ("poly_2_ex : divisor is small (solution at infinity)\n"); + printf ("%8.3e %8.3e %8.3e, %8.3e %8.3e\n",\ + f(1), diff (f), diff (sort (l))); + + ex = (2*(l(1)>l(2))-1)*inf; + ## keyboard +else + ex = ((l(3) - l(1))*((f(1)*(m^2-1) + f(2) - f(3)*m^2))) / d ; + +## Not an improvement +# n = ((l(2)+l(3))*(l(2)-l(3)) + 2*(l(3)-l(2))*l(1)) / (l(3)-l(1))^2 ; +# ex = ((l(3) - l(1))*((f(1)*n + f(2) - f(3)*m^2))) / \ +# (2*(f(1)*(m-1)+f(2)-f(3)*m)); +# if ex != ex0, +# ex - ex0 +# end + ex = l(1) + ex; +end diff --git a/octave_packages/optim-1.2.0/__semi_bracket.m b/octave_packages/optim-1.2.0/__semi_bracket.m new file mode 100644 index 0000000..65a765b --- /dev/null +++ b/octave_packages/optim-1.2.0/__semi_bracket.m @@ -0,0 +1,50 @@ +## Copyright (C) 2002 Etienne Grossmann +## Copyright (C) 2009 Levente Torok +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## [a, b, ga, gb, nev] = semi_bracket (f, dx, a, narg, args) +## +## Find an interval containing a local minimum of the function +## g : h in [a, inf[ ---> f (x+h*dx) where x = args{narg} +## +## The local minimum may be in a. +## a < b. +## nev is the number of function evaluations. + +function [a,b,ga,gb,n] = __semi_bracket (f, dx, a, narg, args) + +step = 1; + +x = args{narg}; +args{narg} = x+a*dx; ga = feval (f, args ); +b = a + step; +args{narg} = x+b*dx; gb = feval (f, args ); +n = 2; + +if gb >= ga, return ; end + +while 1, + + c = b + step; + args{narg} = x+c*dx; gc = feval( f, args ); + n++; + + if gc >= gb, # ga >= gb <= gc + gb = gc; b = c; + return; + end + step *= 2; + a = b; b = c; ga = gb; gb = gc; +end diff --git a/octave_packages/optim-1.2.0/adsmax.m b/octave_packages/optim-1.2.0/adsmax.m new file mode 100644 index 0000000..7549df9 --- /dev/null +++ b/octave_packages/optim-1.2.0/adsmax.m @@ -0,0 +1,171 @@ +%% Copyright (C) 2002 N.J.Higham +%% Copyright (C) 2003 Andy Adler +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%%ADSMAX Alternating directions method for direct search optimization. +%% [x, fmax, nf] = ADSMAX(FUN, x0, STOPIT, SAVIT, P) attempts to +%% maximize the function FUN, using the starting vector x0. +%% The alternating directions direct search method is used. +%% Output arguments: +%% x = vector yielding largest function value found, +%% fmax = function value at x, +%% nf = number of function evaluations. +%% The iteration is terminated when either +%% - the relative increase in function value between successive +%% iterations is <= STOPIT(1) (default 1e-3), +%% - STOPIT(2) function evaluations have been performed +%% (default inf, i.e., no limit), or +%% - a function value equals or exceeds STOPIT(3) +%% (default inf, i.e., no test on function values). +%% Progress of the iteration is not shown if STOPIT(5) = 0 (default 1). +%% If a non-empty fourth parameter string SAVIT is present, then +%% `SAVE SAVIT x fmax nf' is executed after each inner iteration. +%% By default, the search directions are the co-ordinate directions. +%% The columns of a fifth parameter matrix P specify alternative search +%% directions (P = EYE is the default). +%% NB: x0 can be a matrix. In the output argument, in SAVIT saves, +%% and in function calls, x has the same shape as x0. +%% ADSMAX(fun, x0, STOPIT, SAVIT, P, P1, P2,...) allows additional +%% arguments to be passed to fun, via feval(fun,x,P1,P2,...). +%% Reference: +%% N. J. Higham, Optimization by direct search in matrix computations, +%% SIAM J. Matrix Anal. Appl, 14(2): 317-333, 1993. +%% N. J. Higham, Accuracy and Stability of Numerical Algorithms, +%% Second edition, Society for Industrial and Applied Mathematics, +%% Philadelphia, PA, 2002; sec. 20.5. + +% From Matrix Toolbox +% Copyright (C) 2002 N.J.Higham +% www.maths.man.ac.uk/~higham/mctoolbox +% Modifications for octave by A.Adler 2003 + +function [x, fmax, nf] = adsmax(f, x, stopit, savit, P, varargin) + +x0 = x(:); % Work with column vector internally. +n = length(x0); + +mu = 1e-4; % Initial percentage change in components. +nstep = 25; % Max number of times to double or decrease h. + +% Set up convergence parameters. +if nargin < 3 + stopit(1) = 1e-3; +elseif isempty(stopit) + stopit(1) = 1e-3; +endif +tol = stopit(1); % Required rel. increase in function value over one iteration. +if length(stopit) == 1, stopit(2) = inf; end % Max no. of f-evaluations. +if length(stopit) == 2, stopit(3) = inf; end % Default target for f-values. +if length(stopit) < 5, stopit(5) = 1; end % Default: show progress. +trace = stopit(5); +if length(stopit) == 5, stopit(6) = 1; end % Default: maximize +dirn= stopit(6); +if nargin < 4, savit = []; end % File name for snapshots. + +% Matrix of search directions. +if nargin < 5 + P = eye(n); +elseif isempty(P) + P = eye(n); +else + if ~isequal(size(P),[n n]) % Check for common error. + error('P must be of dimension the number of elements in x0.') + end +end + +fmax = dirn*feval(f,x,varargin{:}); nf = 1; +if trace, fprintf('f(x0) = %9.4e\n', fmax), end + +steps = zeros(n,1); +it = 0; y = x0; + +while 1 % Outer loop. +it = it+1; +if trace, fprintf('Iter %2.0f (nf = %2.0f)\n', it, nf), end +fmax_old = fmax; + +for i=1:n % Loop over search directions. + + pi = P(:,i); + flast = fmax; + yi = y; + h = sign(pi'*yi)*norm(pi.*yi)*mu; % Initial step size. + if h == 0, h = max(norm(yi,inf),1)*mu; end + y = yi + h*pi; + x(:) = y; fnew = dirn*feval(f,x,varargin{:}); nf = nf + 1; + if fnew > fmax + fmax = fnew; + if fmax >= stopit(3) + if trace + fprintf('Comp. = %2.0f, steps = %2.0f, f = %9.4e*\n', i,0,fmax) + fprintf('Exceeded target...quitting\n') + end + x(:) = y; return + end + h = 2*h; lim = nstep; k = 1; + else + h = -h; lim = nstep+1; k = 0; + end + + for j=1:lim + y = yi + h*pi; + x(:) = y; fnew = dirn*feval(f,x,varargin{:}); nf = nf + 1; + if fnew <= fmax, break, end + fmax = fnew; k = k + 1; + if fmax >= stopit(3) + if trace + fprintf('Comp. = %2.0f, steps = %2.0f, f = %9.4e*\n', i,j,fmax) + fprintf('Exceeded target...quitting\n') + end + x(:) = y; return + end + h = 2*h; + end + + steps(i) = k; + y = yi + 0.5*h*pi; + if k == 0, y = yi; end + + if trace + fprintf('Comp. = %2.0f, steps = %2.0f, f = %9.4e', i, k, fmax) + fprintf(' (%2.1f%%)\n', 100*(fmax-flast)/(abs(flast)+eps)) + end + + + if nf >= stopit(2) + if trace + fprintf('Max no. of function evaluations exceeded...quitting\n') + end + x(:) = y; return + end + + if (fmax > flast && ~isempty (savit)) + x(:) = y; + eval(['save ' savit ' x fmax nf']) + end + +end % Loop over search directions. + +if isequal(steps,zeros(n,1)) + if trace, fprintf('Stagnated...quitting\n'), end + x(:) = y; return +end + +if fmax-fmax_old <= tol*abs(fmax_old) + if trace, fprintf('Function values ''converged''...quitting\n'), end + x(:) = y; return +end + +end %%%%%% Of outer loop. diff --git a/octave_packages/optim-1.2.0/battery.m b/octave_packages/optim-1.2.0/battery.m new file mode 100644 index 0000000..d793492 --- /dev/null +++ b/octave_packages/optim-1.2.0/battery.m @@ -0,0 +1,49 @@ +## Copyright (C) 2004 Michael Creel +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## battery.m: repeatedly call bfgs using a battery of +## start values, to attempt to find global min +## of a nonconvex function +## +## INPUTS: +## func: function to mimimize +## args: args of function +## minarg: argument to minimize w.r.t. (usually = 1) +## startvals: kxp matrix of values to try for sure (don't include all zeros, that's automatic) +## max iters per start value +## number of additional random start values to try +## +# OUTPUT: theta - the best value found - NOT iterated to convergence + +function theta = battery(func, args, minarg, startvals, maxiters) + +# setup +[k,trials] = size(startvals); +bestobj = inf; +besttheta = zeros(k,1); +bfgscontrol = {maxiters,0,0,1}; +# now try the supplied start values, and optionally the random start values +for i = 1:trials + args{minarg} = startvals(:,i); + [theta, obj_value, convergence] = bfgsmin (func, args, bfgscontrol); + + if obj_value < bestobj + besttheta = theta; + bestobj = obj_value; + endif +endfor + +theta = besttheta; +endfunction diff --git a/octave_packages/optim-1.2.0/bfgsmin.m b/octave_packages/optim-1.2.0/bfgsmin.m new file mode 100644 index 0000000..387ed33 --- /dev/null +++ b/octave_packages/optim-1.2.0/bfgsmin.m @@ -0,0 +1,130 @@ +## Copyright (C) 2006 Michael Creel +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## bfgsmin: bfgs or limited memory bfgs minimization of function +## +## Usage: [x, obj_value, convergence, iters] = bfgsmin(f, args, control) +## +## The function must be of the form +## [value, return_2,..., return_m] = f(arg_1, arg_2,..., arg_n) +## By default, minimization is w.r.t. arg_1, but it can be done +## w.r.t. any argument that is a vector. Numeric derivatives are +## used unless analytic derivatives are supplied. See bfgsmin_example.m +## for methods. +## +## Arguments: +## * f: name of function to minimize (string) +## * args: a cell array that holds all arguments of the function +## The argument with respect to which minimization is done +## MUST be a vector +## * control: an optional cell array of 1-8 elements. If a cell +## array shorter than 8 elements is provided, the trailing elements +## are provided with default values. +## * elem 1: maximum iterations (positive integer, or -1 or Inf for unlimited (default)) +## * elem 2: verbosity +## 0 = no screen output (default) +## 1 = only final results +## 2 = summary every iteration +## 3 = detailed information +## * elem 3: convergence criterion +## 1 = strict (function, gradient and param change) (default) +## 0 = weak - only function convergence required +## * elem 4: arg in f_args with respect to which minimization is done (default is first) +## * elem 5: (optional) Memory limit for lbfgs. If it's a positive integer +## then lbfgs will be use. Otherwise ordinary bfgs is used +## * elem 6: function change tolerance, default 1e-12 +## * elem 7: parameter change tolerance, default 1e-6 +## * elem 8: gradient tolerance, default 1e-5 +## +## Returns: +## * x: the minimizer +## * obj_value: the value of f() at x +## * convergence: 1 if normal conv, other values if not +## * iters: number of iterations performed +## +## Example: see bfgsmin_example.m + +function [parameter, obj, convergence, iters] = bfgsmin(f, f_args, control) + + # check number and types of arguments + if ((nargin < 2) || (nargin > 3)) + usage("bfgsmin: you must supply 2 or 3 arguments"); + endif + if (!ischar(f)) usage("bfgsmin: first argument must be string holding objective function name"); endif + if (!iscell(f_args)) usage("bfgsmin: second argument must cell array of function arguments"); endif + if (nargin > 2) + if (!iscell(control)) + usage("bfgsmin: 3rd argument must be a cell array of 1-8 elements"); + endif + if (length(control) > 8) + usage("bfgsmin: 3rd argument must be a cell array of 1-8 elements"); + endif + else control = {}; + endif + + # provide defaults for missing controls + if (length(control) == 0) control{1} = -1; endif # limit on iterations + if (length(control) == 1) control{2} = 0; endif # level of verbosity + if (length(control) == 2) control{3} = 1; endif # strong (function, gradient and parameter change) convergence required? + if (length(control) == 3) control{4} = 1; endif # argument with respect to which minimization is done + if (length(control) == 4) control{5} = 0; endif # memory for lbfgs: 0 uses ordinary bfgs + if (length(control) == 5) control{6} = 1e-10; endif # tolerance for function convergence + if (length(control) == 6) control{7} = 1e-6; endif # tolerance for parameter convergence + if (length(control) == 7) control{8} = 1e-5; endif # tolerance for gradient convergence + + # validity checks on all controls + tmp = control{1}; + if (((tmp !=Inf) && (tmp != -1)) && (tmp > 0 && (mod(tmp,1) != 0))) + usage("bfgsmin: 1st element of 3rd argument (iteration limit) must be Inf or positive integer"); + endif + tmp = control{2}; + if ((tmp < 0) || (tmp > 3) || (mod(tmp,1) != 0)) + usage("bfgsmin: 2nd element of 3rd argument (verbosity level) must be 0, 1, 2, or 3"); + endif + tmp = control{3}; + if ((tmp != 0) && (tmp != 1)) + usage("bfgsmin: 3rd element of 3rd argument (strong/weak convergence) must be 0 (weak) or 1 (strong)"); + endif + tmp = control{4}; + if ((tmp < 1) || (tmp > length(f_args)) || (mod(tmp,1) != 0)) + usage("bfgsmin: 4th element of 3rd argument (arg with respect to which minimization is done) must be an integer that indicates one of the elements of f_args"); + endif + tmp = control{5}; + if ((tmp < 0) || (mod(tmp,1) != 0)) + usage("bfgsmin: 5th element of 3rd argument (memory for lbfgs must be zero (regular bfgs) or a positive integer"); + endif + tmp = control{6}; + if (tmp < 0) + usage("bfgsmin: 6th element of 3rd argument (tolerance for function convergence) must be a positive real number"); + endif + tmp = control{7}; + if (tmp < 0) + usage("bfgsmin: 7th element of 3rd argument (tolerance for parameter convergence) must be a positive real number"); + endif + tmp = control{8}; + if (tmp < 0) + usage("bfgsmin: 8th element of 3rd argument (tolerance for gradient convergence) must be a positive real number"); + endif + + # check that the parameter we minimize w.r.t. is a vector + minarg = control{4}; + theta = f_args{minarg}; + theta = theta(:); + if (!isvector(theta)) usage("bfgsmin: minimization must be done with respect to a vector of parameters"); endif + f_args{minarg} = theta; + + # now go ahead and do the minimization + [parameter, obj, convergence, iters] = __bfgsmin(f, f_args, control); +endfunction diff --git a/octave_packages/optim-1.2.0/bfgsmin_example.m b/octave_packages/optim-1.2.0/bfgsmin_example.m new file mode 100644 index 0000000..e893170 --- /dev/null +++ b/octave_packages/optim-1.2.0/bfgsmin_example.m @@ -0,0 +1,170 @@ +## Copyright (C) 2004,2005,2006 Michael Creel +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +# usage: bfgsmin_example (to run) or edit bfgsmin_example (to examine) +## +# Shows how to call bfgsmin. There are two objective functions, the first +# supplies the analytic gradient, and the second does not. The true minimizer +# is at "location", a 50x1 vector (0.00, 0.02, 0.04 ..., 1.00). +# Note that limited memory bfgs is faster when the dimension is high. +# Also note that supplying analytic derivatives gives a speedup. +## +# Six examples are given: +# Example 1: regular bfgs, analytic gradient +# Example 2: same as Example 1, but verbose +# Example 3: limited memory bfgs, analytic gradient +# Example 4: regular bfgs, numeric gradient +# Example 5: limited memory bfgs, numeric gradient +# Example 6: regular bfgs, analytic gradient, minimize wrt second argument +1; +# example obj. fn.: supplies analytic gradient +function [obj_value, gradient] = objective(theta, location) + x = theta - location + ones(rows(theta),1); # move minimizer to "location" + [obj_value, gradient] = rosenbrock(x); +endfunction + +# example obj. fn.: no gradient +function obj_value = objective2(theta, location) + x = theta - location + ones(rows(theta),1); # move minimizer to "location" + obj_value = rosenbrock(x); +endfunction + +# initial values +dim = 20; # dimension of Rosenbrock function +theta0 = zeros(dim+1,1); # starting values +location = (0:dim)/dim; # true values +location = location'; + +printf("EXAMPLE 1: Ordinary BFGS, using analytic gradient\n"); +t=cputime(); +control = {Inf,1}; # maxiters, verbosity +[theta, obj_value, convergence] = bfgsmin("objective", {theta0, location}, control); +fflush(1); +t1 = cputime() - t; +conv = norm(theta-location, 'inf'); +test1 = conv < 1e-5; + +printf("EXAMPLE 2: Same as Example 1, but verbose\n"); +t=cputime(); +control = {-1;3}; # maxiters, verbosity +[theta, obj_value, convergence] = bfgsmin("objective", {theta0, location}, control); +fflush(1); +t2 = cputime() - t; +conv = norm(theta-location, 'inf'); +test2 = conv < 1e-5; + +printf("EXAMPLE 3: Limited memory BFGS, using analytic gradient\n"); +t=cputime(); +control = {-1;1;1;1;3}; # maxiters, verbosity, conv. requirement., arg_to_min, lbfgs memory +[theta, obj_value, convergence] = bfgsmin("objective", {theta0, location}, control); +fflush(1); +t3 = cputime() - t; +conv = norm(theta-location, 'inf'); +test3 = conv < 1e-5; + +printf("EXAMPLE 4: Ordinary BFGS, using numeric gradient\n"); +t=cputime(); +control = {-1;1}; # maxiters, verbosity +[theta, obj_value, convergence] = bfgsmin("objective2", {theta0, location}, control); +fflush(1); +t4 = cputime() - t; +conv = norm(theta-location, 'inf'); +test4 = conv < 1e-5; + +printf("EXAMPLE 5: Limited memory BFGS, using numeric gradient\n"); +t=cputime(); +control = {-1;1;1;1;3}; # maxiters, verbosity, conv. reg., arg_to_min, lbfgs memory +[theta, obj_value, convergence] = bfgsmin("objective2", {theta0, location}, control); +fflush(1); +t5 = cputime() - t; +conv = norm(theta-location, 'inf'); +test5 = conv < 1e-5; + + +printf("EXAMPLE 6: Funny case: minimize w.r.t. second argument, Ordinary BFGS, using numeric gradient\n"); +t=cputime(); +control = {-1;1;1;2}; # maxiters, verbosity, conv. reg., arg_to_min +[theta, obj_value, convergence] = bfgsmin("objective2", {location, theta0}, control); +fflush(1); +t6 = cputime() - t; +conv = norm(theta-location, 'inf'); +test6 = conv < 1e-5; + +printf("EXAMPLE 7: Ordinary BFGS, using numeric gradient, using non-default tolerances\n"); +t=cputime(); +control = {-1;1;1;1;0;1e-6;1e-2;1e-2}; # maxiters, verbosity, conv. reg., arg_to_min, lbfgs memory, fun. tol., param. tol., gradient tol. +[theta, obj_value, convergence] = bfgsmin("objective2", {theta0, location}, control); +fflush(1); +t7 = cputime() - t; +conv = norm(theta-location, 'inf'); +test7 = conv < 1e-2; + + +printf("EXAMPLE 1: Ordinary BFGS, using analytic gradient\n"); +if test1 + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t1); + +printf("EXAMPLE 2: Same as Example 1, but verbose\n"); +if test2 + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t2); + +printf("EXAMPLE 3: Limited memory BFGS, using analytic gradient\n"); +if test3 + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t3); + +printf("EXAMPLE 4: Ordinary BFGS, using numeric gradient\n"); +if test4 + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t4); + +printf("EXAMPLE 5: Limited memory BFGS, using numeric gradient\n"); +if test5 + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t5); + +printf("EXAMPLE 6: Funny case: minimize w.r.t. second argument, Ordinary BFGS, using numeric gradient\n"); +if test6 + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t6); + +printf("EXAMPLE 7: Ordinary BFGS, using numeric gradient, using non-default tolerances\n"); +if test7 + printf("Success!! :-)\n"); +else + printf("Failure?! :-(\n"); +endif +printf("Elapsed time = %f\n\n\n\n",t7); + diff --git a/octave_packages/optim-1.2.0/brent_line_min.m b/octave_packages/optim-1.2.0/brent_line_min.m new file mode 100644 index 0000000..1c881e1 --- /dev/null +++ b/octave_packages/optim-1.2.0/brent_line_min.m @@ -0,0 +1,233 @@ +## Copyright (C) 2009 Levente Torok +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{s},@var{v},@var{n}]} brent_line_min ( @var{f},@var{df},@var{args},@var{ctl} ) +## Line minimization of f along df +## +## Finds minimum of f on line @math{ x0 + dx*w | a < w < b } by +## bracketing. a and b are passed through argument ctl. +## +## @subheading Arguments +## @itemize @bullet +## @item @var{f} : string : Name of function. Must return a real value +## @item @var{args} : cell : Arguments passed to f or RxC : f's only argument. x0 must be at @var{args}@{ @var{ctl}(2) @} +## @item @var{ctl} : 5 : (optional) Control variables, described below. +## @end itemize +## +## @subheading Returned values +## @itemize @bullet +## @item @var{s} : 1 : Minimum is at x0 + s*dx +## @item @var{v} : 1 : Value of f at x0 + s*dx +## @item @var{nev} : 1 : Number of function evaluations +## @end itemize +## +## @subheading Control Variables +## @itemize @bullet +## @item @var{ctl}(1) : Upper bound for error on s Default=sqrt(eps) +## @item @var{ctl}(2) : Position of minimized argument in args Default= 1 +## @item @var{ctl}(3) : Maximum number of function evaluations Default= inf +## @item @var{ctl}(4) : a Default=-inf +## @item @var{ctl}(5) : b Default= inf +## @end itemize +## +## Default values will be used if ctl is not passed or if nan values are +## given. +## @end deftypefn + +function [s,gs,nev] = brent_line_min( f,dx,args,ctl ) + +verbose = 0; + +seps = sqrt (eps); + + # Default control variables +tol = 10*eps; # sqrt (eps); +narg = 1; +maxev = inf; +a = -inf; +b = inf; + +if nargin >= 4, # Read arguments + if !isnan (ctl (1)), tol = ctl(1); end + if length (ctl)>=2 && !isnan (ctl(2)), narg = ctl(2); end + if length (ctl)>=3 && !isnan (ctl(3)), maxev = ctl(3); end + if length (ctl)>=4 && !isnan (ctl(4)), a = ctl(4); end + if length (ctl)>=5 && !isnan (ctl(5)), b = ctl(5); end + +end # Otherwise, use defaults, def'd above + +if a>b, tmp=a; a=b; b=tmp; end + +if narg > length (args), + printf ("brent_line_min : narg==%i > length (args)==%i",\ + narg, length (args)); + keyboard +end + + +if ! iscell (args), + args = {args}; +endif + +x = args{ narg }; + +[R,C] = size (x); +N = R*C; # Size of argument + +gs0 = gs = feval (f, args); +nev = 1; + # Initial value +s = 0; + +if all (dx==0), return; end # Trivial case + + # If any of the bounds is infinite, find + # finite bounds that bracket minimum +if !isfinite (a) || !isfinite (b), + if !isfinite (a) && !isfinite (b), + [a,b, ga,gb, n] = __bracket_min (f, dx, narg, args); + elseif !isfinite (a), + [a,b, ga,gb, n] = __semi_bracket (f, -dx, -b, narg, args); + tmp = a; a = -b; b = -tmp; + tmp = ga; ga = gb; gb = tmp; + else + [a,b, ga,gb, n] = __semi_bracket (f, dx, a, narg, args); + end + nev += n; +else + args{narg} = x+a*dx; ga = feval( f, args ); + args{narg} = x+b*dx; gb = feval( f, args ); + nev += 2; +end # End of finding bracket for minimum + +if a > b, # Check assumptions + printf ("brent_line_min : a > b\n"); + keyboard +end + +s = 0.5*(a+b); +args{narg} = x+ s*dx; gs = feval( f, args ); +nev++; + +if verbose, + printf ("[a,s,b]=[%.3e,%.3e,%.3e], [ga,gs,gb]=[%.3e,%.3e,%.3e]\n",\ + a,s,b,ga,gs,gb); +end + +maxerr = 2*tol; + +while ( b-a > maxerr ) && nev < maxev, + + if gs > ga && gs > gb, # Check assumptions + printf ("brent_line_min : gs > ga && gs > gb\n"); + keyboard + end + + if ga == gb && gb == gs, break end + + # Don't trust poly_2_ex for glued points + # (see test_poly_2_ex). + + ## if min (b-s, s-a) > 10*seps, + + # If s is not glued to a or b and does not + # look linear + ## mydet = sum (l([2 3 1]).*f([3 1 2])-l([3 1 2]).*f([2 3 1])) + mydet = sum ([s b a].*[gb ga gs] - [b a s].*[gs gb ga]); + if min (b-s, s-a) > 10*seps && abs (mydet) > 10*seps && \ + (t = poly_2_ex ([a,s,b], [ga, gs, gb])) < b && t > a, + + # t has already been set + + ## if t>=b || t<=a, + ## printf ("brent_line_min : t is not in ]a,b[\n"); + ## keyboard + ## end + + # Otherwise, reduce the biggest of the + # intervals, but not too much + elseif s-a > b-s, + t = max (0.5*(a+s), s-100*seps); + else + t = min (0.5*(s+b), s+100*seps); + end + + if abs (t-s) < 0.51*maxerr, + #sayif (verbose, "ungluing t and s\n"); + t = s + (1 - 2*(s-a > b-s))*0.49*maxerr ; + end + + if a > s || s > b, # Check assumptions + printf ("brent_line_min : a > s || s > b\n"); + keyboard + end + + xt = args; + args{narg} = x+t*dx; + gt = feval( f, args ); + nev++; + + if verbose, + printf ("t = %.3e, gt = %.3e\n",t,gt); + end + + if t ga + seps, # Check assumptions + printf ("brent_line_min : gt > ga\n"); + keyboard + end + + if gt < gs, + b = s; gb = gs; + s = t; gs = gt; + else + a = t; ga = gt; + end + else # New point is in ]s,b[ + if gt > gb + seps, # Check assumptions + printf ("brent_line_min : gt > gb\n"); + keyboard + end + + if gt < gs, + a = s; ga = gs; + s = t; gs = gt; + else + b = t; gb = gt; + end + end + + if verbose, + printf ("[a,s,b]=[%.3e,%.3e,%.3e], [ga,gs,gb]=[%.3e,%.3e,%.3e]\n",\ + a,s,b,ga,gs,gb); + end + ## keyboard + ## [b-a, maxerr] +end + +s2 = 0.5*(a+b); +args{narg} = x + s2*dx; gs2 = feval (f, args ); +nev++; + +if gs2 < gs, + s = s2; gs = gs2; +end + +if gs > gs0, + printf ("brent_line_min : goes uphill by %8.3e\n",gs-gs0); + keyboard +end diff --git a/octave_packages/optim-1.2.0/cauchy.m b/octave_packages/optim-1.2.0/cauchy.m new file mode 100644 index 0000000..7f4c753 --- /dev/null +++ b/octave_packages/optim-1.2.0/cauchy.m @@ -0,0 +1,125 @@ +## Copyright (C) 2011 Fernando Damian Nieuwveldt +## 2012 Adapted by Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or +## modify it under the terms of the GNU General Public License +## as published by the Free Software Foundation; either version 3 +## of the License, or (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. + +## -*- texinfo -*- +## @deftypefn {Function File} {} cauchy (@var{N}, @var{r}, @var{x}, @var{f} ) +## Return the Taylor coefficients and numerical differentiation of a function +## @var{f} for the first @var{N-1} coefficients or derivatives using the fft. +## @var{N} is the number of points to evaluate, +## @var{r} is the radius of convergence, needs to be chosen less then the smallest singularity, +## @var{x} is point to evaluate the Taylor expansion or differentiation. For example, +## +## If @var{x} is a scalar, the function @var{f} is evaluated in a row vector +## of length @var{N}. If @var{x} is a column vector, @var{f} is evaluated in a +## matrix of length(x)-by-N elements and must return a matrix of the same size. +## +## @example +## @group +## d = cauchy(16, 1.5, 0, @@(x) exp(x)); +## @result{} d(2) = 1.0000 # first (2-1) derivative of function f (index starts from zero) +## @end group +## @end example +## @end deftypefn + +function deriv = cauchy(N, r, x, f) + + if nargin != 4 + print_usage (); + end + + [nx m] = size (x); + if m > 1 + error('cauchy:InvalidArgument', 'The 3rd argument must be a column vector'); + end + + n = 0:N-1; + th = 2*pi*n/N; + + f_p = f (bsxfun (@plus, x, r * exp (i * th) ) ); + + evalfft = real(fft (f_p, [], 2)); + + deriv = bsxfun (@times, evalfft, 1./(N*(r.^n)).* factorial(n)) ; + +endfunction + +function g = hermite(order,x) + ## N should be bigger than order+1 + N = 32; + r = 0.5; + Hnx = @(t) exp ( bsxfun (@minus, kron(t(:).', x(:)) , t(:).'.^2/2) ); + Hnxfft = cauchy(N, r, 0, Hnx); + g = Hnxfft(:, order+1); +endfunction + +%!demo +%! # Cauchy integral formula: Application to Hermite polynomials +%! # Author: Fernando Damian Nieuwveldt +%! # Edited by: Juan Pablo Carbajal +%! +%! Hnx = @(t,x) exp ( bsxfun (@minus, kron(t(:).', x(:)) , t(:).'.^2/2) ); +%! hermite = @(order,x) cauchy(32, 0.5, 0, @(t)Hnx(t,x))(:, order+1); +%! +%! t = linspace(-1,1,30); +%! he2 = hermite(2,t); +%! he2_ = t.^2-1; +%! +%! figure(1) +%! clf +%! plot(t,he2,'bo;Contour integral representation;', t,he2_,'r;Exact;'); +%! grid +%! clear all +%! +%! % -------------------------------------------------------------------------- +%! % The plots compares the approximation of the Hermite polynomial using the +%! % Cauchy integral (circles) and the corresposind polynomial H_2(x) = x.^2 - 1. +%! % See http://en.wikipedia.org/wiki/Hermite_polynomials#Contour_integral_representation + +%!demo +%! # Cauchy integral formula: Application to Hermite polynomials +%! # Author: Fernando Damian Nieuwveldt +%! # Edited by: Juan Pablo Carbajal +%! +%! xx = sort (rand (100,1)); +%! yy = sin (3*2*pi*xx); +%! +%! # Exact first derivative derivative +%! diffy = 6*pi*cos (3*2*pi*xx); +%! +%! np = [10 15 30 100]; +%! +%! for i =1:4 +%! idx = sort(randperm (100,np(i))); +%! x = xx(idx); +%! y = yy(idx); +%! +%! p = spline (x,y); +%! yval = ppval (ppder(p),x); +%! # Use the cauchy formula for computing the derivatives +%! deriv = cauchy (fix (np(i)/4), .1, x, @(x) sin (3*2*pi*x)); +%! +%! subplot(2,2,i) +%! h = plot(xx,diffy,'-b;Exact;',... +%! x,yval,'-or;ppder solution;',... +%! x,deriv(:,2),'-og;Cauchy formula;'); +%! set(h(1),'linewidth',2); +%! set(h(2:3),'markersize',3); +%! +%! legend(h, 'Location','Northoutside','Orientation','horizontal'); +%! if i!=1 +%! legend('hide'); +%! end +%! end +%! +%! % -------------------------------------------------------------------------- +%! % The plots compares the derivatives calculated with Cauchy and with ppder. +%! % Each subplot shows the results with increasing number of samples. diff --git a/octave_packages/optim-1.2.0/cdiff.m b/octave_packages/optim-1.2.0/cdiff.m new file mode 100644 index 0000000..7d1cab1 --- /dev/null +++ b/octave_packages/optim-1.2.0/cdiff.m @@ -0,0 +1,155 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## c = cdiff (func,wrt,N,dfunc,stack,dx) - Code for num. differentiation +## = "function df = dfunc (var1,..,dvar,..,varN) .. endfunction +## +## Returns a string of octave code that defines a function 'dfunc' that +## returns the derivative of 'func' with respect to it's 'wrt'th +## argument. +## +## The derivatives are obtained by symmetric finite difference. +## +## dfunc()'s return value is in the same format as that of ndiff() +## +## func : string : name of the function to differentiate +## +## wrt : int : position, in argument list, of the differentiation +## variable. Default:1 +## +## N : int : total number of arguments taken by 'func'. +## If N=inf, dfunc will take variable argument list. +## Default:wrt +## +## dfunc : string : Name of the octave function that returns the +## derivatives. Default:['d',func] +## +## stack : string : Indicates whether 'func' accepts vertically +## (stack="rstack") or horizontally (stack="cstack") +## arguments. Any other string indicates that 'func' +## does not allow stacking. Default:'' +## +## dx : real : Step used in the symmetric difference scheme. +## Default:10*sqrt(eps) +## +## See also : ndiff, eval, todisk + +function c = cdiff (func,wrt,nargs,dfunc,stack,dx) + +if nargin<2, + wrt = 1 ; +end +if nargin<3, + nargs = wrt ; +end +if nargin<4 || strcmp(dfunc,""), + dfunc = ["d",func] ; + if exist(dfunc)>=2, + printf(["cdiff : Warning : name of derivative not specified\n",\ + " and canonic name '%s' is already taken\n"],\ + dfunc); + ## keyboard + end +end +if nargin<5, stack = "" ; end +if nargin<6, dx = 10*sqrt(eps) ; end + +## verbose = 0 ; +## build argstr = "var1,..,dvar,...var_nargs" +if isfinite (nargs) + argstr = sprintf("var%i,",1:nargs); +else + argstr = [sprintf("var%i,",1:wrt),"...,"]; +end + +argstr = strrep(argstr,sprintf("var%i",wrt),"dvar") ; +argstr = argstr(1:length(argstr)-1) ; + +if strcmp("cstack",stack) , # Horizontal stacking ################ + + calstr = "reshape (kron(ones(1,2*ps), dvar(:))+[-dx*eye(ps),dx*eye(ps)], sz.*[1,2*ps])"; + calstr = strrep(argstr,"dvar",calstr) ; + calstr = sprintf("%s(%s)",func,calstr) ; + + calstr = sprintf(strcat(" res = %s;\n", + " pr = prod (size(res)) / (2*ps);\n", + " res = reshape (res,pr,2*ps);\n", + " df = (res(:,ps+1:2*ps)-res(:,1:ps)) / (2*dx);\n"), + calstr) ; + + +elseif strcmp("rstack",stack), # Vertical stacking ################## + + calstr = "kron(ones(2*ps,1),dvar)+dx*[-dv;dv]" ; + calstr = strrep(argstr,"dvar",calstr) ; + calstr = sprintf("%s(%s)",func,calstr) ; + + calstr = sprintf(strcat(" dv = kron (eye(sz(2)), eye(sz(1))(:));\n",\ + " res = %s;\n",\ + " sr = size(res)./[2*ps,1];\n",\ + " pr = prod (sr);\n",\ + " df = (res(sr(1)*ps+1:2*sr(1)*ps,:)-res(1:sr(1)*ps,:))/(2*dx);\n",\ + " scramble = reshape (1:pr,sr(2),sr(1))';\n",\ + " df = reshape (df',pr,ps)(scramble(:),:);\n"),\ + calstr) ; + ## sayif(verbose,"cdiff : calstr='%s'\n",calstr) ; +else # No stacking ######################## + calstr = sprintf("%s (%s)",func,argstr) ; + ## "func(var1,dvar%sdv(:,%d:%d),...,varN)," + ## calstr = strrep(calstr,"dvar","dvar%sdv(:,(i-1)*sz(2)+1:i*sz(2))")(:)'; + + calstr = strrep(calstr,"dvar","dvar%sdv")(:)'; + + ## func(..,dvar+dv(:,1:sz(2)),..) - func(..) + calstr = strcat(calstr,"-",calstr) ; ## strcat(calstr,"-",calstr) ; + calstr = sprintf(calstr,"+","-") ; + tmp = calstr ; + ## sayif(verbose,"cdiff : calstr='%s'\n",calstr) ; + calstr = sprintf(strcat(" dv = zeros (sz); dv(1) = dx;\n",\ + " df0 = %s;\n",\ + " sr = size (df0);\n",\ + " df = zeros(prod (sr),ps); df(:,1) = df0(:);\n",\ + " for i = 2:ps,\n",\ + " dv(i) = dx; dv(i-1) = 0;\n",\ + " df(:,i) = (%s)(:);\n",\ + " end;\n",\ + " df ./= 2*dx;\n" + ), + calstr, tmp) ; + + + ## sayif(verbose,"cdiff : calstr='%s'\n",calstr) ; + + ## "func(var1,reshape(dvar(1:NV,1),SZ1,SZ2),...,varN)," , + ## "func(var1,reshape(dvar(1:NV,2),SZ1,SZ2),...,varN)," , ... + ## "func(var1,reshape(dvar(1:NV,NP),SZ1,SZ2),...,varN)" + ## sayif(verbose,"cdiff : calstr='%s'\n",calstr) ; +end +argstr = strrep (argstr, "...", "varargin"); +calstr = strrep (calstr, "...", "varargin{:}"); + +c = sprintf(strcat("function df = %s (%s)\n",\ + " ## Numerical differentiation of '%s' wrt to it's %d'th argument\n",\ + " ## This function has been written by 'cdiff()'\n",\ + " dx = %e;\n",\ + " sz = size (dvar);\n",\ + " ps = prod (sz);\n",\ + "%s",\ + "endfunction\n"),\ + dfunc,argstr,\ + func,wrt,\ + dx,\ + calstr) ; + diff --git a/octave_packages/optim-1.2.0/cg_min.m b/octave_packages/optim-1.2.0/cg_min.m new file mode 100644 index 0000000..c6b559e --- /dev/null +++ b/octave_packages/optim-1.2.0/cg_min.m @@ -0,0 +1,305 @@ +## Copyright (C) 2002 Etienne Grossmann +## Copyright (C) 2009 Levente Torok +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x0},@var{v},@var{nev}]} cg_min ( @var{f},@var{df},@var{args},@var{ctl} ) +## NonLinear Conjugate Gradient method to minimize function @var{f}. +## +## @subheading Arguments +## @itemize @bullet +## @item @var{f} : string : Name of function. Return a real value +## @item @var{df} : string : Name of f's derivative. Returns a (R*C) x 1 vector +## @item @var{args}: cell : Arguments passed to f.@* +## @item @var{ctl} : 5-vec : (Optional) Control variables, described below +## @end itemize +## +## @subheading Returned values +## @itemize @bullet +## @item @var{x0} : matrix : Local minimum of f +## @item @var{v} : real : Value of f in x0 +## @item @var{nev} : 1 x 2 : Number of evaluations of f and of df +## @end itemize +## +## @subheading Control Variables +## @itemize @bullet +## @item @var{ctl}(1) : 1 or 2 : Select stopping criterion amongst : +## @item @var{ctl}(1)==0 : Default value +## @item @var{ctl}(1)==1 : Stopping criterion : Stop search when value doesn't +## improve, as tested by @math{ ctl(2) > Deltaf/max(|f(x)|,1) } +## where Deltaf is the decrease in f observed in the last iteration +## (each iteration consists R*C line searches). +## @item @var{ctl}(1)==2 : Stopping criterion : Stop search when updates are small, +## as tested by @math{ ctl(2) > max @{ dx(i)/max(|x(i)|,1) | i in 1..N @}} +## where dx is the change in the x that occured in the last iteration. +## @item @var{ctl}(2) : Threshold used in stopping tests. Default=10*eps +## @item @var{ctl}(2)==0 : Default value +## @item @var{ctl}(3) : Position of the minimized argument in args Default=1 +## @item @var{ctl}(3)==0 : Default value +## @item @var{ctl}(4) : Maximum number of function evaluations Default=inf +## @item @var{ctl}(4)==0 : Default value +## @item @var{ctl}(5) : Type of optimization: +## @item @var{ctl}(5)==1 : "Fletcher-Reves" method +## @item @var{ctl}(5)==2 : "Polak-Ribiere" (Default) +## @item @var{ctl}(5)==3 : "Hestenes-Stiefel" method +## @end itemize +## +## @var{ctl} may have length smaller than 4. Default values will be used if ctl is +## not passed or if nan values are given. +## @subheading Example: +## +## function r=df( l ) b=[1;0;-1]; r = -( 2*l@{1@} - 2*b + rand(size(l@{1@}))); endfunction @* +## function r=ff( l ) b=[1;0;-1]; r = (l@{1@}-b)' * (l@{1@}-b); endfunction @* +## ll = @{ [10; 2; 3] @}; @* +## ctl(5) = 3; @* +## [x0,v,nev]=cg_min( "ff", "df", ll, ctl ) @* +## +## Comment: In general, BFGS method seems to be better performin in many cases but requires more computation per iteration +## @seealso{ bfgsmin, http://en.wikipedia.org/wiki/Nonlinear_conjugate_gradient } +## @end deftypefn + +function [x,v,nev] = cg_min (f, dfn, args, ctl) + +verbose = 0; + +crit = 1; # Default control variables +tol = 10*eps; +narg = 1; +maxev = inf; +method = 2; + +if nargin >= 4, # Read arguments + if !isnan (ctl(1)) && ctl(1) ~= 0, crit = ctl(1); end + if length (ctl)>=2 && !isnan (ctl(2)) && ctl(2) ~= 0, tol = ctl(2); end + if length (ctl)>=3 && !isnan (ctl(3)) && ctl(3) ~= 0, narg = ctl(3); end + if length (ctl)>=4 && !isnan (ctl(4)) && ctl(4) ~= 0, maxev = ctl(4); end + if length (ctl)>=5 && !isnan (ctl(5)) && ctl(5) ~= 0, method= ctl(5); end +end + +if iscell (args), # List of arguments + x = args{narg}; +else # Single argument + x = args; + args = {args}; +end + +if narg > length (args), # Check + error ("cg_min : narg==%i, length (args)==%i\n", + narg, length (args)); +end + +[R, C] = size(x); +N = R*C; +x = reshape (x,N,1) ; + +nev = [0, 0]; + +v = feval (f, args); +nev(1)++; + +dxn = lxn = dxn_1 = -feval( dfn, args ); +nev(2)++; + +done = 0; + +## TEMP +## tb = ts = zeros (1,100); + + # Control params for line search +ctlb = [10*sqrt(eps), narg, maxev]; +if crit == 2, ctlb(1) = tol; end + +x0 = x; +v0 = v; + +nline = 0; +while nev(1) <= maxev , + ## xprev = x ; + ctlb(3) = maxev - nev(1); # Update # of evals + + + ## wiki alg 4. + [alpha, vnew, nev0] = brent_line_min (f, dxn, args, ctlb); + + nev += nev0; + ## wiki alg 5. + x = x + alpha * dxn; + + if nline >= N, + if crit == 1, + done = tol > (v0 - vnew) / max (1, abs (v0)); + else + done = tol > norm ((x-x0)(:)); + end + nline = 1; + x0 = x; + v0 = vnew; + else + nline++; + end + if done || nev(1) >= maxev, return end + + if vnew > v + eps , + printf("cg_min: step increased cost function\n"); + keyboard + end + + # if abs(1-(x-xprev)'*dxn/norm(dxn)/norm(x-xprev))>1000*eps, + # printf("cg_min: step is not in the right direction\n"); + # keyboard + # end + + # update x at the narg'th position of args cellarray + args{narg} = reshape (x, R, C); + + v = feval (f, args); + nev(1)++; + + if verbose, printf("cg_min : nev=%4i, v=%8.3g\n",nev(1),v) ; end + + ## wiki alg 1: + dxn = -feval (dfn, args); + nev(2)++; + + # wiki alg 2: + switch method + + case 1 # Fletcher-Reenves method + nu = dxn' * dxn; + de = dxn_1' * dxn_1; + + case 2 # Polak-Ribiere method + nu = (dxn-dxn_1)' * dxn; + de = dxn_1' * dxn_1; + + case 3 # Hestenes-Stiefel method + nu = (dxn-dxn_1)' * dxn; + de = (dxn-dxn_1)' * lxn; + + otherwise + error("No method like this"); + + endswitch + + if nu == 0, + return + endif + + if de == 0, + error("Numerical instability!"); + endif + beta = nu / de; + beta = max( 0, beta ); + ## wiki alg 3. update dxn, lxn, point + dxn_1 = dxn; + dxn = lxn = dxn_1 + beta*lxn ; + +end + +if verbose, printf ("cg_min: Too many evaluatiosn!\n"); end + +endfunction + +%!demo +%! P = 15; # Number of parameters +%! R = 20; # Number of observations (must have R >= P) +%! +%! obsmat = randn (R, P); +%! truep = randn (P, 1); +%! xinit = randn (P, 1); +%! obses = obsmat * truep; +%! +%! msq = @(x) mean (x (!isnan(x)).^2); +%! ff = @(x) msq (obses - obsmat * x{1}) + 1; +%! dff = @(x) 2 / rows (obses) * obsmat.' * (-obses + obsmat * x{1}); +%! +%! tic; +%! [xlev,vlev,nlev] = cg_min (ff, dff, xinit) ; +%! toc; +%! +%! printf (" Costs : init=%8.3g, final=%8.3g, best=%8.3g\n", ... +%! ff ({xinit}), vlev, ff ({truep})); +%! +%! if (max (abs (xlev-truep)) > 100*sqrt (eps)) +%! printf ("Error is too big : %8.3g\n", max (abs (xlev-truep))); +%! else +%! printf ("All tests ok\n"); +%! endif + +%!demo +%! N = 1 + floor (30 * rand ()); +%! truemin = randn (N, 1); +%! offset = 100 * randn (); +%! metric = randn (2 * N, N); +%! metric = metric.' * metric; +%! +%! if (N > 1) +%! [u,d,v] = svd (metric); +%! d = (0.1+[0:(1/(N-1)):1]).^2; +%! metric = u * diag (d) * u.'; +%! endif +%! +%! testfunc = @(x) sum((x{1}-truemin)'*metric*(x{1}-truemin)) + offset; +%! dtestf = @(x) metric' * 2*(x{1}-truemin); +%! +%! xinit = 10 * randn (N, 1); +%! +%! [x, v, niter] = cg_min (testfunc, dtestf, xinit); +%! +%! if (any (abs (x-truemin) > 100 * sqrt(eps))) +%! printf ("NOT OK 1\n"); +%! else +%! printf ("OK 1\n"); +%! endif +%! +%! if (v-offset > 1e-8) +%! printf ("NOT OK 2\n"); +%! else +%! printf ("OK 2\n"); +%! endif +%! +%! printf ("nev=%d N=%d errx=%8.3g errv=%8.3g\n",... +%! niter (1), N, max (abs (x-truemin)), v-offset); + +%!demo +%! P = 2; # Number of parameters +%! R = 3; # Number of observations +%! +%! obsmat = randn (R, P); +%! truep = randn (P, 1); +%! xinit = randn (P, 1); +%! +%! obses = obsmat * truep; +%! +%! msq = @(x) mean (x (!isnan(x)).^2); +%! ff = @(xx) msq (xx{3} - xx{2} * xx{1}) + 1; +%! dff = @(xx) 2 / rows(xx{3}) * xx{2}.' * (-xx{3} + xx{2}*xx{1}); +%! +%! tic; +%! x = {xinit, obsmat, obses}; +%! [xlev, vlev, nlev] = cg_min (ff, dff, x); +%! toc; +%! +%! xinit_ = {xinit, obsmat, obses}; +%! xtrue_ = {truep, obsmat, obses}; +%! printf (" Costs : init=%8.3g, final=%8.3g, best=%8.3g\n", ... +%! ff (xinit_), vlev, ff (xtrue_)); +%! +%! if (max (abs(xlev-truep)) > 100*sqrt (eps)) +%! printf ("Error is too big : %8.3g\n", max (abs (xlev-truep))); +%! else +%! printf ("All tests ok\n"); +%! endif + diff --git a/octave_packages/optim-1.2.0/cpiv_bard.m b/octave_packages/optim-1.2.0/cpiv_bard.m new file mode 100644 index 0000000..74ce8f2 --- /dev/null +++ b/octave_packages/optim-1.2.0/cpiv_bard.m @@ -0,0 +1,86 @@ +%% Copyright (C) 2010, 2011 Olaf Till +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% [lb, idx, ridx, mv] = cpiv_bard (v, m[, incl]) +%% +%% v: column vector; m: matrix; incl (optional): index. length (v) +%% must equal rows (m). Finds column vectors w and l with w == v + m * +%% l, w >= 0, l >= 0, l.' * w == 0. Chooses idx, w, and l so that +%% l(~idx) == 0, l(idx) == -inv (m(idx, idx)) * v(idx), w(idx) roughly +%% == 0, and w(~idx) == v(~idx) + m(idx, ~idx).' * l(idx). idx indexes +%% at least everything indexed by incl, but l(incl) may be < 0. lb: +%% l(idx) (column vector); idx: logical index, defined above; ridx: +%% ~idx & w roughly == 0; mv: [m, v] after performing a Gauss-Jordan +%% 'sweep' (with gjp.m) on each diagonal element indexed by idx. +%% Except the handling of incl (which enables handling of equality +%% constraints in the calling code), this is called solving the +%% 'complementary pivot problem' (Cottle, R. W. and Dantzig, G. B., +%% 'Complementary pivot theory of mathematical programming', Linear +%% Algebra and Appl. 1, 102--125. References for the current +%% algorithm: Bard, Y.: Nonlinear Parameter Estimation, p. 147--149, +%% Academic Press, New York and London 1974; Bard, Y., 'An eclectic +%% approach to nonlinear programming', Proc. ANU Sem. Optimization, +%% Canberra, Austral. Nat. Univ.). + +function [lb, idx, ridx, m] = cpiv_bard (v, m, incl) + + n = length (v); + if (n > size (v, 1)) + error ('first argument is no column vector'); % the most typical mistake + end + if (nargin < 3) + incl = []; + elseif (islogical (incl)) + incl = find (incl); + end + nincl = 1:n; + nincl(incl) = []; + sgn = ones (n, 1); + if (length (incl) == n) + sgn = - sgn; + m = inv (m); + m = cat (2, m, m * v); + else + m = cat (2, m, v); + for id = incl(:).' + sgn(id) = -sgn(id); + m = gjp (m, id); + end + end + nz = eps; % This is arbitrary; components of w and -l are regarded as + % non-negative if >= -nz. + nl = 100 * n; % maximum number of loop repeats, after that give up + if (isempty (nincl)) + ready = true; + else + ready = false; + while (~ready && nl > 0) + [vm, idm] = min (sgn(nincl) .* m(nincl, end)); + if (vm >= -nz) + ready = true; + else + idm = nincl(idm); + sgn(idm) = -sgn(idm); + m = gjp (m, idm); + nl = nl - 1; + end + end + end + if (~ready) + error ('not successful'); + end + idx = sgn < 0; + lb = -m(idx, end); + ridx = ~idx & abs (m(:, end)) <= nz; diff --git a/octave_packages/optim-1.2.0/curvefit_stat.m b/octave_packages/optim-1.2.0/curvefit_stat.m new file mode 100644 index 0000000..d515746 --- /dev/null +++ b/octave_packages/optim-1.2.0/curvefit_stat.m @@ -0,0 +1,76 @@ +## Copyright (C) 2011 Olaf Till +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{info} =} residmin_stat (@var{f}, @var{p}, @var{x}, @var{y}, @var{settings}) +## +## Frontend for computation of statistics for fitting of values, +## computed by a model function, to observed values. +## +## Please refer to the description of @code{residmin_stat}. The only +## differences to @code{residmin_stat} are the additional arguments +## @var{x} (independent values) and @var{y} (observations), that the +## model function @var{f}, if provided, has a second obligatory argument +## which will be set to @var{x} and is supposed to return guesses for +## the observations (with the same dimensions), and that the possibly +## user-supplied function for the jacobian of the model function has +## also a second obligatory argument which will be set to @var{x}. +## +## @seealso {residmin_stat} +## @end deftypefn + +function ret = curvefit_stat (f, pfin, x, y, settings) + + if (nargin == 1) + ret = __residmin_stat__ (f); + return; + endif + + if (nargin != 5) + print_usage () + endif + + if (compare_versions (version (), "3.3.55", "<")) + ## optimset mechanism was fixed for option names with underscores + ## sometime in 3.3.54+, if I remember right + optimget = @ __optimget__; + endif + if (! isempty (dfdp = optimget (settings, "dfdp")) && \ + ! (ismatrix (dfdp) && ! ischar (dfdp))) + if (ischar (dfdp)) + dfdp = str2func (dfdp); + endif + settings.dfdp = @ (p, varargin) dfdp (p, x, varargin{:}); + endif + if (! isempty (f)) + f = @ (p) f (p, x); + endif + + ret = __residmin_stat__ \ + (f, pfin, settings, struct ("observations", y)); + +endfunction + +function ret = __optimget__ (s, name, default) + + if (isfield (s, name)) + ret = s.(name); + elseif (nargin > 2) + ret = default; + else + ret = []; + endif + +endfunction diff --git a/octave_packages/optim-1.2.0/d2_min.m b/octave_packages/optim-1.2.0/d2_min.m new file mode 100644 index 0000000..befda03 --- /dev/null +++ b/octave_packages/optim-1.2.0/d2_min.m @@ -0,0 +1,393 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## [x,v,nev,h,args] = d2_min(f,d2f,args,ctl,code) - Newton-like minimization +## +## Minimize f(x) using 1st and 2nd derivatives. Any function w/ second +## derivatives can be minimized, as in Newton. f(x) decreases at each +## iteration, as in Levenberg-Marquardt. This function is inspired from the +## Levenberg-Marquardt algorithm found in the book "Numerical Recipes". +## +## ARGUMENTS : +## f : string : Cost function's name +## +## d2f : string : Name of function returning the cost (1x1), its +## differential (1xN) and its second differential or it's +## pseudo-inverse (NxN) (see ctl(5) below) : +## +## [v,dv,d2v] = d2f (x). +## +## args : list : f and d2f's arguments. By default, minimize the 1st +## or matrix : argument. +## +## ctl : vector : Control arguments (see below) +## or struct +## +## code : string : code will be evaluated after each outer loop that +## produced some (any) improvement. Variables visible from +## "code" include "x", the best parameter found, "v" the +## best value and "args", the list of all arguments. All can +## be modified. This option can be used to re-parameterize +## the argument space during optimization +## +## CONTROL VARIABLE ctl : (optional). May be a struct or a vector of length +## ---------------------- 5 or less where NaNs are ignored. Default values +## are written . +## FIELD VECTOR +## NAME POS +## +## ftol, f N/A : Stop search when value doesn't improve, as tested by +## +## f > Deltaf/max(|f(x)|,1) +## +## where Deltaf is the decrease in f observed in the last +## iteration. <10*sqrt(eps)> +## +## utol, u N/A : Stop search when updates are small, as tested by +## +## u > max { dx(i)/max(|x(i)|,1) | i in 1..N } +## +## where dx is the change in the x that occured in the last +## iteration. +## +## dtol, d N/A : Stop search when derivative is small, as tested by +## +## d > norm (dv) +## +## crit, c ctl(1) : Set one stopping criterion, 'ftol' (c=1), 'utol' (c=2) +## or 'dtol' (c=3) to the value of by the 'tol' option. <1> +## +## tol, t ctl(2) : Threshold in termination test chosen by 'crit' <10*eps> +## +## narg, n ctl(3) : Position of the minimized argument in args <1> +## maxev,m ctl(4) : Maximum number of function evaluations +## maxout,m : Maximum number of outer loops +## id2f, i ctl(5) : 0 if d2f returns the 2nd derivatives, 1 if <0> +## it returns its pseudo-inverse. +## +## verbose, v N/A : Be more or less verbose (quiet=0) <0> + +function [xbest,vbest,nev,hbest,args] = d2_min (f,d2f,args,ctl,code) + +maxout = inf; +maxinner = 30 ; + +tcoeff = 0.5 ; # Discount on total weight +ncoeff = 0.5 ; # Discount on weight of newton +ocoeff = 1.5 ; # Factor for outwards searching + +report = 0 ; # Never report +verbose = 0 ; # Be quiet +prudent = 1 ; # Check coherence of d2f and f? + +niter = 0 ; + +crit = 0; # Default control variables +ftol = 10 * sqrt (eps); +dtol = eps; +utol = tol = nan; +narg = 1; +maxev = inf; +id2f = 0; + +if nargin >= 4 # Read arguments + if isnumeric (ctl) + if length (ctl)>=1 && !isnan (ctl(1)), crit = ctl(1); end + if length (ctl)>=2 && !isnan (ctl(2)), tol = ctl(2); end + if length (ctl)>=3 && !isnan (ctl(3)), narg = ctl(3); end + if length (ctl)>=4 && !isnan (ctl(4)), maxev = ctl(4); end + if length (ctl)>=5 && !isnan (ctl(5)), id2f = ctl(5); end + elseif isstruct (ctl) + if isfield (ctl, "crit") , crit = ctl.crit ; end + if isfield (ctl, "tol") , tol = ctl.tol ; end + if isfield (ctl, "narg") , narg = ctl.narg ; end + if isfield (ctl, "maxev") , maxev = ctl.maxev ; end + if isfield (ctl, "maxout") , maxout = ctl.maxout ; end + if isfield (ctl, "id2f") , id2f = ctl.id2f ; end + if isfield (ctl, "verbose"), verbose = ctl.verbose; end + if isfield (ctl, "code") , code = ctl.code ; end + else + error ("The 'ctl' argument should be either a vector or a struct"); + end +end + +if crit == 1, ftol = tol; +elseif crit == 2, utol = tol; +elseif crit == 3, dtol = tol; +elseif crit, error ("crit is %i. Should be 1,2 or 3.\n"); +end + + +if nargin < 5, code = "" ; end + +if iscell (args) # List of arguments + x = args{narg}; +else # Single argument + x = args; + args = {args}; +end + +############################## Checking ############################## +if narg > length (args) + error ("d2_min : narg==%i, length (args)==%i\n", + narg, length (args)); +end + +if tol <= 0 + printf ("d2_min : tol=%8.3g <= 0\n",tol) ; +end + +if !ischar (d2f) || !ischar (f) + printf ("d2_min : f and d2f should be strings!\n"); +end + +sz = size (x); N = prod (sz); + +v = feval (f, args{:}); +nev = [1,0]; + +if prudent && (! isnumeric (v) || isnan (v) || any (size (v)>1)) + error ("Function '%s' returns inadequate output", f); +end + +xbest = x = x(:); +vold = vbest = nan ; # Values of f +hbest = nan ; # Inv. Hessian + +if verbose + printf ( "d2_min : Initially, v=%8.3g\n",v); +end + +while niter <= maxout + niter += 1; + if nev(1) < maxev, break; end; + + [v,d,h] = feval (d2f, args{1:narg-1},reshape(x,sz),args{narg+1:end}); + nev(2)++; + + if prudent && niter <= 1 && \ + (! isnumeric (v) || isnan (v) || any (size (v)>1) || \ + ! isnumeric (d) || length (d(:)) != N || \ + ! isnumeric (h) || any (size (h) != N)) + error ("Function '%s' returns inadequate output", d2f); + end + + if ! id2f, h = pinv (h); end + d = d(:); + + if prudent + v2 = feval (f, args{1:narg-1},reshape(x,sz),args{narg+1:end}); + nev(1)++; + if abs(v2-v) > 0.001 * sqrt(eps) * max (abs(v2), 1) + printf ("d2_min : f and d2f disagree %8.3g\n",abs(v2-v)); + end + end + + xbest = x ; + if ! isnan (vbest) # Check that v ==vbest + if abs (vbest - v) > 1000*eps * max (vbest, 1) + printf ("d2_min : vbest changed at beginning of outer loop\n"); + end + end + vold = vbest = v ; + hbest = h ; + + if length (code), abest = args; end # Eventually stash all args + + if verbose || (report && rem(niter,max(report,1)) == 1) + printf ("d2_min : niter=%d, v=%8.3g\n",niter,v ); + end + + if norm (d) < dtol # Check for small derivative + if verbose || report + printf ("d2_min : Exiting because of low gradient\n"); + end + break; # Exit outer loop + end + + dnewton = -h*d ; # Newton step + # Heuristic for negative hessian + if dnewton'*d > 0, dnewton = -100*d; end + wn = 1 ; # Weight of Newton step + wt = 1 ; # Total weight + + ninner = 0; + done_inner = 0; # 0=not found. 1=Ready to quit inner. + + # ########################################## + while ninner < maxinner, # Inner loop ############################### + ninner += 1; + # Proposed step + dx = wt*(wn*dnewton - (1-wn)*d) ; + xnew = x+dx ; + + if verbose + printf (["Weight : total=%8.3g, newtons's=%8.3g vbest=%8.3g ",... + "Norm:Newton=%8.3g, deriv=%8.3g\n"],... + wt,wn,vbest,norm(wt*wn*dnewton),norm(wt*(1-wn)*d)); + end + if any(isnan(xnew)) + printf ("d2_min : Whoa!! any(isnan(xnew)) (1)\n"); + end + + vnew = feval (f, args{1:narg-1},reshape(xnew,sz),args{narg+1:end}); + nev(1)++; + + if vnew= maxinner # There was a problem + if verbose + printf ( "d2_min : Too many inner loops (vnew=%8.3g)\n",vnew); + end + + # ########################################## + else # Look for improvement along dbest + wn = ocoeff ; + xnew = x+wn*dbest; + if any(isnan(xnew)), + printf ("d2_min : Whoa!! any(isnan(xnew)) (2)\n"); + end + vnew = feval (f, args{1:narg-1},reshape(xnew,sz),args{narg+1:end}); + nev(1)++; + + while vnew < vbest, + vbest = vnew; # Stash best values + wbest = wn; + xbest = xnew; + wn = wn*ocoeff ; + xnew = x+wn*dbest; + vnew = feval (f, args{1:narg-1},reshape(xnew,sz),args{narg+1:length(args)}); + if verbose + printf ( "Looking farther : v = %8.3g\n",vnew); + end + nev(1)++; + end + end # End of improving along dbest + # ########################################## + + if verbose || rem(niter,max(report,1)) == 1 + if vold, + if verbose + printf ("d2_min : Inner loop : vbest=%8.5g, vbest/vold=%8.5g\n",\ + vbest,vbest/vold); + end + else + if verbose + printf ( "d2_min : Inner loop : vbest=%8.5g, vold=0\n", vbest); + end + end + end + + if vbest < vold + ## "improvement found" + if prudent + tmpv = feval (f, args{1:narg-1},reshape(xbest,sz),args{2:end}); + nev(1)++; + + if abs (tmpv-vbest) > eps + printf ("d2_min : Whoa! Value at xbest changed by %g\n",\ + abs(tmpv-vbest)); + end + end + v = vbest; x = xbest; + if ! isempty (code) + if verbose + printf ("d2_min : Going to eval (\"%s\")\n",code); + end + + xstash = xbest; + astash = abest; + args = abest; # Here : added 2001/11/07. Is that right? + x = xbest; + eval (code, "printf (\"code fails\\n\");"); + xbest = x; + abest = args; + # Check whether eval (code) changes value + if prudent + tmpv = feval (f, args{1:narg-1},reshape(x,sz),args{2:end}); + nev(1)++; + if abs (tmpv-vbest) > max (min (100*eps,0.00001*abs(vbest)), eps) , + printf ("d2_min : Whoa! Value changes by %g after eval (code)\n",\ + abs (tmpv-vbest)); + end + end + end + end + + if ! isnan (ftol) && ftol > (vold-vbest)/max(vold,1), + if verbose || report + printf ("d2_min : Quitting, niter=%-3d v=%8.3g, ",niter,v); + if vold, printf ("v/vold=%8.3g \n",v/vold); + else printf ("vold =0 \n",v); + end + end + break ; # out of outer loop + end + if ! isnan (utol) && utol > max (abs (wbest*dbest)) / max(abs (xbest),1) + if verbose || report + printf ("d2_min : Quitting, niter=%-3d v=%8.3g, ",niter,v); + if vold, printf ("v/vold=%8.3g \n",v/vold); + else printf ("vold =0 \n",v); + end + end + break ; # out of outer loop + end +end # End of outer loop ################## + +xbest = reshape (xbest, sz); +if length (code) + args = abest; + args(narg) = xbest; +end + +if niter > maxout + if verbose + printf ( "d2_min : Outer loop lasts forever\n"); + end +end + + # One last check +if prudent + err = feval (f, args{1:narg-1},reshape(xbest,sz),args{2:end}); + nev(1)++; + + if abs (err-vbest) > eps, + printf ("d2_min : Whoa!! xbest does not eval to vbest\n"); + printf (" : %8.3e - %8.3e = %8.3e != 0\n",err,vbest,err-vbest); + end +end + diff --git a/octave_packages/optim-1.2.0/dcdp.m b/octave_packages/optim-1.2.0/dcdp.m new file mode 100644 index 0000000..417d171 --- /dev/null +++ b/octave_packages/optim-1.2.0/dcdp.m @@ -0,0 +1,42 @@ +%% Copyright (C) 2010, 2011 Olaf Till +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% function prt = dcdp (f, p, dp, func[, bounds]) +%% +%% This is an interface to __dfdp__.m, similar to dfdp.m, but for +%% functions only of parameters 'p', not of independents 'x'. See +%% dfdp.m. +%% +%% dfpdp is more general and is meant to be used instead of dcdp in +%% optimization. + +function prt = dcdp (f, p, dp, func, bounds) + + if (ischar (func)) + func = str2func (func); + end + + hook.f = f; + + if (nargin > 4) + hook.lbounds = bounds(:, 1); + hook.ubounds = bounds(:, 2); + end + + hook.diffp = abs (dp); + hook.fixed = dp == 0; + hook.diff_onesided = dp < 0; + + prt = __dfdp__ (p, func, hook); diff --git a/octave_packages/optim-1.2.0/de_min.m b/octave_packages/optim-1.2.0/de_min.m new file mode 100644 index 0000000..93b4c26 --- /dev/null +++ b/octave_packages/optim-1.2.0/de_min.m @@ -0,0 +1,451 @@ +## Copyright (C) 1996, 1997 R. Storn +## Copyright (C) 2009-2010 Christian Fischer +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## de_min: global optimisation using differential evolution +## +## Usage: [x, obj_value, nfeval, convergence] = de_min(fcn, control) +## +## minimization of a user-supplied function with respect to x(1:D), +## using the differential evolution (DE) method based on an algorithm +## by Rainer Storn (http://www.icsi.berkeley.edu/~storn/code.html) +## See: http://www.softcomputing.net/tevc2009_1.pdf +## +## +## Arguments: +## --------------- +## fcn string : Name of function. Must return a real value +## control vector : (Optional) Control variables, described below +## or struct +## +## Returned values: +## ---------------- +## x vector : parameter vector of best solution +## obj_value scalar : objective function value of best solution +## nfeval scalar : number of function evaluations +## convergence : 1 = best below value to reach (VTR) +## 0 = population has reached defined quality (tol) +## -1 = some values are close to constraints/boundaries +## -2 = max number of iterations reached (maxiter) +## -3 = max number of functions evaluations reached (maxnfe) +## +## Control variable: (optional) may be named arguments (i.e. "name",value +## ---------------- pairs), a struct, or a vector, where +## NaN's are ignored. +## +## XVmin : vector of lower bounds of initial population +## *** note: by default these are no constraints *** +## XVmax : vector of upper bounds of initial population +## constr : 1 -> enforce the bounds not just for the initial population +## const : data vector (remains fixed during the minimization) +## NP : number of population members +## F : difference factor from interval [0, 2] +## CR : crossover probability constant from interval [0, 1] +## strategy : 1 --> DE/best/1/exp 7 --> DE/best/1/bin +## 2 --> DE/rand/1/exp 8 --> DE/rand/1/bin +## 3 --> DE/target-to-best/1/exp 9 --> DE/target-to-best/1/bin +## 4 --> DE/best/2/exp 10--> DE/best/2/bin +## 5 --> DE/rand/2/exp 11--> DE/rand/2/bin +## 6 --> DEGL/SAW/exp else DEGL/SAW/bin +## refresh : intermediate output will be produced after "refresh" +## iterations. No intermediate output will be produced +## if refresh is < 1 +## VTR : Stopping criterion: "Value To Reach" +## de_min will stop when obj_value <= VTR. +## Use this if you know which value you expect. +## tol : Stopping criterion: "tolerance" +## stops if (best-worst)/max(1,worst) < tol +## This stops basically if the whole population is "good". +## maxnfe : maximum number of function evaluations +## maxiter : maximum number of iterations (generations) +## +## The algorithm seems to work well only if [XVmin,XVmax] covers the +## region where the global minimum is expected. +## DE is also somewhat sensitive to the choice of the +## difference factor F. A good initial guess is to choose F from +## interval [0.5, 1], e.g. 0.8. +## CR, the crossover probability constant from interval [0, 1] +## helps to maintain the diversity of the population and is +## rather uncritical but affects strongly the convergence speed. +## If the parameters are correlated, high values of CR work better. +## The reverse is true for no correlation. +## Experiments suggest that /bin likes to have a slightly +## larger CR than /exp. +## The number of population members NP is also not very critical. A +## good initial guess is 10*D. Depending on the difficulty of the +## problem NP can be lower than 10*D or must be higher than 10*D +## to achieve convergence. +## +## Default Values: +## --------------- +## XVmin = [-2]; +## XVmax = [ 2]; +## constr= 0; +## const = []; +## NP = 10 *D +## F = 0.8; +## CR = 0.9; +## strategy = 12; +## refresh = 0; +## VTR = -Inf; +## tol = 1.e-3; +## maxnfe = 1e6; +## maxiter = 1000; +## +## +## Example to find the minimum of the Rosenbrock saddle: +## ---------------------------------------------------- +## Define f as: +## function result = f(x); +## result = 100 * (x(2) - x(1)^2)^2 + (1 - x(1))^2; +## end +## Then type: +## +## ctl.XVmin = [-2 -2]; +## ctl.XVmax = [ 2 2]; +## [x, obj_value, nfeval, convergence] = de_min (@f, ctl); +## +## Keywords: global-optimisation optimisation minimisation + +function [bestmem, bestval, nfeval, convergence] = de_min(fcn, varargin) + +## Default options +XVmin = [-2 ]; +XVmax = [ 2 ]; +constr= 0; +const = []; +NP = 0; # NP will be set later +F = 0.8; +CR = 0.9; +strategy = 12; +refresh = 0; +VTR = -Inf; +tol = 1.e-3; +maxnfe = 1e6; +maxiter = 1000; + +## ------------ Check input variables (ctl) -------------------------------- +if nargin >= 2, # Read control arguments + va_arg_cnt = 1; + if nargin > 2, + ctl = struct (varargin{:}); + else + ctl = varargin{va_arg_cnt++}; + end + if isnumeric (ctl) + if length (ctl)>=1 && !isnan (ctl(1)), XVmin = ctl(1); end + if length (ctl)>=2 && !isnan (ctl(2)), XVmax = ctl(2); end + if length (ctl)>=3 && !isnan (ctl(3)), constr = ctl(3); end + if length (ctl)>=4 && !isnan (ctl(4)), const = ctl(4); end + if length (ctl)>=5 && !isnan (ctl(5)), NP = ctl(5); end + if length (ctl)>=6 && !isnan (ctl(6)), F = ctl(6); end + if length (ctl)>=7 && !isnan (ctl(7)), CR = ctl(7); end + if length (ctl)>=8 && !isnan (ctl(8)), strategy = ctl(8); end + if length (ctl)>=9 && !isnan (ctl(9)), refresh = ctl(9); end + if length (ctl)>=10&& !isnan (ctl(10)), VTR = ctl(10); end + if length (ctl)>=11&& !isnan (ctl(11)), tol = ctl(11); end + if length (ctl)>=12&& !isnan (ctl(12)), maxnfe = ctl(12); end + if length (ctl)>=13&& !isnan (ctl(13)), maxiter = ctl(13); end + else + if isfield (ctl,"XVmin") && !isnan (ctl.XVmin), XVmin=ctl.XVmin; end + if isfield (ctl,"XVmax") && !isnan (ctl.XVmax), XVmax=ctl.XVmax; end + if isfield (ctl,"constr")&& !isnan (ctl.constr), constr=ctl.constr; end + if isfield (ctl,"const") && !isnan (ctl.const), const=ctl.const; end + if isfield (ctl, "NP" ) && ! isnan (ctl.NP ), NP = ctl.NP ; end + if isfield (ctl, "F" ) && ! isnan (ctl.F ), F = ctl.F ; end + if isfield (ctl, "CR" ) && ! isnan (ctl.CR ), CR = ctl.CR ; end + if isfield (ctl, "strategy") && ! isnan (ctl.strategy), + strategy = ctl.strategy ; end + if isfield (ctl, "refresh") && ! isnan (ctl.refresh), + refresh = ctl.refresh ; end + if isfield (ctl, "VTR") && ! isnan (ctl.VTR ), VTR = ctl.VTR ; end + if isfield (ctl, "tol") && ! isnan (ctl.tol ), tol = ctl.tol ; end + if isfield (ctl, "maxnfe") && ! isnan (ctl.maxnfe) + maxnfe = ctl.maxnfe; + end + if isfield (ctl, "maxiter") && ! isnan (ctl.maxiter) + maxiter = ctl.maxiter; + end + end +end + +## set dimension D and population size NP +D = length (XVmin); +if (NP == 0); + NP = 10 * D; +end + +## -------- do a few sanity checks -------------------------------- +if (length (XVmin) != length (XVmax)) + error("Length of upper and lower bounds does not match.") +end +if (NP < 5) + error("Population size NP must be bigger than 5.") +end +if ((F <= 0) || (F > 2)) + error("Difference Factor F out of range (0,2].") +end +if ((CR < 0) || (CR > 1)) + error("CR value out of range [0,1].") +end +if (maxiter <= 0) + error("maxiter must be positive.") +end +if (maxnfe <= 0) + error("maxnfe must be positive.") +end +refresh = floor(abs(refresh)); + +## ----- Initialize population and some arrays -------------------------- + +pop = zeros(NP,D); # initialize pop + +## pop is a matrix of size NPxD. It will be initialized with +## random values between the min and max values of the parameters +for i = 1:NP + pop(i,:) = XVmin + rand (1,D) .* (XVmax - XVmin); +end + +## initialise the weighting factors between 0.0 and 1.0 +w = rand (NP,1); +wi = w; + +popold = zeros (size (pop)); # toggle population +val = zeros (1, NP); # create and reset the "cost array" +bestmem = zeros (1, D); # best population member ever +bestmemit = zeros (1 ,D); # best population member in iteration +nfeval = 0; # number of function evaluations + +## ------ Evaluate the best member after initialization ------------------ + +ibest = 1; # start with first population member +val(1) = feval (fcn, [pop(ibest,:) const]); +bestval = val(1); # best objective function value so far +bestw = w(1); # weighting of best design so far +for i = 2:NP # check the remaining members + val(i) = feval (fcn, [pop(i,:) const]); + if (val(i) < bestval) # if member is better + ibest = i; # save its location + bestval = val(i); + bestw = w(i); + end +end +nfeval = nfeval + NP; +bestmemit = pop(ibest,:); # best member of current iteration +bestvalit = bestval; # best value of current iteration + +bestmem = bestmemit; # best member ever + +## ------ DE - Minimization --------------------------------------- +## popold is the population which has to compete. It is static +## through one iteration. pop is the newly emerging population. + +bm_n= zeros (NP, D); # initialize bestmember matrix in neighbourh. +lpm1= zeros (NP, D); # initialize local population matrix 1 +lpm1= zeros (NP, D); # initialize local population matrix 2 +rot = 0:1:NP-1; # rotating index array (size NP) +rotd= 0:1:D-1; # rotating index array (size D) + +iter = 1; +while ((iter < maxiter) && (nfeval < maxnfe) && (bestval > VTR) && ... + ((abs (max (val) - bestval) / max (1, abs (max (val))) > tol))) + popold = pop; # save the old population + wold = w; # save the old weighting factors + + ind = randperm (4); # index pointer array + + a1 = randperm (NP); # shuffle locations of vectors + rt = rem (rot + ind(1), NP); # rotate indices by ind(1) positions + a2 = a1(rt+1); # rotate vector locations + rt = rem (rot + ind(2), NP); + a3 = a2(rt+1); + rt = rem (rot +ind(3), NP); + a4 = a3(rt+1); + rt = rem (rot + ind(4), NP); + a5 = a4(rt+1); + + pm1 = popold(a1,:); # shuffled population 1 + pm2 = popold(a2,:); # shuffled population 2 + pm3 = popold(a3,:); # shuffled population 3 + w1 = wold(a4); # shuffled weightings 1 + w2 = wold(a5); # shuffled weightings 2 + + bm = repmat (bestmemit, NP, 1); # population filled with the best member + # of the last iteration + bw = repmat (bestw, NP, 1); # the same for the weighting of the best + + mui = rand (NP, D) < CR; # mask for intermediate population + # all random numbers < CR are 1, 0 otherwise + + if (strategy > 6) + st = strategy - 6; # binomial crossover + else + st = strategy; # exponential crossover + mui = sort (mui'); # transpose, collect 1's in each column + for i = 1:NP + n = floor (rand * D); + if (n > 0) + rtd = rem (rotd + n, D); + mui(:,i) = mui(rtd+1,i); #rotate column i by n + endif + endfor + mui = mui'; # transpose back + endif + mpo = mui < 0.5; # inverse mask to mui + + if (st == 1) # DE/best/1 + ui = bm + F*(pm1 - pm2); # differential variation + elseif (st == 2) # DE/rand/1 + ui = pm3 + F*(pm1 - pm2); # differential variation + elseif (st == 3) # DE/target-to-best/1 + ui = popold + F*(bm-popold) + F*(pm1 - pm2); + elseif (st == 4) # DE/best/2 + pm4 = popold(a4,:); # shuffled population 4 + pm5 = popold(a5,:); # shuffled population 5 + ui = bm + F*(pm1 - pm2 + pm3 - pm4); # differential variation + elseif (st == 5) # DE/rand/2 + pm4 = popold(a4,:); # shuffled population 4 + pm5 = popold(a5,:); # shuffled population 5 + ui = pm5 + F*(pm1 - pm2 + pm3 - pm4); # differential variation + else # DEGL/SAW + ## The DEGL/SAW method is more complicated. + ## We have to generate a neighbourhood first. + ## The neighbourhood size is 10% of NP and at least 1. + nr = max (1, ceil ((0.1*NP -1)/2)); # neighbourhood radius + ## FIXME: I don't know how to vectorise this. - if possible + for i = 1:NP + neigh_ind = i-nr:i+nr; # index range of neighbourhood + neigh_ind = neigh_ind + ((neigh_ind <= 0)-(neigh_ind > NP))*NP; + # do wrap around + [x, ix] = min (val(neigh_ind)); # find the local best and its index + bm_n(i,:) = popold(neigh_ind(ix),:); # copy the data from the local best + neigh_ind(nr+1) = []; # remove "i" + pq = neigh_ind(randperm (length (neigh_ind))); + # permutation of the remaining ind. + lpm1(i,:) = popold(pq(1),:); # create the local pop member matrix + lpm2(i,:) = popold(pq(2),:); # for the random point p,q + endfor + ## calculate the new weihting factors + wi = wold + F*(bw - wold) + F*(w1 - w2); # use DE/target-to-best/1/nocross + # for optimisation of weightings + ## fix bounds for weightings + o = ones (NP, 1); + wi = sort ([0.05*o, wi, 0.95*o],2)(:,2); # sort and take the second column + ## fill weighting matrix + wm = repmat (wi, 1, D); + li = popold + F*(bm_n- popold) + F*(lpm1 - lpm2); + gi = popold + F*(bm - popold) + F*(pm1 - pm2); + ui = wm.*gi + (1-wm).*li; # combine global and local part + endif + ## crossover + ui = popold.*mpo + ui.*mui; + + ## enforce initial bounds/constraints if specified + if (constr == 1) + for i = 1:NP + ui(i,:) = max (ui(i,:), XVmin); + ui(i,:) = min (ui(i,:), XVmax); + end + end + + ## ----- Select which vectors are allowed to enter the new population ------ + for i = 1:NP + tempval = feval (fcn, [ui(i,:) const]); # check cost of competitor + if (tempval <= val(i)) # if competitor is better + pop(i,:) = ui(i,:); # replace old vector with new one + val(i) = tempval; # save value in "cost array" + w(i) = wi(i); # save the weighting factor + + ## we update bestval only in case of success to save time + if (tempval <= bestval) # if competitor better than the best one ever + bestval = tempval; # new best value + bestmem = ui(i,:); # new best parameter vector ever + bestw = wi(i); # save best weighting + end + end + endfor #---end for i = 1:NP + + nfeval = nfeval + NP; # increase number of function evaluations + + bestmemit = bestmem; # freeze the best member of this iteration for the + # coming iteration. This is needed for some of the + # strategies. + + ## ---- Output section ---------------------------------------------------- + + if (refresh > 0) + if (rem (iter, refresh) == 0) + printf ('Iteration: %d, Best: %8.4e, Worst: %8.4e\n', ... + iter, bestval, max(val)); + for n = 1:D + printf ('x(%d) = %e\n', n, bestmem(n)); + end + end + end + + iter = iter + 1; +endwhile #---end while ((iter < maxiter) ... + +## check that all variables are well within bounds/constraints +boundsOK = 1; +for i = 1:NP + range = XVmax - XVmin; + if (ui(i,:) < XVmin + 0.01*range) + boundsOK = 0; + end + if (ui(i,:) > XVmax - 0.01*range) + boundsOK = 0; + end +end + +## create the convergence result +if (bestval <= VTR) + convergence = 1; +elseif (abs (max (val) - bestval) / max (1, abs (max (val))) <= tol) + convergence = 0; +elseif (boundsOK == 0) + convergence = -1; +elseif (iter >= maxiter) + convergence = -2; +elseif (nfeval >= maxnfe) + convergence = -3; +end + +endfunction + +%!function result = f(x); +%! result = 100 * (x(2) - x(1)^2)^2 + (1 - x(1))^2; +%!test +%! tol = 1.0e-4; +%! ctl.tol = 0.0; +%! ctl.VTR = 1.0e-6; +%! ctl.XVmin = [-2 -2]; +%! ctl.XVmax = [ 2 2]; +%! rand("state", 11) +%! [x, obj_value, nfeval, convergence] = de_min (@f, ctl); +%! assert (convergence == 1); +%! assert (f(x) == obj_value); +%! assert (obj_value < ctl.VTR); + +%!demo +%! ## define a simple example function +%! f = @(x) peaks(x(1), x(2)); +%! ## plot the function to see where the minimum might be +%! peaks() +%! ## first we set the region where we expect the minimum +%! ctl.XVmin = [-3 -3]; +%! ctl.XVmax = [ 3 3]; +%! ## and solve it with de_min +%! [x, obj_value, nfeval, convergence] = de_min (f, ctl) diff --git a/octave_packages/optim-1.2.0/deriv.m b/octave_packages/optim-1.2.0/deriv.m new file mode 100644 index 0000000..f83eecb --- /dev/null +++ b/octave_packages/optim-1.2.0/deriv.m @@ -0,0 +1,98 @@ +## Copyright (C) 2000 Ben Sapp +## Copyright (C) 2011 Joaquín Ignacio Aramendía +## Copyright (C) 2011 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{dx} =} deriv (@var{f}, @var{x0}) +## @deftypefnx {Function File} {@var{dx} =} deriv (@var{f}, @var{x0}, @var{h}) +## @deftypefnx {Function File} {@var{dx} =} deriv (@var{f}, @var{x0}, @var{h}, @var{O}) +## @deftypefnx {Function File} {@var{dx} =} deriv (@var{f}, @var{x0}, @var{h}, @var{O}, @var{N}) +## Calculate derivate of function @var{f}. +## +## @var{f} must be a function handle or the name of a function that takes @var{x0} +## and returns a variable of equal length and orientation. @var{x0} must be a +## numeric vector or scalar. +## +## @var{h} defines the step taken for the derivative calculation. Defaults to 1e-7. +## +## @var{O} defines the order of the calculation. Supported values are 2 (h^2 order) +## or 4 (h^4 order). Defaults to 2. +## +## @var{N} defines the derivative order. Defaults to the 1st derivative of the +## function. Can be up to the 4th derivative. +## +## Reference: Numerical Methods for Mathematics, Science, and Engineering by +## John H. Mathews. +## @end deftypefn + +function dx = deriv (f, x0, h = 0.0000001, O = 2, N = 1) + + if (ischar(f)) + f = str2func(f); # let's also support a string with str2func + endif + + if (nargin < 2) + error ("Not enough arguments."); + elseif (!isa (f, 'function_handle')) + error ("The first argument 'f' must be a function handle."); + elseif (!isvector (x0) || !isnumeric (x0)) + ## a scalar is 1x1 therefore counts as a vector too + error ("The second argument 'x0' must be a numeric vector."); + elseif (!isscalar (h) || !isnumeric (h)) + error ("The third argument 'h' must be a scalar."); + elseif (!isscalar (O) || !isnumeric (O)) + error ("The fourth argument 'O' must be a scalar."); + elseif (O != 2 && O != 4) + error ("Only order 2 or 4 is supported."); + elseif (!isscalar (N) || !isnumeric (N)) + error ("The fifth argument 'N' must be a scalar."); + elseif ((N > 4) || (N < 1)) + error("Only 1st,2nd,3rd or 4th order derivatives are acceptable."); + elseif (nargin > 5) + warning("Ignoring arguements beyond the 5th."); + endif + + switch O + case (2) + switch N + case (1) + dx = (feval(f,x0+h)-feval(f,x0-h))/(2*h); + case (2) + dx = (feval(f,x0+h)-2*feval(f,x0)+feval(f,x0-h))/(h^2); + case (3) + dx = (feval(f,x0+2*h)-2*feval(f,x0+h)+2*feval(f,x0-h)-feval(f,x0-2*h))/(2*h^3); + case (4) + dx = (feval(f,x0+2*h)-4*feval(f,x0+h)+6*feval(f,x0)-4*feval(f,x0-h)+feval(f,x0-2*h))/(h^4); + otherwise + error("Only 1st,2nd,3rd or 4th order derivatives are acceptable."); + endswitch + case (4) + switch N + case (1) + dx = (-feval(f,x0+2*h)+8*feval(f,x0+h)-8*feval(f,x0-h)+feval(f,x0-2*h))/(12*h); + case (2) + dx = (-feval(f,x0+2*h)+16*feval(f,x0+h)-30*feval(f,x0)+16*feval(f,x0-h)-feval(f,x0-2*h))/(12*h^2); + case (3) + dx = (-feval(f,x0+3*h)+8*feval(f,x0+2*h)-13*feval(f,x0+h)+13*feval(f,x0-h)-8*feval(f,x0-2*h)+feval(f,x0-3*h))/(8*h^3); + case (4) + dx = (-feval(f,x0+3*h)+12*feval(f,x0+2*h)-39*feval(f,x0+h)+56*feval(f,x0)-39*feval(f,x0-h)+12*feval(f,x0-2*h)-feval(f,x0-3*h))/(6*h^4); + otherwise + error("Only 1st,2nd,3rd or 4th order derivatives are acceptable."); + endswitch + otherwise + error ("Only order 2 or 4 is supported."); + endswitch +endfunction diff --git a/octave_packages/optim-1.2.0/dfdp.m b/octave_packages/optim-1.2.0/dfdp.m new file mode 100644 index 0000000..0614c79 --- /dev/null +++ b/octave_packages/optim-1.2.0/dfdp.m @@ -0,0 +1,70 @@ +%% Copyright (C) 1992-1994 Richard Shrager +%% Copyright (C) 1992-1994 Arthur Jutan +%% Copyright (C) 1992-1994 Ray Muzic +%% Copyright (C) 2010, 2011 Olaf Till +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% function prt = dfdp (x, f, p, dp, func[, bounds]) +%% numerical partial derivatives (Jacobian) df/dp for use with leasqr +%% --------INPUT VARIABLES--------- +%% x=vec or matrix of indep var(used as arg to func) x=[x0 x1 ....] +%% f=func(x,p) vector initialsed by user before each call to dfdp +%% p= vec of current parameter values +%% dp= fractional increment of p for numerical derivatives +%% dp(j)>0 central differences calculated +%% dp(j)<0 one sided differences calculated +%% dp(j)=0 sets corresponding partials to zero; i.e. holds p(j) fixed +%% func=function (string or handle) to calculate the Jacobian for, +%% e.g. to calc Jacobian for function expsum prt=dfdp(x,f,p,dp,'expsum') +%% bounds=two-column-matrix of lower and upper bounds for parameters +%% If no 'bounds' options is specified to leasqr, it will call +%% dfdp without the 'bounds' argument. +%%----------OUTPUT VARIABLES------- +%% prt= Jacobian Matrix prt(i,j)=df(i)/dp(j) +%%================================ +%% +%% dfxpdp is more general and is meant to be used instead of dfdp in +%% optimization. + +function prt = dfdp (x, f, p, dp, func, bounds) + + %% This is just an interface. The original code has been moved to + %% __dfdp__.m, which is used with two different interfaces by + %% leasqr.m. + + %% if (ischar (varargin{5})) + %% varargin{5} = @ (p) str2func (varargin{5}) (varargin{1}, p); + %% else + %% varargin{5} = @ (p) varargin{5} (varargin{1}, p); + %% end + + if (ischar (func)) + func = @ (p) str2func (func) (x, p); + else + func = @ (p) func (x, p); + end + + hook.f = f; + + if (nargin > 5) + hook.lbound = bounds(:, 1); + hook.ubound = bounds(:, 2); + end + + hook.diffp = abs (dp); + hook.fixed = dp == 0; + hook.diff_onesided = dp < 0; + + prt = __dfdp__ (p, func, hook); diff --git a/octave_packages/optim-1.2.0/dfpdp.m b/octave_packages/optim-1.2.0/dfpdp.m new file mode 100644 index 0000000..e13124d --- /dev/null +++ b/octave_packages/optim-1.2.0/dfpdp.m @@ -0,0 +1,50 @@ +%% Copyright (C) 2010, 2011 Olaf Till +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% function jac = dfpdp (p, func[, hook]) +%% +%% Returns Jacobian of func (p) with respect to p with finite +%% differencing. The optional argument hook is a structure which can +%% contain the following fields at the moment: +%% +%% hook.f: value of func(p) for p as given in the arguments +%% +%% hook.diffp: positive vector of fractional steps from given p in +%% finite differencing (actual steps may be smaller if bounds are +%% given). The default is .001 * ones (size (p)). +%% +%% hook.diff_onesided: logical vector, indexing elements of p for +%% which only one-sided differences should be computed (faster); even +%% if not one-sided, differences might not be exactly central if +%% bounds are given. The default is false (size (p)). +%% +%% hook.fixed: logical vector, indexing elements of p for which zero +%% should be returned instead of the guessed partial derivatives +%% (useful in optimization if some parameters are not optimized, but +%% are 'fixed'). +%% +%% hook.lbound, hook.ubound: vectors of lower and upper parameter +%% bounds (or -Inf or +Inf, respectively) to be respected in finite +%% differencing. The consistency of bounds is not checked. + +function ret = dfpdp (varargin) + + %% This is an interface to __dfdp__.m. + + if (ischar (varargin{2})) + varargin{2} = str2func (varargin{2}); + end + + ret = __dfdp__ (varargin{:}); diff --git a/octave_packages/optim-1.2.0/dfxpdp.m b/octave_packages/optim-1.2.0/dfxpdp.m new file mode 100644 index 0000000..c0dfe11 --- /dev/null +++ b/octave_packages/optim-1.2.0/dfxpdp.m @@ -0,0 +1,53 @@ +%% Copyright (C) 2010, 2011 Olaf Till +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% function jac = dfxpdp (x, p, func[, hook]) +%% +%% Returns Jacobian of func (p, x) with respect to p with finite +%% differencing. The optional argument hook is a structure which can +%% contain the following fields at the moment: +%% +%% hook.f: value of func(p, x) for p and x as given in the arguments +%% +%% hook.diffp: positive vector of fractional steps from given p in +%% finite differencing (actual steps may be smaller if bounds are +%% given). The default is .001 * ones (size (p)); +%% +%% hook.diff_onesided: logical vector, indexing elements of p for +%% which only one-sided differences should be computed (faster); even +%% if not one-sided, differences might not be exactly central if +%% bounds are given. The default is false (size (p)). +%% +%% hook.fixed: logical vector, indexing elements of p for which zero +%% should be returned instead of the guessed partial derivatives +%% (useful in optimization if some parameters are not optimized, but +%% are 'fixed'). +%% +%% hook.lbound, hook.ubound: vectors of lower and upper parameter +%% bounds (or -Inf or +Inf, respectively) to be respected in finite +%% differencing. The consistency of bounds is not checked. + +function ret = dfxpdp (varargin) + + %% This is an interface to __dfdp__.m. + + if (ischar (varargin{3})) + varargin{3} = @ (p) str2func (varargin{3}) ... + (p, varargin{1}); + else + varargin{3} = @ (p) varargin{3} (p, varargin{1}); + end + + ret = __dfdp__ (varargin{2:end}); diff --git a/octave_packages/optim-1.2.0/doc-cache b/octave_packages/optim-1.2.0/doc-cache new file mode 100644 index 0000000..50d4c57 --- /dev/null +++ b/octave_packages/optim-1.2.0/doc-cache @@ -0,0 +1,3563 @@ +# Created by Octave 3.6.2, Tue Jun 12 20:02:41 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 58 +# name: +# type: sq_string +# elements: 1 +# length: 16 +LinearRegression + + +# name: +# type: sq_string +# elements: 1 +# length: 717 + general linear regression + + [p,y_var,r,p_var]=LinearRegression(F,y) + [p,y_var,r,p_var]=LinearRegression(F,y,weight) + + determine the parameters p_j (j=1,2,...,m) such that the function + f(x) = sum_(i=1,...,m) p_j*f_j(x) fits as good as possible to the + given values y_i = f(x_i) + + parameters + F n*m matrix with the values of the basis functions at the support points + in column j give the values of f_j at the points x_i (i=1,2,...,n) + y n column vector of given values + weight n column vector of given weights + + return values + p m vector with the estimated values of the parameters + y_var estimated variance of the error + r weighted norm of residual + p_var estimated variance of the parameters p_j + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 + general linear regression + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +adsmax + + +# name: +# type: sq_string +# elements: 1 +# length: 1909 +ADSMAX Alternating directions method for direct search optimization. + [x, fmax, nf] = ADSMAX(FUN, x0, STOPIT, SAVIT, P) attempts to + maximize the function FUN, using the starting vector x0. + The alternating directions direct search method is used. + Output arguments: + x = vector yielding largest function value found, + fmax = function value at x, + nf = number of function evaluations. + The iteration is terminated when either + - the relative increase in function value between successive + iterations is <= STOPIT(1) (default 1e-3), + - STOPIT(2) function evaluations have been performed + (default inf, i.e., no limit), or + - a function value equals or exceeds STOPIT(3) + (default inf, i.e., no test on function values). + Progress of the iteration is not shown if STOPIT(5) = 0 (default 1). + If a non-empty fourth parameter string SAVIT is present, then + `SAVE SAVIT x fmax nf' is executed after each inner iteration. + By default, the search directions are the co-ordinate directions. + The columns of a fifth parameter matrix P specify alternative search + directions (P = EYE is the default). + NB: x0 can be a matrix. In the output argument, in SAVIT saves, + and in function calls, x has the same shape as x0. + ADSMAX(fun, x0, STOPIT, SAVIT, P, P1, P2,...) allows additional + arguments to be passed to fun, via feval(fun,x,P1,P2,...). + Reference: + N. J. Higham, Optimization by direct search in matrix computations, + SIAM J. Matrix Anal. Appl, 14(2): 317-333, 1993. + N. J. Higham, Accuracy and Stability of Numerical Algorithms, + Second edition, Society for Industrial and Applied Mathematics, + Philadelphia, PA, 2002; sec. 20.5. + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +ADSMAX Alternating directions method for direct search optimization. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +battery + + +# name: +# type: sq_string +# elements: 1 +# length: 474 + battery.m: repeatedly call bfgs using a battery of + start values, to attempt to find global min + of a nonconvex function + + INPUTS: + func: function to mimimize + args: args of function + minarg: argument to minimize w.r.t. (usually = 1) + startvals: kxp matrix of values to try for sure (don't include all zeros, that's automatic) + max iters per start value + number of additional random start values to try + + OUTPUT: theta - the best value found - NOT iterated to convergence + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 + battery. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +bfgsmin + + +# name: +# type: sq_string +# elements: 1 +# length: 1747 + bfgsmin: bfgs or limited memory bfgs minimization of function + + Usage: [x, obj_value, convergence, iters] = bfgsmin(f, args, control) + + The function must be of the form + [value, return_2,..., return_m] = f(arg_1, arg_2,..., arg_n) + By default, minimization is w.r.t. arg_1, but it can be done + w.r.t. any argument that is a vector. Numeric derivatives are + used unless analytic derivatives are supplied. See bfgsmin_example.m + for methods. + + Arguments: + * f: name of function to minimize (string) + * args: a cell array that holds all arguments of the function + The argument with respect to which minimization is done + MUST be a vector + * control: an optional cell array of 1-8 elements. If a cell + array shorter than 8 elements is provided, the trailing elements + are provided with default values. + * elem 1: maximum iterations (positive integer, or -1 or Inf for unlimited (default)) + * elem 2: verbosity + 0 = no screen output (default) + 1 = only final results + 2 = summary every iteration + 3 = detailed information + * elem 3: convergence criterion + 1 = strict (function, gradient and param change) (default) + 0 = weak - only function convergence required + * elem 4: arg in f_args with respect to which minimization is done (default is first) + * elem 5: (optional) Memory limit for lbfgs. If it's a positive integer + then lbfgs will be use. Otherwise ordinary bfgs is used + * elem 6: function change tolerance, default 1e-12 + * elem 7: parameter change tolerance, default 1e-6 + * elem 8: gradient tolerance, default 1e-5 + + Returns: + * x: the minimizer + * obj_value: the value of f() at x + * convergence: 1 if normal conv, other values if not + * iters: number of iterations performed + + Example: see bfgsmin_example.m + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 + bfgsmin: bfgs or limited memory bfgs minimization of function + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +bfgsmin_example + + +# name: +# type: sq_string +# elements: 1 +# length: 16 + initial values + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 + initial values + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +brent_line_min + + +# name: +# type: sq_string +# elements: 1 +# length: 1186 + -- Function File: [S,V,N] brent_line_min ( F,DF,ARGS,CTL ) + Line minimization of f along df + + Finds minimum of f on line x0 + dx*w | a < w < b by bracketing. + a and b are passed through argument ctl. + +Arguments +--------- + + * F : string : Name of function. Must return a real value + + * ARGS : cell : Arguments passed to f or RxC : f's only + argument. x0 must be at ARGS{ CTL(2) } + + * CTL : 5 : (optional) Control variables, described + below. + +Returned values +--------------- + + * S : 1 : Minimum is at x0 + s*dx + + * V : 1 : Value of f at x0 + s*dx + + * NEV : 1 : Number of function evaluations + +Control Variables +----------------- + + * CTL(1) : Upper bound for error on s + Default=sqrt(eps) + + * CTL(2) : Position of minimized argument in args + Default= 1 + + * CTL(3) : Maximum number of function evaluations + Default= inf + + * CTL(4) : a + Default=-inf + + * CTL(5) : b + Default= inf + + Default values will be used if ctl is not passed or if nan values +are given. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 +Line minimization of f along df + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +cauchy + + +# name: +# type: sq_string +# elements: 1 +# length: 766 + -- Function File: cauchy (N, R, X, F ) + Return the Taylor coefficients and numerical differentiation of a + function F for the first N-1 coefficients or derivatives using the + fft. N is the number of points to evaluate, R is the radius of + convergence, needs to be chosen less then the smallest singularity, + X is point to evaluate the Taylor expansion or differentiation. + For example, + + If X is a scalar, the function F is evaluated in a row vector of + length N. If X is a column vector, F is evaluated in a matrix of + length(x)-by-N elements and must return a matrix of the same size. + + d = cauchy(16, 1.5, 0, @(x) exp(x)); + => d(2) = 1.0000 # first (2-1) derivative of function f (index starts from zero) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the Taylor coefficients and numerical differentiation of a +function F for + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +cdiff + + +# name: +# type: sq_string +# elements: 1 +# length: 1377 + c = cdiff (func,wrt,N,dfunc,stack,dx) - Code for num. differentiation + = "function df = dfunc (var1,..,dvar,..,varN) .. endfunction + + Returns a string of octave code that defines a function 'dfunc' that + returns the derivative of 'func' with respect to it's 'wrt'th + argument. + + The derivatives are obtained by symmetric finite difference. + + dfunc()'s return value is in the same format as that of ndiff() + + func : string : name of the function to differentiate + + wrt : int : position, in argument list, of the differentiation + variable. Default:1 + + N : int : total number of arguments taken by 'func'. + If N=inf, dfunc will take variable argument list. + Default:wrt + + dfunc : string : Name of the octave function that returns the + derivatives. Default:['d',func] + + stack : string : Indicates whether 'func' accepts vertically + (stack="rstack") or horizontally (stack="cstack") + arguments. Any other string indicates that 'func' + does not allow stacking. Default:'' + + dx : real : Step used in the symmetric difference scheme. + Default:10*sqrt(eps) + + See also : ndiff, eval, todisk + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 + c = cdiff (func,wrt,N,dfunc,stack,dx) - Code for num. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +cg_min + + +# name: +# type: sq_string +# elements: 1 +# length: 2479 + -- Function File: [X0,V,NEV] cg_min ( F,DF,ARGS,CTL ) + NonLinear Conjugate Gradient method to minimize function F. + +Arguments +--------- + + * F : string : Name of function. Return a real value + + * DF : string : Name of f's derivative. Returns a (R*C) x 1 + vector + + * ARGS: cell : Arguments passed to f. + * CTL : 5-vec : (Optional) Control variables, described + below + +Returned values +--------------- + + * X0 : matrix : Local minimum of f + + * V : real : Value of f in x0 + + * NEV : 1 x 2 : Number of evaluations of f and of df + +Control Variables +----------------- + + * CTL(1) : 1 or 2 : Select stopping criterion amongst : + + * CTL(1)==0 : Default value + + * CTL(1)==1 : Stopping criterion : Stop search when value + doesn't improve, as tested by ctl(2) > Deltaf/max(|f(x)|,1) + where Deltaf is the decrease in f observed in the last + iteration (each iteration consists R*C line searches). + + * CTL(1)==2 : Stopping criterion : Stop search when updates + are small, as tested by ctl(2) > max { dx(i)/max(|x(i)|,1) | + i in 1..N } where dx is the change in the x that occured in + the last iteration. + + * CTL(2) : Threshold used in stopping tests. + Default=10*eps + + * CTL(2)==0 : Default value + + * CTL(3) : Position of the minimized argument in args + Default=1 + + * CTL(3)==0 : Default value + + * CTL(4) : Maximum number of function evaluations + Default=inf + + * CTL(4)==0 : Default value + + * CTL(5) : Type of optimization: + + * CTL(5)==1 : "Fletcher-Reves" method + + * CTL(5)==2 : "Polak-Ribiere" (Default) + + * CTL(5)==3 : "Hestenes-Stiefel" method + + CTL may have length smaller than 4. Default values will be used if +ctl is not passed or if nan values are given. + +Example: +-------- + + function r=df( l ) b=[1;0;-1]; r = -( 2*l{1} - 2*b + +rand(size(l{1}))); endfunction + function r=ff( l ) b=[1;0;-1]; r = (l{1}-b)' * (l{1}-b); +endfunction + ll = { [10; 2; 3] }; + ctl(5) = 3; + [x0,v,nev]=cg_min( "ff", "df", ll, ctl ) + Comment: In general, BFGS method seems to be better performin in +many cases but requires more computation per iteration + + See also: bfgsmin, +http://en.wikipedia.org/wiki/Nonlinear_conjugate_gradient + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 +NonLinear Conjugate Gradient method to minimize function F. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +cpiv_bard + + +# name: +# type: sq_string +# elements: 1 +# length: 1197 + [lb, idx, ridx, mv] = cpiv_bard (v, m[, incl]) + + v: column vector; m: matrix; incl (optional): index. length (v) + must equal rows (m). Finds column vectors w and l with w == v + m * + l, w >= 0, l >= 0, l.' * w == 0. Chooses idx, w, and l so that + l(~idx) == 0, l(idx) == -inv (m(idx, idx)) * v(idx), w(idx) roughly + == 0, and w(~idx) == v(~idx) + m(idx, ~idx).' * l(idx). idx indexes + at least everything indexed by incl, but l(incl) may be < 0. lb: + l(idx) (column vector); idx: logical index, defined above; ridx: + ~idx & w roughly == 0; mv: [m, v] after performing a Gauss-Jordan + 'sweep' (with gjp.m) on each diagonal element indexed by idx. + Except the handling of incl (which enables handling of equality + constraints in the calling code), this is called solving the + 'complementary pivot problem' (Cottle, R. W. and Dantzig, G. B., + 'Complementary pivot theory of mathematical programming', Linear + Algebra and Appl. 1, 102--125. References for the current + algorithm: Bard, Y.: Nonlinear Parameter Estimation, p. 147--149, + Academic Press, New York and London 1974; Bard, Y., 'An eclectic + approach to nonlinear programming', Proc. ANU Sem. Optimization, + Canberra, Austral. Nat. Univ.). + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + [lb, idx, ridx, mv] = cpiv_bard (v, m[, incl]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +curvefit_stat + + +# name: +# type: sq_string +# elements: 1 +# length: 749 + -- Function File: INFO = residmin_stat (F, P, X, Y, SETTINGS) + Frontend for computation of statistics for fitting of values, + computed by a model function, to observed values. + + Please refer to the description of `residmin_stat'. The only + differences to `residmin_stat' are the additional arguments X + (independent values) and Y (observations), that the model function + F, if provided, has a second obligatory argument which will be set + to X and is supposed to return guesses for the observations (with + the same dimensions), and that the possibly user-supplied function + for the jacobian of the model function has also a second + obligatory argument which will be set to X. + + See also: residmin_stat + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Frontend for computation of statistics for fitting of values, computed +by a mode + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +d2_min + + +# name: +# type: sq_string +# elements: 1 +# length: 2782 + [x,v,nev,h,args] = d2_min(f,d2f,args,ctl,code) - Newton-like minimization + + Minimize f(x) using 1st and 2nd derivatives. Any function w/ second + derivatives can be minimized, as in Newton. f(x) decreases at each + iteration, as in Levenberg-Marquardt. This function is inspired from the + Levenberg-Marquardt algorithm found in the book "Numerical Recipes". + + ARGUMENTS : + f : string : Cost function's name + + d2f : string : Name of function returning the cost (1x1), its + differential (1xN) and its second differential or it's + pseudo-inverse (NxN) (see ctl(5) below) : + + [v,dv,d2v] = d2f (x). + + args : list : f and d2f's arguments. By default, minimize the 1st + or matrix : argument. + + ctl : vector : Control arguments (see below) + or struct + + code : string : code will be evaluated after each outer loop that + produced some (any) improvement. Variables visible from + "code" include "x", the best parameter found, "v" the + best value and "args", the list of all arguments. All can + be modified. This option can be used to re-parameterize + the argument space during optimization + + CONTROL VARIABLE ctl : (optional). May be a struct or a vector of length + ---------------------- 5 or less where NaNs are ignored. Default values + are written . + FIELD VECTOR + NAME POS + + ftol, f N/A : Stop search when value doesn't improve, as tested by + + f > Deltaf/max(|f(x)|,1) + + where Deltaf is the decrease in f observed in the last + iteration. <10*sqrt(eps)> + + utol, u N/A : Stop search when updates are small, as tested by + + u > max { dx(i)/max(|x(i)|,1) | i in 1..N } + + where dx is the change in the x that occured in the last + iteration. + + dtol, d N/A : Stop search when derivative is small, as tested by + + d > norm (dv) + + crit, c ctl(1) : Set one stopping criterion, 'ftol' (c=1), 'utol' (c=2) + or 'dtol' (c=3) to the value of by the 'tol' option. <1> + + tol, t ctl(2) : Threshold in termination test chosen by 'crit' <10*eps> + + narg, n ctl(3) : Position of the minimized argument in args <1> + maxev,m ctl(4) : Maximum number of function evaluations + maxout,m : Maximum number of outer loops + id2f, i ctl(5) : 0 if d2f returns the 2nd derivatives, 1 if <0> + it returns its pseudo-inverse. + + verbose, v N/A : Be more or less verbose (quiet=0) <0> + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 + [x,v,nev,h,args] = d2_min(f,d2f,args,ctl,code) - Newton-like minimization + + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +dcdp + + +# name: +# type: sq_string +# elements: 1 +# length: 268 + function prt = dcdp (f, p, dp, func[, bounds]) + + This is an interface to __dfdp__.m, similar to dfdp.m, but for + functions only of parameters 'p', not of independents 'x'. See + dfdp.m. + + dfpdp is more general and is meant to be used instead of dcdp in + optimization. + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + function prt = dcdp (f, p, dp, func[, bounds]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +de_min + + +# name: +# type: sq_string +# elements: 1 +# length: 4432 + de_min: global optimisation using differential evolution + + Usage: [x, obj_value, nfeval, convergence] = de_min(fcn, control) + + minimization of a user-supplied function with respect to x(1:D), + using the differential evolution (DE) method based on an algorithm + by Rainer Storn (http://www.icsi.berkeley.edu/~storn/code.html) + See: http://www.softcomputing.net/tevc2009_1.pdf + + + Arguments: + --------------- + fcn string : Name of function. Must return a real value + control vector : (Optional) Control variables, described below + or struct + + Returned values: + ---------------- + x vector : parameter vector of best solution + obj_value scalar : objective function value of best solution + nfeval scalar : number of function evaluations + convergence : 1 = best below value to reach (VTR) + 0 = population has reached defined quality (tol) + -1 = some values are close to constraints/boundaries + -2 = max number of iterations reached (maxiter) + -3 = max number of functions evaluations reached (maxnfe) + + Control variable: (optional) may be named arguments (i.e. "name",value + ---------------- pairs), a struct, or a vector, where + NaN's are ignored. + + XVmin : vector of lower bounds of initial population + *** note: by default these are no constraints *** + XVmax : vector of upper bounds of initial population + constr : 1 -> enforce the bounds not just for the initial population + const : data vector (remains fixed during the minimization) + NP : number of population members + F : difference factor from interval [0, 2] + CR : crossover probability constant from interval [0, 1] + strategy : 1 --> DE/best/1/exp 7 --> DE/best/1/bin + 2 --> DE/rand/1/exp 8 --> DE/rand/1/bin + 3 --> DE/target-to-best/1/exp 9 --> DE/target-to-best/1/bin + 4 --> DE/best/2/exp 10--> DE/best/2/bin + 5 --> DE/rand/2/exp 11--> DE/rand/2/bin + 6 --> DEGL/SAW/exp else DEGL/SAW/bin + refresh : intermediate output will be produced after "refresh" + iterations. No intermediate output will be produced + if refresh is < 1 + VTR : Stopping criterion: "Value To Reach" + de_min will stop when obj_value <= VTR. + Use this if you know which value you expect. + tol : Stopping criterion: "tolerance" + stops if (best-worst)/max(1,worst) < tol + This stops basically if the whole population is "good". + maxnfe : maximum number of function evaluations + maxiter : maximum number of iterations (generations) + + The algorithm seems to work well only if [XVmin,XVmax] covers the + region where the global minimum is expected. + DE is also somewhat sensitive to the choice of the + difference factor F. A good initial guess is to choose F from + interval [0.5, 1], e.g. 0.8. + CR, the crossover probability constant from interval [0, 1] + helps to maintain the diversity of the population and is + rather uncritical but affects strongly the convergence speed. + If the parameters are correlated, high values of CR work better. + The reverse is true for no correlation. + Experiments suggest that /bin likes to have a slightly + larger CR than /exp. + The number of population members NP is also not very critical. A + good initial guess is 10*D. Depending on the difficulty of the + problem NP can be lower than 10*D or must be higher than 10*D + to achieve convergence. + + Default Values: + --------------- + XVmin = [-2]; + XVmax = [ 2]; + constr= 0; + const = []; + NP = 10 *D + F = 0.8; + CR = 0.9; + strategy = 12; + refresh = 0; + VTR = -Inf; + tol = 1.e-3; + maxnfe = 1e6; + maxiter = 1000; + + + Example to find the minimum of the Rosenbrock saddle: + ---------------------------------------------------- + Define f as: + function result = f(x); + result = 100 * (x(2) - x(1)^2)^2 + (1 - x(1))^2; + end + Then type: + + ctl.XVmin = [-2 -2]; + ctl.XVmax = [ 2 2]; + [x, obj_value, nfeval, convergence] = de_min (@f, ctl); + + Keywords: global-optimisation optimisation minimisation + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 + de_min: global optimisation using differential evolution + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +deriv + + +# name: +# type: sq_string +# elements: 1 +# length: 820 + -- Function File: DX = deriv (F, X0) + -- Function File: DX = deriv (F, X0, H) + -- Function File: DX = deriv (F, X0, H, O) + -- Function File: DX = deriv (F, X0, H, O, N) + Calculate derivate of function F. + + F must be a function handle or the name of a function that takes X0 + and returns a variable of equal length and orientation. X0 must be + a numeric vector or scalar. + + H defines the step taken for the derivative calculation. Defaults + to 1e-7. + + O defines the order of the calculation. Supported values are 2 + (h^2 order) or 4 (h^4 order). Defaults to 2. + + N defines the derivative order. Defaults to the 1st derivative of + the function. Can be up to the 4th derivative. + + Reference: Numerical Methods for Mathematics, Science, and + Engineering by John H. Mathews. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Calculate derivate of function F. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +dfdp + + +# name: +# type: sq_string +# elements: 1 +# length: 1050 + function prt = dfdp (x, f, p, dp, func[, bounds]) + numerical partial derivatives (Jacobian) df/dp for use with leasqr + --------INPUT VARIABLES--------- + x=vec or matrix of indep var(used as arg to func) x=[x0 x1 ....] + f=func(x,p) vector initialsed by user before each call to dfdp + p= vec of current parameter values + dp= fractional increment of p for numerical derivatives + dp(j)>0 central differences calculated + dp(j)<0 one sided differences calculated + dp(j)=0 sets corresponding partials to zero; i.e. holds p(j) fixed + func=function (string or handle) to calculate the Jacobian for, + e.g. to calc Jacobian for function expsum prt=dfdp(x,f,p,dp,'expsum') + bounds=two-column-matrix of lower and upper bounds for parameters + If no 'bounds' options is specified to leasqr, it will call + dfdp without the 'bounds' argument. +----------OUTPUT VARIABLES------- + prt= Jacobian Matrix prt(i,j)=df(i)/dp(j) +================================ + + dfxpdp is more general and is meant to be used instead of dfdp in + optimization. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + function prt = dfdp (x, f, p, dp, func[, bounds]) + numerical partial derivative + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +dfpdp + + +# name: +# type: sq_string +# elements: 1 +# length: 1099 + function jac = dfpdp (p, func[, hook]) + + Returns Jacobian of func (p) with respect to p with finite + differencing. The optional argument hook is a structure which can + contain the following fields at the moment: + + hook.f: value of func(p) for p as given in the arguments + + hook.diffp: positive vector of fractional steps from given p in + finite differencing (actual steps may be smaller if bounds are + given). The default is .001 * ones (size (p)). + + hook.diff_onesided: logical vector, indexing elements of p for + which only one-sided differences should be computed (faster); even + if not one-sided, differences might not be exactly central if + bounds are given. The default is false (size (p)). + + hook.fixed: logical vector, indexing elements of p for which zero + should be returned instead of the guessed partial derivatives + (useful in optimization if some parameters are not optimized, but + are 'fixed'). + + hook.lbound, hook.ubound: vectors of lower and upper parameter + bounds (or -Inf or +Inf, respectively) to be respected in finite + differencing. The consistency of bounds is not checked. + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 + function jac = dfpdp (p, func[, hook]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +dfxpdp + + +# name: +# type: sq_string +# elements: 1 +# length: 1115 + function jac = dfxpdp (x, p, func[, hook]) + + Returns Jacobian of func (p, x) with respect to p with finite + differencing. The optional argument hook is a structure which can + contain the following fields at the moment: + + hook.f: value of func(p, x) for p and x as given in the arguments + + hook.diffp: positive vector of fractional steps from given p in + finite differencing (actual steps may be smaller if bounds are + given). The default is .001 * ones (size (p)); + + hook.diff_onesided: logical vector, indexing elements of p for + which only one-sided differences should be computed (faster); even + if not one-sided, differences might not be exactly central if + bounds are given. The default is false (size (p)). + + hook.fixed: logical vector, indexing elements of p for which zero + should be returned instead of the guessed partial derivatives + (useful in optimization if some parameters are not optimized, but + are 'fixed'). + + hook.lbound, hook.ubound: vectors of lower and upper parameter + bounds (or -Inf or +Inf, respectively) to be respected in finite + differencing. The consistency of bounds is not checked. + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 + function jac = dfxpdp (x, p, func[, hook]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +expfit + + +# name: +# type: sq_string +# elements: 1 +# length: 1621 + USAGE [alpha,c,rms] = expfit( deg, x1, h, y ) + + Prony's method for non-linear exponential fitting + + Fit function: \sum_1^{deg} c(i)*exp(alpha(i)*x) + + Elements of data vector y must correspond to + equidistant x-values starting at x1 with stepsize h + + The method is fully compatible with complex linear + coefficients c, complex nonlinear coefficients alpha + and complex input arguments y, x1, non-zero h . + Fit-order deg must be a real positive integer. + + Returns linear coefficients c, nonlinear coefficients + alpha and root mean square error rms. This method is + known to be more stable than 'brute-force' non-linear + least squares fitting. + + Example + x0 = 0; step = 0.05; xend = 5; x = x0:step:xend; + y = 2*exp(1.3*x)-0.5*exp(2*x); + error = (rand(1,length(y))-0.5)*1e-4; + [alpha,c,rms] = expfit(2,x0,step,y+error) + + alpha = + 2.0000 + 1.3000 + c = + -0.50000 + 2.00000 + rms = 0.00028461 + + The fit is very sensitive to the number of data points. + It doesn't perform very well for small data sets. + Theoretically, you need at least 2*deg data points, but + if there are errors on the data, you certainly need more. + + Be aware that this is a very (very,very) ill-posed problem. + By the way, this algorithm relies heavily on computing the + roots of a polynomial. I used 'roots.m', if there is + something better please use that code. + + Demo for a complex fit-function: + deg= 2; N= 20; x1= -(1+i), x= linspace(x1,1+i/2,N).'; + h = x(2) - x(1) + y= (2+i)*exp( (-1-2i)*x ) + (-1+3i)*exp( (2+3i)*x ); + A= 5e-2; y+= A*(randn(N,1)+randn(N,1)*i); % add complex noise + [alpha,c,rms]= expfit( deg, x1, h, y ) + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + USAGE [alpha,c,rms] = expfit( deg, x1, h, y ) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +fmin + + +# name: +# type: sq_string +# elements: 1 +# length: 19 + alias for fminbnd + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 + alias for fminbnd + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +fmins + + +# name: +# type: sq_string +# elements: 1 +# length: 1412 + -- Function File: [X] = fmins(F,X0,OPTIONS,GRAD,P1,P2, ...) + Find the minimum of a funtion of several variables. By default + the method used is the Nelder&Mead Simplex algorithm + + Example usage: fmins(inline('(x(1)-5).^2+(x(2)-8).^4'),[0;0]) + + *Inputs* + F + A string containing the name of the function to minimize + + X0 + A vector of initial parameters fo the function F. + + OPTIONS + Vector with control parameters (not all parameters are used) options(1) - Show progress (if 1, default is 0, no progress) + options(2) - Relative size of simplex (default 1e-3) + options(6) - Optimization algorithm + if options(6)==0 - Nelder & Mead simplex (default) + if options(6)==1 - Multidirectional search Method + if options(6)==2 - Alternating Directions search + options(5) + if options(6)==0 && options(5)==0 - regular simplex + if options(6)==0 && options(5)==1 - right-angled simplex + Comment: the default is set to "right-angled simplex". + this works better for me on a broad range of problems, + although the default in nmsmax is "regular simplex" + options(10) - Maximum number of function evaluations + + GRAD + Unused (For compatibility with Matlab) + + P1,P2, ... + Optional parameters for function F + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Find the minimum of a funtion of several variables. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +fminsearch + + +# name: +# type: sq_string +# elements: 1 +# length: 300 + -- Function File: X = fminsearch (FUN, X0) + -- Function File: [X, FVAL] = fminsearch (FUN, X0, OPTIONS, GRAD, P1, + P2, ...) + Find the minimum of a funtion of several variables. By default + the method used is the Nelder&Mead Simplex algorithm. + + See also: fmin, fmins, nmsmax + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Find the minimum of a funtion of several variables. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +fminunc_compat + + +# name: +# type: sq_string +# elements: 1 +# length: 1594 + [x,v,flag,out,df,d2f] = fminunc_compat (f,x,opt,...) - M*tlab-like optimization + + Imitation of m*tlab's fminunc(). The optional 'opt' argument is a struct, + e.g. produced by 'optimset()'. 'fminunc_compat' has been deprecated in + favor of 'fminunc', which is now part of core Octave. This function + will possibly be removed from future versions of the 'optim' package. + + Supported options + ----------------- + Diagnostics, [off|on] : Be verbose + Display , [off|iter|notify|final] + : Be verbose unless value is "off" + GradObj , [off|on] : Function's 2nd return value is derivatives + Hessian , [off|on] : Function's 2nd and 3rd return value are + derivatives and Hessian. + TolFun , scalar : Termination criterion (see 'ftol' in minimize()) + TolX , scalar : Termination criterion (see 'utol' in minimize()) + MaxFunEvals, int : Max. number of function evaluations + MaxIter , int : Max. number of algorithm iterations + + These non-m*tlab are provided to facilitate porting code to octave: + ----------------------- + "MinEquiv" , [off|on] : Don't minimize 'fun', but instead return the + option passed to minimize(). + + "Backend" , [off|on] : Don't minimize 'fun', but instead return + [backend, opt], the name of the backend + optimization function that is used and the + optional arguments that will be passed to it. See + the 'backend' option of minimize(). + + This function is a front-end to minimize(). + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 + [x,v,flag,out,df,d2f] = fminunc_compat (f,x,opt,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +gjp + + +# name: +# type: sq_string +# elements: 1 +# length: 829 + m = gjp (m, k[, l]) + + m: matrix; k, l: row- and column-index of pivot, l defaults to k. + + Gauss-Jordon pivot as defined in Bard, Y.: Nonlinear Parameter + Estimation, p. 296, Academic Press, New York and London 1974. In + the pivot column, this seems not quite the same as the usual + Gauss-Jordan(-Clasen) pivot. Bard gives Beaton, A. E., 'The use of + special matrix operators in statistical calculus' Research Bulletin + RB-64-51 (1964), Educational Testing Service, Princeton, New Jersey + as a reference, but this article is not easily accessible. Another + reference, whose definition of gjp differs from Bards by some + signs, is Clarke, R. B., 'Algorithm AS 178: The Gauss-Jordan sweep + operator with detection of collinearity', Journal of the Royal + Statistical Society, Series C (Applied Statistics) (1982), 31(2), + 166--168. + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 + m = gjp (m, k[, l]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +jacobs + + +# name: +# type: sq_string +# elements: 1 +# length: 1030 + -- Function File: Df = jacobs (X, F) + -- Function File: Df = jacobs (X, F, HOOK) + Calculate the jacobian of a function using the complex step method. + + Let F be a user-supplied function. Given a point X at which we + seek for the Jacobian, the function `jacobs' returns the Jacobian + matrix `d(f(1), ..., df(end))/d(x(1), ..., x(n))'. The function + uses the complex step method and thus can be applied to real + analytic functions. + + The optional argument HOOK is a structure with additional options. + HOOK can have the following fields: + * `h' - can be used to define the magnitude of the complex step + and defaults to 1e-20; steps larger than 1e-3 are not allowed. + + * `fixed' - is a logical vector internally usable by some + optimization functions; it indicates for which elements of X + no gradient should be computed, but zero should be returned. + + For example: + + f = @(x) [x(1)^2 + x(2); x(2)*exp(x(1))]; + Df = jacobs ([1, 2], f) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 +Calculate the jacobian of a function using the complex step method. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +leasqr + + +# name: +# type: sq_string +# elements: 1 +# length: 7546 +function [f,p,cvg,iter,corp,covp,covr,stdresid,Z,r2]= + leasqr(x,y,pin,F,{stol,niter,wt,dp,dFdp,options}) + + Levenberg-Marquardt nonlinear regression of f(x,p) to y(x). + + Version 3.beta + Optional parameters are in braces {}. + x = vector or matrix of independent variables. + y = vector or matrix of observed values. + wt = statistical weights (same dimensions as y). These should be + set to be proportional to (sqrt of var(y))^-1; (That is, the + covariance matrix of the data is assumed to be proportional to + diagonal with diagonal equal to (wt.^2)^-1. The constant of + proportionality will be estimated.); default = ones( size (y)). + pin = vec of initial parameters to be adjusted by leasqr. + dp = fractional increment of p for numerical partial derivatives; + default = .001*ones(size(pin)) + dp(j) > 0 means central differences on j-th parameter p(j). + dp(j) < 0 means one-sided differences on j-th parameter p(j). + dp(j) = 0 holds p(j) fixed i.e. leasqr wont change initial guess: pin(j) + F = name of function in quotes or function handle; the function + shall be of the form y=f(x,p), with y, x, p of the form y, x, pin + as described above. + dFdp = name of partial derivative function in quotes or function + handle; default is 'dfdp', a slow but general partial derivatives + function; the function shall be of the form + prt=dfdp(x,f,p,dp,F[,bounds]). For backwards compatibility, the + function will only be called with an extra 'bounds' argument if the + 'bounds' option is explicitely specified to leasqr (see dfdp.m). + stol = scalar tolerance on fractional improvement in scalar sum of + squares = sum((wt.*(y-f))^2); default stol = .0001; + niter = scalar maximum number of iterations; default = 20; + options = structure, currently recognized fields are 'fract_prec', + 'max_fract_change', 'inequc', 'bounds', and 'equc'. For backwards + compatibility, 'options' can also be a matrix whose first and + second column contains the values of 'fract_prec' and + 'max_fract_change', respectively. + Field 'options.fract_prec': column vector (same length as 'pin') + of desired fractional precisions in parameter estimates. + Iterations are terminated if change in parameter vector (chg) + relative to current parameter estimate is less than their + corresponding elements in 'options.fract_prec' [ie. all (abs + (chg) < abs (options.fract_prec .* current_parm_est))] on two + consecutive iterations, default = zeros(). + Field 'options.max_fract_change': column vector (same length as + 'pin) of maximum fractional step changes in parameter vector. + Fractional change in elements of parameter vector is constrained to + be at most 'options.max_fract_change' between sucessive iterations. + [ie. abs(chg(i))=abs(min([chg(i) + options.max_fract_change(i)*current param estimate])).], default = + Inf*ones(). + Field 'options.inequc': cell-array containing up to four entries, + two entries for linear inequality constraints and/or one or two + entries for general inequality constraints. Initial parameters + must satisfy these constraints. Either linear or general + constraints may be the first entries, but the two entries for + linear constraints must be adjacent and, if two entries are given + for general constraints, they also must be adjacent. The two + entries for linear constraints are a matrix (say m) and a vector + (say v), specifying linear inequality constraints of the form + `m.' * parameters + v >= 0'. If the constraints are just bounds, + it is suggested to specify them in 'options.bounds' instead, + since then some sanity tests are performed, and since the + function 'dfdp.m' is guarantied not to violate constraints during + determination of the numeric gradient only for those constraints + specified as 'bounds' (possibly with violations due to a certain + inaccuracy, however, except if no constraints except bounds are + specified). The first entry for general constraints must be a + differentiable vector valued function (say h), specifying general + inequality constraints of the form `h (p[, idx]) >= 0'; p is the + column vector of optimized paraters and the optional argument idx + is a logical index. h has to return the values of all constraints + if idx is not given, and has to return only the indexed + constraints if idx is given (so computation of the other + constraints can be spared). If a second entry for general + constraints is given, it must be a function (say dh) which + returnes a matrix whos rows contain the gradients of the + constraint function h with respect to the optimized parameters. + It has the form jac_h = dh (vh, p, dp, h, idx[, bounds]); p is + the column vector of optimized parameters, and idx is a logical + index --- only the rows indexed by idx must be returned (so + computation of the others can be spared). The other arguments of + dh are for the case that dh computes numerical gradients: vh is + the column vector of the current values of the constraint + function h, with idx already applied. h is a function h (p) to + compute the values of the constraints for parameters p, it will + return only the values indexed by idx. dp is a suggestion for + relative step width, having the same value as the argument 'dp' + of leasqr above. If bounds were specified to leasqr, they are + provided in the argument bounds of dh, to enable their + consideration in determination of numerical gradients. If dh is + not specified to leasqr, numerical gradients are computed in the + same way as with 'dfdp.m' (see above). If some constraints are + linear, they should be specified as linear constraints (or + bounds, if applicable) for reasons of performance, even if + general constraints are also specified. + Field 'options.bounds': two-column-matrix, one row for each + parameter in 'pin'. Each row contains a minimal and maximal value + for each parameter. Default: [-Inf, Inf] in each row. If this + field is used with an existing user-side function for 'dFdp' + (see above) the functions interface might have to be changed. + Field 'options.equc': equality constraints, specified the same + way as inequality constraints (see field 'options.inequc'). + Initial parameters must satisfy these constraints. + Note that there is possibly a certain inaccuracy in honoring + constraints, except if only bounds are specified. + _Warning_: If constraints (or bounds) are set, returned guesses + of corp, covp, and Z are generally invalid, even if no constraints + are active for the final parameters. If equality constraints are + specified, corp, covp, and Z are not guessed at all. + Field 'options.cpiv': Function for complementary pivot algorithm + for inequality constraints, default: cpiv_bard. No different + function is supplied. + + OUTPUT VARIABLES + f = column vector of values computed: f = F(x,p). + p = column vector trial or final parameters. i.e, the solution. + cvg = scalar: = 1 if convergence, = 0 otherwise. + iter = scalar number of iterations used. + corp = correlation matrix for parameters. + covp = covariance matrix of the parameters. + covr = diag(covariance matrix of the residuals). + stdresid = standardized residuals. + Z = matrix that defines confidence region (see comments in the source). + r2 = coefficient of multiple determination, intercept form. + + Not suitable for non-real residuals. + + References: + Bard, Nonlinear Parameter Estimation, Academic Press, 1974. + Draper and Smith, Applied Regression Analysis, John Wiley and Sons, 1981. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +function [f,p,cvg,iter,corp,covp,covr,stdresid,Z,r2]= + leasqr( + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +line_min + + +# name: +# type: sq_string +# elements: 1 +# length: 806 + [a,fx,nev] = line_min (f, dx, args, narg, h, nev_max) - Minimize f() along dx + + INPUT ---------- + f : string : Name of minimized function + dx : matrix : Direction along which f() is minimized + args : cell : Arguments of f + narg : integer : Position of minimized variable in args. Default=1 + h : scalar : Step size to use for centered finite difference + approximation of first and second derivatives. Default=1E-3. + nev_max : integer : Maximum number of function evaluations. Default=30 + + OUTPUT --------- + a : scalar : Value for which f(x+a*dx) is a minimum (*) + fx : scalar : Value of f(x+a*dx) at minimum (*) + nev : integer : Number of function evaluations + + (*) The notation f(x+a*dx) assumes that args == {x}. + + Reference: David G Luenberger's Linear and Nonlinear Programming + + + +# name: +# type: sq_string +# elements: 1 +# length: 79 + [a,fx,nev] = line_min (f, dx, args, narg, h, nev_max) - Minimize f() along dx + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +linprog + + +# name: +# type: sq_string +# elements: 1 +# length: 591 + -- Function File: X = linprog (F, A, B) + -- Function File: X = linprog (F, A, B, AEQ, BEQ) + -- Function File: X = linprog (F, A, B, AEQ, BEQ, LB, UB) + -- Function File: [X, FVAL] = linprog (...) + Solve a linear problem. + + Finds + + min (f' * x) + + (both f and x are column vectors) subject to + + A * x <= b + Aeq * x = beq + lb <= x <= ub + + If not specified, AEQ and BEQ default to empty matrices. + + If not specified, the lower bound LB defaults to minus infinite + and the upper bound UB defaults to infinite. + + See also: glpk + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 23 +Solve a linear problem. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +mdsmax + + +# name: +# type: sq_string +# elements: 1 +# length: 2358 +MDSMAX Multidirectional search method for direct search optimization. + [x, fmax, nf] = MDSMAX(FUN, x0, STOPIT, SAVIT) attempts to + maximize the function FUN, using the starting vector x0. + The method of multidirectional search is used. + Output arguments: + x = vector yielding largest function value found, + fmax = function value at x, + nf = number of function evaluations. + The iteration is terminated when either + - the relative size of the simplex is <= STOPIT(1) + (default 1e-3), + - STOPIT(2) function evaluations have been performed + (default inf, i.e., no limit), or + - a function value equals or exceeds STOPIT(3) + (default inf, i.e., no test on function values). + The form of the initial simplex is determined by STOPIT(4): + STOPIT(4) = 0: regular simplex (sides of equal length, the default), + STOPIT(4) = 1: right-angled simplex. + Progress of the iteration is not shown if STOPIT(5) = 0 (default 1). + If a non-empty fourth parameter string SAVIT is present, then + `SAVE SAVIT x fmax nf' is executed after each inner iteration. + NB: x0 can be a matrix. In the output argument, in SAVIT saves, + and in function calls, x has the same shape as x0. + MDSMAX(fun, x0, STOPIT, SAVIT, P1, P2,...) allows additional + arguments to be passed to fun, via feval(fun,x,P1,P2,...). + + This implementation uses 2n^2 elements of storage (two simplices), where x0 + is an n-vector. It is based on the algorithm statement in [2, sec.3], + modified so as to halve the storage (with a slight loss in readability). + + References: + [1] V. J. Torczon, Multi-directional search: A direct search algorithm for + parallel machines, Ph.D. Thesis, Rice University, Houston, Texas, 1989. + [2] V. J. Torczon, On the convergence of the multidirectional search + algorithm, SIAM J. Optimization, 1 (1991), pp. 123-145. + [3] N. J. Higham, Optimization by direct search in matrix computations, + SIAM J. Matrix Anal. Appl, 14(2): 317-333, 1993. + [4] N. J. Higham, Accuracy and Stability of Numerical Algorithms, + Second edition, Society for Industrial and Applied Mathematics, + Philadelphia, PA, 2002; sec. 20.5. + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +MDSMAX Multidirectional search method for direct search optimization. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +minimize + + +# name: +# type: sq_string +# elements: 1 +# length: 4103 + [x,v,nev,...] = minimize (f,args,...) - Minimize f + + ARGUMENTS + f : string : Name of function. Must return a real value + args : list or : List of arguments to f (by default, minimize the first) + matrix : f's only argument + + RETURNED VALUES + x : matrix : Local minimum of f. Let's suppose x is M-by-N. + v : real : Value of f in x0 + nev : integer : Number of function evaluations + or 1 x 2 : Number of function and derivative evaluations (if + derivatives are used) + + + Extra arguments are either a succession of option-value pairs or a single + list or struct of option-value pairs (for unary options, the value in the + struct is ignored). + + OPTIONS : DERIVATIVES Derivatives may be used if one of these options + --------------------- uesd. Otherwise, the Nelder-Mean (see + nelder_mead_min) method is used. + + 'd2f', d2f : Name of a function that returns the value of f, of its + 1st and 2nd derivatives : [fx,dfx,d2fx] = feval (d2f, x) + where fx is a real number, dfx is 1x(M*N) and d2fx is + (M*N)x(M*N). A Newton-like method (d2_min) will be used. + + 'hess' : Use [fx,dfx,d2fx] = leval (f, args) to compute 1st and + 2nd derivatives, and use a Newton-like method (d2_min). + + 'd2i', d2i : Name of a function that returns the value of f, of its + 1st and pseudo-inverse of second derivatives : + [fx,dfx,id2fx] = feval (d2i, x) where fx is a real + number, dfx is 1x(M*N) and d2ix is (M*N)x(M*N). + A Newton-like method will be used (see d2_min). + + 'ihess' : Use [fx,dfx,id2fx] = leval (f, args) to compute 1st + derivative and the pseudo-inverse of 2nd derivatives, + and use a Newton-like method (d2_min). + + NOTE : df, d2f or d2i take the same arguments as f. + + 'order', n : Use derivatives of order n. If the n'th order derivative + is not specified by 'df', 'd2f' or 'd2i', it will be + computed numerically. Currently, only order 1 works. + + 'ndiff' : Use a variable metric method (bfgs) using numerical + differentiation. + + OPTIONS : STOPPING CRITERIA Default is to use 'tol' + --------------------------- + 'ftol', ftol : Stop search when value doesn't improve, as tested by + + ftol > Deltaf/max(|f(x)|,1) + + where Deltaf is the decrease in f observed in the last + iteration. Default=10*eps + + 'utol', utol : Stop search when updates are small, as tested by + + tol > max { dx(i)/max(|x(i)|,1) | i in 1..N } + + where dx is the change in the x that occured in the last + iteration. + + 'dtol',dtol : Stop search when derivatives are small, as tested by + + dtol > max { df(i)*max(|x(i)|,1)/max(v,1) | i in 1..N } + + where x is the current minimum, v is func(x) and df is + the derivative of f in x. This option is ignored if + derivatives are not used in optimization. + + MISC. OPTIONS + ------------- + 'maxev', m : Maximum number of function evaluations + + 'narg' , narg : Position of the minimized argument in args <1> + 'isz' , step : Initial step size (only for 0 and 1st order method) <1> + Should correspond to expected distance to minimum + 'verbose' : Display messages during execution + + 'backend' : Instead of performing the minimization itself, return + [backend, control], the name and control argument of the + backend used by minimize(). Minimimzation can then be + obtained without the overhead of minimize by calling, if + a 0 or 1st order method is used : + + [x,v,nev] = feval (backend, args, control) + + or, if a 2nd order method is used : + + [x,v,nev] = feval (backend, control.d2f, args, control) + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + [x,v,nev,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +nelder_mead_min + + +# name: +# type: sq_string +# elements: 1 +# length: 2747 + [x0,v,nev] = nelder_mead_min (f,args,ctl) - Nelder-Mead minimization + + Minimize 'f' using the Nelder-Mead algorithm. This function is inspired + from the that found in the book "Numerical Recipes". + + ARGUMENTS + --------- + f : string : Name of function. Must return a real value + args : list : Arguments passed to f. + or matrix : f's only argument + ctl : vector : (Optional) Control variables, described below + or struct + + RETURNED VALUES + --------------- + x0 : matrix : Local minimum of f + v : real : Value of f in x0 + nev : number : Number of function evaluations + + CONTROL VARIABLE : (optional) may be named arguments (i.e. "name",value + ------------------ pairs), a struct, or a vector of length <= 6, where + NaN's are ignored. Default values are written . + OPT. VECTOR + NAME POS + ftol,f N/A : Stopping criterion : stop search when values at simplex + vertices are all alike, as tested by + + f > (max_i (f_i) - min_i (f_i)) /max(max(|f_i|),1) + + where f_i are the values of f at the vertices. <10*eps> + + rtol,r N/A : Stop search when biggest radius of simplex, using + infinity-norm, is small, as tested by : + + ctl(2) > Radius <10*eps> + + vtol,v N/A : Stop search when volume of simplex is small, tested by + + ctl(2) > Vol + + crit,c ctl(1) : Set one stopping criterion, 'ftol' (c=1), 'rtol' (c=2) + or 'vtol' (c=3) to the value of the 'tol' option. <1> + + tol, t ctl(2) : Threshold in termination test chosen by 'crit' <10*eps> + + narg ctl(3) : Position of the minimized argument in args <1> + maxev ctl(4) : Maximum number of function evaluations. This number + may be slightly exceeded. + isz ctl(5) : Size of initial simplex, which is : <1> + + { x + e_i | i in 0..N } + + Where x == args{narg} is the initial value + e_0 == zeros (size (x)), + e_i(j) == 0 if j != i and e_i(i) == ctl(5) + e_i has same size as x + + Set ctl(5) to the distance you expect between the starting + point and the minimum. + + rst ctl(6) : When a minimum is found the algorithm restarts next to + it until the minimum does not improve anymore. ctl(6) is + the maximum number of restarts. Set ctl(6) to zero if + you know the function is well-behaved or if you don't + mind not getting a true minimum. <0> + + verbose, v Be more or less verbose (quiet=0) <0> + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 + [x0,v,nev] = nelder_mead_min (f,args,ctl) - Nelder-Mead minimization + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nmsmax + + +# name: +# type: sq_string +# elements: 1 +# length: 1967 +NMSMAX Nelder-Mead simplex method for direct search optimization. + [x, fmax, nf] = NMSMAX(FUN, x0, STOPIT, SAVIT) attempts to + maximize the function FUN, using the starting vector x0. + The Nelder-Mead direct search method is used. + Output arguments: + x = vector yielding largest function value found, + fmax = function value at x, + nf = number of function evaluations. + The iteration is terminated when either + - the relative size of the simplex is <= STOPIT(1) + (default 1e-3), + - STOPIT(2) function evaluations have been performed + (default inf, i.e., no limit), or + - a function value equals or exceeds STOPIT(3) + (default inf, i.e., no test on function values). + The form of the initial simplex is determined by STOPIT(4): + STOPIT(4) = 0: regular simplex (sides of equal length, the default) + STOPIT(4) = 1: right-angled simplex. + Progress of the iteration is not shown if STOPIT(5) = 0 (default 1). + STOPIT(6) indicates the direction (ie. minimization or + maximization.) Default is 1, maximization. + set STOPIT(6)=-1 for minimization + If a non-empty fourth parameter string SAVIT is present, then + `SAVE SAVIT x fmax nf' is executed after each inner iteration. + NB: x0 can be a matrix. In the output argument, in SAVIT saves, + and in function calls, x has the same shape as x0. + NMSMAX(fun, x0, STOPIT, SAVIT, P1, P2,...) allows additional + arguments to be passed to fun, via feval(fun,x,P1,P2,...). + References: + N. J. Higham, Optimization by direct search in matrix computations, + SIAM J. Matrix Anal. Appl, 14(2): 317-333, 1993. + C. T. Kelley, Iterative Methods for Optimization, Society for Industrial + and Applied Mathematics, Philadelphia, PA, 1999. + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +NMSMAX Nelder-Mead simplex method for direct search optimization. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +nonlin_curvefit + + +# name: +# type: sq_string +# elements: 1 +# length: 1010 + -- Function File: [P, FY, CVG, OUTP] = nonlin_curvefit (F, PIN, X, Y) + -- Function File: [P, FY, CVG, OUTP] = nonlin_curvefit (F, PIN, X, Y, + SETTINGS) + Frontend for nonlinear fitting of values, computed by a model + function, to observed values. + + Please refer to the description of `nonlin_residmin'. The only + differences to `nonlin_residmin' are the additional arguments X + (independent values, mostly, but not necessarily, an array of the + same dimensions or the same number of rows as Y) and Y (array of + observations), the returned value FY (final guess for observed + values) instead of RESID, that the model function has a second + obligatory argument which will be set to X and is supposed to + return guesses for the observations (with the same dimensions), + and that the possibly user-supplied function for the jacobian of + the model function has also a second obligatory argument which + will be set to X. + + See also: nonlin_residmin + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Frontend for nonlinear fitting of values, computed by a model function, +to obser + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +nonlin_min + + +# name: +# type: sq_string +# elements: 1 +# length: 15376 + -- Function File: [P, OBJF, CVG, OUTP] = nonlin_min (F, PIN) + -- Function File: [P, OBJF, CVG, OUTP] = nonlin_min (F, PIN, SETTINGS) + Frontend for constrained nonlinear minimization of a scalar + objective function. The functions supplied by the user have a + minimal interface; any additionally needed constants can be + supplied by wrapping the user functions into anonymous functions. + + The following description applies to usage with vector-based + parameter handling. Differences in usage for structure-based + parameter handling will be explained in a separate section below. + + F: objective function. It gets a column vector of real parameters + as argument. In gradient determination, this function may be + called with an informational second argument, whose content + depends on the function for gradient determination. + + PIN: real column vector of initial parameters. + + SETTINGS: structure whose fields stand for optional settings + referred to below. The fields can be set by `optimset()' with + Octave versions 3.3.55 or greater; with older Octave versions, the + fields must be set directly as structure-fields in the correct + case. + + The returned values are the column vector of final parameters P, + the final value of the objective function OBJF, an integer CVG + indicating if and how optimization succeeded or failed, and a + structure OUTP with additional information, curently with only one + field: NITER, the number of iterations. CVG is greater than zero + for success and less than or equal to zero for failure; its + possible values depend on the used backend and currently can be + `0' (maximum number of iterations exceeded), `1' (fixed number of + iterations completed, e.g. in stochastic optimizers), `2' + (parameter change less than specified precision in two consecutive + iterations), `3' (improvement in objective function less than + specified), or `-4' (algorithm got stuck). + + SETTINGS: + + `Algorithm': String specifying the backend. Currently available + are `"lm_feasible"' (default) and `"siman"'. They are described in + separate sections below. + + `objf_grad': Function computing the gradient of the objective + function with respect to the parameters, assuming residuals are + reshaped to a vector. Default: finite differences. Will be called + with the column vector of parameters and an informational structure + as arguments. The structure has the fields `f': value of objective + function for current parameters, `fixed': logical vector + indicating which parameters are not optimized, so these partial + derivatives need not be computed and can be set to zero, `diffp', + `diff_onesided', `lbound', `ubound': identical to the user + settings of this name, `plabels': 1-dimensional cell-array of + column-cell-arrays, each column with labels for all parameters, + the first column contains the numerical indices of the parameters. + The default gradient function will call the objective function + with the second argument set with fields `f': as the `f' passed to + the gradient function, `plabels': cell-array of 1x1 cell-arrays + with the entries of the column-cell-arrays of `plabels' as passed + to the jacobian function corresponding to current parameter, + `side': `0' for one-sided interval, `1' or `2', respectively, for + the sides of a two-sided interval, and `parallel': logical scalar + indicating parallel computation of partial derivatives. + + `objf_hessian': Function computing the Hessian of the objective + function with respect to the parameters. The default is backend + specific. Will be called with the column vector of parameters as + argument. + + `diffp': column vector of fractional intervals (doubled for + central intervals) supposed to be used by gradient functions + performing finite differencing. Default: `.001 * ones (size + (parameters))'. The default gradient function will use these as + absolute intervals for parameters with value zero. + + `diff_onesided': logical column vector indicating that one-sided + intervals should be used by gradient functions performing finite + differencing. Default: `false (size (parameters))'. + + `complex_step_derivative_objf', `complex_step_derivative_inequc', + `complex_step_derivative_equc': logical scalars, default: false. + Estimate gradient of objective function, general inequality + constraints, and general equality constraints, respectively, with + complex step derivative approximation. Use only if you know that + your objective function, function of general inequality + constraints, or function of general equality constraints, + respectively, is suitable for this. No user function for the + respective gradient must be specified. + + `cstep': scalar step size for complex step derivative + approximation. Default: 1e-20. + + `fixed': logical column vector indicating which parameters should + not be optimized, but kept to their inital value. Fixing is done + independently of the backend, but the backend may choose to fix + additional parameters under certain conditions. + + `lbound', `ubound': column vectors of lower and upper bounds for + parameters. Default: `-Inf' and `+Inf', respectively. The bounds + are non-strict, i.e. parameters are allowed to be exactly equal to + a bound. The default gradient function will respect bounds (but no + further inequality constraints) in finite differencing. + + `inequc': Further inequality constraints. Cell-array containing up + to four entries, two entries for linear inequality constraints + and/or one or two entries for general inequality constraints. + Either linear or general constraints may be the first entries, but + the two entries for linear constraints must be adjacent and, if + two entries are given for general constraints, they also must be + adjacent. The two entries for linear constraints are a matrix (say + `m') and a vector (say `v'), specifying linear inequality + constraints of the form `m.' * parameters + v >= 0'. The first + entry for general constraints must be a differentiable vector + valued function (say `h'), specifying general inequality + constraints of the form `h (p[, idx]) >= 0'; `p' is the column + vector of optimized paraters and the optional argument `idx' is a + logical index. `h' has to return the values of all constraints if + `idx' is not given. It may choose to return only the indexed + constraints if `idx' is given (so computation of the other + constraints can be spared); in this case, the additional setting + `inequc_f_idx' has to be set to `true'. In gradient determination, + this function may be called with an informational third argument, + whose content depends on the function for gradient determination. + If a second entry for general inequality constraints is given, it + must be a function computing the jacobian of the constraints with + respect to the parameters. For this function, the description of + `dfdp' above applies, with 2 exceptions: 1) it is called with 3 + arguments since it has an additional argument `idx' -- a logical + index -- at second position, indicating which rows of the jacobian + must be returned (if the function chooses to return only indexed + rows, the additional setting `inequc_df_idx' has to be set to + `true'). 2) the default jacobian function calls `h' with 3 + arguments, since the argument `idx' is also supplied. Note that + specifying linear constraints as general constraints will generally + waste performance, even if further, non-linear, general constraints + are also specified. + + `equc': Equality constraints. Specified the same way as inequality + constraints (see `inequc'). The respective additional settings are + named `equc_f_idx' and `equc_df_idx'. + + `cpiv': Function for complementary pivoting, usable in algorithms + for constraints. Default: cpiv_bard. Only the default function is + supplied with the package. + + `TolFun': Minimum fractional improvement in objective function in + an iteration (abortion criterium). Default: .0001. + + `MaxIter': Maximum number of iterations (abortion criterium). + Default: backend-specific. + + `fract_prec': Column Vector, minimum fractional change of + parameters in an iteration (abortion criterium if violated in two + consecutive iterations). Default: backend-specific. + + `max_fract_change': Column Vector, enforced maximum fractional + change in parameters in an iteration. Default: backend-specific. + + `Display': String indicating the degree of verbosity. Default: + `"off"'. Possible values are currently `"off"' (no messages) and + `"iter"' (some messages after each iteration). Support of this + setting and its exact interpretation are backend-specific. + + `debug': Logical scalar, default: `false'. Will be passed to the + backend, which might print debugging information if true. + + Structure-based parameter handling + + The setting `param_order' is a cell-array with names of the + optimized parameters. If not given, and initial parameters are a + structure, all parameters in the structure are optimized. If + initial parameters are a structure, it is an error if + `param_order' is not given and there are any non-structure-based + configuration items or functions. + + The initial parameters PIN can be given as a structure containing + at least all fields named in `param_order'. In this case the + returned parameters P will also be a structure. + + Each user-supplied function can be called with the argument + containing the current parameters being a structure instead of a + column vector. For this, a corresponding setting must be set to + `true': `objf_pstruct' (objective function), `objf_grad_pstruct' + (gradient of objective function), `objf_hessian_pstruct' (hessian + of objective function), `f_inequc_pstruct' (general inequality + constraints), `df_inequc_pstruct' (jacobian of general inequality + constraints), `f_equc_pstruct' (general equality constraints), and + `df_equc_pstruct' (jacobian of general equality constraints). If a + gradient (jacobian) function is configured in such a way, it must + return the entries (columns) of the gradient (jacobian) as fields + of a structure under the respective parameter names. If the + hessian function is configured in such a way, it must return a + structure (say `h') with fields e.g. as `h.a.b = value' for + `value' being the 2nd partial derivative with respect to `a' and + `b'. There is no need to also specify the field `h.b.a' in this + example. + + Similarly, for specifying linear constraints, instead of the matrix + (called `m' above), a structure containing the rows of the matrix + in fields under the respective parameter names can be given. In + this case, rows containing only zeros need not be given. + + The vector-based settings `lbound', `ubound', `fixed', `diffp', + `diff_onesided', `fract_prec', and `max_fract_change' can be + replaced by the setting `param_config'. It is a structure that can + contain fields named in `param_order'. For each such field, there + may be subfields with the same names as the above vector-based + settings, but containing a scalar value for the respective + parameter. If `param_config' is specified, none of the above + vector/matrix-based settings may be used. + + Additionally, named parameters are allowed to be non-scalar real + arrays. In this case, their dimensions are given by the setting + `param_dims', a cell-array of dimension vectors, each containing + at least two dimensions; if not given, dimensions are taken from + the initial parameters, if these are given in a structure. Any + vector-based settings or not structure-based linear constraints + then must correspond to an order of parameters with all parameters + reshaped to vectors and concatenated in the user-given order of + parameter names. Structure-based settings or structure-based + initial parameters must contain arrays with dimensions reshapable + to those of the respective parameters. + + Description of backends + + "lm_feasible" + + A Levenberg/Marquardt-like optimizer, attempting to honour + constraints throughout the course of optimization. This means that + the initial parameters must not violate constraints (to find an + initial feasible set of parameters, e.g. Octaves `sqp' can be + used, by specifying an objective function which is constant or + which returns the quadratic distance to the initial values). If the + constraints need only be honoured in the result of the + optimization, Octaves `sqp' may be preferable. The Hessian is + either supplied by the user or is approximated by the BFGS + algorithm. + + Returned value CVG will be `2' or `3' for success and `0' or `-4' + for failure (see above for meaning). + + Backend-specific defaults are: `MaxIter': 20, `fract_prec': `zeros + (size (parameters))', `max_fract_change': `Inf' for all parameters. + + Interpretation of `Display': if set to `"iter"', currently only + information on applying `max_fract_change' is printed. + + "siman" + + A simulated annealing (stochastic) optimizer, changing all + parameters at once in a single step, so being suitable for + non-bound constraints. + + No gradient or hessian of the objective function is used. The + settings `MaxIter', `fract_prec', `TolFun', and `max_fract_change' + are not honoured. + + Accepts the additional settings `T_init' (initial temperature, + default 0.01), `T_min' (final temperature, default 1.0e-5), `mu_T' + (factor of temperature decrease, default 1.005), `iters_fixed_T' + (iterations within one temperature step, default 10), + `max_rand_step' (column vector or structure-based configuration of + maximum random steps for each parameter, default 0.005 * PIN), + `stoch_regain_constr' (if `true', regain constraints after a + random step, otherwise take new random value until constraints are + met, default false), `trace_steps' (set field `trace' of OUTP with + a matrix with a row for each step, first column iteration number, + second column repeat number within iteration, third column value + of objective function, rest columns parameter values, default + false), and `siman_log' (set field `log' of OUTP with a matrix + with a row for each iteration, first column temperature, second + column value of objective function, rest columns numbers of tries + with decrease, no decrease but accepted, and no decrease and + rejected. + + Steps with increase `diff' of objective function are accepted if + `rand (1) < exp (- diff / T)', where `T' is the temperature of the + current iteration. + + If regaining of constraints failed, optimization will be aborted + and returned value of CVG will be `0'. Otherwise, CVG will be `1'. + + Interpretation of `Display': if set to `"iter"', an informational + line is printed after each iteration. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 79 +Frontend for constrained nonlinear minimization of a scalar objective +function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +nonlin_residmin + + +# name: +# type: sq_string +# elements: 1 +# length: 12987 + -- Function File: [P, RESID, CVG, OUTP] = nonlin_residmin (F, PIN) + -- Function File: [P, RESID, CVG, OUTP] = nonlin_residmin (F, PIN, + SETTINGS) + Frontend for nonlinear minimization of residuals returned by a + model function. + + The functions supplied by the user have a minimal interface; any + additionally needed constants (e.g. observed values) can be + supplied by wrapping the user functions into anonymous functions. + + The following description applies to usage with vector-based + parameter handling. Differences in usage for structure-based + parameter handling will be explained in a separate section below. + + F: function returning the array of residuals. It gets a column + vector of real parameters as argument. In gradient determination, + this function may be called with an informational second argument, + whose content depends on the function for gradient determination. + + PIN: real column vector of initial parameters. + + SETTINGS: structure whose fields stand for optional settings + referred to below. The fields can be set by `optimset()' with + Octave versions 3.3.55 or greater; with older Octave versions, the + fields must be set directly as structure-fields in the correct + case. + + The returned values are the column vector of final parameters P, + the final array of residuals RESID, an integer CVG indicating if + and how optimization succeeded or failed, and a structure OUTP + with additional information, curently with only one field: NITER, + the number of iterations. CVG is greater than zero for success and + less than or equal to zero for failure; its possible values depend + on the used backend and currently can be `0' (maximum number of + iterations exceeded), `2' (parameter change less than specified + precision in two consecutive iterations), or `3' (improvement in + objective function -- e.g. sum of squares -- less than specified). + + SETTINGS: + + `Algorithm': String specifying the backend. Default: + `"lm_svd_feasible"'. The latter is currently the only backend + distributed with this package. It is described in a separate + section below. + + `dfdp': Function computing the jacobian of the residuals with + respect to the parameters, assuming residuals are reshaped to a + vector. Default: finite differences. Will be called with the column + vector of parameters and an informational structure as arguments. + The structure has the fields `f': value of residuals for current + parameters, reshaped to a column vector, `fixed': logical vector + indicating which parameters are not optimized, so these partial + derivatives need not be computed and can be set to zero, `diffp', + `diff_onesided', `lbound', `ubound': identical to the user + settings of this name, `plabels': 1-dimensional cell-array of + column-cell-arrays, each column with labels for all parameters, + the first column contains the numerical indices of the parameters. + The default jacobian function will call the model function with + the second argument set with fields `f': as the `f' passed to the + jacobian function, `plabels': cell-array of 1x1 cell-arrays with + the entries of the column-cell-arrays of `plabels' as passed to + the jacobian function corresponding to current parameter, `side': + `0' for one-sided interval, `1' or `2', respectively, for the + sides of a two-sided interval, and `parallel': logical scalar + indicating parallel computation of partial derivatives. + + `diffp': column vector of fractional intervals (doubled for + central intervals) supposed to be used by jacobian functions + performing finite differencing. Default: `.001 * ones (size + (parameters))'. The default jacobian function will use these as + absolute intervals for parameters with value zero. + + `diff_onesided': logical column vector indicating that one-sided + intervals should be used by jacobian functions performing finite + differencing. Default: `false (size (parameters))'. + + `complex_step_derivative_f', `complex_step_derivative_inequc', + `complex_step_derivative_equc': logical scalars, default: false. + Estimate Jacobian of model function, general inequality + constraints, and general equality constraints, respectively, with + complex step derivative approximation. Use only if you know that + your model function, function of general inequality constraints, + or function of general equality constraints, respectively, is + suitable for this. No user function for the respective Jacobian + must be specified. + + `cstep': scalar step size for complex step derivative + approximation. Default: 1e-20. + + `fixed': logical column vector indicating which parameters should + not be optimized, but kept to their inital value. Fixing is done + independently of the backend, but the backend may choose to fix + additional parameters under certain conditions. + + `lbound', `ubound': column vectors of lower and upper bounds for + parameters. Default: `-Inf' and `+Inf', respectively. The bounds + are non-strict, i.e. parameters are allowed to be exactly equal to + a bound. The default jacobian function will respect bounds (but no + further inequality constraints) in finite differencing. + + `inequc': Further inequality constraints. Cell-array containing up + to four entries, two entries for linear inequality constraints + and/or one or two entries for general inequality constraints. + Either linear or general constraints may be the first entries, but + the two entries for linear constraints must be adjacent and, if + two entries are given for general constraints, they also must be + adjacent. The two entries for linear constraints are a matrix (say + `m') and a vector (say `v'), specifying linear inequality + constraints of the form `m.' * parameters + v >= 0'. The first + entry for general constraints must be a differentiable vector + valued function (say `h'), specifying general inequality + constraints of the form `h (p[, idx]) >= 0'; `p' is the column + vector of optimized paraters and the optional argument `idx' is a + logical index. `h' has to return the values of all constraints if + `idx' is not given. It may choose to return only the indexed + constraints if `idx' is given (so computation of the other + constraints can be spared); in this case, the additional setting + `inequc_f_idx' has to be set to `true'. In gradient determination, + this function may be called with an informational third argument, + whose content depends on the function for gradient determination. + If a second entry for general inequality constraints is given, it + must be a function computing the jacobian of the constraints with + respect to the parameters. For this function, the description of + `dfdp' above applies, with 2 exceptions: 1) it is called with 3 + arguments since it has an additional argument `idx' -- a logical + index -- at second position, indicating which rows of the jacobian + must be returned (if the function chooses to return only indexed + rows, the additional setting `inequc_df_idx' has to be set to + `true'). 2) the default jacobian function calls `h' with 3 + arguments, since the argument `idx' is also supplied. Note that + specifying linear constraints as general constraints will generally + waste performance, even if further, non-linear, general constraints + are also specified. + + `equc': Equality constraints. Specified the same way as inequality + constraints (see `inequc'). + + `cpiv': Function for complementary pivoting, usable in algorithms + for constraints. Default: cpiv_bard. Only the default function is + supplied with the package. + + `weights': Array of weights for the residuals. Dimensions must + match. + + `TolFun': Minimum fractional improvement in objective function + (e.g. sum of squares) in an iteration (abortion criterium). + Default: .0001. + + `MaxIter': Maximum number of iterations (abortion criterium). + Default: backend-specific. + + `fract_prec': Column Vector, minimum fractional change of + parameters in an iteration (abortion criterium if violated in two + consecutive iterations). Default: backend-specific. + + `max_fract_change': Column Vector, enforced maximum fractional + change in parameters in an iteration. Default: backend-specific. + + `Display': String indicating the degree of verbosity. Default: + `"off"'. Possible values are currently `"off"' (no messages) and + `"iter"' (some messages after each iteration). Support of this + setting and its exact interpretation are backend-specific. + + `plot_cmd': Function enabling backend to plot results or + intermediate results. Will be called with current computed + residuals. Default: plot nothing. + + `debug': Logical scalar, default: `false'. Will be passed to the + backend, which might print debugging information if true. + + Structure-based parameter handling + + The setting `param_order' is a cell-array with names of the + optimized parameters. If not given, and initial parameters are a + structure, all parameters in the structure are optimized. If + initial parameters are a structure, it is an error if + `param_order' is not given and there are any non-structure-based + configuration items or functions. + + The initial parameters PIN can be given as a structure containing + at least all fields named in `param_order'. In this case the + returned parameters P will also be a structure. + + Each user-supplied function can be called with the argument + containing the current parameters being a structure instead of a + column vector. For this, a corresponding setting must be set to + `true': `f_pstruct' (model function), `dfdp_pstruct' (jacobian of + model function), `f_inequc_pstruct' (general inequality + constraints), `df_inequc_pstruct' (jacobian of general inequality + constraints), `f_equc_pstruct' (general equality constraints), and + `df_equc_pstruct' (jacobian of general equality constraints). If a + jacobian-function is configured in such a way, it must return the + columns of the jacobian as fields of a structure under the + respective parameter names. + + Similarly, for specifying linear constraints, instead of the matrix + (called `m' above), a structure containing the rows of the matrix + in fields under the respective parameter names can be given. In + this case, rows containing only zeros need not be given. + + The vector-based settings `lbound', `ubound', `fixed', `diffp', + `diff_onesided', `fract_prec', and `max_fract_change' can be + replaced by the setting `param_config'. It is a structure that can + contain fields named in `param_order'. For each such field, there + may be subfields with the same names as the above vector-based + settings, but containing a scalar value for the respective + parameter. If `param_config' is specified, none of the above + vector/matrix-based settings may be used. + + Additionally, named parameters are allowed to be non-scalar real + arrays. In this case, their dimensions are given by the setting + `param_dims', a cell-array of dimension vectors, each containing + at least two dimensions; if not given, dimensions are taken from + the initial parameters, if these are given in a structure. Any + vector-based settings or not structure-based linear constraints + then must correspond to an order of parameters with all parameters + reshaped to vectors and concatenated in the user-given order of + parameter names. Structure-based settings or structure-based + initial parameters must contain arrays with dimensions reshapable + to those of the respective parameters. + + Description of backends (currently only one) + + "lm_svd_feasible" + + A Levenberg/Marquardt algorithm using singular value decomposition + and featuring constraints which must be met by the initial + parameters and are attempted to be kept met throughout the + optimization. + + Parameters with identical lower and upper bounds will be fixed. + + Returned value CVG will be `0', `2', or `3'. + + Backend-specific defaults are: `MaxIter': 20, `fract_prec': `zeros + (size (parameters))', `max_fract_change': `Inf' for all parameters. + + Interpretation of `Display': if set to `"iter"', currently + `plot_cmd' is evaluated for each iteration, and some further + diagnostics may be printed. + + Specific option: `lm_svd_feasible_alt_s': if falling back to + nearly gradient descent, do it more like original + Levenberg/Marquardt method, with descent in each gradient + component; for testing only. + + See also: nonlin_curvefit + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 78 +Frontend for nonlinear minimization of residuals returned by a model +function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +nrm + + +# name: +# type: sq_string +# elements: 1 +# length: 153 + -- Function File: XMIN = nrm(F,X0) + Using X0 as a starting point find a minimum of the scalar function + F. The Newton-Raphson method is used. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +Using X0 as a starting point find a minimum of the scalar function F. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +optim_problems + + +# name: +# type: sq_string +# elements: 1 +# length: 64 + Problems for testing optimizers. Documentation is in the code. + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 + Problems for testing optimizers. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +optimset_compat + + +# name: +# type: sq_string +# elements: 1 +# length: 1208 + opt = optimset_compat (...) - manipulate m*tlab-style options structure + + This function returns a m*tlab-style options structure that can be used + with the fminunc() function. 'optimset_compat' has been deprecated in + favor of 'optimset', which is now part of core Octave. This function + will possibly be removed from future versions of the 'optim' package. + + INPUT : Input consist in one or more structs followed by option-value + pairs. The option that can be passed are those of m*tlab's 'optimset'. + Whether fminunc() accepts them is another question (see fminunc()). + + Two extra options are supported which indicate how to use directly octave + optimization tools (such as minimize() and other backends): + + "MinEquiv", [on|off] : Tell 'fminunc()' not to minimize 'fun', but + instead return the option passed to minimize(). + + "Backend", [on|off] : Tell 'fminunc()' not to minimize 'fun', but + instead return the [backend, opt], the name of the + backend optimization function that is used and the + optional arguments that will be passed to it. See + the 'backend' option of minimize(). + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 + opt = optimset_compat (. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +poly_2_ex + + +# name: +# type: sq_string +# elements: 1 +# length: 353 + ex = poly_2_ex (l, f) - Extremum of a 1-var deg-2 polynomial + + l : 3 : Values of variable at which polynomial is known. + f : 3 : f(i) = Value of the degree-2 polynomial at l(i). + + ex : 1 : Value for which f reaches its extremum + + Assuming that f(i) = a*l(i)^2 + b*l(i) + c = P(l(i)) for some a, b, c, + ex is the extremum of the polynome P. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 + ex = poly_2_ex (l, f) - Extremum of a 1-var deg-2 polynomial + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +polyconf + + +# name: +# type: sq_string +# elements: 1 +# length: 1439 + [y,dy] = polyconf(p,x,s) + + Produce prediction intervals for the fitted y. The vector p + and structure s are returned from polyfit or wpolyfit. The + x values are where you want to compute the prediction interval. + + polyconf(...,['ci'|'pi']) + + Produce a confidence interval (range of likely values for the + mean at x) or a prediction interval (range of likely values + seen when measuring at x). The prediction interval tells + you the width of the distribution at x. This should be the same + regardless of the number of measurements you have for the value + at x. The confidence interval tells you how well you know the + mean at x. It should get smaller as you increase the number of + measurements. Error bars in the physical sciences usually show + a 1-alpha confidence value of erfc(1/sqrt(2)), representing + one standandard deviation of uncertainty in the mean. + + polyconf(...,1-alpha) + + Control the width of the interval. If asking for the prediction + interval 'pi', the default is .05 for the 95% prediction interval. + If asking for the confidence interval 'ci', the default is + erfc(1/sqrt(2)) for a one standard deviation confidence interval. + + Example: + [p,s] = polyfit(x,y,1); + xf = linspace(x(1),x(end),150); + [yf,dyf] = polyconf(p,xf,s,'ci'); + plot(xf,yf,'g-;fit;',xf,yf+dyf,'g.;;',xf,yf-dyf,'g.;;',x,y,'xr;data;'); + plot(x,y-polyval(p,x),';residuals;',xf,dyf,'g-;;',xf,-dyf,'g-;;'); + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 + [y,dy] = polyconf(p,x,s) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +polyfitinf + + +# name: +# type: sq_string +# elements: 1 +# length: 4746 + function [A,REF,HMAX,H,R,EQUAL] = polyfitinf(M,N,K,X,Y,EPSH,MAXIT,REF0) + + Best polynomial approximation in discrete uniform norm + + INPUT VARIABLES: + + M : degree of the fitting polynomial + N : number of data points + X(N) : x-coordinates of data points + Y(N) : y-coordinates of data points + K : character of the polynomial: + K = 0 : mixed parity polynomial + K = 1 : odd polynomial ( X(1) must be > 0 ) + K = 2 : even polynomial ( X(1) must be >= 0 ) + EPSH : tolerance for leveling. A useful value for 24-bit + mantissa is EPSH = 2.0E-7 + MAXIT : upper limit for number of exchange steps + REF0(M2): initial alternating set ( N-vector ). This is an + OPTIONAL argument. The length M2 is given by: + M2 = M + 2 , if K = 0 + M2 = integer part of (M+3)/2 , if K = 1 + M2 = 2 + M/2 (M must be even) , if K = 2 + + OUTPUT VARIABLES: + + A : polynomial coefficients of the best approximation + in order of increasing powers: + p*(x) = A(1) + A(2)*x + A(3)*x^2 + ... + REF : selected alternating set of points + HMAX : maximum deviation ( uniform norm of p* - f ) + H : pointwise approximation errors + R : total number of iterations + EQUAL : success of failure of algorithm + EQUAL=1 : succesful + EQUAL=0 : convergence not acheived + EQUAL=-1: input error + EQUAL=-2: algorithm failure + + Relies on function EXCH, provided below. + + Example: + M = 5; N = 10000; K = 0; EPSH = 10^-12; MAXIT = 10; + X = linspace(-1,1,N); % uniformly spaced nodes on [-1,1] + k=1; Y = abs(X).^k; % the function Y to approximate + [A,REF,HMAX,H,R,EQUAL] = polyfitinf(M,N,K,X,Y,EPSH,MAXIT); + p = polyval(A,X); plot(X,Y,X,p) % p is the best approximation + + Note: using an even value of M, e.g., M=2, in the example above, makes + the algorithm to fail with EQUAL=-2, because of collocation, which + appears because both the appriximating function and the polynomial are + even functions. The way aroung it is to approximate only the right half + of the function, setting K = 2 : even polynomial. For example: + + N = 10000; K = 2; EPSH = 10^-12; MAXIT = 10; X = linspace(0,1,N); + for i = 1:2 + k = 2*i-1; Y = abs(X).^k; + for j = 1:4 + M = 2^j; + [~,~,HMAX] = polyfitinf(M,N,K,X,Y,EPSH,MAXIT); + approxerror(i,j) = HMAX; + end + end + disp('Table 3.1 from Approximation theory and methods, M.J.D.POWELL, p. 27'); + disp(' '); + disp(' n K=1 K=3'); + disp(' '); format short g; + disp([(2.^(1:4))' approxerror']); + + ALGORITHM: + + Computation of the polynomial that best approximates the data (X,Y) + in the discrete uniform norm, i.e. the polynomial with the minimum + value of max{ | p(x_i) - y_i | , x_i in X } . That polynomial, also + known as minimax polynomial, is obtained by the exchange algorithm, + a finite iterative process requiring, at most, + n + ( ) iterations ( usually p = M + 2. See also function EXCH ). + p + since this number can be very large , the routine may not converge + within MAXIT iterations . The other possibility of failure occurs + when there is insufficient floating point precision for the input + data chosen. + + CREDITS: This routine was developed and modified as + computer assignments in Approximation Theory courses by + Prof. Andrew Knyazev, University of Colorado Denver, USA. + + Team Fall 98 (Revision 1.0): + Chanchai Aniwathananon + Crhistopher Mehl + David A. Duran + Saulo P. Oliveira + + Team Spring 11 (Revision 1.1): Manuchehr Aminian + + The algorithm and the comments are based on a FORTRAN code written + by Joseph C. Simpson. The code is available on Netlib repository: + http://www.netlib.org/toms/501 + See also: Communications of the ACM, V14, pp.355-356(1971) + + NOTES: + + 1) A may contain the collocation polynomial + 2) If MAXIT is exceeded, REF contains a new reference set + 3) M, EPSH and REF can be altered during the execution + 4) To keep consistency to the original code , EPSH can be + negative. However, the use of REF0 is *NOT* determined by + EPSH< 0, but only by its inclusion as an input parameter. + + Some parts of the code can still take advantage of vectorization. + + Revision 1.0 from 1998 is a direct human translation of + the FORTRAN code http://www.netlib.org/toms/501 + Revision 1.1 is a clean-up and technical update. + Tested on MATLAB Version 7.11.0.584 (R2010b) and + GNU Octave Version 3.2.4 + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 + function [A,REF,HMAX,H,R,EQUAL] = polyfitinf(M,N,K,X,Y,EPSH,MAXIT,REF0) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +powell + + +# name: +# type: sq_string +# elements: 1 +# length: 2656 + -- Function File: [ P, OBJ_VALUE, CONVERGENCE, ITERS, NEVS] = powell + (F, P0, CONTROL) + Multidimensional minimization (direction-set method). Implements a + direction-set (Powell's) method for multidimensional minimization + of a function without calculation of the gradient [1, 2] + +Arguments +--------- + + * F: name of function to minimize (string or handle), which + should accept one input variable (see example for how to pass + on additional input arguments) + + * P0: An initial value of the function argument to minimize + + * OPTIONS: an optional structure, which can be generated by + optimset, with some or all of the following fields: + - MaxIter: maximum iterations (positive integer, or -1 + or Inf for unlimited (default)) + + - TolFun: minimum amount by which function value must + decrease in each iteration to continue (default is 1E-8) + + - MaxFunEvals: maximum function evaluations (positive + integer, or -1 or Inf for unlimited (default)) + + - SearchDirections: an n*n matrix whose columns contain + the initial set of (presumably orthogonal) directions to + minimize along, where n is the number of elements in the + argument to be minimized for; or an n*1 vector of + magnitudes for the initial directions (defaults to the + set of unit direction vectors) + +Examples +-------- + + y = @(x, s) x(1) ^ 2 + x(2) ^ 2 + s; + o = optimset('MaxIter', 100, 'TolFun', 1E-10); + s = 1; + [x_optim, y_min, conv, iters, nevs] = powell(@(x) y(x, s), [1 0.5], o); %pass y wrapped in an anonymous function so that all other arguments to y, which are held constant, are set + %should return something like x_optim = [4E-14 3E-14], y_min = 1, conv = 1, iters = 2, nevs = 24 + + +Returns: +-------- + + * P: the minimizing value of the function argument + + * OBJ_VALUE: the value of F() at P + + * CONVERGENCE: 1 if normal convergence, 0 if not + + * ITERS: number of iterations performed + + * NEVS: number of function evaluations + +References +---------- + + 1. Powell MJD (1964), An efficient method for finding the + minimum of a function of several variables without + calculating derivatives, `Computer Journal', 7 :155-162 + + 2. Press, WH; Teukolsky, SA; Vetterling, WT; Flannery, BP + (1992). `Numerical Recipes in Fortran: The Art of Scientific + Computing' (2nd Ed.). New York: Cambridge University Press + (Section 10.5) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Multidimensional minimization (direction-set method). + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +residmin_stat + + +# name: +# type: sq_string +# elements: 1 +# length: 3188 + -- Function File: INFO = residmin_stat (F, P, SETTINGS) + Frontend for computation of statistics for a residual-based + minimization. + + SETTINGS is a structure whose fields can be set by `optimset' with + Octave versions 3.3.55 or greater; with older Octave versions, the + fields must be set directly and in the correct case. With SETTINGS + the computation of certain statistics is requested by setting the + fields `ret_' to `true'. The respective + statistics will be returned in a structure as fields with name + `'. Depending on the requested statistic and on + the additional information provided in SETTINGS, F and P may be + empty. Otherwise, F is the model function of an optimization (the + interface of F is described e.g. in `nonlin_residmin', please see + there), and P is a real column vector with parameters resulting + from the same optimization. + + Currently, the following statistics (or general information) can be + requested: + + `dfdp': Jacobian of model function with respect to parameters. + + `covd': Covariance matrix of data (typically guessed by applying a + factor to the covariance matrix of the residuals). + + `covp': Covariance matrix of final parameters. + + `corp': Correlation matrix of final parameters. + + Further SETTINGS + + The functionality of the interface is similar to + `nonlin_residmin'. In particular, structure-based, possibly + non-scalar, parameters and flagging parameters as fixed are + possible. The following settings have the same meaning as in + `nonlin_residmin' (please refer to there): `param_order', + `param_dims', `f_pstruct', `dfdp_pstruct', `diffp', + `diff_onesided', `complex_step_derivative', `cstep', `fixed', and + `weights'. Similarly, `param_config' can be used, but only with + fields corresponding to the settings `fixed', `diffp', and + `diff_onesided'. + + `dfdp' can be set in the same way as in `nonlin_residmin', but + alternatively may already contain the computed Jacobian of the + model function at the final parameters in matrix- or + structure-form. Users may pass information on the result of the + optimization in `residuals' (self-explaining) and `covd' + (covariance matrix of data). In many cases the type of objective + function of the optimization must be specified in `objf'; + currently, there is only a backend for the type "wls" (weighted + least squares). + + Backend-specific information + + The backend for `objf == "wls"' (currently the only backend) + computes `cord' (due to user request or as a prerequisite for + `covp' and `corp') as a diagonal matrix by assuming that the + variances of data points are proportional to the reciprocal of the + squared `weights' and guessing the factor of proportionality from + the residuals. If `covp' is not defined (e.g. because the Jacobian + has no full rank), it makes an attempt to still compute its + uniquely defined elements, if any, and to find the additional + defined elements (being `1' or `-1'), if any, in `corp'. + + See also: curvefit_stat + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 +Frontend for computation of statistics for a residual-based +minimization. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +rosenbrock + + +# name: +# type: sq_string +# elements: 1 +# length: 195 + Rosenbrock function - used to create example obj. fns. + + Function value and gradient vector of the rosenbrock function + The minimizer is at the vector (1,1,..,1), + and the minimized value is 0. + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 + Rosenbrock function - used to create example obj. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +samin_example + + +# name: +# type: sq_string +# elements: 1 +# length: 16 + dimensionality + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 + dimensionality + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +test_fminunc_1 + + +# name: +# type: sq_string +# elements: 1 +# length: 92 + Plain run, just to make sure ###################################### + Minimum wrt 'x' is y0 + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Plain run, just to make sure ###################################### + Minimum wr + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +test_min_1 + + +# name: +# type: sq_string +# elements: 1 +# length: 63 + [x,v,niter] = feval (optim_func, "testfunc","dtestf", xinit); + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 + [x,v,niter] = feval (optim_func, "testfunc","dtestf", xinit); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +test_min_2 + + +# name: +# type: sq_string +# elements: 1 +# length: 60 + [xlev,vlev,nlev] = feval(optim_func, "ff", "dff", xinit) ; + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 + [xlev,vlev,nlev] = feval(optim_func, "ff", "dff", xinit) ; + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +test_min_3 + + +# name: +# type: sq_string +# elements: 1 +# length: 166 + [xlev,vlev,nlev] = feval (optim_func, "ff", "dff", xinit, "extra", extra) ; + [xlev,vlev,nlev] = feval \ + (optim_func, "ff", "dff", list (xinit, obsmat, obses)); + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + [xlev,vlev,nlev] = feval (optim_func, "ff", "dff", xinit, "extra", extra) ; + [x + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +test_min_4 + + +# name: +# type: sq_string +# elements: 1 +# length: 173 + Plain run, just to make sure ###################################### + Minimum wrt 'x' is y0 + [xlev,vlev,nlev] = feval (optim_func, "ff", "dff", {x0,y0,1}); + ctl.df = "dff"; + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Plain run, just to make sure ###################################### + Minimum wr + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +test_minimize_1 + + +# name: +# type: sq_string +# elements: 1 +# length: 92 + Plain run, just to make sure ###################################### + Minimum wrt 'x' is y0 + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Plain run, just to make sure ###################################### + Minimum wr + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +test_nelder_mead_min_1 + + +# name: +# type: sq_string +# elements: 1 +# length: 29 + Use vanilla nelder_mead_min + + + +# name: +# type: sq_string +# elements: 1 +# length: 29 + Use vanilla nelder_mead_min + + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +test_nelder_mead_min_2 + + +# name: +# type: sq_string +# elements: 1 +# length: 70 + + Test using volume ################################################# + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 + + Test using volume ################################################# + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +test_wpolyfit + + +# name: +# type: sq_string +# elements: 1 +# length: 34 + x y dy + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 + x y dy + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +vfzero + + +# name: +# type: sq_string +# elements: 1 +# length: 1964 + -- Function File: vfzero (FUN, X0) + -- Function File: vfzero (FUN, X0, OPTIONS) + -- Function File: [X, FVAL, INFO, OUTPUT] = vfzero (...) + A variant of `fzero'. Finds a zero of a vector-valued multivariate + function where each output element only depends on the input + element with the same index (so the Jacobian is diagonal). + + FUN should be a handle or name of a function returning a column + vector. X0 should be a two-column matrix, each row specifying two + points which bracket a zero of the respective output element of + FUN. + + If X0 is a single-column matrix then several nearby and distant + values are probed in an attempt to obtain a valid bracketing. If + this is not successful, the function fails. OPTIONS is a structure + specifying additional options. Currently, `vfzero' recognizes + these options: `"FunValCheck"', `"OutputFcn"', `"TolX"', + `"MaxIter"', `"MaxFunEvals"'. For a description of these options, + see *note optimset: doc-optimset. + + On exit, the function returns X, the approximate zero and FVAL, + the function value thereof. INFO is a column vector of exit flags + that can have these values: + + * 1 The algorithm converged to a solution. + + * 0 Maximum number of iterations or function evaluations has + been reached. + + * -1 The algorithm has been terminated from user output + function. + + * -5 The algorithm may have converged to a singular point. + + OUTPUT is a structure containing runtime information about the + `fzero' algorithm. Fields in the structure are: + + * iterations Number of iterations through loop. + + * nfev Number of function evaluations. + + * bracketx A two-column matrix with the final bracketing of the + zero along the x-axis. + + * brackety A two-column matrix with the final bracketing of the + zero along the y-axis. + + See also: optimset, fsolve + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +A variant of `fzero'. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +wpolyfit + + +# name: +# type: sq_string +# elements: 1 +# length: 2922 + -- Function File: [P, S] = wpolyfit (X, Y, DY, N) + Return the coefficients of a polynomial P(X) of degree N that + minimizes `sumsq (p(x(i)) - y(i))', to best fit the data in the + least squares sense. The standard error on the observations Y if + present are given in DY. + + The returned value P contains the polynomial coefficients suitable + for use in the function polyval. The structure S returns + information necessary to compute uncertainty in the model. + + To compute the predicted values of y with uncertainty use + [y,dy] = polyconf(p,x,s,'ci'); + You can see the effects of different confidence intervals and + prediction intervals by calling the wpolyfit internal plot + function with your fit: + feval('wpolyfit:plt',x,y,dy,p,s,0.05,'pi') + Use DY=[] if uncertainty is unknown. + + You can use a chi^2 test to reject the polynomial fit: + p = 1-chi2cdf(s.normr^2,s.df); + p is the probability of seeing a chi^2 value higher than that which + was observed assuming the data are normally distributed around the + fit. If p < 0.01, you can reject the fit at the 1% level. + + You can use an F test to determine if a higher order polynomial + improves the fit: + [poly1,S1] = wpolyfit(x,y,dy,n); + [poly2,S2] = wpolyfit(x,y,dy,n+1); + F = (S1.normr^2 - S2.normr^2)/(S1.df-S2.df)/(S2.normr^2/S2.df); + p = 1-f_cdf(F,S1.df-S2.df,S2.df); + p is the probability of observing the improvement in chi^2 obtained + by adding the extra parameter to the fit. If p < 0.01, you can + reject the lower order polynomial at the 1% level. + + You can estimate the uncertainty in the polynomial coefficients + themselves using + dp = sqrt(sumsq(inv(s.R'))'/s.df)*s.normr; + but the high degree of covariance amongst them makes this a + questionable operation. + + -- Function File: [P, S, MU] = wpolyfit (...) + If an additional output `mu = [mean(x),std(x)]' is requested then + the X values are centered and normalized prior to computing the + fit. This will give more stable numerical results. To compute a + predicted Y from the returned model use `y = polyval(p, + (x-mu(1))/mu(2)' + + -- Function File: wpolyfit (...) + If no output arguments are requested, then wpolyfit plots the data, + the fitted line and polynomials defining the standard error range. + + Example + x = linspace(0,4,20); + dy = (1+rand(size(x)))/2; + y = polyval([2,3,1],x) + dy.*randn(size(x)); + wpolyfit(x,y,dy,2); + + -- Function File: wpolyfit (..., 'origin') + If 'origin' is specified, then the fitted polynomial will go + through the origin. This is generally ill-advised. Use with + caution. + + Hocking, RR (2003). Methods and Applications of Linear Models. + New Jersey: John Wiley and Sons, Inc. + + + See also: polyfit, polyconf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the coefficients of a polynomial P(X) of degree N that minimizes +`sumsq ( + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +wrap_f_dfdp + + +# name: +# type: sq_string +# elements: 1 +# length: 387 + [ret1, ret2] = wrap_f_dfdp (f, dfdp, varargin) + + f and dftp should be the objective function (or "model function" in + curve fitting) and its jacobian, respectively, of an optimization + problem. ret1: f (varagin{:}), ret2: dfdp (varargin{:}). ret2 is + only computed if more than one output argument is given. This + manner of calling f and dfdp is needed by some optimization + functions. + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + [ret1, ret2] = wrap_f_dfdp (f, dfdp, varargin) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +wsolve + + +# name: +# type: sq_string +# elements: 1 +# length: 1736 + [x,s] = wsolve(A,y,dy) + + Solve a potentially over-determined system with uncertainty in + the values. + + A x = y +/- dy + + Use QR decomposition for increased accuracy. Estimate the + uncertainty for the solution from the scatter in the data. + + The returned structure s contains + + normr = sqrt( A x - y ), weighted by dy + R such that R'R = A'A + df = n-p, n = rows of A, p = columns of A + + See polyconf for details on how to use s to compute dy. + The covariance matrix is inv(R'*R). If you know that the + parameters are independent, then uncertainty is given by + the diagonal of the covariance matrix, or + + dx = sqrt(N*sumsq(inv(s.R'))') + + where N = normr^2/df, or N = 1 if df = 0. + + Example 1: weighted system + + A=[1,2,3;2,1,3;1,1,1]; xin=[1;2;3]; + dy=[0.2;0.01;0.1]; y=A*xin+randn(size(dy)).*dy; + [x,s] = wsolve(A,y,dy); + dx = sqrt(sumsq(inv(s.R'))'); + res = [xin, x, dx] + + Example 2: weighted overdetermined system y = x1 + 2*x2 + 3*x3 + e + + A = fullfact([3,3,3]); xin=[1;2;3]; + y = A*xin; dy = rand(size(y))/50; y+=dy.*randn(size(y)); + [x,s] = wsolve(A,y,dy); + dx = s.normr*sqrt(sumsq(inv(s.R'))'/s.df); + res = [xin, x, dx] + + Note there is a counter-intuitive result that scaling the + uncertainty in the data does not affect the uncertainty in + the fit. Indeed, if you perform a monte carlo simulation + with x,y datasets selected from a normal distribution centered + on y with width 10*dy instead of dy you will see that the + variance in the parameters indeed increases by a factor of 100. + However, if the error bars really do increase by a factor of 10 + you should expect a corresponding increase in the scatter of + the data, which will increase the variance computed by the fit. + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 + [x,s] = wsolve(A,y,dy) + + + + + + diff --git a/octave_packages/optim-1.2.0/expfit.m b/octave_packages/optim-1.2.0/expfit.m new file mode 100644 index 0000000..995cb89 --- /dev/null +++ b/octave_packages/optim-1.2.0/expfit.m @@ -0,0 +1,136 @@ +## Copyright (C) 2000 Gert Van den Eynde +## Copyright (C) 2002 Rolf Fabian +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## USAGE [alpha,c,rms] = expfit( deg, x1, h, y ) +## +## Prony's method for non-linear exponential fitting +## +## Fit function: \sum_1^{deg} c(i)*exp(alpha(i)*x) +## +## Elements of data vector y must correspond to +## equidistant x-values starting at x1 with stepsize h +## +## The method is fully compatible with complex linear +## coefficients c, complex nonlinear coefficients alpha +## and complex input arguments y, x1, non-zero h . +## Fit-order deg must be a real positive integer. +## +## Returns linear coefficients c, nonlinear coefficients +## alpha and root mean square error rms. This method is +## known to be more stable than 'brute-force' non-linear +## least squares fitting. +## +## Example +## x0 = 0; step = 0.05; xend = 5; x = x0:step:xend; +## y = 2*exp(1.3*x)-0.5*exp(2*x); +## error = (rand(1,length(y))-0.5)*1e-4; +## [alpha,c,rms] = expfit(2,x0,step,y+error) +## +## alpha = +## 2.0000 +## 1.3000 +## c = +## -0.50000 +## 2.00000 +## rms = 0.00028461 +## +## The fit is very sensitive to the number of data points. +## It doesn't perform very well for small data sets. +## Theoretically, you need at least 2*deg data points, but +## if there are errors on the data, you certainly need more. +## +## Be aware that this is a very (very,very) ill-posed problem. +## By the way, this algorithm relies heavily on computing the +## roots of a polynomial. I used 'roots.m', if there is +## something better please use that code. +## +## Demo for a complex fit-function: +## deg= 2; N= 20; x1= -(1+i), x= linspace(x1,1+i/2,N).'; +## h = x(2) - x(1) +## y= (2+i)*exp( (-1-2i)*x ) + (-1+3i)*exp( (2+3i)*x ); +## A= 5e-2; y+= A*(randn(N,1)+randn(N,1)*i); % add complex noise +## [alpha,c,rms]= expfit( deg, x1, h, y ) + +function [a,c,rms] = expfit(deg,x1,h,y) + +% Check input +if deg<1, error('expfit: deg must be >= 1'); end +if ~h, error('expfit: vanishing stepsize h'); end + +if ( N=length( y=y(:) ) ) < 2*deg + error('expfit: less than %d samples',2*deg); +end + +% Solve for polynomial coefficients +A = hankel( y(1:N-deg),y(N-deg:N) ); +s = - A(:,1:deg) \ A(:,deg+1); + +% Compose polynomial +p = flipud([s;1]); + +% Compute roots +u = roots(p); + +% nonlinear coefficients +a = log(u)/h; + +% Compose second matrix A(i,j) = u(j)^(i-1) +A = ( ones(N,1) * u(:).' ) .^ ( [0:N-1]' * ones(1,deg) ); + +% Solve linear system +f = A\y; + +% linear coefficients +c = f./exp( a*x1 ); + +% Compute rms of y - approx +% where approx(i) = sum_k ( c(k) * exp(x(i)*a(k)) ) +if nargout > 2 + x = x1+h*[0:N-1]; + approx = exp( x(:) * a(:).' ) * c(:); + rms = sqrt( sumsq(approx - y) ); +end + +endfunction + +%!demo % same as in help - part +%! deg= 2; N= 20; x1= -(1+i), x= linspace(x1,1+i/2,N).'; +%! h = x(2) - x(1) +%! y= (2+i)*exp( (-1-2i)*x ) + (-1+3i)*exp( (2+3i)*x ); +%! A= 5e-2; y+= A*(randn(N,1)+randn(N,1)*i); % add complex noise +%! [alpha,c,rms]= expfit( deg, x1, h, y ) + +%!demo % demo for stepsize with negative real part +%! deg= 2; N= 20; x1= +3*(1+i), x= linspace(x1,1+i/3,N).'; +%! h = x(2) - x(1) +%! y= (2+i)*exp( (-1-2i)*x ) + (-1+3i)*exp( (2+3i)*x ); +%! A= 5e-2; y+= A*(randn(N,1)+randn(N,1)*i); % add complex noise +%! [alpha,c,rms]= expfit( deg, x1, h, y ) + +%!demo +%! x0 = 1.5; step = 0.05; xend = 5; +%! a = [1.3, 2]'; +%! c = [2, -0.5]'; +%! v = 1e-4; +%! +%! x = x0:step:xend; +%! y = exp (x(:) * a(:).') * c(:); +%! err = randn (size (y)) * v; +%! plot (x, y + err); +%! +%! [a_out, c_out, rms] = expfit (2, x0, step, y+err) + + diff --git a/octave_packages/optim-1.2.0/fmin.m b/octave_packages/optim-1.2.0/fmin.m new file mode 100644 index 0000000..7a4e99b --- /dev/null +++ b/octave_packages/optim-1.2.0/fmin.m @@ -0,0 +1,28 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +function ret=fmin(varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "`fmin' has been deprecated, and will be removed in the future. Use `fminbnd' directly instead."); + endif + + ## alias for fminbnd + ret = fminbnd(varargin{:}); + +endfunction diff --git a/octave_packages/optim-1.2.0/fmins.m b/octave_packages/optim-1.2.0/fmins.m new file mode 100644 index 0000000..43c7d7e --- /dev/null +++ b/octave_packages/optim-1.2.0/fmins.m @@ -0,0 +1,78 @@ +## Copyright (C) 2003 Andy Adler +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}] =} fmins(@var{f},@var{X0},@var{options},@var{grad},@var{P1},@var{P2}, ...) +## +## Find the minimum of a funtion of several variables. +## By default the method used is the Nelder&Mead Simplex algorithm +## +## Example usage: +## fmins(inline('(x(1)-5).^2+(x(2)-8).^4'),[0;0]) +## +## @strong{Inputs} +## @table @var +## @item f +## A string containing the name of the function to minimize +## @item X0 +## A vector of initial parameters fo the function @var{f}. +## @item options +## Vector with control parameters (not all parameters are used) +## @verbatim +## options(1) - Show progress (if 1, default is 0, no progress) +## options(2) - Relative size of simplex (default 1e-3) +## options(6) - Optimization algorithm +## if options(6)==0 - Nelder & Mead simplex (default) +## if options(6)==1 - Multidirectional search Method +## if options(6)==2 - Alternating Directions search +## options(5) +## if options(6)==0 && options(5)==0 - regular simplex +## if options(6)==0 && options(5)==1 - right-angled simplex +## Comment: the default is set to "right-angled simplex". +## this works better for me on a broad range of problems, +## although the default in nmsmax is "regular simplex" +## options(10) - Maximum number of function evaluations +## @end verbatim +## @item grad +## Unused (For compatibility with Matlab) +## @item P1,P2, ... +## Optional parameters for function @var{f} +## +## @end table +## @end deftypefn + +function ret=fmins(funfun, X0, options, grad, varargin) + stopit = [1e-3, inf, inf, 1, 0, -1]; + minfun = 'nmsmax'; + + if nargin < 3; options=[]; end + + if length(options)>=1; stopit(5)= options(1); end + if length(options)>=2; stopit(1)= options(2); end + if length(options)>=5; + if options(6)==0; minfun= 'nmsmax'; + if options(5)==0; stopit(4)= 0; + elseif options(5)==1; stopit(4)= 1; + else error('options(5): no associated simple strategy'); + end + elseif options(6)==1; minfun= 'mdsmax'; + elseif options(6)==2; minfun= 'adsmax'; + else error('options(6) does not correspond to known algorithm'); + end + end + if length(options)>=10; stopit(2)= options(10); end + + ret = feval(minfun, funfun, X0, stopit, [], varargin{:}); +endfunction diff --git a/octave_packages/optim-1.2.0/fminsearch.m b/octave_packages/optim-1.2.0/fminsearch.m new file mode 100644 index 0000000..10eaaa2 --- /dev/null +++ b/octave_packages/optim-1.2.0/fminsearch.m @@ -0,0 +1,36 @@ +## Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} fminsearch (@var{fun}, @var{x0}) +## @deftypefnx {Function File} {[@var{x}, @var{fval}] =} fminsearch (@var{fun}, @var{x0}, @var{options}, @var{grad}, @var{P1}, @var{P2}, @dots{}) +## +## Find the minimum of a funtion of several variables. +## By default the method used is the Nelder&Mead Simplex algorithm. +## @seealso{fmin,fmins,nmsmax} +## @end deftypefn + +## TODO: describe arguments in texinfo help string + +function [x, fval] = fminsearch (fun, x0, options = [], grad = [], varargin) + + if (nargin < 2) + print_usage (); + endif + + x = fmins (fun, x0, options, grad, varargin{:}); + fval = feval (fun, x, varargin{:}); + +endfunction diff --git a/octave_packages/optim-1.2.0/fminunc_compat.m b/octave_packages/optim-1.2.0/fminunc_compat.m new file mode 100644 index 0000000..93d1937 --- /dev/null +++ b/octave_packages/optim-1.2.0/fminunc_compat.m @@ -0,0 +1,166 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## [x,v,flag,out,df,d2f] = fminunc_compat (f,x,opt,...) - M*tlab-like optimization +## +## Imitation of m*tlab's fminunc(). The optional 'opt' argument is a struct, +## e.g. produced by 'optimset()'. 'fminunc_compat' has been deprecated in +## favor of 'fminunc', which is now part of core Octave. This function +## will possibly be removed from future versions of the 'optim' package. +## +## Supported options +## ----------------- +## Diagnostics, [off|on] : Be verbose +## Display , [off|iter|notify|final] +## : Be verbose unless value is "off" +## GradObj , [off|on] : Function's 2nd return value is derivatives +## Hessian , [off|on] : Function's 2nd and 3rd return value are +## derivatives and Hessian. +## TolFun , scalar : Termination criterion (see 'ftol' in minimize()) +## TolX , scalar : Termination criterion (see 'utol' in minimize()) +## MaxFunEvals, int : Max. number of function evaluations +## MaxIter , int : Max. number of algorithm iterations +## +## These non-m*tlab are provided to facilitate porting code to octave: +## ----------------------- +## "MinEquiv" , [off|on] : Don't minimize 'fun', but instead return the +## option passed to minimize(). +## +## "Backend" , [off|on] : Don't minimize 'fun', but instead return +## [backend, opt], the name of the backend +## optimization function that is used and the +## optional arguments that will be passed to it. See +## the 'backend' option of minimize(). +## +## This function is a front-end to minimize(). + +function [x,fval,flag,out,df,d2f] = fminunc_compat (fun,x0,opt,varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "`fminunc_compat' has been deprecated, and will be removed in the future. Use `fminunc' from Octave core instead."); + endif + +if nargin < 3, opt = struct (); end +if nargin > 3, + args = {x0, varargin{:}}; +else + args = {x0}; +end + +## Do some checks #################################################### +ws = es = ""; + +## Check for unknown options +## All known options +opn = [" DerivativeCheck Diagnostics DiffMaxChange DiffMinChange",\ + " Display GoalsExactAchieve GradConstr GradObj Hessian HessMult",\ + " HessPattern HessUpdate Jacobian JacobMult JacobPattern",\ + " LargeScale LevenbergMarquardt LineSearchType MaxFunEvals MaxIter",\ + " MaxPCGIter MeritFunction MinAbsMax PrecondBandWidth TolCon",\ + " TolFun TolPCG TolX TypicalX ",\ + " MinEquiv Backend "]; + +for [v,k] = opt + if ! findstr ([" ",k," "],opn) + es = [es,sprintf("Unknown option '%s'\n",k)]; + end +end +## Check for ignored options +## All ignored options +iop = [" DerivativeCheck DiffMaxChange DiffMinChange",\ + " Display GoalsExactAchieve GradConstr HessMult",\ + " HessPattern HessUpdate JacobMult JacobPattern",\ + " LargeScale LevenbergMarquardt LineSearchType",\ + " MaxPCGIter MeritFunction MinAbsMax PrecondBandWidth TolCon",\ + " TolPCG TypicalX "]; +for [v,k] = opt + if ! findstr ([" ",k," "],iop) + ws = [ws,sprintf("Ignoring option '%s'\n",k)]; + end +end + +if length (ws) && ! length (es), warning (ws); +elseif length (es), error ([ws,es]); +end + +## Transform fminunc options into minimize() options + +opm = struct(); # minimize() options + +equiv = struct ("TolX" , "utol" , "TolFun" , "ftol",\ + "MaxFunEvals", "maxev" , "MaxIter" , "maxit",\ + "GradObj" , "jac" , "Hessian" , "hess",\ + "Display" , "verbose", "Diagnostics", "verbose",\ + "Backend" , "backend"); + +for [v,k] = equiv + if isfield (opt,k) + opm = setfield (opm, getfield(equiv,k), getfield(opt,k)); + end +end + + # Transform "off" into 0, other strings into + # 1. +for [v,k] = opm + if ischar (v) + if strcmp (v,"off") + opm = setfield (opm, k,0); + else + opm = setfield (opm, k,1); + end + end +end + +unary_opt = " hess jac backend verbose "; +opml = {}; +for [v,k] = opm + if findstr ([" ",k," "], unary_opt) + opml(end+1) = {k}; # append k + else + opml(end+[1,2]) = {k,v}; # append k and v + end +end + # Return only options to minimize() ## +if isfield (opt, "MinEquiv") + x = opml; + if nargout > 1 + warning ("Only 1 return value is defined with the 'MinEquiv' option"); + end + return + # Use the backend option ############# +elseif isfield (opm, "backend") + [x,fval] = minimize (fun, args, opml); + if nargout > 2 + warning ("Only 2 return values are defined with the 'Backend' option"); + end + return +else # Do the minimization ################ + [x,fval,out] = minimize (fun, args, opml); + + if isfield (opm, "maxev") + flag = out(1) < getfield(opm,"maxev"); + else + flag = 1; + end + + if nargout > 4 + [dummy,df,d2f] = feval (fun, x, args{2:end}); + elseif nargout > 3 + [dummy,df] = feval (fun, x, args{2:end}); + end +end diff --git a/octave_packages/optim-1.2.0/gjp.m b/octave_packages/optim-1.2.0/gjp.m new file mode 100644 index 0000000..4bfd9c8 --- /dev/null +++ b/octave_packages/optim-1.2.0/gjp.m @@ -0,0 +1,52 @@ +%% Copyright (C) 2010, 2011 Olaf Till +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% m = gjp (m, k[, l]) +%% +%% m: matrix; k, l: row- and column-index of pivot, l defaults to k. +%% +%% Gauss-Jordon pivot as defined in Bard, Y.: Nonlinear Parameter +%% Estimation, p. 296, Academic Press, New York and London 1974. In +%% the pivot column, this seems not quite the same as the usual +%% Gauss-Jordan(-Clasen) pivot. Bard gives Beaton, A. E., 'The use of +%% special matrix operators in statistical calculus' Research Bulletin +%% RB-64-51 (1964), Educational Testing Service, Princeton, New Jersey +%% as a reference, but this article is not easily accessible. Another +%% reference, whose definition of gjp differs from Bards by some +%% signs, is Clarke, R. B., 'Algorithm AS 178: The Gauss-Jordan sweep +%% operator with detection of collinearity', Journal of the Royal +%% Statistical Society, Series C (Applied Statistics) (1982), 31(2), +%% 166--168. + +function m = gjp (m, k, l) + + if (nargin < 3) + l = k; + end + + p = m(k, l); + + if (p == 0) + error ('pivot is zero'); + end + + %% This is a case where I really hate to remain Matlab compatible, + %% giving so many indices twice. + m(k, [1:l-1, l+1:end]) = m(k, [1:l-1, l+1:end]) / p; % pivot row + m([1:k-1, k+1:end], [1:l-1, l+1:end]) = ... % except pivot row and col + m([1:k-1, k+1:end], [1:l-1, l+1:end]) - ... + m([1:k-1, k+1:end], l) * m(k, [1:l-1, l+1:end]); + m([1:k-1, k+1:end], l) = - m([1:k-1, k+1:end], l) / p; % pivot column + m(k, l) = 1 / p; diff --git a/octave_packages/optim-1.2.0/jacobs.m b/octave_packages/optim-1.2.0/jacobs.m new file mode 100644 index 0000000..521b259 --- /dev/null +++ b/octave_packages/optim-1.2.0/jacobs.m @@ -0,0 +1,142 @@ +## Copyright (C) 2011 Fotios Kasolis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {Df =} jacobs (@var{x}, @var{f}) +## @deftypefnx {Function File} {Df =} jacobs (@var{x}, @var{f}, @var{hook}) +## Calculate the jacobian of a function using the complex step method. +## +## Let @var{f} be a user-supplied function. Given a point @var{x} at +## which we seek for the Jacobian, the function @command{jacobs} returns +## the Jacobian matrix @code{d(f(1), @dots{}, df(end))/d(x(1), @dots{}, +## x(n))}. The function uses the complex step method and thus can be +## applied to real analytic functions. +## +## The optional argument @var{hook} is a structure with additional options. @var{hook} +## can have the following fields: +## @itemize @bullet +## @item +## @code{h} - can be used to define the magnitude of the complex step and defaults +## to 1e-20; steps larger than 1e-3 are not allowed. +## @item +## @code{fixed} - is a logical vector internally usable by some optimization +## functions; it indicates for which elements of @var{x} no gradient should be +## computed, but zero should be returned. +## @end itemize +## +## For example: +## +## @example +## @group +## f = @@(x) [x(1)^2 + x(2); x(2)*exp(x(1))]; +## Df = jacobs ([1, 2], f) +## @end group +## @end example +## @end deftypefn + +function Df = jacobs (x, f, hook) + + if ( (nargin < 2) || (nargin > 3) ) + print_usage (); + endif + + if (ischar (f)) + f = str2func (f, "global"); + endif + + n = numel (x); + + default_h = 1e-20; + max_h = 1e-3; # must be positive + + if (nargin > 2) + + if (isfield (hook, "h")) + if (! (isscalar (hook.h))) + error ("complex step magnitude must be a scalar"); + endif + if (abs (hook.h) > max_h) + warning ("complex step magnitude larger than allowed, set to %e", ... + max_h) + h = max_h; + else + h = hook.h; + endif + else + h = default_h; + endif + + if (isfield (hook, "fixed")) + if (numel (hook.fixed) != n) + error ("index of fixed parameters has wrong dimensions"); + endif + fixed = hook.fixed; + else + fixed = false (n, 1); + endif + + else + + h = default_h; + fixed = false (n, 1); + + endif + + if (all (fixed)) + error ("all elements of 'x' are fixed"); + endif + + x = repmat (x(:), 1, n) + h * 1i * eye (n); + + idx = find (! fixed); + + ## after first evaluation, dimensionness of 'f' is known + t_Df = imag (f (x(:, idx(1)))(:)); + dim = numel (t_Df); + + Df = zeros (dim, n); + + Df(:, idx(1)) = t_Df; + + for count = idx(2:end) + Df(:, count) = imag (f (x(:, count))(:)); + endfor + + Df /= h; + +endfunction + +%!assert (jacobs (1, @(x) x), 1) +%!assert (jacobs (6, @(x) x^2), 12) +%!assert (jacobs ([1; 1], @(x) [x(1)^2; x(1)*x(2)]), [2, 0; 1, 1]) +%!assert (jacobs ([1; 2], @(x) [x(1)^2 + x(2); x(2)*exp(x(1))]), [2, 1; 2*exp(1), exp(1)]) + +%% Test input validation +%!error jacobs () +%!error jacobs (1) +%!error jacobs (1, 2, 3, 4) +%!error jacobs (@sin, 1, [1, 1]) +%!error jacobs (@sin, 1, ones(2, 2)) + +%!demo +%! # Relative error against several h-values +%! k = 3:20; h = 10 .^ (-k); x = 0.3*pi; +%! err = zeros (1, numel (k)); +%! for count = 1 : numel (k) +%! err(count) = abs (jacobs (x, @sin, struct ("h", h(count))) - cos (x)) / abs (cos (x)) + eps; +%! endfor +%! loglog (h, err); grid minor; +%! xlabel ("h"); ylabel ("|Df(x) - cos(x)| / |cos(x)|") +%! title ("f(x)=sin(x), f'(x)=cos(x) at x = 0.3pi") diff --git a/octave_packages/optim-1.2.0/leasqr.m b/octave_packages/optim-1.2.0/leasqr.m new file mode 100644 index 0000000..653087c --- /dev/null +++ b/octave_packages/optim-1.2.0/leasqr.m @@ -0,0 +1,798 @@ +%% Copyright (C) 1992-1994 Richard Shrager +%% Copyright (C) 1992-1994 Arthur Jutan +%% Copyright (C) 1992-1994 Ray Muzic +%% Copyright (C) 2010, 2011 Olaf Till +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%%function [f,p,cvg,iter,corp,covp,covr,stdresid,Z,r2]= +%% leasqr(x,y,pin,F,{stol,niter,wt,dp,dFdp,options}) +%% +%% Levenberg-Marquardt nonlinear regression of f(x,p) to y(x). +%% +%% Version 3.beta +%% Optional parameters are in braces {}. +%% x = vector or matrix of independent variables. +%% y = vector or matrix of observed values. +%% wt = statistical weights (same dimensions as y). These should be +%% set to be proportional to (sqrt of var(y))^-1; (That is, the +%% covariance matrix of the data is assumed to be proportional to +%% diagonal with diagonal equal to (wt.^2)^-1. The constant of +%% proportionality will be estimated.); default = ones( size (y)). +%% pin = vec of initial parameters to be adjusted by leasqr. +%% dp = fractional increment of p for numerical partial derivatives; +%% default = .001*ones(size(pin)) +%% dp(j) > 0 means central differences on j-th parameter p(j). +%% dp(j) < 0 means one-sided differences on j-th parameter p(j). +%% dp(j) = 0 holds p(j) fixed i.e. leasqr wont change initial guess: pin(j) +%% F = name of function in quotes or function handle; the function +%% shall be of the form y=f(x,p), with y, x, p of the form y, x, pin +%% as described above. +%% dFdp = name of partial derivative function in quotes or function +%% handle; default is 'dfdp', a slow but general partial derivatives +%% function; the function shall be of the form +%% prt=dfdp(x,f,p,dp,F[,bounds]). For backwards compatibility, the +%% function will only be called with an extra 'bounds' argument if the +%% 'bounds' option is explicitely specified to leasqr (see dfdp.m). +%% stol = scalar tolerance on fractional improvement in scalar sum of +%% squares = sum((wt.*(y-f))^2); default stol = .0001; +%% niter = scalar maximum number of iterations; default = 20; +%% options = structure, currently recognized fields are 'fract_prec', +%% 'max_fract_change', 'inequc', 'bounds', and 'equc'. For backwards +%% compatibility, 'options' can also be a matrix whose first and +%% second column contains the values of 'fract_prec' and +%% 'max_fract_change', respectively. +%% Field 'options.fract_prec': column vector (same length as 'pin') +%% of desired fractional precisions in parameter estimates. +%% Iterations are terminated if change in parameter vector (chg) +%% relative to current parameter estimate is less than their +%% corresponding elements in 'options.fract_prec' [ie. all (abs +%% (chg) < abs (options.fract_prec .* current_parm_est))] on two +%% consecutive iterations, default = zeros(). +%% Field 'options.max_fract_change': column vector (same length as +%% 'pin) of maximum fractional step changes in parameter vector. +%% Fractional change in elements of parameter vector is constrained to +%% be at most 'options.max_fract_change' between sucessive iterations. +%% [ie. abs(chg(i))=abs(min([chg(i) +%% options.max_fract_change(i)*current param estimate])).], default = +%% Inf*ones(). +%% Field 'options.inequc': cell-array containing up to four entries, +%% two entries for linear inequality constraints and/or one or two +%% entries for general inequality constraints. Initial parameters +%% must satisfy these constraints. Either linear or general +%% constraints may be the first entries, but the two entries for +%% linear constraints must be adjacent and, if two entries are given +%% for general constraints, they also must be adjacent. The two +%% entries for linear constraints are a matrix (say m) and a vector +%% (say v), specifying linear inequality constraints of the form +%% `m.' * parameters + v >= 0'. If the constraints are just bounds, +%% it is suggested to specify them in 'options.bounds' instead, +%% since then some sanity tests are performed, and since the +%% function 'dfdp.m' is guarantied not to violate constraints during +%% determination of the numeric gradient only for those constraints +%% specified as 'bounds' (possibly with violations due to a certain +%% inaccuracy, however, except if no constraints except bounds are +%% specified). The first entry for general constraints must be a +%% differentiable vector valued function (say h), specifying general +%% inequality constraints of the form `h (p[, idx]) >= 0'; p is the +%% column vector of optimized paraters and the optional argument idx +%% is a logical index. h has to return the values of all constraints +%% if idx is not given, and has to return only the indexed +%% constraints if idx is given (so computation of the other +%% constraints can be spared). If a second entry for general +%% constraints is given, it must be a function (say dh) which +%% returnes a matrix whos rows contain the gradients of the +%% constraint function h with respect to the optimized parameters. +%% It has the form jac_h = dh (vh, p, dp, h, idx[, bounds]); p is +%% the column vector of optimized parameters, and idx is a logical +%% index --- only the rows indexed by idx must be returned (so +%% computation of the others can be spared). The other arguments of +%% dh are for the case that dh computes numerical gradients: vh is +%% the column vector of the current values of the constraint +%% function h, with idx already applied. h is a function h (p) to +%% compute the values of the constraints for parameters p, it will +%% return only the values indexed by idx. dp is a suggestion for +%% relative step width, having the same value as the argument 'dp' +%% of leasqr above. If bounds were specified to leasqr, they are +%% provided in the argument bounds of dh, to enable their +%% consideration in determination of numerical gradients. If dh is +%% not specified to leasqr, numerical gradients are computed in the +%% same way as with 'dfdp.m' (see above). If some constraints are +%% linear, they should be specified as linear constraints (or +%% bounds, if applicable) for reasons of performance, even if +%% general constraints are also specified. +%% Field 'options.bounds': two-column-matrix, one row for each +%% parameter in 'pin'. Each row contains a minimal and maximal value +%% for each parameter. Default: [-Inf, Inf] in each row. If this +%% field is used with an existing user-side function for 'dFdp' +%% (see above) the functions interface might have to be changed. +%% Field 'options.equc': equality constraints, specified the same +%% way as inequality constraints (see field 'options.inequc'). +%% Initial parameters must satisfy these constraints. +%% Note that there is possibly a certain inaccuracy in honoring +%% constraints, except if only bounds are specified. +%% _Warning_: If constraints (or bounds) are set, returned guesses +%% of corp, covp, and Z are generally invalid, even if no constraints +%% are active for the final parameters. If equality constraints are +%% specified, corp, covp, and Z are not guessed at all. +%% Field 'options.cpiv': Function for complementary pivot algorithm +%% for inequality constraints, default: cpiv_bard. No different +%% function is supplied. +%% +%% OUTPUT VARIABLES +%% f = column vector of values computed: f = F(x,p). +%% p = column vector trial or final parameters. i.e, the solution. +%% cvg = scalar: = 1 if convergence, = 0 otherwise. +%% iter = scalar number of iterations used. +%% corp = correlation matrix for parameters. +%% covp = covariance matrix of the parameters. +%% covr = diag(covariance matrix of the residuals). +%% stdresid = standardized residuals. +%% Z = matrix that defines confidence region (see comments in the source). +%% r2 = coefficient of multiple determination, intercept form. +%% +%% Not suitable for non-real residuals. +%% +%% References: +%% Bard, Nonlinear Parameter Estimation, Academic Press, 1974. +%% Draper and Smith, Applied Regression Analysis, John Wiley and Sons, 1981. + +function [f,p,cvg,iter,corp,covp,covr,stdresid,Z,r2]= ... + leasqr(x,y,pin,F,stol,niter,wt,dp,dFdp,options) + + %% The following two blocks of comments are chiefly from the original + %% version for Matlab. For later changes the logs of the Octave Forge + %% svn repository should also be consulted. + + %% A modified version of Levenberg-Marquardt + %% Non-Linear Regression program previously submitted by R.Schrager. + %% This version corrects an error in that version and also provides + %% an easier to use version with automatic numerical calculation of + %% the Jacobian Matrix. In addition, this version calculates statistics + %% such as correlation, etc.... + %% + %% Version 3 Notes + %% Errors in the original version submitted by Shrager (now called + %% version 1) and the improved version of Jutan (now called version 2) + %% have been corrected. + %% Additional features, statistical tests, and documentation have also been + %% included along with an example of usage. BEWARE: Some the the input and + %% output arguments were changed from the previous version. + %% + %% Ray Muzic + %% Arthur Jutan + + %% Richard I. Shrager (301)-496-1122 + %% Modified by A.Jutan (519)-679-2111 + %% Modified by Ray Muzic 14-Jul-1992 + %% 1) add maxstep feature for limiting changes in parameter estimates + %% at each step. + %% 2) remove forced columnization of x (x=x(:)) at beginning. x + %% could be a matrix with the ith row of containing values of + %% the independent variables at the ith observation. + %% 3) add verbose option + %% 4) add optional return arguments covp, stdresid, chi2 + %% 5) revise estimates of corp, stdev + %% Modified by Ray Muzic 11-Oct-1992 + %% 1) revise estimate of Vy. remove chi2, add Z as return values + %% (later remark: the current code contains no variable Vy) + %% Modified by Ray Muzic 7-Jan-1994 + %% 1) Replace ones(x) with a construct that is compatible with versions + %% newer and older than v 4.1. + %% 2) Added global declaration of verbose (needed for newer than v4.x) + %% 3) Replace return value var, the variance of the residuals + %% with covr, the covariance matrix of the residuals. + %% 4) Introduce options as 10th input argument. Include + %% convergence criteria and maxstep in it. + %% 5) Correct calculation of xtx which affects coveraince estimate. + %% 6) Eliminate stdev (estimate of standard deviation of + %% parameter estimates) from the return values. The covp is a + %% much more meaningful expression of precision because it + %% specifies a confidence region in contrast to a confidence + %% interval.. If needed, however, stdev may be calculated as + %% stdev=sqrt(diag(covp)). + %% 7) Change the order of the return values to a more logical order. + %% 8) Change to more efficent algorithm of Bard for selecting epsL. + %% 9) Tighten up memory usage by making use of sparse matrices (if + %% MATLAB version >= 4.0) in computation of covp, corp, stdresid. + %% Modified by Francesco Potortì + %% for use in Octave + %% Added linear inequality constraints with quadratic programming to + %% this file and special case bounds to this file and to dfdp.m + %% (24-Feb-2010) and later also general inequality constraints + %% (12-Apr-2010) (Reference: Bard, Y., 'An eclectic approach to + %% nonlinear programming', Proc. ANU Sem. Optimization, Canberra, + %% Austral. Nat. Univ.). Differences from the reference: adaption to + %% svd-based algorithm, linesearch or stepwidth adaptions to ensure + %% decrease in objective function omitted to rather start a new + %% overall cycle with a new epsL, some performance gains from linear + %% constraints even if general constraints are specified. Equality + %% constraints also implemented. Olaf Till + %% Now split into files leasqr.m and __lm_svd__.m. + + %% needed for some anonymous functions + if (exist ('ifelse') ~= 5) + ifelse = @ scalar_ifelse; + end + + __plot_cmds__ (); % flag persistent variables invalid + + global verbose; + + %% argument processing + %% + + if (nargin > 8) + if (ischar (dFdp)) + dfdp = str2func (dFdp); + else + dfdp = dFdp; + end + end + + if (nargin <= 7) dp=.001*(pin*0+1); end %DT + if (nargin <= 6) wt = ones (size (y)); end % SMB modification + if (nargin <= 5) niter = []; end + if (nargin == 4) stol=.0001; end + if (ischar (F)) F = str2func (F); end + %% + + if (any (size (y) ~= size (wt))) + error ('dimensions of observations and weights do not match'); + end + wtl = wt(:); + pin=pin(:); dp=dp(:); %change all vectors to columns + [rows_y, cols_y] = size (y); + m = rows_y * cols_y; n=length(pin); + f_pin = F (x, pin); + if (any (size (f_pin) ~= size (y))) + error ('dimensions of returned values of model function and of observations do not match'); + end + f_pin = y - f_pin; + + dFdp = @ (p, dfdp_hook) - dfdp (x, y(:) - dfdp_hook.f, p, dp, F); + + %% processing of 'options' + pprec = zeros (n, 1); + maxstep = Inf * ones (n, 1); + have_gencstr = false; % no general constraints + have_genecstr = false; % no general equality constraints + n_gencstr = 0; + mc = zeros (n, 0); + vc = zeros (0, 1); rv = 0; + emc = zeros (n, 0); + evc = zeros (0, 1); erv = 0; + bounds = cat (2, -Inf * ones (n, 1), Inf * ones (n, 1)); + pin_cstr.inequ.lin_except_bounds = [];; + pin_cstr.inequ.gen = [];; + pin_cstr.equ.lin = [];; + pin_cstr.equ.gen = [];; + dfdp_bounds = {}; + cpiv = @ cpiv_bard; + eq_idx = []; % numerical index for equality constraints in all + % constraints, later converted to + % logical index + if (nargin > 9) + if (ismatrix (options)) % backwards compatibility + tp = options; + options = struct ('fract_prec', tp(:, 1)); + if (columns (tp) > 1) + options.max_fract_change = tp(:, 2); + end + end + if (isfield (options, 'cpiv') && ~isempty (options.cpiv)) + %% As yet there is only one cpiv function distributed with leasqr, + %% but this may change; the algorithm of cpiv_bard is said to be + %% relatively fast, but may have disadvantages. + if (ischar (options.cpiv)) + cpiv = str2func (options.cpiv); + else + cpiv = options.cpiv; + end + end + if (isfield (options, 'fract_prec')) + pprec = options.fract_prec; + if (any (size (pprec) ~= [n, 1])) + error ('fractional precisions: wrong dimensions'); + end + end + if (isfield (options, 'max_fract_change')) + maxstep = options.max_fract_change; + if (any (size (maxstep) ~= [n, 1])) + error ('maximum fractional step changes: wrong dimensions'); + end + end + if (isfield (options, 'inequc')) + inequc = options.inequc; + if (ismatrix (inequc{1})) + mc = inequc{1}; + vc = inequc{2}; + if (length (inequc) > 2) + have_gencstr = true; + f_gencstr = inequc{3}; + if (length (inequc) > 3) + df_gencstr = inequc{4}; + else + df_gencstr = @ dcdp; + end + end + else + lid = 0; % no linear constraints + have_gencstr = true; + f_gencstr = inequc{1}; + if (length (inequc) > 1) + if (ismatrix (inequc{2})) + lid = 2; + df_gencstr = @ dcdp; + else + df_gencstr = inequc{2}; + if (length (inequc) > 2) + lid = 3; + end + end + else + df_gencstr = @ dcdp; + end + if (lid) + mc = inequc{lid}; + vc = inequc{lid + 1}; + end + end + if (have_gencstr) + if (ischar (f_gencstr)) + f_gencstr = str2func (f_gencstr); + end + tp = f_gencstr (pin); + n_gencstr = length (tp); + f_gencstr = @ (p, idx) tf_gencstr (p, idx, f_gencstr); + if (ischar (df_gencstr)) + df_gencstr = str2func (df_gencstr); + end + if (strcmp (func2str (df_gencstr), 'dcdp')) + df_gencstr = @ (f, p, dp, idx, db) ... + df_gencstr (f(idx), p, dp, ... + @ (tp) f_gencstr (tp, idx), db{:}); + else + df_gencstr = @ (f, p, dp, idx, db) ... + df_gencstr (f(idx), p, dp, ... + @ (tp) f_gencstr (tp, idx), idx, db{:}); + end + end + [rm, cm] = size (mc); + [rv, cv] = size (vc); + if (rm ~= n || cm ~= rv || cv ~= 1) + error ('linear inequality constraints: wrong dimensions'); + end + pin_cstr.inequ.lin_except_bounds = mc.' * pin + vc; + if (have_gencstr) + pin_cstr.inequ.gen = tp; + end + end + if (isfield (options, 'equc')) + equc = options.equc; + if (ismatrix (equc{1})) + emc = equc{1}; + evc = equc{2}; + if (length (equc) > 2) + have_genecstr = true; + f_genecstr = equc{3}; + if (length (equc) > 3) + df_genecstr = equc{4}; + else + df_genecstr = @ dcdp; + end + end + else + lid = 0; % no linear constraints + have_genecstr = true; + f_genecstr = equc{1}; + if (length (equc) > 1) + if (ismatrix (equc{2})) + lid = 2; + df_genecstr = @ dcdp; + else + df_genecstr = equc{2}; + if (length (equc) > 2) + lid = 3; + end + end + else + df_genecstr = @ dcdp; + end + if (lid) + emc = equc{lid}; + evc = equc{lid + 1}; + end + end + if (have_genecstr) + if (ischar (f_genecstr)) + f_genecstr = str2func (f_genecstr); + end + tp = f_genecstr (pin); + n_genecstr = length (tp); + f_genecstr = @ (p, idx) tf_gencstr (p, idx, f_genecstr); + if (ischar (df_genecstr)) + df_genecstr = str2func (df_genecstr); + end + if (strcmp (func2str (df_genecstr), 'dcdp')) + df_genecstr = @ (f, p, dp, idx, db) ... + df_genecstr (f, p, dp, ... + @ (tp) f_genecstr (tp, idx), db{:}); + else + df_genecstr = @ (f, p, dp, idx, db) ... + df_genecstr (f, p, dp, ... + @ (tp) f_genecstr (tp, idx), idx, db{:}); + end + end + [erm, ecm] = size (emc); + [erv, ecv] = size (evc); + if (erm ~= n || ecm ~= erv || ecv ~= 1) + error ('linear equality constraints: wrong dimensions'); + end + pin_cstr.equ.lin = emc.' * pin + evc; + if (have_genecstr) + pin_cstr.equ.gen = tp; + end + end + if (isfield (options, 'bounds')) + bounds = options.bounds; + if (any (size (bounds) ~= [n, 2])) + error ('bounds: wrong dimensions'); + end + idx = bounds(:, 1) > bounds(:, 2); + tp = bounds(idx, 2); + bounds(idx, 2) = bounds(idx, 1); + bounds(idx, 1) = tp; + %% It is possible to take this decision here, since this frontend + %% is used only with one certain backend. The backend will check + %% this again; but it will not reference 'dp' in its message, + %% thats why the additional check here. + idx = bounds(:, 1) == bounds(:, 2); + if (any (idx)) + warning ('leasqr:constraints', 'lower and upper bounds identical for some parameters, setting the respective elements of dp to zero'); + dp(idx) = 0; + end + %% + tp = eye (n); + lidx = ~isinf (bounds(:, 1)); + uidx = ~isinf (bounds(:, 2)); + mc = cat (2, mc, tp(:, lidx), - tp(:, uidx)); + vc = cat (1, vc, - bounds(lidx, 1), bounds(uidx, 2)); + [rm, cm] = size (mc); + [rv, cv] = size (vc); + dfdp_bounds = {bounds}; + dFdp = @ (p, dfdp_hook) - dfdp (x, y(:) - dfdp_hook.f, p, dp, ... + F, bounds); + end + %% concatenate inequality and equality constraint functions, mc, and + %% vc; update eq_idx, rv, n_gencstr, have_gencstr + if (erv > 0) + mc = cat (2, mc, emc); + vc = cat (1, vc, evc); + eq_idx = rv + 1 : rv + erv; + rv = rv + erv; + end + if (have_genecstr) + eq_idx = cat (2, eq_idx, ... + rv + n_gencstr + 1 : rv + n_gencstr + n_genecstr); + nidxi = 1 : n_gencstr; + nidxe = n_gencstr + 1 : n_gencstr + n_genecstr; + n_gencstr = n_gencstr + n_genecstr; + if (have_gencstr) + f_gencstr = @ (p, idx) cat (1, ... + f_gencstr (p, idx(nidxi)), ... + f_genecstr (p, idx(nidxe))); + df_gencstr = @ (f, p, dp, idx, db) ... + cat (1, ... + df_gencstr (f(nidxi), p, dp, idx(nidxi), db), ... + df_genecstr (f(nidxe), p, dp, idx(nidxe), db)); + else + f_gencstr = f_genecstr; + df_gencstr = df_genecstr; + have_gencstr = true; + end + end + end + if (have_gencstr) + nidxl = 1:rv; + nidxh = rv+1:rv+n_gencstr; + f_cstr = @ (p, idx) ... + cat (1, mc(:, idx(nidxl)).' * p + vc(idx(nidxl), 1), ... + f_gencstr (p, idx(nidxh))); + %% in the case of this interface, diffp is already zero at fixed; + %% also in this special case, dfdp_bounds can be filled in directly + %% --- otherwise it would be a field of hook in the called function + df_cstr = @ (p, idx, dfdp_hook) ... + cat (1, mc(:, idx(nidxl)).', ... + df_gencstr (dfdp_hook.f(nidxh), p, dp, ... + idx(nidxh), ... + dfdp_bounds)); + else + f_cstr = @ (p, idx) mc(:, idx).' * p + vc(idx, 1); + df_cstr = @ (p, idx, dfdp_hook) mc(:, idx).'; + end + + + + %% in a general interface, check for all(fixed) here + + %% passed constraints + hook.mc = mc; % matrix of linear constraints + hook.vc = vc; % vector of linear constraints + hook.f_cstr = f_cstr; % function of all constraints + hook.df_cstr = df_cstr; % function of derivatives of all constraints + hook.n_gencstr = n_gencstr; % number of non-linear constraints + hook.eq_idx = false (size (vc, 1) + n_gencstr, 1); + hook.eq_idx(eq_idx) = true; % logical index of equality constraints in + % all constraints + hook.lbound = bounds(:, 1); % bounds, subset of linear inequality + % constraints in mc and vc + hook.ubound = bounds(:, 2); + + %% passed values of constraints for initial parameters + hook.pin_cstr = pin_cstr; + + %% passed derivative of model function + hook.dfdp = dFdp; + + %% passed function for complementary pivoting + hook.cpiv = cpiv; + + %% passed value of residual function for initial parameters + hook.f_pin = f_pin; + + %% passed options + hook.max_fract_change = maxstep; + hook.fract_prec = pprec; + hook.TolFun = stol; + hook.MaxIter = niter; + hook.weights = wt; + hook.fixed = dp == 0; + if (verbose) + hook.Display = 'iter'; + __plot_cmds__ = @ __plot_cmds__; # for bug #31484 (Octave <= 3.2.4) + hook.plot_cmd = @ (f) __plot_cmds__ (x, y, y - f); + else + hook.Display = 'off'; + end + + %% only preliminary, for testing + hook.testing = false; + hook.new_s = false; + if (exist ('options')) + if (isfield (options, 'testing')) + hook.testing = options.testing; + end + if (isfield (options, 'new_s')) + hook.new_s = options.new_s; + end + end + + [p, resid, cvg, outp] = __lm_svd__ (@ (p) y - F (x, p), pin, hook); + f = y - resid; + iter = outp.niter; + cvg = cvg > 0; + + if (~cvg) disp(' CONVERGENCE NOT ACHIEVED! '); end + + if (~(verbose || nargout > 4)) return; end + + yl = y(:); + f = f(:); + %% CALC VARIANCE COV MATRIX AND CORRELATION MATRIX OF PARAMETERS + %% re-evaluate the Jacobian at optimal values + jac = dFdp (p, struct ('f', f)); + msk = ~hook.fixed; + n = sum(msk); % reduce n to equal number of estimated parameters + jac = jac(:, msk); % use only fitted parameters + + %% following section is Ray Muzic's estimate for covariance and correlation + %% assuming covariance of data is a diagonal matrix proportional to + %% diag(1/wt.^2). + %% cov matrix of data est. from Bard Eq. 7-5-13, and Row 1 Table 5.1 + + tp = wtl.^2; + if (exist('sparse')) % save memory + Q = sparse (1:m, 1:m, 1 ./ tp); + Qinv = sparse (1:m, 1:m, tp); + else + Q = diag (ones (m, 1) ./ tp); + Qinv = diag (tp); + end + resid = resid(:); % un-weighted residuals + if (~isreal (resid)) error ('residuals are not real'); end + tp = resid.' * Qinv * resid; + covr = (tp / m) * Q; %covariance of residuals + + %% Matlab compatibility and avoiding recomputation make the following + %% logic clumsy. + compute = 1; + if (m <= n || any (eq_idx)) + compute = 0; + else + Qinv = ((m - n) / tp) * Qinv; + %% simplified Eq. 7-5-13, Bard; cov of parm est, inverse; outer + %% parantheses contain inverse of guessed covariance matrix of data + covpinv = jac.' * Qinv * jac; + if (exist ('rcond') && rcond (covpinv) <= eps) + compute = 0; + elseif (rank (covpinv) < n) + %% above test is not equivalent to 'rcond' and may unnecessarily + %% reject some matrices + compute = 0; + end + end + if (compute) + covp = inv (covpinv); + d=sqrt(diag(covp)); + corp = covp ./ (d * d.'); + else + covp = NA * ones (n); + corp = covp; + end + + if (exist('sparse')) + covr=spdiags(covr,0); + else + covr=diag(covr); % convert returned values to + % compact storage + end + covr = reshape (covr, rows_y, cols_y); + stdresid = resid .* abs (wtl) / sqrt (tp / m); % equivalent to resid ./ + % sqrt (covr) + stdresid = reshape (stdresid, rows_y, cols_y); + + if (~(verbose || nargout > 8)) return; end + + if (m > n && ~any (eq_idx)) + Z = ((m - n) / (n * resid.' * Qinv * resid)) * covpinv; + else + Z = NA * ones (n); + end + +%%% alt. est. of cov. mat. of parm.:(Delforge, Circulation, 82:1494-1504, 1990 + %%disp('Alternate estimate of cov. of param. est.') + %%acovp=resid'*Qinv*resid/(m-n)*inv(jac'*Qinv*jac); + + if (~(verbose || nargout > 9)) return; end + + %%Calculate R^2, intercept form + %% + tp = sumsq (yl - mean (yl)); + if (tp > 0) + r2 = 1 - sumsq (resid) / tp; + else + r2 = NA; + end + + %% if someone has asked for it, let them have it + %% + if (verbose) + __plot_cmds__ (x, y, f); + disp(' Least Squares Estimates of Parameters') + disp(p.') + disp(' Correlation matrix of parameters estimated') + disp(corp) + disp(' Covariance matrix of Residuals' ) + disp(covr) + disp(' Correlation Coefficient R^2') + disp(r2) + fprintf(' 95%% conf region: F(0.05)(%.0f,%.0f)>= delta_pvec.%s*Z*delta_pvec\n', n, m - n, char (39)); % works with ' and ' + Z + %% runs test according to Bard. p 201. + n1 = sum (resid > 0); + n2 = sum (resid < 0); + nrun=sum(abs(diff(resid > 0)))+1; + if ((n1 > 10) && (n2 > 10)) % sufficent data for test? + zed=(nrun-(2*n1*n2/(n1+n2)+1)+0.5)/(2*n1*n2*(2*n1*n2-n1-n2)... + /((n1+n2)^2*(n1+n2-1))); + if (zed < 0) + prob = erfc(-zed/sqrt(2))/2*100; + disp([num2str(prob),'% chance of fewer than ',num2str(nrun),' runs.']); + else + prob = erfc(zed/sqrt(2))/2*100; + disp([num2str(prob),'% chance of greater than ',num2str(nrun),' runs.']); + end + end + end + +function ret = tf_gencstr (p, idx, f) + + %% necessary since user function f_gencstr might return [] or a row + %% vector + + ret = f (p, idx); + if (isempty (ret)) + ret = zeros (0, 1); + elseif (size (ret, 2) > 1) + ret = ret(:); + end + +function fval = scalar_ifelse (cond, tval, fval) + + %% needed for some anonymous functions, builtin ifelse only available + %% in Octave > 3.2; we need only the scalar case here + + if (cond) + fval = tval; + end + +%!demo +%! % Define functions +%! leasqrfunc = @(x, p) p(1) * exp (-p(2) * x); +%! leasqrdfdp = @(x, f, p, dp, func) [exp(-p(2)*x), -p(1)*x.*exp(-p(2)*x)]; +%! +%! % generate test data +%! t = [1:10:100]'; +%! p = [1; 0.1]; +%! data = leasqrfunc (t, p); +%! +%! rnd = [0.352509; -0.040607; -1.867061; -1.561283; 1.473191; ... +%! 0.580767; 0.841805; 1.632203; -0.179254; 0.345208]; +%! +%! % add noise +%! % wt1 = 1 /sqrt of variances of data +%! % 1 / wt1 = sqrt of var = standard deviation +%! wt1 = (1 + 0 * t) ./ sqrt (data); +%! data = data + 0.05 * rnd ./ wt1; +%! +%! % Note by Thomas Walter : +%! % +%! % Using a step size of 1 to calculate the derivative is WRONG !!!! +%! % See numerical mathbooks why. +%! % A derivative calculated from central differences need: s +%! % step = 0.001...1.0e-8 +%! % And onesided derivative needs: +%! % step = 1.0e-5...1.0e-8 and may be still wrong +%! +%! F = leasqrfunc; +%! dFdp = leasqrdfdp; % exact derivative +%! % dFdp = dfdp; % estimated derivative +%! dp = [0.001; 0.001]; +%! pin = [.8; .05]; +%! stol=0.001; niter=50; +%! minstep = [0.01; 0.01]; +%! maxstep = [0.8; 0.8]; +%! options = [minstep, maxstep]; +%! +%! global verbose; +%! verbose = 1; +%! [f1, p1, kvg1, iter1, corp1, covp1, covr1, stdresid1, Z1, r21] = ... +%! leasqr (t, data, pin, F, stol, niter, wt1, dp, dFdp, options); + +%!demo +%! %% Example for linear inequality constraints. +%! %% model function: +%! F = @ (x, p) p(1) * exp (p(2) * x); +%! %% independents and dependents: +%! x = 1:5; +%! y = [1, 2, 4, 7, 14]; +%! %% initial values: +%! init = [.25; .25]; +%! %% other configuration (default values): +%! tolerance = .0001; +%! max_iterations = 20; +%! weights = ones (1, 5); +%! dp = [.001; .001]; % bidirectional numeric gradient stepsize +%! dFdp = 'dfdp'; % function for gradient (numerical) +%! +%! %% linear constraints, A.' * parametervector + B >= 0 +%! A = [1; -1]; B = 0; % p(1) >= p(2); +%! options.inequc = {A, B}; +%! +%! %% start leasqr, be sure that 'verbose' is not set +%! global verbose; verbose = false; +%! [f, p, cvg, iter] = ... +%! leasqr (x, y, init, F, tolerance, max_iterations, ... +%! weights, dp, dFdp, options) diff --git a/octave_packages/optim-1.2.0/line_min.m b/octave_packages/optim-1.2.0/line_min.m new file mode 100644 index 0000000..335e0f9 --- /dev/null +++ b/octave_packages/optim-1.2.0/line_min.m @@ -0,0 +1,83 @@ +## Copyright (C) 2000 Ben Sapp +## Copyright (C) 2002 Etienne Grossmann +## Copyright (C) 2011 Nir Krakauer nkrakauer@ccny.cuny.edu +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## [a,fx,nev] = line_min (f, dx, args, narg, h, nev_max) - Minimize f() along dx +## +## INPUT ---------- +## f : string : Name of minimized function +## dx : matrix : Direction along which f() is minimized +## args : cell : Arguments of f +## narg : integer : Position of minimized variable in args. Default=1 +## h : scalar : Step size to use for centered finite difference +## approximation of first and second derivatives. Default=1E-3. +## nev_max : integer : Maximum number of function evaluations. Default=30 +## +## OUTPUT --------- +## a : scalar : Value for which f(x+a*dx) is a minimum (*) +## fx : scalar : Value of f(x+a*dx) at minimum (*) +## nev : integer : Number of function evaluations +## +## (*) The notation f(x+a*dx) assumes that args == {x}. +## +## Reference: David G Luenberger's Linear and Nonlinear Programming + +function [a,fx,nev] = line_min (f, dx, args, narg, h, nev_max) + velocity = 1; + acceleration = 1; + + if (nargin < 4) narg = 1; endif + if (nargin < 5) h = 0.001; endif + if (nargin < 6) nev_max = 30; endif + + nev = 0; + x = args{narg}; + a = 0; + + min_velocity_change = 0.000001; + + while (abs (velocity) > min_velocity_change && nev < nev_max) + fx = feval (f,args{1:narg-1}, x+a*dx, args{narg+1:end}); + fxph = feval (f,args{1:narg-1}, x+(a+h)*dx, args{narg+1:end}); + fxmh = feval (f,args{1:narg-1}, x+(a-h)*dx, args{narg+1:end}); + if (nev == 0) + fx0 = fx; + endif + + velocity = (fxph - fxmh)/(2*h); + acceleration = (fxph - 2*fx + fxmh)/(h^2); + if abs(acceleration) <= eps, acceleration = 1; end # Don't do div by zero + # Use abs(accel) to avoid problems due to + # concave function + a = a - velocity/abs(acceleration); + nev += 3; + endwhile + + fx = feval (f, args{1:narg-1}, x+a*dx, args{narg+1:end}); + nev++; + if fx >= fx0 # if no improvement, return the starting value + a = 0; + fx = fx0; + endif + + if (nev >= nev_max) + disp ("line_min: maximum number of function evaluations reached") + endif + +endfunction + +## Rem : Although not clear from the code, the returned a always seems to +## correspond to (nearly) optimal fx. diff --git a/octave_packages/optim-1.2.0/linprog.m b/octave_packages/optim-1.2.0/linprog.m new file mode 100644 index 0000000..ec8d14e --- /dev/null +++ b/octave_packages/optim-1.2.0/linprog.m @@ -0,0 +1,159 @@ +## Copyright (C) 2009 Luca Favatella +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{x} =} linprog (@var{f}, @var{A}, @var{b}) +## @deftypefnx{Function File} {@var{x} =} linprog (@var{f}, @var{A}, @var{b}, @var{Aeq}, @var{beq}) +## @deftypefnx{Function File} {@var{x} =} linprog (@var{f}, @var{A}, @var{b}, @var{Aeq}, @var{beq}, @var{lb}, @var{ub}) +## @deftypefnx{Function File} {[@var{x}, @var{fval}] =} linprog (@dots{}) +## Solve a linear problem. +## +## Finds +## +## @example +## min (f' * x) +## @end example +## +## (both f and x are column vectors) subject to +## +## @example +## @group +## A * x <= b +## Aeq * x = beq +## lb <= x <= ub +## @end group +## @end example +## +## If not specified, @var{Aeq} and @var{beq} default to empty matrices. +## +## If not specified, the lower bound @var{lb} defaults to minus infinite +## and the upper bound @var{ub} defaults to infinite. +## +## @seealso{glpk} +## @end deftypefn + +function [x fval] = linprog (f, A, b, + Aeq = [], beq = [], + lb = [], ub = []) + + if (((nargin != 3) && (nargin != 5) && (nargin != 7)) || + (nargout > 2)) + print_usage (); + endif + + nr_f = rows(f); + + # Sanitize A and b + if (isempty (A) && isempty (b)) + A = zeros (0, nr_f); + b = zeros (rows (A), 1); + endif + + nr_A = rows (A); + + if (columns (f) != 1) + error ("f must be a column vector"); + elseif (columns (A) != nr_f) + error ("columns (A) != rows (f)"); + elseif (size (b) != [nr_A 1]) + error ("size (b) != [(rows (A)) 1]"); + else + + ## Sanitize Aeq + if (isempty (Aeq)) + Aeq = zeros (0, nr_f); + endif + if (columns (Aeq) != nr_f) + error ("columns (Aeq) != rows (f)"); + endif + + ## Sanitize beq + if (isempty (beq)) + beq = zeros (0, 1); + endif + nr_Aeq = rows (Aeq); + if (size (beq) != [nr_Aeq 1]) + error ("size (beq) != [(rows (Aeq)) 1]"); + endif + + ## Sanitize lb + if (isempty (lb)) + lb = - Inf (nr_f, 1); + endif + if (size (lb) != [nr_f 1]) + error ("size (lb) != [(rows (f)) 1]"); + endif + + ## Sanitize ub + if (isempty (ub)) + ub = Inf (nr_f, 1); + endif + if (size (ub) != [nr_f 1]) + error ("size (ub) != [(rows (f)) 1]"); + endif + + + ## Call glpk + ctype = [(repmat ("U", nr_A, 1)); + (repmat ("S", nr_Aeq, 1))]; + [x(1:nr_f, 1) fval(1, 1)] = glpk (f, [A; Aeq], [b; beq], lb, ub, ctype); + + endif + +endfunction + +%!test +%! f = [1; -1]; +%! A = []; +%! b = []; +%! Aeq = [1, 0]; +%! beq = [2]; +%! lb = [0; Inf]; +%! ub = [-Inf; 0]; +%! x_exp = [2; 0]; +%! assert (linprog (f, A, b, Aeq, beq, lb, ub), x_exp); + +%!shared f, A, b, lb, ub, x_exp, fval_exp +%! f = [21 25 31 34 23 19 32 36 27 25 19]'; +%! +%! A1 = [ 1 0 0 0 1 0 0 1 0 0 0; +%! 0 1 0 0 0 1 0 0 1 0 0; +%! 0 0 1 0 0 0 0 0 0 1 0; +%! 0 0 0 1 0 0 1 0 0 0 1]; +%! A2 = [ 1 1 1 1 0 0 0 0 0 0 0; +%! 0 0 0 0 1 1 1 0 0 0 0; +%! 0 0 0 0 0 0 0 1 1 1 1]; +%! A = [-A1; A2]; +%! +%! b1 = [40; 50; 50; 70]; +%! b2 = [100; 60; 50]; +%! b = [-b1; b2]; +%! +%! lb = zeros (rows (f), 1); +%! ub = Inf (rows (f), 1); +%! +%! x_exp = [40 0 50 10 0 50 10 0 0 0 50]'; +%! fval_exp = f' * x_exp; +%! +%!test +%! Aeq = []; +%! beq = []; +%! [x_obs fval_obs] = linprog (f, A, b, Aeq, beq, lb, ub); +%! assert ([x_obs; fval_obs], [x_exp; fval_exp]); +%! +%!test +%! Aeq = zeros (1, rows (f)); +%! beq = 0; +%! assert (linprog (f, A, b, Aeq, beq, lb, ub), x_exp); diff --git a/octave_packages/optim-1.2.0/mdsmax.m b/octave_packages/optim-1.2.0/mdsmax.m new file mode 100644 index 0000000..f650eb6 --- /dev/null +++ b/octave_packages/optim-1.2.0/mdsmax.m @@ -0,0 +1,200 @@ +%% Copyright (C) 2002 N.J.Higham +%% Copyright (C) 2003 Andy Adler +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%%MDSMAX Multidirectional search method for direct search optimization. +%% [x, fmax, nf] = MDSMAX(FUN, x0, STOPIT, SAVIT) attempts to +%% maximize the function FUN, using the starting vector x0. +%% The method of multidirectional search is used. +%% Output arguments: +%% x = vector yielding largest function value found, +%% fmax = function value at x, +%% nf = number of function evaluations. +%% The iteration is terminated when either +%% - the relative size of the simplex is <= STOPIT(1) +%% (default 1e-3), +%% - STOPIT(2) function evaluations have been performed +%% (default inf, i.e., no limit), or +%% - a function value equals or exceeds STOPIT(3) +%% (default inf, i.e., no test on function values). +%% The form of the initial simplex is determined by STOPIT(4): +%% STOPIT(4) = 0: regular simplex (sides of equal length, the default), +%% STOPIT(4) = 1: right-angled simplex. +%% Progress of the iteration is not shown if STOPIT(5) = 0 (default 1). +%% If a non-empty fourth parameter string SAVIT is present, then +%% `SAVE SAVIT x fmax nf' is executed after each inner iteration. +%% NB: x0 can be a matrix. In the output argument, in SAVIT saves, +%% and in function calls, x has the same shape as x0. +%% MDSMAX(fun, x0, STOPIT, SAVIT, P1, P2,...) allows additional +%% arguments to be passed to fun, via feval(fun,x,P1,P2,...). +%% +%% This implementation uses 2n^2 elements of storage (two simplices), where x0 +%% is an n-vector. It is based on the algorithm statement in [2, sec.3], +%% modified so as to halve the storage (with a slight loss in readability). +%% +%% References: +%% [1] V. J. Torczon, Multi-directional search: A direct search algorithm for +%% parallel machines, Ph.D. Thesis, Rice University, Houston, Texas, 1989. +% [2] V. J. Torczon, On the convergence of the multidirectional search +%% algorithm, SIAM J. Optimization, 1 (1991), pp. 123-145. +%% [3] N. J. Higham, Optimization by direct search in matrix computations, +%% SIAM J. Matrix Anal. Appl, 14(2): 317-333, 1993. +%% [4] N. J. Higham, Accuracy and Stability of Numerical Algorithms, +%% Second edition, Society for Industrial and Applied Mathematics, +%% Philadelphia, PA, 2002; sec. 20.5. + +% From Matrix Toolbox +% Copyright (C) 2002 N.J.Higham +% www.maths.man.ac.uk/~higham/mctoolbox +% Modifications for octave by A.Adler 2003 + +function [x, fmax, nf] = mdsmax(fun, x, stopit, savit, varargin) + +x0 = x(:); % Work with column vector internally. +n = length(x0); + +mu = 2; % Expansion factor. +theta = 0.5; % Contraction factor. + +% Set up convergence parameters etc. +if nargin < 3 + stopit(1) = 1e-3; +elseif isempty(stopit) + stopit(1) = 1e-3; +endif +tol = stopit(1); % Tolerance for cgce test based on relative size of simplex. +if length(stopit) == 1, stopit(2) = inf; end % Max no. of f-evaluations. +if length(stopit) == 2, stopit(3) = inf; end % Default target for f-values. +if length(stopit) == 3, stopit(4) = 0; end % Default initial simplex. +if length(stopit) == 4, stopit(5) = 1; end % Default: show progress. +trace = stopit(5); +if length(stopit) == 5, stopit(6) = 1; end % Default: maximize +dirn= stopit(6); +if nargin < 4, savit = []; end % File name for snapshots. + +V = [zeros(n,1) eye(n)]; T = V; +f = zeros(n+1,1); ft = f; +V(:,1) = x0; f(1) = dirn*feval(fun,x,varargin{:}); +fmax_old = f(1); + +if trace, fprintf('f(x0) = %9.4e\n', f(1)), end + +k = 0; m = 0; + +% Set up initial simplex. +scale = max(norm(x0,inf),1); +if stopit(4) == 0 + % Regular simplex - all edges have same length. + % Generated from construction given in reference [18, pp. 80-81] of [1]. + alpha = scale / (n*sqrt(2)) * [ sqrt(n+1)-1+n sqrt(n+1)-1 ]; + V(:,2:n+1) = (x0 + alpha(2)*ones(n,1)) * ones(1,n); + for j=2:n+1 + V(j-1,j) = x0(j-1) + alpha(1); + x(:) = V(:,j); f(j) = dirn*feval(fun,x,varargin{:}); + end +else + % Right-angled simplex based on co-ordinate axes. + alpha = scale*ones(n+1,1); + for j=2:n+1 + V(:,j) = x0 + alpha(j)*V(:,j); + x(:) = V(:,j); f(j) = dirn*feval(fun,x,varargin{:}); + end +end +nf = n+1; +size = 0; % Integer that keeps track of expansions/contractions. +flag_break = 0; % Flag which becomes true when ready to quit outer loop. + +while 1 %%%%%% Outer loop. +k = k+1; + +% Find a new best vertex x and function value fmax = f(x). +[fmax,j] = max(f); +V(:,[1 j]) = V(:,[j 1]); v1 = V(:,1); +if ~isempty(savit), x(:) = v1; eval(['save ' savit ' x fmax nf']), end +f([1 j]) = f([j 1]); +if trace + fprintf('Iter. %2.0f, inner = %2.0f, size = %2.0f, ', k, m, size) + fprintf('nf = %3.0f, f = %9.4e (%2.1f%%)\n', nf, fmax, ... + 100*(fmax-fmax_old)/(abs(fmax_old)+eps)) +end +fmax_old = fmax; + +% Stopping Test 1 - f reached target value? +if fmax >= stopit(3) + msg = ['Exceeded target...quitting\n']; + break % Quit. +end + +m = 0; +while 1 %%% Inner repeat loop. + m = m+1; + + % Stopping Test 2 - too many f-evals? + if nf >= stopit(2) + msg = ['Max no. of function evaluations exceeded...quitting\n']; + flag_break = 1; break % Quit. + end + + % Stopping Test 3 - converged? This is test (4.3) in [1]. + size_simplex = norm(V(:,2:n+1)- v1(:,ones(1,n)),1) / max(1, norm(v1,1)); + if size_simplex <= tol + msg = sprintf('Simplex size %9.4e <= %9.4e...quitting\n', ... + size_simplex, tol); + flag_break = 1; break % Quit. + end + + for j=2:n+1 % ---Rotation (reflection) step. + T(:,j) = 2*v1 - V(:,j); + x(:) = T(:,j); ft(j) = dirn*feval(fun,x,varargin{:}); + end + nf = nf + n; + + replaced = ( max(ft(2:n+1)) > fmax ); + + if replaced + for j=2:n+1 % ---Expansion step. + V(:,j) = (1-mu)*v1 + mu*T(:,j); + x(:) = V(:,j); f(j) = dirn*feval(fun,x,varargin{:}); + end + nf = nf + n; + % Accept expansion or rotation? + if max(ft(2:n+1)) > max(f(2:n+1)) + V(:,2:n+1) = T(:,2:n+1); f(2:n+1) = ft(2:n+1); % Accept rotation. + else + size = size + 1; % Accept expansion (f and V already set). + end + else + for j=2:n+1 % ---Contraction step. + V(:,j) = (1+theta)*v1 - theta*T(:,j); + x(:) = V(:,j); f(j) = dirn*feval(fun,x,varargin{:}); + end + nf = nf + n; + replaced = ( max(f(2:n+1)) > fmax ); + % Accept contraction (f and V already set). + size = size - 1; + end + + if replaced, break, end + if (trace && rem(m, 10) == 0) + fprintf(' ...inner = %2.0f...\n', m); + end + end %%% Of inner repeat loop. + +if flag_break, break, end +end %%%%%% Of outer loop. + +% Finished. +if trace, fprintf(msg), end +x(:) = v1; diff --git a/octave_packages/optim-1.2.0/minimize.m b/octave_packages/optim-1.2.0/minimize.m new file mode 100644 index 0000000..02a9bbe --- /dev/null +++ b/octave_packages/optim-1.2.0/minimize.m @@ -0,0 +1,297 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## [x,v,nev,...] = minimize (f,args,...) - Minimize f +## +## ARGUMENTS +## f : string : Name of function. Must return a real value +## args : list or : List of arguments to f (by default, minimize the first) +## matrix : f's only argument +## +## RETURNED VALUES +## x : matrix : Local minimum of f. Let's suppose x is M-by-N. +## v : real : Value of f in x0 +## nev : integer : Number of function evaluations +## or 1 x 2 : Number of function and derivative evaluations (if +## derivatives are used) +## +## +## Extra arguments are either a succession of option-value pairs or a single +## list or struct of option-value pairs (for unary options, the value in the +## struct is ignored). +## +## OPTIONS : DERIVATIVES Derivatives may be used if one of these options +## --------------------- uesd. Otherwise, the Nelder-Mean (see +## nelder_mead_min) method is used. +## +## 'd2f', d2f : Name of a function that returns the value of f, of its +## 1st and 2nd derivatives : [fx,dfx,d2fx] = feval (d2f, x) +## where fx is a real number, dfx is 1x(M*N) and d2fx is +## (M*N)x(M*N). A Newton-like method (d2_min) will be used. +## +## 'hess' : Use [fx,dfx,d2fx] = leval (f, args) to compute 1st and +## 2nd derivatives, and use a Newton-like method (d2_min). +## +## 'd2i', d2i : Name of a function that returns the value of f, of its +## 1st and pseudo-inverse of second derivatives : +## [fx,dfx,id2fx] = feval (d2i, x) where fx is a real +## number, dfx is 1x(M*N) and d2ix is (M*N)x(M*N). +## A Newton-like method will be used (see d2_min). +## +## 'ihess' : Use [fx,dfx,id2fx] = leval (f, args) to compute 1st +## derivative and the pseudo-inverse of 2nd derivatives, +## and use a Newton-like method (d2_min). +## +## NOTE : df, d2f or d2i take the same arguments as f. +## +## 'order', n : Use derivatives of order n. If the n'th order derivative +## is not specified by 'df', 'd2f' or 'd2i', it will be +## computed numerically. Currently, only order 1 works. +## +## 'ndiff' : Use a variable metric method (bfgs) using numerical +## differentiation. +## +## OPTIONS : STOPPING CRITERIA Default is to use 'tol' +## --------------------------- +## 'ftol', ftol : Stop search when value doesn't improve, as tested by +## +## ftol > Deltaf/max(|f(x)|,1) +## +## where Deltaf is the decrease in f observed in the last +## iteration. Default=10*eps +## +## 'utol', utol : Stop search when updates are small, as tested by +## +## tol > max { dx(i)/max(|x(i)|,1) | i in 1..N } +## +## where dx is the change in the x that occured in the last +## iteration. +## +## 'dtol',dtol : Stop search when derivatives are small, as tested by +## +## dtol > max { df(i)*max(|x(i)|,1)/max(v,1) | i in 1..N } +## +## where x is the current minimum, v is func(x) and df is +## the derivative of f in x. This option is ignored if +## derivatives are not used in optimization. +## +## MISC. OPTIONS +## ------------- +## 'maxev', m : Maximum number of function evaluations +## +## 'narg' , narg : Position of the minimized argument in args <1> +## 'isz' , step : Initial step size (only for 0 and 1st order method) <1> +## Should correspond to expected distance to minimum +## 'verbose' : Display messages during execution +## +## 'backend' : Instead of performing the minimization itself, return +## [backend, control], the name and control argument of the +## backend used by minimize(). Minimimzation can then be +## obtained without the overhead of minimize by calling, if +## a 0 or 1st order method is used : +## +## [x,v,nev] = feval (backend, args, control) +## +## or, if a 2nd order method is used : +## +## [x,v,nev] = feval (backend, control.d2f, args, control) + +function [x,v,nev,varargout] = minimize (f,args,varargin) + +## Oldies +## +## 'df' , df : Name of a function that returns the derivatives of f +## in x : dfx = feval (df, x) where dfx is 1x(M*N). A +## variable metric method (see bfgs) will be used. +## +## 'jac' : Use [fx, dfx] = leval(f, args) to compute derivatives +## and use a variable metric method (bfgs). +## + + +# #################################################################### +# Read the options ################################################### +# #################################################################### +# Options with a value +op1 = "ftol utol dtol df d2f d2i order narg maxev isz"; +# Boolean options +op0 = "verbose backend jac hess ihess ndiff" ; + +default = struct ("backend",0,"verbose",0,\ + "df","", "df", "","d2f","","d2i","", \ + "hess", 0, "ihess", 0, "jac", 0,"ndiff", 0, \ + "ftol" ,nan, "utol",nan, "dtol", nan,\ + "order",nan, "narg",nan, "maxev",nan,\ + "isz", nan); + +if nargin == 3 # Accomodation to struct and list optional + tmp = varargin{1}; + + if isstruct (tmp) + opls = {}; + for [v,k] = tmp # Treat separately unary and binary opts + if findstr ([" ",k," "],op0) + opls (end+1) = {k}; # append k + else + opls (end+[1:2]) = {k, v}; # append k and v + end + end + elseif iscell (tmp) + opls = tmp; + else + opls = {tmp}; + end +else + opls = varargin; +end +ops = read_options (opls,\ + "op0",op0, "op1",op1, "default",default); + +backend=ops.backend; verbose=ops.verbose; +df=ops.df; d2f=ops.d2f; d2i=ops.d2i; +hess=ops.hess; ihess=ops.ihess; jac=ops.jac; +ftol=ops.ftol; utol=ops.utol; dtol=ops.dtol; +order=ops.order; narg=ops.narg; maxev=ops.maxev; +isz=ops.isz; ndiff=ops.ndiff; + +if length (df), error ("Option 'df' doesn't exist any more. Sorry.\n");end +if jac, error ("Option 'jac' doesn't exist any more. Sorry.\n");end + + # Basic coherence checks ############# + +ws = ""; # Warning string +es = ""; # Error string + + # Warn if more than 1 differential is given +if !!length (df) + !!length (d2f) + !!length (d2i) + jac + hess + ihess + \ + ndiff > 1 + # Order of preference of + if length (d2i), ws = [ws,"d2i='",d2i,"', "]; end + if length (d2f), ws = [ws,"d2f='",d2f,"', "]; end + if length (df), ws = [ws,"df='",df,"', "]; end + if hess , ws = [ws,"hess, "]; end + if ihess , ws = [ws,"ihess, "]; end + if jac , ws = [ws,"jac, "]; end + if ndiff , ws = [ws,"ndiff, "]; end + ws = ws(1:length(ws)-2); + ws = ["Options ",ws," were passed. Only one will be used\n"] +end + + # Check that enough args are passed to call + # f(), unless backend is specified, in which + # case I don't need to call f() +if ! isnan (narg) && ! backend + if narg > 1 + es = [es,sprintf("narg=%i, but a single argument was passed\n",narg)]; + end +end + +if length (ws), warn (ws); end +if length (es), error (es); end # EOF Basic coherence checks ######### + + +op = 0; # Set if any option is passed and should be + # passed to backend + +if ! isnan (ftol) , ctls.ftol = ftol; op = 1; end +if ! isnan (utol) , ctls.utol = utol; op = 1; end +if ! isnan (dtol) , ctls.dtol = dtol; op = 1; end +if ! isnan (maxev) , ctls.maxev = maxev; op = 1; end +if ! isnan (narg) , ctls.narg = narg; op = 1; end +if ! isnan (isz) , ctls.isz = isz; op = 1; end +if verbose , ctls.verbose = 1; op = 1; end + + # defaults That are used in this function : +if isnan (narg), narg = 1; end + + # ########################################## + # Choose one optimization method ########### + # Choose according to available derivatives +if ihess, d2f = f; ctls.id2f = 1; op = 1; +elseif hess, d2f = f; +end + + +if length (d2i), method = "d2_min"; ctls.id2f = 1; op = 1; d2f = d2i; +elseif length (d2f), method = "d2_min"; +### elseif length (df) , method = "bfgsmin"; ctls.df = df; op = 1; +### elseif jac , method = "bfgsmin"; ctls.jac = 1 ; op = 1; + ## else method = "nelder_mead_min"; + ## end + # Choose method because ndiff is passed #### +elseif ndiff , method = "bfgsmin"; + + # Choose method by specifying order ######## +elseif ! isnan (order) + + if order == 0, method = "nelder_mead_min"; + elseif order == 1 + method = "bfgsmin"; + + elseif order == 2 + if ! (length (d2f) || length (d2i)) + error ("minimize(): 'order' is 2, but 2nd differential is missing\n"); + end + else + error ("minimize(): 'order' option only implemented for order<=2\n"); + end +else # Default is nelder_mead_min + method = "nelder_mead_min"; +end # EOF choose method ######################## + +if verbose + printf ("minimize(): Using '%s' as back-end\n",method); +end + + # More checks ############################## +ws = ""; +if !isnan (isz) && strcmp (method,"d2_min") + ws = [ws,"option 'isz' is passed to method that doesn't use it"]; +end +if length (ws), warn (ws); end + # EOF More checks ########################## + +if strcmp (method, "d2_min"), all_args = {f, d2f, args}; +elseif strcmp (method, "bfgsmin"),all_args = {f, args}; +else all_args = {f, args}; +end + # Eventually add ctls to argument list +if op, all_args{end+1} = ctls; end + +if ! backend # Call the backend ################### + if strcmp (method, "d2_min"), + [x,v,nev,h] = d2_min(all_args{:}); + # Eventually return inverse of Hessian + if nargout > 3, varargout{1} = h; vr_val_cnt=2; end + elseif strcmp (method, "bfgsmin") + nev = nan; + if !iscell(args), args = {args}; end + if isnan (ftol), ftol = 1e-12; end # Use bfgsmin's defaults + if isnan (utol), utol = 1e-6; end + if isnan (dtol), dtol = 1e-5; end + if isnan (maxev), maxev = inf; end + [x, v, okcv] = bfgsmin (f, args, {maxev,verbose,1,narg,0,ftol,utol,dtol}); + else + [x,v,nev] = feval (method, all_args{:}); + end + +else # Don't call backend, just return its name + # and arguments. + + x = method; + if op, v = ctls; else v = []; end +end + + diff --git a/octave_packages/optim-1.2.0/nelder_mead_min.m b/octave_packages/optim-1.2.0/nelder_mead_min.m new file mode 100644 index 0000000..860dfb8 --- /dev/null +++ b/octave_packages/optim-1.2.0/nelder_mead_min.m @@ -0,0 +1,352 @@ +## Copyright (C) 2002-2008 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## [x0,v,nev] = nelder_mead_min (f,args,ctl) - Nelder-Mead minimization +## +## Minimize 'f' using the Nelder-Mead algorithm. This function is inspired +## from the that found in the book "Numerical Recipes". +## +## ARGUMENTS +## --------- +## f : string : Name of function. Must return a real value +## args : list : Arguments passed to f. +## or matrix : f's only argument +## ctl : vector : (Optional) Control variables, described below +## or struct +## +## RETURNED VALUES +## --------------- +## x0 : matrix : Local minimum of f +## v : real : Value of f in x0 +## nev : number : Number of function evaluations +## +## CONTROL VARIABLE : (optional) may be named arguments (i.e. "name",value +## ------------------ pairs), a struct, or a vector of length <= 6, where +## NaN's are ignored. Default values are written . +## OPT. VECTOR +## NAME POS +## ftol,f N/A : Stopping criterion : stop search when values at simplex +## vertices are all alike, as tested by +## +## f > (max_i (f_i) - min_i (f_i)) /max(max(|f_i|),1) +## +## where f_i are the values of f at the vertices. <10*eps> +## +## rtol,r N/A : Stop search when biggest radius of simplex, using +## infinity-norm, is small, as tested by : +## +## ctl(2) > Radius <10*eps> +## +## vtol,v N/A : Stop search when volume of simplex is small, tested by +## +## ctl(2) > Vol +## +## crit,c ctl(1) : Set one stopping criterion, 'ftol' (c=1), 'rtol' (c=2) +## or 'vtol' (c=3) to the value of the 'tol' option. <1> +## +## tol, t ctl(2) : Threshold in termination test chosen by 'crit' <10*eps> +## +## narg ctl(3) : Position of the minimized argument in args <1> +## maxev ctl(4) : Maximum number of function evaluations. This number +## may be slightly exceeded. +## isz ctl(5) : Size of initial simplex, which is : <1> +## +## { x + e_i | i in 0..N } +## +## Where x == args{narg} is the initial value +## e_0 == zeros (size (x)), +## e_i(j) == 0 if j != i and e_i(i) == ctl(5) +## e_i has same size as x +## +## Set ctl(5) to the distance you expect between the starting +## point and the minimum. +## +## rst ctl(6) : When a minimum is found the algorithm restarts next to +## it until the minimum does not improve anymore. ctl(6) is +## the maximum number of restarts. Set ctl(6) to zero if +## you know the function is well-behaved or if you don't +## mind not getting a true minimum. <0> +## +## verbose, v Be more or less verbose (quiet=0) <0> + +function [x,v,nev] = nelder_mead_min (f, args, varargin) + +verbose = 0; + + # Default control variables +ftol = rtol = 10*eps; # Stop either by likeness of values or +vtol = nan; # radius, but don't care about volume. +crit = 0; # Stopping criterion ctl(1) +tol = 10*eps; # Stopping test's threshold ctl(2) +narg = 1; # Position of minimized arg ctl(3) +maxev = inf; # Max num of func evaluations ctl(4) +isz = 1; # Initial size ctl(5) +rst = 0; # Max # of restarts + + +if nargin >= 3, # Read control arguments + va_arg_cnt = 1; + if nargin > 3, + ctl = struct (varargin{:}); + else + ctl = varargin{va_arg_cnt++}; + end + if isnumeric (ctl) + if length (ctl)>=1 && !isnan (ctl(1)), crit = ctl(1); end + if length (ctl)>=2 && !isnan (ctl(2)), tol = ctl(2); end + if length (ctl)>=3 && !isnan (ctl(3)), narg = ctl(3); end + if length (ctl)>=4 && !isnan (ctl(4)), maxev = ctl(4); end + if length (ctl)>=5 && !isnan (ctl(5)), isz = ctl(5); end + if length (ctl)>=6 && !isnan (ctl(6)), rst = ctl(6); end + else + if isfield (ctl, "crit") && ! isnan (ctl.crit ), crit = ctl.crit ; end + if isfield (ctl, "tol") && ! isnan (ctl.tol ), tol = ctl.tol ; end + if isfield (ctl, "ftol") && ! isnan (ctl.ftol ), ftol = ctl.ftol ; end + if isfield (ctl, "rtol") && ! isnan (ctl.rtol ), rtol = ctl.rtol ; end + if isfield (ctl, "vtol") && ! isnan (ctl.vtol ), vtol = ctl.vtol ; end + if isfield (ctl, "narg") && ! isnan (ctl.narg ), narg = ctl.narg ; end + if isfield (ctl,"maxev") && ! isnan (ctl.maxev), maxev = ctl.maxev; end + if isfield (ctl, "isz") && ! isnan (ctl.isz ), isz = ctl.isz ; end + if isfield (ctl, "rst") && ! isnan (ctl.rst ), rst = ctl.rst ; end + if isfield(ctl,"verbose")&& !isnan(ctl.verbose),verbose=ctl.verbose;end + end +end + + +if crit == 1, ftol = tol; +elseif crit == 2, rtol = tol; +elseif crit == 3, vtol = tol; +elseif crit, error ("crit is %i. Should be 1,2 or 3.\n"); +end + +if iscell (args) + x = args{1}; +else # Single argument + x = args; + args = {args}; +endif + +if narg > length (args) # Check + error ("nelder_mead_min : narg==%i, length (args)==%i\n", + narg, length (args)); +end + +[R,C] = size (x); +N = R*C; # Size of argument +x = x(:); + # Initial simplex +u = isz * eye (N+1,N) + ones(N+1,1)*x'; + +y = zeros (N+1,1); +for i = 1:N+1, + y(i) = feval (f, args{1:narg-1},reshape(u(i,:),R,C),args{narg+1:end}); +end ; +nev = N+1; + +[ymin,imin] = min(y); +ymin0 = ymin; +## y +nextprint = 0 ; +v = nan; +while nev <= maxev, + + ## ymin, ymax, ymx2 : lowest, highest and 2nd highest function values + ## imin, imax, imx2 : indices of vertices with these values + [ymin,imin] = min(y); [ymax,imax] = max(y) ; + y(imax) = ymin ; + [ymx2,imx2] = max(y) ; + y(imax) = ymax ; + + ## ymin may be > ymin0 after restarting + ## if ymin > ymin0 , + ## "nelder-mead : Whoa 'downsimplex' Should be renamed 'upsimplex'" + ## keyboard + ## end + + # Compute stopping criterion + done = 0; + if ! isnan (ftol), + done |= ((max(y)-min(y)) / max(1,max(abs(y))) < ftol); + end + if ! isnan (rtol), + done |= (2*max (max (u) - min (u)) < rtol); + end + if ! isnan (vtol) + done |= (abs (det (u(1:N,:)-ones(N,1)*u(N+1,:)))/factorial(N) < vtol); + end + ## [ 2*max (max (u) - min (u)), abs (det (u(1:N,:)-ones(N,1)*u(N+1,:)))/factorial(N);\ + ## rtol, vtol] + + # Eventually print some info + if verbose && nev > nextprint && ! done + + printf("nev=%-5d imin=%-3d ymin=%-8.3g done=%i\n",\ + nev,imin,ymin,done) ; + + nextprint = nextprint + 100 ; + end + + if done # Termination test + if (rst > 0) && (isnan (v) || v > ymin) + rst--; + if verbose + if isnan (v), + printf ("Restarting next to minimum %10.3e\n",ymin); + else + printf ("Restarting next to minimum %10.3e\n",ymin-v); + end + end + # Keep best minimum + x = reshape (u(imin,:), R, C) ; + v = ymin ; + + jumplen = 10 * max (max (u) - min (u)); + + u += jumplen * randn (size (u)); + for i = 1:N+1, y(i) = \ + feval (f, args{1:narg-1},reshape(u(i,:),R,C),args{narg+1:length(args)}); + end + nev += N+1; + [ymin,imin] = min(y); [ymax,imax] = max(y); + y(imax) = ymin; + [ymx2,imx2] = max(y); + y(imax) = ymax ; + else + if isnan (v), + x = reshape (u(imin,:), R, C) ; + v = ymin ; + end + if verbose, + printf("nev=%-5d imin=%-3d ymin=%-8.3g done=%i. Done\n",\ + nev,imin,ymin,done) ; + end + return + end + + end + ## [ y' u ] + + tra = 0 ; # 'trace' debug var contains flags + if verbose > 1, str = sprintf (" %i : %10.3e --",done,ymin); end + + # Look for a new point + xsum = sum(u) ; # Consider reflection of worst vertice + # around centroid. + ## f1 = (1-(-1))/N = 2/N; + ## f2 = f1 - (-1) = 2/N + 1 = (N+2)/N + xnew = (2*xsum - (N+2)*u(imax,:)) / N; + ## xnew = (2*xsum - N*u(imax,:)) / N; + ynew = feval (f, args{1:narg-1},reshape(xnew,R,C),args{narg+1:length(args)}); + nev++; + + if ynew <= ymin , # Reflection is good + + tra += 1 ; + if verbose > 1 + str = [str,sprintf(" %3i : %10.3e good refl >>",nev,ynew-ymin)]; + end + y(imax) = ynew; u(imax,:) = xnew ; + ## ymin = ynew; + ## imin = imax; + xsum = sum(u) ; + + ## f1 = (1-2)/N = -1/N + ## f2 = f1 - 2 = -1/N - 2 = -(2*N+1)/N + xnew = ( -xsum + (2*N+1)*u(imax,:) ) / N; + ynew = feval (f, args{1:narg-1},reshape(xnew,R,C),args{narg+1:length(args)}); + nev++; + + if ynew <= ymin , # expansion improves + tra += 2 ; + ## 'expanded reflection' + y(imax) = ynew ; u(imax,:) = xnew ; + xsum = sum(u) ; + if verbose > 1 + str = [str,sprintf(" %3i : %10.3e expd refl",nev,ynew-ymin)]; + end + else + tra += 4 ; + ## 'plain reflection' + ## Updating of y and u has already been done + if verbose > 1 + str = [str,sprintf(" %3i : %10.3e plain ref",nev,ynew-ymin)]; + end + end + # Reflexion is really bad + elseif ynew >= ymax , + + tra += 8 ; + if verbose > 1 + str = [str,sprintf(" %3i : %10.3e intermedt >>",nev,ynew-ymin)]; + end + ## look for intermediate point + # Bring worst point closer to centroid + ## f1 = (1-0.5)/N = 0.5/N + ## f2 = f1 - 0.5 = 0.5*(1 - N)/N + xnew = 0.5*(xsum + (N-1)*u(imax,:)) / N; + ynew = feval (f, args{1:narg-1},reshape(xnew,R,C),args{narg+1:length(args)}); + nev++; + + if ynew >= ymax , # New point is even worse. Contract whole + # simplex + + nev += N + 1 ; + ## u0 = u; + u = (u + ones(N+1,1)*u(imin,:)) / 2; + ## keyboard + + ## Code that doesn't care about value of empty_list_elements_ok + if imin == 1 , ii = 2:N+1; + elseif imin == N+1, ii = 1:N; + else ii = [1:imin-1,imin+1:N+1]; end + for i = ii + y(i) = \ + ynew = feval (f, args{1:narg-1},reshape(u(i,:),R,C),args{narg+1:length(args)}); + end + ## 'contraction' + tra += 16 ; + if verbose > 1 + str = [str,sprintf(" %3i contractn",nev)]; + end + else # Replace highest point + y(imax) = ynew ; u(imax,:) = xnew ; + xsum = sum(u) ; + ## 'intermediate' + tra += 32 ; + if verbose > 1 + str = [str,sprintf(" %3i : %10.3e intermedt",nev,ynew-ymin)]; + end + end + + else # Reflexion is neither good nor bad + y(imax) = ynew ; u(imax,:) = xnew ; + xsum = sum(u) ; + ## 'plain reflection (2)' + tra += 64 ; + if verbose > 1 + str = [str,sprintf(" %3i : %10.3e keep refl",nev,ynew-ymin)]; + end + end + if verbose > 1, printf ("%s\n",str); end +end + +if verbose >= 0 + printf ("nelder_mead : Too many iterations. Returning\n"); +end + +if isnan (v) || v > ymin, + x = reshape (u(imin,:), R, C) ; + v = ymin ; +end diff --git a/octave_packages/optim-1.2.0/nmsmax.m b/octave_packages/optim-1.2.0/nmsmax.m new file mode 100644 index 0000000..b221a96 --- /dev/null +++ b/octave_packages/optim-1.2.0/nmsmax.m @@ -0,0 +1,213 @@ +%% Copyright (C) 2002 N.J.Higham +%% Copyright (C) 2003 Andy Adler +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%%NMSMAX Nelder-Mead simplex method for direct search optimization. +%% [x, fmax, nf] = NMSMAX(FUN, x0, STOPIT, SAVIT) attempts to +%% maximize the function FUN, using the starting vector x0. +%% The Nelder-Mead direct search method is used. +%% Output arguments: +%% x = vector yielding largest function value found, +%% fmax = function value at x, +%% nf = number of function evaluations. +%% The iteration is terminated when either +%% - the relative size of the simplex is <= STOPIT(1) +%% (default 1e-3), +%% - STOPIT(2) function evaluations have been performed +%% (default inf, i.e., no limit), or +%% - a function value equals or exceeds STOPIT(3) +%% (default inf, i.e., no test on function values). +%% The form of the initial simplex is determined by STOPIT(4): +%% STOPIT(4) = 0: regular simplex (sides of equal length, the default) +%% STOPIT(4) = 1: right-angled simplex. +%% Progress of the iteration is not shown if STOPIT(5) = 0 (default 1). +%% STOPIT(6) indicates the direction (ie. minimization or +%% maximization.) Default is 1, maximization. +%% set STOPIT(6)=-1 for minimization +%% If a non-empty fourth parameter string SAVIT is present, then +%% `SAVE SAVIT x fmax nf' is executed after each inner iteration. +%% NB: x0 can be a matrix. In the output argument, in SAVIT saves, +%% and in function calls, x has the same shape as x0. +%% NMSMAX(fun, x0, STOPIT, SAVIT, P1, P2,...) allows additional +%% arguments to be passed to fun, via feval(fun,x,P1,P2,...). +%% References: +%% N. J. Higham, Optimization by direct search in matrix computations, +%% SIAM J. Matrix Anal. Appl, 14(2): 317-333, 1993. +%% C. T. Kelley, Iterative Methods for Optimization, Society for Industrial +%% and Applied Mathematics, Philadelphia, PA, 1999. + +% From Matrix Toolbox +% Copyright (C) 2002 N.J.Higham +% www.maths.man.ac.uk/~higham/mctoolbox +% Modifications for octave by A.Adler 2003 + +function [x, fmax, nf] = nmsmax(fun, x, stopit, savit, varargin) + +x0 = x(:); % Work with column vector internally. +n = length(x0); + +% Set up convergence parameters etc. +if (nargin < 3 || isempty(stopit)) + stopit(1) = 1e-3; +end +tol = stopit(1); % Tolerance for cgce test based on relative size of simplex. +if length(stopit) == 1, stopit(2) = inf; end % Max no. of f-evaluations. +if length(stopit) == 2, stopit(3) = inf; end % Default target for f-values. +if length(stopit) == 3, stopit(4) = 0; end % Default initial simplex. +if length(stopit) == 4, stopit(5) = 1; end % Default: show progress. +trace = stopit(5); +if length(stopit) == 5, stopit(6) = 1; end % Default: maximize +dirn= stopit(6); +if nargin < 4, savit = []; end % File name for snapshots. + +V = [zeros(n,1) eye(n)]; +f = zeros(n+1,1); +V(:,1) = x0; +f(1) = dirn*feval(fun,x,varargin{:}); +fmax_old = f(1); + +if trace, fprintf('f(x0) = %9.4e\n', f(1)), end + +k = 0; m = 0; + +% Set up initial simplex. +scale = max(norm(x0,inf),1); +if stopit(4) == 0 + % Regular simplex - all edges have same length. + % Generated from construction given in reference [18, pp. 80-81] of [1]. + alpha = scale / (n*sqrt(2)) * [ sqrt(n+1)-1+n sqrt(n+1)-1 ]; + V(:,2:n+1) = (x0 + alpha(2)*ones(n,1)) * ones(1,n); + for j=2:n+1 + V(j-1,j) = x0(j-1) + alpha(1); + x(:) = V(:,j); + f(j) = dirn*feval(fun,x,varargin{:}); + end +else + % Right-angled simplex based on co-ordinate axes. + alpha = scale*ones(n+1,1); + for j=2:n+1 + V(:,j) = x0 + alpha(j)*V(:,j); + x(:) = V(:,j); + f(j) = dirn*feval(fun,x,varargin{:}); + end +end +nf = n+1; +how = 'initial '; + +[temp,j] = sort(f); +j = j(n+1:-1:1); +f = f(j); V = V(:,j); + +alpha = 1; beta = 1/2; gamma = 2; + +while 1 %%%%%% Outer (and only) loop. +k = k+1; + + fmax = f(1); + if fmax > fmax_old + if ~isempty(savit) + x(:) = V(:,1); eval(['save ' savit ' x fmax nf']) + end + end + if trace + fprintf('Iter. %2.0f,', k) + fprintf([' how = ' how ' ']); + fprintf('nf = %3.0f, f = %9.4e (%2.1f%%)\n', nf, fmax, ... + 100*(fmax-fmax_old)/(abs(fmax_old)+eps)) + end + fmax_old = fmax; + + %%% Three stopping tests from MDSMAX.M + + % Stopping Test 1 - f reached target value? + if fmax >= stopit(3) + msg = ['Exceeded target...quitting\n']; + break % Quit. + end + + % Stopping Test 2 - too many f-evals? + if nf >= stopit(2) + msg = ['Max no. of function evaluations exceeded...quitting\n']; + break % Quit. + end + + % Stopping Test 3 - converged? This is test (4.3) in [1]. + v1 = V(:,1); + size_simplex = norm(V(:,2:n+1)-v1(:,ones(1,n)),1) / max(1, norm(v1,1)); + if size_simplex <= tol + msg = sprintf('Simplex size %9.4e <= %9.4e...quitting\n', ... + size_simplex, tol); + break % Quit. + end + + % One step of the Nelder-Mead simplex algorithm + % NJH: Altered function calls and changed CNT to NF. + % Changed each `fr < f(1)' type test to `>' for maximization + % and re-ordered function values after sort. + + vbar = (sum(V(:,1:n)')/n)'; % Mean value + vr = (1 + alpha)*vbar - alpha*V(:,n+1); + x(:) = vr; + fr = dirn*feval(fun,x,varargin{:}); + nf = nf + 1; + vk = vr; fk = fr; how = 'reflect, '; + if fr > f(n) + if fr > f(1) + ve = gamma*vr + (1-gamma)*vbar; + x(:) = ve; + fe = dirn*feval(fun,x,varargin{:}); + nf = nf + 1; + if fe > f(1) + vk = ve; fk = fe; + how = 'expand, '; + end + end + else + vt = V(:,n+1); ft = f(n+1); + if fr > ft + vt = vr; ft = fr; + end + vc = beta*vt + (1-beta)*vbar; + x(:) = vc; + fc = dirn*feval(fun,x,varargin{:}); + nf = nf + 1; + if fc > f(n) + vk = vc; fk = fc; + how = 'contract,'; + else + for j = 2:n + V(:,j) = (V(:,1) + V(:,j))/2; + x(:) = V(:,j); + f(j) = dirn*feval(fun,x,varargin{:}); + end + nf = nf + n-1; + vk = (V(:,1) + V(:,n+1))/2; + x(:) = vk; + fk = dirn*feval(fun,x,varargin{:}); + nf = nf + 1; + how = 'shrink, '; + end + end + V(:,n+1) = vk; + f(n+1) = fk; + [temp,j] = sort(f); + j = j(n+1:-1:1); + f = f(j); V = V(:,j); + +end %%%%%% End of outer (and only) loop. + +% Finished. +if trace, fprintf(msg), end +x(:) = V(:,1); diff --git a/octave_packages/optim-1.2.0/nonlin_curvefit.m b/octave_packages/optim-1.2.0/nonlin_curvefit.m new file mode 100644 index 0000000..2d53782 --- /dev/null +++ b/octave_packages/optim-1.2.0/nonlin_curvefit.m @@ -0,0 +1,101 @@ +## Copyright (C) 2010, 2011 Olaf Till +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{p}, @var{fy}, @var{cvg}, @var{outp}] =} nonlin_curvefit (@var{f}, @var{pin}, @var{x}, @var{y}) +## @deftypefnx {Function File} {[@var{p}, @var{fy}, @var{cvg}, @var{outp}] =} nonlin_curvefit (@var{f}, @var{pin}, @var{x}, @var{y}, @var{settings}) +## Frontend for nonlinear fitting of values, computed by a model +## function, to observed values. +## +## Please refer to the description of @code{nonlin_residmin}. The only +## differences to @code{nonlin_residmin} are the additional arguments +## @var{x} (independent values, mostly, but not necessarily, an array of +## the same dimensions or the same number of rows as @var{y}) and +## @var{y} (array of observations), the returned value @var{fy} (final +## guess for observed values) instead of @var{resid}, that the model +## function has a second obligatory argument which will be set to +## @var{x} and is supposed to return guesses for the observations (with +## the same dimensions), and that the possibly user-supplied function for the +## jacobian of the model function has also a second obligatory argument +## which will be set to @var{x}. +## +## @seealso {nonlin_residmin} +## @end deftypefn + +function [p, fy, cvg, outp] = nonlin_curvefit (f, pin, x, y, settings) + + if (nargin == 1) + p = __nonlin_residmin__ (f); + return; + endif + + if (nargin < 4 || nargin > 5) + print_usage (); + endif + + if (nargin == 4) + settings = struct (); + endif + + if (compare_versions (version (), "3.3.55", "<")) + ## optimset mechanism was fixed for option names with underscores + ## sometime in 3.3.54+, if I remember right + optimget = @ __optimget__; + endif + if (! isempty (dfdp = optimget (settings, "dfdp"))) + if (ischar (dfdp)) + dfdp = str2func (dfdp); + endif + ## settings = optimset \ + ## (settings, "dfdp", @ (p, varargin) dfdp (p, x, varargin{:})); + settings.dfdp = @ (p, varargin) dfdp (p, x, varargin{:}); + endif + + [p, fy, cvg, outp] = __nonlin_residmin__ \ + (@ (p) f (p, x), pin, settings, struct ("observations", y)); + + fy += y; + +endfunction + +function ret = __optimget__ (s, name, default) + + if (isfield (s, name)) + ret = s.(name); + elseif (nargin > 2) + ret = default; + else + ret = []; + endif + +endfunction + +%!demo +%! ## Example for linear inequality constraints +%! ## (see also the same example in 'demo nonlin_residmin') +%! +%! ## independents and observations +%! indep = 1:5; +%! obs = [1, 2, 4, 7, 14]; +%! ## model function: +%! f = @ (p, x) p(1) * exp (p(2) * x); +%! ## initial values: +%! init = [.25; .25]; +%! ## linear constraints, A.' * parametervector + B >= 0 +%! A = [1; -1]; B = 0; # p(1) >= p(2); +%! settings = optimset ("inequc", {A, B}); +%! +%! ## start optimization +%! [p, model_values, cvg, outp] = nonlin_curvefit (f, init, indep, obs, settings) diff --git a/octave_packages/optim-1.2.0/nonlin_min.m b/octave_packages/optim-1.2.0/nonlin_min.m new file mode 100644 index 0000000..7d4bbf7 --- /dev/null +++ b/octave_packages/optim-1.2.0/nonlin_min.m @@ -0,0 +1,1420 @@ +## Copyright (C) 2012 Olaf Till +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{p}, @var{objf}, @var{cvg}, @var{outp}] =} nonlin_min (@var{f}, @var{pin}) +## @deftypefnx {Function File} {[@var{p}, @var{objf}, @var{cvg}, @var{outp}] =} nonlin_min (@var{f}, @var{pin}, @var{settings}) +## +## Frontend for constrained nonlinear minimization of a scalar objective +## function. The functions supplied by the user have a minimal +## interface; any additionally needed constants can be supplied by +## wrapping the user functions into anonymous functions. +## +## The following description applies to usage with vector-based +## parameter handling. Differences in usage for structure-based +## parameter handling will be explained in a separate section below. +## +## @var{f}: objective function. It gets a column vector of real +## parameters as argument. In gradient determination, this function may +## be called with an informational second argument, whose content +## depends on the function for gradient determination. +## +## @var{pin}: real column vector of initial parameters. +## +## @var{settings}: structure whose fields stand for optional settings +## referred to below. The fields can be set by @code{optimset()} with +## Octave versions 3.3.55 or greater; with older Octave versions, the +## fields must be set directly as structure-fields in the correct case. +## +## The returned values are the column vector of final parameters +## @var{p}, the final value of the objective function @var{objf}, an +## integer @var{cvg} indicating if and how optimization succeeded or +## failed, and a structure @var{outp} with additional information, +## curently with only one field: @var{niter}, the number of iterations. +## @var{cvg} is greater than zero for success and less than or equal to +## zero for failure; its possible values depend on the used backend and +## currently can be @code{0} (maximum number of iterations exceeded), +## @code{1} (fixed number of iterations completed, e.g. in stochastic +## optimizers), @code{2} (parameter change less than specified precision +## in two consecutive iterations), @code{3} (improvement in objective +## function less than specified), or @code{-4} (algorithm got stuck). +## +## @var{settings}: +## +## @code{Algorithm}: String specifying the backend. Currently available +## are @code{"lm_feasible"} (default) and @code{"siman"}. They are +## described in separate sections below. +## +## @code{objf_grad}: Function computing the gradient of the objective +## function with respect to the parameters, assuming residuals are +## reshaped to a vector. Default: finite differences. Will be called +## with the column vector of parameters and an informational structure +## as arguments. The structure has the fields @code{f}: value of +## objective function for current parameters, @code{fixed}: logical +## vector indicating which parameters are not optimized, so these +## partial derivatives need not be computed and can be set to zero, +## @code{diffp}, @code{diff_onesided}, @code{lbound}, @code{ubound}: +## identical to the user settings of this name, @code{plabels}: +## 1-dimensional cell-array of column-cell-arrays, each column with +## labels for all parameters, the first column contains the numerical +## indices of the parameters. The default gradient function will call +## the objective function with the second argument set with fields +## @code{f}: as the @code{f} passed to the gradient function, +## @code{plabels}: cell-array of 1x1 cell-arrays with the entries of the +## column-cell-arrays of @code{plabels} as passed to the jacobian +## function corresponding to current parameter, @code{side}: @code{0} +## for one-sided interval, @code{1} or @code{2}, respectively, for the +## sides of a two-sided interval, and @code{parallel}: logical scalar +## indicating parallel computation of partial derivatives. +## +## @code{objf_hessian}: Function computing the Hessian of the objective +## function with respect to the parameters. The default is backend +## specific. Will be called with the column vector of parameters as +## argument. +## +## @code{diffp}: column vector of fractional intervals (doubled for +## central intervals) supposed to be used by gradient functions +## performing finite differencing. Default: @code{.001 * ones (size +## (parameters))}. The default gradient function will use these as +## absolute intervals for parameters with value zero. +## +## @code{diff_onesided}: logical column vector indicating that one-sided +## intervals should be used by gradient functions performing finite +## differencing. Default: @code{false (size (parameters))}. +## +## @code{complex_step_derivative_objf}, +## @code{complex_step_derivative_inequc}, +## @code{complex_step_derivative_equc}: logical scalars, default: false. +## Estimate gradient of objective function, general inequality +## constraints, and general equality constraints, respectively, with +## complex step derivative approximation. Use only if you know that your +## objective function, function of general inequality constraints, or +## function of general equality constraints, respectively, is suitable +## for this. No user function for the respective gradient must be +## specified. +## +## @code{cstep}: scalar step size for complex step derivative +## approximation. Default: 1e-20. +## +## @code{fixed}: logical column vector indicating which parameters +## should not be optimized, but kept to their inital value. Fixing is +## done independently of the backend, but the backend may choose to fix +## additional parameters under certain conditions. +## +## @code{lbound}, @code{ubound}: column vectors of lower and upper +## bounds for parameters. Default: @code{-Inf} and @code{+Inf}, +## respectively. The bounds are non-strict, i.e. parameters are allowed +## to be exactly equal to a bound. The default gradient function will +## respect bounds (but no further inequality constraints) in finite +## differencing. +## +## @code{inequc}: Further inequality constraints. Cell-array containing +## up to four entries, two entries for linear inequality constraints +## and/or one or two entries for general inequality constraints. Either +## linear or general constraints may be the first entries, but the two +## entries for linear constraints must be adjacent and, if two entries +## are given for general constraints, they also must be adjacent. The +## two entries for linear constraints are a matrix (say @code{m}) and a +## vector (say @code{v}), specifying linear inequality constraints of +## the form @code{m.' * parameters + v >= 0}. The first entry for +## general constraints must be a differentiable vector valued function +## (say @code{h}), specifying general inequality constraints of the form +## @code{h (p[, idx]) >= 0}; @code{p} is the column vector of optimized +## paraters and the optional argument @code{idx} is a logical index. +## @code{h} has to return the values of all constraints if @code{idx} is +## not given. It may choose to return only the indexed constraints if +## @code{idx} is given (so computation of the other constraints can be +## spared); in this case, the additional setting @code{inequc_f_idx} has +## to be set to @code{true}. In gradient determination, this function +## may be called with an informational third argument, whose content +## depends on the function for gradient determination. If a second entry +## for general inequality constraints is given, it must be a function +## computing the jacobian of the constraints with respect to the +## parameters. For this function, the description of @code{dfdp} above +## applies, with 2 exceptions: 1) it is called with 3 arguments since it +## has an additional argument @code{idx} --- a logical index --- at +## second position, indicating which rows of the jacobian must be +## returned (if the function chooses to return only indexed rows, the +## additional setting @code{inequc_df_idx} has to be set to +## @code{true}). 2) the default jacobian function calls @code{h} with 3 +## arguments, since the argument @code{idx} is also supplied. Note that +## specifying linear constraints as general constraints will generally +## waste performance, even if further, non-linear, general constraints +## are also specified. +## +## @code{equc}: Equality constraints. Specified the same way as +## inequality constraints (see @code{inequc}). The respective additional +## settings are named @code{equc_f_idx} and @code{equc_df_idx}. +## +## @code{cpiv}: Function for complementary pivoting, usable in +## algorithms for constraints. Default: @ cpiv_bard. Only the default +## function is supplied with the package. +## +## @code{TolFun}: Minimum fractional improvement in objective function +## in an iteration (abortion criterium). Default: .0001. +## +## @code{MaxIter}: Maximum number of iterations (abortion criterium). +## Default: backend-specific. +## +## @code{fract_prec}: Column Vector, minimum fractional change of +## parameters in an iteration (abortion criterium if violated in two +## consecutive iterations). Default: backend-specific. +## +## @code{max_fract_change}: Column Vector, enforced maximum fractional +## change in parameters in an iteration. Default: backend-specific. +## +## @code{Display}: String indicating the degree of verbosity. Default: +## @code{"off"}. Possible values are currently @code{"off"} (no +## messages) and @code{"iter"} (some messages after each iteration). +## Support of this setting and its exact interpretation are +## backend-specific. +## +## @code{debug}: Logical scalar, default: @code{false}. Will be passed +## to the backend, which might print debugging information if true. +## +## Structure-based parameter handling +## +## The setting @code{param_order} is a cell-array with names of the +## optimized parameters. If not given, and initial parameters are a +## structure, all parameters in the structure are optimized. If initial +## parameters are a structure, it is an error if @code{param_order} is +## not given and there are any non-structure-based configuration items +## or functions. +## +## The initial parameters @var{pin} can be given as a structure +## containing at least all fields named in @code{param_order}. In this +## case the returned parameters @var{p} will also be a structure. +## +## Each user-supplied function can be called with the argument +## containing the current parameters being a structure instead of a +## column vector. For this, a corresponding setting must be set to +## @code{true}: @code{objf_pstruct} (objective function), +## @code{objf_grad_pstruct} (gradient of objective function), +## @code{objf_hessian_pstruct} (hessian of objective function), +## @code{f_inequc_pstruct} (general inequality constraints), +## @code{df_inequc_pstruct} (jacobian of general inequality +## constraints), @code{f_equc_pstruct} (general equality constraints), +## and @code{df_equc_pstruct} (jacobian of general equality +## constraints). If a gradient (jacobian) function is configured in such +## a way, it must return the entries (columns) of the gradient +## (jacobian) as fields of a structure under the respective parameter +## names. If the hessian function is configured in such a way, it must +## return a structure (say @code{h}) with fields e.g. as +## @code{h.a.b = value} for @code{value} being the 2nd partial derivative +## with respect to @code{a} and @code{b}. There is no need to also +## specify the field @code{h.b.a} in this example. +## +## Similarly, for specifying linear constraints, instead of the matrix +## (called @code{m} above), a structure containing the rows of the +## matrix in fields under the respective parameter names can be given. +## In this case, rows containing only zeros need not be given. +## +## The vector-based settings @code{lbound}, @code{ubound}, +## @code{fixed}, @code{diffp}, @code{diff_onesided}, @code{fract_prec}, +## and @code{max_fract_change} can be replaced by the setting +## @code{param_config}. It is a structure that can contain fields named +## in @code{param_order}. For each such field, there may be subfields +## with the same names as the above vector-based settings, but +## containing a scalar value for the respective parameter. If +## @code{param_config} is specified, none of the above +## vector/matrix-based settings may be used. +## +## Additionally, named parameters are allowed to be non-scalar real +## arrays. In this case, their dimensions are given by the setting +## @code{param_dims}, a cell-array of dimension vectors, each containing +## at least two dimensions; if not given, dimensions are taken from the +## initial parameters, if these are given in a structure. Any +## vector-based settings or not structure-based linear constraints then +## must correspond to an order of parameters with all parameters +## reshaped to vectors and concatenated in the user-given order of +## parameter names. Structure-based settings or structure-based initial +## parameters must contain arrays with dimensions reshapable to those of +## the respective parameters. +## +## Description of backends +## +## "lm_feasible" +## +## A Levenberg/Marquardt-like optimizer, attempting to honour +## constraints throughout the course of optimization. This means that +## the initial parameters must not violate constraints (to find an +## initial feasible set of parameters, e.g. Octaves @code{sqp} can be +## used, by specifying an objective function which is constant or which +## returns the quadratic distance to the initial values). If the +## constraints need only be honoured in the result of the optimization, +## Octaves @code{sqp} may be preferable. The Hessian is either supplied +## by the user or is approximated by the BFGS algorithm. +## +## Returned value @var{cvg} will be @code{2} or @code{3} for success and +## @code{0} or @code{-4} for failure (see above for meaning). +## +## Backend-specific defaults are: @code{MaxIter}: 20, @code{fract_prec}: +## @code{zeros (size (parameters))}, @code{max_fract_change}: @code{Inf} +## for all parameters. +## +## Interpretation of @code{Display}: if set to @code{"iter"}, currently +## only information on applying @code{max_fract_change} is printed. +## +## "siman" +## +## A simulated annealing (stochastic) optimizer, changing all parameters +## at once in a single step, so being suitable for non-bound +## constraints. +## +## No gradient or hessian of the objective function is used. The +## settings @code{MaxIter}, @code{fract_prec}, @code{TolFun}, and +## @code{max_fract_change} are not honoured. +## +## Accepts the additional settings @code{T_init} (initial temperature, +## default 0.01), @code{T_min} (final temperature, default 1.0e-5), +## @code{mu_T} (factor of temperature decrease, default 1.005), +## @code{iters_fixed_T} (iterations within one temperature step, default +## 10), @code{max_rand_step} (column vector or structure-based +## configuration of maximum random steps for each parameter, default +## 0.005 * @var{pin}), @code{stoch_regain_constr} (if @code{true}, +## regain constraints after a random step, otherwise take new random +## value until constraints are met, default false), @code{trace_steps} +## (set field @code{trace} of @var{outp} with a matrix with a row for +## each step, first column iteration number, second column repeat number +## within iteration, third column value of objective function, rest +## columns parameter values, default false), and @code{siman_log} (set +## field @code{log} of @var{outp} with a matrix with a row for each +## iteration, first column temperature, second column value of objective +## function, rest columns numbers of tries with decrease, no decrease +## but accepted, and no decrease and rejected. +## +## Steps with increase @code{diff} of objective function are accepted if +## @code{rand (1) < exp (- diff / T)}, where @code{T} is the temperature +## of the current iteration. +## +## If regaining of constraints failed, optimization will be aborted and +## returned value of @var{cvg} will be @code{0}. Otherwise, @var{cvg} +## will be @code{1}. +## +## Interpretation of @code{Display}: if set to @code{"iter"}, an +## informational line is printed after each iteration. +## +## @end deftypefn + +## disabled PKG_ADD: __all_opts__ ("nonlin_min"); + +function [p, objf, cvg, outp] = nonlin_min (f, pin, settings) + + if (compare_versions (version (), "3.3.55", "<")) + ## optimset mechanism was fixed for option names with underscores + ## sometime in 3.3.54+, if I remember right + optimget = @ __optimget__; + endif + + if (compare_versions (version (), "3.2.4", "<=")) + ## For bug #31484; but Octave 3.6... shows bug #36288 due to this + ## workaround. Octave 3.7... seems to be all right. + __dfdp__ = @ __dfdp__; + endif + + ## some scalar defaults; some defaults are backend specific, so + ## lacking elements in respective constructed vectors will be set to + ## NA here in the frontend + diffp_default = .001; + stol_default = .0001; + cstep_default = 1e-20; + + if (nargin == 1 && ischar (f) && strcmp (f, "defaults")) + p = optimset ("param_config", [], \ + "param_order", [], \ + "param_dims", [], \ + "f_inequc_pstruct", false, \ + "f_equc_pstruct", false, \ + "objf_pstruct", false, \ + "df_inequc_pstruct", false, \ + "df_equc_pstruct", false, \ + "objf_grad_pstruct", false, \ + "objf_hessian_pstruct", false, \ + "lbound", [], \ + "ubound", [], \ + "objf_grad", [], \ + "objf_hessian", [], \ + "cpiv", @ cpiv_bard, \ + "max_fract_change", [], \ + "fract_prec", [], \ + "diffp", [], \ + "diff_onesided", [], \ + "complex_step_derivative_objf", false, \ + "complex_step_derivative_inequc", false, \ + "complex_step_derivative_equc", false, \ + "cstep", cstep_default, \ + "fixed", [], \ + "inequc", [], \ + "equc", [], \ + "inequc_f_idx", false, \ + "inequc_df_idx", false, \ + "equc_f_idx", false, \ + "equc_df_idx", false, \ + "TolFun", stol_default, \ + "MaxIter", [], \ + "Display", "off", \ + "Algorithm", "lm_feasible", \ + "T_init", .01, \ + "T_min", 1.0e-5, \ + "mu_T", 1.005, \ + "iters_fixed_T", 10, \ + "max_rand_step", [], \ + "stoch_regain_constr", false, \ + "trace_steps", false, \ + "siman_log", false, \ + "debug", false); + return; + endif + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (nargin == 2) + settings = struct (); + endif + + if (ischar (f)) + f = str2func (f); + endif + + if (! (pin_struct = isstruct (pin))) + if (! isvector (pin) || columns (pin) > 1) + error ("initial parameters must be either a structure or a column vector"); + endif + endif + + #### processing of settings and consistency checks + + pconf = optimget (settings, "param_config"); + pord = optimget (settings, "param_order"); + pdims = optimget (settings, "param_dims"); + f_inequc_pstruct = optimget (settings, "f_inequc_pstruct", false); + f_equc_pstruct = optimget (settings, "f_equc_pstruct", false); + f_pstruct = optimget (settings, "objf_pstruct", false); + dfdp_pstruct = optimget (settings, "objf_grad_pstruct", f_pstruct); + hessian_pstruct = optimget (settings, "objf_hessian_pstruct", f_pstruct); + df_inequc_pstruct = optimget (settings, "df_inequc_pstruct", \ + f_inequc_pstruct); + df_equc_pstruct = optimget (settings, "df_equc_pstruct", \ + f_equc_pstruct); + lbound = optimget (settings, "lbound"); + ubound = optimget (settings, "ubound"); + dfdp = optimget (settings, "objf_grad"); + if (ischar (dfdp)) dfdp = str2func (dfdp); endif + hessian = optimget (settings, "objf_hessian"); + max_fract_change = optimget (settings, "max_fract_change"); + fract_prec = optimget (settings, "fract_prec"); + diffp = optimget (settings, "diffp"); + diff_onesided = optimget (settings, "diff_onesided"); + fixed = optimget (settings, "fixed"); + do_cstep = optimget (settings, "complex_step_derivative_objf", false); + cstep = optimget (settings, "cstep", cstep_default); + if (do_cstep && ! isempty (dfdp)) + error ("both 'complex_step_derivative_objf' and 'objf_grad' are set"); + endif + do_cstep_inequc = \ + optimget (settings, "complex_step_derivative_inequc", false); + do_cstep_equc = optimget (settings, "complex_step_derivative_equc", \ + false); + max_rand_step = optimget (settings, "max_rand_step"); + + any_vector_conf = ! (isempty (lbound) && isempty (ubound) && \ + isempty (max_fract_change) && \ + isempty (fract_prec) && isempty (diffp) && \ + isempty (diff_onesided) && isempty (fixed) && \ + isempty (max_rand_step)); + + ## collect constraints + [mc, vc, f_genicstr, df_gencstr, user_df_gencstr] = \ + __collect_constraints__ (optimget (settings, "inequc"), \ + do_cstep_inequc, "inequality constraints"); + [emc, evc, f_genecstr, df_genecstr, user_df_genecstr] = \ + __collect_constraints__ (optimget (settings, "equc"), \ + do_cstep_equc, "equality constraints"); + mc_struct = isstruct (mc); + emc_struct = isstruct (emc); + + ## correct "_pstruct" settings if functions are not supplied, handle + ## constraint functions not honoring indices + if (isempty (dfdp)) dfdp_pstruct = false; endif + if (isempty (hessian)) hessian_pstruct = false; endif + if (isempty (f_genicstr)) + f_inequc_pstruct = false; + elseif (! optimget (settings, "inequc_f_idx", false)) + f_genicstr = @ (p, varargin) apply_idx_if_given \ + (f_genicstr (p, varargin{:}), varargin{:}); + endif + if (isempty (f_genecstr)) + f_equc_pstruct = false; + elseif (! optimget (settings, "equc_f_idx", false)) + f_genecstr = @ (p, varargin) apply_idx_if_given \ + (f_genecstr (p, varargin{:}), varargin{:}); + endif + if (user_df_gencstr) + if (! optimget (settings, "inequc_df_idx", false)) + df_gencstr = @ (varargin) df_gencstr (varargin{:})(varargin{2}, :); + endif + else + df_inequc_pstruct = false; + endif + if (user_df_genecstr) + if (! optimget (settings, "equc_df_idx", false)) + df_genecstr = @ (varargin) df_genecstr (varargin{:})(varargin{2}, :); + endif + else + df_equc_pstruct = false; + endif + + ## some settings require a parameter order + if (pin_struct || ! isempty (pconf) || f_inequc_pstruct || \ + f_equc_pstruct || f_pstruct || dfdp_pstruct || \ + hessian_pstruct || df_inequc_pstruct || df_equc_pstruct || \ + mc_struct || emc_struct) + if (isempty (pord)) + if (pin_struct) + if (any_vector_conf || \ + ! (f_pstruct && \ + (f_inequc_pstruct || isempty (f_genicstr)) && \ + (f_equc_pstruct || isempty (f_genecstr)) && \ + (dfdp_pstruct || isempty (dfdp)) && \ + (hessian_pstruct || isempty (hessian)) && \ + (df_inequc_pstruct || ! user_df_gencstr) && \ + (df_equc_pstruct || ! user_df_genecstr) && \ + (mc_struct || isempty (mc)) && \ + (emc_struct || isempty (emc)))) + error ("no parameter order specified and constructing a parameter order from the structure of initial parameters can not be done since not all configuration or given functions are structure based"); + else + pord = fieldnames (pin); + endif + else + error ("given settings require specification of parameter order or initial parameters in the form of a structure"); + endif + endif + pord = pord(:); + if (pin_struct && ! all (isfield (pin, pord))) + error ("some initial parameters lacking"); + endif + if ((nnames = rows (unique (pord))) < rows (pord)) + error ("duplicate parameter names in 'param_order'"); + endif + if (isempty (pdims)) + if (pin_struct) + pdims = cellfun \ + (@ size, fields2cell (pin, pord), "UniformOutput", false); + else + pdims = num2cell (ones (nnames, 2), 2); + endif + else + pdims = pdims(:); + if (pin_struct && \ + ! all (cellfun (@ (x, y) prod (size (x)) == prod (y), \ + struct2cell (pin), pdims))) + error ("given param_dims and dimensions of initial parameters do not match"); + endif + endif + if (nnames != rows (pdims)) + error ("lengths of 'param_order' and 'param_dims' not equal"); + endif + pnel = cellfun (@ prod, pdims); + ppartidx = pnel; + if (any (pnel > 1)) + pnonscalar = true; + cpnel = num2cell (pnel); + prepidx = cat (1, cellfun \ + (@ (x, n) x(ones (1, n), 1), \ + num2cell ((1:nnames).'), cpnel, \ + "UniformOutput", false){:}); + epord = pord(prepidx, 1); + psubidx = cat (1, cellfun \ + (@ (n) (1:n).', cpnel, \ + "UniformOutput", false){:}); + else + pnonscalar = false; # some less expensive interfaces later + prepidx = (1:nnames).'; + epord = pord; + psubidx = ones (nnames, 1); + endif + else + pord = []; # spares checks for given but not needed + endif + + if (pin_struct) + np = sum (pnel); + else + np = length (pin); + if (! isempty (pord) && np != sum (pnel)) + error ("number of initial parameters not correct"); + endif + endif + + plabels = num2cell (num2cell ((1:np).')); + if (! isempty (pord)) + plabels = cat (2, plabels, num2cell (epord), \ + num2cell (num2cell (psubidx))); + endif + + ## some useful vectors + zerosvec = zeros (np, 1); + NAvec = NA (np, 1); + Infvec = Inf (np, 1); + falsevec = false (np, 1); + sizevec = [np, 1]; + + ## collect parameter-related configuration + if (! isempty (pconf)) + ## use supplied configuration structure + + ## parameter-related configuration is either allowed by a structure + ## or by vectors + if (any_vector_conf) + error ("if param_config is given, its potential items must not \ + be configured in another way"); + endif + + ## supplement parameter names lacking in param_config + nidx = ! isfield (pconf, pord); + pconf = cell2fields ({struct()}(ones (1, sum (nidx))), \ + pord(nidx), 2, pconf); + + pconf = structcat (1, fields2cell (pconf, pord){:}); + + ## in the following, use reshape with explicit dimensions (instead + ## of x(:)) so that errors are thrown if a configuration item has + ## incorrect number of elements + + lbound = - Infvec; + if (isfield (pconf, "lbound")) + idx = ! fieldempty (pconf, "lbound"); + if (pnonscalar) + lbound (idx(prepidx), 1) = \ + cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).lbound}.', \ + cpnel(idx), "UniformOutput", false){:}); + else + lbound(idx, 1) = cat (1, pconf.lbound); + endif + endif + + ubound = Infvec; + if (isfield (pconf, "ubound")) + idx = ! fieldempty (pconf, "ubound"); + if (pnonscalar) + ubound (idx(prepidx), 1) = \ + cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).ubound}.', \ + cpnel(idx), "UniformOutput", false){:}); + else + ubound(idx, 1) = cat (1, pconf.ubound); + endif + endif + + max_fract_change = fract_prec = NAvec; + + if (isfield (pconf, "max_fract_change")) + idx = ! fieldempty (pconf, "max_fract_change"); + if (pnonscalar) + max_fract_change(idx(prepidx)) = \ + cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).max_fract_change}.', \ + cpnel(idx), \ + "UniformOutput", false){:}); + else + max_fract_change(idx) = [pconf.max_fract_change]; + endif + endif + + if (isfield (pconf, "fract_prec")) + idx = ! fieldempty (pconf, "fract_prec"); + if (pnonscalar) + fract_prec(idx(prepidx)) = \ + cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).fract_prec}.', cpnel(idx), \ + "UniformOutput", false){:}); + else + fract_prec(idx) = [pconf.fract_prec]; + endif + endif + + diffp = zerosvec; + diffp(:) = diffp_default; + if (isfield (pconf, "diffp")) + idx = ! fieldempty (pconf, "diffp"); + if (pnonscalar) + diffp(idx(prepidx)) = \ + cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).diffp}.', cpnel(idx), \ + "UniformOutput", false){:}); + else + diffp(idx) = [pconf.diffp]; + endif + endif + + diff_onesided = fixed = falsevec; + + if (isfield (pconf, "diff_onesided")) + idx = ! fieldempty (pconf, "diff_onesided"); + if (pnonscalar) + diff_onesided(idx(prepidx)) = \ + logical \ + (cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).diff_onesided}.', cpnel(idx), \ + "UniformOutput", false){:})); + else + diff_onesided(idx) = logical ([pconf.diff_onesided]); + endif + endif + + if (isfield (pconf, "fixed")) + idx = ! fieldempty (pconf, "fixed"); + if (pnonscalar) + fixed(idx(prepidx)) = \ + logical \ + (cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).fixed}.', cpnel(idx), \ + "UniformOutput", false){:})); + else + fixed(idx) = logical ([pconf.fixed]); + endif + endif + + max_rand_step = NAvec; + + if (isfield (pconf, "max_rand_step")) + idx = ! fieldempty (pconf, "max_rand_step"); + if (pnonscalar) + max_rand_step(idx(prepidx)) = \ + logical \ + (cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).max_rand_step}.', + cpnel(idx), \ + "UniformOutput", false){:})); + else + max_rand_step(idx) = logical ([pconf.max_rand_step]); + endif + endif + + else + ## use supplied configuration vectors + + if (isempty (lbound)) + lbound = - Infvec; + elseif (any (size (lbound) != sizevec)) + error ("bounds: wrong dimensions"); + endif + + if (isempty (ubound)) + ubound = Infvec; + elseif (any (size (ubound) != sizevec)) + error ("bounds: wrong dimensions"); + endif + + if (isempty (max_fract_change)) + max_fract_change = NAvec; + elseif (any (size (max_fract_change) != sizevec)) + error ("max_fract_change: wrong dimensions"); + endif + + if (isempty (fract_prec)) + fract_prec = NAvec; + elseif (any (size (fract_prec) != sizevec)) + error ("fract_prec: wrong dimensions"); + endif + + if (isempty (diffp)) + diffp = zerosvec; + diffp(:) = diffp_default; + else + if (any (size (diffp) != sizevec)) + error ("diffp: wrong dimensions"); + endif + diffp(isna (diffp)) = diffp_default; + endif + + if (isempty (diff_onesided)) + diff_onesided = falsevec; + else + if (any (size (diff_onesided) != sizevec)) + error ("diff_onesided: wrong dimensions") + endif + diff_onesided(isna (diff_onesided)) = false; + diff_onesided = logical (diff_onesided); + endif + + if (isempty (fixed)) + fixed = falsevec; + else + if (any (size (fixed) != sizevec)) + error ("fixed: wrong dimensions"); + endif + fixed(isna (fixed)) = false; + fixed = logical (fixed); + endif + + if (isempty (max_rand_step)) + max_rand_step = NAvec; + elseif (any (size (max_rand_step) != sizevec)) + error ("max_rand_step: wrong dimensions"); + endif + + endif + + ## guaranty all (lbound <= ubound) + if (any (lbound > ubound)) + error ("some lower bounds larger than upper bounds"); + endif + + #### consider whether initial parameters and functions are based on + #### parameter structures or parameter vectors; wrappers for call to + #### default function for jacobians + + ## initial parameters + if (pin_struct) + if (pnonscalar) + pin = cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + fields2cell (pin, pord), cpnel, \ + "UniformOutput", false){:}); + else + pin = cat (1, fields2cell (pin, pord){:}); + endif + endif + + ## objective function + if (f_pstruct) + if (pnonscalar) + f = @ (p, varargin) \ + f (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1), varargin{:}); + else + f = @ (p, varargin) \ + f (cell2struct (num2cell (p), pord, 1), varargin{:}); + endif + endif + f_pin = f (pin); + + ## gradient of objective function + if (isempty (dfdp)) + if (do_cstep) + dfdp = @ (p, hook) jacobs (p, f, hook); + else + dfdp = @ (p, hook) __dfdp__ (p, f, hook); + endif + endif + if (dfdp_pstruct) + if (pnonscalar) + dfdp = @ (p, hook) \ + cat (2, \ + fields2cell \ + (dfdp (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1), hook), \ + pord){:}); + else + dfdp = @ (p, hook) \ + cat (2, \ + fields2cell \ + (dfdp (cell2struct (num2cell (p), pord, 1), hook), \ + pord){:}); + endif + endif + + ## hessian of objective function + if (hessian_pstruct) + if (pnonscalar) + hessian = @ (p) \ + hessian_struct2mat \ + (hessian (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1)), pord); + else + hessian = @ (p) \ + hessian_struct2mat \ + (hessian (cell2struct (num2cell (p), pord, 1)), pord); + endif + endif + + ## function for general inequality constraints + if (f_inequc_pstruct) + if (pnonscalar) + f_genicstr = @ (p, varargin) \ + f_genicstr (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1), varargin{:}); + else + f_genicstr = @ (p, varargin) \ + f_genicstr \ + (cell2struct (num2cell (p), pord, 1), varargin{:}); + endif + endif + + ## note this stage + possibly_pstruct_f_genicstr = f_genicstr; + + ## jacobian of general inequality constraints + if (df_inequc_pstruct) + if (pnonscalar) + df_gencstr = @ (p, func, idx, hook) \ + cat (2, \ + fields2cell \ + (df_gencstr \ + (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), pord, 1), \ + func, idx, hook), \ + pord){:}); + else + df_gencstr = @ (p, func, idx, hook) \ + cat (2, \ + fields2cell \ + (df_gencstr (cell2struct (num2cell (p), pord, 1), \ + func, idx, hook), \ + pord){:}); + endif + endif + + ## function for general equality constraints + if (f_equc_pstruct) + if (pnonscalar) + f_genecstr = @ (p, varargin) \ + f_genecstr (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1), varargin{:}); + else + f_genecstr = @ (p, varargin) \ + f_genecstr \ + (cell2struct (num2cell (p), pord, 1), varargin{:}); + endif + endif + + ## note this stage + possibly_pstruct_f_genecstr = f_genecstr; + + ## jacobian of general equality constraints + if (df_equc_pstruct) + if (pnonscalar) + df_genecstr = @ (p, func, idx, hook) \ + cat (2, \ + fields2cell \ + (df_genecstr \ + (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), pord, 1), \ + func, idx, hook), \ + pord){:}); + else + df_genecstr = @ (p, func, idx, hook) \ + cat (2, \ + fields2cell \ + (df_genecstr (cell2struct (num2cell (p), pord, 1), \ + func, idx, hook), \ + pord){:}); + endif + endif + + ## linear inequality constraints + if (mc_struct) + idx = isfield (mc, pord); + if (rows (fieldnames (mc)) > sum (idx)) + error ("unknown fields in structure of linear inequality constraints"); + endif + smc = mc; + mc = zeros (np, rows (vc)); + mc(idx(prepidx), :) = cat (1, fields2cell (smc, pord(idx)){:}); + endif + + ## linear equality constraints + if (emc_struct) + idx = isfield (emc, pord); + if (rows (fieldnames (emc)) > sum (idx)) + error ("unknown fields in structure of linear equality constraints"); + endif + semc = emc; + emc = zeros (np, rows (evc)); + emc(idx(prepidx), :) = cat (1, fields2cell (semc, pord(idx)){:}); + endif + + ## parameter-related configuration for jacobian functions + if (dfdp_pstruct || df_inequc_pstruct || df_equc_pstruct) + if(pnonscalar) + s_diffp = cell2struct \ + (cellfun (@ reshape, mat2cell (diffp, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + s_diff_onesided = cell2struct \ + (cellfun (@ reshape, mat2cell (diff_onesided, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + s_orig_lbound = cell2struct \ + (cellfun (@ reshape, mat2cell (lbound, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + s_orig_ubound = cell2struct \ + (cellfun (@ reshape, mat2cell (ubound, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + s_plabels = cell2struct \ + (num2cell \ + (cat (2, cellfun \ + (@ (x) cellfun \ + (@ reshape, mat2cell (cat (1, x{:}), ppartidx), \ + pdims, "UniformOutput", false), \ + num2cell (plabels, 1), "UniformOutput", false){:}), \ + 2), \ + pord, 1); + s_orig_fixed = cell2struct \ + (cellfun (@ reshape, mat2cell (fixed, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + else + s_diffp = cell2struct (num2cell (diffp), pord, 1); + s_diff_onesided = cell2struct (num2cell (diff_onesided), pord, 1); + s_orig_lbound = cell2struct (num2cell (lbound), pord, 1); + s_orig_ubound = cell2struct (num2cell (ubound), pord, 1); + s_plabels = cell2struct (num2cell (plabels, 2), pord, 1); + s_orig_fixed = cell2struct (num2cell (fixed), pord, 1); + endif + endif + + #### some further values and checks + + if (any (fixed & (pin < lbound | pin > ubound))) + warning ("some fixed parameters outside bounds"); + endif + + ## dimensions of linear constraints + if (isempty (mc)) + mc = zeros (np, 0); + vc = zeros (0, 1); + endif + if (isempty (emc)) + emc = zeros (np, 0); + evc = zeros (0, 1); + endif + [rm, cm] = size (mc); + [rv, cv] = size (vc); + if (rm != np || cm != rv || cv != 1) + error ("linear inequality constraints: wrong dimensions"); + endif + [erm, ecm] = size (emc); + [erv, ecv] = size (evc); + if (erm != np || ecm != erv || ecv != 1) + error ("linear equality constraints: wrong dimensions"); + endif + + ## note initial values of linear constraits + pin_cstr.inequ.lin_except_bounds = mc.' * pin + vc; + pin_cstr.equ.lin = emc.' * pin + evc; + + ## note number and initial values of general constraints + if (isempty (f_genicstr)) + pin_cstr.inequ.gen = []; + n_genicstr = 0; + else + n_genicstr = length (pin_cstr.inequ.gen = f_genicstr (pin)); + endif + if (isempty (f_genecstr)) + pin_cstr.equ.gen = []; + n_genecstr = 0; + else + n_genecstr = length (pin_cstr.equ.gen = f_genecstr (pin)); + endif + + #### collect remaining settings + hook.TolFun = optimget (settings, "TolFun", stol_default); + hook.MaxIter = optimget (settings, "MaxIter"); + if (ischar (hook.cpiv = optimget (settings, "cpiv", @ cpiv_bard))) + hook.cpiv = str2func (hook.cpiv); + endif + hook.Display = optimget (settings, "Display", "off"); + hook.testing = optimget (settings, "debug", false); + hook.siman.T_init = optimget (settings, "T_init", .01); + hook.siman.T_min = optimget (settings, "T_min", 1.0e-5); + hook.siman.mu_T = optimget (settings, "mu_T", 1.005); + hook.siman.iters_fixed_T = optimget (settings, "iters_fixed_T", 10); + hook.stoch_regain_constr = \ + optimget (settings, "stoch_regain_constr", false); + hook.trace_steps = \ + optimget (settings, "trace_steps", false); + hook.siman_log = \ + optimget (settings, "siman_log", false); + backend = optimget (settings, "Algorithm", "lm_feasible"); + backend = map_matlab_algorithm_names (backend); + backend = map_backend (backend); + + #### handle fixing of parameters + orig_lbound = lbound; + orig_ubound = ubound; + orig_fixed = fixed; + if (all (fixed)) + error ("no free parameters"); + endif + + nonfixed = ! fixed; + if (any (fixed)) + ## backend (returned values and initial parameters) + backend = @ (f, pin, hook) \ + backend_wrapper (backend, fixed, f, pin, hook); + + ## objective function + f = @ (p, varargin) f (assign (pin, nonfixed, p), varargin{:}); + + ## gradient of objective function + dfdp = @ (p, hook) \ + dfdp (assign (pin, nonfixed, p), hook)(nonfixed); + + ## hessian of objective function + if (! isempty (hessian)) + hessian = @ (p) \ + hessian (assign (pin, nonfixed, p))(nonfixed, nonfixed); + endif + + ## function for general inequality constraints + f_genicstr = @ (p, varargin) \ + f_genicstr (assign (pin, nonfixed, p), varargin{:}); + + ## jacobian of general inequality constraints + df_gencstr = @ (p, func, idx, hook) \ + df_gencstr (assign (pin, nonfixed, p), func, idx, hook) \ + (:, nonfixed); + + ## function for general equality constraints + f_genecstr = @ (p, varargin) \ + f_genecstr (assign (pin, nonfixed, p), varargin{:}); + + ## jacobian of general equality constraints + df_genecstr = @ (p, func, idx, hook) \ + df_genecstr (assign (pin, nonfixed, p), func, idx, hook) \ + (:, nonfixed); + + ## linear inequality constraints + vc += mc(fixed, :).' * (tp = pin(fixed)); + mc = mc(nonfixed, :); + + ## linear equality constraints + evc += emc(fixed, :).' * tp; + emc = emc(nonfixed, :); + + ## _last_ of all, vectors of parameter-related configuration, + ## including "fixed" itself + lbound = lbound(nonfixed, :); + ubound = ubound(nonfixed, :); + max_fract_change = max_fract_change(nonfixed); + fract_prec = fract_prec(nonfixed); + max_rand_step = max_rand_step(nonfixed); + fixed = fixed(nonfixed); + endif + + #### supplement constants to jacobian functions + + ## gradient of objective function + if (dfdp_pstruct) + dfdp = @ (p, hook) \ + dfdp (p, cell2fields \ + ({s_diffp, s_diff_onesided, s_orig_lbound, \ + s_orig_ubound, s_plabels, \ + cell2fields(num2cell(hook.fixed), pord(nonfixed), \ + 1, s_orig_fixed), cstep}, \ + {"diffp", "diff_onesided", "lbound", "ubound", \ + "plabels", "fixed", "h"}, \ + 2, hook)); + else + dfdp = @ (p, hook) \ + dfdp (p, cell2fields \ + ({diffp, diff_onesided, orig_lbound, orig_ubound, \ + plabels, assign(orig_fixed, nonfixed, hook.fixed), \ + cstep}, \ + {"diffp", "diff_onesided", "lbound", "ubound", \ + "plabels", "fixed", "h"}, \ + 2, hook)); + endif + + ## jacobian of general inequality constraints + if (df_inequc_pstruct) + df_gencstr = @ (p, func, idx, hook) \ + df_gencstr (p, func, idx, cell2fields \ + ({s_diffp, s_diff_onesided, s_orig_lbound, \ + s_orig_ubound, s_plabels, \ + cell2fields(num2cell(hook.fixed), pord(nonfixed), \ + 1, s_orig_fixed), cstep}, \ + {"diffp", "diff_onesided", "lbound", "ubound", \ + "plabels", "fixed", "h"}, \ + 2, hook)); + else + df_gencstr = @ (p, func, idx, hook) \ + df_gencstr (p, func, idx, cell2fields \ + ({diffp, diff_onesided, orig_lbound, \ + orig_ubound, plabels, \ + assign(orig_fixed, nonfixed, hook.fixed), cstep}, \ + {"diffp", "diff_onesided", "lbound", "ubound", \ + "plabels", "fixed", "h"}, \ + 2, hook)); + endif + + ## jacobian of general equality constraints + if (df_equc_pstruct) + df_genecstr = @ (p, func, idx, hook) \ + df_genecstr (p, func, idx, cell2fields \ + ({s_diffp, s_diff_onesided, s_orig_lbound, \ + s_orig_ubound, s_plabels, \ + cell2fields(num2cell(hook.fixed), pord(nonfixed), \ + 1, s_orig_fixed), cstep}, \ + {"diffp", "diff_onesided", "lbound", "ubound", \ + "plabels", "fixed", "h"}, \ + 2, hook)); + else + df_genecstr = @ (p, func, idx, hook) \ + df_genecstr (p, func, idx, cell2fields \ + ({diffp, diff_onesided, orig_lbound, \ + orig_ubound, plabels, \ + assign(orig_fixed, nonfixed, hook.fixed), cstep}, \ + {"diffp", "diff_onesided", "lbound", "ubound", \ + "plabels", "fixed", "h"}, \ + 2, hook)); + endif + + #### interfaces to constraints + + ## include bounds into linear inequality constraints + tp = eye (sum (nonfixed)); + lidx = lbound != - Inf; + uidx = ubound != Inf; + mc = cat (2, tp(:, lidx), - tp(:, uidx), mc); + vc = cat (1, - lbound(lidx, 1), ubound(uidx, 1), vc); + + ## concatenate linear inequality and equality constraints + mc = cat (2, mc, emc); + vc = cat (1, vc, evc); + n_lincstr = rows (vc); + + ## concatenate general inequality and equality constraints + if (n_genecstr > 0) + if (n_genicstr > 0) + nidxi = 1 : n_genicstr; + nidxe = n_genicstr + 1 : n_genicstr + n_genecstr; + f_gencstr = @ (p, idx, varargin) \ + cat (1, \ + f_genicstr (p, idx(nidxi), varargin{:}), \ + f_genecstr (p, idx(nidxe), varargin{:})); + df_gencstr = @ (p, idx, hook) \ + cat (1, \ + df_gencstr (p, @ (p, varargin) \ + possibly_pstruct_f_genicstr \ + (p, idx(nidxi), varargin{:}), \ + idx(nidxi), \ + setfield (hook, "f", \ + hook.f(nidxi(idx(nidxi))))), \ + df_genecstr (p, @ (p, varargin) \ + possibly_pstruct_f_genecstr \ + (p, idx(nidxe), varargin{:}), \ + idx(nidxe), \ + setfield (hook, "f", \ + hook.f(nidxe(idx(nidxe)))))); + else + f_gencstr = f_genecstr; + df_gencstr = @ (p, idx, hook) \ + df_genecstr (p, \ + @ (p, varargin) \ + possibly_pstruct_f_genecstr \ + (p, idx, varargin{:}), \ + idx, \ + setfield (hook, "f", hook.f(idx))); + endif + else + f_gencstr = f_genicstr; + df_gencstr = @ (p, idx, hook) \ + df_gencstr (p, \ + @ (p, varargin) \ + possibly_pstruct_f_genicstr (p, idx, varargin{:}), \ + idx, \ + setfield (hook, "f", hook.f(idx))); + endif + n_gencstr = n_genicstr + n_genecstr; + + ## concatenate linear and general constraints, defining the final + ## function interfaces + if (n_gencstr > 0) + nidxl = 1:n_lincstr; + nidxh = n_lincstr + 1 : n_lincstr + n_gencstr; + f_cstr = @ (p, idx, varargin) \ + cat (1, \ + mc(:, idx(nidxl)).' * p + vc(idx(nidxl), 1), \ + f_gencstr (p, idx(nidxh), varargin{:})); + df_cstr = @ (p, idx, hook) \ + cat (1, \ + mc(:, idx(nidxl)).', \ + df_gencstr (p, idx(nidxh), \ + setfield (hook, "f", \ + hook.f(nidxh)))); + else + f_cstr = @ (p, idx, varargin) mc(:, idx).' * p + vc(idx, 1); + df_cstr = @ (p, idx, hook) mc(:, idx).'; + endif + + ## define eq_idx (logical index of equality constraints within all + ## concatenated constraints + eq_idx = false (n_lincstr + n_gencstr, 1); + eq_idx(n_lincstr + 1 - rows (evc) : n_lincstr) = true; + n_cstr = n_lincstr + n_gencstr; + eq_idx(n_cstr + 1 - n_genecstr : n_cstr) = true; + + #### prepare interface hook + + ## passed constraints + hook.mc = mc; + hook.vc = vc; + hook.f_cstr = f_cstr; + hook.df_cstr = df_cstr; + hook.n_gencstr = n_gencstr; + hook.eq_idx = eq_idx; + hook.lbound = lbound; + hook.ubound = ubound; + + ## passed values of constraints for initial parameters + hook.pin_cstr = pin_cstr; + + ## passed function for gradient of objective function + hook.dfdp = dfdp; + + ## passed function for hessian of objective function + hook.hessian = hessian; + + ## passed function for complementary pivoting + ## hook.cpiv = cpiv; # set before + + ## passed value of objective function for initial parameters + hook.f_pin = f_pin; + + ## passed options + hook.max_fract_change = max_fract_change; + hook.fract_prec = fract_prec; + ## hook.TolFun = ; # set before + ## hook.MaxIter = ; # set before + hook.fixed = fixed; + hook.max_rand_step = max_rand_step; + + #### call backend + + [p, objf, cvg, outp] = backend (f, pin, hook); + + if (pin_struct) + if (pnonscalar) + p = cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1); + else + p = cell2struct (num2cell (p), pord, 1); + endif + endif + +endfunction + +function backend = map_matlab_algorithm_names (backend) + + ## nothing done here at the moment + +endfunction + +function backend = map_backend (backend) + + switch (backend) + ## case "sqp_infeasible" + ## backend = "__sqp__"; + ## case "sqp" + ## backend = "__sqp__"; + case "lm_feasible" + backend = "__lm_feasible__"; + case "siman" + backend = "__siman__"; + otherwise + error ("no backend implemented for algorithm '%s'", backend); + endswitch + + backend = str2func (backend); + +endfunction + +function [p, resid, cvg, outp] = backend_wrapper (backend, fixed, f, p, hook) + + [tp, resid, cvg, outp] = backend (f, p(! fixed), hook); + + p(! fixed) = tp; + +endfunction + +function lval = assign (lval, lidx, rval) + + lval(lidx) = rval; + +endfunction + +function m = hessian_struct2mat (s, pord) + + m = cell2mat (fields2cell \ + (structcat (1, NA, fields2cell (s, pord){:}), pord)); + + idx = isna (m); + + m(idx) = (m.')(idx); + +endfunction + +function ret = __optimget__ (s, name, default) + + if (isfield (s, name)) + ret = s.(name); + elseif (nargin > 2) + ret = default; + else + ret = []; + endif + +endfunction + +function ret = apply_idx_if_given (ret, varargin) + + if (nargin > 1) + ret = ret(varargin{1}); + endif + +endfunction + +%!demo +%! ## Example for default optimization (Levenberg/Marquardt with +%! ## BFGS), one non-linear equality constraint. Constrained optimum is +%! ## at p = [0; 1]. +%! objective_function = @ (p) p(1)^2 + p(2)^2; +%! pin = [-2; 5]; +%! constraint_function = @ (p) p(1)^2 + 1 - p(2); +%! [p, objf, cvg, outp] = nonlin_min (objective_function, pin, optimset ("equc", {constraint_function})) + +%!demo +%! ## Example for simulated annealing, two parameters, "trace_steps" +%! ## is true; +%! t_init = .2; +%! t_min = .002; +%! mu_t = 1.002; +%! iters_fixed_t = 10; +%! init_p = [2; 2]; +%! max_rand_step = [.2; .2]; +%! [p, objf, cvg, outp] = nonlin_min (@ (p) (p(1)/10)^2 + (p(2)/10)^2 + .1 * (-cos(4*p(1)) - cos(4*p(2))), init_p, optimset ("algorithm", "siman", "max_rand_step", max_rand_step, "t_init", t_init, "T_min", t_min, "mu_t", mu_t, "iters_fixed_T", iters_fixed_t, "trace_steps", true)); +%! p +%! objf +%! x = (outp.trace(:, 1) - 1) * iters_fixed_t + outp.trace(:, 2); +%! x(1) = 0; +%! plot (x, cat (2, outp.trace(:, 3:end), t_init ./ (mu_t .^ outp.trace(:, 1)))) +%! legend ({"objective function value", "p(1)", "p(2)", "Temperature"}) +%! xlabel ("subiteration") diff --git a/octave_packages/optim-1.2.0/nonlin_residmin.m b/octave_packages/optim-1.2.0/nonlin_residmin.m new file mode 100644 index 0000000..b98695d --- /dev/null +++ b/octave_packages/optim-1.2.0/nonlin_residmin.m @@ -0,0 +1,304 @@ +## Copyright (C) 2010, 2011 Olaf Till +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{p}, @var{resid}, @var{cvg}, @var{outp}] =} nonlin_residmin (@var{f}, @var{pin}) +## @deftypefnx {Function File} {[@var{p}, @var{resid}, @var{cvg}, @var{outp}] =} nonlin_residmin (@var{f}, @var{pin}, @var{settings}) +## Frontend for nonlinear minimization of residuals returned by a model +## function. +## +## The functions supplied by the user have a minimal +## interface; any additionally needed constants (e.g. observed values) +## can be supplied by wrapping the user functions into anonymous +## functions. +## +## The following description applies to usage with vector-based +## parameter handling. Differences in usage for structure-based +## parameter handling will be explained in a separate section below. +## +## @var{f}: function returning the array of residuals. It gets a column +## vector of real parameters as argument. In gradient determination, +## this function may be called with an informational second argument, +## whose content depends on the function for gradient determination. +## +## @var{pin}: real column vector of initial parameters. +## +## @var{settings}: structure whose fields stand for optional settings +## referred to below. The fields can be set by @code{optimset()} with +## Octave versions 3.3.55 or greater; with older Octave versions, the +## fields must be set directly as structure-fields in the correct case. +## +## The returned values are the column vector of final parameters +## @var{p}, the final array of residuals @var{resid}, an integer +## @var{cvg} indicating if and how optimization succeeded or failed, and +## a structure @var{outp} with additional information, curently with +## only one field: @var{niter}, the number of iterations. @var{cvg} is +## greater than zero for success and less than or equal to zero for +## failure; its possible values depend on the used backend and currently +## can be @code{0} (maximum number of iterations exceeded), @code{2} +## (parameter change less than specified precision in two consecutive +## iterations), or @code{3} (improvement in objective function --- e.g. +## sum of squares --- less than specified). +## +## @var{settings}: +## +## @code{Algorithm}: String specifying the backend. Default: +## @code{"lm_svd_feasible"}. The latter is currently the only backend +## distributed with this package. It is described in a separate section +## below. +## +## @code{dfdp}: Function computing the jacobian of the residuals with +## respect to the parameters, assuming residuals are reshaped to a +## vector. Default: finite differences. Will be called with the column +## vector of parameters and an informational structure as arguments. The +## structure has the fields @code{f}: value of residuals for current +## parameters, reshaped to a column vector, @code{fixed}: logical vector +## indicating which parameters are not optimized, so these partial +## derivatives need not be computed and can be set to zero, +## @code{diffp}, @code{diff_onesided}, @code{lbound}, @code{ubound}: +## identical to the user settings of this name, @code{plabels}: +## 1-dimensional cell-array of column-cell-arrays, each column with +## labels for all parameters, the first column contains the numerical +## indices of the parameters. The default jacobian function will call +## the model function with the second argument set with fields @code{f}: +## as the @code{f} passed to the jacobian function, @code{plabels}: +## cell-array of 1x1 cell-arrays with the entries of the +## column-cell-arrays of @code{plabels} as passed to the jacobian +## function corresponding to current parameter, @code{side}: @code{0} +## for one-sided interval, @code{1} or @code{2}, respectively, for the +## sides of a two-sided interval, and @code{parallel}: logical scalar +## indicating parallel computation of partial derivatives. +## +## @code{diffp}: column vector of fractional intervals (doubled for +## central intervals) supposed to be used by jacobian functions +## performing finite differencing. Default: @code{.001 * ones (size (parameters))}. The default jacobian function will use these as +## absolute intervals for parameters with value zero. +## +## @code{diff_onesided}: logical column vector indicating that one-sided +## intervals should be used by jacobian functions performing finite +## differencing. Default: @code{false (size (parameters))}. +## +## @code{complex_step_derivative_f}, +## @code{complex_step_derivative_inequc}, +## @code{complex_step_derivative_equc}: logical scalars, default: false. +## Estimate Jacobian of model function, general inequality constraints, +## and general equality constraints, respectively, with complex step +## derivative approximation. Use only if you know that your model +## function, function of general inequality constraints, or function of +## general equality constraints, respectively, is suitable for this. No +## user function for the respective Jacobian must be specified. +## +## @code{cstep}: scalar step size for complex step derivative +## approximation. Default: 1e-20. +## +## @code{fixed}: logical column vector indicating which parameters +## should not be optimized, but kept to their inital value. Fixing is +## done independently of the backend, but the backend may choose to fix +## additional parameters under certain conditions. +## +## @code{lbound}, @code{ubound}: column vectors of lower and upper +## bounds for parameters. Default: @code{-Inf} and @code{+Inf}, +## respectively. The bounds are non-strict, i.e. parameters are allowed +## to be exactly equal to a bound. The default jacobian function will +## respect bounds (but no further inequality constraints) in finite +## differencing. +## +## @code{inequc}: Further inequality constraints. Cell-array containing +## up to four entries, two entries for linear inequality constraints +## and/or one or two entries for general inequality constraints. Either +## linear or general constraints may be the first entries, but the two +## entries for linear constraints must be adjacent and, if two entries +## are given for general constraints, they also must be adjacent. The +## two entries for linear constraints are a matrix (say @code{m}) and a +## vector (say @code{v}), specifying linear inequality constraints of +## the form @code{m.' * parameters + v >= 0}. The first entry for +## general constraints must be a differentiable vector valued function +## (say @code{h}), specifying general inequality constraints of the form +## @code{h (p[, idx]) >= 0}; @code{p} is the column vector of optimized +## paraters and the optional argument @code{idx} is a logical index. +## @code{h} has to return the values of all constraints if @code{idx} is +## not given. It may choose to return only the indexed constraints if +## @code{idx} is given (so computation of the other constraints can be +## spared); in this case, the additional setting @code{inequc_f_idx} has +## to be set to @code{true}. In gradient determination, this function +## may be called with an informational third argument, whose content +## depends on the function for gradient determination. If a second entry +## for general inequality constraints is given, it must be a function +## computing the jacobian of the constraints with respect to the +## parameters. For this function, the description of @code{dfdp} above +## applies, with 2 exceptions: 1) it is called with 3 arguments since it +## has an additional argument @code{idx} --- a logical index --- at +## second position, indicating which rows of the jacobian must be +## returned (if the function chooses to return only indexed rows, the +## additional setting @code{inequc_df_idx} has to be set to +## @code{true}). 2) the default jacobian function calls @code{h} with 3 +## arguments, since the argument @code{idx} is also supplied. Note that +## specifying linear constraints as general constraints will generally +## waste performance, even if further, non-linear, general constraints +## are also specified. +## +## @code{equc}: Equality constraints. Specified the same way as +## inequality constraints (see @code{inequc}). +## +## @code{cpiv}: Function for complementary pivoting, usable in +## algorithms for constraints. Default: @ cpiv_bard. Only the default +## function is supplied with the package. +## +## @code{weights}: Array of weights for the residuals. Dimensions must +## match. +## +## @code{TolFun}: Minimum fractional improvement in objective function +## (e.g. sum of squares) in an iteration (abortion criterium). Default: +## .0001. +## +## @code{MaxIter}: Maximum number of iterations (abortion criterium). +## Default: backend-specific. +## +## @code{fract_prec}: Column Vector, minimum fractional change of +## parameters in an iteration (abortion criterium if violated in two +## consecutive iterations). Default: backend-specific. +## +## @code{max_fract_change}: Column Vector, enforced maximum fractional +## change in parameters in an iteration. Default: backend-specific. +## +## @code{Display}: String indicating the degree of verbosity. Default: +## @code{"off"}. Possible values are currently @code{"off"} (no +## messages) and @code{"iter"} (some messages after each iteration). +## Support of this setting and its exact interpretation are +## backend-specific. +## +## @code{plot_cmd}: Function enabling backend to plot results or +## intermediate results. Will be called with current computed +## residuals. Default: plot nothing. +## +## @code{debug}: Logical scalar, default: @code{false}. Will be passed +## to the backend, which might print debugging information if true. +## +## Structure-based parameter handling +## +## The setting @code{param_order} is a cell-array with names of the +## optimized parameters. If not given, and initial parameters are a +## structure, all parameters in the structure are optimized. If initial +## parameters are a structure, it is an error if @code{param_order} is +## not given and there are any non-structure-based configuration items +## or functions. +## +## The initial parameters @var{pin} can be given as a structure +## containing at least all fields named in @code{param_order}. In this +## case the returned parameters @var{p} will also be a structure. +## +## Each user-supplied function can be called with the argument +## containing the current parameters being a structure instead of a +## column vector. For this, a corresponding setting must be set to +## @code{true}: @code{f_pstruct} (model function), @code{dfdp_pstruct} +## (jacobian of model function), @code{f_inequc_pstruct} (general +## inequality constraints), @code{df_inequc_pstruct} (jacobian of +## general inequality constraints), @code{f_equc_pstruct} (general +## equality constraints), and @code{df_equc_pstruct} (jacobian of +## general equality constraints). If a jacobian-function is configured +## in such a way, it must return the columns of the jacobian as fields +## of a structure under the respective parameter names. +## +## Similarly, for specifying linear constraints, instead of the matrix +## (called @code{m} above), a structure containing the rows of the +## matrix in fields under the respective parameter names can be given. +## In this case, rows containing only zeros need not be given. +## +## The vector-based settings @code{lbound}, @code{ubound}, +## @code{fixed}, @code{diffp}, @code{diff_onesided}, @code{fract_prec}, +## and @code{max_fract_change} can be replaced by the setting +## @code{param_config}. It is a structure that can contain fields named +## in @code{param_order}. For each such field, there may be subfields +## with the same names as the above vector-based settings, but +## containing a scalar value for the respective parameter. If +## @code{param_config} is specified, none of the above +## vector/matrix-based settings may be used. +## +## Additionally, named parameters are allowed to be non-scalar real +## arrays. In this case, their dimensions are given by the setting +## @code{param_dims}, a cell-array of dimension vectors, each containing +## at least two dimensions; if not given, dimensions are taken from the +## initial parameters, if these are given in a structure. Any +## vector-based settings or not structure-based linear constraints then +## must correspond to an order of parameters with all parameters +## reshaped to vectors and concatenated in the user-given order of +## parameter names. Structure-based settings or structure-based initial +## parameters must contain arrays with dimensions reshapable to those of +## the respective parameters. +## +## Description of backends (currently only one) +## +## "lm_svd_feasible" +## +## A Levenberg/Marquardt algorithm using singular value decomposition +## and featuring constraints which must be met by the initial parameters +## and are attempted to be kept met throughout the optimization. +## +## Parameters with identical lower and upper bounds will be fixed. +## +## Returned value @var{cvg} will be @code{0}, @code{2}, or @code{3}. +## +## Backend-specific defaults are: @code{MaxIter}: 20, @code{fract_prec}: +## @code{zeros (size (parameters))}, @code{max_fract_change}: @code{Inf} +## for all parameters. +## +## Interpretation of @code{Display}: if set to @code{"iter"}, currently +## @code{plot_cmd} is evaluated for each iteration, and some further +## diagnostics may be printed. +## +## Specific option: @code{lm_svd_feasible_alt_s}: if falling back to +## nearly gradient descent, do it more like original Levenberg/Marquardt +## method, with descent in each gradient component; for testing only. +## +## @seealso {nonlin_curvefit} +## @end deftypefn + +function [p, resid, cvg, outp] = nonlin_residmin (varargin) + + if (nargin == 1) + p = __nonlin_residmin__ (varargin{1}); + return; + endif + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (nargin == 2) + varargin{3} = struct (); + endif + + varargin{4} = struct (); + + [p, resid, cvg, outp] = __nonlin_residmin__ (varargin{:}); + +endfunction + +%!demo +%! ## Example for linear inequality constraints +%! ## (see also the same example in 'demo nonlin_curvefit') +%! +%! ## independents +%! indep = 1:5; +%! ## residual function: +%! f = @ (p) p(1) * exp (p(2) * indep) - [1, 2, 4, 7, 14]; +%! ## initial values: +%! init = [.25; .25]; +%! ## linear constraints, A.' * parametervector + B >= 0 +%! A = [1; -1]; B = 0; # p(1) >= p(2); +%! settings = optimset ("inequc", {A, B}); +%! +%! ## start optimization +%! [p, residuals, cvg, outp] = nonlin_residmin (f, init, settings) diff --git a/octave_packages/optim-1.2.0/nrm.m b/octave_packages/optim-1.2.0/nrm.m new file mode 100644 index 0000000..e2e0c7a --- /dev/null +++ b/octave_packages/optim-1.2.0/nrm.m @@ -0,0 +1,38 @@ +## Copyright (C) 2000 Ben Sapp +## Copyright (C) 2002 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{xmin} =} nrm(@var{f},@var{x0}) +## Using @var{x0} as a starting point find a minimum of the scalar +## function @var{f}. The Newton-Raphson method is used. +## @end deftypefn + +## Reference: David G Luenberger's Linear and Nonlinear Programming + +function x = nrm(f,x,varargin) + velocity = 1; + acceleration = 1; + + h = 0.01; + while(abs(velocity) > 0.0001) + fx = feval(f,x,varargin{:}); + fxph = feval(f,x+h,varargin{:}); + fxmh = feval(f,x-h,varargin{:}); + velocity = (fxph - fxmh)/(2*h); + acceleration = (fxph - 2*fx + fxmh)/(h^2); + x = x - velocity/abs(acceleration); + endwhile +endfunction diff --git a/octave_packages/optim-1.2.0/optim_problems.m b/octave_packages/optim-1.2.0/optim_problems.m new file mode 100644 index 0000000..2450c50 --- /dev/null +++ b/octave_packages/optim-1.2.0/optim_problems.m @@ -0,0 +1,1258 @@ +%% Copyright (C) 2007 Paul Kienzle (sort-based lookup in ODE solver) +%% Copyright (C) 2009 Thomas Treichl (ode23 code) +%% Copyright (C) 2010 Olaf Till +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% Problems for testing optimizers. Documentation is in the code. + +function ret = optim_problems () + + %% As little external code as possible is called. This leads to some + %% duplication of external code. The advantages are that thus these + %% problems do not change with evolving external code, and that + %% optimization results in Octave can be compared with those in Matlab + %% without influence of differences in external code (e.g. ODE + %% solvers). Even calling 'interp1 (..., ..., ..., 'linear')' is + %% avoided by using an internal subfunction, although this is possibly + %% too cautious. + %% + %% For cross-program comparison of optimizers, the code of these + %% problems is intended to be Matlab compatible. + %% + %% External data may be loaded, which should be supplied in the + %% 'private/' subdirectory. Use the variable 'ddir', which contains + %% the path to this directory. + + %% Note: The difficulty of problems with dynamic models often + %% decisively depends on the the accuracy of the used ODE(DAE)-solver. + + %% Description of the returned structure + %% + %% According to 3 classes of problems, there are (or should be) three + %% fields: 'curve' (curve fitting), 'general' (general optimization), + %% and 'zero' (zero finding). The subfields are labels for the + %% particular problems. + %% + %% Under the label fields, there are subfields mostly identical + %% between the 3 classes of problems (some may contain empty values): + %% + %% .f: handle of an internally defined objective function (argument: + %% column vector of parameters), meant for minimization, or to a + %% 'model function' (arguments: independents, column vector of + %% parameters) in the case of curve fitting, where .f should return a + %% matrix of equal dimensions as .data.y below. + %% + %% .dfdp: handle of internally defined function for jacobian of + %% objective function or 'model function', respectively. + %% + %% .init_p: initial parameters, column vector + %% + %% possibly .init_p_b: two column matrix of ranges to choose initial + %% parameters from + %% + %% possibly .init_p_f: handle of internally defined function which + %% returns a column vector of initial parameters unique to the index + %% given as function argument; given '0' as function argument, + %% .init_p_f returns the maximum index + %% + %% .result.p: parameters of best known result + %% + %% possibly .result.obj: value of objective function for .result.p (or + %% sum of squared residuals in curve fitting). + %% + %% .data.x: matrix of independents (curve fitting) + %% + %% .data.y: matrix of observations, dimensions may be independent of + %% .data.x (curve fitting) + %% + %% .data.wt: matrix of weights, same dimensions as .data.y (curve + %% fitting) + %% + %% .data.cov: covariance matrix of .data.y(:) (not necessarily a + %% diagonal matrix, which could be expressed in .data.wt) + %% + %% .strict_inequc, .non_strict_inequc, .equc: 'strict' inequality + %% constraints (<, >), 'non-strict' inequality constraints (<=, >=), + %% and equality constraints, respectively. Subfields are: .bounds + %% (except in equality constraints): two-column matrix of ranges; + %% .linear: cell-array {m, v}, meaning linear constraints m.' * + %% parameters + v >|>=|== 0; .general: handle of internally defined + %% function h with h (p) >|>=|== 0; possibly .general_dcdp: handle of + %% internally defined function (argument: parameters) returning the + %% jacobian of the constraints given in .general. For the sake of + %% optimizers which can exploit this, the function in subfield + %% .general may accept a logical index vector as an optional second + %% argument, returning only the indexed constraint values. + + + %% Please keep the following list of problems current. + %% + %% .curve.p_1, .curve.p_2, .curve.p_3_d2: from 'Comparison of gradient + %% methods for the solution of nonlinear parameter estimation + %% problems' (1970), Yonathan Bard, Siam Journal on Numerical Analysis + %% 7(1), 157--186. The numbering of problems is the same as in the + %% article. Since Bard used strict bounds, testing optimizers which + %% used penalization for bounds, the bounds are changed here to allow + %% testing with non-strict bounds (<= or >=). .curve.p_3_d2 involves + %% dynamic modeling. These are not necessarily difficult problems. + %% + %% .curve.p_3_d2_noweights: problem .curve.p_3_d2 equivalently + %% re-formulated without weights. + %% + %% .curve.p_r: A seemingly more difficult 'real life' problem with + %% dynamic modeling. To assess optimizers, .init_p_f should be used + %% with 1:64. There should be two groups of results, indicating the + %% presence of two local minima. Olaf Till + %% + %% .....schittkowski_...: Klaus Schittkowski: 'More test examples for + %% nonlinear programming codes.' Lecture Notes in Economics and + %% Mathematical Systems 282, Berlin 1987. The published problems are + %% numbered from 201 to 395 and may appear here under the fields + %% .curve, .general, or .zero. + %% + %% .general.schittkowski_281: 10 parameters, unconstrained. + %% + %% .general.schittkowski_289: 30 parameters, unconstrained. + %% + %% .general.schittkowski_327 and + %% + %% .curve.schittkowski_327: Two parameters, one general inequality + %% constraint, two bounds. The best solution given in the publication + %% seems not very good (it probably has been achieved with general + %% minimization, not curve fitting) and has been replaced here by a + %% better (leasqr). + %% + %% .curve.schittkowski_372 and + %% + %% .general.schittkowski_372: 9 parameters, 12 general inequality + %% constraints, 6 bounds. Infeasible initial parameters + %% (.curve.schittkowski_372.init_p_f(1) provides a set of more or less + %% feasible parameters). leasqr sticks at the (feasible) initial + %% values. sqp has no problems. + %% + %% .curve.schittkowski_373: 9 parameters, 6 equality constraints. + %% Infeasible initial parameters (.curve.schittkowski_373.init_p_f(1) + %% provides a set of more or less feasible parameters). leasqr sticks + %% at the (feasible) initial values. sqp has no problems. + %% + %% .general.schittkowski_391: 30 parameters, unconstrained. The best + %% solution given in the publication seems not very good, obviously + %% the used routine had not managed to get very far from the starting + %% parameters; it has been replaced here by a better (Octaves + %% fminunc). The result still varies widely (without much changes in + %% objective function) with changes of starting values. Maybe not a + %% very good test problem, no well defined minimum ... + + %% needed for some anonymous functions + if (exist ('ifelse') ~= 5) + ifelse = @ scalar_ifelse; + end + + if (~exist ('OCTAVE_VERSION')) + NA = NaN; + end + + %% determine the directory of this functions file + fdir = fileparts (mfilename ('fullpath')); + %% data directory + ddir = sprintf ('%s%sprivate%s', fdir, filesep, filesep); + + ret.curve.p_1.dfdp = []; + ret.curve.p_1.init_p = [1; 1; 1]; + ret.curve.p_1.data.x = cat (2, ... + (1:15).', ... + (15:-1:1).', ... + [(1:8).'; (7:-1:1).']); + ret.curve.p_1.data.y = [.14; .18; .22; .25; .29; .32; .35; .39; ... + .37; .58; .73; .96; 1.34; 2.10; 4.39]; + ret.curve.p_1.data.wt = []; + ret.curve.p_1.data.cov = []; + ret.curve.p_1.result.p = [.08241040; 1.133033; 2.343697]; + ret.curve.p_1.strict_inequc.bounds = [0, 100; 0, 100; 0, 100]; + ret.curve.p_1.strict_inequc.linear = []; + ret.curve.p_1.strict_inequc.general = []; + ret.curve.p_1.non_strict_inequc.bounds = ... + [eps, 100; eps, 100; eps, 100]; + ret.curve.p_1.non_strict_inequc.linear = []; + ret.curve.p_1.non_strict_inequc.general = []; + ret.curve.p_1.equc.linear = []; + ret.curve.p_1.equc.general = []; + ret.curve.p_1.f = @ f_1; + + ret.curve.p_2.dfdp = []; + ret.curve.p_2.init_p = [0; 0; 0; 0; 0]; + ret.curve.p_2.data.x = [.871, .643, .550; ... + .228, .669, .854; ... + .528, .229, .170; ... + .110, .354, .337; ... + .911, .056, .493; ... + .476, .154, .918; ... + .655, .421, .077; ... + .649, .140, .199; ... + .995, .045, NA; ... + .130, .016, .195; ... + .823, .690, .690; ... + .768, .992, .389; ... + .203, .740, .120; ... + .302, .519, .221; ... + .991, .450, .249; ... + .224, .030, .502; ... + .428, .127, .772; ... + .552, .494, .110; ... + .461, .824, .714; ... + .799, .494, .295]; + ret.curve.p_2.data.y = zeros (20, 3); + ret.curve.p_2.data.wt = []; + ret.curve.p_2.data.cov = []; + ret.curve.p_2.data.misc = [4.36, 5.21, 5.35; ... + 4.99, 3.30, 3.10; ... + 1.67, NA, 2.75; ... + 2.17, 1.48, 1.49; ... + 2.98, 4.69, 4.23; ... + 4.46, 3.87, 3.15; ... + 1.79, 3.18, 3.57; ... + 1.71, 3.13, 3.07; ... + 3.07, 5.01, 4.58; ... + 0.94, 0.93, 0.74; ... + 4.97, 5.37, 5.35; ... + 4.32, 4.85, 5.46; ... + 2.17, 1.78, 2.43; ... + 2.22, 2.18, 2.44; ... + 2.88, 4.90, 5.11; ... + 2.29, 1.94, 1.46; ... + 3.76, 3.39, 2.71; ... + 1.99, 2.93, 3.31; ... + 4.95, 4.08, 4.19; ... + 2.96, 4.26, 4.48]; + ret.curve.p_2.result.p = [.9925145; 2.005293; 3.999732; ... + 2.680371; .4977683]; % from maximum + % likelyhood optimization + ret.curve.p_2.strict_inequc.bounds = []; + ret.curve.p_2.strict_inequc.linear = []; + ret.curve.p_2.strict_inequc.general = []; + ret.curve.p_2.non_strict_inequc.bounds = []; + ret.curve.p_2.non_strict_inequc.linear = []; + ret.curve.p_2.non_strict_inequc.general = []; + ret.curve.p_2.equc.linear = []; + ret.curve.p_2.equc.general = []; + ret.curve.p_2.f = @ (x, p) f_2 (x, p, ret.curve.p_2.data.misc); + + + + ret.curve.p_3_d2.dfdp = []; + ret.curve.p_3_d2.init_p = [.01; .01; .001; .001; .02; .001]; + ret.curve.p_3_d2.data.x = [0; 12.5; 25; 37.5; 50; ... + 62.5; 75; 87.5; 100]; + ret.curve.p_3_d2.data.y=[1 1 0 0 0 ; ... + .945757 .961201 .494861 .154976 .111485; ... + .926486 .928762 .690492 .314501 .236263; ... + .917668 .915966 .751806 .709300 .311747; ... + .928987 .917542 .771559 1.19224 .333096; ... + .927782 .920075 .780903 1.68815 .340324; ... + .925304 .912330 .790539 2.19539 .356787; ... + .925083 .917684 .783933 2.74211 .358283; ... + .917277 .907529 .779259 3.20025 .361969]; + ret.curve.p_3_d2.data.y(:, 3) = ... + ret.curve.p_3_d2.data.y(:, 3) / 10; + ret.curve.p_3_d2.data.y(:, 4:5) = ... + ret.curve.p_3_d2.data.y(:, 4:5) / 1000; + ret.curve.p_3_d2.data.wt = repmat ([.1, .1, 1, 10, 100], 9, 1); + ret.curve.p_3_d2.data.cov = []; + ret.curve.p_3_d2.result.p = [.6358247e-2; ... + .6774551e-1; ... + .5914274e-4; ... + .4944010e-3; ... + .1018828; ... + .4210526e-3]; + ret.curve.p_3_d2.strict_inequc.bounds = [0, 1; ... + 0, 1; ... + 0, .1; ... + 0, .1; ... + 0, 2; ... + 0, .1]; + ret.curve.p_3_d2.strict_inequc.linear = []; + ret.curve.p_3_d2.strict_inequc.general = []; + ret.curve.p_3_d2.non_strict_inequc.bounds = [eps, 1; ... + eps, 1; ... + eps, .1; ... + eps, .1; ... + eps, 2; ... + eps, .1]; + ret.curve.p_3_d2.non_strict_inequc.linear = []; + ret.curve.p_3_d2.non_strict_inequc.general = []; + ret.curve.p_3_d2.equc.linear = []; + ret.curve.p_3_d2.equc.general = []; + ret.curve.p_3_d2.f = @ f_3; + + ret.curve.p_3_d2_noweights = ret.curve.p_3_d2; + ret.curve.p_3_d2_noweights.data.wt = []; + ret.curve.p_3_d2_noweights.data.y(:, 1:2) = ... + ret.curve.p_3_d2_noweights.data.y(:, 1:2) * .1; + ret.curve.p_3_d2_noweights.data.y(:, 4) = ... + ret.curve.p_3_d2_noweights.data.y(:, 4) * 10; + ret.curve.p_3_d2_noweights.data.y(:, 5) = ... + ret.curve.p_3_d2_noweights.data.y(:, 5) * 100; + ret.curve.p_3_d2_noweights.f = @ f_3_noweights; + + ret.curve.p_r.dfdp = []; + ret.curve.p_r.init_p = [.3; .03; .003; .7; 1000; .0205]; + ret.curve.p_r.init_p_b = [.3, .5; ... + .03, .05; ... + .003, .005; ... + .7, .9; ... + 1000, 1300; ... + .0205, .023]; + ret.curve.p_r.init_p_f = @ (id) pc2 (ret.curve.p_r.init_p_b, id); + hook.ns = [84; 84; 85; 86; 84; 84; 84; 84]; + xb = [0.2, 0.8640; ... + 0.2, 0.5320; ... + 0.2, 0.4856; ... + 0.2, 0.4210; ... + 0.2, 0.3328; ... + 0.2, 0.2996; ... + 0.2, 0.2664; ... + 0.2, 0.2498]; + ns = cat (1, 0, cumsum (hook.ns)); + x = zeros (ns(end), 1); + for id = 1:8 + x(ns(id) + 1 : ns(id + 1)) = ... + linspace (xb(id, 1), xb(id, 2), hook.ns(id)).'; + end + hook.t = x; + ret.curve.p_r.data.x = x; + ret.curve.p_r.data.y = ... + load (sprintf ('%soptim_problems_p_r_y.data', ddir)); + ret.curve.p_r.data.wt = []; + ret.curve.p_r.data.cov = []; + ret.curve.p_r.result.p = [4.742909e-01; ... + 3.837951e-02; ... + 3.652570e-03; ... + 7.725986e-01; ... + 1.180967e+03; ... + 2.107000e-02]; + ret.curve.p_r.result.obj = 0.2043396; + ret.curve.p_r.strict_inequc.bounds = []; + ret.curve.p_r.strict_inequc.linear = []; + ret.curve.p_r.strict_inequc.general = []; + ret.curve.p_r.non_strict_inequc.bounds = []; + ret.curve.p_r.non_strict_inequc.linear = []; + ret.curve.p_r.non_strict_inequc.general = []; + ret.curve.p_r.equc.linear = []; + ret.curve.p_r.equc.general = []; + hook.mc = [2.0019999999999999e-01, 1.9939999999999999e-01, ... + 1.9939999999999999e-01, 1.9780000000000000e-01, ... + 2.0080000000000001e-01, 1.9960000000000000e-01, ... + 1.9960000000000000e-01, 1.9980000000000001e-01; ... + ... + 2.0060000000000000e-01, 2.0160000000000000e-01, ... + 2.0200000000000001e-01, 2.0200000000000001e-01, ... + 2.0180000000000001e-01, 2.0899999999999999e-01, ... + 2.0860000000000001e-01, 2.0820000000000000e-01; ... + ... + 2.1999144799999999e-02, 2.1998803099999999e-02, ... + 2.2000449599999999e-02, 2.2000024399999998e-02, ... + 2.1998160999999999e-02, 2.1999289000000002e-02, ... + 2.1998038800000001e-02, 2.2000270999999998e-02; ... + ... + -6.8806551999999986e-03, -1.3768898999999999e-02, ... + -1.6065479000000001e-02, -2.0657919600000001e-02, ... + -3.4479971099999999e-02, -4.5934394099999998e-02, ... + -6.9011619100000005e-02, -9.1971348400000000e-02; ... + ... + 2.3383865100000002e-02, 2.4768462500000001e-02, ... + 2.5231915899999999e-02, 2.6155515300000001e-02, ... + 2.8933514200000000e-02, 3.1235568599999999e-02, ... + 3.5874086299999997e-02, 4.0490560699999997e-02; ... + ... + -1.8240616806039459e+05, -1.6895474269973661e+03, ... + -8.1072652464694931e+02, -7.0113302985566395e+02, ... + 1.0929964862867249e+04, 3.5665776039585688e+02, ... + 5.7400262910547769e+02, 9.1737316974342252e+02; ... + ... + 1.0965398741890911e+05, 1.0131334821116490e+03, ... + 4.8504892529762208e+02, 4.1801020186158411e+02, ... + -6.6178457662355086e+03, -2.2103886018172699e+02, ... + -3.5529578864017282e+02, -5.6690686490678263e+02; ... + ... + -2.1972917026209168e+04, -2.0250659086265861e+02, ... + -9.6733175964156985e+01, -8.3069683020988421e+01, ... + 1.3356173243752210e+03, 4.5610806266307627e+01, ... + 7.3229009073208331e+01, 1.1667126232349770e+02; ... + ... + 1.4676952576063929e+03, 1.3514357622838521e+01, ... + 6.4524906786197480e+00, 5.5245948033669476e+00, ... + -8.9827382090060922e+01, -3.1118708128841241e+00, ... + -5.0039950796246986e+00, -7.9749636293721071e+00]; + ret.curve.p_r.f = @ (x, p) f_r (x, p, hook); + + ret.general.schittkowski_281.dfdp = ... + @ (p) schittkowski_281_dfdp (p); + ret.general.schittkowski_281.init_p = zeros (10, 1); + ret.general.schittkowski_281.result.p = ones (10, 1); % 'theoretically' + ret.general.schittkowski_281.result.obj = 0; % 'theoretically' + ret.general.schittkowski_281.strict_inequc.bounds = []; + ret.general.schittkowski_281.strict_inequc.linear = []; + ret.general.schittkowski_281.strict_inequc.general = []; + ret.general.schittkowski_281.non_strict_inequc.bounds = []; + ret.general.schittkowski_281.non_strict_inequc.linear = []; + ret.general.schittkowski_281.non_strict_inequc.general = []; + ret.general.schittkowski_281.equc.linear = []; + ret.general.schittkowski_281.equc.general = []; + ret.general.schittkowski_281.f = ... + @ (p) (sum (((1:10).') .^ 3 .* (p - 1) .^ 2)) ^ (1 / 3); + + ret.general.schittkowski_289.dfdp = ... + @ (p) exp (- sum (p .^ 2) / 60) / 30 * p; + ret.general.schittkowski_289.init_p = [-1.03; 1.07; -1.10; 1.13; ... + -1.17; 1.20; -1.23; 1.27; ... + -1.30; 1.33; -1.37; 1.40; ... + -1.43; 1.47; -1.50; 1.53; ... + -1.57; 1.60; -1.63; 1.67; ... + -1.70; 1.73; -1.77; 1.80; ... + -1.83; 1.87; -1.90; 1.93; ... + -1.97; 2.00]; + ret.general.schittkowski_289.result.p = zeros (30, 1); % 'theoretically' + ret.general.schittkowski_289.result.obj = 0; % 'theoretically' + ret.general.schittkowski_289.strict_inequc.bounds = []; + ret.general.schittkowski_289.strict_inequc.linear = []; + ret.general.schittkowski_289.strict_inequc.general = []; + ret.general.schittkowski_289.non_strict_inequc.bounds = []; + ret.general.schittkowski_289.non_strict_inequc.linear = []; + ret.general.schittkowski_289.non_strict_inequc.general = []; + ret.general.schittkowski_289.equc.linear = []; + ret.general.schittkowski_289.equc.general = []; + ret.general.schittkowski_289.f = @ (p) 1 - exp (- sum (p .^ 2) / 60); + + ret.curve.schittkowski_327.dfdp = ... + @ (x, p) [1 + exp(-p(2) * (x - 8)), ... + (p(1) + .49) * (8 - x) .* exp (-p(2) * (x - 8))]; + ret.curve.schittkowski_327.init_p = [.42; 5]; + ret.curve.schittkowski_327.data.x = ... + [8; 8; 10; 10; 10; 10; 12; 12; 12; 12; 14; 14; 14; 16; 16; 16; ... + 18; 18; 20; 20; 20; 22; 22; 22; 24; 24; 24; 26; 26; 26; 28; ... + 28; 30; 30; 30; 32; 32; 34; 36; 36; 38; 38; 40; 42]; + ret.curve.schittkowski_327.data.y= ... + [.49; .49; .48; .47; .48; .47; .46; .46; .45; .43; .45; .43; ... + .43; .44; .43; .43; .46; .45; .42; .42; .43; .41; .41; .40; ... + .42; .40; .40; .41; .40; .41; .41; .40; .40; .40; .38; .41; ... + .40; .40; .41; .38; .40; .40; .39; .39]; + ret.curve.schittkowski_327.data.wt = []; + ret.curve.schittkowski_327.data.cov = []; + %% This result was given by Schittkowski. No constraint is active + %% here. The second parameter is unchanged from initial value. + %% + %% ret.curve.schittkowski_327.result.p = [.4219; 5]; + %% ret.curve.schittkowski_327.result.obj = .0307986; + %% + %% This is the result of leasqr of Octave Forge. The general + %% constraint is active here. Both parameters are different from + %% initial value. The value of the objective function is better. + %% + ret.curve.schittkowski_327.result.p = [.4199227; 1.2842958]; + ret.curve.schittkowski_327.result.obj = .0284597; + ret.curve.schittkowski_327.strict_inequc.bounds = []; + ret.curve.schittkowski_327.strict_inequc.linear = []; + ret.curve.schittkowski_327.strict_inequc.general = []; + ret.curve.schittkowski_327.non_strict_inequc.bounds = [.4, Inf; ... + .4, Inf]; + ret.curve.schittkowski_327.non_strict_inequc.linear = []; + ret.curve.schittkowski_327.non_strict_inequc.general = ... + @ (p, varargin) apply_idx_if_given ... + (-.09 - p(1) * p(2) + .49 * p(2), varargin{:}); + ret.curve.schittkowski_327.equc.linear = []; + ret.curve.schittkowski_327.equc.general = []; + ret.curve.schittkowski_327.f = ... + @ (x, p) p(1) + (.49 - p(1)) * exp (-p(2) * (x - 8)); + + ret.general.schittkowski_327.init_p = [.42; 5]; + ret.general.schittkowski_327.data.x = ... + [8; 8; 10; 10; 10; 10; 12; 12; 12; 12; 14; 14; 14; 16; 16; 16; ... + 18; 18; 20; 20; 20; 22; 22; 22; 24; 24; 24; 26; 26; 26; 28; ... + 28; 30; 30; 30; 32; 32; 34; 36; 36; 38; 38; 40; 42]; + ret.general.schittkowski_327.data.y= ... + [.49; .49; .48; .47; .48; .47; .46; .46; .45; .43; .45; .43; ... + .43; .44; .43; .43; .46; .45; .42; .42; .43; .41; .41; .40; ... + .42; .40; .40; .41; .40; .41; .41; .40; .40; .40; .38; .41; ... + .40; .40; .41; .38; .40; .40; .39; .39]; + x = ret.general.schittkowski_327.data.x; + y = ret.general.schittkowski_327.data.y; + ret.general.schittkowski_327.dfdp = ... + @ (p) cat (2, ... + 2 * sum ((exp (-p(2 * x - 8)) - 1) * ... + (y + (p(1) - .49) * ... + exp (-p(2) * (x - 8)) - p1)), ... + 2 * (p(1) - .49) * ... + sum ((8 - x) * exp (-p(2 * x - 8)) * ... + (y + (p(1) - .49) * ... + exp (-p(2) * (x - 8)) - p1))); + %% This result was given by Schittkowski. No constraint is active + %% here. The second parameter is unchanged from initial value. + %% + %% ret.general.schittkowski_327.result.p = [.4219; 5]; + %% ret.general.schittkowski_327.result.obj = .0307986; + %% + %% This is the result of leasqr of Octave Forge. The general + %% constraint is active here. Both parameters are different from + %% initial value. The value of the objective function is better. sqp + %% gives a similar result. + ret.general.schittkowski_327.result.p = [.4199227; 1.2842958]; + ret.general.schittkowski_327.result.obj = .0284597; + ret.general.schittkowski_327.strict_inequc.bounds = []; + ret.general.schittkowski_327.strict_inequc.linear = []; + ret.general.schittkowski_327.strict_inequc.general = []; + ret.general.schittkowski_327.non_strict_inequc.bounds = [.4, Inf; ... + .4, Inf]; + ret.general.schittkowski_327.non_strict_inequc.linear = []; + ret.general.schittkowski_327.non_strict_inequc.general = ... + @ (p, varargin) apply_idx_if_given ... + (-.09 - p(1) * p(2) + .49 * p(2), varargin{:}); + ret.general.schittkowski_327.equc.linear = []; + ret.general.schittkowski_327.equc.general = []; + ret.general.schittkowski_327.f = ... + @ (p) sumsq (y - p(1) - (.49 - p(1)) * exp (-p(2) * (x - 8))); + + ret.curve.schittkowski_372.dfdp = ... + @ (x, p) cat (2, zeros (6, 3), eye (6)); + %% given by Schittkowski, not feasible + ret.curve.schittkowski_372.init_p = [300; -100; -.1997; -127; ... + -151; 379; 421; 460; 426]; + %% computed with sqp and a constant objective function, (almost) + %% feasible + ret.curve.schittkowski_372.init_p_f = @ (id) ... + ifelse (id == 0, 1, [2.951277e+02; ... + -1.058720e+02; ... + -9.535824e-02; ... + 2.421108e+00; ... + 3.191822e+00; ... + 3.790000e+02; ... + 4.210000e+02; ... + 4.600000e+02; ... + 4.260000e+02]); + ret.curve.schittkowski_372.data.x = (1:6).'; % any different numbers + ret.curve.schittkowski_372.data.y= zeros (6, 1); + ret.curve.schittkowski_372.data.wt = []; + ret.curve.schittkowski_372.data.cov = []; + %% recomputed with sqp (i.e. not with curve fitting) + ret.curve.schittkowski_372.result.p = [5.2330557804078126e+02; ... + -1.5694790476454301e+02; ... + -1.9966450018535931e-01; ... + 2.9607990282984435e+01; ... + 8.6615541706550545e+01; ... + 4.7326722338555498e+01; ... + 2.6235616534580515e+01; ... + 2.2915996663200740e+01; ... + 3.9470733973874445e+01]; + ret.curve.schittkowski_372.result.obj = 13390.1; + ret.curve.schittkowski_372.strict_inequc.bounds = []; + ret.curve.schittkowski_372.strict_inequc.linear = []; + ret.curve.schittkowski_372.strict_inequc.general = []; + ret.curve.schittkowski_372.non_strict_inequc.bounds = [-Inf, Inf; ... + -Inf, Inf; ... + -Inf, Inf; ... + 0, Inf; ... + 0, Inf; ... + 0, Inf; ... + 0, Inf; ... + 0, Inf; ... + 0, Inf]; + ret.curve.schittkowski_372.non_strict_inequc.linear = []; + ret.curve.schittkowski_372.non_strict_inequc.general = ... + @ (p, varargin) apply_idx_if_given ... + (cat (1, p(1) + p(2) * exp (-5 * p(3)) + p(4) - 127, ... + p(1) + p(2) * exp (-3 * p(3)) + p(5) - 151, ... + p(1) + p(2) * exp (-p(3)) + p(6) - 379, ... + p(1) + p(2) * exp (p(3)) + p(7) - 421, ... + p(1) + p(2) * exp (3 * p(3)) + p(8) - 460, ... + p(1) + p(2) * exp (5 * p(3)) + p(9) - 426, ... + -p(1) - p(2) * exp (-5 * p(3)) + p(4) + 127, ... + -p(1) - p(2) * exp (-3 * p(3)) + p(5) + 151, ... + -p(1) - p(2) * exp (-p(3)) + p(6) + 379, ... + -p(1) - p(2) * exp (p(3)) + p(7) + 421, ... + -p(1) - p(2) * exp (3 * p(3)) + p(8) + 460, ... + -p(1) - p(2) * exp (5 * p(3)) + p(9) + 426), ... + varargin{:}); + ret.curve.schittkowski_372.equc.linear = []; + ret.curve.schittkowski_372.equc.general = []; + ret.curve.schittkowski_372.f = @ (x, p) p(4:9); + + ret.curve.schittkowski_373.dfdp = ... + @ (x, p) cat (2, zeros (6, 3), eye (6)); + %% not feasible + ret.curve.schittkowski_373.init_p = [300; -100; -.1997; -127; ... + -151; 379; 421; 460; 426]; + %% feasible + ret.curve.schittkowski_373.init_p_f = @ (id) ... + ifelse (id == 0, 1, [2.5722721227695763e+02; ... + -1.5126681606092043e+02; ... + 8.3101871447778766e-02; ... + -3.0390506000425454e+01; ... + 1.1661334225083069e+01; ... + 2.6097719374430665e+02; ... + 3.2814725183082305e+02; ... + 3.9686840023267564e+02; ... + 3.9796353824451995e+02]); + ret.curve.schittkowski_373.data.x = (1:6).'; % any different numbers + ret.curve.schittkowski_373.data.y= zeros (6, 1); + ret.curve.schittkowski_373.data.wt = []; + ret.curve.schittkowski_373.data.cov = []; + ret.curve.schittkowski_373.result.p = [523.31; ... + -156.95; ... + -.2; ... + 29.61; ... + -86.62; ... + 47.33; ... + 26.24; ... + 22.92; ... + -39.47]; + ret.curve.schittkowski_373.result.obj = 13390.1; + ret.curve.schittkowski_373.strict_inequc.bounds = []; + ret.curve.schittkowski_373.strict_inequc.linear = []; + ret.curve.schittkowski_373.strict_inequc.general = []; + ret.curve.schittkowski_373.non_strict_inequc.bounds = []; + ret.curve.schittkowski_373.non_strict_inequc.linear = []; + ret.curve.schittkowski_373.non_strict_inequc.general = []; + ret.curve.schittkowski_373.equc.linear = []; + ret.curve.schittkowski_373.equc.general = ... + @ (p, varargin) apply_idx_if_given ... + (cat (1, p(1) + p(2) * exp (-5 * p(3)) + p(4) - 127, ... + p(1) + p(2) * exp (-3 * p(3)) + p(5) - 151, ... + p(1) + p(2) * exp (-p(3)) + p(6) - 379, ... + p(1) + p(2) * exp (p(3)) + p(7) - 421, ... + p(1) + p(2) * exp (3 * p(3)) + p(8) - 460, ... + p(1) + p(2) * exp (5 * p(3)) + p(9) - 426), ... + varargin{:}); + ret.curve.schittkowski_373.f = @ (x, p) p(4:9); + + ret.general.schittkowski_372.dfdp = ... + @ (p) cat (2, zeros (1, 3), 2 * p(4:9)); + %% not feasible + ret.general.schittkowski_372.init_p = [300; -100; -.1997; -127; ... + -151; 379; 421; 460; 426]; + %% recomputed with sqp + ret.general.schittkowski_372.result.p = [5.2330557804078126e+02; ... + -1.5694790476454301e+02; ... + -1.9966450018535931e-01; ... + 2.9607990282984435e+01; ... + 8.6615541706550545e+01; ... + 4.7326722338555498e+01; ... + 2.6235616534580515e+01; ... + 2.2915996663200740e+01; ... + 3.9470733973874445e+01]; + ret.general.schittkowski_372.result.obj = 13390.1; + ret.general.schittkowski_372.strict_inequc.bounds = []; + ret.general.schittkowski_372.strict_inequc.linear = []; + ret.general.schittkowski_372.strict_inequc.general = []; + ret.general.schittkowski_372.non_strict_inequc.bounds = [-Inf, Inf; ... + -Inf, Inf; ... + -Inf, Inf; ... + 0, Inf; ... + 0, Inf; ... + 0, Inf; ... + 0, Inf; ... + 0, Inf; ... + 0, Inf]; + ret.general.schittkowski_372.non_strict_inequc.linear = []; + ret.general.schittkowski_372.non_strict_inequc.general = ... + @ (p, varargin) apply_idx_if_given ... + (cat (1, p(1) + p(2) * exp (-5 * p(3)) + p(4) - 127, ... + p(1) + p(2) * exp (-3 * p(3)) + p(5) - 151, ... + p(1) + p(2) * exp (-p(3)) + p(6) - 379, ... + p(1) + p(2) * exp (p(3)) + p(7) - 421, ... + p(1) + p(2) * exp (3 * p(3)) + p(8) - 460, ... + p(1) + p(2) * exp (5 * p(3)) + p(9) - 426, ... + -p(1) - p(2) * exp (-5 * p(3)) + p(4) + 127, ... + -p(1) - p(2) * exp (-3 * p(3)) + p(5) + 151, ... + -p(1) - p(2) * exp (-p(3)) + p(6) + 379, ... + -p(1) - p(2) * exp (p(3)) + p(7) + 421, ... + -p(1) - p(2) * exp (3 * p(3)) + p(8) + 460, ... + -p(1) - p(2) * exp (5 * p(3)) + p(9) + 426), ... + varargin{:}); + ret.general.schittkowski_372.equc.linear = []; + ret.general.schittkowski_372.equc.general = []; + ret.general.schittkowski_372.f = @ (p) sumsq (p(4:9)); + + ret.general.schittkowski_391.dfdp = []; + ret.general.schittkowski_391.init_p = ... + -2.8742711 * alpha_391 (zeros (30, 1), 1:30); + %% computed with fminunc (Octave) + ret.general.schittkowski_391.result.p = [-1.1986682e+18; ... + -1.1474574e+07; ... + -1.3715802e+07; ... + -1.0772255e+07; ... + -1.0634232e+07; ... + -1.0622915e+07; ... + -8.8775399e+06; ... + -8.8201496e+06; ... + -9.7729975e+06; ... + -1.0431808e+07; ... + -1.0415089e+07; ... + -1.0350400e+07; ... + -1.0325094e+07; ... + -1.0278561e+07; ... + -1.0275751e+07; ... + -1.0276546e+07; ... + -1.0292584e+07; ... + -1.0289350e+07; ... + -1.0192566e+07; ... + -1.0058577e+07; ... + -1.0096341e+07; ... + -1.0242386e+07; ... + -1.0615831e+07; ... + -1.1142096e+07; ... + -1.1617283e+07; ... + -1.2005738e+07; ... + -1.2282117e+07; ... + -1.2301260e+07; ... + -1.2051365e+07; ... + -1.1704693e+07]; + ret.general.schittkowski_391.result.obj = -5.1615468e+20; + ret.general.schittkowski_391.strict_inequc.bounds = []; + ret.general.schittkowski_391.strict_inequc.linear = []; + ret.general.schittkowski_391.strict_inequc.general = []; + ret.general.schittkowski_391.non_strict_inequc.bounds = []; + ret.general.schittkowski_391.non_strict_inequc.linear = []; + ret.general.schittkowski_391.non_strict_inequc.general = []; + ret.general.schittkowski_391.equc.linear = []; + ret.general.schittkowski_391.equc.general = []; + ret.general.schittkowski_391.f = @ (p) sum (alpha_391 (p, 1:30)); + + function ret = f_1 (x, p) + + ret = p(1) + x(:, 1) ./ (p(2) * x(:, 2) + p(3) * x(:, 3)); + + function ret = f_2 (x, p, y) + + y(3, 2) = p(4); + x(9, 3) = p(5); + p = p(:); + mp = cat (2, p([1, 2, 3]), p([3, 1, 2]), p([3, 2, 1])); + ret = x * mp - y; + + function ret = f_3 (x, p) + + ret = fixed_step_rk4 (x.', [1, 1, 0, 0, 0], 1, ... + @ (x, t) f_3_xdot (x, t, p)); + ret = ret.'; + + function ret = f_3_noweights (x, p) + + ret = fixed_step_rk4 (x.', [.1, .1, 0, 0, 0], .2, ... + @ (x, t) f_3_xdot_noweights (x, t, p)); + ret = ret.'; + + function ret = f_3_xdot (x, t, p) + + ret = zeros (5, 1); + tp = p(2) * x(3) - p(1) * x(1) * x(2); + ret(1) = tp; + ret(2) = tp - p(4) * x(2) * x(3) + p(5) * x(5) - p(6) * x(2) * x(4); + ret(3) = - tp - p(3) * x(3) - p(4) * x(2) * x(3); + ret(4) = p(3) * x(3) + p(5) * x(5) - p(6) * x(2) * x(4); + ret(5) = p(4) * x(2) * x(3) - p(5) * x(5) + p(6) * x(2) * x(4); + + function ret = f_3_xdot_noweights (x, t, p) + + x(1:2) = x(1:2) / .1; + x(4) = x(4) / 10; + x(5) = x(5) / 100; + ret = f_3_xdot (x, t, p); + ret(1:2) = ret(1:2) * .1; + ret(4) = ret(4) * 10; + ret(5) = ret(5) * 100; + + function ret = f_r (x, p, hook) + + n = size (hook.mc, 2); + ns = cat (1, 0, cumsum (hook.ns)); + xdhook.p = p; + ret = zeros (1, ns(end)); + %% temporary variables + dls = p(3) ^ 2; + dmhp = p(5) * dls / p(4); + mhp = dmhp / 2; + %% + for id = 1:n + xdhook.c = hook.mc(:, id); + l = xdhook.c(3); + x0 = mhp - sqrt (max (0, mhp ^ 2 + dls + (p(6) - l) * dmhp)); + ids = ns(id) + 1; + ide = ns(id + 1); + + tp = odeset (); + %% necessary in Matlab (7.1) + tp.OutputSave = []; + tp.Refine = 0; + %% + tp.RelTol = 1e-7; + tp.AbsTol = 1e-7; + [cx, Xcx] = essential_ode23 (@ (t, X) f_r_xdot (X, t, xdhook), ... + x([ids, ide]).', x0, tp); + X = lin_interp (cx.', Xcx.', x(ids:ide).'); + + X = X.'; + [discarded, lr] = ... + f_r_xdot (X, hook.t(ids:ide), xdhook); + ret(ids:ide) = max (0, lr - p(6) - X) * p(5); + end + ret = ret.'; + + function [ret, l] = f_r_xdot (x, t, hook) + + %% keep this working with non-scalar x and t + + p = hook.p; + c = hook.c; + idl = t <= c(1); + idg = t >= c(2); + idb = ~ (idl | idg); + l = zeros (size (t)); + l(idl) = c(3); + l(idg) = c(4) * t(idg) + c(5); + l(idb) = polyval (c(6:9), t(idb)); + dls = max (1e-6, l - p(6) - x); + tf = x / p(3); + ido = tf >= 1; + idx = ~ido; + ret(ido) = 0; + ret(idx) = - ((p(4) + p(1)) * p(2)) ./ ... + ((p(5) * dls(idx)) ./ (1 - tf(idx) .^ 2) + p(1)) + p(2); + + function ret = alpha_391 (p, id) + + %% for .general.schittkowski_391; id is a numeric index(-vector) + %% into p + + p = p(:); + n = size (p, 1); + + nid = length (id); + id = reshape (id, 1, nid); + + v = sqrt (repmat (p .^ 2, 1, nid) + 1 ./ ((1:n).') * id); + + log_v = log (v); + + ret = 420 * p(id) + (id(:) - 15) .^ 3 + ... + sum (v .* (sin (log_v) .^ 5 + cos (log_v) .^ 5)).'; + + function ret = schittkowski_281_dfdp (p) + + tp = (sum (((1:10).') .^ 3 .* (p - 1) .^ 2)) ^ (- 2 / 3) / 3; + + ret = 2 * ((1:10).') .^ 3 .* (p - 1) * tp; + + function state = fixed_step_rk4 (t, x0, step, f) + + %% minimalistic fourth order ODE-solver, as said to be a popular one + %% by Wikipedia (to make these optimization tests self-contained; + %% for the same reason 'lookup' and even 'interp1' are not used + %% here) + + n = ceil ((t(end) - t(1)) / step) + 1; + m = length (x0); + tstate = zeros (m, n); + tstate(:, 1) = x0; + tt = linspace (t(1), t(1) + step * (n - 1), n); + for id = 1 : n - 1 + k1 = f (tstate(:, id), tt(id)); + k2 = f (tstate(:, id) + .5 * step * k1, tt(id) + .5 * step); + k3 = f (tstate(:, id) + .5 * step * k2, tt(id) + .5 * step); + k4 = f (tstate(:, id) + step * k3, tt(id + 1)); + tstate(:, id + 1) = tstate(:, id) + ... + (step / 6) * (k1 + 2 * k2 + 2 * k3 + k4); + end + state = lin_interp (tt, tstate, t); + + function ret = pc2 (p, id) + %% a combination out of 2 possible values for each parameter + r = size (p, 1); + n = 2 ^ r; + if (id < 0 || id > n) + error ('no parameter set for this index'); + end + if (id == 0) % return maximum id + ret = n; + return; + end + idx = dec2bin (id - 1, r) == '1'; + nidx = ~idx; + ret = zeros (r, 1); + ret(nidx) = p(nidx, 1); + ret(idx) = p(idx, 2); + + function [varargout] = essential_ode23 (vfun, vslot, vinit, vodeoptions) + + %% This code is taken from the ode23 solver of Thomas Treichl + %% , some flexibility of the + %% interface has been removed. The idea behind this duplication is + %% to have a fixed version of the solver here which runs both in + %% Octave and Matlab. + + %% Some of the option treatment has been left out. + if (length (vslot) > 2) + vstepsizefixed = true; + else + vstepsizefixed = false; + end + if (strcmp (vodeoptions.NormControl, 'on')) + vnormcontrol = true; + else + vnormcontrol = false; + end + if (~isempty (vodeoptions.NonNegative)) + if (isempty (vodeoptions.Mass)) + vhavenonnegative = true; + else + vhavenonnegative = false; + end + else + vhavenonnegative = false; + end + if (isempty (vodeoptions.OutputFcn) && nargout == 0) + vodeoptions.OutputFcn = @odeplot; + vhaveoutputfunction = true; + elseif (isempty (vodeoptions.OutputFcn)) + vhaveoutputfunction = false; + else + vhaveoutputfunction = true; + end + if (~isempty (vodeoptions.OutputSel)) + vhaveoutputselection = true; + else + vhaveoutputselection = false; + end + if (isempty (vodeoptions.OutputSave)) + vodeoptions.OutputSave = 1; + end + if (vodeoptions.Refine > 0) + vhaverefine = true; + else + vhaverefine = false; + end + if (isempty (vodeoptions.InitialStep) && ~vstepsizefixed) + vodeoptions.InitialStep = (vslot(1,2) - vslot(1,1)) / 10; + vodeoptions.InitialStep = vodeoptions.InitialStep / ... + 10^vodeoptions.Refine; + end + if (isempty (vodeoptions.MaxStep) && ~vstepsizefixed) + vodeoptions.MaxStep = (vslot(1,2) - vslot(1,1)) / 10; + end + if (~isempty (vodeoptions.Events)) + vhaveeventfunction = true; + else + vhaveeventfunction = false; + end + if (~isempty (vodeoptions.Mass) && ismatrix (vodeoptions.Mass)) + vhavemasshandle = false; + vmass = vodeoptions.Mass; + elseif (isa (vodeoptions.Mass, 'function_handle')) + vhavemasshandle = true; + else + vhavemasshandle = false; + end + if (strcmp (vodeoptions.MStateDependence, 'none')) + vmassdependence = false; + else + vmassdependence = true; + end + + %% Starting the initialisation of the core solver ode23 + vtimestamp = vslot(1,1); %% timestamp = start time + vtimelength = length (vslot); %% length needed if fixed steps + vtimestop = vslot(1,vtimelength); %% stop time = last value + vdirection = sign (vtimestop); %% Flag for direction to solve + + if (~vstepsizefixed) + vstepsize = vodeoptions.InitialStep; + vminstepsize = (vtimestop - vtimestamp) / (1/eps); + else %% If step size is given then use the fixed time steps + vstepsize = vslot(1,2) - vslot(1,1); + vminstepsize = sign (vstepsize) * eps; + end + + vretvaltime = vtimestamp; %% first timestamp output + vretvalresult = vinit; %% first solution output + + %% Initialize the OutputFcn + if (vhaveoutputfunction) + if (vhaveoutputselection) vretout = ... + vretvalresult(vodeoptions.OutputSel); + else + vretout = vretvalresult; + end + feval (vodeoptions.OutputFcn, vslot.', ... + vretout.', 'init'); + end + + %% Initialize the EventFcn + if (vhaveeventfunction) + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vretvalresult.', 'init'); + end + + vpow = 1/3; %% 20071016, reported by Luis Randez + va = [ 0, 0, 0; %% The Runge-Kutta-Fehlberg 2(3) coefficients + 1/2, 0, 0; %% Coefficients proved on 20060827 + -1, 2, 0]; %% See p.91 in Ascher & Petzold + vb2 = [0; 1; 0]; %% 2nd and 3rd order + vb3 = [1/6; 2/3; 1/6]; %% b-coefficients + vc = sum (va, 2); + + %% The solver main loop - stop if the endpoint has been reached + vcntloop = 2; vcntcycles = 1; vu = vinit; vk = vu.' * zeros(1,3); + vcntiter = 0; vunhandledtermination = true; vcntsave = 2; + while ((vdirection * (vtimestamp) < vdirection * (vtimestop)) && ... + (vdirection * (vstepsize) >= vdirection * (vminstepsize))) + + %% Hit the endpoint of the time slot exactely + if ((vtimestamp + vstepsize) > vdirection * vtimestop) + %% if (((vtimestamp + vstepsize) > vtimestop) || ... + %% (abs(vtimestamp + vstepsize - vtimestop) < eps)) + vstepsize = vtimestop - vdirection * vtimestamp; + end + + %% Estimate the three results when using this solver + for j = 1:3 + vthetime = vtimestamp + vc(j,1) * vstepsize; + vtheinput = vu.' + vstepsize * vk(:,1:j-1) * va(j,1:j-1).'; + if (vhavemasshandle) %% Handle only the dynamic mass matrix, + if (vmassdependence) %% constant mass matrices have already + vmass = feval ... %% been set before (if any) + (vodeoptions.Mass, vthetime, vtheinput); + else %% if (vmassdependence == false) + vmass = feval ... %% then we only have the time argument + (vodeoptions.Mass, vthetime); + end + vk(:,j) = vmass \ feval ... + (vfun, vthetime, vtheinput); + else + vk(:,j) = feval ... + (vfun, vthetime, vtheinput); + end + end + + %% Compute the 2nd and the 3rd order estimation + y2 = vu.' + vstepsize * (vk * vb2); + y3 = vu.' + vstepsize * (vk * vb3); + if (vhavenonnegative) + vu(vodeoptions.NonNegative) = abs (vu(vodeoptions.NonNegative)); + y2(vodeoptions.NonNegative) = abs (y2(vodeoptions.NonNegative)); + y3(vodeoptions.NonNegative) = abs (y3(vodeoptions.NonNegative)); + end + vSaveVUForRefine = vu; + + %% Calculate the absolute local truncation error and the + %% acceptable error + if (~vstepsizefixed) + if (~vnormcontrol) + vdelta = abs (y3 - y2); + vtau = max (vodeoptions.RelTol * abs (vu.'), ... + vodeoptions.AbsTol); + else + vdelta = norm (y3 - y2, Inf); + vtau = max (vodeoptions.RelTol * max (norm (vu.', Inf), ... + 1.0), ... + vodeoptions.AbsTol); + end + else %% if (vstepsizefixed == true) + vdelta = 1; vtau = 2; + end + + %% If the error is acceptable then update the vretval variables + if (all (vdelta <= vtau)) + vtimestamp = vtimestamp + vstepsize; + vu = y3.'; %% MC2001: the higher order estimation as 'local + %% extrapolation' Save the solution every vodeoptions.OutputSave + %% steps + if (mod (vcntloop-1,vodeoptions.OutputSave) == 0) + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu; + vcntsave = vcntsave + 1; + end + vcntloop = vcntloop + 1; vcntiter = 0; + + %% Call plot only if a valid result has been found, therefore + %% this code fragment has moved here. Stop integration if plot + %% function returns false + if (vhaveoutputfunction) + for vcnt = 0:vodeoptions.Refine %% Approximation between told + %% and t + if (vhaverefine) %% Do interpolation + vapproxtime = (vcnt + 1) * vstepsize / ... + (vodeoptions.Refine + 2); + vapproxvals = vSaveVUForRefine.' + vapproxtime * (vk * ... + vb3); + vapproxtime = (vtimestamp - vstepsize) + vapproxtime; + else + vapproxvals = vu.'; + vapproxtime = vtimestamp; + end + if (vhaveoutputselection) + vapproxvals = vapproxvals(vodeoptions.OutputSel); + end + vpltret = feval (vodeoptions.OutputFcn, vapproxtime, ... + vapproxvals, []); + if vpltret %% Leave refinement loop + break; + end + end + if (vpltret) %% Leave main loop + vunhandledtermination = false; + break; + end + end + + %% Call event only if a valid result has been found, therefore + %% this code fragment has moved here. Stop integration if + %% veventbreak is true + if (vhaveeventfunction) + vevent = ... + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vu(:), []); + if (~isempty (vevent{1}) && vevent{1} == 1) + vretvaltime(vcntloop-1,:) = vevent{3}(end,:); + vretvalresult(vcntloop-1,:) = vevent{4}(end,:); + vunhandledtermination = false; break; + end + end + end %% If the error is acceptable ... + + %% Update the step size for the next integration step + if (~vstepsizefixed) + %% 20080425, reported by Marco Caliari vdelta cannot be negative + %% (because of the absolute value that has been introduced) but + %% it could be 0, then replace the zeros with the maximum value + %% of vdelta + vdelta(find (vdelta == 0)) = max (vdelta); + %% It could happen that max (vdelta) == 0 (ie. that the original + %% vdelta was 0), in that case we double the previous vstepsize + vdelta(find (vdelta == 0)) = max (vtau) .* (0.4 ^ (1 / vpow)); + + if (vdirection == 1) + vstepsize = min (vodeoptions.MaxStep, ... + min (0.8 * vstepsize * (vtau ./ vdelta) .^ ... + vpow)); + else + vstepsize = max (vodeoptions.MaxStep, ... + max (0.8 * vstepsize * (vtau ./ vdelta) .^ ... + vpow)); + end + else %% if (vstepsizefixed) + if (vcntloop <= vtimelength) + vstepsize = vslot(vcntloop) - vslot(vcntloop-1); + else %% Get out of the main integration loop + break; + end + end + + %% Update counters that count the number of iteration cycles + vcntcycles = vcntcycles + 1; %% Needed for cost statistics + vcntiter = vcntiter + 1; %% Needed to find iteration problems + + %% Stop solving because the last 1000 steps no successful valid + %% value has been found + if (vcntiter >= 5000) + error (['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f before endpoint at', ... + ' tend = %f was reached. This happened because the iterative', ... + ' integration loop does not find a valid solution at this time', ... + ' stamp. Try to reduce the value of ''InitialStep'' and/or', ... + ' ''MaxStep'' with the command ''odeset''.\n'], vtimestamp, vtimestop); + end + + end %% The main loop + + %% Check if integration of the ode has been successful + if (vdirection * vtimestamp < vdirection * vtimestop) + if (vunhandledtermination == true) + error ('OdePkg:InvalidArgument', ... + ['Solving has not been successful. The iterative', ... + ' integration loop exited at time t = %f', ... + ' before endpoint at tend = %f was reached. This may', ... + ' happen if the stepsize grows smaller than defined in', ... + ' vminstepsize. Try to reduce the value of ''InitialStep'' and/or', ... + ' ''MaxStep'' with the command ''odeset''.\n'], vtimestamp, vtimestop); + else + warning ('OdePkg:InvalidArgument', ... + ['Solver has been stopped by a call of ''break'' in', ... + ' the main iteration loop at time t = %f before endpoint at', ... + ' tend = %f was reached. This may happen because the @odeplot', ... + ' function returned ''true'' or the @event function returned ''true''.'], ... + vtimestamp, vtimestop); + end + end + + %% Postprocessing, do whatever when terminating integration + %% algorithm + if (vhaveoutputfunction) %% Cleanup plotter + feval (vodeoptions.OutputFcn, vtimestamp, ... + vu.', 'done'); + end + if (vhaveeventfunction) %% Cleanup event function handling + odepkg_event_handle (vodeoptions.Events, vtimestamp, ... + vu.', 'done'); + end + %% Save the last step, if not already saved + if (mod (vcntloop-2,vodeoptions.OutputSave) ~= 0) + vretvaltime(vcntsave,:) = vtimestamp; + vretvalresult(vcntsave,:) = vu; + end + + + varargout{1} = vretvaltime; %% Time stamps are first output argument + varargout{2} = vretvalresult; %% Results are second output argument + + function yi = lin_interp (x, y, xi) + + %% Actually interp1 with 'linear' should behave equally in Octave + %% and Matlab, but having this subset of functionality here is being + %% on the safe side. + + n = size (x, 2); + m = size (y, 1); + %% This elegant lookup is from an older version of 'lookup' by Paul + %% Kienzle, and had been suggested by Kai Habel . + [v, p] = sort ([x, xi]); + idx(p) = cumsum (p <= n); + idx = idx(n + 1 : n + size (xi, 2)); + %% + idx(idx == n) = n - 1; + yi = y(:, idx) + ... + repmat (xi - x(idx), m, 1) .* ... + (y(:, idx + 1) - y(:, idx)) ./ ... + repmat (x(idx + 1) - x(idx), m, 1); + + function ret = apply_idx_if_given (ret, idx) + + if (nargin > 1) + ret = ret(idx); + end + + function fval = scalar_ifelse (cond, tval, fval) + + %% needed for some anonymous functions, builtin ifelse only available + %% in Octave > 3.2; we need only the scalar case here + + if (cond) + fval = tval; + end + +%!demo +%! p_t = optim_problems ().curve.p_1; +%! global verbose; +%! verbose = false; +%! [cy, cp, cvg, iter] = leasqr (p_t.data.x, p_t.data.y, p_t.init_p, p_t.f) +%! disp (p_t.result.p) +%! sumsq (cy - p_t.data.y) diff --git a/octave_packages/optim-1.2.0/optimset_compat.m b/octave_packages/optim-1.2.0/optimset_compat.m new file mode 100644 index 0000000..a6d650d --- /dev/null +++ b/octave_packages/optim-1.2.0/optimset_compat.m @@ -0,0 +1,76 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## opt = optimset_compat (...) - manipulate m*tlab-style options structure +## +## This function returns a m*tlab-style options structure that can be used +## with the fminunc() function. 'optimset_compat' has been deprecated in +## favor of 'optimset', which is now part of core Octave. This function +## will possibly be removed from future versions of the 'optim' package. +## +## INPUT : Input consist in one or more structs followed by option-value +## pairs. The option that can be passed are those of m*tlab's 'optimset'. +## Whether fminunc() accepts them is another question (see fminunc()). +## +## Two extra options are supported which indicate how to use directly octave +## optimization tools (such as minimize() and other backends): +## +## "MinEquiv", [on|off] : Tell 'fminunc()' not to minimize 'fun', but +## instead return the option passed to minimize(). +## +## "Backend", [on|off] : Tell 'fminunc()' not to minimize 'fun', but +## instead return the [backend, opt], the name of the +## backend optimization function that is used and the +## optional arguments that will be passed to it. See +## the 'backend' option of minimize(). + +function opt = optimset_compat (varargin) + +## Diagnostics , ["on"|{"off"}] : +## DiffMaxChange, [scalar>0] : N/A (I don't know what it does) +## DiffMinChange, [scalar>0] : N/A (I don't know what it does) +## Display , ["off","iter","notify","final"] +## : N/A + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "`optimset_compat' has been deprecated, and will be removed in the future. Use `optimset' from Octave core instead."); + endif + +args = varargin; + +opt = struct (); + + # Integrate all leading structs + +while length (args) && isstruct (o = args{1}) + + args = args(2:length(args)); # Remove 1st element of args + # Add key/value pairs + for [v,k] = o, opt = setfield (opt,k,v); end +end + +## All the option +op1 = [" DerivativeCheck Diagnostics DiffMaxChange DiffMinChange",\ + " Display GoalsExactAchieve GradConstr GradObj Hessian HessMult",\ + " HessPattern HessUpdate Jacobian JacobMult JacobPattern",\ + " LargeScale LevenbergMarquardt LineSearchType MaxFunEvals MaxIter",\ + " MaxPCGIter MeritFunction MinAbsMax PrecondBandWidth TolCon",\ + " TolFun TolPCG TolX TypicalX ",\ + " MinEquiv Backend "]; + +opt = read_options (args, "op1",op1, "default",opt,"prefix",1,"nocase",1); diff --git a/octave_packages/optim-1.2.0/packinfo/.autoload b/octave_packages/optim-1.2.0/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/optim-1.2.0/packinfo/DESCRIPTION b/octave_packages/optim-1.2.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..d30df29 --- /dev/null +++ b/octave_packages/optim-1.2.0/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: Optim +Version: 1.2.0 +Date: 2012-06-12 +Author: various authors +Maintainer: Octave-Forge community +Title: Optimization. +Description: Non-linear optimization toolkit. +Depends: octave (>= 2.9.7), miscellaneous (>= 1.0.10), struct (>= 1.0.10) +Autoload: yes +License: GFDL, GPLv3+, modified BSD, public domain +Url: http://octave.sf.net diff --git a/octave_packages/optim-1.2.0/packinfo/INDEX b/octave_packages/optim-1.2.0/packinfo/INDEX new file mode 100644 index 0000000..5169856 --- /dev/null +++ b/octave_packages/optim-1.2.0/packinfo/INDEX @@ -0,0 +1,48 @@ +optimization >> Optimization +Minimization + minimize + nelder_mead_min + d2_min + nrm + fmin + line_min + powell + fmins adsmax mdsmax nmsmax + bfgsmin samin battery + fminsearch + cg_min + de_min + nonlin_min +Data fitting + expfit + wpolyfit + leasqr + nonlin_residmin + nonlin_curvefit + LinearRegression +Optimization statistics + residmin_stat + curvefit_stat +Zero finding + vfzero +Compatibility + fminunc_compat + optimset_compat + quadprog= try Yinyu Ye's code + linprog +Numerical derivatives + dfdp dcdp dfpdp dfxpdp cdiff deriv + numgradient numhessian jacobs cauchy +Pivoting + cpiv_bard + gjp +Tests + test_min_1 test_min_2 test_min_3 test_min_4 + test_d2_min_1 test_d2_min_2 test_d2_min_3 + test_nelder_mead_min_1 test_nelder_mead_min_2 + poly_2_ex test_minimize_1 + optim_problems +Examples + bfgsmin_example + rosenbrock + samin_example diff --git a/octave_packages/optim-1.2.0/packinfo/NEWS b/octave_packages/optim-1.2.0/packinfo/NEWS new file mode 100644 index 0000000..eb9435e --- /dev/null +++ b/octave_packages/optim-1.2.0/packinfo/NEWS @@ -0,0 +1,71 @@ +Summary of important user-visible changes for optim 1.2.0: +------------------------------------------------------------------- + + ** Together with the new backend "lm_feasible" there is now a + complete suite of backends for optimization with linear and + general equality and inequality constraints, for scalar valued + objective functions and for array valued model function, which + features, a.o., honouring of constraints throughout optimization + and handling of structure-based parameters. The respective user + functions (frontends) are + + nonlin_min nonlin_residmin nonlin_curvefit + + together with a user function for statistics + + residmin_stat + + ** The requirement of nonlin_min, nonlin_residmin, and + nonlin_curvefit for the general constraint functions being able to + honour an index of constraints has been removed, the respective + feature is still available by setting some options. + + ** Makefile fixed to work with non-standard linker options e.g on + Apple. + + +Summary of important user-visible changes for optim 1.1.0: +------------------------------------------------------------------- + + ** The following functions are new optim 1.1.0: + + powell cauchy nonlin_min + + ** The following functions have been deprecated since they have been + implemented in Octave core: + + fminunc_compat optimset_compat + + ** The function `fmin' has been deprecated in favour of using `fminbnd' + directly. If one really wishes to use the short version, one can + easily create an alias on an octaverc file (see `doc startup') with + the following code + + function out=fmin(varargin) out=fminbnd(varargin{:}); endfunction + + ** The package Makefile has been adapted for compatibility with Octave 3.6.0. + + ** Bugfixes on the functions: + + deriv linprog + + ** The function `line_min' has a configurable setpesize and max evals. + + ** Added possibility to restrict a parameter to samin. + + ** Package is no longer automatically loaded. + + +Some important changes of the last versions of optim before 1.1.0: +------------------------------------------------------------------ + + ** New functions: + + jacobs: complex step derivative approximation + + nonlin_residmin, nonlin_curvefit: Frontends with a general + interface for constrained residual-based optimization. They + allow a.o. optimization of structure-based named parameters or + parameter-arrays. A backend is included, which is derived from + the algorithm of leasqr, but enables feasible-path optimization + with linear and general constraints. diff --git a/octave_packages/optim-1.2.0/poly_2_ex.m b/octave_packages/optim-1.2.0/poly_2_ex.m new file mode 100644 index 0000000..2d44f72 --- /dev/null +++ b/octave_packages/optim-1.2.0/poly_2_ex.m @@ -0,0 +1,51 @@ +## Copyright (C) 2002 Etienne Grossmann. All rights reserved. +## +## 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, or (at your option) any +## later version. +## +## This is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +## for more details. + +## ex = poly_2_ex (l, f) - Extremum of a 1-var deg-2 polynomial +## +## l : 3 : Values of variable at which polynomial is known. +## f : 3 : f(i) = Value of the degree-2 polynomial at l(i). +## +## ex : 1 : Value for which f reaches its extremum +## +## Assuming that f(i) = a*l(i)^2 + b*l(i) + c = P(l(i)) for some a, b, c, +## ex is the extremum of the polynome P. +## +function ex = poly_2_ex (l, f) + + +### This somewhat helps if solution is very close to one of the points. +[f,i] = sort (f); +l = l(i); + + +m = (l(2) - l(1))/(l(3) - l(1)); +d = (2*(f(1)*(m-1)+f(2)-f(3)*m)); +if abs (d) < eps, + printf ("poly_2_ex : divisor is small (solution at infinity)\n"); + printf ("%8.3e %8.3e %8.3e, %8.3e %8.3e\n",\ + f(1), diff (f), diff (sort (l))); + + ex = (2*(l(1)>l(2))-1)*inf; + ## keyboard +else + ex = ((l(3) - l(1))*((f(1)*(m^2-1) + f(2) - f(3)*m^2))) / d ; + +## Not an improvement +# n = ((l(2)+l(3))*(l(2)-l(3)) + 2*(l(3)-l(2))*l(1)) / (l(3)-l(1))^2 ; +# ex = ((l(3) - l(1))*((f(1)*n + f(2) - f(3)*m^2))) / \ +# (2*(f(1)*(m-1)+f(2)-f(3)*m)); +# if ex != ex0, +# ex - ex0 +# end + ex = l(1) + ex; +end \ No newline at end of file diff --git a/octave_packages/optim-1.2.0/polyconf.m b/octave_packages/optim-1.2.0/polyconf.m new file mode 100644 index 0000000..b93f643 --- /dev/null +++ b/octave_packages/optim-1.2.0/polyconf.m @@ -0,0 +1,140 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## [y,dy] = polyconf(p,x,s) +## +## Produce prediction intervals for the fitted y. The vector p +## and structure s are returned from polyfit or wpolyfit. The +## x values are where you want to compute the prediction interval. +## +## polyconf(...,['ci'|'pi']) +## +## Produce a confidence interval (range of likely values for the +## mean at x) or a prediction interval (range of likely values +## seen when measuring at x). The prediction interval tells +## you the width of the distribution at x. This should be the same +## regardless of the number of measurements you have for the value +## at x. The confidence interval tells you how well you know the +## mean at x. It should get smaller as you increase the number of +## measurements. Error bars in the physical sciences usually show +## a 1-alpha confidence value of erfc(1/sqrt(2)), representing +## one standandard deviation of uncertainty in the mean. +## +## polyconf(...,1-alpha) +## +## Control the width of the interval. If asking for the prediction +## interval 'pi', the default is .05 for the 95% prediction interval. +## If asking for the confidence interval 'ci', the default is +## erfc(1/sqrt(2)) for a one standard deviation confidence interval. +## +## Example: +## [p,s] = polyfit(x,y,1); +## xf = linspace(x(1),x(end),150); +## [yf,dyf] = polyconf(p,xf,s,'ci'); +## plot(xf,yf,'g-;fit;',xf,yf+dyf,'g.;;',xf,yf-dyf,'g.;;',x,y,'xr;data;'); +## plot(x,y-polyval(p,x),';residuals;',xf,dyf,'g-;;',xf,-dyf,'g-;;'); + +function [y,dy] = polyconf(p,x,varargin) + alpha = s = []; + typestr = 'pi'; + for i=1:length(varargin) + v = varargin{i}; + if isstruct(v), s = v; + elseif ischar(v), typestr = v; + elseif isscalar(v), alpha = v; + else s = []; + end + end + if (nargout>1 && (isempty(s)||nargin<3)) || nargin < 2 + print_usage; + end + + if isempty(s) + y = polyval(p,x); + + else + ## For a polynomial fit, x is the set of powers ( x^n ; ... ; 1 ). + n=length(p)-1; + k=length(x(:)); + if columns(s.R) == n, ## fit through origin + A = (x(:) * ones (1, n)) .^ (ones (k, 1) * (n:-1:1)); + p = p(1:n); + else + A = (x(:) * ones (1, n+1)) .^ (ones (k, 1) * (n:-1:0)); + endif + y = dy = x; + [y(:),dy(:)] = confidence(A,p,s,alpha,typestr); + + end +end + +%!test +%! # data from Hocking, RR, "Methods and Applications of Linear Models" +%! temperature=[40;40;40;45;45;45;50;50;50;55;55;55;60;60;60;65;65;65]; +%! strength=[66.3;64.84;64.36;69.70;66.26;72.06;73.23;71.4;68.85;75.78;72.57;76.64;78.87;77.37;75.94;78.82;77.13;77.09]; +%! [p,s] = polyfit(temperature,strength,1); +%! [y,dy] = polyconf(p,40,s,0.05,'ci'); +%! assert([y,dy],[66.15396825396826,1.71702862681486],200*eps); +%! [y,dy] = polyconf(p,40,s,0.05,'pi'); +%! assert(dy,4.45345484470743,200*eps); + +## [y,dy] = confidence(A,p,s) +## +## Produce prediction intervals for the fitted y. The vector p +## and structure s are returned from wsolve. The matrix A is +## the set of observation values at which to evaluate the +## confidence interval. +## +## confidence(...,['ci'|'pi']) +## +## Produce a confidence interval (range of likely values for the +## mean at x) or a prediction interval (range of likely values +## seen when measuring at x). The prediction interval tells +## you the width of the distribution at x. This should be the same +## regardless of the number of measurements you have for the value +## at x. The confidence interval tells you how well you know the +## mean at x. It should get smaller as you increase the number of +## measurements. Error bars in the physical sciences usually show +## a 1-alpha confidence value of erfc(1/sqrt(2)), representing +## one standandard deviation of uncertainty in the mean. +## +## confidence(...,1-alpha) +## +## Control the width of the interval. If asking for the prediction +## interval 'pi', the default is .05 for the 95% prediction interval. +## If asking for the confidence interval 'ci', the default is +## erfc(1/sqrt(2)) for a one standard deviation confidence interval. +## +## Confidence intervals for linear system are given by: +## x' p +/- sqrt( Finv(1-a,1,df) var(x' p) ) +## where for confidence intervals, +## var(x' p) = sigma^2 (x' inv(A'A) x) +## and for prediction intervals, +## var(x' p) = sigma^2 (1 + x' inv(A'A) x) +## +## Rather than A'A we have R from the QR decomposition of A, but +## R'R equals A'A. Note that R is not upper triangular since we +## have already multiplied it by the permutation matrix, but it +## is invertible. Rather than forming the product R'R which is +## ill-conditioned, we can rewrite x' inv(A'A) x as the equivalent +## x' inv(R) inv(R') x = t t', for t = x' inv(R) +## Since x is a vector, t t' is the inner product sumsq(t). +## Note that LAPACK allows us to do this simultaneously for many +## different x using sqrt(sumsq(X/R,2)), with each x on a different row. +## +## Note: sqrt(F(1-a;1,df)) = T(1-a/2;df) +## +## For non-linear systems, use x = dy/dp and ignore the y output. +function [y,dy] = confidence(A,p,S,alpha,typestr) + if nargin < 4, alpha = []; end + if nargin < 5, typestr = 'ci'; end + y = A*p(:); + switch typestr, + case 'ci', pred = 0; default_alpha=erfc(1/sqrt(2)); + case 'pi', pred = 1; default_alpha=0.05; + otherwise, error("use 'ci' or 'pi' for interval type"); + end + if isempty(alpha), alpha = default_alpha; end + s = tinv(1-alpha/2,S.df)*S.normr/sqrt(S.df); + dy = s*sqrt(pred+sumsq(A/S.R,2)); +end diff --git a/octave_packages/optim-1.2.0/polyfitinf.m b/octave_packages/optim-1.2.0/polyfitinf.m new file mode 100644 index 0000000..1c7aca5 --- /dev/null +++ b/octave_packages/optim-1.2.0/polyfitinf.m @@ -0,0 +1,870 @@ +## Copyright (c) 1998-2011 Andrew V. Knyazev +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without", +## modification, are permitted provided that the following conditions are met: +## +## 1 Redistributions of source code must retain the above copyright notice, +## this list of conditions and the following disclaimer. +## 2 Redistributions in binary form must reproduce the above copyright +## notice, this list of conditions and the following disclaimer in the +## documentation and/or other materials provided with the distribution. +## 3 Neither the name of the author nor the names of its contributors may be +## used to endorse or promote products derived from this software without +## specific prior written permission. +## +## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' +## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR +## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +% function [A,REF,HMAX,H,R,EQUAL] = polyfitinf(M,N,K,X,Y,EPSH,MAXIT,REF0) +% +% Best polynomial approximation in discrete uniform norm +% +% INPUT VARIABLES: +% +% M : degree of the fitting polynomial +% N : number of data points +% X(N) : x-coordinates of data points +% Y(N) : y-coordinates of data points +% K : character of the polynomial: +% K = 0 : mixed parity polynomial +% K = 1 : odd polynomial ( X(1) must be > 0 ) +% K = 2 : even polynomial ( X(1) must be >= 0 ) +% EPSH : tolerance for leveling. A useful value for 24-bit +% mantissa is EPSH = 2.0E-7 +% MAXIT : upper limit for number of exchange steps +% REF0(M2): initial alternating set ( N-vector ). This is an +% OPTIONAL argument. The length M2 is given by: +% M2 = M + 2 , if K = 0 +% M2 = integer part of (M+3)/2 , if K = 1 +% M2 = 2 + M/2 (M must be even) , if K = 2 +% +% OUTPUT VARIABLES: +% +% A : polynomial coefficients of the best approximation +% in order of increasing powers: +% p*(x) = A(1) + A(2)*x + A(3)*x^2 + ... +% REF : selected alternating set of points +% HMAX : maximum deviation ( uniform norm of p* - f ) +% H : pointwise approximation errors +% R : total number of iterations +% EQUAL : success of failure of algorithm +% EQUAL=1 : succesful +% EQUAL=0 : convergence not acheived +% EQUAL=-1: input error +% EQUAL=-2: algorithm failure +% +% Relies on function EXCH, provided below. +% +% Example: +% M = 5; N = 10000; K = 0; EPSH = 10^-12; MAXIT = 10; +% X = linspace(-1,1,N); % uniformly spaced nodes on [-1,1] +% k=1; Y = abs(X).^k; % the function Y to approximate +% [A,REF,HMAX,H,R,EQUAL] = polyfitinf(M,N,K,X,Y,EPSH,MAXIT); +% p = polyval(A,X); plot(X,Y,X,p) % p is the best approximation +% +% Note: using an even value of M, e.g., M=2, in the example above, makes +% the algorithm to fail with EQUAL=-2, because of collocation, which +% appears because both the appriximating function and the polynomial are +% even functions. The way aroung it is to approximate only the right half +% of the function, setting K = 2 : even polynomial. For example: +% +% N = 10000; K = 2; EPSH = 10^-12; MAXIT = 10; X = linspace(0,1,N); +% for i = 1:2 +% k = 2*i-1; Y = abs(X).^k; +% for j = 1:4 +% M = 2^j; +% [~,~,HMAX] = polyfitinf(M,N,K,X,Y,EPSH,MAXIT); +% approxerror(i,j) = HMAX; +% end +% end +% disp('Table 3.1 from Approximation theory and methods, M.J.D.POWELL, p. 27'); +% disp(' '); +% disp(' n K=1 K=3'); +% disp(' '); format short g; +% disp([(2.^(1:4))' approxerror']); +% +% ALGORITHM: +% +% Computation of the polynomial that best approximates the data (X,Y) +% in the discrete uniform norm, i.e. the polynomial with the minimum +% value of max{ | p(x_i) - y_i | , x_i in X } . That polynomial, also +% known as minimax polynomial, is obtained by the exchange algorithm, +% a finite iterative process requiring, at most, +% n +% ( ) iterations ( usually p = M + 2. See also function EXCH ). +% p +% since this number can be very large , the routine may not converge +% within MAXIT iterations . The other possibility of failure occurs +% when there is insufficient floating point precision for the input +% data chosen. +% +% CREDITS: This routine was developed and modified as +% computer assignments in Approximation Theory courses by +% Prof. Andrew Knyazev, University of Colorado Denver, USA. +% +% Team Fall 98 (Revision 1.0): +% Chanchai Aniwathananon +% Crhistopher Mehl +% David A. Duran +% Saulo P. Oliveira +% +% Team Spring 11 (Revision 1.1): Manuchehr Aminian +% +% The algorithm and the comments are based on a FORTRAN code written +% by Joseph C. Simpson. The code is available on Netlib repository: +% http://www.netlib.org/toms/501 +% See also: Communications of the ACM, V14, pp.355-356(1971) +% +% NOTES: +% +% 1) A may contain the collocation polynomial +% 2) If MAXIT is exceeded, REF contains a new reference set +% 3) M, EPSH and REF can be altered during the execution +% 4) To keep consistency to the original code , EPSH can be +% negative. However, the use of REF0 is *NOT* determined by +% EPSH< 0, but only by its inclusion as an input parameter. +% +% Some parts of the code can still take advantage of vectorization. +% +% Revision 1.0 from 1998 is a direct human translation of +% the FORTRAN code http://www.netlib.org/toms/501 +% Revision 1.1 is a clean-up and technical update. +% Tested on MATLAB Version 7.11.0.584 (R2010b) and +% GNU Octave Version 3.2.4 + +% $Revision: 1.1 $ $Date: 2011/08/3 $ + +% ************************************ beginning of POLYFITINF +function [A,REF,HMAX,H,R,EQUAL] = polyfitinf(M,N,K,X,Y,EPSH,MAXIT,REF0) + + % Preassign output variables A,REF,HMAX,H,R,EQUAL in case of error return + A = []; REF = []; HMAX = []; H = []; R = 0; EQUAL = -2; + %%%% end preassignment + + % Setting M with respect to K + MOLD = M; + + switch K + case 1 + K0 = 0; + K1 = 1; + Q1 = 1; + Q2 = 2; + M = (M-Q1)/2; + case 2 + K0 = 0; + K1 = 0; + Q1 = 0; + Q2 = 2; + + % If the user has input odd M, but wants an even polynomial, + % subtract 1 from M to prevent errors later. The outputs should be + % mathematically equivalent. + if mod(M,2) == 1 + M = M-1; + end + + M = (M-Q1)/2; + otherwise + if (K ~= 0) + warning('polyfitinf:MixedParity','Using mixed parity polynomial...'); + end + K0 = 1; + K1 = 0; + Q1 = 0; + Q2 = 1; + end + + P = M + 2; + + % Check input data consistency + + if ( (length(X) ~= N) || (length(Y) ~= N) ) + error('Input Error: check data lengths'); + end + + if (P > N) + error('Input Error: insufficient data points'); + end + + if (M < 0) + error('Input Error: insufficient degree'); + end + + if ( (K == 2) && (X(1) < 0) ) || ( (K == 1) && (X(1) <= 0) ) + error('Input Error: X(1) inconsistent with parity'); + end + + if any(diff(X)<0) + error('Input Error: Abscissae out of order'); + end + + ITEMP = MOLD + 1; + + A = zeros(1,ITEMP); + + + ITEMP = P + 2; + Z = zeros(1,ITEMP); + Z(1) = 0; + Z(ITEMP) = N + 1; + + EPSH = abs(EPSH); + + % Read initial reference set into Z, if available. + + if (nargin == 8) + J = 0; + + Z(2:(P+1))= REF0(1:P); + + % Check if REF is monotonically increasing + if ( any(diff(REF0) < 0) || any(REF0 > J) ) + error('Input Error : Bad initial reference set'); + end + + else + + % Loads Z with the points closest to the Chebychev abscissas + + X1 = X(1); + XE = X(N); + + % Setting parity-dependent parameters + + if (K0 == 1) + XA = XE + X1; + XE = XE - X1; + Q = pi/(M + 1.0); + else + XA = 0.; + XE = XE + XE; + ITEMP = 2*(M+1) + Q1; + Q = pi/(ITEMP); + end + + % Calculate the J-th Chebyshev abcissa and load Z(J+1) + % with the appropriate index from the data abcissas + + for JJ = 1:P + J = P + 1 - JJ; + X1 = XA + XE*( cos(Q*(P-J)) ); + ITEMP = J + 2; + R = Z(ITEMP); + HIGH = R - 1; + FLAG = 1; + if (HIGH >= 2) + II = 2; + while ( (II <= HIGH) && (FLAG == 1) ) + I = HIGH + 2 - II; + ITEMP = I - 1; + + % If the Chebyschev abscissa is bracketed by + % two input abcissas, get out of the while loop + + if (X(I)+X(ITEMP) <= X1) + FLAG = 0; + end + II = II + 1; + end + end + + if (FLAG == 1) + I = 1; + end + ITEMP = J + 1; + + if (I < R) + Z(ITEMP) = I; + else + Z(ITEMP) = R - 1; + end + end + + % If the lower Chebyshev abcissas are less than X(1), + % load the lower elements of Z with the lowest points + + IND = find(Z(2:end) >= (1:(length(Z)-1))); + + try TEMP = IND(1); % If IND is empty, do nothing. + catch exception % The catch will be that IND is an empty array. + + if strcmpi(exception.identifier,'MATLAB:badsubscript') + % This will be the exception. Do nothing. + end + end + + if TEMP~=1 + Z(2:TEMP) = (1:(TEMP-1))'; + end + + + end + + % M1 entry. Initialize variables to prepare for exchange iteration + + ITEMP = M + 1; + + + % Zero the AA array + + + AA = zeros(1,ITEMP); + + + % Load H with the ordinates and XX(I) with the abscissas if the + % polynomial is mixed . If it is even or odd , load XX with the + % squares of the abscissas. + + H(1:N) = Y(1:N); + if (K0 <=0) + XX(1:N) = X(1:N).^2; + else + XX(1:N) = X(1:N); + end + + B1 = 0; + B2 = 0; + B3 = 0; + R = -1; + T = 0.; + + % Iteration entry. R is the iteration index + + C = zeros(1,P); + D = zeros(1,P); + DAA = zeros(1,M+1); + + FLAG = 1; + while ( (R < MAXIT) && (FLAG == 1) ) + + R = R + 1; % LABEL 350 + %S = 1.; + + % Computation of div. differences schemes + + if (K1 > 0) + + % If the polynomial is mixed or even: + %for I = 1:P + % S = -S; + % ITEMP = I + 1; + % J = Z(ITEMP); + % Q = X(J); + % C(I) = (H(J) + S*T)/Q; + % D(I) = S/Q; + %end + + I = (1:P); + S = (-1).^I; + ITEMP = I+1; + J = Z(ITEMP); + C(I) = (H(J) + S*T)./X(J); + D(I) = S./Q; + clear I ITEMP S J + + else + + % If the polynomial is odd: + %for I = 1:P + % S = -S; + % ITEMP = I + 1; + % ITEMP = Z(ITEMP); + % C(I) = H(ITEMP) + S*T; + % D(I) = S; + %end + + I = (1:P); + S = (-1).^I; + ITEMP = I+1; + C(I) = H( Z(ITEMP) ) + S.*T; + D(I) = S; + clear I ITEMP S + + end + + for I = 2:P + for JJ = I:P + J = P + I - JJ; + ITEMP = J + 1; + ITEMP = Z(ITEMP); + QD = XX(ITEMP); + ITEMP = 2 + J - I; + ITEMP = Z(ITEMP); + QD = QD - XX(ITEMP); + ITEMP = J - 1; + C(J) = (C(J)-C(ITEMP))/QD; + D(J) = (D(J)-D(ITEMP))/QD; + end + end + + DT = -C(P)/D(P); + T = T + DT; + + % Computation of polynomial coefficients + + HIGH = M + 1; + for II = 1:HIGH + I = HIGH - II; + ITEMP = I + 1; + DAA(ITEMP) = C(ITEMP) + DT*D(ITEMP); + ITEMP = I + 2; + ITEMP = Z(ITEMP); + QD = XX(ITEMP); + LOW = I + 1; + if (M >= LOW) + DAA(LOW:M) = DAA(LOW:M) - QD*DAA(((LOW:M)+1)); + end + end + + AA(1:HIGH) = AA(1:HIGH) + DAA(1:HIGH); + + % Evaluation of the polynomial to get the approximation errors + + MAXX = 0.; + H = zeros(1,N); + for I = 1:N + SD = AA(HIGH); + QD = XX(I); + if (M > 0) + for J = M:-1:1 + SD = SD*QD + AA(J); + end + end + if (K1 > 0) + % If the polynomial is odd, multiply SD by X(I) + SD = SD*X(I); + end + + QD = Y(I) - SD; + H(I) = Y(I) - SD; + + if (abs(QD) > MAXX) + % Load MAXX with the largest magnitude + % of the approximation array + MAXX = abs(QD); + end + end + + % Test for alternating signs + + ITEMP = Z(2); + + if (H(ITEMP) == 0.) + + % This represents a case where the polynomial + % exactly predicts a data point + + warning('polyfitinf:Collocation','Collocation has occured.'); + if (B3 > 0) + B3 = -1; + FLAG = 0; + else + B3 = 1; + if (EPSH < MAXX) + warning('polyfitinf:AnotherTry','1 more attempt with middle points'); + LOW = (N+1)/2 - (P+1)/2 + 1; + HIGH = LOW + P; + Z(LOW:HIGH) = ( (LOW:HIGH) -1); + + else + disp('Normal Exit.'); + FLAG = 0; + end + end + else + + if (H(ITEMP) > 0.) + J = -1; + else + J = 1; + end + + I = 2; + FLAG2 = 1; + while ( (I <= P) && (FLAG2 == 1) ) + ITEMP = I + 1; + ITEMP = Z(ITEMP); + if (H(ITEMP) == 0.) + J = 0; + warning('polyfitinf:Collocation','Collocation has occured.'); + if (B3 > 0) + B3 = -1; + FLAG = 0; + else + B3 = 1; + if (EPSH < MAXX) + warning('polyfitinf:AnotherTry','1 more attempt with middle points'); + LOW = (N+1)/2 - (P+1)/2 + 1; + HIGH = LOW + P; + Z(LOW:HIGH) = ( (LOW:HIGH) -1); + else + disp('Normal Exit.'); + FLAG = 0; + end + end + FLAG2 = 0; + else + if (H(ITEMP) < 0) + JJ = -1; + else + JJ = 1; + end + if (J~=JJ) + + % Error entry: bad accuracy for calculation + + B1 = 1; + FLAG2 = 0; + FLAG = 0; + else + J = -J; + end + end + + I = I + 1; + + end % end of while + + % Search for another reference + + if (FLAG2*FLAG == 1) + + [H,Z,EQUAL] = exch(N, P, EPSH, H, Z); + if (EQUAL > 0) + FLAG = 0; + else + if (R >= MAXIT) + B2 = 1; + FLAG = 0; + end + end + + end + + end % end of if over H(ITEMP) + + end; % end of iteration loop + + % M2 entry; load output variables and return + + HIGH = M + 1; + + % Load the coefficients into A array + + A(Q1 + Q2*(((1:HIGH)-1)) + 1) = AA(1:HIGH); + + % Load REF with the final reference points + + REF(1:P) = Z((1:P) + 1); + + HMAX = MAXX; + + if (B3 < 0) + EQUAL = -2; + warning('polyfitinf:Collocation','polyfitinf terminates'); + end + if (B1 > 0) + EQUAL = -2; + warning('polyfitinf:NoAlternatingSigns','Alternating signs not observed'); + end + if (B2 > 0) + EQUAL = 0; + warning('polyfitinf:MaxIterationsReached','MAXIT was reached, current ref. set saved in REF.'); + end + + % Reverse the order of A to make it compatible with MATLAB'S polyval() function. + A = A(end:-1:1); + + +endfunction +% ****************************************** end of POLYFITINF + +function [H,Z,EQUAL] = exch(N, P, EPSH, H, Z) +% function [H,Z,EQUAL] = exch(N, P, EPSH, H, Z) +% +% EXCH: exchange algorithm +% +% INPUT VARIABLES: +% N : number of data points +% P : number of reference points +% EPSH : tolerance for leveling. +% Z : old reference indices +% +% OUTPUT VARIABLES: +% H : pointwise approximation errors +% Z : new reference indices +% EQUAL : EQUAL=1 : normal exchange +% EQUAL=0 : old and new references are equal +% +% CREDITS: This routine was developed and modified as +% computer assignments in Approximation Theory courses by +% Prof. Andrew Knyazev, University of Colorado Denver, USA. +% +% Team Fall 98 (Revision 1.0): +% Chanchai Aniwathananon +% Crhistopher Mehl +% David A. Duran +% Saulo P. Oliveira +% +% Team Spring 11 (Revision 1.1): Manuchehr Aminian +% +% The algorithm and the comments are based on a FORTRAN code written +% by Joseph C. Simpson. The code is available on Netlib repository: +% http://www.netlib.org/toms/501 +% See also: Communications of the ACM, V14, pp.355-356(1971) +% +% Revision 1.0 from 1998 is a direct human translation of +% the FORTRAN code http://www.netlib.org/toms/501 +% Revision 1.1 is a clean-up and technical update. +% Tested on MATLAB Version 7.11.0.584 (R2010b) and +% GNU Octave Version 3.2.4 + +% License: BSD +% Copyright 1998-2011 Andrew V. Knyazev +% $Revision: 1.1 $ $Date: 2011/05/17 $ + +% ************************************ beginning of exch + + EQUAL = 0; + L = 0; + ITEMP = Z(2); + + % SIG is arbitrarily chosen equal to the sign of the input + % point. This will be adjusted later if necessary. + + if (H(ITEMP) <= 0) + SIG = 1.; + else + SIG = -1.; + end + + % The next loop prescans Z to insure it is a proper choice, i.e + % resets Z if necessary so that maximum error points are chosen, + % given the sign convention mentioned above. In order to work + % properly, this section requires Z(1) = 0 and Z(P+2) = N + 1 . + + for I = 1:P + MAXX = 0.; + SIG = -SIG; + ITEMP = I + 2; + ZE = Z(ITEMP) - 1; + LOW = Z(I) + 1; + + % Scan the open point interval containing only the 1th initial + % reference point. In the interval pick the point with largest + % magnitude and correct sign. Most of the sorting occurs in + % this section. SIG contains the sign assumed for H(I). + + for J = LOW:ZE + if (SIG*(H(J)-MAXX) > 0) + MAXX = H(J); + INDEX = J; + end + end + ITEMP = I + 1; + ITEMP = Z(ITEMP); + MAXL = abs(MAXX); + + % If the MAX error is significantly greater than the + % input point, switch to this point. + + if (abs( MAXX - H(ITEMP) )/MAXL > EPSH) + ITEMP = I + 1; + Z(ITEMP) = INDEX; + L = 1; + end + end + % + MAXL = 0.; + MAXR = 0.; + ITEMP = P + 1; + LOW = Z(ITEMP) + 1; + % + if (LOW <= N) + + % Find the error with largest abs value and proper sign + % from among the points above the last reference point. + % This section is necessary because the set of points + % chosen may begin with the wrong sign alternation. + + for J = LOW:N + if (SIG*(MAXR-H(J)) > 0) + MAXR = H(J); + INDR = J; + end + end + end + + % Find the error with largest abs value and proper sign + % from among the points below the 1st reference point. + % This section is necessary by the same reason as above. + + ITEMP = Z(2); + HZ1 = H(ITEMP); + HIGH = ITEMP -1; + if (HIGH > 0) + if (HZ1 < 0) + SIG = -1.; + elseif (HZ1 == 0) + SIG = 0.; + else + SIG = 1.; + end + + for J = 1:HIGH + if (SIG*(MAXL-H(J)) > 0) + MAXL = H(J); + INDL = J; + end + end + + end + + % MAXL and MAXR contain the magnitude of the significant + % errors outside the reference point set. If either is + % zero, the reference point set extends to the end point + % on that side of the interval. + + MAXL = abs(MAXL); + MAXR = abs(MAXR); + HZ1 = abs(HZ1); + ITEMP = P + 1; + ITEMP = Z(ITEMP); + HZP = abs(H(ITEMP)); + + % L = 0 implies that the previous prescan did not change + % any points. If L = 0 and MAXL, MAXR are not significant + % if compared with upper and lower reference point errors, + % respectively, use the EQUAL exit. + + FLAG1 = 1; + if (L == 0) + if ( (MAXL == 0) || (EPSH >= (MAXL-HZP)/MAXL) ) + if ( (MAXR == 0) || (EPSH >= (MAXR-HZ1)/MAXR) ) + FLAG1 = 0; + EQUAL = 1; + end + end + end + + if ( (MAXL == 0) && (MAXR == 0) ) + FLAG1 = 0; + end + + if ( (MAXL > MAXR) && (MAXL <= HZP) && (MAXR < HZ1) ) + FLAG1 = 0; + end + + if ( (MAXL <= MAXR) && (MAXR <= HZ1) && (MAXL < HZP) ) + FLAG1 = 0; + end + + % If a point outside the present reference set must be + % included, (i.e. the sign of the 1st point previously + % assumed is wrong) shift to the side of largest + % relative error first. + + if (FLAG1 == 1) + + FLAG2 = 1; + + if ( (MAXL > MAXR) && (MAXL > HZP) ) + FLAG2 = 0; + end + + if ( (MAXL <= MAXR) && (MAXR <= HZ1) ) + FLAG2 = 0; + end + + if (FLAG2 == 1) + + % SHR entry. This section inserts a point from + % above the prescan point set + + INDEX = Z(2); + + % shift point set down, dropping the lowest point + + Z(2:P) = Z((2:P)+1); + + ITEMP = P + 1; + + % add the next high point + Z(ITEMP)=INDR; + + % if MAXL > 0 replace reference points from the left, + % stopping the 1st time the candidate for replacement + % is greater than in magnitude than the prospective + % replacee. Alternation of signs is preserved because + % non-replacement immediately terminates the process. + + if (MAXL > 0) + I = 2; + FLAG3 = 1; + while ( (I <= P) && (FLAG3 == 1) ) + ITEMP = Z(I); + if ( abs(H(INDL)) >= abs(H(ITEMP)) ) + J = Z(I); + Z(I) = INDL; + INDL = INDEX; + INDEX = J; + else + FLAG3 = 0; + end + I = I + 1; + end + end + + else + + % SHL entry. This section inserts a point from below the + % prescan point set. + + ITEMP = P + 1 ; + INDEX = Z(ITEMP); + + Z((2:P)+1) = Z(2:P); + + % store lowest point in Z(2) + Z(2) = INDL; + + % if MAXR > 0 replace reference points from the right, + % stopping the 1st time the candidate for replacement + % is greater than in magnitude than the prospective + % replacee. + + if (MAXR > 0) + II = 2; + FLAG3 = 1; + while ( (II <= P) && (FLAG3 == 1) ) + I = P + 2 - II; + ITEMP = I + 1; + HIGH = Z(ITEMP); + if ( abs(H(INDR)) >= abs(H(HIGH)) ) + J = Z(ITEMP); + Z(ITEMP) = INDR; + INDR = INDEX; + INDEX = J; + else + FLAG3 = 0; + end + II = II + 1; + end + end + + end + + end + +endfunction +% ****************************************** end of exch diff --git a/octave_packages/optim-1.2.0/powell.m b/octave_packages/optim-1.2.0/powell.m new file mode 100644 index 0000000..8f1175a --- /dev/null +++ b/octave_packages/optim-1.2.0/powell.m @@ -0,0 +1,193 @@ +## Copyright (C) 2011 Nir Krakauer +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} [@var{p}, @var{obj_value}, @var{convergence}, @var{iters}, @var{nevs}] = powell (@var{f}, @var{p0}, @var{control}) +## Multidimensional minimization (direction-set method). Implements a direction-set (Powell's) method for multidimensional minimization of a function without calculation of the gradient [1, 2] +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{f}: name of function to minimize (string or handle), which should accept one input variable (see example for how to pass on additional input arguments) +## +## @item +## @var{p0}: An initial value of the function argument to minimize +## +## @item +## @var{options}: an optional structure, which can be generated by optimset, with some or all of the following fields: +## @itemize @minus +## @item +## MaxIter: maximum iterations (positive integer, or -1 or Inf for unlimited (default)) +## @item +## TolFun: minimum amount by which function value must decrease in each iteration to continue (default is 1E-8) +## @item +## MaxFunEvals: maximum function evaluations (positive integer, or -1 or Inf for unlimited (default)) +## @item +## SearchDirections: an n*n matrix whose columns contain the initial set of (presumably orthogonal) directions to minimize along, where n is the number of elements in the argument to be minimized for; or an n*1 vector of magnitudes for the initial directions (defaults to the set of unit direction vectors) +## @end itemize +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## y = @@(x, s) x(1) ^ 2 + x(2) ^ 2 + s; +## o = optimset('MaxIter', 100, 'TolFun', 1E-10); +## s = 1; +## [x_optim, y_min, conv, iters, nevs] = powell(@@(x) y(x, s), [1 0.5], o); %pass y wrapped in an anonymous function so that all other arguments to y, which are held constant, are set +## %should return something like x_optim = [4E-14 3E-14], y_min = 1, conv = 1, iters = 2, nevs = 24 +## @end group +## +## @end example +## +## @subheading Returns: +## +## @itemize @bullet +## @item +## @var{p}: the minimizing value of the function argument +## @item +## @var{obj_value}: the value of @var{f}() at @var{p} +## @item +## @var{convergence}: 1 if normal convergence, 0 if not +## @item +## @var{iters}: number of iterations performed +## @item +## @var{nevs}: number of function evaluations +## @end itemize +## +## @subheading References +## +## @enumerate +## @item +## Powell MJD (1964), An efficient method for finding the minimum of a function of several variables without calculating derivatives, @cite{Computer Journal}, 7 :155-162 +## +## @item +## Press, WH; Teukolsky, SA; Vetterling, WT; Flannery, BP (1992). @cite{Numerical Recipes in Fortran: The Art of Scientific Computing} (2nd Ed.). New York: Cambridge University Press (Section 10.5) +## @end enumerate +## @end deftypefn + +## PKG_ADD: __all_opts__ ("powell"); + +function [p, obj_value, convergence, iters, nevs] = powell (f, p0, options); + + if (nargin == 1 && ischar (f) && strcmp (f, "defaults")) + p = optimset ("MaxIter", Inf, \ + "TolFun", 1e-8, \ + "MaxFunEvals", Inf, \ + "SearchDirections", []); + return; + endif + + ## check number of arguments + if ((nargin < 2) || (nargin > 3)) + usage('powell: you must supply 2 or 3 arguments'); + endif + + + ## default or input values + + if (nargin < 3) + options = struct (); + endif + + xi_set = 0; + xi = optimget (options, 'SearchDirections'); + if (! isempty (xi)) + if (isvector (xi)) # assume that xi is is n*1 or 1*n + xi = diag (x); + endif + xi_set = 1; + endif + + + MaxIter = optimget (options, 'MaxIter', Inf); + if (MaxIter < 0) MaxIter = Inf; endif + MaxFunEvals = optimget (options, 'MaxFunEvals', Inf); + TolFun = optimget (options, 'TolFun', 1E-8); + + nevs = 0; + iters = 0; + convergence = 0; + + p = p0; # initial value of the argument being minimized + + try + obj_value = f(p); + catch + error ("function does not exist or cannot be evaluated"); + end_try_catch + + nevs++; + + n = numel (p); # number of dimensions to minimize over + + xit = zeros (n, 1); + if (! xi_set) + xi = eye(n); + endif + + + + ## do an iteration + while (iters <= MaxIter && nevs <= MaxFunEvals && ! convergence) + iters++; + pt = p; # best point as iteration begins + fp = obj_value; # value of the objective function as iteration begins + ibig = 0; # will hold direction along which the objective function decreased the most in this iteration + dlt = 0; # will hold decrease in objective function value in this iteration + for i = 1:n + xit = reshape (xi(:, i), size(p)); + fptt = obj_value; + [a, obj_value, nev] = line_min (f, xit, {p}); + nevs = nevs + nev; + p = p + a*xit; + change = fptt - obj_value; + if (change > dlt) + dlt = change; + ibig = i; + endif + endfor + + if ( 2*abs(fp-obj_value) <= TolFun*(abs(fp) + abs(obj_value)) ) + convergence = 1; + return + endif + + if (iters == MaxIter) + disp ("iteration maximum exceeded"); + return + endif + + ## attempt parabolic extrapolation + ptt = 2*p - pt; + xit = p - pt; + fptt = f(ptt); + nevs++; + if (fptt < fp) # check whether the extrapolation actually makes the objective function smaller + t = 2 * (fp - 2*obj_value + fptt) * (fp-obj_value-dlt)^2 - dlt * (fp-fptt)^2; + if (t < 0) + p = ptt; + [a, obj_value, nev] = line_min (f, xit, {p}); + nevs = nevs + nev; + p = p + a*xit; + + ## add the net direction from this iteration to the direction set + xi(:, ibig) = xi(:, n); + xi(:, n) = xit(:); + endif + endif + endwhile + diff --git a/octave_packages/optim-1.2.0/private/__collect_constraints__.m b/octave_packages/optim-1.2.0/private/__collect_constraints__.m new file mode 100644 index 0000000..9216959 --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__collect_constraints__.m @@ -0,0 +1,93 @@ +## Copyright (C) 2010, 2011 Olaf Till +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +function [mc, vc, f_gencstr, df_gencstr, user_df] = \ + __collect_constraints__ (cstr, do_cstep, context) + + mc = vc = f_gencstr = df_gencstr = []; + user_df = false; + + if (isempty (cstr)) return; endif + + if (ismatrix (tp = cstr{1}) || isstruct (tp)) + mc = tp; + vc = cstr{2}; + if ((tp = length (cstr)) > 2) + f_genstr = cstr{3}; + if (tp > 3) + df_gencstr = cstr{4}; + user_df = true; + endif + endif + else + lid = 0; # no linear constraints + f_gencstr = cstr{1}; + if ((len = length (cstr)) > 1) + if (ismatrix (c = cstr{2}) || isstruct (c)) + lid = 2; + else + df_gencstr = c; + user_df = true; + if (len > 2) + lid = 3; + endif + endif + endif + if (lid) + mc = cstr{lid}; + vc = cstr{lid + 1}; + endif + endif + + if (! isempty (f_gencstr)) + if (ischar (f_gencstr)) + f_gencstr = str2func (f_gencstr); + endif + f_gencstr = @ (varargin) \ + tf_gencstr (f_gencstr, varargin{:}); + + if (user_df) + if (do_cstep) + error ("both complex step derivative chosen and user Jacobian function specified for %s", context); + endif + if (ischar (df_gencstr)) + df_gencstr = str2func (df_gencstr); + endif + df_gencstr = @ (p, func, idx, hook) \ + df_gencstr (p, idx, hook); + else + if (do_cstep) + df_gencstr = @ (p, func, idx, hook) jacobs (p, func, hook); + else + __dfdp__ = @ __dfdp__; # for bug #31484 (Octave <= 3.2.4) + df_gencstr = @ (p, func, idx, hook) __dfdp__ (p, func, hook); + endif + endif + endif + +endfunction + +function ret = tf_gencstr (f, varargin) # varargin: p[, idx[, info]] + + ## necessary since user function f_gencstr might return [] or a row + ## vector + + if (isempty (ret = f (varargin{:}))) + ret = zeros (0, 1); + elseif (columns (ret) > 1) + ret = ret(:); + endif + +endfunction diff --git a/octave_packages/optim-1.2.0/private/__covd_wls__.m b/octave_packages/optim-1.2.0/private/__covd_wls__.m new file mode 100644 index 0000000..019b63e --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__covd_wls__.m @@ -0,0 +1,32 @@ +## Copyright (C) 2011 Olaf Till +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +function hook = __covd_wls__ (hook) + + m = hook.nm; + n = hook.np; + + if (m <= n) + error ("guessing covariance-matrix of residuals for weighted least squares requires at least one more residual than free parameters"); + endif + + w = hook.weights(:); + res = hook.residuals(:); + + w2 = w .^ 2; + + hook.covd = diag (res.' * diag (w2) * res / (m - n) ./ w2); + +endfunction diff --git a/octave_packages/optim-1.2.0/private/__covp_corp_wls__.m b/octave_packages/optim-1.2.0/private/__covp_corp_wls__.m new file mode 100644 index 0000000..dd4591a --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__covp_corp_wls__.m @@ -0,0 +1,105 @@ +## Copyright (C) 2011 Olaf Till +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## This is based on Bard, Nonlinear Parameter Estimation, Academic +## Press, 1974, section 7-5, but also on own re-calculations for the +## specific case of weighted least squares. The part with only certain +## elements of covp or corp being defined is self-made, I don't know a +## reference. + +function hook = __covp_corp_wls__ (hook) + + ## compute jacobian, if not already done + if (! isfield (hook, "jac")) + hook.jac = hook.dfdp (hook.pfin, hook); + endif + jact = (jac = hook.jac).'; + + ## compute guessed covariance matrix of data, if not already done + if (! isfield (hook, "covd")) + hook = hook.funs.covd (hook); + endif + covd_inv = inv (covd = hook.covd); + + if (rcond (A = jact * covd_inv * jac) > eps) + + covp = hook.covp = inv (A); + + d = sqrt (diag (covp)); + + hook.corp = covp ./ (d * d.'); + + else + + n = hook.np; + + covp = NA (n); + + ## Now we have the equation "A * covp * A.' == A". + + ## Find a particular solution for "covp * A.'". + part_covp_At = A \ A; + + ## Find a particular solution for "covp". Only uniquely defined + ## elements (identified later) will be further used. + part_covp = A \ part_covp_At.'; + + ## Find a basis for the nullspace of A. + if (true) # test for Octave version once submitted patch is applied + # to Octave (bug #33503) + null = @ __null_optim__; + endif + if (isempty (basis = null (A))) + error ("internal error, singularity assumed, but null-space computed to be zero-dimensional"); + endif + + ## Find an index (applied to both row and column) of uniquely + ## defined elements of covp. + idun = all (basis == 0, 2); + + ## Fill in these elements. + covp(idun, idun) = part_covp(idun, idun); + + ## Compute corp as far as possible at the moment. + d = sqrt (diag (covp)); + corp = covp ./ (d * d.'); + + ## All diagonal elements of corp should be one, even those as yet + ## NA. + corp(1 : n + 1 : n * n) = 1; + + ## If there are indices, applied to both row and column, so that + ## indexed elements within one row or one column are determined up + ## to a multiple of a vector, find both these vectors and the + ## respective indices. In the same run, use them to further fill in + ## corp as described below. + for id = 1 : (cb = columns (basis)) + if (any (idx = \ + all (basis(:, (1 : cb) != id) == 0, 2) & \ + basis(:, id) != 0)) + vec = sign (basis(idx, id)); + + ## Depending on "vec", single coefficients of correlation + ## indexed by "idx" are either +1 or -1. + corp(idx, idx) = vec * vec.'; + endif + endfor + + hook.covp = covp; + hook.corp = corp; + + endif + +endfunction diff --git a/octave_packages/optim-1.2.0/private/__dfdp__.m b/octave_packages/optim-1.2.0/private/__dfdp__.m new file mode 100644 index 0000000..02a622e --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__dfdp__.m @@ -0,0 +1,156 @@ +%% Copyright (C) 1992-1994 Richard Shrager +%% Copyright (C) 1992-1994 Arthur Jutan +%% Copyright (C) 1992-1994 Ray Muzic +%% Copyright (C) 2010, 2011 Olaf Till +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +function prt = __dfdp__ (p, func, hook) + + %% Meant to be called by interfaces 'dfxpdp.m' and 'dfpdp.m', see there. + + + if (nargin > 2 && isfield (hook, 'f')) + f = hook.f; + else + f = func (p); + f = f(:); + end + + m = length (f); + n = length (p); + + if (nargin > 2) + + if (isfield (hook, 'fixed')) + fixed = hook.fixed; + else + fixed = false (n, 1); + end + + if (isfield (hook, 'diffp')) + diffp = hook.diffp; + else + diffp = .001 * ones (n, 1); + end + + if (isfield (hook, 'diff_onesided')) + diff_onesided = hook.diff_onesided; + else + diff_onesided = false (n, 1); + end + + if (isfield (hook, 'lbound')) + lbound = hook.lbound; + else + lbound = - Inf (n, 1); + end + + if (isfield (hook, 'ubound')) + ubound = hook.ubound; + else + ubound = Inf (n, 1); + end + + if (isfield (hook, 'plabels')) + plabels = hook.plabels; + else + plabels = num2cell (num2cell ((1:n).')); + end + + else + fixed = false (n, 1); + diff_onesided = fixed; + diffp = .001 * ones (n, 1); + lbound = - Inf (n, 1); + ubound = Inf (n, 1); + plabels = num2cell (num2cell ((1:n).')); + end + + prt = zeros (m, n); % initialise Jacobian to Zero + del = diffp .* p; + idxa = p == 0; + del(idxa) = diffp(idxa); + del(diff_onesided) = - del(diff_onesided); % keep course of + % optimization of previous versions + absdel = abs (del); + idxd = ~(diff_onesided | fixed); % double sided interval + p1 = zeros (n, 1); + p2 = p1; + idxvs = false (n, 1); + idx1g2w = idxvs; + idx1le2w = idxvs; + + %% p may be slightly out of bounds due to inaccuracy, or exactly at + %% the bound -> single sided interval + idxvl = p <= lbound; + idxvg = p >= ubound; + p1(idxvl) = min (p(idxvl, 1) + absdel(idxvl, 1), ubound(idxvl, 1)); + idxd(idxvl) = false; + p1(idxvg) = max (p(idxvg, 1) - absdel(idxvg, 1), lbound(idxvg, 1)); + idxd(idxvg) = false; + idxs = ~(fixed | idxd); % single sided interval + + idxnv = ~(idxvl | idxvg); % current paramters within bounds + idxnvs = idxs & idxnv; % within bounds, single sided interval + idxnvd = idxd & idxnv; % within bounds, double sided interval + %% remaining single sided intervals + p1(idxnvs) = p(idxnvs) + del(idxnvs); % don't take absdel, this could + % change course of optimization without + % bounds with respect to previous + % versions + %% remaining single sided intervals, violating a bound -> take largest + %% possible direction of single sided interval + idxvs(idxnvs) = p1(idxnvs, 1) < lbound(idxnvs, 1) | ... + p1(idxnvs, 1) > ubound(idxnvs, 1); + del1 = p(idxvs, 1) - lbound(idxvs, 1); + del2 = ubound(idxvs, 1) - p(idxvs, 1); + idx1g2 = del1 > del2; + idx1g2w(idxvs) = idx1g2; + idx1le2w(idxvs) = ~idx1g2; + p1(idx1g2w) = max (p(idx1g2w, 1) - absdel(idx1g2w, 1), ... + lbound(idx1g2w, 1)); + p1(idx1le2w) = min (p(idx1le2w, 1) + absdel(idx1le2w, 1), ... + ubound(idx1le2w, 1)); + %% double sided interval + p1(idxnvd) = min (p(idxnvd, 1) + absdel(idxnvd, 1), ... + ubound(idxnvd, 1)); + p2(idxnvd) = max (p(idxnvd, 1) - absdel(idxnvd, 1), ... + lbound(idxnvd, 1)); + + del(idxs) = p1(idxs) - p(idxs); + del(idxd) = p1(idxd) - p2(idxd); + + info.f = f; + info.parallel = false; + + for j = 1:n + if (~fixed(j)) + info.plabels = plabels(j, :); + ps = p; + ps(j) = p1(j); + if (idxs(j)) + info.side = 0; % onesided interval + tp1 = func (ps, info); + prt(:, j) = (tp1(:) - f) / del(j); + else + info.side = 1; % centered interval, side 1 + tp1 = func (ps, info); + ps(j) = p2(j); + info.side = 2; % centered interval, side 2 + tp2 = func (ps, info); + prt(:, j) = (tp1(:) - tp2(:)) / del(j); + end + end + end diff --git a/octave_packages/optim-1.2.0/private/__lm_feasible__.m b/octave_packages/optim-1.2.0/private/__lm_feasible__.m new file mode 100644 index 0000000..157a830 --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__lm_feasible__.m @@ -0,0 +1,505 @@ +## Copyright (C) 2012 Olaf Till +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +function [p_res, objf, cvg, outp] = __lm_feasible__ (f, pin, hook) + + ## some backend specific defaults + fract_prec_default = 0; + max_fract_step_default = Inf; + + ## needed for some anonymous functions + if (exist ("ifelse") != 5) + ifelse = @ scalar_ifelse; + endif + + n = length (pin); + + ## passed constraints + mc = hook.mc; # matrix of linear constraints + vc = hook.vc; # vector of linear constraints + f_cstr = hook.f_cstr; # function of all constraints + df_cstr = hook.df_cstr; # function of derivatives of all constraints + n_gencstr = hook.n_gencstr; # number of non-linear constraints + eq_idx = hook.eq_idx; # logical index of equality constraints in all + # constraints + lbound = hook.lbound; # bounds, subset of linear inequality + ubound = hook.ubound; # constraints in mc and vc + + ## passed values of constraints for initial parameters + pin_cstr = hook.pin_cstr; + + ## passed return value of f for initial parameters + f_pin = hook.f_pin; + + ## passed function for gradient of objective function + grad_f = hook.dfdp; + + ## passed function for hessian of objective function + if (isempty (hessian = hook.hessian)) + user_hessian = false; + A = eye (n); + else + user_hessian = true; + endif + + ## passed function for complementary pivoting + cpiv = hook.cpiv; + + ## passed options + ftol = hook.TolFun; + if (isempty (niter = hook.MaxIter)) niter = 20; endif + fixed = hook.fixed; + maxstep = hook.max_fract_change; + maxstep(isna (maxstep)) = max_fract_step_default; + pprec = hook.fract_prec; + pprec(isna (pprec)) = fract_prec_default; + verbose = strcmp (hook.Display, "iter"); + + ## some useful variables derived from passed variables + n_lcstr = size (vc, 1); + have_constraints_except_bounds = \ + n_lcstr + n_gencstr > \ + sum (lbound != -Inf) + sum (ubound != Inf); + ac_idx = true (n_lcstr + n_gencstr, 1); # index of all constraints + nc_idx = false (n_lcstr + n_gencstr, 1); # none of all constraints + gc_idx = cat (1, false (n_lcstr, 1), true (n_gencstr, 1)); # gen. constr. + + nz = 20 * eps; # This is arbitrary. Accuracy of equality constraints. + + ## backend-specific checking of options and constraints + ## + if (any (pin < lbound | pin > ubound) || + any (pin_cstr.inequ.lin_except_bounds < 0) || + any (pin_cstr.inequ.gen < 0) || + any (abs (pin_cstr.equ.lin)) >= nz || + any (abs (pin_cstr.equ.gen)) >= nz) + error ("Initial parameters violate constraints."); + endif + ## + idx = lbound == ubound; + if (any (idx)) + warning ("lower and upper bounds identical for some parameters, fixing the respective parameters"); + fixed(idx) = true; + endif + if (all (fixed)) + error ("no free parameters"); + endif + if (n_gencstr > 0 && any (! isinf (maxstep))) + warning ("setting both a maximum fractional step change of parameters and general constraints may result in inefficiency and failure"); + endif + + ## fill constant fields of hook for derivative-functions; some fields + ## may be backend-specific + dfdp_hook.fixed = fixed; # this may be handled by the frontend, but + # the backend still may add to it + + ## set up for iterations + p = pbest = pin; + vf = fbest = f_pin; + iter = 0; + done = false; + ll = 1; + ltab = [.1, 1, 1e2, 1e4, 1e6]; + chgprev = Inf (n, 1); + df = []; + c_act = false (n, 1); + dca = zeros (n, 0); + + while (! done) + + iter++; + + ## gradient of objective function + old_df = df; + df = grad_f (p, setfield (dfdp_hook, "f", f))(:); + + ## constraints, preparation of some constants + v_cstr = f_cstr (p, ac_idx); + old_c_act = c_act; + old_dca = dca; + c_act = v_cstr < nz | eq_idx; # index of active constraints + if (any (c_act)) + + if (n_gencstr) + ## full gradient is needed later + dct = df_cstr (p, ac_idx, setfield (dfdp_hook, "f", v_cstr)); + dct(:, fixed) = 0; # for user supplied dfdp; necessary? + dcat = dct(c_act, :); + else + dcat = df_cstr (p, c_act, setfield (dfdp_hook, "f", v_cstr)); + dcat(:, fixed) = 0; # for user supplied dfdp; necessary? + endif + + dca = dcat.'; + + a_eq_idx = eq_idx(c_act); + + else + + dca = zeros (n, 0); + + endif + + ## hessian of objectiv function + if (user_hessian) + + A = hessian (p); + idx = isnan (A); + A(idx) = A.'(idx); + if (any (isnan (A(:)))) + error ("some second derivatives undefined by user function"); + endif + if (! isreal (A)) + error ("second derivatives given by user function not real"); + endif + if (! issymmetric (A)) + error ("Hessian returned by user function not symmetric"); + endif + + elseif (iter > 1) + + if (any (chg)) + + ## approximate Hessian of Lagrangian + + ## I wonder if this hassle here and above with accounting for + ## changing active sets is indeed better than just approximating + ## the Hessian only of the objective function. + ## + ## index, over all constraints, of constraints active both + ## previously and currently + s_c_act = old_c_act & c_act; + ## index, over currently active constraints, of constraints + ## active both previously and currently + id_new = s_c_act(c_act); + ## index, over previously active constraints, of constraints + ## active both previously and currently + id_old = s_c_act(old_c_act); + ## gradients of currently active constraints which were also + ## active previously + dca_new_id = dca(:, id_new); + ## gradients of previously active constraints which are also + ## active currently + dca_old_id = old_dca(:, id_old); + ## index, over constraints active both previously and currently, + ## of (old) non-zero multipliers (bidx set below previously) + bidx_old_id = bidx(id_old); + ## index, over (old) non-zero multipliers, of constraints active + ## both previously and currently (bidx set below previously) + old_l_idx = id_old(bidx); + + ## difference of derivatives of new and old active constraints, + ## multiplied by multipliers, as used for BFGS update (lb set + ## below previously) + dch = (dca_new_id(:, bidx_old_id) - \ + dca_old_id(:, bidx_old_id)) * \ + lb(old_l_idx); + + y = df - old_df - dch; + + ## Damped BFGS according to Nocedal & Wright, 2nd edition, + ## procedure 18.2. + chgt = chg.'; + sAs = chgt * A * chg; + cy = chgt * y; + if (cy >= .2 * sAs) + th = 1; + else + if ((den1 = sAs - cy) == 0) + cvg = -4; + break; + endif + th = .8 * sAs / den1; + endif + Ac = A * chg; + r = th * y + (1 - th) * Ac; + + if ((den2 = chgt * r) == 0 || sAs == 0) + cvg = -4; + break; + endif + A += r * r.' / den2 - Ac * Ac.' / sAs; + + endif + + endif + + ## Inverse scaled decomposition A = G * (1 ./ L) * G.' + ## + ## make matrix Binv for scaling + Binv = diag (A); + nidx = ! (idx = Binv == 0); + Binv(nidx) = 1 ./ sqrt (abs (Binv(nidx))); + Binv(idx) = 1; + Binv = diag (Binv); + ## eigendecomposition of scaled A + [V, L] = eig (Binv * A * Binv); + L = diag (L); + ## A is symmetric, so V and L are real, delete any imaginary parts, + ## which might occur due to inaccuracy + V = real (V); + L = real (L); + ## + nminL = - min (L) * 1.1 / ltab(1); + G = Binv * V; + + ## Levenberg/Marquardt + fgoal = (1 - ftol) * vf; + for l = ltab + + ll = max (ll, nminL); + l = max (1e-7, ll * l); + + R = G * diag (1 ./ (L + l)) * G.'; + + ## step computation + if (any (c_act)) + + ## some constraints are active, quadratic programming + + tp = dcat * R; + [lb, bidx, ridx, tbl] = cpiv (- tp * df, tp * dca, a_eq_idx); + chg = R * (dca(:, bidx) * lb - df); # step direction + + ## indices for different types of constraints + c_inact = ! c_act; # inactive constraints + c_binding = c_unbinding = nc_idx; + c_binding(c_act) = bidx; # constraints selected binding + c_unbinding(c_act) = ridx; # constraints unselected binding + c_nonbinding = c_act & ! (c_binding | c_unbinding); # + #constraints selected non-binding + + else + + ## no constraints are active, chg is the Levenberg/Marquardt step + + chg = - R * df; # step direction + + lb = zeros (0, 1); + bidx = false (0, 1); + + ## indices for different types of constraints (meaning see above) + c_inact = ac_idx; + c_binding = nc_idx; + c_unbinding = nc_idx; + c_nonbinding = nc_idx; + + endif + + ## apply inactive and non-binding constraints to step width + ## + ## linear constraints + k = 1; + c_tp = c_inact(1:n_lcstr); + mcit = mc(:, c_tp).'; + vci = vc(c_tp); + hstep = mcit * chg; + idx = hstep < 0; + if (any (idx)) + k = min (1, min (- (vci(idx) + mcit(idx, :) * p) ./ \ + hstep(idx))); + endif + ## + ## general constraints + if (n_gencstr) + c_tp = gc_idx & (c_nonbinding | c_inact); + if (any (c_tp) && any (f_cstr (p + k * chg, c_tp) < 0)) + [k, fval, info] = \ + fzero (@ (x) min (cat (1, \ + f_cstr (p + x * chg, c_tp), \ + k - x, \ + ifelse (x < 0, -Inf, Inf))), \ + 0); + if (info != 1 || abs (fval) >= nz) + error ("could not find stepwidth to satisfy inactive and non-binding general inequality constraints"); + endif + endif + endif + ## + chg = k * chg; + + ## if necessary, regain binding constraints and one of the + ## possibly active previously inactive or non-binding constraints + if (any (gc_idx & c_binding)) # none selected binding => none + # unselected binding + ptp1 = p + chg; + + tp = true; + nt_nosuc = true; + lim = 20; + while (nt_nosuc && lim >= 0) + ## we keep d_p.' * inv (R) * d_p minimal in each step of the + ## inner loop + c_tp0 = c_inact | c_nonbinding; + c_tp1 = c_inact | (gc_idx & c_nonbinding); + btbl = tbl(bidx, bidx); + c_tp2 = c_binding; + ## once (any(tp)==false), it would not get true again even + ## with the following assignment + if (any (tp) && \ + any (tp = f_cstr (ptp1, c_tp1) < nz)) + ## keep only the first true entry in tp + tp(tp) = logical (cat (1, 1, zeros (sum (tp) - 1, 1))); + ## supplement binding index with one (the first) getting + ## binding in c_tp1 + c_tp2(c_tp1) = tp; + ## gradient of this added constraint + caddt = dct(c_tp2 & ! c_binding, :); + cadd = caddt.'; + C = dct(c_binding, :) * R * cadd; + Ct = C.'; + T = [btbl, btbl * C; \ + -Ct * btbl, caddt * R * cadd - Ct * btbl * C]; + btbl = gjp (T, size (T, 1)); + endif + dcbt = dct(c_tp2, :); + mfc = - R * dcbt.' * btbl; + + ptp2 = ptp1; + nt_niter = nt_niter_start = 100; + while (nt_nosuc && nt_niter >= 0) + hv = f_cstr (ptp2, c_tp2); + if (all (abs (hv) < nz)) + nt_nosuc = false; + chg = ptp2 - p; + else + ptp2 = ptp2 + mfc * hv; # step should be zero for each + # component for which the parameter is + # "fixed" + endif + nt_niter--; + endwhile + + if (nt_nosuc || \ + any (abs (chg) > abs (p .* maxstep)) || \ + any (f_cstr (ptp2, c_tp0) < -nz)) + ## if (nt_nosuc), regaining did not converge, else, + ## regaining violated type 3 and 4. + nt_nosuc = true; + ptp1 = (p + ptp1) / 2; + endif + if (! nt_nosuc && \ + any ((tp = f_cstr (ptp2, c_unbinding)) < 0)) + [discarded, id] = min(tp); + tid = find (ridx); + id = tid(id); # index within active constraints + unsuccessful_exchange = false; + if (abs (tbl(id, id)) < nz) # Bard: not absolute value + ## exchange this unselected binding constraint against a + ## binding constraint, but not against an equality + ## constraint + tbidx = bidx & ! a_eq_idx; + if (! any (tbidx)) + unsuccessful_exchange = true; + else + [discarded, idm] = max (abs (tbl(tbidx, id))); + tid = find (tbidx); + idm = tid(idm); # -> index within active constraints + tbl = gjp (tbl, idm); + bidx(idm) = false; + ridx(idm) = true; + endif + endif + if (unsuccessful_exchange) + ## It probably doesn't look good now; this desperate last + ## attempt is not in the original algortithm, since that + ## didn't account for equality constraints. + ptp1 = (p + ptp1) / 2; + else + tbl = gjp (tbl, id); + bidx(id) = true; + ridx(id) = false; + c_binding = nc_idx; + c_binding(c_act) = bidx; + c_unbinding = nc_idx; + c_unbinding(c_act) = ridx; + endif + ## regaining violated type 2 constraints + nt_nosuc = true; + endif + lim--; + endwhile + if (nt_nosuc) + error ("could not regain binding constraints"); + endif + else + ## check the maximal stepwidth and apply as necessary + ochg = chg; + idx = ! isinf (maxstep); + limit = abs (maxstep(idx) .* p(idx)); + chg(idx) = min (max (chg(idx), - limit), limit); + if (verbose && any (ochg != chg)) + printf ("Change in parameter(s): %s:maximal fractional stepwidth enforced", \ + sprintf ("%d ", find (ochg != chg))); + endif + endif # regaining + + aprec = abs (pprec .* pbest); + if (any (abs (chg) > 0.1 * aprec)) # only worth evaluating + # function if there is some + # non-miniscule change + p_chg = p + chg; + ## since the projection method may have slightly violated + ## constraints due to inaccuracy, correct parameters to bounds + ## --- but only if no further constraints are given, otherwise + ## the inaccuracy in honoring them might increase by this + if (! have_constraints_except_bounds) + lidx = p_chg < lbound; + uidx = p_chg > ubound; + p_chg(lidx, 1) = lbound(lidx, 1); + p_chg(uidx, 1) = ubound(uidx, 1); + chg(lidx, 1) = p_chg(lidx, 1) - p(lidx, 1); + chg(uidx, 1) = p_chg(uidx, 1) - p(uidx, 1); + endif + ## + if (! isreal (vf_chg = f (p_chg))) + error ("objective function not real"); + endif + if (vf_chg < fbest) + pbest = p_chg; + fbest = vf_chg; + endif + if (vf_chg <= fgoal) + p = p_chg; + vf = vf_chg; + break; + endif + endif + endfor + + ll = l; + + aprec = abs (pprec .* pbest); + if (vf_chg < eps || vf_chg > fgoal) + cvg = 3; + done = true; + elseif (all (abs (chg) <= aprec) && all (abs (chgprev) <= aprec)) + cvg = 2; + done = true; + elseif (iter == niter) + cvg = 0; + done = true; + else + chgprev = chg; + endif + + endwhile + + ## return result + p_res = pbest; + objf = fbest; + outp.niter = iter; + +endfunction diff --git a/octave_packages/optim-1.2.0/private/__lm_svd__.m b/octave_packages/optim-1.2.0/private/__lm_svd__.m new file mode 100644 index 0000000..807e7b2 --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__lm_svd__.m @@ -0,0 +1,510 @@ +%% Copyright (C) 1992-1994 Richard Shrager +%% Copyright (C) 1992-1994 Arthur Jutan +%% Copyright (C) 1992-1994 Ray Muzic +%% Copyright (C) 2010, 2011 Olaf Till +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +function [p, resid, cvg, outp] = __lm_svd__ (F, pin, hook) + + %% This is a backend for optimization. This code was originally + %% contained in leasqr.m, which is now a frontend. + + %% some backend specific defaults + fract_prec_default = 0; + max_fract_step_default = Inf; + + %% needed for some anonymous functions + if (exist ('ifelse') ~= 5) + ifelse = @ scalar_ifelse; + end + + %% passed constraints + mc = hook.mc; % matrix of linear constraints + vc = hook.vc; % vector of linear constraints + f_cstr = hook.f_cstr; % function of all constraints + df_cstr = hook.df_cstr; % function of derivatives of all constraints + n_gencstr = hook.n_gencstr; % number of non-linear constraints + eq_idx = hook.eq_idx; % logical index of equality constraints in all + % constraints + lbound = hook.lbound; % bounds, subset of linear inequality + ubound = hook.ubound; % constraints in mc and vc + + %% passed values of constraints for initial parameters + pin_cstr = hook.pin_cstr; + + %% passed return value of F for initial parameters + f_pin = hook.f_pin; + + %% passed derivative of residual function + dfdp = hook.dfdp; + + %% passed function for complementary pivoting + cpiv = hook.cpiv; + + %% passed options + maxstep = hook.max_fract_change; + maxstep(isna (maxstep)) = max_fract_step_default; + pprec = hook.fract_prec; + pprec(isna (pprec)) = fract_prec_default; + stol = hook.TolFun; + niter = hook.MaxIter; + if (isempty (niter)) niter = 20; end + wt = hook.weights; + fixed = hook.fixed; + verbose = strcmp (hook.Display, 'iter'); + + %% only preliminary, for testing + if (isfield (hook, 'testing')) + testing = hook.testing; + else + testing = false; + end + if (isfield (hook, 'new_s')) + new_s = hook.new_s; + else + new_s = false; + end + + %% some useful variables derived from passed variables + n_lcstr = size (vc, 1); + have_constraints_except_bounds = ... + n_lcstr + n_gencstr > ... + sum (lbound ~= -Inf) + sum (ubound ~= Inf); + n = length (pin); + wtl = wt(:); + + nz = 20 * eps; % This is arbitrary. Constraint function will be + % regarded as <= zero if less than nz. + + %% backend-specific checking of options and constraints + if (have_constraints_except_bounds) + if (any (pin_cstr.inequ.lin_except_bounds < 0) || ... + (n_gencstr > 0 && any (pin_cstr.inequ.gen < 0))) + warning ('initial parameters violate inequality constraints'); + end + if (any (abs (pin_cstr.equ.lin) >= nz) || ... + (n_gencstr > 0 && any (abs (pin_cstr.equ.gen) >= nz))) + warning ('initial parameters violate equality constraints'); + end + end + idx = lbound == ubound; + if (any (idx)) + warning ('lower and upper bounds identical for some parameters, fixing the respective parameters'); + fixed(idx) = true; + end + if (all (fixed)) + error ('no free parameters'); + end + lidx = pin < lbound; + uidx = pin > ubound; + if (any (lidx | uidx) && have_constraints_except_bounds) + warning ('initial parameters outside bounds, not corrected since other constraints are given'); + else + if (any (lidx)) + warning ('some initial parameters set to lower bound'); + pin(lidx, 1) = lbound(lidx, 1); + end + if (any (uidx)) + warning ('some initial parameters set to upper bound'); + pin(uidx, 1) = ubound(uidx, 1); + end + end + if (n_gencstr > 0 && any (~isinf (maxstep))) + warning ('setting both a maximum fractional step change of parameters and general constraints may result in inefficiency and failure'); + end + + %% fill constant fields of hook for derivative-functions; some fields + %% may be backend-specific + dfdp_hook.fixed = fixed; % this may be handled by the frontend, but + % the backend still may add to it + + %% set up for iterations + %% + p = pin; + f = f_pin; fbest=f; pbest=p; + m = prod (size (f)); + r = wt .* f; + r = r(:); + if (~isreal (r)) error ('weighted residuals are not real'); end + ss = r.' * r; + sbest=ss; + chgprev=Inf*ones(n,1); + cvg=0; + epsLlast=1; + epstab=[.1, 1, 1e2, 1e4, 1e6]; + ac_idx = true (n_lcstr + n_gencstr, 1); % all constraints + nc_idx = false (n_lcstr + n_gencstr, 1); % none of all constraints + gc_idx = cat (1, false (n_lcstr, 1), true (n_gencstr, 1)); % gen. constr. + lc_idx = ~gc_idx; + + %% do iterations + %% + for iter = 1:niter + deb_printf (testing, '\nstart outer iteration\n'); + v_cstr = f_cstr (p, ac_idx); + %% index of active constraints + c_act = v_cstr < nz | eq_idx; # equality constraints might be + # violated at start + if (any (c_act)) + if (n_gencstr > 0) + %% full gradient is needed later + dct = df_cstr (p, ac_idx, ... + setfield (dfdp_hook, 'f', v_cstr)); + dct(:, fixed) = 0; % for user supplied dfdp; necessary? + dcat = dct(c_act, :); + else + dcat = df_cstr (p, c_act, ... + setfield (dfdp_hook, 'f', v_cstr)); + dcat(:, fixed) = 0; % for user supplied dfdp; necessary? + end + dca = dcat.'; + end + nrm = zeros (1, n); + pprev=pbest; + prt = dfdp (p, setfield (dfdp_hook, 'f', fbest(:))); + prt(:, fixed) = 0; % for user supplied dfdp; necessary? + r = wt .* -fbest; + r = r(:); + if (~isreal (r)) error ('weighted residuals are not real'); end + sprev=sbest; + sgoal=(1-stol)*sprev; + msk = ~fixed; + prt(:, msk) = prt(:, msk) .* wtl(:, ones (1, sum (msk))); + nrm(msk) = sumsq (prt(:, msk), 1); + msk = nrm > 0; + nrm(msk) = 1 ./ sqrt (nrm(msk)); + prt = prt .* nrm(ones (1, m), :); + nrm = nrm.'; + [prt,s,v]=svd(prt,0); + s=diag(s); + g = prt.' * r; + for jjj=1:length(epstab) + deb_printf (testing, '\nstart inner iteration\n'); + epsL = max(epsLlast*epstab(jjj),1e-7); + %% printf ('epsL: %e\n', epsL); % for testing + + %% Usage of this 'ser' later is equivalent to pre-multiplying the + %% gradient with a positive-definit matrix, but not with a + %% diagonal matrix, at epsL -> Inf; so there is a fallback to + %% gradient descent, but not in general to descent for each + %% gradient component. Using the commented-out 'ser' ((1 / (1 + + %% epsL^2)) * (1 ./ se + epsL * s)) would be equivalent to using + %% Marquardts diagonal of the Hessian-approximation for epsL -> + %% Inf, but currently this gives no advantages in tests, even with + %% constraints. +%%% ser = 1 ./ sqrt((s.*s)+epsL); + se = sqrt ((s.*s) + epsL); + if (new_s) + %% for testing + ser = (1 / (1 + epsL^2)) * (1 ./ se + epsL * s); + else + ser = 1 ./ se; + end + tp1 = (v * (g .* ser)) .* nrm; + if (any (c_act)) + deb_printf (testing, 'constraints are active:\n'); + deb_printf (testing, '%i\n', c_act); + %% calculate chg by 'quadratic programming' + nrme= diag (nrm); + ser2 = diag (ser .* ser); + mfc1 = nrme * v * ser2 * v.' * nrme; + tp2 = mfc1 * dca; + a_eq_idx = eq_idx(c_act); + [lb, bidx, ridx, tbl] = cpiv (dcat * tp1, dcat * tp2, a_eq_idx); + chg = tp1 + tp2(:, bidx) * lb; % if a parameter is 'fixed', + % the respective component of chg should + % be zero too, even here (with active + % constraints) + deb_printf (testing, 'change:\n'); + deb_printf (testing, '%e\n', chg); + deb_printf (testing, '\n'); + %% indices for different types of constraints + c_inact = ~c_act; % inactive constraints + c_binding = nc_idx; + c_binding(c_act) = bidx; % constraints selected binding + c_unbinding = nc_idx; + c_unbinding(c_act) = ridx; % constraints unselected binding + c_nonbinding = c_act & ~(c_binding | c_unbinding); % constraints + % selected non-binding + else + %% chg is the Levenberg/Marquardt step + chg = tp1; + %% indices for different types of constraints + c_inact = ac_idx; % inactive constraints consist of all + % constraints + c_binding = nc_idx; + c_unbinding = nc_idx; + c_nonbinding = nc_idx; + end + %% apply constraints to step width (since this is a + %% Levenberg/Marquardt algorithm, no line-search is performed + %% here) + k = 1; + c_tp = c_inact(1:n_lcstr); + mcit = mc(:, c_tp).'; + vci = vc(c_tp); + hstep = mcit * chg; + idx = hstep < 0; + if (any (idx)) + k = min (1, min (- (vci(idx) + mcit(idx, :) * pprev) ./ ... + hstep(idx))); + end + if (k < 1) + deb_printf (testing, 'stepwidth: linear constraints\n'); + end + if (n_gencstr > 0) + c_tp = gc_idx & (c_nonbinding | c_inact); + if (any (c_tp) && any (f_cstr (pprev + k * chg, c_tp) < 0)) + [k, fval, info] = ... + fzero (@ (x) min (cat (1, ... + f_cstr (pprev + x * chg, c_tp), ... + k - x, ... + ifelse (x < 0, -Inf, Inf))), ... + 0); + if (info ~= 1 || abs (fval) >= nz) + error ('could not find stepwidth to satisfy inactive and non-binding general inequality constraints'); + end + deb_printf (testing, 'general constraints limit stepwidth\n'); + end + end + chg = k * chg; + + if (any (gc_idx & c_binding)) % none selected binding => + % none unselected binding + deb_printf (testing, 'general binding constraints must be regained:\n'); + %% regain binding constraints and one of the possibly active + %% previously inactive or non-binding constraints + ptp1 = pprev + chg; + + tp = true; + nt_nosuc = true; + lim = 20; + while (nt_nosuc && lim >= 0) + deb_printf (testing, 'starting from new value of p in regaining:\n'); + deb_printf (testing, '%e\n', ptp1); + %% we keep d_p.' * inv (mfc1) * d_p minimal in each step of + %% the inner loop; this is both sensible (this metric + %% considers a guess of curvature of sum of squared residuals) + %% and convenient (we have useful matrices available for it) + c_tp0 = c_inact | c_nonbinding; + c_tp1 = c_inact | (gc_idx & c_nonbinding); + btbl = tbl(bidx, bidx); + c_tp2 = c_binding; + if (any (tp)) % if none before, does not get true again + tp = f_cstr (ptp1, c_tp1) < nz; + if (any (tp)) % could be less clumsy, but ml-compatibility.. + %% keep only the first true entry in tp + tp(tp) = logical (cat (1, 1, zeros (sum (tp) - 1, 1))); + %% supplement binding index with one (the first) getting + %% binding in c_tp1 + c_tp2(c_tp1) = tp; + %% gradient of this added constraint + caddt = dct(c_tp2 & ~c_binding, :); + cadd = caddt.'; + C = dct(c_binding, :) * mfc1 * cadd; + Ct = C.'; + G = [btbl, btbl * C; ... + -Ct * btbl, caddt * mfc1 * cadd - Ct * btbl * C]; + btbl = gjp (G, size (G, 1)); + end + end + dcbt = dct(c_tp2, :); + mfc = - mfc1 * dcbt.' * btbl; + deb_printf (testing, 'constraints to regain:\n'); + deb_printf (testing, '%i\n', c_tp2); + + ptp2 = ptp1; + nt_niter_start = 100; + nt_niter = nt_niter_start; + while (nt_nosuc && nt_niter >= 0) + hv = f_cstr (ptp2, c_tp2); + if (all (abs (hv) < nz)) + nt_nosuc = false; + chg = ptp2 - pprev; + else + ptp2 = ptp2 + mfc * hv; % step should be zero for each + % component for which the parameter is + % 'fixed' + end + nt_niter = nt_niter - 1; + end + deb_printf (testing, 'constraints after regaining:\n'); + deb_printf (testing, '%e\n', hv); + if (nt_nosuc || ... + any (abs (chg) > abs (pprev .* maxstep)) || ... + any (f_cstr (ptp2, c_tp0) < -nz)) + if (nt_nosuc) + deb_printf (testing, 'regaining did not converge\n'); + else + deb_printf (testing, 'regaining violated type 3 and 4\n'); + end + nt_nosuc = true; + ptp1 = (pprev + ptp1) / 2; + end + if (~nt_nosuc) + tp = f_cstr (ptp2, c_unbinding); + if (any (tp) < 0) % again ml-compatibility clumsyness.. + [discarded, id] = min(tp); + tid = find (ridx); + id = tid(id); % index within active constraints + unsuccessful_exchange = false; + if (abs (tbl(id, id)) < nz) % Bard: not absolute value + %% exchange this unselected binding constraint against a + %% binding constraint, but not against an equality + %% constraint + tbidx = bidx & ~a_eq_idx; + if (~any (tbidx)) + unsuccessful_exchange = true; + else + [discarded, idm] = max (abs (tbl(tbidx, id))); + tid = find (tbidx); + idm = tid(idm); % -> index within active constraints + tbl = gjp (tbl, idm); + bidx(idm) = false; + ridx(idm) = true; + end + end + if (unsuccessful_exchange) + %% It probably doesn't look good now; this desperate + %% last attempt is not in the original algortithm, since + %% that didn't account for equality constraints. + ptp1 = (pprev + ptp1) / 2; + else + tbl = gjp (tbl, id); + bidx(id) = true; + ridx(id) = false; + c_binding = nc_idx; + c_binding(c_act) = bidx; + c_unbinding = nc_idx; + c_unbinding(c_act) = ridx; + end + nt_nosuc = true; + deb_printf (testing, 'regaining violated type 2\n'); + end + end + if (~nt_nosuc) + deb_printf (testing, 'regaining successful, converged with %i iterations:\n', ... + nt_niter_start - nt_niter); + deb_printf (testing, '%e\n', ptp2); + end + lim = lim - 1; + end + if (nt_nosuc) + error ('could not regain binding constraints'); + end + else + %% check the maximal stepwidth and apply as necessary + ochg=chg; + idx = ~isinf(maxstep); + limit = abs(maxstep(idx).*pprev(idx)); + chg(idx) = min(max(chg(idx),-limit),limit); + if (verbose && any(ochg ~= chg)) + disp(['Change in parameter(s): ', ... + sprintf('%d ',find(ochg ~= chg)), 'maximal fractional stepwidth enforced']); + end + end + aprec=abs(pprec.*pbest); %--- + %% ss=scalar sum of squares=sum((wt.*f)^2). + if (any(abs(chg) > 0.1*aprec))%--- % only worth evaluating + % function if there is some non-miniscule + % change + %% In the code of the outer loop before the inner loop pbest is + %% actually identical to p, since once they deviate, the outer + %% loop will not be repeated. Though the inner loop can still be + %% repeated in this case, pbest is not used in it. Since pprev + %% is set from pbest in the outer loop before the inner loop, it + %% is also identical to p up to here. + p=chg+pprev; + %% since the projection method may have slightly violated + %% constraints due to inaccuracy, correct parameters to bounds + %% --- but only if no further constraints are given, otherwise + %% the inaccuracy in honoring them might increase by this + if (~have_constraints_except_bounds) + lidx = p < lbound; + uidx = p > ubound; + p(lidx, 1) = lbound(lidx, 1); + p(uidx, 1) = ubound(uidx, 1); + chg(lidx, 1) = p(lidx, 1) - pprev(lidx, 1); + chg(uidx, 1) = p(uidx, 1) - pprev(uidx, 1); + end + %% + f = F (p); + r = wt .* f; + r = r(:); + if (~isreal (r)) + error ('weighted residuals are not real'); + end + ss = r.' * r; + deb_printf (testing, 'sbest: %.16e\n', sbest); + deb_printf (testing, 'sgoal: %.16e\n', sgoal); + deb_printf (testing, ' ss: %.16e\n', ss); + if (sssgoal) + cvg = 3; + break; + end + aprec=abs(pprec.*pbest); + %% [aprec, chg, chgprev] + if (all(abs(chg) <= aprec) && all(abs(chgprev) <= aprec)) + cvg = 2; + if (verbose) + fprintf('Parameter changes converged to specified precision\n'); + end + break; + else + chgprev=chg; + end + end + + %% set further return values + %% + p = pbest; + resid = fbest; + outp.niter = iter; + +function deb_printf (do_printf, varargin) + + %% for testing + + if (do_printf) + printf (varargin{:}) + end + +function fval = scalar_ifelse (cond, tval, fval) + + %% needed for some anonymous functions, builtin ifelse only available + %% in Octave > 3.2; we need only the scalar case here + + if (cond) + fval = tval; + end diff --git a/octave_packages/optim-1.2.0/private/__nonlin_residmin__.m b/octave_packages/optim-1.2.0/private/__nonlin_residmin__.m new file mode 100644 index 0000000..63eabdd --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__nonlin_residmin__.m @@ -0,0 +1,1032 @@ +## Copyright (C) 2010, 2011 Olaf Till +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## Internal function, called by nonlin_residmin --- see there --- and +## others. Calling __nonlin_residmin__ indirectly hides the argument +## "hook", usable by wrappers, from users. Currently, hook can contain +## the field "observations", so that dimensions of observations and +## returned values of unchanged model function can be checked against +## each other exactly one time. + +## disabled PKG_ADD: __all_opts__ ("__nonlin_residmin__"); + +function [p, resid, cvg, outp] = \ + __nonlin_residmin__ (f, pin, settings, hook) + + if (compare_versions (version (), "3.3.55", "<")) + ## optimset mechanism was fixed for option names with underscores + ## sometime in 3.3.54+, if I remember right + optimget = @ __optimget__; + endif + + if (compare_versions (version (), "3.2.4", "<=")) + ## For bug #31484; but Octave 3.6... shows bug #36288 due to this + ## workaround. Octave 3.7... seems to be all right. + __dfdp__ = @ __dfdp__; + endif + + ## some scalar defaults; some defaults are backend specific, so + ## lacking elements in respective constructed vectors will be set to + ## NA here in the frontend + diffp_default = .001; + stol_default = .0001; + cstep_default = 1e-20; + + if (nargin == 1 && ischar (f) && strcmp (f, "defaults")) + p = optimset ("param_config", [], \ + "param_order", [], \ + "param_dims", [], \ + "f_inequc_pstruct", false, \ + "f_equc_pstruct", false, \ + "f_pstruct", false, \ + "df_inequc_pstruct", false, \ + "df_equc_pstruct", false, \ + "dfdp_pstruct", false, \ + "lbound", [], \ + "ubound", [], \ + "dfdp", [], \ + "cpiv", @ cpiv_bard, \ + "max_fract_change", [], \ + "fract_prec", [], \ + "diffp", [], \ + "diff_onesided", [], \ + "complex_step_derivative_f", false, \ + "complex_step_derivative_inequc", false, \ + "complex_step_derivative_equc", false, \ + "cstep", cstep_default, \ + "fixed", [], \ + "inequc", [], \ + "equc", [], \ + "inequc_f_idx", false, \ + "inequc_df_idx", false, \ + "equc_f_idx", false, \ + "equc_df_idx", false, \ + "weights", [], \ + "TolFun", stol_default, \ + "MaxIter", [], \ + "Display", "off", \ + "Algorithm", "lm_svd_feasible", \ + "plot_cmd", @ (f) 0, \ + "debug", false, \ + "lm_svd_feasible_alt_s", false); + return; + endif + + assign = @ assign; # Is this faster in repeated calls? + + if (nargin != 4) + error ("incorrect number of arguments"); + endif + + if (ischar (f)) + f = str2func (f); + endif + + if (! (pin_struct = isstruct (pin))) + if (! isvector (pin) || columns (pin) > 1) + error ("initial parameters must be either a structure or a column vector"); + endif + endif + + #### processing of settings and consistency checks + + pconf = optimget (settings, "param_config"); + pord = optimget (settings, "param_order"); + pdims = optimget (settings, "param_dims"); + f_inequc_pstruct = optimget (settings, "f_inequc_pstruct", false); + f_equc_pstruct = optimget (settings, "f_equc_pstruct", false); + f_pstruct = optimget (settings, "f_pstruct", false); + dfdp_pstruct = optimget (settings, "dfdp_pstruct", f_pstruct); + df_inequc_pstruct = optimget (settings, "df_inequc_pstruct", \ + f_inequc_pstruct); + df_equc_pstruct = optimget (settings, "df_equc_pstruct", \ + f_equc_pstruct); + lbound = optimget (settings, "lbound"); + ubound = optimget (settings, "ubound"); + dfdp = optimget (settings, "dfdp"); + if (ischar (dfdp)) dfdp = str2func (dfdp); endif + max_fract_change = optimget (settings, "max_fract_change"); + fract_prec = optimget (settings, "fract_prec"); + diffp = optimget (settings, "diffp"); + diff_onesided = optimget (settings, "diff_onesided"); + fixed = optimget (settings, "fixed"); + do_cstep = optimget (settings, "complex_step_derivative_f", false); + cstep = optimget (settings, "cstep", cstep_default); + if (do_cstep && ! isempty (dfdp)) + error ("both 'complex_step_derivative_f' and 'dfdp' are set"); + endif + do_cstep_inequc = \ + optimget (settings, "complex_step_derivative_inequc", false); + do_cstep_equc = optimget (settings, "complex_step_derivative_equc", false); + + any_vector_conf = ! (isempty (lbound) && isempty (ubound) && \ + isempty (max_fract_change) && \ + isempty (fract_prec) && isempty (diffp) && \ + isempty (diff_onesided) && isempty (fixed)); + + ## collect constraints + [mc, vc, f_genicstr, df_gencstr, user_df_gencstr] = \ + __collect_constraints__ (optimget (settings, "inequc"), \ + do_cstep_inequc, "inequality constraints"); + [emc, evc, f_genecstr, df_genecstr, user_df_genecstr] = \ + __collect_constraints__ (optimget (settings, "equc"), \ + do_cstep_equc, "equality constraints"); + mc_struct = isstruct (mc); + emc_struct = isstruct (emc); + + ## correct "_pstruct" settings if functions are not supplied, handle + ## constraint functions not honoring indices + if (isempty (dfdp)) dfdp_pstruct = false; endif + if (isempty (f_genicstr)) + f_inequc_pstruct = false; + elseif (! optimget (settings, "inequc_f_idx", false)) + f_genicstr = @ (p, varargin) apply_idx_if_given \ + (f_genicstr (p, varargin{:}), varargin{:}); + endif + if (isempty (f_genecstr)) + f_equc_pstruct = false; + elseif (! optimget (settings, "equc_f_idx", false)) + f_genecstr = @ (p, varargin) apply_idx_if_given \ + (f_genecstr (p, varargin{:}), varargin{:}); + endif + if (user_df_gencstr) + if (! optimget (settings, "inequc_df_idx", false)) + df_gencstr = @ (varargin) df_gencstr (varargin{:})(varargin{2}, :); + endif + else + df_inequc_pstruct = false; + endif + if (user_df_genecstr) + if (! optimget (settings, "equc_df_idx", false)) + df_genecstr = @ (varargin) df_genecstr (varargin{:})(varargin{2}, :); + endif + else + df_equc_pstruct = false; + endif + + ## some settings require a parameter order + if (pin_struct || ! isempty (pconf) || f_inequc_pstruct || \ + f_equc_pstruct || f_pstruct || dfdp_pstruct || \ + df_inequc_pstruct || df_equc_pstruct || mc_struct || \ + emc_struct) + if (isempty (pord)) + if (pin_struct) + if (any_vector_conf || \ + ! (f_pstruct && \ + (f_inequc_pstruct || isempty (f_genicstr)) && \ + (f_equc_pstruct || isempty (f_genecstr)) && \ + (dfdp_pstruct || isempty (dfdp)) && \ + (df_inequc_pstruct || ! user_df_gencstr) && \ + (df_equc_pstruct || ! user_df_genecstr) && \ + (mc_struct || isempty (mc)) && \ + (emc_struct || isempty (emc)))) + error ("no parameter order specified and constructing a parameter order from the structure of initial parameters can not be done since not all configuration or given functions are structure based"); + else + pord = fieldnames (pin); + endif + else + error ("given settings require specification of parameter order or initial parameters in the form of a structure"); + endif + endif + pord = pord(:); + if (pin_struct && ! all (isfield (pin, pord))) + error ("some initial parameters lacking"); + endif + if ((nnames = rows (unique (pord))) < rows (pord)) + error ("duplicate parameter names in 'param_order'"); + endif + if (isempty (pdims)) + if (pin_struct) + pdims = cellfun \ + (@ size, fields2cell (pin, pord), "UniformOutput", false); + else + pdims = num2cell (ones (nnames, 2), 2); + endif + else + pdims = pdims(:); + if (pin_struct && \ + ! all (cellfun (@ (x, y) prod (size (x)) == prod (y), \ + struct2cell (pin), pdims))) + error ("given param_dims and dimensions of initial parameters do not match"); + endif + endif + if (nnames != rows (pdims)) + error ("lengths of 'param_order' and 'param_dims' not equal"); + endif + pnel = cellfun (@ prod, pdims); + ppartidx = pnel; + if (any (pnel > 1)) + pnonscalar = true; + cpnel = num2cell (pnel); + prepidx = cat (1, cellfun \ + (@ (x, n) x(ones (1, n), 1), \ + num2cell ((1:nnames).'), cpnel, \ + "UniformOutput", false){:}); + epord = pord(prepidx, 1); + psubidx = cat (1, cellfun \ + (@ (n) (1:n).', cpnel, \ + "UniformOutput", false){:}); + else + pnonscalar = false; # some less expensive interfaces later + prepidx = (1:nnames).'; + epord = pord; + psubidx = ones (nnames, 1); + endif + else + pord = []; # spares checks for given but not needed + endif + + if (pin_struct) + np = sum (pnel); + else + np = length (pin); + if (! isempty (pord) && np != sum (pnel)) + error ("number of initial parameters not correct"); + endif + endif + + plabels = num2cell (num2cell ((1:np).')); + if (! isempty (pord)) + plabels = cat (2, plabels, num2cell (epord), \ + num2cell (num2cell (psubidx))); + endif + + ## some useful vectors + zerosvec = zeros (np, 1); + NAvec = NA (np, 1); + Infvec = Inf (np, 1); + falsevec = false (np, 1); + sizevec = [np, 1]; + + ## collect parameter-related configuration + if (! isempty (pconf)) + ## use supplied configuration structure + + ## parameter-related configuration is either allowed by a structure + ## or by vectors + if (any_vector_conf) + error ("if param_config is given, its potential items must not \ + be configured in another way"); + endif + + ## supplement parameter names lacking in param_config + nidx = ! isfield (pconf, pord); + pconf = cell2fields ({struct()}(ones (1, sum (nidx))), \ + pord(nidx), 2, pconf); + + pconf = structcat (1, fields2cell (pconf, pord){:}); + + ## in the following, use reshape with explicit dimensions (instead + ## of x(:)) so that errors are thrown if a configuration item has + ## incorrect number of elements + + lbound = - Infvec; + if (isfield (pconf, "lbound")) + idx = ! fieldempty (pconf, "lbound"); + if (pnonscalar) + lbound (idx(prepidx), 1) = \ + cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).lbound}.', \ + cpnel(idx), "UniformOutput", false){:}); + else + lbound(idx, 1) = cat (1, pconf.lbound); + endif + endif + + ubound = Infvec; + if (isfield (pconf, "ubound")) + idx = ! fieldempty (pconf, "ubound"); + if (pnonscalar) + ubound (idx(prepidx), 1) = \ + cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).ubound}.', \ + cpnel(idx), "UniformOutput", false){:}); + else + ubound(idx, 1) = cat (1, pconf.ubound); + endif + endif + + max_fract_change = fract_prec = NAvec; + + if (isfield (pconf, "max_fract_change")) + idx = ! fieldempty (pconf, "max_fract_change"); + if (pnonscalar) + max_fract_change(idx(prepidx)) = \ + cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).max_fract_change}.', \ + cpnel(idx), \ + "UniformOutput", false){:}); + else + max_fract_change(idx) = [pconf.max_fract_change]; + endif + endif + + if (isfield (pconf, "fract_prec")) + idx = ! fieldempty (pconf, "fract_prec"); + if (pnonscalar) + fract_prec(idx(prepidx)) = \ + cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).fract_prec}.', cpnel(idx), \ + "UniformOutput", false){:}); + else + fract_prec(idx) = [pconf.fract_prec]; + endif + endif + + diffp = zerosvec; + diffp(:) = diffp_default; + if (isfield (pconf, "diffp")) + idx = ! fieldempty (pconf, "diffp"); + if (pnonscalar) + diffp(idx(prepidx)) = \ + cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).diffp}.', cpnel(idx), \ + "UniformOutput", false){:}); + else + diffp(idx) = [pconf.diffp]; + endif + endif + + diff_onesided = fixed = falsevec; + + if (isfield (pconf, "diff_onesided")) + idx = ! fieldempty (pconf, "diff_onesided"); + if (pnonscalar) + diff_onesided(idx(prepidx)) = \ + logical \ + (cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).diff_onesided}.', cpnel(idx), \ + "UniformOutput", false){:})); + else + diff_onesided(idx) = logical ([pconf.diff_onesided]); + endif + endif + + if (isfield (pconf, "fixed")) + idx = ! fieldempty (pconf, "fixed"); + if (pnonscalar) + fixed(idx(prepidx)) = \ + logical \ + (cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).fixed}.', cpnel(idx), \ + "UniformOutput", false){:})); + else + fixed(idx) = logical ([pconf.fixed]); + endif + endif + else + ## use supplied configuration vectors + + if (isempty (lbound)) + lbound = - Infvec; + elseif (any (size (lbound) != sizevec)) + error ("bounds: wrong dimensions"); + endif + + if (isempty (ubound)) + ubound = Infvec; + elseif (any (size (ubound) != sizevec)) + error ("bounds: wrong dimensions"); + endif + + if (isempty (max_fract_change)) + max_fract_change = NAvec; + elseif (any (size (max_fract_change) != sizevec)) + error ("max_fract_change: wrong dimensions"); + endif + + if (isempty (fract_prec)) + fract_prec = NAvec; + elseif (any (size (fract_prec) != sizevec)) + error ("fract_prec: wrong dimensions"); + endif + + if (isempty (diffp)) + diffp = zerosvec; + diffp(:) = diffp_default; + else + if (any (size (diffp) != sizevec)) + error ("diffp: wrong dimensions"); + endif + diffp(isna (diffp)) = diffp_default; + endif + + if (isempty (diff_onesided)) + diff_onesided = falsevec; + else + if (any (size (diff_onesided) != sizevec)) + error ("diff_onesided: wrong dimensions") + endif + diff_onesided(isna (diff_onesided)) = false; + diff_onesided = logical (diff_onesided); + endif + + if (isempty (fixed)) + fixed = falsevec; + else + if (any (size (fixed) != sizevec)) + error ("fixed: wrong dimensions"); + endif + fixed(isna (fixed)) = false; + fixed = logical (fixed); + endif + endif + + ## guaranty all (lbound <= ubound) + if (any (lbound > ubound)) + error ("some lower bounds larger than upper bounds"); + endif + + #### consider whether initial parameters and functions are based on + #### parameter structures or parameter vectors; wrappers for call to + #### default function for jacobians + + ## initial parameters + if (pin_struct) + if (pnonscalar) + pin = cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + fields2cell (pin, pord), cpnel, \ + "UniformOutput", false){:}); + else + pin = cat (1, fields2cell (pin, pord){:}); + endif + endif + + ## model function + if (f_pstruct) + if (pnonscalar) + f = @ (p, varargin) \ + f (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1), varargin{:}); + else + f = @ (p, varargin) \ + f (cell2struct (num2cell (p), pord, 1), varargin{:}); + endif + endif + f_pin = f (pin); + if (isfield (hook, "observations")) + if (any (size (f_pin) != size (obs = hook.observations))) + error ("dimensions of observations and values of model function must match"); + endif + f = @ (p) f (p) - obs; + f_pin -= obs; + endif + + ## jacobian of model function + if (isempty (dfdp)) + if (do_cstep) + dfdp = @ (p, hook) jacobs (p, f, hook); + else + dfdp = @ (p, hook) __dfdp__ (p, f, hook); + endif + endif + if (dfdp_pstruct) + if (pnonscalar) + dfdp = @ (p, hook) \ + cat (2, \ + fields2cell \ + (dfdp (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1), hook), \ + pord){:}); + else + dfdp = @ (p, hook) \ + cat (2, \ + fields2cell \ + (dfdp (cell2struct (num2cell (p), pord, 1), hook), \ + pord){:}); + endif + endif + + ## function for general inequality constraints + if (f_inequc_pstruct) + if (pnonscalar) + f_genicstr = @ (p, varargin) \ + f_genicstr (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1), varargin{:}); + else + f_genicstr = @ (p, varargin) \ + f_genicstr \ + (cell2struct (num2cell (p), pord, 1), varargin{:}); + endif + endif + + ## note this stage + possibly_pstruct_f_genicstr = f_genicstr; + + ## jacobian of general inequality constraints + if (df_inequc_pstruct) + if (pnonscalar) + df_gencstr = @ (p, func, idx, hook) \ + cat (2, \ + fields2cell \ + (df_gencstr \ + (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), pord, 1), \ + func, idx, hook), \ + pord){:}); + else + df_gencstr = @ (p, func, idx, hook) \ + cat (2, \ + fields2cell \ + (df_gencstr (cell2struct (num2cell (p), pord, 1), \ + func, idx, hook), \ + pord){:}); + endif + endif + + ## function for general equality constraints + if (f_equc_pstruct) + if (pnonscalar) + f_genecstr = @ (p, varargin) \ + f_genecstr (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1), varargin{:}); + else + f_genecstr = @ (p, varargin) \ + f_genecstr \ + (cell2struct (num2cell (p), pord, 1), varargin{:}); + endif + endif + + ## note this stage + possibly_pstruct_f_genecstr = f_genecstr; + + ## jacobian of general equality constraints + if (df_equc_pstruct) + if (pnonscalar) + df_genecstr = @ (p, func, idx, hook) \ + cat (2, \ + fields2cell \ + (df_genecstr \ + (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), pord, 1), \ + func, idx, hook), \ + pord){:}); + else + df_genecstr = @ (p, func, idx, hook) \ + cat (2, \ + fields2cell \ + (df_genecstr (cell2struct (num2cell (p), pord, 1), \ + func, idx, hook), \ + pord){:}); + endif + endif + + ## linear inequality constraints + if (mc_struct) + idx = isfield (mc, pord); + if (rows (fieldnames (mc)) > sum (idx)) + error ("unknown fields in structure of linear inequality constraints"); + endif + smc = mc; + mc = zeros (np, rows (vc)); + mc(idx(prepidx), :) = cat (1, fields2cell (smc, pord(idx)){:}); + endif + + ## linear equality constraints + if (emc_struct) + idx = isfield (emc, pord); + if (rows (fieldnames (emc)) > sum (idx)) + error ("unknown fields in structure of linear equality constraints"); + endif + semc = emc; + emc = zeros (np, rows (evc)); + emc(idx(prepidx), :) = cat (1, fields2cell (semc, pord(idx)){:}); + endif + + ## parameter-related configuration for jacobian functions + if (dfdp_pstruct || df_inequc_pstruct || df_equc_pstruct) + if(pnonscalar) + s_diffp = cell2struct \ + (cellfun (@ reshape, mat2cell (diffp, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + s_diff_onesided = cell2struct \ + (cellfun (@ reshape, mat2cell (diff_onesided, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + s_orig_lbound = cell2struct \ + (cellfun (@ reshape, mat2cell (lbound, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + s_orig_ubound = cell2struct \ + (cellfun (@ reshape, mat2cell (ubound, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + s_plabels = cell2struct \ + (num2cell \ + (cat (2, cellfun \ + (@ (x) cellfun \ + (@ reshape, mat2cell (cat (1, x{:}), ppartidx), \ + pdims, "UniformOutput", false), \ + num2cell (plabels, 1), "UniformOutput", false){:}), \ + 2), \ + pord, 1); + s_orig_fixed = cell2struct \ + (cellfun (@ reshape, mat2cell (fixed, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + else + s_diffp = cell2struct (num2cell (diffp), pord, 1); + s_diff_onesided = cell2struct (num2cell (diff_onesided), pord, 1); + s_orig_lbound = cell2struct (num2cell (lbound), pord, 1); + s_orig_ubound = cell2struct (num2cell (ubound), pord, 1); + s_plabels = cell2struct (num2cell (plabels, 2), pord, 1); + s_orig_fixed = cell2struct (num2cell (fixed), pord, 1); + endif + endif + + #### some further values and checks + + if (any (fixed & (pin < lbound | pin > ubound))) + warning ("some fixed parameters outside bounds"); + endif + + ## dimensions of linear constraints + if (isempty (mc)) + mc = zeros (np, 0); + vc = zeros (0, 1); + endif + if (isempty (emc)) + emc = zeros (np, 0); + evc = zeros (0, 1); + endif + [rm, cm] = size (mc); + [rv, cv] = size (vc); + if (rm != np || cm != rv || cv != 1) + error ("linear inequality constraints: wrong dimensions"); + endif + [erm, ecm] = size (emc); + [erv, ecv] = size (evc); + if (erm != np || ecm != erv || ecv != 1) + error ("linear equality constraints: wrong dimensions"); + endif + + ## check weights dimensions + weights = optimget (settings, "weights", ones (size (f_pin))); + if (any (size (weights) != size (f_pin))) + error ("dimension of weights and residuals must match"); + endif + + ## note initial values of linear constraits + pin_cstr.inequ.lin_except_bounds = mc.' * pin + vc; + pin_cstr.equ.lin = emc.' * pin + evc; + + ## note number and initial values of general constraints + if (isempty (f_genicstr)) + pin_cstr.inequ.gen = []; + n_genicstr = 0; + else + n_genicstr = length (pin_cstr.inequ.gen = f_genicstr (pin)); + endif + if (isempty (f_genecstr)) + pin_cstr.equ.gen = []; + n_genecstr = 0; + else + n_genecstr = length (pin_cstr.equ.gen = f_genecstr (pin)); + endif + + #### collect remaining settings + hook.TolFun = optimget (settings, "TolFun", stol_default); + hook.MaxIter = optimget (settings, "MaxIter"); + if (ischar (hook.cpiv = optimget (settings, "cpiv", @ cpiv_bard))) + hook.cpiv = str2func (hook.cpiv); + endif + hook.Display = optimget (settings, "Display", "off"); + hook.plot_cmd = optimget (settings, "plot_cmd", @ (f) 0); + hook.testing = optimget (settings, "debug", false); + hook.new_s = optimget (settings, "lm_svd_feasible_alt_s", false); + backend = optimget (settings, "Algorithm", "lm_svd_feasible"); + backend = map_matlab_algorithm_names (backend); + backend = map_backend (backend); + + #### handle fixing of parameters + orig_lbound = lbound; + orig_ubound = ubound; + orig_fixed = fixed; + if (all (fixed)) + error ("no free parameters"); + endif + + nonfixed = ! fixed; + if (any (fixed)) + ## backend (returned values and initial parameters) + backend = @ (f, pin, hook) \ + backend_wrapper (backend, fixed, f, pin, hook); + + ## model function + f = @ (p, varargin) f (assign (pin, nonfixed, p), varargin{:}); + + ## jacobian of model function + dfdp = @ (p, hook) \ + dfdp (assign (pin, nonfixed, p), hook)(:, nonfixed); + + ## function for general inequality constraints + f_genicstr = @ (p, varargin) \ + f_genicstr (assign (pin, nonfixed, p), varargin{:}); + + ## jacobian of general inequality constraints + df_gencstr = @ (p, func, idx, hook) \ + df_gencstr (assign (pin, nonfixed, p), func, idx, hook) \ + (:, nonfixed); + + ## function for general equality constraints + f_genecstr = @ (p, varargin) \ + f_genecstr (assign (pin, nonfixed, p), varargin{:}); + + ## jacobian of general equality constraints + df_genecstr = @ (p, func, idx, hook) \ + df_genecstr (assign (pin, nonfixed, p), func, idx, hook) \ + (:, nonfixed); + + ## linear inequality constraints + vc += mc(fixed, :).' * (tp = pin(fixed)); + mc = mc(nonfixed, :); + + ## linear equality constraints + evc += emc(fixed, :).' * tp; + emc = emc(nonfixed, :); + + ## _last_ of all, vectors of parameter-related configuration, + ## including "fixed" itself + lbound = lbound(nonfixed, :); + ubound = ubound(nonfixed, :); + max_fract_change = max_fract_change(nonfixed); + fract_prec = fract_prec(nonfixed); + fixed = fixed(nonfixed); + endif + + #### supplement constants to jacobian functions + + ## jacobian of model function + if (dfdp_pstruct) + dfdp = @ (p, hook) \ + dfdp (p, cell2fields \ + ({s_diffp, s_diff_onesided, s_orig_lbound, \ + s_orig_ubound, s_plabels, \ + cell2fields(num2cell(hook.fixed), pord(nonfixed), \ + 1, s_orig_fixed), cstep}, \ + {"diffp", "diff_onesided", "lbound", "ubound", \ + "plabels", "fixed", "h"}, \ + 2, hook)); + else + dfdp = @ (p, hook) \ + dfdp (p, cell2fields \ + ({diffp, diff_onesided, orig_lbound, orig_ubound, \ + plabels, assign(orig_fixed, nonfixed, hook.fixed), \ + cstep}, \ + {"diffp", "diff_onesided", "lbound", "ubound", \ + "plabels", "fixed", "h"}, \ + 2, hook)); + endif + + ## jacobian of general inequality constraints + if (df_inequc_pstruct) + df_gencstr = @ (p, func, idx, hook) \ + df_gencstr (p, func, idx, cell2fields \ + ({s_diffp, s_diff_onesided, s_orig_lbound, \ + s_orig_ubound, s_plabels, \ + cell2fields(num2cell(hook.fixed), pord(nonfixed), \ + 1, s_orig_fixed), cstep}, \ + {"diffp", "diff_onesided", "lbound", "ubound", \ + "plabels", "fixed", "h"}, \ + 2, hook)); + else + df_gencstr = @ (p, func, idx, hook) \ + df_gencstr (p, func, idx, cell2fields \ + ({diffp, diff_onesided, orig_lbound, \ + orig_ubound, plabels, \ + assign(orig_fixed, nonfixed, hook.fixed), cstep}, \ + {"diffp", "diff_onesided", "lbound", "ubound", \ + "plabels", "fixed", "h"}, \ + 2, hook)); + endif + + ## jacobian of general equality constraints + if (df_equc_pstruct) + df_genecstr = @ (p, func, idx, hook) \ + df_genecstr (p, func, idx, cell2fields \ + ({s_diffp, s_diff_onesided, s_orig_lbound, \ + s_orig_ubound, s_plabels, \ + cell2fields(num2cell(hook.fixed), pord(nonfixed), \ + 1, s_orig_fixed), cstep}, \ + {"diffp", "diff_onesided", "lbound", "ubound", \ + "plabels", "fixed", "h"}, \ + 2, hook)); + else + df_genecstr = @ (p, func, idx, hook) \ + df_genecstr (p, func, idx, cell2fields \ + ({diffp, diff_onesided, orig_lbound, \ + orig_ubound, plabels, \ + assign(orig_fixed, nonfixed, hook.fixed), cstep}, \ + {"diffp", "diff_onesided", "lbound", "ubound", \ + "plabels", "fixed", "h"}, \ + 2, hook)); + endif + + #### interfaces to constraints + + ## include bounds into linear inequality constraints + tp = eye (sum (nonfixed)); + lidx = lbound != - Inf; + uidx = ubound != Inf; + mc = cat (2, tp(:, lidx), - tp(:, uidx), mc); + vc = cat (1, - lbound(lidx, 1), ubound(uidx, 1), vc); + + ## concatenate linear inequality and equality constraints + mc = cat (2, mc, emc); + vc = cat (1, vc, evc); + n_lincstr = rows (vc); + + ## concatenate general inequality and equality constraints + if (n_genecstr > 0) + if (n_genicstr > 0) + nidxi = 1 : n_genicstr; + nidxe = n_genicstr + 1 : n_genicstr + n_genecstr; + f_gencstr = @ (p, idx, varargin) \ + cat (1, \ + f_genicstr (p, idx(nidxi), varargin{:}), \ + f_genecstr (p, idx(nidxe), varargin{:})); + df_gencstr = @ (p, idx, hook) \ + cat (1, \ + df_gencstr (p, @ (p, varargin) \ + possibly_pstruct_f_genicstr \ + (p, idx(nidxi), varargin{:}), \ + idx(nidxi), \ + setfield (hook, "f", \ + hook.f(nidxi(idx(nidxi))))), \ + df_genecstr (p, @ (p, varargin) \ + possibly_pstruct_f_genecstr \ + (p, idx(nidxe), varargin{:}), \ + idx(nidxe), \ + setfield (hook, "f", \ + hook.f(nidxe(idx(nidxe)))))); + else + f_gencstr = f_genecstr; + df_gencstr = @ (p, idx, hook) \ + df_genecstr (p, \ + @ (p, varargin) \ + possibly_pstruct_f_genecstr \ + (p, idx, varargin{:}), \ + idx, \ + setfield (hook, "f", hook.f(idx))); + endif + else + f_gencstr = f_genicstr; + df_gencstr = @ (p, idx, hook) \ + df_gencstr (p, \ + @ (p, varargin) \ + possibly_pstruct_f_genicstr (p, idx, varargin{:}), \ + idx, \ + setfield (hook, "f", hook.f(idx))); + endif + n_gencstr = n_genicstr + n_genecstr; + + ## concatenate linear and general constraints, defining the final + ## function interfaces + if (n_gencstr > 0) + nidxl = 1:n_lincstr; + nidxh = n_lincstr + 1 : n_lincstr + n_gencstr; + f_cstr = @ (p, idx, varargin) \ + cat (1, \ + mc(:, idx(nidxl)).' * p + vc(idx(nidxl), 1), \ + f_gencstr (p, idx(nidxh), varargin{:})); + df_cstr = @ (p, idx, hook) \ + cat (1, \ + mc(:, idx(nidxl)).', \ + df_gencstr (p, idx(nidxh), \ + setfield (hook, "f", \ + hook.f(nidxh)))); + else + f_cstr = @ (p, idx, varargin) mc(:, idx).' * p + vc(idx, 1); + df_cstr = @ (p, idx, hook) mc(:, idx).'; + endif + + ## define eq_idx (logical index of equality constraints within all + ## concatenated constraints + eq_idx = false (n_lincstr + n_gencstr, 1); + eq_idx(n_lincstr + 1 - rows (evc) : n_lincstr) = true; + n_cstr = n_lincstr + n_gencstr; + eq_idx(n_cstr + 1 - n_genecstr : n_cstr) = true; + + #### prepare interface hook + + ## passed constraints + hook.mc = mc; + hook.vc = vc; + hook.f_cstr = f_cstr; + hook.df_cstr = df_cstr; + hook.n_gencstr = n_gencstr; + hook.eq_idx = eq_idx; + hook.lbound = lbound; + hook.ubound = ubound; + + ## passed values of constraints for initial parameters + hook.pin_cstr = pin_cstr; + + ## passed function for derivative of model function + hook.dfdp = dfdp; + + ## passed function for complementary pivoting + ## hook.cpiv = cpiv; # set before + + ## passed value of residual function for initial parameters + hook.f_pin = f_pin; + + ## passed options + hook.max_fract_change = max_fract_change; + hook.fract_prec = fract_prec; + ## hook.TolFun = ; # set before + ## hook.MaxIter = ; # set before + hook.weights = weights; + hook.fixed = fixed; + + #### call backend + + [p, resid, cvg, outp] = backend (f, pin, hook); + + if (pin_struct) + if (pnonscalar) + p = cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1); + else + p = cell2struct (num2cell (p), pord, 1); + endif + endif + +endfunction + +function backend = map_matlab_algorithm_names (backend) + + switch (backend) + case "levenberg-marquardt" + backend = "lm_svd_feasible"; + warning ("algorithm 'levenberg-marquardt' mapped to 'lm_svd_feasible'"); + endswitch + +endfunction + +function backend = map_backend (backend) + + switch (backend) + case "lm_svd_feasible" + backend = "__lm_svd__"; + otherwise + error ("no backend implemented for algorithm '%s'", backend); + endswitch + + backend = str2func (backend); + +endfunction + +function [p, resid, cvg, outp] = backend_wrapper (backend, fixed, f, p, hook) + + [tp, resid, cvg, outp] = backend (f, p(! fixed), hook); + + p(! fixed) = tp; + +endfunction + +function lval = assign (lval, lidx, rval) + + lval(lidx) = rval; + +endfunction + +function ret = __optimget__ (s, name, default) + + if (isfield (s, name)) + ret = s.(name); + elseif (nargin > 2) + ret = default; + else + ret = []; + endif + +endfunction + +function ret = apply_idx_if_given (ret, varargin) + + if (nargin > 1) + ret = ret(varargin{1}); + endif + +endfunction diff --git a/octave_packages/optim-1.2.0/private/__null_optim__.m b/octave_packages/optim-1.2.0/private/__null_optim__.m new file mode 100644 index 0000000..9af7c6f --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__null_optim__.m @@ -0,0 +1,120 @@ +## Copyright (C) 1994-2011 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- 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 +## Adapted-By: Olaf Till + +## This function has also been submitted to Octave (bug #33503). + +function retval = __null_optim__ (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)) * (vtol = s (1) * (meps = eps ("single"))); + else + tol = max (size (A)) * (vtol = s (1) * (meps = eps)); + endif + elseif (nargin != 2) + print_usage (); + endif + + rank = sum (s > tol); + + if (rank < cols) + retval = V (:, rank+1:cols); + + if (rows >= cols) + cb = columns (retval); + + ## Set those elements of each vector to zero whose absolute + ## values are smallest and which together could be zero without + ## making the angle to the originally computed vector larger + ## than given by the error bound. Do this in an approximative + ## but numerically feasible way. + + ## error bounds of basis vectors in radians, see LAPACK user + ## guide, http://www.netlib.org/lapack/lug/node96.html + if (true) # test for Octave version once submitted patch is applied + # to Octave (bug #33503) + __disna__ = @ __disna_optim__; + endif + ebnd = vtol ./ (__disna__ ("R", s, rows, cols)(rank+1:cols)); + + ## sort elements by magnitude + sb = conj (retval) .* retval; + [sb, idx] = sort (sb); + idx += repmat (0:cols:cols*(cb-1), cols, 1); # for un-sorting + + ## norms of vectors made by all elements up to this + sb = sqrt (cumsum (sb)); + + ## The norm of the vectors made up by elements settable to zero + ## is small enough to be approximately equal to the angle + ## between the full vectors before and after setting these + ## elements to zero (considering the norms of the full vectors + ## being 1). Index of approximated angles not exceeding error + ## bound. + zidx = sb <= repmat (ebnd, cols, 1); + + ## set indexed elements to zero in original basis + zidx = zidx(idx); + retval(zidx) = 0; + + else + ## no error bounds computable with LAPACK + + retval(abs (retval) < meps) = 0; + endif + else + retval = zeros (cols, 0); + endif + endif + +endfunction diff --git a/octave_packages/optim-1.2.0/private/__plot_cmds__.m b/octave_packages/optim-1.2.0/private/__plot_cmds__.m new file mode 100644 index 0000000..901052a --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__plot_cmds__.m @@ -0,0 +1,50 @@ +%% Copyright (C) 2010, 2011 Olaf Till +%% +%% This program is free software; you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation; either version 3 of the License, or +%% (at your option) any later version. +%% +%% This program is distributed in the hope that it will be useful, +%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%% GNU General Public License for more details. +%% +%% You should have received a copy of the GNU General Public License +%% along with this program; If not, see . + +function __plot_cmds__ (x, y, f) + + persistent lgnd; + persistent use_x; + if (nargin == 0) + %% reset function + lgnd = []; + return; + end + + if (length (size (f)) > 2) + return; + end + + if (isempty (lgnd)); + n = size (y, 2); + if (n == 1) + lgnd = {'data', 'fit'}; + else + id = num2str ((1:n).'); + lgnd1 = cat (2, repmat ('data ', n, 1), id); + lgnd2 = cat (2, repmat ('fit ', n, 1), id); + lgnd = cat (1, cellstr (lgnd1), cellstr (lgnd2)); + end + use_x = size (x, 1) == size (y, 1); + end + + x = x(:, 1); + if (use_x) + plot (x, y, 'marker', '+', 'linestyle', 'none', x, f); + else + plot (y, 'marker', '+', 'linestyle', 'none', f); + end + legend (lgnd); + drawnow; diff --git a/octave_packages/optim-1.2.0/private/__residmin_stat__.m b/octave_packages/optim-1.2.0/private/__residmin_stat__.m new file mode 100644 index 0000000..6225cfc --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__residmin_stat__.m @@ -0,0 +1,621 @@ +## Copyright (C) 2011 Olaf Till +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## Internal function, called by residmin_stat --- see there --- and +## others. Calling __residmin_stat__ indirectly hides the argument +## "hook", usable by wrappers, from users. Currently, hook can contain +## the field "observations". Since much uf the interface code is taken +## from __nonlin_residmin__, it may be that not everything is ideal for +## the present case; but I think it's allright to leave it so. +## +## Some general considerations while making this function: +## +## Different Functions for optimization statistics should be made for +## mere objective function optimization (to be made yet) and +## residual-derived minimization (this function), since there are +## different computing aspects. Don't put the contained functionality +## (statistics) into the respective optimization functions (or +## backends), since different optimization algorithms can share a way to +## compute statistics (e.g. even stochastic optimizers can mimize +## (weighted) squares of residuals). Also, don't use the same frontend +## for optimization and statistics, since the differences in the +## interface for both uses may be confusing otherwise, also the optimset +## options only partially overlap. + +## disabled PKG_ADD: __all_opts__ ("__residmin_stat__"); + +function ret = __residmin_stat__ (f, pfin, settings, hook) + + if (compare_versions (version (), "3.3.55", "<")) + ## optimset mechanism was fixed for option names with underscores + ## sometime in 3.3.54+, if I remember right + optimget = @ __optimget__; + endif + + ## scalar defaults + diffp_default = .001; + cstep_default = 1e-20; + + if (nargin == 1 && ischar (f) && strcmp (f, "defaults")) + ret = optimset ("param_config", [], \ + "param_order", [], \ + "param_dims", [], \ + "f_pstruct", false, \ + "dfdp_pstruct", false, \ + "dfdp", [], \ + "diffp", [], \ + "diff_onesided", [], \ + "complex_step_derivative", false, \ + "cstep", cstep_default, \ + "fixed", [], \ + "weights", [], \ + "residuals", [], \ + "covd", [], \ + "objf", [], \ # no default, e.g. "wls" + "ret_dfdp", false, \ + "ret_covd", false, \ + "ret_covp", false, \ + "ret_corp", false); + return; + endif + + assign = @ assign; # Is this faster in repeated calls? + + if (nargin != 4) + error ("incorrect number of arguments"); + endif + + if (ischar (f)) + f = str2func (f); + endif + + if (! (p_struct = isstruct (pfin))) + if (! isempty (pfin) && (! isvector (pfin) || columns (pfin) > 1)) + error ("parameters must be either a structure or a column vector"); + endif + endif + + #### processing of settings and consistency checks + + pconf = optimget (settings, "param_config"); + pord = optimget (settings, "param_order"); + pdims = optimget (settings, "param_dims"); + f_pstruct = optimget (settings, "f_pstruct", false); + dfdp_pstruct = optimget (settings, "dfdp_pstruct", f_pstruct); + dfdp = optimget (settings, "dfdp"); + if (ischar (dfdp)) dfdp = str2func (dfdp); endif + if (isstruct (dfdp)) dfdp_pstruct = true; endif + diffp = optimget (settings, "diffp"); + diff_onesided = optimget (settings, "diff_onesided"); + fixed = optimget (settings, "fixed"); + residuals = optimget (settings, "residuals"); + do_cstep = optimget (settings, "complex_step_derivative", false); + cstep = optimget (settings, "cstep", cstep_default); + if (do_cstep && ! isempty (dfdp)) + error ("both 'complex_step_derivative' and 'dfdp' are set"); + endif + + any_vector_conf = ! (isempty (diffp) && isempty (diff_onesided) && \ + isempty (fixed)); + + ## correct "_pstruct" settings if functions are not supplied + if (isempty (dfdp)) dfdp_pstruct = false; endif + if (isempty (f)) f_pstruct = false; endif + + ## some settings require a parameter order + if (p_struct || ! isempty (pconf) || f_pstruct || dfdp_pstruct) + if (isempty (pord)) + if (p_struct) + if (any_vector_conf || \ + ! ((f_pstruct || isempty (f)) && \ + (dfdp_pstruct || isempty (dfdp)))) + error ("no parameter order specified and constructing a parameter order from the structure of parameters can not be done since not all configuration or given functions are structure based"); + else + pord = fieldnames (pfin); + endif + else + error ("given settings require specification of parameter order or parameters in the form of a structure"); + endif + endif + pord = pord(:); + if (p_struct && ! all (isfield (pfin, pord))) + error ("some parameters lacking"); + endif + if ((nnames = rows (unique (pord))) < rows (pord)) + error ("duplicate parameter names in 'param_order'"); + endif + if (isempty (pdims)) + if (p_struct) + pdims = cellfun \ + (@ size, fields2cell (pfin, pord), "UniformOutput", false); + else + pdims = num2cell (ones (nnames, 2), 2); + endif + else + pdims = pdims(:); + if (p_struct && \ + ! all (cellfun (@ (x, y) prod (size (x)) == prod (y), \ + struct2cell (pfin), pdims))) + error ("given param_dims and dimensions of parameters do not match"); + endif + endif + if (nnames != rows (pdims)) + error ("lengths of 'param_order' and 'param_dims' not equal"); + endif + pnel = cellfun (@ prod, pdims); + ppartidx = pnel; + if (any (pnel > 1)) + pnonscalar = true; + cpnel = num2cell (pnel); + prepidx = cat (1, cellfun \ + (@ (x, n) x(ones (1, n), 1), \ + num2cell ((1:nnames).'), cpnel, \ + "UniformOutput", false){:}); + epord = pord(prepidx, 1); + psubidx = cat (1, cellfun \ + (@ (n) (1:n).', cpnel, \ + "UniformOutput", false){:}); + else + pnonscalar = false; # some less expensive interfaces later + prepidx = (1:nnames).'; + epord = pord; + psubidx = ones (nnames, 1); + endif + else + pord = []; # spares checks for given but not needed + endif + + if (p_struct) + np = sum (pnel); + else + np = length (pfin); + if (! isempty (pord) && np != sum (pnel)) + error ("number of initial parameters not correct"); + endif + endif + if (ismatrix (dfdp) && ! ischar (dfdp) && ! isempty (dfdp) && \ + np == 0) + np = columns (dfdp); + endif + + plabels = num2cell (num2cell ((1:np).')); + if (! isempty (pord)) + plabels = cat (2, plabels, num2cell (epord), \ + num2cell (num2cell (psubidx))); + endif + + ## some useful vectors + zerosvec = zeros (np, 1); + falsevec = false (np, 1); + sizevec = [np, 1]; + + ## collect parameter-related configuration + if (! isempty (pconf)) + ## use supplied configuration structure + + ## parameter-related configuration is either allowed by a structure + ## or by vectors + if (any_vector_conf) + error ("if param_config is given, its potential items must not \ + be configured in another way"); + endif + + ## supplement parameter names lacking in param_config + nidx = ! isfield (pconf, pord); + pconf = cell2fields ({struct()}(ones (1, sum (nidx))), \ + pord(nidx), 2, pconf); + + pconf = structcat (1, fields2cell (pconf, pord){:}); + + ## in the following, use reshape with explicit dimensions (instead + ## of x(:)) so that errors are thrown if a configuration item has + ## incorrect number of elements + + diffp = zerosvec; + diffp(:) = diffp_default; + if (isfield (pconf, "diffp")) + idx = ! fieldempty (pconf, "diffp"); + if (pnonscalar) + diffp(idx(prepidx)) = \ + cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).diffp}.', cpnel(idx), \ + "UniformOutput", false){:}); + else + diffp(idx) = [pconf.diffp]; + endif + endif + + diff_onesided = fixed = falsevec; + + if (isfield (pconf, "diff_onesided")) + idx = ! fieldempty (pconf, "diff_onesided"); + if (pnonscalar) + diff_onesided(idx(prepidx)) = \ + logical \ + (cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).diff_onesided}.', cpnel(idx), \ + "UniformOutput", false){:})); + else + diff_onesided(idx) = logical ([pconf.diff_onesided]); + endif + endif + + if (isfield (pconf, "fixed")) + idx = ! fieldempty (pconf, "fixed"); + if (pnonscalar) + fixed(idx(prepidx)) = \ + logical \ + (cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + {pconf(idx).fixed}.', cpnel(idx), \ + "UniformOutput", false){:})); + else + fixed(idx) = logical ([pconf.fixed]); + endif + endif + else + ## use supplied configuration vectors + + if (isempty (diffp)) + diffp = zerosvec; + diffp(:) = diffp_default; + else + if (any (size (diffp) != sizevec)) + error ("diffp: wrong dimensions"); + endif + diffp(isna (diffp)) = diffp_default; + endif + + if (isempty (diff_onesided)) + diff_onesided = falsevec; + else + if (any (size (diff_onesided) != sizevec)) + error ("diff_onesided: wrong dimensions") + endif + diff_onesided(isna (diff_onesided)) = false; + diff_onesided = logical (diff_onesided); + endif + + if (isempty (fixed)) + fixed = falsevec; + else + if (any (size (fixed) != sizevec)) + error ("fixed: wrong dimensions"); + endif + fixed(isna (fixed)) = false; + fixed = logical (fixed); + endif + endif + + #### consider whether parameters and functions are based on parameter + #### structures or parameter vectors; wrappers for call to default + #### function for jacobians + + ## parameters + if (p_struct) + if (pnonscalar) + pfin = cat (1, cellfun (@ (x, n) reshape (x, n, 1), \ + fields2cell (pfin, pord), cpnel, \ + "UniformOutput", false){:}); + else + pfin = cat (1, fields2cell (pfin, pord){:}); + endif + endif + + ## model function + if (f_pstruct) + if (pnonscalar) + f = @ (p, varargin) \ + f (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1), varargin{:}); + else + f = @ (p, varargin) \ + f (cell2struct (num2cell (p), pord, 1), varargin{:}); + endif + endif + if (isempty (residuals)) + if (isempty (f)) + error ("neither model function nor residuals given"); + endif + residuals = f (pfin); + endif + if (isfield (hook, "observations")) + if (any (size (residuals) != size (obs = hook.observations))) + error ("dimensions of observations and values of model function must match"); + endif + f = @ (p) f (p) - obs; + residuals -= obs; + endif + + ## jacobian of model function + if (isempty (dfdp)) + if (! isempty (f)) + if (do_cstep) + dfdp = @ (p, hook) jacobs (p, f, hook); + else + __dfdp__ = @ __dfdp__; # for bug #31484 (Octave <= 3.2.4) + dfdp = @ (p, hook) __dfdp__ (p, f, hook); + endif + endif + elseif (! isa (dfdp, "function_handle")) + if (ismatrix (dfdp)) + if (any (size (dfdp) != [prod(size(residuals)), np])) + error ("jacobian has wrong size"); + endif + elseif (! dfdp_pstruct) + error ("jacobian has wrong type"); + endif + dfdp = @ (varargin) dfdp; # simply make a function returning it + endif + if (dfdp_pstruct) + if (pnonscalar) + dfdp = @ (p, hook) \ + cat (2, \ + fields2cell \ + (dfdp (cell2struct \ + (cellfun (@ reshape, mat2cell (p, ppartidx), \ + pdims, "UniformOutput", false), \ + pord, 1), hook), \ + pord){:}); + else + dfdp = @ (p, hook) \ + cat (2, \ + fields2cell \ + (dfdp (cell2struct (num2cell (p), pord, 1), hook), \ + pord){:}); + endif + endif + + ## parameter-related configuration for jacobian function + if (dfdp_pstruct) + if(pnonscalar) + s_diffp = cell2struct \ + (cellfun (@ reshape, mat2cell (diffp, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + s_diff_onesided = cell2struct \ + (cellfun (@ reshape, mat2cell (diff_onesided, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + s_plabels = cell2struct \ + (num2cell \ + (cat (2, cellfun \ + (@ (x) cellfun \ + (@ reshape, mat2cell (cat (1, x{:}), ppartidx), \ + pdims, "UniformOutput", false), \ + num2cell (plabels, 1), "UniformOutput", false){:}), \ + 2), \ + pord, 1); + s_orig_fixed = cell2struct \ + (cellfun (@ reshape, mat2cell (fixed, ppartidx), \ + pdims, "UniformOutput", false), pord, 1); + else + s_diffp = cell2struct (num2cell (diffp), pord, 1); + s_diff_onesided = cell2struct (num2cell (diff_onesided), pord, 1); + s_plabels = cell2struct (num2cell (plabels, 2), pord, 1); + s_fixed = cell2struct (num2cell (fixed), pord, 1); + endif + endif + + #### further values and checks + + ## check weights dimensions + weights = optimget (settings, "weights", ones (size (residuals))); + if (any (size (weights) != size (residuals))) + error ("dimension of weights and residuals must match"); + endif + + + #### collect remaining settings + need_dfdp = false; + covd = optimget (settings, "covd"); + need_objf_label = false; + if ((ret_dfdp = optimget (settings, "ret_dfdp", false))) + need_dfdp = true; + endif + if ((ret_covd = optimget (settings, "ret_covd", false))) + need_objf_label = true; + if (np == 0) + error ("number of parameters must be known for 'covd', specify either parameters or a jacobian matrix"); + endif + endif + if ((ret_covp = optimget (settings, "ret_covp", false))) + need_objf_label = true; + need_dfdp = true; + endif + if ((ret_corp = optimget (settings, "ret_corp", false))) + need_objf_label = true; + need_dfdp = true; + endif + if (need_objf_label) + if (isempty (objf = optimget (settings, "objf"))) + error ("label of objective function must be specified"); + else + funs = map_objf (objf); + endif + else + funs = struct (); + endif + if (isempty (dfdp) && need_dfdp) + error ("jacobian required and default function for jacobian requires a model function"); + endif + + #### + + ## Everything which is computed is stored in a hook structure which is + ## passed to and returned by every backend function. This hook is not + ## identical to the returned structure, since some more results could + ## be computed by the way. + + #### handle fixing of parameters + + orig_p = pfin; + + if (all (fixed) && ! isempty (fixed)) + error ("no free parameters"); + endif + + ## The policy should be that everything which is computed is left as + ## it is up to the end --- since other computations might need it in + ## this form --- and supplemented with values corresponding to fixed + ## parameters (mostly NA, probably) not until then. + + nonfixed = ! fixed; + + np_after_fixing = sum (nonfixed); + + if (any (fixed)) + + if (! isempty (pfin)) + pfin = pfin(nonfixed); + endif + + ## model function + f = @ (p, varargin) f (assign (pfin, nonfixed, p), varargin{:}); + + ## jacobian of model function + if (! isempty (dfdp)) + dfdp = @ (p, hook) \ + dfdp (assign (pfin, nonfixed, p), hook)(:, nonfixed); + endif + + endif + + #### supplement constants to jacobian function + if (dfdp_pstruct) + dfdp = @ (p, hook) \ + dfdp (p, cell2fields \ + ({s_diffp, s_diff_onesided, s_plabels, s_fixed, cstep}, \ + {"diffp", "diff_onesided", "plabels", "fixed", "h"}, \ + 2, hook)); + else + if (! isempty (dfdp)) + dfdp = @ (p, hook) \ + dfdp (p, cell2fields \ + ({diffp, diff_onesided, plabels, fixed, cstep}, \ + {"diffp", "diff_onesided", "plabels", "fixed", "h"}, \ + 2, hook)); + endif + endif + + #### prepare interface hook + + ## passed final parameters of an optimization + hook.pfin = pfin; + + ## passed function for derivative of model function + hook.dfdp = dfdp; + + ## passed function for complementary pivoting + ## hook.cpiv = cpiv; # set before + + ## passed value of residual function for initial parameters + hook.residuals = residuals; + + ## passed weights + hook.weights = weights; + + ## passed dimensions + hook.np = np_after_fixing; + hook.nm = prod (size (residuals)); + + ## passed statistics functions + hook.funs = funs; + + ## passed covariance matrix of data (if given by user) + if (! isempty (covd)) + covd_dims = size (covd); + if (length (covd_dims) != 2 || any (covd_dims != hook.nm)) + error ("wrong dimensions of covariance matrix of data"); + endif + hook.covd = covd; + endif + + #### do the actual work + + if (ret_dfdp) + hook.jac = hook.dfdp (hook.pfin, hook); + endif + + if (ret_covd) + hook = funs.covd (hook); + endif + + if (ret_covp || ret_corp) + hook = funs.covp_corp (hook); + endif + + #### convert (consider fixing ...) and return results + + ret = struct (); + + if (ret_dfdp) + ret.dfdp = zeros (hook.nm, np); + ret.dfdp(:, nonfixed) = hook.jac; + endif + + if (ret_covd) + ret.covd = hook.covd; + endif + + if (ret_covp) + if (any (fixed)) + ret.covp = NA (np); + ret.covp(nonfixed, nonfixed) = hook.covp; + else + ret.covp = hook.covp; + endif + endif + + if (ret_corp) + if (any (fixed)) + ret.corp = NA (np); + ret.corp(nonfixed, nonfixed) = hook.corp; + else + ret.corp = hook.corp; + endif + endif + +endfunction + +function funs = map_objf (objf) + + switch (objf) + case "wls" # weighted least squares + funs.covd = str2func ("__covd_wls__"); + funs.covp_corp = str2func ("__covp_corp_wls__"); + otherwise + error ("no statistics implemented for objective function '%s'", \ + objf); + endswitch + +endfunction + +function lval = assign (lval, lidx, rval) + + lval(lidx) = rval; + +endfunction + +function ret = __optimget__ (s, name, default) + + if (isfield (s, name)) + ret = s.(name); + elseif (nargin > 2) + ret = default; + else + ret = []; + endif + +endfunction diff --git a/octave_packages/optim-1.2.0/private/__s2mat__.m b/octave_packages/optim-1.2.0/private/__s2mat__.m new file mode 100644 index 0000000..21ee031 --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__s2mat__.m @@ -0,0 +1,50 @@ +## Copyright (C) 2010 Olaf Till +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## __s2mat__ (s, ord) +## +## Returns a matrix of second derivatives with respect to some +## parameters from the structure-based representation of such a matrix +## in s, using the order of parameter names ord. s has to contain all +## fields named in ord. Each field has some subfields named in ord so +## that each second derivative is represented at least in one of its two +## possible orders. If it is represented differently in both orders, no +## error is returned, but both entries might get into the final matrix +## at symmetric positions. +## +## Should be included as a subfunction of a wrapper for optimization +## functions possibly needing a Hessian. + +function ret = __s2mat__ (s, ord) + + if (any (size (s) != [1, 1])) + error ("structure must be scalar"); + endif + + if (! (iscell (ord) && isvector (ord))) + error ("ord must be a one-dimensional cell-array"); + endif + + c = fields2cell (structcat (1, fields2cell (s, ord){:}), ord); + + neidx = ! (eidx = cellfun ("isempty", c)); + + ret = zeros (length (ord)); + + ret(neidx) = [c{neidx}]; # faster than [c{:}] ? + + ret(eidx) = ret.'(eidx); + +endfunction \ No newline at end of file diff --git a/octave_packages/optim-1.2.0/private/__siman__.m b/octave_packages/optim-1.2.0/private/__siman__.m new file mode 100644 index 0000000..c7b2820 --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__siman__.m @@ -0,0 +1,249 @@ +## Copyright (C) 2012 Olaf Till +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## The simulated annealing code is translated and adapted from siman.c, +## written by Mark Galassi, of the GNU Scientific Library. + +function [p_res, objf, cvg, outp] = __siman__ (f, pin, hook) + + ## needed for some anonymous functions + if (exist ("ifelse") != 5) + ifelse = @ scalar_ifelse; + endif + + ## passed constraints + mc = hook.mc; # matrix of linear constraints + vc = hook.vc; # vector of linear constraints + f_cstr = hook.f_cstr; # function of all constraints + df_cstr = hook.df_cstr; # function of derivatives of all constraints + n_gencstr = hook.n_gencstr; # number of non-linear constraints + eq_idx = hook.eq_idx; # logical index of equality constraints in all + # constraints + lbound = hook.lbound; # bounds, subset of linear inequality + ubound = hook.ubound; # constraints in mc and vc + + ## passed values of constraints for initial parameters + pin_cstr = hook.pin_cstr; + + ## passed return value of f for initial parameters + f_pin = hook.f_pin; + + ## passed function for complementary pivoting, currently sqp is used + ## instead + ## + ## cpiv = hook.cpiv; + + ## passed simulated annealing parameters + T_init = hook.siman.T_init; + T_min = hook.siman.T_min; + mu_T = hook.siman.mu_T; + iters_fixed_T = hook.siman.iters_fixed_T; + max_rand_step = hook.max_rand_step; + + ## passed options + fixed = hook.fixed; + verbose = strcmp (hook.Display, "iter"); + regain_constraints = hook.stoch_regain_constr; + if ((siman_log = hook.siman_log)) + log = zeros (0, 5); + endif + if ((trace_steps = hook.trace_steps)) + trace = [0, 0, f_pin, pin.']; + endif + + ## some useful variables derived from passed variables + n = length (pin); + sqp_hessian = 2 * eye (n); + n_lconstr = length (vc); + n_bounds = sum (lbound != -Inf) + sum (ubound != Inf); + bidx = false (n_lconstr + n_gencstr, 1); + bidx(1 : n_bounds) = true; + ac_idx = true (n_lconstr + n_gencstr, 1); + ineq_idx = ! eq_idx; + leq_idx = eq_idx(1:n_lconstr); + lineq_idx = ineq_idx(1:n_lconstr); + lfalse_idx = false(n_lconstr, 1); + + nz = 20 * eps; # This is arbitrary. Accuracy of equality constraints. + + ## backend-specific checking of options and constraints + ## + ## equality constraints can not be met by chance + if ((any (eq_idx) || any (lbound == ubound)) && ! regain_constraints) + error ("If 'stoch_regain_constr' is not set, equality constraints or identical lower and upper bounds are not allowed by simulated annealing backend."); + endif + ## + if (any (pin < lbound | pin > ubound) || + any (pin_cstr.inequ.lin_except_bounds < 0) || + any (pin_cstr.inequ.gen < 0) || + any (abs (pin_cstr.equ.lin)) >= nz || + any (abs (pin_cstr.equ.gen)) >= nz) + error ("Initial parameters violate constraints."); + endif + ## + if (all (fixed)) + error ("no free parameters"); + endif + ## + idx = isna (max_rand_step); + max_rand_step(idx) = 0.005 * pin(idx); + + ## fill constant fields of hook for derivative-functions; some fields + ## may be backend-specific + dfdp_hook.fixed = fixed; # this may be handled by the frontend, but + # the backend still may add to it + + ## set up for iterations + sizep = size (pin); + p = best_p = pin; + E = best_E = f_pin; + T = T_init; + n_evals = 1; # one has been done by frontend + n_iter = 0; + done = false; + + cvg = 1; + + ## simulated annealing + while (! done) + + n_iter++; + + n_accepts = n_rejects = n_eless = 0; + + for id = 1 : iters_fixed_T + + new_p = p + max_rand_step .* (2 * rand (sizep) - 1); + + ## apply constraints + if (regain_constraints) + evidx = (abs ((ac = f_cstr (new_p, ac_idx))(eq_idx)) >= nz); + ividx = (ac(ineq_idx) < 0); + if (any (evidx) || any (ividx)) + nv = sum (evidx) + sum (ividx); + if (sum (lbvidx = (new_p < lbound)) + \ + sum (ubvidx = (new_p > ubound)) == \ + nv) + ## special case only bounds violated, set back to bound + new_p(lbvidx) = lbound(lbvidx); + new_p(ubvidx) = ubound(ubvidx); + elseif (nv == 1 && \ + sum (t_eq = (abs (ac(leq_idx)) >= nz)) + \ + sum (t_inequ = (ac(lineq_idx) < 0)) == 1) + ## special case only one linear constraint violated, set + ## back perpendicularly to constraint + tidx = lfalse_idx; + tidx(leq_idx) = t_eq; + tidx(lineq_idx) = t_inequ; + c = mc(:, tidx); + d = ac(tidx); + new_p -= c * (d / (c.' * c)); + else + ## other cases, set back keeping the distance to original + ## 'new_p' minimal, using quadratic programming, or + ## sequential quadratic programming for nonlinear + ## constraints + [new_p, discarded, sqp_info] = \ + sqp (new_p, \ + {@(x)sumsq(x-new_p), \ + @(x)2*(x-new_p), \ + @(x)sqp_hessian}, \ + {@(x)f_cstr(x,eq_idx), \ + @(x)df_cstr(x,eq_idx, \ + setfield(hook,"f", \ + f_cstr(x,ac_idx)))}, \ + {@(x)f_cstr(x,ineq_idx), \ + @(x)df_cstr(x,ineq_idx, \ + setfield(hook,"f", \ + f_cstr(x,ac_idx)))}); + if (sqp_info != 101) + cvg = 0; + done = true; + break; + endif + endif + endif + else + n_retry_constr = 0; + while (any (abs ((ac = f_cstr (new_p, ac_idx))(eq_idx)) >= nz) \ + || any (ac(ineq_idx) < 0)) + new_p = p + max_rand_step .* (2 * rand (sizep) - 1); + n_retry_constr++; + endwhile + if (verbose && n_retry_constr) + printf ("%i additional tries of random step to meet constraints\n", + n_retry_constr); + endif + endif + + new_E = f (new_p); + n_evals++; + + if (new_E < best_E) + best_p = new_p; + best_E = new_E; + endif + if (new_E < E) + ## take a step + p = new_p; + E = new_E; + n_eless++; + if (trace_steps) + trace(end + 1, :) = [n_iter, id, E, p.']; + endif + elseif (rand (1) < exp (- (new_E - E) / T)) + ## take a step + p = new_p; + E = new_E; + n_accepts++; + if (trace_steps) + trace(end + 1, :) = [n_iter, id, E, p.']; + endif + else + n_rejects++; + endif + + endfor # iters_fixed_T + + if (verbose) + printf ("temperature no. %i: %e, energy %e,\n", n_iter, T, E); + printf ("tries with energy less / not less but accepted / rejected:\n"); + printf ("%i / %i / %i\n", n_eless, n_accepts, n_rejects); + endif + + if (siman_log) + log(end + 1, :) = [T, E, n_eless, n_accepts, n_rejects]; + endif + + ## cooling + T /= mu_T; + if (T < T_min) + done = true; + endif + + endwhile + + ## return result + p_res = best_p; + objf = best_E; + outp.niter = n_iter; + if (trace_steps) + outp.trace = trace; + endif + if (siman_log) + outp.log = log; + endif + +endfunction diff --git a/octave_packages/optim-1.2.0/private/__sqp__.m b/octave_packages/optim-1.2.0/private/__sqp__.m new file mode 100644 index 0000000..5bf866c --- /dev/null +++ b/octave_packages/optim-1.2.0/private/__sqp__.m @@ -0,0 +1,160 @@ +## Copyright (C) 2012 Olaf Till +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## The simulated annealing code is translated and adapted from siman.c, +## written by Mark Galassi, of the GNU Scientific Library. + +function [p_res, objf, cvg, outp] = __sqp__ (f, pin, hook) + + ## needed for some anonymous functions + if (exist ("ifelse") != 5) + ifelse = @ scalar_ifelse; + endif + + n = length (pin); + + ## passed constraints + mc = hook.mc; # matrix of linear constraints + vc = hook.vc; # vector of linear constraints + f_cstr = hook.f_cstr; # function of all constraints + df_cstr = hook.df_cstr; # function of derivatives of all constraints + n_gencstr = hook.n_gencstr; # number of non-linear constraints + eq_idx = hook.eq_idx; # logical index of equality constraints in all + # constraints + lbound = hook.lbound; # bounds, subset of linear inequality + ubound = hook.ubound; # constraints in mc and vc + + ## passed values of constraints for initial parameters + pin_cstr = hook.pin_cstr; + + ## passed return value of f for initial parameters + f_pin = hook.f_pin; + + ## passed function for gradient of objective function + grad_f = hook.dfdp; + + ## passed function for hessian of objective function + if (isempty (hessian = hook.hessian)) + user_hessian = false; + R = eye (n); + else + user_hessian = true; + endif + + ## passed function for complementary pivoting + cpiv = hook.cpiv; + + ## passed options + ftol = hook.TolFun; + niter = hook.MaxIter; + if (isempty (niter)) niter = 20; endif + fixed = hook.fixed; + + ## some useful variables derived from passed variables + ## + ## ... + + nz = 20 * eps; # This is arbitrary. Accuracy of equality constraints. + + ## backend-specific checking of options and constraints + ## + if (any (pin < lbound | pin > ubound) || + any (pin_cstr.inequ.lin_except_bounds < 0) || + any (pin_cstr.inequ.gen < 0) || + any (abs (pin_cstr.equ.lin)) >= nz || + any (abs (pin_cstr.equ.gen)) >= nz) + error ("Initial parameters violate constraints."); + endif + ## + if (all (fixed)) + error ("no free parameters"); + endif + + ## fill constant fields of hook for derivative-functions; some fields + ## may be backend-specific + dfdp_hook.fixed = fixed; # this may be handled by the frontend, but + # the backend still may add to it + + ## set up for iterations + p = pin; + f = f_pin; + n_iter = 0; + done = false; + + while (! done) + + niter++; + + if (user_hessian) + + H = hessian (p); + idx = isnan (H); + H(idx) = H.'(idx); + if (any (isnan (H(:)))) + error ("some second derivatives undefined by user function"); + endif + if (! isreal (H)) + error ("second derivatives given by user function not real"); + endif + if (! issymmetric (H)) + error ("Hessian returned by user function not symmetric"); + endif + + R = directional_discrimination (H); + + endif + + + endwhile + + ## return result + +endfunction + +function R = directional_discrimination (A) + + ## A is expected to be real and symmetric without checking + ## + ## "Directional discrimination" (Bard, Nonlinear Parameter Estimation, + ## Academic Press, 1974). Compute R, which is "similar" to computing + ## inv(H), but succeeds even if H is singular; R is positive definite + ## and is tuned to avoid large steps of one parameter with respect to + ## the steps of the others. + + ## make matrix Binv for scaling + Binv = diag (A); + nidx = ! (idx = Binv == 0); + Binv(nidx) = 1 ./ sqrt (abs (Binv(nidx))); + Binv(idx) = 1; + Binv = diag (Binv); + + ## eigendecomposition of scaled hessian + [V, L] = eig (Binv * A * Binv); + + ## A is symmetric, so V and L are real, delete any imaginary parts, + ## which might occur due to inaccuracy + V = real (V); + L = real (L); + + ## actual directional discrimination, does not exactly follow Bard + L = abs (diag (L)); # R should get positive definite + L = max (L, .001 * max (L)); # avoids relatively large steps of + # parameters + + G = Binv * V; + + R = G * diag (1 ./ L) * G.'; + +endfunction diff --git a/octave_packages/optim-1.2.0/private/optim_problems_p_r_y.data b/octave_packages/optim-1.2.0/private/optim_problems_p_r_y.data new file mode 100644 index 0000000..0bcc643 --- /dev/null +++ b/octave_packages/optim-1.2.0/private/optim_problems_p_r_y.data @@ -0,0 +1,675 @@ + 0.74474 + 0.704907943019318 + 0.6783600455187353 + 0.6638710199213019 + 0.6493922050536766 + 0.644562529854532 + 0.6373129116909114 + 0.6409377207727217 + 0.6312783703744327 + 0.6312783703744327 + 0.6300735042570986 + 0.6252438290579542 + 0.6228340968232858 + 0.6204141538588096 + 0.6192092877414755 + 0.6143796125423311 + 0.6095601480729944 + 0.6107650141903287 + 0.6047304728738501 + 0.603515396026708 + 0.5999007976747056 + 0.5950711224755612 + 0.5950711224755612 + 0.5902414472764167 + 0.5914463133937508 + 0.5793772307607936 + 0.5769674985261253 + 0.5733426894443149 + 0.5673081481278364 + 0.5600687406940237 + 0.5552390654948792 + 0.5516142564130688 + 0.5455797150965902 + 0.5407500398974457 + 0.533510632463633 + 0.5274760911471544 + 0.5214415498306758 + 0.5117821994323869 + 0.5057476581159083 + 0.4973033845647614 + 0.4912688432482828 + 0.4852343019318041 + 0.4743700854161811 + 0.4695404102170366 + 0.4586761937014135 + 0.4514367862676008 + 0.442982301986646 + 0.432118085471023 + 0.4248786780372102 + 0.4152193276389213 + 0.4055701879704403 + 0.3959108375721513 + 0.3862514871738624 + 0.3765921367755734 + 0.3669429971070924 + 0.3560787805914694 + 0.3452145640758463 + 0.3355552136775573 + 0.3234861310446001 + 0.3126219145289771 + 0.301757698013354 + 0.2908934814977309 + 0.2788243988647737 + 0.2703801253136268 + 0.2595159087980037 + 0.2486516922823807 + 0.2389923418840917 + 0.2281281253684687 + 0.2136493105008432 + 0.2063996923372225 + 0.1943306097042653 + 0.1858863361531184 + 0.1738172535201612 + 0.1641579031218723 + 0.1557034188409175 + 0.1448494130551023 + 0.1351900626568134 + 0.1255307122585245 + 0.1158713618602355 + 0.1062222221917545 + 0.1001876808752759 + 0.08811859824231871 + 0.08207384619603218 + 0.07242470652755117 + 0.74474 + 0.71282 + 0.65963 + 0.61589 + 0.57451 + 0.54614 + 0.52723 + 0.51186 + 0.5024 + 0.49058 + 0.47994 + 0.4764 + 0.47403 + 0.46931 + 0.46458 + 0.46103 + 0.45867 + 0.45394 + 0.45039 + 0.45039 + 0.44921 + 0.4433 + 0.44093 + 0.43739 + 0.43266 + 0.43029 + 0.43148 + 0.42675 + 0.42202 + 0.41966 + 0.41611 + 0.41138 + 0.40665 + 0.40192 + 0.39838 + 0.39483 + 0.38892 + 0.38419 + 0.38183 + 0.37473 + 0.37001 + 0.3641 + 0.35819 + 0.35346 + 0.34873 + 0.33927 + 0.33218 + 0.32509 + 0.31799 + 0.31326 + 0.30617 + 0.29908 + 0.28962 + 0.28135 + 0.27189 + 0.26598 + 0.25889 + 0.24943 + 0.24234 + 0.2317 + 0.22106 + 0.21278 + 0.20333 + 0.19505 + 0.18796 + 0.1785 + 0.17023 + 0.15841 + 0.14895 + 0.14422 + 0.13476 + 0.12412 + 0.11703 + 0.10994 + 0.09693 + 0.08984 + 0.08037999999999999 + 0.07328999999999999 + 0.06738 + 0.05674 + 0.0532 + 0.04492 + 0.04137 + 0.03428 + 0.74474 + 0.711827416514371 + 0.6594168081630392 + 0.6106665905189123 + 0.5643497593730962 + 0.5314371758874674 + 0.5046183696073544 + 0.4863370379908068 + 0.474149483579775 + 0.4619619291687433 + 0.4534244545051779 + 0.4448972908013512 + 0.4424535933433017 + 0.4351431228886304 + 0.4314827321814254 + 0.4290493456831145 + 0.4253889549759095 + 0.4205118710195492 + 0.4168617912720828 + 0.4180784845212382 + 0.4132014005648778 + 0.4107680140665669 + 0.4095513208174115 + 0.407107623359362 + 0.4022305394030015 + 0.403447232652157 + 0.3973534554466411 + 0.3961367621974857 + 0.3924866824500193 + 0.3900429849919698 + 0.3888262917428144 + 0.3839492077864539 + 0.3778554305809381 + 0.3766387373317826 + 0.3741950398737331 + 0.3681012626682172 + 0.3668845694190618 + 0.3620074854627014 + 0.357130401506341 + 0.3522636285097192 + 0.3473865445533587 + 0.3437261538461538 + 0.3376323766406379 + 0.3327552926842775 + 0.3303219061859666 + 0.3254448222296062 + 0.3181343517749349 + 0.3108135703605249 + 0.3059364864041645 + 0.2974093227003378 + 0.2925322387439774 + 0.285221768289306 + 0.2791279910837902 + 0.2718072096693803 + 0.2608466594672426 + 0.258402962009193 + 0.2486487940964723 + 0.2437820210998504 + 0.235244546436285 + 0.2291507692307692 + 0.2181799080688929 + 0.2096527443650661 + 0.2011152697015008 + 0.192588105997674 + 0.1828339380849532 + 0.1779568541285927 + 0.1682026862158719 + 0.1608922157612006 + 0.1511380478484798 + 0.1450442706429639 + 0.1365171069391372 + 0.1267629390264163 + 0.1170087711136955 + 0.1084816074098687 + 0.1011711369551974 + 0.09141696904247659 + 0.08410649858780528 + 0.07556902392423989 + 0.06582516697125766 + 0.06216477626405272 + 0.05485430580938139 + 0.04753352439497147 + 0.04265644043861105 + 0.03169589023647339 + 0.02559180207121891 + 0.74474 + 0.724082753053198 + 0.6706308419236873 + 0.6171686535568895 + 0.5637167424273788 + 0.5175513925343269 + 0.482321023114607 + 0.4543772149313461 + 0.4325072539846822 + 0.4154984262747533 + 0.4021277405644104 + 0.3924157513282274 + 0.3802680568550335 + 0.3754069236182985 + 0.3693330763817015 + 0.3644719431449665 + 0.3583980959083695 + 0.3571853819085076 + 0.3535369626716345 + 0.3498885434347616 + 0.3462504014351755 + 0.3438146961981646 + 0.3413892681984406 + 0.3401765541985786 + 0.3365281349617056 + 0.3328797157248327 + 0.3304542877251087 + 0.3292415737252467 + 0.3243804404885117 + 0.3219447352515007 + 0.3207320212516387 + 0.3207320212516387 + 0.3170938792520527 + 0.3134454600151797 + 0.3110097547781688 + 0.3025104795418478 + 0.3025104795418478 + 0.3012977655419857 + 0.2988620603049748 + 0.2927882130683778 + 0.2915754990685158 + 0.2830762238321949 + 0.2782150905954598 + 0.2794278045953219 + 0.2733539573587249 + 0.2697055381218519 + 0.263631690885255 + 0.25877055764852 + 0.253909424411785 + 0.249058568412337 + 0.244197435175602 + 0.239336301938867 + 0.2332624547022701 + 0.2247529022286621 + 0.2186790549920651 + 0.2186790549920651 + 0.2113924937556061 + 0.2041059325191472 + 0.1955963800455392 + 0.1907352468088042 + 0.1834486855723453 + 0.1761621243358863 + 0.1700882770992893 + 0.1640144298626923 + 0.1555048773890844 + 0.1494310301524874 + 0.1457928881529014 + 0.1336349164424205 + 0.1287840604429725 + 0.1202745079693645 + 0.1142006607327675 + 0.1044783942592976 + 0.09840454702270061 + 0.09111798578624163 + 0.08383142454978265 + 0.07532187207617469 + 0.07046073883943972 + 0.06438689160284275 + 0.05588761636652177 + 0.04860105513006278 + 0.04373992189332781 + 0.03523036941971986 + 0.03159222742013386 + 0.02673109418339888 + 0.0218699609466639 + 0.01822154170979093 + 0.74474 + 0.7339284058287399 + 0.6894829989630519 + 0.6306289073841619 + 0.5693665941712601 + 0.5069052507777111 + 0.4528472799214102 + 0.407202842875075 + 0.3663646878240462 + 0.3387361873055722 + 0.3099086566064509 + 0.2918927200785897 + 0.272667592097364 + 0.258258907384162 + 0.2486463433935491 + 0.2390337794029362 + 0.2306304068656879 + 0.2246250946897342 + 0.2198188126944278 + 0.2150125306991213 + 0.2090072185231676 + 0.2053999667085084 + 0.2042009365278611 + 0.1993946545325547 + 0.1957975639906129 + 0.1921903121759537 + 0.1909912819953064 + 0.1885830603612945 + 0.1849859698193527 + 0.1825777481853408 + 0.1801796878240463 + 0.1717661540140807 + 0.1777816274627517 + 0.1741743756480926 + 0.1705671238334334 + 0.1681690634721388 + 0.1669700332914915 + 0.1657608418381269 + 0.1621637512961851 + 0.1609647211155378 + 0.1573574693008787 + 0.1525511873055722 + 0.1525511873055722 + 0.148943935490913 + 0.1477449053102658 + 0.1429386233149593 + 0.1405405629536648 + 0.1393415327730175 + 0.1345352507777111 + 0.1297289687824046 + 0.1261217169677454 + 0.1249226867870982 + 0.1201164047917917 + 0.1153101227964853 + 0.1117130322545435 + 0.106906750259237 + 0.1032994984445779 + 0.09729418626862413 + 0.09489612590732958 + 0.09008984391202314 + 0.0852835619167167 + 0.08047727992141025 + 0.07688018937946843 + 0.07327293756480925 + 0.06966568575015007 + 0.06486956502756099 + 0.06006328303225454 + 0.05405797085630082 + 0.05164974922228893 + 0.04444540686568793 + 0.04083815505102876 + 0.03724106450908694 + 0.03243478251378049 + 0.02882753069912132 + 0.02642947033782677 + 0.02042415816187305 + 0.01561787616656661 + 0.01081159417126016 + 0.00961256399061289 + 0.007204342356600993 + 0 + -0.004806281995306445 + -0.003607251814659171 + -0.01320965453255471 + 0.74474 + 0.7375021906482698 + 0.7061757284822601 + 0.6519431288326764 + 0.5928989150788435 + 0.5278197954993429 + 0.4675726782194481 + 0.4073153668418747 + 0.3591074789202803 + 0.3157315932982917 + 0.2819891299824792 + 0.2518553772448532 + 0.2289594338589575 + 0.2096823951489269 + 0.1964300681668857 + 0.183167547087166 + 0.1735341247809899 + 0.1626876048510731 + 0.1542468919732808 + 0.1482221802452913 + 0.143400372043364 + 0.1397916614651774 + 0.1361727567893123 + 0.131350948587385 + 0.1289451415352606 + 0.1253262368593955 + 0.1217175262812089 + 0.1168957180792816 + 0.1168957180792816 + 0.1144797169294788 + 0.1120739098773544 + 0.1120739098773544 + 0.1096579087275515 + 0.1072521016754271 + 0.1060491981493649 + 0.1024302934734998 + 0.1024302934734998 + 0.09881138879763469 + 0.0976084852715725 + 0.0976084852715725 + 0.0964055817455103 + 0.0927866770696452 + 0.09038087001752081 + 0.09038087001752081 + 0.08555906181559352 + 0.08676196534165571 + 0.08435615828953132 + 0.07953435008760404 + 0.07712854303547963 + 0.07591544541173893 + 0.07350963835961453 + 0.07110383130749015 + 0.06868783015768724 + 0.06386602195575997 + 0.06507911957950065 + 0.06146021490363557 + 0.05904421375383268 + 0.05423259964958388 + 0.05301950202584318 + 0.04941079144765659 + 0.0457918867717915 + 0.04097007856986421 + 0.03736136799167761 + 0.03494536684187472 + 0.03133665626368813 + 0.03253955978975032 + 0.02771775158782304 + 0.02651484806176084 + 0.02409884691195795 + 0.01927703871003066 + 0.01566832813184407 + 0.01325232698204117 + 0.01084651992991678 + 0.009643616403854577 + 0.007227615254051686 + 0.001202903526062199 + 0.002405807052124398 + -0.002405807052124398 + -0.001202903526062199 + -0.00361890467586509 + -0.00361890467586509 + -0.004821808201927289 + -0.006024711727989488 + -0.006024711727989488 + 0.74474 + 0.7374888614235295 + 0.7229763569947404 + 0.6842967997363325 + 0.6347251936994465 + 0.5754785847100344 + 0.5089910644200003 + 0.4473308183303808 + 0.3844637536906576 + 0.3300546461775086 + 0.2768625844903116 + 0.2357591628558481 + 0.1982761968716956 + 0.1680545967398618 + 0.1438670893585465 + 0.1257341292794463 + 0.1100148063005534 + 0.09430571059750889 + 0.08342388909487909 + 0.07374888614235295 + 0.07011820321619357 + 0.06407388318982683 + 0.05923638171356377 + 0.05440910751314904 + 0.04957160603688598 + 0.04473410456062291 + 0.0459409231107266 + 0.04352728601051923 + 0.04231024018456721 + 0.03989660308435986 + 0.03748296598415249 + 0.03748296598415249 + 0.03626592015820047 + 0.03264546450788942 + 0.0338522830579931 + 0.03264546450788942 + 0.03264546450788942 + 0.03143864595778574 + 0.03022160013183373 + 0.02780796303162636 + 0.02660114448152268 + 0.02660114448152268 + 0.02660114448152268 + 0.02538409865557066 + 0.0229704615553633 + 0.02417728010546698 + 0.02055682445515594 + 0.02055682445515594 + 0.01933977862920392 + 0.02176364300525961 + 0.01692614152899655 + 0.01692614152899655 + 0.01571932297889287 + 0.01451250442878919 + 0.01208864005273349 + 0.01208864005273349 + 0.008457957126574107 + 0.009675002952526126 + 0.009675002952526126 + 0.008457957126574107 + 0.007251138576470427 + 0.004837501476263063 + 0.002413637100207363 + 0 + 0.001206818550103682 + 0 + 0 + -0.001206818550103682 + -0.003630682926159381 + -0.008457957126574107 + -0.002413637100207363 + -0.004837501476263063 + -0.004837501476263063 + -0.006044320026366745 + -0.004837501476263063 + -0.007251138576470427 + -0.007251138576470427 + -0.007251138576470427 + -0.008457957126574107 + -0.008457957126574107 + -0.008457957126574107 + -0.008457957126574107 + -0.009675002952526126 + -0.007251138576470427 + 0.74474 + 0.745952713999862 + 0.73501773352653 + 0.7143604865797281 + 0.6730562699234113 + 0.6244552147933484 + 0.5685778756641137 + 0.5054036980611329 + 0.4397938152211412 + 0.3814807708548955 + 0.3170938792520527 + 0.2672801101221279 + 0.2186790549920651 + 0.1773748383357483 + 0.1409317549161664 + 0.1117752327330435 + 0.08990527178637962 + 0.07046073883943972 + 0.05467490236665976 + 0.04373992189332781 + 0.03280494141999585 + 0.02794380818326088 + 0.0218699609466639 + 0.01822154170979093 + 0.01458339971020492 + 0.01093498047333195 + 0.009722266473469951 + 0.008499275236320982 + 0.006073847236596978 + 0.004861133236734975 + 0.003648419236872973 + 0.002425427999724004 + 0.002425427999724004 + 0.002425427999724004 + 0.003648419236872973 + 0 + 0.001212713999862002 + -0.001212713999862002 + 0.002425427999724004 + -0.001212713999862002 + -0.001212713999862002 + -0.001212713999862002 + -0.001212713999862002 + -0.002425427999724004 + -0.002425427999724004 + -0.002425427999724004 + -0.004861133236734975 + -0.004861133236734975 + -0.002425427999724004 + -0.004861133236734975 + -0.003648419236872973 + -0.003648419236872973 + -0.006073847236596978 + -0.004861133236734975 + -0.004861133236734975 + -0.00728656123645898 + -0.004861133236734975 + -0.006073847236596978 + -0.006073847236596978 + -0.00728656123645898 + -0.00728656123645898 + -0.006073847236596978 + -0.00728656123645898 + -0.009722266473469951 + -0.008499275236320982 + -0.00728656123645898 + -0.00728656123645898 + -0.008499275236320982 + -0.008499275236320982 + -0.008499275236320982 + -0.00728656123645898 + -0.01093498047333195 + -0.00728656123645898 + -0.009722266473469951 + -0.00728656123645898 + -0.00728656123645898 + -0.008499275236320982 + -0.008499275236320982 + -0.01093498047333195 + -0.008499275236320982 + -0.009722266473469951 + -0.008499275236320982 + -0.009722266473469951 + -0.00728656123645898 diff --git a/octave_packages/optim-1.2.0/residmin_stat.m b/octave_packages/optim-1.2.0/residmin_stat.m new file mode 100644 index 0000000..33a923f --- /dev/null +++ b/octave_packages/optim-1.2.0/residmin_stat.m @@ -0,0 +1,99 @@ +## Copyright (C) 2011 Olaf Till +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{info} =} residmin_stat (@var{f}, @var{p}, @var{settings}) +## Frontend for computation of statistics for a residual-based +## minimization. +## +## @var{settings} is a structure whose fields can be set by +## @code{optimset} with Octave versions 3.3.55 or greater; with older +## Octave versions, the fields must be set directly and in the correct +## case. With @var{settings} the computation of certain statistics is +## requested by setting the fields @code{ret_} to +## @code{true}. The respective statistics will be returned in a +## structure as fields with name @code{}. Depending +## on the requested statistic and on the additional information provided +## in @var{settings}, @var{f} and @var{p} may be empty. Otherwise, +## @var{f} is the model function of an optimization (the interface of +## @var{f} is described e.g. in @code{nonlin_residmin}, please see +## there), and @var{p} is a real column vector with parameters resulting +## from the same optimization. +## +## Currently, the following statistics (or general information) can be +## requested: +## +## @code{dfdp}: Jacobian of model function with respect to parameters. +## +## @code{covd}: Covariance matrix of data (typically guessed by applying +## a factor to the covariance matrix of the residuals). +## +## @code{covp}: Covariance matrix of final parameters. +## +## @code{corp}: Correlation matrix of final parameters. +## +## Further @var{settings} +## +## The functionality of the interface is similar to +## @code{nonlin_residmin}. In particular, structure-based, possibly +## non-scalar, parameters and flagging parameters as fixed are possible. +## The following settings have the same meaning as in +## @code{nonlin_residmin} (please refer to there): @code{param_order}, +## @code{param_dims}, @code{f_pstruct}, @code{dfdp_pstruct}, +## @code{diffp}, @code{diff_onesided}, @code{complex_step_derivative}, +## @code{cstep}, @code{fixed}, and @code{weights}. Similarly, +## @code{param_config} can be used, but only with fields corresponding +## to the settings @code{fixed}, @code{diffp}, and @code{diff_onesided}. +## +## @code{dfdp} can be set in the same way as in @code{nonlin_residmin}, +## but alternatively may already contain the computed Jacobian of the +## model function at the final parameters in matrix- or structure-form. +## Users may pass information on the result of the optimization in +## @code{residuals} (self-explaining) and @code{covd} (covariance matrix +## of data). In many cases the type of objective function of the +## optimization must be specified in @code{objf}; currently, there is +## only a backend for the type "wls" (weighted least squares). +## +## Backend-specific information +## +## The backend for @code{objf == "wls"} (currently the only backend) +## computes @code{cord} (due to user request or as a prerequisite for +## @code{covp} and @code{corp}) as a diagonal matrix by assuming that +## the variances of data points are proportional to the reciprocal of +## the squared @code{weights} and guessing the factor of proportionality +## from the residuals. If @code{covp} is not defined (e.g. because the +## Jacobian has no full rank), it makes an attempt to still compute its +## uniquely defined elements, if any, and to find the additional defined +## elements (being @code{1} or @code{-1}), if any, in @code{corp}. +## +## @seealso {curvefit_stat} +## @end deftypefn + +function ret = residmin_stat (varargin) + + if (nargin == 1) + ret = __residmin_stat__ (varargin{1}); + return; + endif + + if (nargin != 3) + print_usage (); + endif + + varargin{4} = struct (); + + ret = __residmin_stat__ (varargin{:}); + +endfunction diff --git a/octave_packages/optim-1.2.0/rosenbrock.m b/octave_packages/optim-1.2.0/rosenbrock.m new file mode 100644 index 0000000..47c7e5b --- /dev/null +++ b/octave_packages/optim-1.2.0/rosenbrock.m @@ -0,0 +1,30 @@ +## Copyright (C) 2004 Michael Creel +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Rosenbrock function - used to create example obj. fns. +## +## Function value and gradient vector of the rosenbrock function +## The minimizer is at the vector (1,1,..,1), +## and the minimized value is 0. + +function [obj_value, gradient] = rosenbrock(x); + dimension = length(x); + obj_value = sum(100*(x(2:dimension)-x(1:dimension-1).^2).^2 + (1-x(1:dimension-1)).^2); + if nargout > 1 + gradient = zeros(dimension, 1); + gradient(1:dimension-1) = - 400*x(1:dimension-1).*(x(2:dimension)-x(1:dimension-1).^2) - 2*(1-x(1:dimension-1)); + gradient(2:dimension) = gradient(2:dimension) + 200*(x(2:dimension)-x(1:dimension-1).^2); + endif +endfunction diff --git a/octave_packages/optim-1.2.0/samin_example.m b/octave_packages/optim-1.2.0/samin_example.m new file mode 100644 index 0000000..a9c8577 --- /dev/null +++ b/octave_packages/optim-1.2.0/samin_example.m @@ -0,0 +1,75 @@ +## Copyright (C) 2004 Michael Creel +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +# samin_example: example script that contains examples of how to call +# samin for minimization using simulated annealing. +# Edit the script to see how samin may be used. +# +# usage: samin_example + +1; # this is a script file + +# Example objective function +# remember that cos(0)=1, so +# "a" has a local minimum at 0 (each dimension) +# "b" makes the function value 0 at min +# "c" adds some curvature to make the min +# at (0,0,...,0) global. +# the closer is "curvature" to zero the more alike are +# the local mins, so the harder the global min is to find + +function f = obj(theta, curvature); + dim = rows(theta); + a = sum(exp(-cos(theta))); + b = - dim*exp(-1); + c = sum(curvature*theta .^ 2); + f = a + b + c; +endfunction + +k = 5; # dimensionality +theta = rand(k,1)*10 - 5; # random start value + +# if you set "curvature" very small, +# you will need to increase nt, ns, and rt +# to minimize sucessfully +curvature = 0.01; + + +# SA controls +ub = 10*ones(rows(theta),1); +lb = -ub; +# setting ub and lb to same value restricts that parameter, and the algorithm does not search +ub(1,:) = 0; +lb(1,:) = 0; +theta(1,:) = 0; # must satisfy restriction + +nt = 20; +ns = 5; +rt = 0.5; # careful - this is too low for many problems +maxevals = 1e10; +neps = 5; +functol = 1e-10; +paramtol = 1e-3; +verbosity = 1; # only final results. Inc +minarg = 1; +control = { lb, ub, nt, ns, rt, maxevals, neps, functol, paramtol, verbosity, 1}; + + +# do sa +t=cputime(); +[theta, obj_value, convergence] = samin("obj", {theta, curvature}, control); +t = cputime() - t; +printf("Elapsed time = %f\n\n\n",t); + diff --git a/octave_packages/optim-1.2.0/test_d2_min_1.m b/octave_packages/optim-1.2.0/test_d2_min_1.m new file mode 100644 index 0000000..d10f287 --- /dev/null +++ b/octave_packages/optim-1.2.0/test_d2_min_1.m @@ -0,0 +1,184 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Test whether d2_min() functions correctly +## +## Gives a simple quadratic programming problem (function ff below). +## +## Sets a ok variable to 1 in case of success, 0 in case of failure +## +## If a variables "verbose" is set, then some comments are output. + +1 ; + +if ! exist ("verbose"), verbose = 0; end + +if verbose + printf ("\n Testing d2_min () on a quadratic programming problem\n\n"); +end + +P = 10+floor(30*rand(1)) ; # Nparams +R = P+floor(30*rand(1)) ; # Nobses +noise = 0 ; +global obsmat ; +obsmat = randn(R,P) ; +global truep ; +truep = randn(P,1) ; +xinit = randn(P,1) ; + +global obses ; +obses = obsmat*truep ; +if noise, obses = adnois(obses,noise); end + + + +function v = ff(x) + global obsmat; + global obses; + v = msq (obses - obsmat*x ) ; +endfunction + +function [v,dv,d2v] = d2ff(x) # Return pseudo-inverse + global obsmat; + global obses; + er = -obses + obsmat*x ; + dv = er'*obsmat ; + v = msq(er ) ; + d2v = pinv (obsmat'*obsmat ) ; +endfunction + +function [v,dv,d2v] = d2ff_2(x) # Return 2nd derivs, not pseudo-inv + global obsmat; + global obses; + er = -obses + obsmat*x ; + dv = er'*obsmat ; + v = msq(er ) ; + d2v = obsmat'*obsmat ; +endfunction + +## dt = mytic() +## +## Returns the cputime since last call to 'mytic'. + +function dt = mytic() + persistent last_mytic = 0 ; + [t,u,s] = cputime() ; + dt = t - last_mytic ; + last_mytic = t ; +endfunction + +## s = msq(x) - Mean squared value, ignoring nans +## +## s == mean(x(:).^2) , but ignores NaN's + + +function s = msq(x) +try + s = mean(x(find(!isnan(x))).^2); +catch + s = nan; +end +endfunction + +cnt = 1; +ok = 1; + +ctl = nan*zeros(1,5); ctl(5) = 1; + +if verbose + printf ("Going to call d2_min\n"); +end +mytic() ; +[xlev,vlev,nev] = d2_min ("ff","d2ff",xinit,ctl); +tlev = mytic() ; + +if verbose, + printf("d2_min should find in one iteration + one more to check\n"); + printf(["d2_min : niter=%-4d nev=%-4d nobs=%-4d,nparams=%-4d\n",... + " time=%-8.3g errx=%-8.3g minv=%-8.3g\n"],... + nev([2,1]),R,P,tlev,max(abs(xlev-truep )),vlev); +end + + + +if nev(2) != 2, + if verbose + printf ("Too many iterations for this function\n"); + end + ok = 0; +else + if verbose + printf ("Ok: single iteration (%i)\n",cnt); + end +end + +if max (abs(xlev-truep )) > sqrt (eps), + if verbose + printf ("Error is too big : %-8.3g\n", max (abs (xlev-truep))); + end + ok = 0; +else + if verbose + printf ("Ok: single error amplitude (%i)\n",cnt); + end +end + +cnt++; + +if verbose + printf ("Going to call d2_min() \n"); +end +mytic() ; +[xlev,vlev,nev] = d2_min("ff","d2ff_2",xinit) ; +tlev = mytic() ; + +if verbose, + printf("d2_min should find in one iteration + one more to check\n"); + printf(["d2_min : niter=%-4d nev=%-4d nobs=%-4d,nparams=%-4d\n",... + " time=%-8.3g errx=%-8.3g minv=%-8.3g\n"],... + nev([2,1]),R,P,tlev,max(abs(xlev-truep )),vlev); +end + + +if nev(2) != 2, + if verbose + printf ("Too many iterations for this function\n"); + end + ok = 0; +else + if verbose + printf ("Ok: single iteration (%i)\n",cnt); + end +end + +if max (abs(xlev-truep )) > sqrt (eps), + if verbose + printf ("Error is too big : %-8.3g\n", max (abs (xlev-truep))); + end + ok = 0; +else + if verbose + printf ("Ok: single error amplitude (%i)\n",cnt); + end +end + +if verbose + if ok + printf ("All tests ok\n"); + else + printf ("Some tests failed\n"); + end +end + diff --git a/octave_packages/optim-1.2.0/test_d2_min_2.m b/octave_packages/optim-1.2.0/test_d2_min_2.m new file mode 100644 index 0000000..50890f9 --- /dev/null +++ b/octave_packages/optim-1.2.0/test_d2_min_2.m @@ -0,0 +1,115 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Test whether d2_min() functions correctly, with two args +## +## Gives a simple quadratic programming problem (function ff below). +## +## Sets a ok variable to 1 in case of success, 0 in case of failure +## +## If a variables "verbose" is set, then some comments are output. + +1 ; + +ok = 0; + +if ! exist ("verbose"), verbose = 0; end + +if verbose + printf ("\n Testing d2_min () on a quadratic programming problem\n\n"); +end + +P = 10+floor(30*rand(1)) ; # Nparams +R = P+floor(30*rand(1)) ; # Nobses +noise = 0 ; +obsmat = randn(R,P) ; +truep = randn(P,1) ; +xinit = randn(P,1) ; + +obses = obsmat*truep ; +if noise, obses = adnois(obses,noise); end + +y.obses = obses; +y.obsmat = obsmat; + +function v = ff (x, y) + v = msq( y.obses - y.obsmat*x ) ; +endfunction + + +function [v,dv,d2v] = d2ff (x, y) + er = -y.obses + y.obsmat*x ; + dv = er'*y.obsmat ; + v = msq( er ) ; + d2v = pinv( y.obsmat'*y.obsmat ) ; +endfunction + +## dt = mytic() +## +## Returns the cputime since last call to 'mytic'. + +function dt = mytic() + persistent last_mytic = 0 ; + [t,u,s] = cputime() ; + dt = t - last_mytic ; + last_mytic = t ; +endfunction + +## s = msq(x) - Mean squared value, ignoring nans +## +## s == mean(x(:).^2) , but ignores NaN's + + +function s = msq(x) +try + s = mean(x(find(!isnan(x))).^2); +catch + s = nan; +end +endfunction + + +ctl = nan*zeros(1,5); ctl(5) = 1; + +if verbose, printf ( "Going to call d2_min()\n"); end +mytic() ; +[xlev,vlev,nev] = d2_min ("ff", "d2ff", {xinit,y}, ctl) ; +tlev = mytic (); + +if verbose, + printf("d2_min should find in one iteration + one more to check\n"); + printf(["d2_min : niter=%-4d nev=%-4d nobs=%-4d nparams=%-4d\n",\ + " time=%-8.3g errx=%-8.3g minv=%-8.3g\n"],... + nev([2,1]), R, P, tlev, max (abs (xlev-truep)), vlev); +end + +ok = 1; +if nev(2) != 2, + if verbose + printf ( "Too many iterations for this function\n"); + end + ok = 0; +end + +if max (abs(xlev-truep )) > sqrt (eps), + if verbose + printf ( "Error is too big : %-8.3g\n", max (abs (xlev-truep))); + end + ok = 0; +end + +if verbose && ok + printf ( "All tests ok\n"); +end diff --git a/octave_packages/optim-1.2.0/test_d2_min_3.m b/octave_packages/optim-1.2.0/test_d2_min_3.m new file mode 100644 index 0000000..06d0764 --- /dev/null +++ b/octave_packages/optim-1.2.0/test_d2_min_3.m @@ -0,0 +1,102 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Test whether d2_min() functions correctly +## +## Gives a 2-dim function with strange shape ("ff", defined below). +## +## Sets a ok variable to 1 in case of success, 0 in case of failure +## +## If a variables "verbose" is set, then some comments are output. + +1 ; + +ok = 0; + +if ! exist ("verbose"), verbose = 0; end + +if verbose + printf ("\n Testing d2_min () on a strange 2-dimensional function\n\n"); +end + +P = 2; # Nparams +noise = 0 ; +truep = [0;0] ; +xinit = randn(P,1) ; + +if noise, obses = adnois(obses,noise); end + +y = nan; + + +function v = ff (x, y) + v = x(1)^2 * (1+sin(x(2)*3*pi)^2) + x(2)^2; +endfunction + + +function [w,dv,d2v] = d2ff (x, y) + u = x(1); v = x(2); + w = u^2 * (1+sin(v*3*pi)^2) + v^2; + + dv = [2*u * (1+sin(v*3*pi)^2), u^2 * sin(v*2*3*pi) + 2*v ]; + + d2v = [2*(1+sin(v*3*pi)^2), 2*u * sin(v*2*3*pi) ; + 2*u * sin(v*2*3*pi), u^2 * 2*3*pi* cos(v*2*3*pi) + 2 ]; + d2v = inv (d2v); +endfunction + +## dt = mytic() +## +## Returns the cputime since last call to 'mytic'. + +function dt = mytic() + persistent last_mytic = 0 ; + [t,u,s] = cputime() ; + dt = t - last_mytic ; + last_mytic = t ; +endfunction + + +ctl = nan*zeros(1,5); ctl(5) = 1; + +if verbose + printf ( "Going to call d2_min\n"); +end +mytic() ; +[xlev,vlev,nev] = d2_min ("ff", "d2ff", {xinit,y},ctl) ; +tlev = mytic (); + +if verbose, + printf("d2_min should find minv = 0 (plus a little error)\n"); + printf(["d2_min : niter=%-4d nev=%-4d nparams=%-4d\n",... + " time=%-8.3g errx=%-8.3g minv=%-8.3g\n"],... + nev([2,1]), P, tlev, max (abs (xlev-truep)), vlev); +end + +ok = 1; + +if max (abs(xlev-truep )) > sqrt (eps), + if verbose + printf ( "Error is too big : %-8.3g\n", max (abs (xlev-truep))); + end + ok = 0; +end + +if verbose && ok + printf ( "All tests ok\n"); +end + + + diff --git a/octave_packages/optim-1.2.0/test_fminunc_1.m b/octave_packages/optim-1.2.0/test_fminunc_1.m new file mode 100644 index 0000000..e1bb65f --- /dev/null +++ b/octave_packages/optim-1.2.0/test_fminunc_1.m @@ -0,0 +1,144 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## test_fminunc_compat_1 - Test that fminunc_compat and optimset_compat work +## +## A quadratic function is fminunc_compatd. Various options are tested. Options +## are passed incomplete (to see if properly completed) and +## case-insensitive. + +ok = 1; # Remains set if all ok. Set to 0 otherwise +cnt = 0; # Test counter +more off; +page_screen_output (0); +page_output_immediately (1); + +if ! exist ("verbose"), verbose = 0; end + +N = 2; + +x0 = randn(N,1) ; +y0 = randn(N,1) ; + +## Return value +function v = ff(x,y,t) + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; +endfunction + + +## Return value, diff and 2nd diff +function [v,dv,d2v] = d2ff(x,y,t) + if nargin < 3, t = 1; end + if t == 1, N = length (x); else N = length (y); end + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + v = ((x - y)(1:2))'*M*((x-y)(1:2)) + 1; + dv = 2*((x-y)(1:2))'*M; + d2v = zeros (N); d2v(1:2,1:2) = 2*M; + if N>2, dv = [dv, zeros(1,N-2)]; end + if t == 2, dv = -dv; end +endfunction + + +## PRint Now +function prn (varargin), printf (varargin{:}); fflush (stdout); end + + +if verbose + prn ("\n Testing that fminunc_compat() works as it should\n\n"); + prn (" Nparams = N = %i\n",N); + fflush (stdout); +end + +## Plain run, just to make sure ###################################### +## Minimum wrt 'x' is y0 +opt = optimset_compat (); +[xlev,vlev] = fminunc_compat ("ff",x0,opt,y0,1); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## See what 'backend' gives in that last case ######################## +opt = optimset_compat ("backend","on"); +[method,ctl] = fminunc_compat ("ff",x0, opt, y0,1); + +cnt++; +if ! ischar (method) || ! strcmp (method,"nelder_mead_min") + if verbose + if ischar (method) + prn ("Wrong method '%s' != 'nelder_mead_min' was chosen\n", method); + else + prn ("fminunc_compat pretends to use a method that isn't a string\n"); + end + return + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +[xle2,vle2,nle2] = feval (method, "ff",{x0,y0,1}, ctl); +cnt++; + # nelder_mead_min is not very repeatable + # because of restarts from random positions +if max (abs (xlev-xle2)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-xle2))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + + +## Run, w/ differential returned by function ('jac' option) ########## +## Minimum wrt 'x' is y0 + +opt = optimset_compat ("GradO","on"); +[xlev,vlev,nlev] = fminunc_compat ("d2ff",x0,opt,y0,1); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + + +## Use the 'hess' option, when f can return 2nd differential ######### +## Minimum wrt 'x' is y0 +opt = optimset_compat ("hessian","on"); +[xlev,vlev,nlev] = fminunc_compat ("d2ff",x0,opt,y0,1); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + + +if verbose && ok + prn ( "All tests ok\n"); +end + diff --git a/octave_packages/optim-1.2.0/test_min_1.m b/octave_packages/optim-1.2.0/test_min_1.m new file mode 100644 index 0000000..43114fc --- /dev/null +++ b/octave_packages/optim-1.2.0/test_min_1.m @@ -0,0 +1,104 @@ +## Copyright (C) 2002 Etienne Grossmann +## Copyright (C) 2004 Michael Creel +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Test an optimization function with the same synopsis as bfgs.m + +if ! exist ("optim_func"), optim_func = "bfgsmin"; end + +ok = 1; + +if ! exist ("verbose"), verbose = 0; end + +if verbose + printf ("\n Testing '%s' on a quadratic programming problem\n\n",\ + optim_func); + printf ([" Set 'optim_func' to the name of the optimization\n",\ + " function you want to test (must have same synopsis\n",\ + " as 'bfgs')\n\n"]); +end + + + +N = 1+floor(30*rand(1)) ; +global truemin ; +truemin = randn(N,1) ; + +global offset ; +offset = 10*randn(1) ; + +global metric ; +metric = randn(2*N,N) ; +metric = metric'*metric ; + +if N>1, + [u,d,v] = svd(metric); + d = (0.1+[0:(1/(N-1)):1]).^2 ; + metric = u*diag(d)*u' ; +end + +function v = testfunc(x) + global offset ; + global truemin ; + global metric ; + v = sum((x-truemin)'*metric*(x-truemin))+offset ; +end + +function df = dtestf(x) + global truemin ; + global metric ; + df = 2*(x-truemin)'*metric ; +end + +xinit = 10*randn(N,1) ; + +if verbose, + printf ([" Dimension is %i\n",\ + " Condition is %f\n"],\ + N, cond (metric)); + fflush (stdout); +end + +## [x,v,niter] = feval (optim_func, "testfunc","dtestf", xinit); +ctl.df = "dtestf"; +if strcmp(optim_func,"bfgsmin") + ctl = {-1,2,1,1}; + xinit2 = {xinit}; +else xinit2 = xinit; +endif +[x,v,niter] = feval (optim_func, "testfunc", xinit2, ctl); + +if verbose + printf ("nev=%d N=%d errx=%8.3g errv=%8.3g\n",\ + niter(1),N,max(abs( x-truemin )),v-offset); +end + +if any (abs (x-truemin) > 1e-4) + ok = 0; + if verbose, printf ("not ok 1 (best argument is wrong)\n"); end +elseif verbose, printf ("ok 1\n"); +end + +if v-offset > 1e-8 + ok = 0; + if verbose, printf ("not ok 2 (best function value is wrong)\n"); end +elseif verbose, printf ("ok 2\n"); +end + +if verbose + if ok, printf ("All tests ok\n"); + else printf ("Whoa!! Some test(s) failed\n"); + end +end diff --git a/octave_packages/optim-1.2.0/test_min_2.m b/octave_packages/optim-1.2.0/test_min_2.m new file mode 100644 index 0000000..b13fd01 --- /dev/null +++ b/octave_packages/optim-1.2.0/test_min_2.m @@ -0,0 +1,123 @@ +## Copyright (C) 2002 Etienne Grossmann +## Copyright (C) 2004 Michael Creel +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## test_min_2 - Test that bfgs works +## +## Defines some simple functions and verifies that calling +## +## bfgs on them returns the correct minimum. +## +## Sets 'ok' to 1 if success, 0 otherwise + +if ! exist ("optim_func"), optim_func = "bfgsmin"; end + +ok = 1; + +if ! exist ("verbose"), verbose = 0; end + +P = 15; +R = 20; # must have R >= P + + +global obsmat ; +## Make test_min_2 reproducible by using fixed obsmat +## obsmat = randn(R,P) ; +obsmat = zeros (R,P); +obsmat(sub2ind([R,P],1:R,1+rem(0:R-1,P))) = 1:R; + +global truep ; + +## Make test_min_2 reproducible by using fixed starting point +## truep = randn(P,1) ; +## xinit = randn(P,1) ; +truep = rem (1:P, P/4)'; +xinit = truep + 2*(1:P)'/(P); + +global obses ; +obses = obsmat*truep ; + + +function v = ff(x) + global obsmat; + global obses; + v = mean ((obses - obsmat*x).^2) + 1 ; +endfunction + + +function dv = dff(x) + global obsmat; + global obses; + er = -obses + obsmat*x ; + dv = 2*er'*obsmat / rows(obses) ; + ## dv = 2*er'*obsmat ; +endfunction + +## dt = mytic() +## +## Returns the cputime since last call to 'mytic'. + +function dt = mytic() + persistent last_mytic = 0 ; + [t,u,s] = cputime() ; + dt = t - last_mytic ; + last_mytic = t ; +endfunction + + +if verbose + printf ("\n Testing %s on a quadratic problem\n\n", optim_func); + + printf ([" Set 'optim_func' to the name of the optimization\n",\ + " function you want to test (must have same synopsis\n",\ + " as 'bfgs')\n\n"]); + + printf (" Nparams = P = %i, Nobses = R = %i\n",P,R); + fflush (stdout); +end + +ctl.df = "dff"; +ctl.ftol = eps; +ctl.dtol = 1e-7; +mytic() ; +if strcmp(optim_func,"bfgsmin") + ctl = {-1,2,1,1}; + xinit2 = {xinit}; +else xinit2 = xinit; +endif +## [xlev,vlev,nlev] = feval(optim_func, "ff", "dff", xinit) ; +[xlev,vlev,nlev] = feval(optim_func, "ff", xinit2, ctl) ; +tlev = mytic() ; + + +if max (abs(xlev-truep)) > 1e-4, + if verbose + printf ("Error is too big : %8.3g\n", max (abs (xlev-truep))); + end + ok = 0; +elseif verbose, printf ("ok 1\n"); +end + +if verbose, + printf (" Costs : init=%8.3g, final=%8.3g, best=%8.3g\n",\ + ff(xinit), vlev, ff(truep)); +end +if verbose + printf ( " time : %8.3g\n",tlev); +end +if verbose && ok + printf ( "All tests ok (there's just one test)\n"); +end + diff --git a/octave_packages/optim-1.2.0/test_min_3.m b/octave_packages/optim-1.2.0/test_min_3.m new file mode 100644 index 0000000..9c56f0b --- /dev/null +++ b/octave_packages/optim-1.2.0/test_min_3.m @@ -0,0 +1,112 @@ +## Copyright (C) 2002 Etienne Grossmann +## Copyright (C) 2004 Michael Creel +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## ok - Test that bfgs works with extra +## arguments +## +## Defines some simple functions and verifies that calling +## bfgs on them returns the correct minimum. +## +## Sets 'ok' to 1 if success, 0 otherwise + +if ! exist ("optim_func"), optim_func = "bfgsmin"; end + +ok = 1; + +if ! exist ("verbose"), verbose = 0; end + +P = 2; +R = 3; + +## Make tests reproducible +## obsmat = randn(R,P) ; +obsmat = zeros (R,P); +obsmat(sub2ind([R,P],1:R,1+rem(0:R-1,P))) = 1:R; + +## Make test_min_2 repeatable by using fixed starting point +## truep = randn(P,1) ; +## xinit = randn(P,1) ; +truep = rem (1:P, P/4)'; +xinit = truep + 2*(1:P)'/(P); + + +## global obses ; +obses = obsmat*truep ; + +extra = {obsmat, obses}; + + +function v = ff(x, obsmat, obses) + v = mean ( (obses - obsmat*x)(:).^2 ) + 1 ; +endfunction + + +function dv = dff(x, obsmat, obses) + er = -obses + obsmat*x ; + dv = 2*er'*obsmat / rows(obses) ; + ## dv = 2*er'*obsmat ; +endfunction + + + +if verbose + printf (" Checking that extra arguments are accepted\n\n"); + + printf ([" Set 'optim_func' to the name of the optimization\n",\ + " function you want to test (must have same synopsis\n",\ + " as 'bfgs')\n\n"]); + + printf (" Tested function : %s\n",optim_func); + printf (" Nparams = P = %i, Nobses = R = %i\n",P,R); + fflush (stdout); +end +function dt = mytic() + persistent last_mytic = 0 ; + [t,u,s] = cputime() ; + dt = t - last_mytic ; + last_mytic = t ; +endfunction + +ctl.df = "dff"; +mytic() ; +## [xlev,vlev,nlev] = feval (optim_func, "ff", "dff", xinit, "extra", extra) ; +## [xlev,vlev,nlev] = feval \ +## (optim_func, "ff", "dff", list (xinit, obsmat, obses)); +if strcmp(optim_func,"bfgsmin") + ctl = {-1,2,1,1}; +endif +[xlev,vlev,nlev] = feval \ + (optim_func, "ff", {xinit, obsmat, obses}, ctl); +tlev = mytic() ; + + +if max (abs(xlev-truep)) > 1e-4, + if verbose, + printf ("Error is too big : %8.3g\n", max (abs (xlev-truep))); + end + ok = 0; +end +if verbose, + printf (" Costs : init=%8.3g, final=%8.3g, best=%8.3g\n",\ + ff(xinit,obsmat,obses), vlev, ff(truep,obsmat,obses)); +end +if verbose + printf ( " time : %8.3g\n",tlev); +end +if verbose && ok + printf ( "All tests ok\n"); +end + diff --git a/octave_packages/optim-1.2.0/test_min_4.m b/octave_packages/optim-1.2.0/test_min_4.m new file mode 100644 index 0000000..2764e0c --- /dev/null +++ b/octave_packages/optim-1.2.0/test_min_4.m @@ -0,0 +1,119 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## test_bfgs - Test that bfgs works +## +## Check that bfgs treats struct options correctly +## +## Sets 'ok' to 1 if success, 0 otherwise + +## The name of the optimizing function +if ! exist ("optim_func"), optim_func = "bfgsmin"; end + +ok = 1; +cnt = 0; + +if ! exist ("verbose"), verbose = 0; end + +N = 2; + +## Make test reproducible +## x0 = randn(N,1) ; +## y0 = randn(N,1) ; +x0 = (1:N)'/N; +y0 = (N:-1:1)'/N; + +function v = ff(x,y,t) + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + v = (x(1:2) - y(1:2))'*M*(x(1:2)-y(1:2)) + 1; +endfunction + + +function dv = dff(x,y,t) + if nargin < 3, t = 1; end + if t == 1, N = length (x); else N = length (y); end + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + dv = 2*(x(1:2)-y(1:2))'*M; + if N>2, dv = [dv, zeros(1,N-2)]; end + if t == 2, dv = -dv; end +endfunction + + +if verbose + printf ("\n Testing that %s accepts struct control variable\n\n",\ + optim_func); + + printf ([" Set 'optim_func' to the name of the optimization\n",\ + " function you want to test (must have same synopsis\n",\ + " as 'bfgsmin')\n\n"]); + + printf (" Nparams = N = %i\n",N); + fflush (stdout); +end + +## Plain run, just to make sure ###################################### +## Minimum wrt 'x' is y0 +## [xlev,vlev,nlev] = feval (optim_func, "ff", "dff", {x0,y0,1}); +## ctl.df = "dff"; +[xlev,vlev,nlev] = feval (optim_func, "ff", {x0,y0,1}); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + printf ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, printf ("ok %i\n",cnt); +end + +## Minimize wrt 2nd arg ############################################## +## Minimum wrt 'y' is x0 +## ctl = struct ("narg", 2,"df","dff"); +## ctl = [nan,nan,2]; +## [xlev,vlev,nlev] = feval (optim_func, "ff", list (x0,y0,2),ctl); +[xlev,vlev,nlev] = feval (optim_func, "ff", {x0,y0,2},{inf,0,1,2}); + +cnt++; +if max (abs (xlev-x0)) > 100*sqrt (eps) + if verbose + printf ("Error is too big : %8.3g\n", max (abs (xlev-x0))); + end + ok = 0; +elseif verbose, printf ("ok %i\n",cnt); +end + +## Set the verbose option ############################################ +## Minimum wrt 'x' is y0 +## ctl = struct ("narg", 1,"verbose",verbose, "df", "dff"); +## ctl = [nan,nan,2]; +## [xlev,vlev,nlev] = feval (optim_func, "ff", "dff", {x0,y0,1},ctl); +[xlev,vlev,nlev] = feval (optim_func, "ff", {x0,y0,1},{inf,1,1,1}); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + printf ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, printf ("ok %i\n",cnt); +end + + + + +if verbose && ok + printf ( "All tests ok\n"); +end + diff --git a/octave_packages/optim-1.2.0/test_minimize_1.m b/octave_packages/optim-1.2.0/test_minimize_1.m new file mode 100644 index 0000000..1e3f48a --- /dev/null +++ b/octave_packages/optim-1.2.0/test_minimize_1.m @@ -0,0 +1,255 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## ok = test_minimize - Test that minimize works + +ok = 1; # Remains set if all ok. Set to 0 otherwise +cnt = 0; # Test counter +page_screen_output (0); +page_output_immediately (1); + +if ! exist ("verbose"), verbose = 0; end + +N = 2; + +x0 = randn(N,1) ; +y0 = randn(N,1) ; + +## Return value +function v = ff(x,y,t) + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + v = (x(1:2) - y(1:2))'*M*(x(1:2)-y(1:2)) + 1; +endfunction + +## Return differential +function dv = dff(x,y,t) + if nargin < 3, t = 1; end + if t == 1, N = length (x); else N = length (y); end + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + dv = 2*(x(1:2)-y(1:2))'*M; + if N>2, dv = [dv, zeros(1,N-2)]; end + if t == 2, dv = -dv; end +endfunction + +## Return value, diff and 2nd diff +function [v,dv,d2v] = d2ff(x,y,t) + if nargin < 3, t = 1; end + if t == 1, N = length (x); else N = length (y); end + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + v = (x(1:2) - y(1:2))'*M*(x(1:2)-y(1:2)) + 1; + dv = 2*(x(1:2)-y(1:2))'*M; + d2v = zeros (N); d2v(1:2,1:2) = 2*M; + if N>2, dv = [dv, zeros(1,N-2)]; end + if t == 2, dv = -dv; end +endfunction + +## Return value, diff and inv of 2nd diff +function [v,dv,d2v] = d2iff(x,y,t) + if nargin < 3, t = 1; end + if t == 1, N = length (x); else N = length (y); end + A = [1 -1;1 1]; M = A'*diag([100,1])*A; + v = (x(1:2) - y(1:2))'*M*(x(1:2)-y(1:2)) + 1; + dv = 2*(x(1:2)-y(1:2))'*M; + d2v = zeros (N); d2v(1:2,1:2) = inv (2*M); + if N>2, dv = [dv, zeros(1,N-2)]; end + if t == 2, dv = -dv; end +endfunction + +## PRint Now +function prn (varargin), printf (varargin{:}); fflush (stdout); end + + +if verbose + prn ("\n Testing that minimize() works as it should\n\n"); + prn (" Nparams = N = %i\n",N); + fflush (stdout); +end + +## Plain run, just to make sure ###################################### +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("ff",{x0,y0,1}); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## See what 'backend' gives in that last case ######################## +[method,ctl] = minimize ("ff",{x0,y0,1},"order",0,"backend"); + +cnt++; +if ! ischar (method) || ! strcmp (method,"nelder_mead_min") + if verbose + if ischar (method) + prn ("Wrong method '%s' != 'nelder_mead_min' was chosen\n", method); + else + prn ("minimize pretends to use a method that isn't a string\n"); + end + return + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +[xle2,vle2,nle2] = feval (method, "ff", {x0,y0,1}, ctl); +cnt++; + # nelder_mead_min is not very repeatable + # because of restarts from random positions +if max (abs (xlev-xle2)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-xle2))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + + +## Run, w/ differential, just to make sure ########################### +## Minimum wrt 'x' is y0 + +# [xlev,vlev,nlev] = minimize ("ff",{x0,y0,1},"df","dff"); + +# cnt++; +# if max (abs (xlev-y0)) > 100*sqrt (eps) +# if verbose +# prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); +# end +# ok = 0; +# elseif verbose, prn ("ok %i\n",cnt); +# en + +## Run, w/ differential returned by function ('jac' option) ########## +## Minimum wrt 'x' is y0 +# [xlev,vlev,nlev] = minimize ("d2ff",{x0,y0,1},"jac"); + +# cnt++; +# if max (abs (xlev-y0)) > 100*sqrt (eps) +# if verbose +# prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); +# end +# ok = 0; +# elseif verbose, prn ("ok %i\n",cnt); +# end + +## Run, w/ 2nd differential, just to make sure ####################### +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("ff",{x0,y0,1},"d2f","d2ff"); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## Use the 'hess' option, when f can return 2nd differential ######### +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("d2ff", {x0,y0,1},"hess"); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## Run, w/ inverse of 2nd differential, just to make sure ############ +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("ff", {x0,y0,1},"d2i","d2iff"); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## Use the 'ihess' option, when f can return pinv of 2nd differential +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("d2iff", {x0,y0,1},"ihess"); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## Run, w/ numerical differential #################################### +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("ff",{x0,y0,1},"ndiff"); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +## Run, w/ numerical differential, specified by "order" ############## +## Minimum wrt 'x' is y0 +[xlev,vlev,nlev] = minimize ("ff",{x0,y0,1},"order",1); + +cnt++; +if max (abs (xlev-y0)) > 100*sqrt (eps) + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + +# ## See what 'backend' gives in that last case ######################## +# [method,ctl] = minimize ("ff",{x0,y0,1},"order",1,"backend"); + +# cnt++; +# if ! strcmp (method,"bfgsmin") +# if verbose +# prn ("Wrong method '%s' != 'bfgsmin' was chosen\n", method); +# end +# ok = 0; +# elseif verbose, prn ("ok %i\n",cnt); +# end + +## [xle2,vle2,nle2] = feval (method, "ff",{x0,y0,1}, ctl); +[xle2,vle2,nle2] = minimize ("ff",{x0,y0,1},"order",1); +cnt++; +if max (abs (xlev-xle2)) > 100*eps + if verbose + prn ("Error is too big : %8.3g\n", max (abs (xlev-y0))); + end + ok = 0; +elseif verbose, prn ("ok %i\n",cnt); +end + + +if verbose && ok + prn ( "All tests ok\n"); +end + diff --git a/octave_packages/optim-1.2.0/test_nelder_mead_min_1.m b/octave_packages/optim-1.2.0/test_nelder_mead_min_1.m new file mode 100644 index 0000000..e1f8fe8 --- /dev/null +++ b/octave_packages/optim-1.2.0/test_nelder_mead_min_1.m @@ -0,0 +1,189 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Checks wether the function 'nelder_mead_min' works, by making it minimize a +## quadratic function. + +ok = 1; +cnt = 1; + +if ! exist ("verbose"), verbose = 0; end +if verbose, printf (" test_nelder_mead : \n"); end + +if ! exist ("inspect"), inspect = 0; end + +tol = 100*sqrt (eps); + +R = 3 ; +C = 2; + +if verbose, + printf (" optimization problem has dimension %i\n",R*C); +end + +function c = my_quad_func (x,y,z) + c = 1 + sum (vec(x-y)'*z*(vec(x-y))); +end + +function c = non_quad_func_1 (x,y,z) + tmp = sum (vec(x-y)'*z*(vec(x-y))); + c = 1 + 1.1*tmp + sin (sqrt(tmp)); +end + +function c = non_quad_func_2 (x,y,z) + tmp1 = sum (vec(x-y)'*z*(vec(x-y))); + tmp2 = max (abs (vec(x-y)))^2; + c = 1 + 1.1*tmp1 + tmp2 ; +end + +## dt = mytic() +## +## Returns the cputime since last call to 'mytic'. + +function dt = mytic() + persistent last_mytic = 0 ; + [t,u,s] = cputime() ; + dt = t - last_mytic ; + last_mytic = t ; +endfunction + +fnames = { "my_quad_func", "non_quad_func_1", "non_quad_func_2"}; + +x0 = randn(R,C) ; +x1 = x0 + randn(R,C) ; +z = randn (R*C); z = z*z'; + +for i = 1:length (fnames) + fname = fnames{i}; + if verbose, + printf ("trying to minimize '%s'\n", fname); + end + ctl = nan*zeros (1,6); + + mytic (); + [x2,v,nf] = nelder_mead_min (fname, {x1,x0,z}, ctl) ; + t0 = mytic (); + + if any (abs (x2-x0)(:) > 100*tol), + if verbose || inspect, printf ("not ok %i\n",cnt); end + [max(abs (x2-x0)(:)), 100*tol] + if inspect, keyboard; end + ok = 0 ; + else + if verbose, + printf ("ok %i\n function evaluations = %i\n",cnt,nf); + end + end + cnt++; + + # Use vanilla nelder_mead_min + mytic (); + [x2,v,nf] = nelder_mead_min (fname, {x1,x0,z}) ; + t1 = mytic (); + + if any (abs (x2-x0)(:) > 100*tol), + if verbose || inspect, printf ("not ok %i\n",cnt); end + [max(abs (x2-x0)(:)), 100*tol] + if inspect, keyboard; end + ok = 0 ; + else + if verbose, + printf ("ok %i\n function evaluations = %i\n",cnt,nf); + end + end + cnt++; + + + # Optimize wrt 2nd arg. + ctl = nan * zeros (1,6); + ctl(6) = 0; + ctl(3) = 2; + + mytic (); + [x2,v,nf] = nelder_mead_min (fname, {x1,x0,z}, ctl) ; + t0 = mytic (); + + if any (abs (x2-x1)(:) > 100*tol), + if verbose || inspect, printf ("not ok %i\n",cnt); end + [max(abs (x2-x0)(:)), 100*tol] + if inspect, keyboard; end + ok = 0 ; + else + if verbose, + printf ("ok %i\n function evaluations = %i\n",cnt,nf); + end + end + cnt++; + + # Optimize wrt 2nd arg. + ctl = nan * zeros (1,6); + ctl(3) = 2; + + mytic (); + [x2,v,nf] = nelder_mead_min (fname, {x1,x0,z}, ctl) ; + t1 = mytic (); + + if any (abs (x2-x1)(:) > tol), + if verbose || inspect, printf ("not ok %i\n",cnt); end + [max(abs (x2-x0)(:)), 100*tol] + if inspect, keyboard; end + ok = 0 ; + else + if verbose, + printf ("ok %i\n function evaluations = %i\n",cnt,nf); + end + end + cnt++; + if 0 + # Check with struct control variable + ctls = struct ("narg", 2); + [x2bis,vbis,nfbis] = nelder_mead_min (fname, {x1,x0,z}, ctls) ; + t1 = mytic (); + ## [nf,nfbis] + if any ((x2-x2bis)(:)) + if verbose || inspect, printf ("not ok %i\n",cnt); end + printf (" struct ctl : x2 - x2bis -> %g\n", max(abs (x2-x2bis)(:))); + if inspect, keyboard; end + ok = 0 ; + else + if verbose, + printf ("ok %i\n function evaluations = %i\n",cnt,nfbis); + end + end + cnt++; + + # Check with named args + [x2bis,vbis,nfbis] = nelder_mead_min (fname, {x1,x0,z}, "narg", 2) ; + t1 = mytic (); + ## [nf,nfbis] + if any ((x2-x2bis)(:)) + if verbose || inspect, printf ("not ok %i\n",cnt); end + printf (" named arg : x2 - x2bis -> %g\n", max(abs (x2-x2bis)(:))); + if inspect, keyboard; end + ok = 0 ; + else + if verbose, + printf ("ok %i\n function evaluations = %i\n",cnt,nfbis); + end + end + cnt++; + end +end + +if verbose && ok + printf ("All tests ok\n"); +end + + diff --git a/octave_packages/optim-1.2.0/test_nelder_mead_min_2.m b/octave_packages/optim-1.2.0/test_nelder_mead_min_2.m new file mode 100644 index 0000000..b43bc52 --- /dev/null +++ b/octave_packages/optim-1.2.0/test_nelder_mead_min_2.m @@ -0,0 +1,153 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Checks wether the function 'nelder_mead_min' accepts options properly + +ok = 1; +cnt = 1; + +if ! exist ("verbose"), verbose = 0; end +if ! exist ("inspect"), inspect = 0; end + +if verbose, + printf (["test_nelder_mead_2\n",\ + " Check whether nelder_mead_min accepts options properly\n\n"]); +end + +N = 2; +x1 = zeros (1,N); +small = 1e-3; +vol = (small^N) / factorial (N); + +## Define simple 2D function : [x,y] -> x^2, start from [0,0] +## + +function c = my_func (x) + c = x(1)^2; +end + +###################################################################### +## Test using volume ################################################# + +## Choose vtol and initial simplex so that algo should stop immediately. +ctl = struct ("verbose",verbose, "isz",small, "vtol",vol*1.01, "rst",0); + +[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); + +if nev != N+1 + if verbose || inspect, printf ("not ok %i\n",cnt); end + if inspect, keyboard; end + ok = 0 ; +else + if verbose, + printf ("ok %i\n",cnt); + end +end +cnt++; + +## Choose vtol and initial simplex so that algo should stop after one +## iteration (should be a reflexion and a tentative extension). Total is 5 +## evaluations. +ctl = struct ("verbose",verbose, "isz",small, "vtol",vol*0.99, "rst",0); + +x1 = [0,0]; + +[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); + +if nev != N+3 + if verbose || inspect, printf ("not ok %i\n",cnt); end + if inspect, keyboard; end + ok = 0 ; +else + if verbose, + printf ("ok %i\n",cnt); + end +end +cnt++; + +###################################################################### +## Test using radius ################################################# + +## Choose rtol and initial simplex so that algo stops immediately. +ctl = struct ("verbose",verbose, "isz",small, "rtol",small*2.01, "rst",0); + +[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); + +if nev != N+1 + if verbose || inspect, printf ("not ok %i\n",cnt); end + if inspect, keyboard; end + ok = 0 ; +else + if verbose, + printf ("ok %i\n",cnt); + end +end +cnt++; + +## Choose rtol and initial simplex so that algo does not stop immediately. +ctl = struct ("verbose",verbose, "isz",small, "rtol",small*1.99, "rst",0); + +[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); + +if nev <= N+1 + if verbose || inspect, printf ("not ok %i\n",cnt); end + if inspect, keyboard; end + ok = 0 ; +else + if verbose, + printf ("ok %i\n",cnt); + end +end +cnt++; + +###################################################################### +## Test using values ################################################# + +## Choose rtol and initial simplex so that algo should stop immediately. +ctl = struct ("verbose",verbose, "isz",small, "ftol",1.01*small^2, "rst",0); + +[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); + +if nev != N+1 + if verbose || inspect, printf ("not ok %i\n",cnt); end + if inspect, keyboard; end + ok = 0 ; +else + if verbose, + printf ("ok %i\n",cnt); + end +end +cnt++; + +## Choose rtol and initial simplex so that algo does not stop immediately. +ctl = struct ("verbose",verbose, "isz",small, "ftol",0.99*small^2, "rst",0); + +[x2,v,nev] = nelder_mead_min ("my_func", x1, ctl); + +if nev <= N+1 + if verbose || inspect, printf ("not ok %i\n",cnt); end + if inspect, keyboard; end + ok = 0 ; +else + if verbose + printf ("ok %i\n",cnt); + end +end +cnt++; + +cnt--; +if verbose && ok + printf ("All %i tests ok\n", cnt); +end diff --git a/octave_packages/optim-1.2.0/test_wpolyfit.m b/octave_packages/optim-1.2.0/test_wpolyfit.m new file mode 100644 index 0000000..5499392 --- /dev/null +++ b/octave_packages/optim-1.2.0/test_wpolyfit.m @@ -0,0 +1,512 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## Tests for wpolyfit. +## +## Test cases are taken from the NIST Statistical Reference Datasets +## http://www.itl.nist.gov/div898/strd/ + +1; + +function do_test(n,x,y,p,dp,varargin) + [myp,s] = wpolyfit(x,y,n,varargin{:}); + %if length(varargin)==0, [myp,s] = polyfit(x,y,n); else return; end + mydp = sqrt(sumsq(inv(s.R'))'/s.df)*s.normr; + if length(varargin)>0, mydp = [mydp;0]; end %origin + %[svdp,j,svddp] = svdfit(x,y,n); + disp('parameter certified value rel. error'); + [myp(:), p, abs((myp(:)-p)./p)] %, svdp, abs((svdp-p)./p) ] + disp('p-error certified value rel. error'); + [mydp(:), dp, abs((mydp(:) - dp)./dp)] %, svdp, abs((svddp - dp)./dp)] + input('Press to proceed to the next test'); +endfunction + +## x y dy +data = [0.0013852 0.2144023 0.0020470 + 0.0018469 0.2516856 0.0022868 + 0.0023087 0.3070443 0.0026362 + 0.0027704 0.3603186 0.0029670 + 0.0032322 0.4260864 0.0033705 + 0.0036939 0.4799956 0.0036983 ]; +x=data(:,1); y=data(:,2); dy=data(:,3); +wpolyfit(x,y,dy,1); +disp('computing parameter uncertainty from monte carlo simulation...'); +fflush(stdout); +n=100; p=zeros(2,n); +for i=1:n, p(:,i)=(polyfit(x,y+randn(size(y)).*dy,1)).'; end +printf("%15s %15s\n", "Coefficient", "Error"); +printf("%15g %15g\n", [mean(p'); std(p')]); +input('Press to see some sample regression lines: '); +t = [x(1), x(length(x))]; +[p,s] = wpolyfit(x,y,dy,1); dp=sqrt(sumsq(inv(s.R'))'/s.df)*s.normr; +hold off; +for i=1:15, plot(t,polyval(p(:)+randn(size(dp)).*dp,t),'-g;;'); hold on; end +errorbar(x,y,dy,"~b;;"); +[yf,dyf]=polyconf(p,x,s,0.05,'ci'); +plot(x,yf-dyf,"-r;;",x,yf+dyf,'-r;95% confidence interval;') +hold off; +input('Press to continue with the tests: '); + + +##Procedure: Linear Least Squares Regression +##Reference: Filippelli, A., NIST. +##Model: Polynomial Class +## 11 Parameters (B0,B1,...,B10) +## +## y = B0 + B1*x + B2*(x**2) + ... + B9*(x**9) + B10*(x**10) + e + +##Data: +## y x +data = [ 0.8116 -6.860120914 + 0.9072 -4.324130045 + 0.9052 -4.358625055 + 0.9039 -4.358426747 + 0.8053 -6.955852379 + 0.8377 -6.661145254 + 0.8667 -6.355462942 + 0.8809 -6.118102026 + 0.7975 -7.115148017 + 0.8162 -6.815308569 + 0.8515 -6.519993057 + 0.8766 -6.204119983 + 0.8885 -5.853871964 + 0.8859 -6.109523091 + 0.8959 -5.79832982 + 0.8913 -5.482672118 + 0.8959 -5.171791386 + 0.8971 -4.851705903 + 0.9021 -4.517126416 + 0.909 -4.143573228 + 0.9139 -3.709075441 + 0.9199 -3.499489089 + 0.8692 -6.300769497 + 0.8872 -5.953504836 + 0.89 -5.642065153 + 0.891 -5.031376979 + 0.8977 -4.680685696 + 0.9035 -4.329846955 + 0.9078 -3.928486195 + 0.7675 -8.56735134 + 0.7705 -8.363211311 + 0.7713 -8.107682739 + 0.7736 -7.823908741 + 0.7775 -7.522878745 + 0.7841 -7.218819279 + 0.7971 -6.920818754 + 0.8329 -6.628932138 + 0.8641 -6.323946875 + 0.8804 -5.991399828 + 0.7668 -8.781464495 + 0.7633 -8.663140179 + 0.7678 -8.473531488 + 0.7697 -8.247337057 + 0.77 -7.971428747 + 0.7749 -7.676129393 + 0.7796 -7.352812702 + 0.7897 -7.072065318 + 0.8131 -6.774174009 + 0.8498 -6.478861916 + 0.8741 -6.159517513 + 0.8061 -6.835647144 + 0.846 -6.53165267 + 0.8751 -6.224098421 + 0.8856 -5.910094889 + 0.8919 -5.598599459 + 0.8934 -5.290645224 + 0.894 -4.974284616 + 0.8957 -4.64454848 + 0.9047 -4.290560426 + 0.9129 -3.885055584 + 0.9209 -3.408378962 + 0.9219 -3.13200249 + 0.7739 -8.726767166 + 0.7681 -8.66695597 + 0.7665 -8.511026475 + 0.7703 -8.165388579 + 0.7702 -7.886056648 + 0.7761 -7.588043762 + 0.7809 -7.283412422 + 0.7961 -6.995678626 + 0.8253 -6.691862621 + 0.8602 -6.392544977 + 0.8809 -6.067374056 + 0.8301 -6.684029655 + 0.8664 -6.378719832 + 0.8834 -6.065855188 + 0.8898 -5.752272167 + 0.8964 -5.132414673 + 0.8963 -4.811352704 + 0.9074 -4.098269308 + 0.9119 -3.66174277 + 0.9228 -3.2644011]; + +##Certified values: +## p dP +target = [ -1467.48961422980 298.084530995537 + -2772.17959193342 559.779865474950 + -2316.37108160893 466.477572127796 + -1127.97394098372 227.204274477751 + -354.478233703349 71.6478660875927 + -75.1242017393757 15.2897178747400 + -10.8753180355343 2.23691159816033 + -1.06221498588947 0.221624321934227 + -0.670191154593408E-01 0.142363763154724E-01 + -0.246781078275479E-02 0.535617408889821E-03 + -0.402962525080404E-04 0.896632837373868E-05]; +if 1 + disp("Filippelli, A., NIST."); + do_test(10, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif + +##Procedure: Linear Least Squares Regression +## +##Reference: Pontius, P., NIST. +## Load Cell Calibration. +## +##Model: Quadratic Class +## 3 Parameters (B0,B1,B2) +## y = B0 + B1*x + B2*(x**2) + + +##Data: y x +data = [ \ + .11019 150000 + .21956 300000 + .32949 450000 + .43899 600000 + .54803 750000 + .65694 900000 + .76562 1050000 + .87487 1200000 + .98292 1350000 + 1.09146 1500000 + 1.20001 1650000 + 1.30822 1800000 + 1.41599 1950000 + 1.52399 2100000 + 1.63194 2250000 + 1.73947 2400000 + 1.84646 2550000 + 1.95392 2700000 + 2.06128 2850000 + 2.16844 3000000 + .11052 150000 + .22018 300000 + .32939 450000 + .43886 600000 + .54798 750000 + .65739 900000 + .76596 1050000 + .87474 1200000 + .98300 1350000 + 1.09150 1500000 + 1.20004 1650000 + 1.30818 1800000 + 1.41613 1950000 + 1.52408 2100000 + 1.63159 2250000 + 1.73965 2400000 + 1.84696 2550000 + 1.95445 2700000 + 2.06177 2850000 + 2.16829 3000000 ]; + +## Certified Regression Statistics +## +## Standard Deviation +## Estimate of Estimate +target = [ \ + 0.673565789473684E-03 0.107938612033077E-03 + 0.732059160401003E-06 0.157817399981659E-09 + -0.316081871345029E-14 0.486652849992036E-16 ]; + +if 1 + disp("Pontius, P., NIST"); + do_test(2, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif + + + +#Procedure: Linear Least Squares Regression +#Reference: Eberhardt, K., NIST. +#Model: Linear Class +# 1 Parameter (B1) +# +# y = B1*x + e + +#Data: y x +data =[\ + 130 60 + 131 61 + 132 62 + 133 63 + 134 64 + 135 65 + 136 66 + 137 67 + 138 68 + 139 69 + 140 70 ]; + + +# Certified Regression Statistics +# +# Standard Deviation +# Estimate of Estimate +target = [ \ + 0 0 + 2.07438016528926 0.165289256198347E-01 ]; + + +if 1 + disp("Eberhardt, K., NIST"); + do_test(1, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2)),'origin'); +endif + + +#Reference: Wampler, R. H. (1970). +# A Report of the Accuracy of Some Widely-Used Least +# Squares Computer Programs. +# Journal of the American Statistical Association, 65, 549-565. +# +#Model: Polynomial Class +# 6 Parameters (B0,B1,...,B5) +# +# y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) +# +# Certified Regression Statistics +# +# Standard Deviation +# Parameter Estimate of Estimate +target = [\ + 1.00000000000000 0.000000000000000 + 1.00000000000000 0.000000000000000 + 1.00000000000000 0.000000000000000 + 1.00000000000000 0.000000000000000 + 1.00000000000000 0.000000000000000 + 1.00000000000000 0.000000000000000 ]; + +#Data: y x +data = [\ + 1 0 + 6 1 + 63 2 + 364 3 + 1365 4 + 3906 5 + 9331 6 + 19608 7 + 37449 8 + 66430 9 + 111111 10 + 177156 11 + 271453 12 + 402234 13 + 579195 14 + 813616 15 + 1118481 16 + 1508598 17 + 2000719 18 + 2613660 19 + 3368421 20 ]; + +if 1 + disp("Wampler1"); + do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif + +##Reference: Wampler, R. H. (1970). +## A Report of the Accuracy of Some Widely-Used Least +## Squares Computer Programs. +## Journal of the American Statistical Association, 65, 549-565. +##Model: Polynomial Class +## 6 Parameters (B0,B1,...,B5) +## +## y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) +## +## Certified Regression Statistics +## Standard Deviation +## Parameter Estimate of Estimate +target = [ \ + 1.00000000000000 0.000000000000000 + 0.100000000000000 0.000000000000000 + 0.100000000000000E-01 0.000000000000000 + 0.100000000000000E-02 0.000000000000000 + 0.100000000000000E-03 0.000000000000000 + 0.100000000000000E-04 0.000000000000000 ]; + + +#Data: y x +data = [ \ + 1.00000 0 + 1.11111 1 + 1.24992 2 + 1.42753 3 + 1.65984 4 + 1.96875 5 + 2.38336 6 + 2.94117 7 + 3.68928 8 + 4.68559 9 + 6.00000 10 + 7.71561 11 + 9.92992 12 + 12.75603 13 + 16.32384 14 + 20.78125 15 + 26.29536 16 + 33.05367 17 + 41.26528 18 + 51.16209 19 + 63.00000 20 ]; + +if 1 + disp("Wampler2"); + do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif + + + + +##Reference: Wampler, R. H. (1970). +## A Report of the Accuracy of Some Widely-Used Least +## Squares Computer Programs. +## Journal of the American Statistical Association, 65, 549-565. +## +##Model: Polynomial Class +## 6 Parameters (B0,B1,...,B5) +## +## y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) +## +## Certified Regression Statistics +## +## Standard Deviation +## Parameter Estimate of Estimate +target = [\ + 1.00000000000000 2152.32624678170 + 1.00000000000000 2363.55173469681 + 1.00000000000000 779.343524331583 + 1.00000000000000 101.475507550350 + 1.00000000000000 5.64566512170752 + 1.00000000000000 0.112324854679312 ]; + +#Data: y x +data = [ \ + 760. 0 + -2042. 1 + 2111. 2 + -1684. 3 + 3888. 4 + 1858. 5 + 11379. 6 + 17560. 7 + 39287. 8 + 64382. 9 + 113159. 10 + 175108. 11 + 273291. 12 + 400186. 13 + 581243. 14 + 811568. 15 + 1121004. 16 + 1506550. 17 + 2002767. 18 + 2611612. 19 + 3369180. 20 ]; +if 1 + disp("Wampler3"); + do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif + +##Model: Polynomial Class +## 6 Parameters (B0,B1,...,B5) +## +## y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) +## +## Certified Regression Statistics +## +## Standard Deviation +## Parameter Estimate of Estimate +target = [\ + 1.00000000000000 215232.624678170 + 1.00000000000000 236355.173469681 + 1.00000000000000 77934.3524331583 + 1.00000000000000 10147.5507550350 + 1.00000000000000 564.566512170752 + 1.00000000000000 11.2324854679312 ]; + +#Data: y x +data = [\ + 75901 0 + -204794 1 + 204863 2 + -204436 3 + 253665 4 + -200894 5 + 214131 6 + -185192 7 + 221249 8 + -138370 9 + 315911 10 + -27644 11 + 455253 12 + 197434 13 + 783995 14 + 608816 15 + 1370781 16 + 1303798 17 + 2205519 18 + 2408860 19 + 3444321 20 ]; + +if 1 + disp("Wampler4"); + do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif + + + +##Model: Polynomial Class +## 6 Parameters (B0,B1,...,B5) +## +## y = B0 + B1*x + B2*(x**2) + B3*(x**3)+ B4*(x**4) + B5*(x**5) +## +## Certified Regression Statistics +## +## Standard Deviation +## Parameter Estimate of Estimate +target = [\ + 1.00000000000000 21523262.4678170 + 1.00000000000000 23635517.3469681 + 1.00000000000000 7793435.24331583 + 1.00000000000000 1014755.07550350 + 1.00000000000000 56456.6512170752 + 1.00000000000000 1123.24854679312 ]; + +##Data: y x +data = [ \ + 7590001 0 + -20479994 1 + 20480063 2 + -20479636 3 + 25231365 4 + -20476094 5 + 20489331 6 + -20460392 7 + 18417449 8 + -20413570 9 + 20591111 10 + -20302844 11 + 18651453 12 + -20077766 13 + 21059195 14 + -19666384 15 + 26348481 16 + -18971402 17 + 22480719 18 + -17866340 19 + 10958421 20 ]; +if 1 + disp("Wampler5"); + do_test(5, data(:,2),data(:,1),flipud(target(:,1)),flipud(target(:,2))); +endif diff --git a/octave_packages/optim-1.2.0/vfzero.m b/octave_packages/optim-1.2.0/vfzero.m new file mode 100644 index 0000000..ba92a26 --- /dev/null +++ b/octave_packages/optim-1.2.0/vfzero.m @@ -0,0 +1,367 @@ +## Copyright (C) 2008, 2009 VZLU Prague, a.s. +## Copyright (C) 2010 Olaf Till +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} vfzero (@var{fun}, @var{x0}) +## @deftypefnx {Function File} {} vfzero (@var{fun}, @var{x0}, @var{options}) +## @deftypefnx {Function File} {[@var{x}, @var{fval}, @var{info}, @var{output}] =} vfzero (@dots{}) +## A variant of @code{fzero}. Finds a zero of a vector-valued +## multivariate function where each output element only depends on the +## input element with the same index (so the Jacobian is diagonal). +## +## @var{fun} should be a handle or name of a function returning a column +## vector. @var{x0} should be a two-column matrix, each row specifying +## two points which bracket a zero of the respective output element of +## @var{fun}. +## +## If @var{x0} is a single-column matrix 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{vfzero} +## 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 and +## @var{fval}, the function value thereof. @var{info} is a column vector +## of exit flags 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-column matrix with the final bracketing of the +## zero along the x-axis. +## +## @item brackety A two-column matrix 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. + +## Author: Jaroslav Hajek + +## PKG_ADD: __all_opts__ ("vfzero"); + +function [x, fval, info, output] = vfzero (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); + nx = rows (x0); + ## fun may assume a certain length of x, so we will always call it + ## with the full-length x, even if only some elements are needed + + 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 = zeros (nx, 1); + niter = 0; + nfev = 0; + + x = fval = fc = a = fa = b = fb = aa = c = u = fu = NaN (nx, 1); + bracket_ready = false (nx, 1); + eps = eps (class (x0)); + + ## Prepare... + a = x0(:, 1); + fa = fun (a)(:); + nfev = 1; + if (columns (x0) > 1) + b = x0(:, 2); + fb = fun (b)(:); + nfev += 1; + else + ## Try to get b. + aa(idx = a == 0) = 1; + aa(! idx) = a(! idx); + for tb = [0.9*aa, 1.1*aa, aa-1, aa+1, 0.5*aa 1.5*aa, -aa, 2*aa, -10*aa, 10*aa] + tfb = fun (tb)(:); nfev += 1; + idx = ! bracket_ready & sign (fa) .* sign (tfb) <= 0; + bracket_ready |= idx; + b(idx) = tb(idx); + fb(idx) = tfb(idx); + if (all (bracket_ready)) + break; + endif + endfor + endif + + tp = a(idx = b < a); + a(idx) = b(idx); + b(idx) = tp; + + tp = fa(idx); + fa(idx) = fb(idx); + fb(idx) = tp; + + if (! all (sign (fa) .* sign (fb) <= 0)) + error ("fzero:bracket", "vfzero: not a valid initial bracketing"); + endif + + slope0 = (fb - fa) ./ (b - a); + + idx = fa == 0; + b(idx) = a(idx); + fb(idx) = fa(idx); + + idx = (! idx & fb == 0); + a(idx) = b(idx); + fa(idx) = fb(idx); + + itype = ones (nx, 1); + + idx = abs (fa) < abs (fb); + u(idx) = a(idx); fu(idx) = fa(idx); + u(! idx) = b(! idx); fu(! idx) = fb(! idx); + + d = e = u; + fd = fe = fu; + mba = mu * (b - a); + not_ready = true (nx, 1); + while (niter < maxiter && nfev < maxfev && any (not_ready)) + + ## itype == 1 + type1idx = not_ready & itype == 1; + ## The initial test. + idx = b - a <= 2*(2 * eps * abs (u) + tolx) & type1idx; + x(idx) = u(idx); fval(idx) = fu(idx); + info(idx) = 1; + not_ready(idx) = false; + type1idx &= not_ready; + exclidx = type1idx; + ## Secant step. + idx = type1idx & \ + (tidx = abs (fa) <= 1e3*abs (fb) & abs (fb) <= 1e3*abs (fa)); + c(idx) = u(idx) - (a(idx) - b(idx)) ./ (fa(idx) - fb(idx)) .* fu(idx); + ## Bisection step. + idx = type1idx & ! tidx; + c(idx) = 0.5*(a(idx) + b(idx)); + d(type1idx) = u(type1idx); fd(type1idx) = fu(type1idx); + itype(type1idx) = 5; + + ## itype == 2 or 3 + type23idx = not_ready & ! exclidx & (itype == 2 | itype == 3); + exclidx |= type23idx; + uidx = cellfun (@ (x) length (unique (x)), \ + num2cell ([fa, fb, fd, fe], 2)) == 4; + oidx = sign (c - a) .* sign (c - b) > 0; + ## Inverse cubic interpolation. + idx = type23idx & (uidx & ! oidx); + q11 = (d(idx) - e(idx)) .* fd(idx) ./ (fe(idx) - fd(idx)); + q21 = (b(idx) - d(idx)) .* fb(idx) ./ (fd(idx) - fb(idx)); + q31 = (a(idx) - b(idx)) .* fa(idx) ./ (fb(idx) - fa(idx)); + d21 = (b(idx) - d(idx)) .* fd(idx) ./ (fd(idx) - fb(idx)); + d31 = (a(idx) - b(idx)) .* fb(idx) ./ (fb(idx) - fa(idx)); + q22 = (d21 - q11) .* fb(idx) ./ (fe(idx) - fb(idx)); + q32 = (d31 - q21) .* fa(idx) ./ (fd(idx) - fa(idx)); + d32 = (d31 - q21) .* fd(idx) ./ (fd(idx) - fa(idx)); + q33 = (d32 - q22) .* fa(idx) ./ (fe(idx) - fa(idx)); + c(idx) = a(idx) + q31 + q32 + q33; + ## Quadratic interpolation + newton. + idx = type23idx & (oidx | ! uidx); + a0 = fa(idx); + a1 = (fb(idx) - fa(idx))./(b(idx) - a(idx)); + a2 = ((fd(idx) - fb(idx))./(d(idx) - b(idx)) - a1) ./ (d(idx) - a(idx)); + ## Modification 1: this is simpler and does not seem to be worse. + c(idx) = a(idx) - a0./a1; + taidx = a2 != 0; + tidx = idx; + tidx(tidx) = taidx; + c(tidx) = a(tidx)(:) - (a0(taidx)./a1(taidx))(:); + for i = 1:3 + tidx &= i <= itype; + taidx = tidx(idx); + pc = a0(taidx)(:) + (a1(taidx)(:) + \ + a2(taidx)(:).*(c(tidx) - b(tidx))(:)) \ + .*(c(tidx) - a(tidx))(:); + pdc = a1(taidx)(:) + a2(taidx)(:).*(2*c(tidx) - a(tidx) - b(tidx))(:); + tidx0 = tidx; + tidx0(tidx0, 1) &= (p0idx = pdc == 0); + taidx0 = tidx0(idx); + tidx(tidx, 1) &= ! p0idx; + c(tidx0) = a(tidx0)(:) - (a0(taidx0)./a1(taidx0))(:); + c(tidx) = c(tidx)(:) - (pc(! p0idx)./pdc(! p0idx))(:); + endfor + itype(type23idx) += 1; + + ## itype == 4 + type4idx = not_ready & ! exclidx & itype == 4; + exclidx |= type4idx; + ## Double secant step. + idx = type4idx; + c(idx) = u(idx) - 2*(b(idx) - a(idx))./(fb(idx) - fa(idx)).*fu(idx); + ## Bisect if too far. + idx = type4idx & abs (c - u) > 0.5*(b - a); + c(idx) = 0.5 * (b(idx) + a(idx)); + itype(type4idx) = 5; + + ## itype == 5 + type5idx = not_ready & ! exclidx & itype == 5; + ## Bisection step. + idx = type5idx; + c(idx) = 0.5 * (b(idx) + a(idx)); + itype(type5idx) = 2; + + ## Don't let c come too close to a or b. + delta = 2*0.7*(2 * eps * abs (u) + tolx); + nidx = not_ready & ! (idx = b - a <= 2*delta); + idx &= not_ready; + c(idx) = (a(idx) + b(idx))/2; + c(nidx) = max (a(nidx) + delta(nidx), \ + min (b(nidx) - delta(nidx), c(nidx))); + + ## Calculate new point. + idx = not_ready; + x(idx, 1) = c(idx, 1); + if (any (idx)) + c(! idx) = u(! idx); # to have some working place-holders since + # fun() might expect full-length + # argument + fval(idx, 1) = fc(idx, 1) = fun (c)(:)(idx, 1); + niter ++; nfev ++; + endif + + ## Modification 2: skip inverse cubic interpolation if + ## nonmonotonicity is detected. + nidx = not_ready & ! (idx = sign (fc - fa) .* sign (fc - fb) >= 0); + idx &= not_ready; + ## The new point broke monotonicity. + ## Disable inverse cubic. + fe(idx) = fc(idx); + ## + e(nidx) = d(nidx); fe(nidx) = fd(nidx); + + ## Bracketing. + idx1 = not_ready & sign (fa) .* sign (fc) < 0; + idx2 = not_ready & ! idx1 & sign (fb) .* sign (fc) < 0; + idx3 = not_ready & ! (idx1 | idx2) & fc == 0; + d(idx1) = b(idx1); fd(idx1) = fb(idx1); + b(idx1) = c(idx1); fb(idx1) = fc(idx1); + d(idx2) = a(idx2); fd(idx2) = fa(idx2); + a(idx2) = c(idx2); fa(idx2) = fc(idx2); + a(idx3) = b(idx3) = c(idx3); fa(idx3) = fb(idx3) = fc(idx3); + info(idx3) = 1; + not_ready(idx3) = false; + if (any (not_ready & ! (idx1 | idx2 | idx3))) + ## This should never happen. + error ("fzero:bracket", "vfzero: zero point is not bracketed"); + endif + + ## If there's an output function, use it now. + if (! isempty (outfcn)) + optv.funccount = nfev; + optv.fval = fval; + optv.iteration = niter; + idx = not_ready & outfcn (x, optv, "iter"); + info(idx) = -1; + not_ready(idx) = false; + endif + + nidx = not_ready & ! (idx = abs (fa) < abs (fb)); + idx &= not_ready; + u(idx) = a(idx); fu(idx) = fa(idx); + u(nidx) = b(nidx); fu(nidx) = fb(nidx); + idx = not_ready & b - a <= 2*(2 * eps * abs (u) + tolx); + info(idx) = 1; + not_ready(idx) = false; + + ## Skip bisection step if successful reduction. + itype(not_ready & itype == 5 & (b - a) <= mba) = 2; + idx = not_ready & itype == 2; + mba(idx) = mu * (b(idx) - a(idx)); + endwhile + + ## Check solution for a singularity by examining slope + idx = not_ready & info == 1 & (b - a) != 0; + idx(idx, 1) &= \ + abs ((fb(idx, 1) - fa(idx, 1))./(b(idx, 1) - a(idx, 1)) \ + ./ slope0(idx, 1)) > max (1e6, 0.5/(eps+tolx)); + info(idx) = - 5; + + 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); + if (! isreal (fx)) + error ("fzero:notreal", "vfzero: non-real value encountered"); + elseif (any (isnan (fx))) + error ("fzero:isnan", "vfzero: NaN value encountered"); + endif +endfunction + +%!shared opt0 +%! opt0 = optimset ("tolx", 0); +%!assert(vfzero(@cos, [0, 3], opt0), pi/2, 10*eps) +%!assert(vfzero(@(x) x^(1/3) - 1e-8, [0,1], opt0), 1e-24, 1e-22*eps) diff --git a/octave_packages/optim-1.2.0/wpolyfit.m b/octave_packages/optim-1.2.0/wpolyfit.m new file mode 100644 index 0000000..a9563fa --- /dev/null +++ b/octave_packages/optim-1.2.0/wpolyfit.m @@ -0,0 +1,261 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{p}, @var{s}] =} wpolyfit (@var{x}, @var{y}, @var{dy}, @var{n}) +## Return the coefficients of a polynomial @var{p}(@var{x}) of degree +## @var{n} that minimizes +## @iftex +## @tex +## $$ +## \sum_{i=1}^N (p(x_i) - y_i)^2 +## $$ +## @end tex +## @end iftex +## @ifinfo +## @code{sumsq (p(x(i)) - y(i))}, +## @end ifinfo +## to best fit the data in the least squares sense. The standard error +## on the observations @var{y} if present are given in @var{dy}. +## +## The returned value @var{p} contains the polynomial coefficients +## suitable for use in the function polyval. The structure @var{s} returns +## information necessary to compute uncertainty in the model. +## +## To compute the predicted values of y with uncertainty use +## @example +## [y,dy] = polyconf(p,x,s,'ci'); +## @end example +## You can see the effects of different confidence intervals and +## prediction intervals by calling the wpolyfit internal plot +## function with your fit: +## @example +## feval('wpolyfit:plt',x,y,dy,p,s,0.05,'pi') +## @end example +## Use @var{dy}=[] if uncertainty is unknown. +## +## You can use a chi^2 test to reject the polynomial fit: +## @example +## p = 1-chi2cdf(s.normr^2,s.df); +## @end example +## p is the probability of seeing a chi^2 value higher than that which +## was observed assuming the data are normally distributed around the fit. +## If p < 0.01, you can reject the fit at the 1% level. +## +## You can use an F test to determine if a higher order polynomial +## improves the fit: +## @example +## [poly1,S1] = wpolyfit(x,y,dy,n); +## [poly2,S2] = wpolyfit(x,y,dy,n+1); +## F = (S1.normr^2 - S2.normr^2)/(S1.df-S2.df)/(S2.normr^2/S2.df); +## p = 1-f_cdf(F,S1.df-S2.df,S2.df); +## @end example +## p is the probability of observing the improvement in chi^2 obtained +## by adding the extra parameter to the fit. If p < 0.01, you can reject +## the lower order polynomial at the 1% level. +## +## You can estimate the uncertainty in the polynomial coefficients +## themselves using +## @example +## dp = sqrt(sumsq(inv(s.R'))'/s.df)*s.normr; +## @end example +## but the high degree of covariance amongst them makes this a questionable +## operation. +## +## @deftypefnx {Function File} {[@var{p}, @var{s}, @var{mu}] =} wpolyfit (...) +## +## If an additional output @code{mu = [mean(x),std(x)]} is requested then +## the @var{x} values are centered and normalized prior to computing the fit. +## This will give more stable numerical results. To compute a predicted +## @var{y} from the returned model use +## @code{y = polyval(p, (x-mu(1))/mu(2)} +## +## @deftypefnx {Function File} wpolyfit (...) +## +## If no output arguments are requested, then wpolyfit plots the data, +## the fitted line and polynomials defining the standard error range. +## +## Example +## @example +## x = linspace(0,4,20); +## dy = (1+rand(size(x)))/2; +## y = polyval([2,3,1],x) + dy.*randn(size(x)); +## wpolyfit(x,y,dy,2); +## @end example +## +## @deftypefnx {Function File} wpolyfit (..., 'origin') +## +## If 'origin' is specified, then the fitted polynomial will go through +## the origin. This is generally ill-advised. Use with caution. +## +## Hocking, RR (2003). Methods and Applications of Linear Models. +## New Jersey: John Wiley and Sons, Inc. +## +## @end deftypefn +## @seealso{polyfit,polyconf} + +function [p_out, s, mu] = wpolyfit (varargin) + + ## strip 'origin' of the end + args = length(varargin); + if args>0 && ischar(varargin{args}) + origin = varargin{args}; + args--; + else + origin=''; + endif + ## strip polynomial order off the end + if args>0 + n = varargin{args}; + args--; + else + n = []; + end + ## interpret the remainder as x,y or x,y,dy or [x,y] or [x,y,dy] + if args == 3 + x = varargin{1}; + y = varargin{2}; + dy = varargin{3}; + elseif args == 2 + x = varargin{1}; + y = varargin{2}; + dy = []; + elseif args == 1 + A = varargin{1}; + [nr,nc]=size(A); + if all(nc!=[2,3]) + error("wpolyfit expects vectors x,y,dy or matrix [x,y,dy]"); + endif + dy = []; + if nc == 3, dy = A(:,3); endif + y = A(:,2); + x = A(:,1); + else + usage ("wpolyfit (x, y [, dy], n [, 'origin'])"); + end + + if (length(origin) == 0) + through_origin = 0; + elseif strcmp(origin,'origin') + through_origin = 1; + else + error ("wpolyfit: expected 'origin' but found '%s'", origin) + endif + + if any(size (x) != size (y)) + error ("wpolyfit: x and y must be vectors of the same size"); + endif + if length(dy)>1 && length(y) != length(dy) + error ("wpolyfit: dy must be a vector the same length as y"); + endif + + if (! (isscalar (n) && n >= 0 && ! isinf (n) && n == round (n))) + error ("wpolyfit: n must be a nonnegative integer"); + endif + + if nargout == 3 + mu = [mean(x), std(x)]; + x = (x - mu(1))/mu(2); + endif + + k = length (x); + + ## observation matrix + if through_origin + ## polynomial through the origin y = ax + bx^2 + cx^3 + ... + A = (x(:) * ones(1,n)) .^ (ones(k,1) * (n:-1:1)); + else + ## polynomial least squares y = a + bx + cx^2 + dx^3 + ... + A = (x(:) * ones (1, n+1)) .^ (ones (k, 1) * (n:-1:0)); + endif + + [p,s] = wsolve(A,y(:),dy(:)); + + if through_origin + p(n+1) = 0; + endif + + if nargout == 0 + good_fit = 1-chi2cdf(s.normr^2,s.df); + printf("Polynomial: %s [ p(chi^2>observed)=%.2f%% ]\n", polyout(p,'x'), good_fit*100); + plt(x,y,dy,p,s,'ci'); + else + p_out = p'; + endif + +function plt(x,y,dy,p,s,varargin) + + if iscomplex(p) + # XXX FIXME XXX how to plot complex valued functions? + # Maybe using hue for phase and saturation for magnitude + # e.g., Frank Farris (Santa Cruz University) has this: + # http://www.maa.org/pubs/amm_complements/complex.html + # Could also look at the book + # Visual Complex Analysis by Tristan Needham, Oxford Univ. Press + # but for now we punt + return + end + + ## decorate the graph + grid('on'); + xlabel('abscissa X'); ylabel('data Y'); + title('Least-squares Polynomial Fit with Error Bounds'); + + ## draw fit with estimated error bounds + xf = linspace(min(x),max(x),150)'; + [yf,dyf] = polyconf(p,xf,s,varargin{:}); + plot(xf,yf+dyf,"g.;;", xf,yf-dyf,"g.;;", xf,yf,"g-;fit;"); + + ## plot the data + hold on; + if (isempty(dy)) + plot(x,y,"x;data;"); + else + if isscalar(dy), dy = ones(size(y))*dy; end + errorbar (x, y, dy, "~;data;"); + endif + hold off; + + if strcmp(deblank(input('See residuals? [y,n] ','s')),'y') + clf; + if (isempty(dy)) + plot(x,y-polyval(p,x),"x;data;"); + else + errorbar(x,y-polyval(p,x),dy, '~;data;'); + endif + hold on; + grid on; + ylabel('Residuals'); + xlabel('abscissa X'); + plot(xf,dyf,'g.;;',xf,-dyf,'g.;;'); + hold off; + endif + +%!demo % #1 +%! x = linspace(0,4,20); +%! dy = (1+rand(size(x)))/2; +%! y = polyval([2,3,1],x) + dy.*randn(size(x)); +%! wpolyfit(x,y,dy,2); + +%!demo % #2 +%! x = linspace(-i,+2i,20); +%! noise = ( randn(size(x)) + i*randn(size(x)) )/10; +%! P = [2-i,3,1+i]; +%! y = polyval(P,x) + noise; +%! wpolyfit(x,y,2) + +%!demo +%! pin = [3; -1; 2]; +%! x = -3:0.1:3; +%! y = polyval (pin, x); +%! +%! ## Poisson weights +%! # dy = sqrt (abs (y)); +%! ## Uniform weights in [0.5,1] +%! dy = 0.5 + 0.5 * rand (size (y)); +%! +%! y = y + randn (size (y)) .* dy; +%! printf ("Original polynomial: %s\n", polyout (pin, 'x')); +%! wpolyfit (x, y, dy, length (pin)-1); + + diff --git a/octave_packages/optim-1.2.0/wrap_f_dfdp.m b/octave_packages/optim-1.2.0/wrap_f_dfdp.m new file mode 100644 index 0000000..9883533 --- /dev/null +++ b/octave_packages/optim-1.2.0/wrap_f_dfdp.m @@ -0,0 +1,45 @@ +%% Copyright (C) 2010 Olaf Till +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% [ret1, ret2] = wrap_f_dfdp (f, dfdp, varargin) +%% +%% f and dftp should be the objective function (or "model function" in +%% curve fitting) and its jacobian, respectively, of an optimization +%% problem. ret1: f (varagin{:}), ret2: dfdp (varargin{:}). ret2 is +%% only computed if more than one output argument is given. This +%% manner of calling f and dfdp is needed by some optimization +%% functions. + +function [ret1, ret2] = wrap_f_dfdp (f, dfdp, varargin) + + if (nargin < 3) + print_usage (); + end + + if (ischar (f)) + f = str2func (f); + end + + if (ischar (dfdp)) + dfdp = str2func (dfdp); + end + + ret1 = f (varargin{:}); + + if (nargout > 1) + ret2 = dfdp (varargin{:}); + end + +end diff --git a/octave_packages/optim-1.2.0/wsolve.m b/octave_packages/optim-1.2.0/wsolve.m new file mode 100644 index 0000000..86abe3c --- /dev/null +++ b/octave_packages/optim-1.2.0/wsolve.m @@ -0,0 +1,128 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## [x,s] = wsolve(A,y,dy) +## +## Solve a potentially over-determined system with uncertainty in +## the values. +## +## A x = y +/- dy +## +## Use QR decomposition for increased accuracy. Estimate the +## uncertainty for the solution from the scatter in the data. +## +## The returned structure s contains +## +## normr = sqrt( A x - y ), weighted by dy +## R such that R'R = A'A +## df = n-p, n = rows of A, p = columns of A +## +## See polyconf for details on how to use s to compute dy. +## The covariance matrix is inv(R'*R). If you know that the +## parameters are independent, then uncertainty is given by +## the diagonal of the covariance matrix, or +## +## dx = sqrt(N*sumsq(inv(s.R'))') +## +## where N = normr^2/df, or N = 1 if df = 0. +## +## Example 1: weighted system +## +## A=[1,2,3;2,1,3;1,1,1]; xin=[1;2;3]; +## dy=[0.2;0.01;0.1]; y=A*xin+randn(size(dy)).*dy; +## [x,s] = wsolve(A,y,dy); +## dx = sqrt(sumsq(inv(s.R'))'); +## res = [xin, x, dx] +## +## Example 2: weighted overdetermined system y = x1 + 2*x2 + 3*x3 + e +## +## A = fullfact([3,3,3]); xin=[1;2;3]; +## y = A*xin; dy = rand(size(y))/50; y+=dy.*randn(size(y)); +## [x,s] = wsolve(A,y,dy); +## dx = s.normr*sqrt(sumsq(inv(s.R'))'/s.df); +## res = [xin, x, dx] +## +## Note there is a counter-intuitive result that scaling the +## uncertainty in the data does not affect the uncertainty in +## the fit. Indeed, if you perform a monte carlo simulation +## with x,y datasets selected from a normal distribution centered +## on y with width 10*dy instead of dy you will see that the +## variance in the parameters indeed increases by a factor of 100. +## However, if the error bars really do increase by a factor of 10 +## you should expect a corresponding increase in the scatter of +## the data, which will increase the variance computed by the fit. + +function [x_out,s]=wsolve(A,y,dy) + if nargin < 2, usage("[x dx] = wsolve(A,y[,dy])"); end + if nargin < 3, dy = []; end + + [nr,nc] = size(A); + if nc > nr, error("underdetermined system"); end + + ## apply weighting term, if it was given + if prod(size(dy))==1 + A = A ./ dy; + y = y ./ dy; + elseif ~isempty(dy) + A = A ./ (dy * ones (1, columns(A))); + y = y ./ dy; + endif + + ## system solution: A x = y => x = inv(A) y + ## QR decomposition has good numerical properties: + ## AP = QR, with P'P = Q'Q = I, and R upper triangular + ## so + ## inv(A) y = P inv(R) inv(Q) y = P inv(R) Q' y = P (R \ (Q' y)) + ## Note that b is usually a vector and Q is matrix, so it will + ## be faster to compute (y' Q)' than (Q' y). + [Q,R,p] = qr(A,0); + x = R\(y'*Q)'; + x(p) = x; + + s.R = R; + s.R(:,p) = R; + s.df = nr-nc; + s.normr = norm(y - A*x); + + if nargout == 0, + cov = s.R'*s.R + if s.df, normalized_chisq = s.normr^2/s.df, end + x = x' + else + x_out = x; + endif + +## We can show that uncertainty dx = sumsq(inv(R'))' = sqrt(diag(inv(A'A))). +## +## Rather than calculate inv(A'A) directly, we are going to use the QR +## decomposition we have already computed: +## +## AP = QR, with P'P = Q'Q = I, and R upper triangular +## +## so +## +## A'A = PR'Q'QRP' = PR'RP' +## +## and +## +## inv(A'A) = inv(PR'RP') = inv(P')inv(R'R)inv(P) = P inv(R'R) P' +## +## For a permutation matrix P, +## +## diag(PXP') = P diag(X) +## +## so +## diag(inv(A'A)) = diag(P inv(R'R) P') = P diag(inv(R'R)) +## +## For R upper triangular, inv(R') = inv(R)' so inv(R'R) = inv(R)inv(R)'. +## Conveniently, for X upper triangular, diag(XX') = sumsq(X')', so +## +## diag(inv(A'A)) = P sumsq(inv(R)')' +## +## This is both faster and more accurate than computing inv(A'A) +## directly. +## +## One small problem: if R is not square then inv(R) does not exist. +## This happens when the system is underdetermined, but in that case +## you shouldn't be using wsolve. + diff --git a/octave_packages/optiminterp-0.3.3/doc-cache b/octave_packages/optiminterp-0.3.3/doc-cache new file mode 100644 index 0000000..6e1c6eb --- /dev/null +++ b/octave_packages/optiminterp-0.3.3/doc-cache @@ -0,0 +1,299 @@ +# Created by Octave 3.6.1, Fri Mar 30 22:42:15 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 8 +# name: +# type: sq_string +# elements: 1 +# length: 19 +example_optiminterp + + +# name: +# type: sq_string +# elements: 1 +# length: 54 + Example program of the optimal interpolation toolbox + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 + Example program of the optimal interpolation toolbox + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +optiminterp1 + + +# name: +# type: sq_string +# elements: 1 +# length: 790 + -- Loadable Function: [FI,VARI] = optiminterp1(X,F,VAR,LENX,M,XI) + Performs a local 1D-optimal interpolation (objective analysis). + + Every elements in F corresponds to a data point (observation) at + location X,Y with the error variance VAR. + + LENX is correlation length in x-direction. M represents the + number of influential points. + + XI is the data points where the field is interpolated. FI is the + interpolated field and VARI is its error variance. + + The background field of the optimal interpolation is zero. For a + different background field, the background field must be + subtracted from the observation, the difference is mapped by OI + onto the background grid and finally the background is added back + to the interpolated field. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Performs a local 1D-optimal interpolation (objective analysis). + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +optiminterp2 + + +# name: +# type: sq_string +# elements: 1 +# length: 955 + -- Loadable Function: [FI,VARI] = + optiminterp2(X,Y,F,VAR,LENX,LENY,M,XI,YI) + Performs a local 2D-optimal interpolation (objective analysis). + + Every elements in F corresponds to a data point (observation) at + location X,Y with the error variance VAR. + + LENX and LENY are correlation length in x-direction and + y-direction respectively. M represents the number of influential + points. + + XI and YI are the data points where the field is interpolated. FI + is the interpolated field and VARI is its error variance. + + The background field of the optimal interpolation is zero. For a + different background field, the background field must be + subtracted from the observation, the difference is mapped by OI + onto the background grid and finally the background is added back + to the interpolated field. The error variance of the background + field is assumed to have a error variance of one. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Performs a local 2D-optimal interpolation (objective analysis). + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +optiminterp3 + + +# name: +# type: sq_string +# elements: 1 +# length: 971 + -- Loadable Function: [FI,VARI] = + optiminterp3(X,Y,Z,F,VAR,LENX,LENY,LENZ,M,XI,YI,ZI) + Performs a local 3D-optimal interpolation (objective analysis). + + Every elements in F corresponds to a data point (observation) at + location X, Y, Z with the error variance var + + LENX,LENY and LENZ are correlation length in x-,y- and z-direction + respectively. M represents the number of influential points. + + XI,YI and ZI are the data points where the field is interpolated. + FI is the interpolated field and VARI is its error variance. + + The background field of the optimal interpolation is zero. For a + different background field, the background field must be + subtracted from the observation, the difference is mapped by OI + onto the background grid and finally the background is added back + to the interpolated field. + + The error variance of the background field is assumed to have a + error variance of one. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Performs a local 3D-optimal interpolation (objective analysis). + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +optiminterp4 + + +# name: +# type: sq_string +# elements: 1 +# length: 1008 + -- Loadable Function: [FI,VARI] = + optiminterp4(X,Y,Z,T,F,VAR,LENX,LENY,LENZ,LENT,M,XI,YI,ZI,TI) + Performs a local 4D-optimal interpolation (objective analysis). + + Every elements in F corresponds to a data point (observation) at + location X, Y, Z, T with the error variance var + + LENX,LENY,LENZ and LENT are correlation length in + x-,y-,z-direction and time, respectively. M represents the number + of influential points. + + XI,YI,ZI and TI are the data points where the field is + interpolated. FI is the interpolated field and VARI is its error + variance. + + The background field of the optimal interpolation is zero. For a + different background field, the background field must be + subtracted from the observation, the difference is mapped by OI + onto the background grid and finally the background is added back + to the interpolated field. + + The error variance of the background field is assumed to have a + error variance of one. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Performs a local 4D-optimal interpolation (objective analysis). + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +optiminterpn + + +# name: +# type: sq_string +# elements: 1 +# length: 971 + -- Loadable Function: [FI,VARI] = + optiminterpn(X,Y,...,F,VAR,LENX,LENY,...,M,XI,YI,...) + Performs a local nD-optimal interpolation (objective analysis). + + Every elements in F corresponds to a data point (observation) at + location X,Y,... with the error variance VAR. + + LENX,LENY,... are correlation length in x-direction + y-direction,... respectively. M represents the number of + influential points. + + XI,YI,... are the data points where the field is interpolated. FI + is the interpolated field and VARI is its error variance. + + The background field of the optimal interpolation is zero. For a + different background field, the background field must be + subtracted from the observation, the difference is mapped by OI + onto the background grid and finally the background is added back + to the interpolated field. The error variance of the background + field is assumed to have a error variance of one. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Performs a local nD-optimal interpolation (objective analysis). + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +test_optiminterp + + +# name: +# type: sq_string +# elements: 1 +# length: 194 + Tests 1D, 2D and 3D optimal interpolation. + All tests should pass; any error indicates that either + there is a bug in the optimal interpolation package or + that it is incrorrectly installed. + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 + Tests 1D, 2D and 3D optimal interpolation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +test_optiminterp_mult + + +# name: +# type: sq_string +# elements: 1 +# length: 194 + Tests 1D, 2D and 3D optimal interpolation. + All tests should pass; any error indicates that either + there is a bug in the optimal interpolation package or + that it is incrorrectly installed. + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 + Tests 1D, 2D and 3D optimal interpolation. + + + + + diff --git a/octave_packages/optiminterp-0.3.3/example_optiminterp.m b/octave_packages/optiminterp-0.3.3/example_optiminterp.m new file mode 100644 index 0000000..99f751f --- /dev/null +++ b/octave_packages/optiminterp-0.3.3/example_optiminterp.m @@ -0,0 +1,67 @@ +%% Copyright (C) 2008 Alexander Barth +%% +%% 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 . + +% Example program of the optimal interpolation toolbox + + +% the grid onto which the observations are interpolated + +[xi,yi] = ndgrid(linspace(0,1,100)); + +% background estimate or first guess +xb = 10 + xi; + +% number of observations to interpolate + +on = 200; + +% create randomly located observations within +% the square [0 1] x [0 1] + +x = rand(1,on); +y = rand(1,on); + +% the underlying function to interpolate + +yo = 10 + x + sin(6*x) .* cos(6*y); + +% the error variance of the observations divided by the error +% variance of the background field + +var = 0.1 * ones(on,1); + +% the correlation length in x and y direction + +lenx = 0.1; +leny = 0.1; + +% number of influential observations + +m = 30; + +% subtract the first guess from the observations +% (DON'T FORGET THIS - THIS IS VERY IMPORTANT) + +Hxb = interp2(xi(:,1),yi(1,:),xb',x,y); +f = yo - Hxb; + +% run the optimal interpolation +% fi is the interpolated field and vari is its error variance + +[fi,vari] = optiminterp2(x,y,f,var,lenx,leny,m,xi,yi); + +% Add the first guess back + +xa = fi + xb; \ No newline at end of file diff --git a/octave_packages/optiminterp-0.3.3/optiminterp1.m b/octave_packages/optiminterp-0.3.3/optiminterp1.m new file mode 100644 index 0000000..3d74daf --- /dev/null +++ b/octave_packages/optiminterp-0.3.3/optiminterp1.m @@ -0,0 +1,41 @@ +## Copyright (C) 2006 Alexander Barth +## +## 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 {Loadable Function} {[@var{fi},@var{vari}]} = optiminterp1(@var{x},@var{f},@var{var},@var{lenx},@var{m},@var{xi}) +## Performs a local 1D-optimal interpolation (objective analysis). +## +## Every elements in @var{f} corresponds to a data point (observation) +## at location @var{x},@var{y} with the error variance @var{var}. +## +## @var{lenx} is correlation length in x-direction. +## @var{m} represents the number of influential points. +## +## @var{xi} is the data points where the field is +## interpolated. @var{fi} is the interpolated field and @var{vari} is +## its error variance. +## +## The background field of the optimal interpolation is zero. +## For a different background field, the background field +## must be subtracted from the observation, the difference +## is mapped by OI onto the background grid and finally the +## background is added back to the interpolated field. +## @end deftypefn + + + +function [fi,vari] = optiminterp1(x,f,var,lenx,m,xi) + +[fi,vari] = optiminterpn(x,f,var,lenx,m,xi); diff --git a/octave_packages/optiminterp-0.3.3/optiminterp2.m b/octave_packages/optiminterp-0.3.3/optiminterp2.m new file mode 100644 index 0000000..c104ec1 --- /dev/null +++ b/octave_packages/optiminterp-0.3.3/optiminterp2.m @@ -0,0 +1,45 @@ +## Copyright (C) 2006 Alexander Barth +## +## 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 {Loadable Function} {[@var{fi},@var{vari}] = } optiminterp2(@var{x},@var{y},@var{f},@var{var},@var{lenx},@var{leny},@var{m},@var{xi},@var{yi}) +## Performs a local 2D-optimal interpolation (objective analysis). +## +## Every elements in @var{f} corresponds to a data point (observation) +## at location @var{x},@var{y} with the error variance @var{var}. +## +## @var{lenx} and @var{leny} are correlation length in x-direction +## and y-direction respectively. +## @var{m} represents the number of influential points. +## +## @var{xi} and @var{yi} are the data points where the field is +## interpolated. @var{fi} is the interpolated field and @var{vari} is +## its error variance. +## +## The background field of the optimal interpolation is zero. +## For a different background field, the background field +## must be subtracted from the observation, the difference +## is mapped by OI onto the background grid and finally the +## background is added back to the interpolated field. +## The error variance of the background field is assumed to +## have a error variance of one. +## @end deftypefn + +## Copyright (C) 2006, Alexander Barth +## Author: Alexander Barth + +function [fi,vari] = optiminterp2(x,y,f,var,lenx,leny,m,xi,yi) + +[fi,vari] = optiminterpn(x,y,f,var,lenx,leny,m,xi,yi); diff --git a/octave_packages/optiminterp-0.3.3/optiminterp3.m b/octave_packages/optiminterp-0.3.3/optiminterp3.m new file mode 100644 index 0000000..cf62ad3 --- /dev/null +++ b/octave_packages/optiminterp-0.3.3/optiminterp3.m @@ -0,0 +1,47 @@ +## Copyright (C) 2006 Alexander Barth +## +## 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 {Loadable Function} {[@var{fi},@var{vari}] = } optiminterp3(@var{x},@var{y},@var{z},@var{f},@var{var},@var{lenx},@var{leny},@var{lenz},@var{m},@var{xi},@var{yi},@var{zi}) +## Performs a local 3D-optimal interpolation (objective analysis). +## +## Every elements in @var{f} corresponds to a data point (observation) +## at location @var{x}, @var{y}, @var{z} with the error variance var +## +## @var{lenx},@var{leny} and @var{lenz} are correlation length in x-,y- and z-direction +## respectively. +## @var{m} represents the number of influential points. +## +## @var{xi},@var{yi} and @var{zi} are the data points where the field is +## interpolated. @var{fi} is the interpolated field and @var{vari} is +## its error variance. +## +## +## The background field of the optimal interpolation is zero. +## For a different background field, the background field +## must be subtracted from the observation, the difference +## is mapped by OI onto the background grid and finally the +## background is added back to the interpolated field. +## +## The error variance of the background field is assumed to +## have a error variance of one. +## @end deftypefn + +## Copyright (C) 2006, Alexander Barth +## Author: Alexander Barth + +function [fi,vari] = optiminterp3(x,y,z,f,var,lenx,leny,lenz,m,xi,yi,zi) + +[fi,vari] = optiminterpn(x,y,z,f,var,lenx,leny,lenz,m,xi,yi,zi); diff --git a/octave_packages/optiminterp-0.3.3/optiminterp4.m b/octave_packages/optiminterp-0.3.3/optiminterp4.m new file mode 100644 index 0000000..fee6215 --- /dev/null +++ b/octave_packages/optiminterp-0.3.3/optiminterp4.m @@ -0,0 +1,48 @@ +## Copyright (C) 2007 Aida Alvera-Azcárate +## +## 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 {Loadable Function} {[@var{fi},@var{vari}] = } optiminterp4(@var{x},@var{y},@var{z},@var{t},@var{f},@var{var},@var{lenx},@var{leny},@var{lenz},@var{lent},@var{m},@var{xi},@var{yi},@var{zi},@var{ti}) +## Performs a local 4D-optimal interpolation (objective analysis). +## +## Every elements in @var{f} corresponds to a data point (observation) +## at location @var{x}, @var{y}, @var{z}, @var{t} with the error variance var +## +## @var{lenx},@var{leny},@var{lenz} and @var{lent} are correlation length in x-,y-,z-direction and time, +## respectively. +## @var{m} represents the number of influential points. +## +## @var{xi},@var{yi},@var{zi} and @var{ti} are the data points where the field is +## interpolated. @var{fi} is the interpolated field and @var{vari} is +## its error variance. +## +## +## The background field of the optimal interpolation is zero. +## For a different background field, the background field +## must be subtracted from the observation, the difference +## is mapped by OI onto the background grid and finally the +## background is added back to the interpolated field. +## +## The error variance of the background field is assumed to +## have a error variance of one. +## @end deftypefn + +## Copyright (C) 2007 Aida Alvera-Azcárate +## Author: Aida Alvera-Azcárate +## Author: Alexander Barth + +function [fi,vari] = optiminterp4(x,y,z,t,f,var,lenx,leny,lenz,lent,m,xi,yi,zi,ti) + +[fi,vari] = optiminterpn(x,y,z,t,f,var,lenx,leny,lenz,lent,m,xi,yi,zi,ti); diff --git a/octave_packages/optiminterp-0.3.3/optiminterpn.m b/octave_packages/optiminterp-0.3.3/optiminterpn.m new file mode 100644 index 0000000..aa6da04 --- /dev/null +++ b/octave_packages/optiminterp-0.3.3/optiminterpn.m @@ -0,0 +1,103 @@ +## Copyright (C) 2008 Alexander Barth +## +## 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 {Loadable Function} {[@var{fi},@var{vari}] = } optiminterpn(@var{x},@var{y},@var{...},@var{f},@var{var},@var{lenx},@var{leny},@var{...},@var{m},@var{xi},@var{yi},@var{...}) +## Performs a local nD-optimal interpolation (objective analysis). +## +## Every elements in @var{f} corresponds to a data point (observation) +## at location @var{x},@var{y},@var{...} with the error variance @var{var}. +## +## @var{lenx},@var{leny},@var{...} are correlation length in x-direction +## y-direction,... respectively. +## @var{m} represents the number of influential points. +## +## @var{xi},@var{yi},@var{...} are the data points where the field is +## interpolated. @var{fi} is the interpolated field and @var{vari} is +## its error variance. +## +## The background field of the optimal interpolation is zero. +## For a different background field, the background field +## must be subtracted from the observation, the difference +## is mapped by OI onto the background grid and finally the +## background is added back to the interpolated field. +## The error variance of the background field is assumed to +## have a error variance of one. +## @end deftypefn + +## Copyright (C) 2008, Alexander Barth +## Author: Alexander Barth + +# {[@var{fi},@var{vari}] = } optiminterpn(@var{x},@var{y},@var{...},@var{f},@var{var},@var{lenx},@var{leny},@var{len...},@var{m},@var{xi},@var{yi},@var{...}) + +function [fi,vari] = optiminterpn(varargin) + +if nargin < 6 || mod(nargin-3,3) ~= 0 + error('optiminterpn: wrong number of arguments'); +end + +n = (nargin-3)/3; + +x = varargin{1}; +xi = varargin{2*n+4}; +on = numel(varargin{1}); +gsz = size(varargin{2*n+4}); + +for i=1:n + tmp = varargin{i}; + + if on ~= numel(tmp) + error('optiminterpn: x, y,... must have the same number of elements'); + end + + ox(:,i) = tmp(:); + + len(i) = varargin{n+i+2}; + tmp = varargin{2*n+3+i}; + + if (numel(tmp) ~= prod(gsz)) + error('optiminterpn: xi, yi, ... must have the same number of elements'); + end + + gx(:,i) = tmp(:); +end + +f = varargin{n+1}; +var = varargin{n+2}; + +m = varargin{2*n+3}; + +if (isscalar(var)) + var = var*ones(size(x)); +end + +if isvector(f) && size(f,1) == 1 + f = f'; +end + +% is this correct? +nf = size(f,n+1); + +if (on*nf ~= numel(f) && on ~= numel(var)) + error('optiminterpn: x,y,...,var must have the same number of elements'); +end + +f=reshape(f,[on nf]); + +%whos ox f var len m gx +[fi,vari] = optiminterp(ox,f,var,len,m,gx); + +fi = reshape(fi,[gsz nf]); +vari = reshape(vari,gsz); diff --git a/octave_packages/optiminterp-0.3.3/packinfo/.autoload b/octave_packages/optiminterp-0.3.3/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/optiminterp-0.3.3/packinfo/DESCRIPTION b/octave_packages/optiminterp-0.3.3/packinfo/DESCRIPTION new file mode 100644 index 0000000..5d5549a --- /dev/null +++ b/octave_packages/optiminterp-0.3.3/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: optiminterp +Version: 0.3.3 +Date: 2011-03-25 +Author: Alexander Barth , Aida Alvera-Azcárate +Maintainer: Alexander Barth +Title: optiminterp +Description: An optimal interpolation toolbox for octave. This package provides functions to perform a n-dimensional optimal interpolations of arbitrarily distributed data points. +Depends: octave (>= 2.9.9) +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net diff --git a/octave_packages/optiminterp-0.3.3/packinfo/INDEX b/octave_packages/optiminterp-0.3.3/packinfo/INDEX new file mode 100644 index 0000000..afaf9ac --- /dev/null +++ b/octave_packages/optiminterp-0.3.3/packinfo/INDEX @@ -0,0 +1,11 @@ +optiminterp >> OptimInterp +OptimInterp + optiminterp1 + optiminterp2 + optiminterp3 + optiminterp4 + optiminterpn + optiminterp +Examples + example_optiminterp + diff --git a/octave_packages/optiminterp-0.3.3/test_optiminterp.m b/octave_packages/optiminterp-0.3.3/test_optiminterp.m new file mode 100644 index 0000000..52b9945 --- /dev/null +++ b/octave_packages/optiminterp-0.3.3/test_optiminterp.m @@ -0,0 +1,147 @@ +% Tests 1D, 2D and 3D optimal interpolation. +% All tests should pass; any error indicates that either +% there is a bug in the optimal interpolation package or +% that it is incrorrectly installed. + +function test_optiminterp + +more off + +printf('Testing 1D-optimal interpolation: '); + +try + % grid of background field + xi = linspace(0,1,50); + fi_ref = sin( xi*6 ); + + % grid of observations + x = linspace(0,1,20); + + on = numel(x); + var = 0.01 * ones(on,1); + f = sin( x*6 ); + + m = 15; + + [fi,vari] = optiminterp1(x,f,var,0.1,m,xi); + + + rms = sqrt(mean((fi_ref(:) - fi(:)).^2)); + + if (rms > 0.005) + error('unexpected large difference with reference field'); + end + + disp('OK'); + +catch + disp('failed'); + disp(lasterr); +end + + +printf('Testing 2D-optimal interpolation: '); + +try + % grid of background field + [xi,yi] = ndgrid(linspace(0,1,30)); + fi_ref = sin( xi*6 ) .* cos( yi*6); + + % grid of observations + [x,y] = ndgrid(linspace(0,1,20)); + x = x(:); + y = y(:); + + on = numel(x); + var = 0.01 * ones(on,1); + f = sin( x*6 ) .* cos( y*6); + + m = 30; + + [fi,vari] = optiminterp2(x,y,f,var,0.1,0.1,m,xi,yi); + + + rms = sqrt(mean((fi_ref(:) - fi(:)).^2)); + + if (rms > 0.005) + error('unexpected large difference with reference field'); + end + + disp('OK'); + +catch + disp('failed'); + disp(lasterr); +end + + +printf('Testing 3D-optimal interpolation: '); + +try + % grid of background field + [xi,yi,zi] = ndgrid(linspace(0,1,15)); + fi_ref = sin(6*xi) .* cos(6*yi) .* sin(6*zi); + + % grid of observations + [x,y,z] = ndgrid(linspace(0,1,10)); + x = x(:); + y = y(:); + z = z(:); + + on = numel(x); + var = 0.01 * ones(on,1); + f = sin(6*x) .* cos(6*y) .* sin(6*z); + + m = 20; + + [fi,vari] = optiminterp3(x,y,z,f,var,0.1,0.1,0.1,m,xi,yi,zi); + + + rms = sqrt(mean((fi_ref(:) - fi(:)).^2)); + + if (rms > 0.04) + error('unexpected large difference with reference field'); + end + + disp('OK'); + +catch + disp('failed'); + disp(lasterr); +end + +printf('Testing 4D-optimal interpolation: '); + +try + % grid of background field + [xi,yi,zi,ti] = ndgrid(linspace(0,1,5)); + fi_ref = sin(6*xi) .* cos(6*yi) .* sin(6*zi) .* cos(6*ti); + + % grid of observations + [x,y,z,t] = ndgrid(linspace(0,1,10)); + x = x(:); + y = y(:); + z = z(:); + t = t(:); + + on = numel(x); + var = 0.01 * ones(on,1); + f = sin(6*x) .* cos(6*y) .* sin(6*z) .* cos(6*t); + + m = 20; + + [fi,vari] = optiminterp4(x,y,z,t,f,var,0.1,0.1,0.1,0.1,m,xi,yi,zi,ti); + + rms = sqrt(mean((fi_ref(:) - fi(:)).^2)); + + if (rms > 0.04) + error('unexpected large difference with reference field'); + end + + disp('OK'); + +catch + disp('failed'); + disp(lasterr); +end + diff --git a/octave_packages/optiminterp-0.3.3/test_optiminterp_mult.m b/octave_packages/optiminterp-0.3.3/test_optiminterp_mult.m new file mode 100644 index 0000000..3b9ac89 --- /dev/null +++ b/octave_packages/optiminterp-0.3.3/test_optiminterp_mult.m @@ -0,0 +1,159 @@ +% Tests 1D, 2D and 3D optimal interpolation. +% All tests should pass; any error indicates that either +% there is a bug in the optimal interpolation package or +% that it is incrorrectly installed. + +function test_optiminterp_mult + +more off + +printf('Testing multiple 1D-optimal interpolation: '); + +try + % grid of background field + xi = linspace(0,1,50)'; + fi_ref(:,1) = sin( xi*6 ); + fi_ref(:,2) = cos( xi*6 ); + + % grid of observations + x = linspace(0,1,20)'; + + on = numel(x); + var = 0.01 * ones(on,1); + f(:,1) = sin( x*6 ); + f(:,2) = cos( x*6 ); + + m = 15; + + [fi,vari] = optiminterp1(x,f,var,0.1,m,xi); + + + rms = sqrt(mean((fi_ref(:) - fi(:)).^2)); + + if (rms > 0.005) + error('unexpected large difference with reference field'); + end + + disp('OK'); + +catch + disp('failed'); + disp(lasterr); +end + + + +printf('Testing multiple 2D-optimal interpolation: '); + +try + clear fi_ref f + % grid of background field + [xi,yi] = ndgrid(linspace(0,1,30)); + + fi_ref(:,:,1) = sin( xi*6 ) .* cos( yi*6); + fi_ref(:,:,2) = cos( xi*6 ) .* sin( yi*6); + + % grid of observations + [x,y] = ndgrid(linspace(0,1,20)); + + on = numel(x); + var = 0.01 * ones(on,1); + f(:,:,1) = sin( x*6 ) .* cos( y*6); + f(:,:,2) = cos( x*6 ) .* sin( y*6); + + m = 30; + + [fi,vari] = optiminterp2(x,y,f,var,0.1,0.1,m,xi,yi); + + + rms = sqrt(mean((fi_ref(:) - fi(:)).^2)); + + if (rms > 0.005) + error('unexpected large difference with reference field'); + end + + disp('OK'); + +catch + disp('failed'); + disp(lasterr); +end + +printf('Testing multiple 3D-optimal interpolation: '); + + +try + clear fi_ref f + + % grid of background field + [xi,yi,zi] = ndgrid(linspace(0,1,15)); + + fi_ref(:,:,:,1) = sin(6*xi) .* cos(6*yi) .* sin(6*zi); + fi_ref(:,:,:,2) = cos(6*xi) .* sin(6*yi) .* cos(6*zi); + + % grid of observations + [x,y,z] = ndgrid(linspace(0,1,10)); + + on = numel(x); + var = 0.01 * ones(on,1); + f(:,:,:,1) = sin(6*x) .* cos(6*y) .* sin(6*z); + f(:,:,:,2) = cos(6*x) .* sin(6*y) .* cos(6*z); + + m = 20; + + [fi,vari] = optiminterp3(x,y,z,f,var,0.1,0.1,0.1,m,xi,yi,zi); + + + rms = sqrt(mean((fi_ref(:) - fi(:)).^2)); + + if (rms > 0.04) + error('unexpected large difference with reference field'); + end + + disp('OK'); + +catch + disp('failed'); + disp(lasterr); +end + +printf('Testing multiple 4D-optimal interpolation: '); + +try + clear fi_ref f + + % grid of background field + [xi,yi,zi,ti] = ndgrid(linspace(0,1,5)); + + fi_ref(:,:,:,:,1) = sin(6*xi) .* cos(6*yi) .* sin(6*zi) .* cos(6*ti); + fi_ref(:,:,:,:,2) = cos(6*xi) .* sin(6*yi) .* cos(6*zi) .* sin(6*ti); + + % grid of observations + [x,y,z,t] = ndgrid(linspace(0,1,10)); + x = x(:); + y = y(:); + z = z(:); + t = t(:); + + on = numel(x); + var = 0.01 * ones(on,1); + f(:,:,:,:,1) = sin(6*x) .* cos(6*y) .* sin(6*z) .* cos(6*t); + f(:,:,:,:,2) = cos(6*x) .* sin(6*y) .* cos(6*z) .* sin(6*t); + + m = 20; + + [fi,vari] = optiminterp4(x,y,z,t,f,var,0.1,0.1,0.1,0.1,m,xi,yi,zi,ti); + + rms = sqrt(mean((fi_ref(:) - fi(:)).^2)); + + if (rms > 0.04) + error('unexpected large difference with reference field'); + end + + disp('OK'); + +catch + disp('failed'); + disp(lasterr); +end + diff --git a/octave_packages/plot-1.1.0/doc-cache b/octave_packages/plot-1.1.0/doc-cache new file mode 100644 index 0000000..0270414 --- /dev/null +++ b/octave_packages/plot-1.1.0/doc-cache @@ -0,0 +1,241 @@ +# Created by Octave 3.6.1, Wed Mar 14 20:28:02 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 7 +# name: +# type: sq_string +# elements: 1 +# length: 8 +dxfwrite + + +# name: +# type: sq_string +# elements: 1 +# length: 245 + -- Function File: NB = dxfwrite (FILENAME, PL, ...) + Write FILENAME as a DXF file. Polyline PL must be defined as + matrix of 1, 2 or 3 columns respectively for x, y and z + coordinates. The number of polyline (NB) or 0 is returned. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 29 +Write FILENAME as a DXF file. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +gplot3 + + +# name: +# type: sq_string +# elements: 1 +# length: 628 + -- Function File: gplot3 (A, XYZ) + -- Function File: gplot3 (A, XYZ, LINE_STYLE) + -- Function File: [X, Y, Z] = gplot3 (A, XYZ) + Plot a 3-dimensional graph defined by A and XYZ in the graph + theory sense. A is the adjacency matrix of the array to be + plotted and XY is an N-by-3 matrix containing the coordinates of + the nodes of the graph. + + The optional parameter 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 X and + Y. + + See also: gplot, treeplot, etreeplot, spy + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 74 +Plot a 3-dimensional graph defined by A and XYZ in the graph theory +sense. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +hist2d + + +# name: +# type: sq_string +# elements: 1 +# length: 304 + -- Function File: [COUNTS, XBINS, YBINS] = hist2d ([X, Y], XBINS, + YBINS, NORM) + Produce a 2D histogram. + + Points xi,yi are stored in a 2-column array. If ybins is missing, + use xbins. If bins is a scalar, use that many bins. If bins is a + vector, it represents bin edges. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 23 +Produce a 2D histogram. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +plotdecimate + + +# name: +# type: sq_string +# elements: 1 +# length: 871 + -- Function File: plotdecimate (P) + -- Function File: plotdecimate (P, SO) + -- Function File: plotdecimate (P, SO, RES) + Optimise plot data by removing redundant points and segments + + The first parameter P is a two-column matrix to be plotted as X and + Y coordinates. The second optional argument SO disables segment + optimisation when set to FALSE (default is TRUE). The third + optional argument RES is the size of the largest error on the plot: + if it is a scalar, it is meant relative to the range of X and Y + values (default 1e-3); if it is a 2x1 array, it contains the + absolute errors for X and Y. Returns a two-column matrix + containing a subset of the rows of P. A line plot of P has the + same appearance as a line plot of the output, with errors smaller + than RES. When creating point plots, set SO to FALSE. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +Optimise plot data by removing redundant points and segments + + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +tics + + +# name: +# type: sq_string +# elements: 1 +# length: 452 + -- Function File: tics (AXIS, [POS1, POS2, ...], [LAB1, LAB2, ...],) + Explicitly set the tic positions and labels for the given axis. + + AXIS must be 'x', 'y' or 'z'. + + If no positions or labels are given, then restore the default. If + positions are given but no labels, use those positions with the + normal labels. If positions and labels are given, each position + labeled with the corresponding row from the label matrix. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Explicitly set the tic positions and labels for the given axis. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +tricontour + + +# name: +# type: sq_string +# elements: 1 +# length: 741 + -- Function File: tricontour (TRI, X, Y, Z, LEVELS) + -- Function File: tricontour (TRI, X, Y, Z, LEVELS, LINESPEC) + Plot level curves for the values of `Z' on a triangular mesh in 2D. + + The variable TRI is the triangular meshing of the points `(X, Y)' + which is returned from `delaunay'. The variable LEVELS is a vector + with the values of the countour levels. If LEVELS is a scalar, + then it corresponds to the number of level curves to be drawn. If + exactly one level curve is desired, list the level twice in the + vector LEVELS. + + If given, LINESPEC determines the properties to use for the lines. + + The output argument H is the graphic handle to the plot. + + See also: plot, trimesh, delaunay + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 +Plot level curves for the values of `Z' on a triangular mesh in 2D. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +zoom + + +# name: +# type: sq_string +# elements: 1 +# length: 69 + -- Function File: zoom + Compatibility function; does nothing. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 +Compatibility function; does nothing. + + + + + diff --git a/octave_packages/plot-1.1.0/dxfwrite.m b/octave_packages/plot-1.1.0/dxfwrite.m new file mode 100644 index 0000000..9868f76 --- /dev/null +++ b/octave_packages/plot-1.1.0/dxfwrite.m @@ -0,0 +1,164 @@ +## Copyright (C) 2004 Patrick Labbe +## Copyright (C) 2004 Laurent Mazet +## Copyright (C) 2005 Larry Doolittle +## +## 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{nb} =} dxfwrite (@var{filename}, @var{pl}, @dots{}) +## +## Write @var{filename} as a DXF file. Polyline @var{pl} must be defined as +## matrix of 1, 2 or 3 columns respectively for x, y and z coordinates. The +## number of polyline (@var{nb}) or 0 is returned. +## @end deftypefn + +function [nb] = dxfwrite (filename, varargin) + + ## Check file name + sn = split(filename, "."); + if !strcmp(tolower(deblank(sn(end,:))), "dxf") + filename = [filename, ".dxf"]; + endif + + ## Check arguments + nb = 0; + if nargin <= 1 + usage("dxfwrite = (filename, pl, ...)"); + return; + endif + + ## Open file + fid = fopen (filename, "wt"); + if fid <= 0 + error("error opening file \"%s\"\n", filename); + endif + + ## Format string + FMT = sprintf("%%.%dg", save_precision); + + ## Header declarations + fprintf (fid, ["0\nSECTION\n", "2\nHEADER\n"]); + ## DXF version + fprintf (fid, ["9\n$ACADVER\n", "1\nAC1009\n"]); ## AutoCAD R11 + ## End of headers + fprintf (fid, "0\nENDSEC\n"); + + ## Table declarations + fprintf (fid, ["0\nSECTION\n", "2\nTABLES\n"]); + + ## Line type declarations + fprintf (fid, ["0\nTABLE\n", "2\nLTYPE\n"]); + ## Number of line types + fprintf (fid, "70\n1\n"); + ## New line type + fprintf (fid, "0\nLTYPE\n"); + ## Line type name + fprintf (fid, "2\nCONTINUOUS\n"); + ## Standard flags + fprintf (fid, "70\n0\n"); ## Optimal for AutoCAD + ## Descriptive text for linetype + fprintf (fid, "3\nContinuous line\n"); + ## Alignment code + fprintf (fid, "72\n65\n"); ## the ASCII code for A + ## Number of linetype elements + fprintf (fid, "73\n0\n"); + ## Total pattern length + fprintf (fid, "40\n0\n"); + ## Pattern definition + ## ??? + ## End of line types + fprintf (fid, "0\nENDTAB\n"); + + ## Layers declarations + fprintf (fid, ["0\nTABLE\n", "2\nLAYER\n"]); + ## Number of layers + fprintf (fid, "70\n%d\n", nargin-1); + + nb = 0; + for i=1:nargin-1 + nb++; + ## New layer + fprintf (fid, "0\nLAYER\n"); + ## Layer name + fprintf (fid, "2\nCurve%d\n", nb); + ## Standard flags + fprintf (fid, "70\n0\n"); ## Optimal for AutoCAD + ## Line type + fprintf (fid, "6\nCONTINUOUS\n"); + ## Color number + fprintf (fid, "62\n%d\n", nb); + endfor + ## End of layers + fprintf (fid, "0\nENDTAB\n"); + + ## End of tables + fprintf (fid, "0\nENDSEC\n"); + + ## Entity declarations + fprintf (fid, ["0\nSECTION\n", "2\nENTITIES\n"]); + + nb = 0; + for i=1:nargin-1 + tmp_pl = varargin{1+nb++}; + + ## Check curve dimension (1, 2 or 3) + if columns(tmp_pl) <= 3 + pl = zeros(rows(tmp_pl), 3); + pl(:, 1:columns(tmp_pl)) = tmp_pl; + else + warning ("%dth entry skipped (more than 3 dimensions)", nb); + continue; + endif + + ## Check if the curve is closed + closed = false; + if pl(1, :) == pl(rows(pl), :) + closed = true; + pl = pl([1:rows(pl)-1], :); + endif + + ## New polyline + fprintf (fid, "0\nPOLYLINE\n"); + + ## Layer name + fprintf (fid, "8\nCurve%d\n", nb); + ## Line type name + fprintf (fid, "6\nCONTINUOUS\n"); + ## Color number??? + fprintf (fid, "66\n%d\n", nb); + ## Standard flags + fprintf (fid, "70\n%d\n", closed); + + ## Layer specification + layspec = sprintf("8\nCurve%d\n", nb); + + ## List of vertex + fprintf(fid, ["0\nVERTEX\n", layspec, \ + "10\n",FMT,"\n", "20\n",FMT,"\n", "30\n",FMT,"\n"], pl.'); + + ## End of polyline + fprintf(fid, "0\nSEQEND\n"); + + endfor + + ## End of entities + fprintf(fid, "0\nENDSEC\n"); + + ## End of file + fprintf(fid, "0\nEOF\n"); + + ## Close file + fclose(fid); + +endfunction diff --git a/octave_packages/plot-1.1.0/gplot3.m b/octave_packages/plot-1.1.0/gplot3.m new file mode 100644 index 0000000..0ef57ee --- /dev/null +++ b/octave_packages/plot-1.1.0/gplot3.m @@ -0,0 +1,74 @@ +## Copyright (C) 2010 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## This program is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gplot3 (@var{a}, @var{xyz}) +## @deftypefnx {Function File} {} gplot3 (@var{a}, @var{xyz}, @var{line_style}) +## @deftypefnx {Function File} {[@var{x}, @var{y}, @var{z}] =} gplot3 (@var{a}, @var{xyz}) +## Plot a 3-dimensional graph defined by @var{A} and @var{xyz} 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-3 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{gplot, treeplot, etreeplot, spy} +## @end deftypefn + +function [x, y, z] = gplot3 (A, xyz, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (length (varargin) == 0) + varargin {1} = "-"; + endif + + [i, j] = find (A); + xcoord = [xyz(i,1), xyz(j,1), NA(length(i),1)]'(:); + ycoord = [xyz(i,2), xyz(j,2), NA(length(i),1)]'(:); + zcoord = [xyz(i,3), xyz(j,3), NA(length(i),1)]'(:); + + if (nargout == 0) + plot3 (xcoord, ycoord, zcoord, varargin {:}); + else + x = xcoord; + y = ycoord; + z = zcoord; + endif + +endfunction + +%!demo +%! ## Define adjacency matrix of a graph with 5 nodes +%! A = [0, 1, 0, 0, 1; +%! 1, 0, 1, 1, 1; +%! 0, 1, 0, 1, 1; +%! 0, 1, 1, 0, 1; +%! 1, 1, 1, 1, 0 ]; +%! +%! ## Define 3D points of the nodes +%! xyz = [2, 1, 3/2; +%! 3, 2, 2; +%! 8/3, 3, 1; +%! 5/3, 3, 1; +%! 1, 2, 2 ]; +%! +%! ## Plot the 3D graph +%! gplot3 (A, xyz); diff --git a/octave_packages/plot-1.1.0/hist2d.m b/octave_packages/plot-1.1.0/hist2d.m new file mode 100644 index 0000000..bc7e33b --- /dev/null +++ b/octave_packages/plot-1.1.0/hist2d.m @@ -0,0 +1,50 @@ +## Copyright (C) 2006 Paul Kienzle +## This program is in the public domain + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{counts}, @var{xbins}, @var{ybins}] =} hist2d ([@var{x}, @var{y}], @var{xbins}, @var{ybins}, @var{norm}) +## Produce a 2D histogram. +## +## Points xi,yi are stored in a 2-column array. +## If ybins is missing, use xbins. +## If bins is a scalar, use that many bins. +## If bins is a vector, it represents bin edges. +## +## @end deftypefn + +function [ret_counts, xbins, ybins] = hist2d(M,xbins,ybins) + + if nargin < 1 && nargin > 3 + print_usage + end + + lo = min(M); + hi = max(M); + if nargin == 1 + ybins = xbins = 10; + elseif nargin == 2 + ybins = xbins; + endif + + # If n bins, find centers based on n+1 bin edges + if isscalar(xbins) + xbins = linspace(lo(1),hi(1),xbins+1); + xbins = (xbins(1:end-1)+xbins(2:end))/2; + end + if isscalar(ybins) + ybins = linspace(lo(2),hi(2),ybins+1); + ybins = (ybins(1:end-1)+ybins(2:end))/2; + end + + xcut = (xbins(1:end-1)+xbins(2:end))/2; + ycut = (ybins(1:end-1)+ybins(2:end))/2; + xidx = lookup(xcut,M(:,1))+1; + yidx = lookup(ycut,M(:,2))+1; + counts = sparse(xidx,yidx,1,length(xbins),length(ybins),'sum'); + + if nargout + ret_counts = full(counts'); + else + mesh(xbins,ybins,full(counts')); + end +endfunction diff --git a/octave_packages/plot-1.1.0/packinfo/.autoload b/octave_packages/plot-1.1.0/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/plot-1.1.0/packinfo/DESCRIPTION b/octave_packages/plot-1.1.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..0936e8d --- /dev/null +++ b/octave_packages/plot-1.1.0/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: Plot +Version: 1.1.0 +Date: 2011-10-27 +Author: Various Authors +Maintainer: The Octave Community +Title: Plotting. +Description: Additional ploting tools for Octave. +Categories: Plotting +Depends: octave (>= 3.2) +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net diff --git a/octave_packages/plot-1.1.0/packinfo/INDEX b/octave_packages/plot-1.1.0/packinfo/INDEX new file mode 100644 index 0000000..5eb3ee2 --- /dev/null +++ b/octave_packages/plot-1.1.0/packinfo/INDEX @@ -0,0 +1,9 @@ +plot >> Plotting. +Plotting + dxfwrite + gplot3 + hist2d + plotdecimate + tics + tricontour + zoom diff --git a/octave_packages/plot-1.1.0/plotdecimate.m b/octave_packages/plot-1.1.0/plotdecimate.m new file mode 100644 index 0000000..2bffbbc --- /dev/null +++ b/octave_packages/plot-1.1.0/plotdecimate.m @@ -0,0 +1,128 @@ +## Copyright (C) 2006 Francesco Potortì +## +## 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, write to the Free Software Foundation, +## Inc., 51 Franklin Street, 5th Floor, Boston, MA 02110-1301, USA. + +## -*- texinfo -*- +## @deftypefn {Function File} {} plotdecimate (@var{P}) +## @deftypefnx {Function File} {} plotdecimate (@var{P}, @var{so}) +## @deftypefnx {Function File} {} plotdecimate (@var{P}, @var{so}, @var{res}) +## Optimise plot data by removing redundant points and segments +## +## The first parameter @var{P} is a two-column matrix to be plotted as X and +## Y coordinates. The second optional argument @var{so} disables segment +## optimisation when set to @var{false} (default is @var{true}). The third +## optional argument @var{res} is the size of the largest error on the plot: +## if it is a scalar, it is meant relative to the range of X and Y values +## (default 1e-3); if it is a 2x1 array, it contains the absolute errors for +## X and Y. Returns a two-column matrix containing a subset of the rows of +## @var{P}. A line plot of @var{P} has the same appearance as a line plot of +## the output, with errors smaller than @var{res}. When creating point +## plots, set @var{so} to @var{false}. +## @end deftypefn + +function C = plotdecimate (P, so, res) + + if (!ismatrix(P) || columns(P) != 2) + error("P must be a matrix with two columns"); + endif + if (nargin < 2) + so = true; # do segment optimisation + endif + if (nargin < 3) + res = 1e-3; # default resolution is 1000 dots/axis + endif + + ## Slack: admissible error on coordinates on the output plot + if (isscalar(res)) + if (res <= 0) + error("res must be positive"); + endif + E = range(P)' * res; # build error vector using range of data + elseif (ismatrix(res)) + if (!all(size(res) == [2 1]) || any(res <= 0)) + error("res must be a 2x1 matrix with positive values"); + endif + E = res; # take error vector as it is + else + error("res should be a scalar or matrix"); + endif + + if (rows(P) < 3) + C = P; + return; # nothing to do + endif + P ./= repmat(E',rows(P),1); # normalize P + rot = [0,-1;1,0]; # rotate a vector pi/4 anticlockwise + + ## Iteratively remove points too near to the previous point + while (1) + V = [true; sumsq(diff(P),2) > 1]; # points far from the previous ones + if (all(V)) break; endif + V = [true; diff(V) >= 0]; # identify the sequence leaders + P = P(V,:); # remove them + endwhile + + ## Remove points laying near to a segment: for each segment R->S, build a + ## unitary-lenght projection vector D perpendicular to R->S, and project + ## R->T over D to compute the distance ot T from R->S. + if (so) # segment optimisation + ## For each segment, r and s are its extremes + r = 1; R = P(1,:)'; # start of segment + s = 2; S = P(2,:)'; # end of the segment + rebuild = true; # build first projection vector + + for t = 3:rows(P) + if (rebuild) # build projection vector + D = rot*(S-R)/sqrt(sumsq(S-R)); # projection vector for distance + rebuild = false; # keep current projection vector + endif + + T = P(t,:)'; # next point + + if (abs(sum((T-R).*D)) < 1 # T is aligned + && sum((T-R).*(S-R)) > 0) # going forward + V(s) = false; # do not plot s + else # set a new segment + r = s; R = S; # new start of segment + rebuild = true; # rebuild projection vector + endif + s = t; S = T; # new end of segment + endfor + endif + + C = P(V,:) .* repmat(E',sum(V),1); # denormalize P +endfunction + +%!test +%! x = [ 0 1 2 3 4 8 8 8 8 8 9 ]'; +%! y = [ 0 1 1 1 1 1 1 2 3 4 5 ]'; +%! +%! x1 = [0 1 8 8 9]'; +%! y1 = [0 1 1 4 5]'; +%! # optimised for segment plot +%! +%! x2 = [ 0 1 2 3 4 8 8 8 8 9 ]'; +%! y2 = [ 0 1 1 1 1 1 2 3 4 5 ]'; +%! # double points removed +%! +%! P = [x,y]; +%! # Original +%! P1 = [x1, y1]; +%! # optimised segments +%! P2 = [x2, y2]; +%! # double points removed +%! +%! assert(plotdecimate(P), P1); +%! assert(plotdecimate(P, false), P2); diff --git a/octave_packages/plot-1.1.0/tics.m b/octave_packages/plot-1.1.0/tics.m new file mode 100644 index 0000000..e2357e9 --- /dev/null +++ b/octave_packages/plot-1.1.0/tics.m @@ -0,0 +1,48 @@ +## Copyright (C) 2002 Paul Kienzle +## Copyright (C) 2005 Dmitri A. Sergatskov +## Copyright (C) 2007 Russel Valentine +## Copyright (C) 2007 Peter Gustafson +## This program is in the public domain + +## -*- texinfo -*- +## @deftypefn {Function File} {} tics (@var{axis}, [@var{pos1}, @var{pos2}, @dots{}], [@var{lab1}, @var{lab2}, @dots{}],) +## Explicitly set the tic positions and labels for the given axis. +## +## @var{axis} must be 'x', 'y' or 'z'. +## +## If no positions or labels are given, then restore the default. +## If positions are given but no labels, use those positions with the +## normal labels. If positions and labels are given, each position +## labeled with the corresponding row from the label matrix. +## +## @end deftypefn + +function tics (axis, pos, lab) + + if ( nargin < 1 || nargin > 3 ) + print_usage; + endif + + t = lower (axis); + if (t ~= "x" && t ~= "y" && t ~= "z") + error ("First input argument must be one of 'x', 'y' or 'z'"); + endif + + if (nargin == 1) + set (gca(), [t, "tick"], []); + set (gca(), [t, "tickmode"], "auto"); + set (gca(), [t, "ticklabel"], ""); + set (gca(), [t, "ticklabelmode"], "auto"); + elseif (nargin == 2) + set (gca(), [t, "tick"], pos); + set (gca(), [t, "ticklabel"], ""); + set (gca(), [t, "ticklabelmode"], "auto"); + elseif (nargin == 3) + set (gca(), [t, "tick"], pos); + set (gca(), [t, "ticklabel"], lab); + else + ## we should never get here anyway + print_usage; + endif + +endfunction diff --git a/octave_packages/plot-1.1.0/tricontour.m b/octave_packages/plot-1.1.0/tricontour.m new file mode 100644 index 0000000..8c8de9b --- /dev/null +++ b/octave_packages/plot-1.1.0/tricontour.m @@ -0,0 +1,117 @@ +## Copyright (C) 2008 Andreas Stahel +## +## 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, write to the Free Software +## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +## 02110-1301 USA + +## -*- texinfo -*- +## @deftypefn {Function File} {} tricontour (@var{tri}, @var{x}, @var{y}, @var{z}, @var{levels}) +## @deftypefnx {Function File} {} tricontour (@var{tri}, @var{x}, @var{y}, @var{z}, @var{levels}, @var{linespec}) +## Plot level curves for the values of @code{@var{z}} on 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}. The +## variable @var{levels} is a vector with the values of the countour levels. If +## @var{levels} is a scalar, then it corresponds to the number of +## level curves to be drawn. If exactly one level curve is desired, list +## the level twice in the vector @var{levels}. +## +## If given, @var{linespec} determines the properties to use for the +## lines. +## +## The output argument @var{h} is the graphic handle to the plot. +## @seealso{plot, trimesh, delaunay} +## @end deftypefn + +function h = tricontour (tri, x, y, z, levels, varargin) + if (nargin < 5) + print_usage (); + endif + + if isscalar(levels); + dom=[min(z),max(z)]; + dom=mean(dom)+0.99*(dom-mean(dom)); + levels=linspace(dom(1),dom(2),levels); + endif + + levels=sort(levels); + lmin=levels(1); + lmax=levels(length(levels)); + + pData=[]; %% no preallocation +%% pData=zeros(12000,2); %% preallocation + pPoints=0; + + for el=1:length(tri) + values=[z(tri(el,1)),z(tri(el,2)),z(tri(el,3))]; + minval=min(values); + maxval=max(values); + locallevel=levels(minval<=levels+eps); # select the levels to be plotted + if size(locallevel)>0 + locallevel=locallevel(locallevel<=maxval+eps); + endif + for level=locallevel + points=zeros(1,2); + npoints=1; + dl=values-level; + + if (abs(dl(1))<=10*eps) + points(npoints,:)=[x(tri(el,1)),y(tri(el,1))];npoints++;endif + if (abs(dl(2))<=10*eps) + points(npoints,:)=[x(tri(el,2)),y(tri(el,2))];npoints++;endif + if (abs(dl(3))<=10*eps) + points(npoints,:)=[x(tri(el,3)),y(tri(el,3))];npoints++;endif + + if (npoints<=2) + if ((dl(1)*dl(2)) < 0) # intersection between 1st and 2nd point + points(npoints,:)= ( dl(2)*[x(tri(el,1)),y(tri(el,1))]... + -dl(1)*[x(tri(el,2)),y(tri(el,2))])/(dl(2)-dl(1)); + npoints++; + endif + if ((dl(1)*dl(3)) < 0) # intersection between 1st and 3rd point + points(npoints,:)= ( dl(3)*[x(tri(el,1)),y(tri(el,1))]... + -dl(1)*[x(tri(el,3)),y(tri(el,3))])/(dl(3)-dl(1)); + npoints++; + endif + if ((dl(3)*dl(2)) < 0) # intersection between 2nd and 3rd point + points(npoints,:)= ( dl(2)*[x(tri(el,3)),y(tri(el,3))]... + -dl(3)*[x(tri(el,2)),y(tri(el,2))])/(dl(2)-dl(3)); + npoints++; + endif + endif + pData=[pData;points; NaN,NaN ]; %% no preallocation + %% pData(pPoints+1:pPoints+npoints,1:2)=[points; NaN,NaN ]; %% preallocation + pPoints += npoints; + endfor # level + endfor # el + + pData=pData(1:pPoints-1,:); + + if (nargout>0) + h= plot(pData(:,1),pData(:,2),varargin(:)); + else + plot(pData(:,1),pData(:,2),varargin(:)); + endif + +endfunction + +%!demo +%! rand ('state', 2) +%! x = rand (100, 1)-0.5; +%! y = rand (100, 1)-0.5; +%! z= (x.*y); +%! tri = delaunay (x, y); +%! tricontour (tri, x, y, z, [-0.25:0.05:0.25]); +%! axis equal +%! grid on diff --git a/octave_packages/plot-1.1.0/zoom.m b/octave_packages/plot-1.1.0/zoom.m new file mode 100644 index 0000000..35b5fe1 --- /dev/null +++ b/octave_packages/plot-1.1.0/zoom.m @@ -0,0 +1,9 @@ +## Copyright (C) 2004 Paul Kienzle +## This program is in the public domain + +## -*- texinfo -*- +## @deftypefn {Function File} {} zoom +## Compatibility function; does nothing. +## @end deftypefn + +function zoom endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/abs.m b/octave_packages/quaternion-2.0.0/@quaternion/abs.m new file mode 100644 index 0000000..7c48cbf --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/abs.m @@ -0,0 +1,38 @@ +## Copyright (C) 2010, 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{qabs} =} abs (@var{q}) +## Modulus of a quaternion. +## +## @example +## q = w + x*i + y*j + z*k +## abs (q) = sqrt (w.^2 + x.^2 + y.^2 + z.^2) +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: August 2010 +## Version: 0.2 + +function b = abs (a) + + if (nargin != 1) + print_usage (); + endif + + b = sqrt (norm2 (a)); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/blkdiag.m b/octave_packages/quaternion-2.0.0/@quaternion/blkdiag.m new file mode 100644 index 0000000..2c0c2bb --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/blkdiag.m @@ -0,0 +1,60 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} blkdiag (@var{q1}, @var{q2}, @dots{}) +## Block-diagonal concatenation of quaternions. +## @end deftypefn + + +## Author: Lukas Reichlin +## Created: December 2011 +## Version: 0.1 + +function q = blkdiag (varargin) + + tmp = cellfun (@quaternion, varargin); # uniformoutput = true ! + + w = blkdiag (tmp.w); + x = blkdiag (tmp.x); + y = blkdiag (tmp.y); + z = blkdiag (tmp.z); + + q = quaternion (w, x, y, z); + +endfunction + + +%!shared C, D +%! Aw = [2, 6; 10, 14]; +%! Ax = [3, 7; 11, 15]; +%! Ay = [4, 8; 12, 16]; +%! Az = [5, 9; 13, 17]; +%! A = quaternion (Aw, Ax, Ay, Az); +%! +%! Bw = [2, 6, 10; 14, 18, 22]; +%! Bx = [3, 7, 11; 15, 19, 23]; +%! By = [4, 8, 12; 16, 20, 24]; +%! Bz = [5, 9, 13; 17, 21, 25]; +%! B = quaternion (Bw, Bx, By, Bz); +%! +%! C = blkdiag (A, B); +%! +%! Dw = blkdiag (Aw, Bw); +%! Dx = blkdiag (Ax, Bx); +%! Dy = blkdiag (Ay, By); +%! Dz = blkdiag (Az, Bz); +%! D = quaternion (Dw, Dx, Dy, Dz); +%!assert (C == D); diff --git a/octave_packages/quaternion-2.0.0/@quaternion/cat.m b/octave_packages/quaternion-2.0.0/@quaternion/cat.m new file mode 100644 index 0000000..7f2ef01 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/cat.m @@ -0,0 +1,36 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} cat (@var{dim}, @var{q1}, @var{q2}, @dots{}) +## Concatenation of quaternions along dimension @var{dim}. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function q = cat (dim, varargin) + + tmp = cellfun (@quaternion, varargin); # uniformoutput = true ! + + w = cat (dim, tmp.w); + x = cat (dim, tmp.x); + y = cat (dim, tmp.y); + z = cat (dim, tmp.z); + + q = quaternion (w, x, y, z); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/columns.m b/octave_packages/quaternion-2.0.0/@quaternion/columns.m new file mode 100644 index 0000000..f71eef9 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/columns.m @@ -0,0 +1,34 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{nc} =} columns (@var{q}) +## Return number of columns @var{nc} of quaternion array @var{q}. +## @end deftypefn + + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function c = columns (a) + + if (nargin != 1) + print_usage (); + endif + + c = columns (a.w); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/conj.m b/octave_packages/quaternion-2.0.0/@quaternion/conj.m new file mode 100644 index 0000000..5100c2a --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/conj.m @@ -0,0 +1,40 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} conj (@var{q}) +## Return conjugate of a quaternion. +## +## @example +## q = w + x*i + y*j + z*k +## conj (q) = w - x*i - y*j - z*k +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function a = conj (a) + + if (nargin != 1) + print_usage (); + endif + + a.x = -a.x; + a.y = -a.y; + a.z = -a.z; + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/ctranspose.m b/octave_packages/quaternion-2.0.0/@quaternion/ctranspose.m new file mode 100644 index 0000000..84612e8 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/ctranspose.m @@ -0,0 +1,31 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Conjugate transpose of a quaternion. Used by Octave for "q'". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function a = ctranspose (a) + + if (nargin != 1) + print_usage (); + endif + + a = conj (transpose (a)); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/diag.m b/octave_packages/quaternion-2.0.0/@quaternion/diag.m new file mode 100644 index 0000000..a884596 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/diag.m @@ -0,0 +1,53 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} diag (@var{v}) +## @deftypefnx {Function File} {@var{q} =} diag (@var{v}, @var{k}) +## Return a diagonal quaternion matrix with quaternion vector V on diagonal K. +## The second argument is optional. If it is positive, +## the vector is placed on the K-th super-diagonal. +## If it is negative, it is placed on the -K-th sub-diagonal. +## The default value of K is 0, and the vector is placed +## on the main diagonal. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function a = diag (a, b = 0) + + if (nargin == 0 || nargin > 2) + print_usage (); + endif + + a.w = diag (a.w, b); + a.x = diag (a.x, b); + a.y = diag (a.y, b); + a.z = diag (a.z, b); + +endfunction + + +%!shared R, S +%! Q = quaternion (2, 3, 4, 5); +%! R = diag ([Q, Q, Q]); +%! W = diag ([2, 2, 2]); +%! X = diag ([3, 3, 3]); +%! Y = diag ([4, 4, 4]); +%! Z = diag ([5, 5, 5]); +%! S = quaternion (W, X, Y, Z); +%!assert (R == S); diff --git a/octave_packages/quaternion-2.0.0/@quaternion/diff.m b/octave_packages/quaternion-2.0.0/@quaternion/diff.m new file mode 100644 index 0000000..258cc2d --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/diff.m @@ -0,0 +1,64 @@ +## Copyright (c) 1998, 2000, 2005, 2007 Auburn University. +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR 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{qdot} =} diff (@var{q}, @var{omega}) +## Derivative of a quaternion. +## +## Let Q be a quaternion to transform a vector from a fixed frame to +## a rotating frame. If the rotating frame is rotating about the +## [x, y, z] axes at angular rates [wx, wy, wz], then the derivative +## of Q is given by +## +## @example +## Q' = diff(Q, omega) +## @end example +## +## If the passive convention is used (rotate the frame, not the vector), +## then +## +## @example +## Q' = diff(Q,-omega) +## @end example +## @end deftypefn + +## Adapted from: qderiv by A. S. Hodel + +function qd = diff (q, Omega) + + if (nargin != 2) + print_usage (); + endif + + if (! isa (q, "quaternion") || ! isscalar (q.w)) + error ("quaternion: first argument '%s' must be a scalar quaternion", inputname(1)); + endif + + Omega = vec (Omega); + + if (length (Omega) != 3) + error ("quaternion: second argument '%s' must be a length 3 vector", inputname(2)); + endif + + qd = 0.5 * quaternion (Omega(1), Omega(2), Omega(3)) * q; + +endfunction + +%!shared q +%! q = quaternion(3,1,0,0); + +%!assert(quaternion(0,0,0.5,1.5) == diff(q,[0 0 1])) +%!assert(quaternion(0,0,2,1) == diff(q,[0 1 1])) diff --git a/octave_packages/quaternion-2.0.0/@quaternion/display.m b/octave_packages/quaternion-2.0.0/@quaternion/display.m new file mode 100644 index 0000000..bc63687 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/display.m @@ -0,0 +1,63 @@ +## Copyright (C) 2010, 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Display routine for quaternions. Used by Octave internally. + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.2 + +function display (q) + + name = inputname(1); + s = size (q); + + if (length (s) == 2 && all (s == 1)) # scalar quaternion + w = num2str (q.w, 4); + x = __num2str__ (q.x); + y = __num2str__ (q.y); + z = __num2str__ (q.z); + disp ([name, " = ", w, x, "i" y, "j", z, "k"]); + disp (""); + else # non-scalar quaternion + disp ([name, ".w ="]); + disp (q.w); + disp (""); + disp ([name, ".x ="]); + disp (q.x); + disp (""); + disp ([name, ".y ="]); + disp (q.y); + disp (""); + disp ([name, ".z ="]); + disp (q.z); + disp (""); + endif + +endfunction + + +function str = __num2str__ (num) + + if (sign (num) == -1) + str = " - "; + else + str = " + "; + endif + + str = [str, num2str(abs (num), 4)]; + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/eq.m b/octave_packages/quaternion-2.0.0/@quaternion/eq.m new file mode 100644 index 0000000..b5490a2 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/eq.m @@ -0,0 +1,35 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Equal to operator for two quaternions. Used by Octave for "q1 == q2". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function flg = eq (a, b) + + if (! isa (a, "quaternion")) + a = quaternion (a); + endif + + if (! isa (b, "quaternion")) + b = quaternion (b); + endif + + flg = (a.w == b.w) && (a.x == b.x) && (a.y == b.y) && (a.z == a.z); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/exp.m b/octave_packages/quaternion-2.0.0/@quaternion/exp.m new file mode 100644 index 0000000..97ecce1 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/exp.m @@ -0,0 +1,40 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{qexp} =} exp (@var{q}) +## Exponential of a quaternion. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function q = exp (q) + + if (nargin != 1) + print_usage (); + endif + + normv = normv (q); + exps = exp (q.w); + sinv = sin (normv); + + q.w = exps .* cos (normv); + q.x = exps .* (q.x ./ normv) .* sinv; + q.y = exps .* (q.y ./ normv) .* sinv; + q.z = exps .* (q.z ./ normv) .* sinv; + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/horzcat.m b/octave_packages/quaternion-2.0.0/@quaternion/horzcat.m new file mode 100644 index 0000000..4d26714 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/horzcat.m @@ -0,0 +1,34 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Horizontal concatenation of quaternions. Used by Octave for "[q1, q2]". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function q = horzcat (varargin) + + tmp = cellfun (@quaternion, varargin); # uniformoutput = true ! + + w = horzcat (tmp.w); + x = horzcat (tmp.x); + y = horzcat (tmp.y); + z = horzcat (tmp.z); + + q = quaternion (w, x, y, z); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/inv.m b/octave_packages/quaternion-2.0.0/@quaternion/inv.m new file mode 100644 index 0000000..7aafaf0 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/inv.m @@ -0,0 +1,42 @@ +## Copyright (C) 2010, 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{qinv} =} inv (@var{q}) +## Return inverse of a quaternion. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.2 + +function a = inv (a) + + if (nargin != 1) + print_usage (); + endif + + if (isscalar (a.w)) + norm2 = norm2 (a); + a.w = a.w / norm2; + a.x = -a.x / norm2; + a.y = -a.y / norm2; + a.z = -a.z / norm2; + else + ## TODO: quaternion arrays + error ("quaternion: inv: implemented for scalar quaternions only"); + endif + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/ispure.m b/octave_packages/quaternion-2.0.0/@quaternion/ispure.m new file mode 100644 index 0000000..d8e4aea --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/ispure.m @@ -0,0 +1,33 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{flg} =} ispure (@var{q}) +## Return 1 if scalar part of quaternion is zero, otherwise return 0 +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function flg = ispure (a) + + if (nargin != 1) + print_usage (); + endif + + flg = all ((abs (a.w) < eps)(:)); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/ldivide.m b/octave_packages/quaternion-2.0.0/@quaternion/ldivide.m new file mode 100644 index 0000000..4d1c69e --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/ldivide.m @@ -0,0 +1,27 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Element-wise left division for quaternions. Used by Octave for "q1 .\\ q2". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function q = ldivide (a, b) + + q = a.^-1 .* b; + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/log.m b/octave_packages/quaternion-2.0.0/@quaternion/log.m new file mode 100644 index 0000000..457e7a9 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/log.m @@ -0,0 +1,61 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{qlog} =} log (@var{q}) +## Logarithmus naturalis of a quaternion. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function q = log (q) + + if (nargin != 1) + print_usage (); + endif + + normq = abs (q); + normv = normv (q); + acossq = acos (q.w ./ normq); + + q.w = log (normq); + q.x = (q.x ./ normv) .* acossq; + q.y = (q.y ./ normv) .* acossq; + q.z = (q.z ./ normv) .* acossq; + + ## FIXME: q = quaternion (2, 3, 4, 5) + ## p = log (exp (q)) + ## p.v is wrong, probably somehow related to acos + ## NOTE: p = exp (log (q)) is calculated correctly + ## NOTE: qtfm 1.9 returns the same "wrong" result + +endfunction + + +%!shared A, B +%! Aw = [2, 6, 10; 14, 18, 22]; +%! Ax = [3, 7, 11; 15, 19, 23]; +%! Ay = [4, 8, 12; 16, 20, 24]; +%! Az = [5, 9, 13; 17, 21, 25]; +%! A = quaternion (Aw, Ax, Ay, Az); +%! +%! B = exp (log (A)); +%! +%!assert (A.w, B.w, 1e-4); +%!assert (A.x, B.x, 1e-4); +%!assert (A.y, B.y, 1e-4); +%!assert (A.z, B.z, 1e-4); diff --git a/octave_packages/quaternion-2.0.0/@quaternion/minus.m b/octave_packages/quaternion-2.0.0/@quaternion/minus.m new file mode 100644 index 0000000..f894bfe --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/minus.m @@ -0,0 +1,38 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Subtraction of two quaternions. Used by Octave for "q1 - q2". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function a = minus (a, b) + + if (! isa (a, "quaternion")) + a = quaternion (a); + endif + + if (! isa (b, "quaternion")) + b = quaternion (b); + endif + + a.w = a.w - b.w; + a.x = a.x - b.x; + a.y = a.y - b.y; + a.z = a.z - b.z; + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/mldivide.m b/octave_packages/quaternion-2.0.0/@quaternion/mldivide.m new file mode 100644 index 0000000..718b780 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/mldivide.m @@ -0,0 +1,27 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Matrix left division for quaternions. Used by Octave for "q1 \\ q2". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function q = mldivide (a, b) + + q = inv (a) * b; + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/mpower.m b/octave_packages/quaternion-2.0.0/@quaternion/mpower.m new file mode 100644 index 0000000..e8c865b --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/mpower.m @@ -0,0 +1,56 @@ +## Copyright (C) 2010, 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Matrix power operator of quaternions. Used by Octave for "q^x". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.2 + +function q = mpower (a, b) + + [r, c] = size (a); + + if (r != c) + error ("quaternion: mpower: quaternion matrix must be square"); + endif + + if (r == 1 && c == 1) # a scalar, b? + q = a .^ b; # b could be a quaternion + elseif (is_real_array (b) && isscalar (b) && fix (b) == b) + e = fix (abs (b)); + switch (sign (b)) + case -1 # q^-e + a = inv (a); + q = a; + case 0 # q^0 + q = eye (r); # alternative: q = quaternion (eye (r)) + return; + case 1; # q^e + q = a; + endswitch + for k = 2 : e + q *= a; # improvement?: q^8 = ((q^2)^2)^2, q^9 = (((q^2)^2)^2)*q + endfor + else + error ("quaternion: mpower: case not implemented yet"); + q = expm (logm (a) * b); # don't know whether this formula is correct + endif + + ## TODO: - q1 ^ q2 + ## - arrays + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/mrdivide.m b/octave_packages/quaternion-2.0.0/@quaternion/mrdivide.m new file mode 100644 index 0000000..6bfdc1a --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/mrdivide.m @@ -0,0 +1,27 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Matrix right division for quaternions. Used by Octave for "q1 / q2". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function q = mrdivide (a, b) + + q = a * inv (b); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/mtimes.m b/octave_packages/quaternion-2.0.0/@quaternion/mtimes.m new file mode 100644 index 0000000..8252f08 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/mtimes.m @@ -0,0 +1,43 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Matrix multiplication of two quaternions. Used by Octave for "q1 * q2". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function a = mtimes (a, b) + + if (! isa (a, "quaternion")) + a = quaternion (a); + endif + + if (! isa (b, "quaternion")) + b = quaternion (b); + endif + + w = a.w*b.w - a.x*b.x - a.y*b.y - a.z*b.z; + x = a.y*b.z - a.z*b.y + a.w*b.x + a.x*b.w; + y = a.z*b.x - a.x*b.z + a.w*b.y + a.y*b.w; + z = a.x*b.y - a.y*b.x + a.w*b.z + a.z*b.w; + + a.w = w; + a.x = x; + a.y = y; + a.z = z; + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/norm.m b/octave_packages/quaternion-2.0.0/@quaternion/norm.m new file mode 100644 index 0000000..bfdcde7 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/norm.m @@ -0,0 +1,38 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{n} =} norm (@var{q}) +## Norm of a quaternion. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function n = norm (a) + + if (nargin != 1) + print_usage (); + endif + + if (! isscalar (a.w)) + warning ("norm: use 'abs' to calculate the lengths of quaternion arrays"); + error ("norm: only the 2-norm of scalar quaternions is implemented until now"); + endif + + n = abs (a); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/plus.m b/octave_packages/quaternion-2.0.0/@quaternion/plus.m new file mode 100644 index 0000000..ed54a2a --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/plus.m @@ -0,0 +1,38 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Addition of two quaternions. Used by Octave for "q1 + q2". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function a = plus (a, b) + + if (! isa (a, "quaternion")) + a = quaternion (a); + endif + + if (! isa (b, "quaternion")) + b = quaternion (b); + endif + + a.w = a.w + b.w; + a.x = a.x + b.x; + a.y = a.y + b.y; + a.z = a.z + b.z; + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/power.m b/octave_packages/quaternion-2.0.0/@quaternion/power.m new file mode 100644 index 0000000..57f1b4a --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/power.m @@ -0,0 +1,49 @@ +## Copyright (C) 2010, 2011 Lukas F. Reichlin +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR 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 -*- +## Power operator of quaternions. Used by Octave for "q.^x". +## Exponent x can be scalar or of appropriate size. + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.3 + +function a = power (a, b) + + if (isa (b, "quaternion")) # exponent is a quaternion + a = exp (log (a) .* b); # a could be real, but log doesn't care + elseif (! isreal (b)) + error ("quaternion:invalidArgument", "quaternion: power: invalid exponent"); + elseif (b == -1) # special case for ldivide and rdivide + norm2 = norm2 (a); # a is quaternion because b is not, + a.w = a.w ./ norm2; # otherwise octave wouldn't call + a.x = -a.x ./ norm2; # quaternion's power operator. + a.y = -a.y ./ norm2; + a.z = -a.z ./ norm2; + else # exponent is real + na = abs (a); + nv = normv (a); + th = acos (a.w ./ na); + nab = na.^b; + snt = sin (b.*th); + a.w = nab .* cos (b.*th); + a.x = (a.x ./ nv) .* nab .* snt; + a.y = (a.y ./ nv) .* nab .* snt; + a.z = (a.z ./ nv) .* nab .* snt; + endif + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/private/norm2.m b/octave_packages/quaternion-2.0.0/@quaternion/private/norm2.m new file mode 100644 index 0000000..f723729 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/private/norm2.m @@ -0,0 +1,29 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{norm2} =} norm2 (@var{q}) +## Return squared norm of a quaternion. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function ret = norm2 (a) + + ret = a.w.^2 + a.x.^2 + a.y.^2 + a.z.^2; + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/private/normv.m b/octave_packages/quaternion-2.0.0/@quaternion/private/normv.m new file mode 100644 index 0000000..3a7c168 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/private/normv.m @@ -0,0 +1,29 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{normv} =} normv (@var{q}) +## Return norm of the vector part. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function ret = normv (a) + + ret = sqrt (a.x.^2 + a.y.^2 + a.z.^2); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/quaternion.m b/octave_packages/quaternion-2.0.0/@quaternion/quaternion.m new file mode 100644 index 0000000..0c19ba0 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/quaternion.m @@ -0,0 +1,111 @@ +## Copyright (C) 2010, 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} quaternion (@var{w}) +## @deftypefnx {Function File} {@var{q} =} quaternion (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {@var{q} =} quaternion (@var{w}, @var{x}, @var{y}, @var{z}) +## Constructor for quaternions - create or convert to quaternion. +## +## @example +## q = w + x*i + y*j + z*k +## @end example +## +## Arguments @var{w}, @var{x}, @var{y} and @var{z} can be scalars or +## matrices, but they must be real and of equal size. If scalar part +## @var{w} or components @var{x}, @var{y} and @var{z} of the vector +## part are not specified, zero matrices of appropriate size are +## assumed. +## +## @strong{Example} +## @example +## @group +## octave:1> q = quaternion (2) +## q = 2 + 0i + 0j + 0k +## +## octave:2> q = quaternion (3, 4, 5) +## q = 0 + 3i + 4j + 5k +## +## octave:3> q = quaternion (2, 3, 4, 5) +## q = 2 + 3i + 4j + 5k +## @end group +## @end example +## @example +## @group +## octave:4> w = [2, 6, 10; 14, 18, 22]; +## octave:5> x = [3, 7, 11; 15, 19, 23]; +## octave:6> y = [4, 8, 12; 16, 20, 24]; +## octave:7> z = [5, 9, 13; 17, 21, 25]; +## octave:8> q = quaternion (w, x, y, z) +## q.w = +## 2 6 10 +## 14 18 22 +## +## q.x = +## 3 7 11 +## 15 19 23 +## +## q.y = +## 4 8 12 +## 16 20 24 +## +## q.z = +## 5 9 13 +## 17 21 25 +## +## octave:9> +## @end group +## @end example +## +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.2 + +function q = quaternion (a, b, c, d) + + switch (nargin) + case 1 + if (isa (a, "quaternion")) # quaternion (q) + q = a; + return; + elseif (is_real_array (a)) # quaternion (w) + b = c = d = zeros (size (a)); + else + print_usage (); + endif + case 3 # quaternion (x, y, z) + d = c; + c = b; + b = a; + a = zeros (size (a)); + case 4 # quaternion (w, x, y, z) + ## nothing to do here, just prevent case "otherwise" + otherwise + print_usage (); + endswitch + + if (! is_real_array (a, b, c, d)) + error ("quaternion: arguments must be real matrices"); + endif + + if (! size_equal (a, b, c, d)); + error ("quaternion: arguments must have identical sizes"); + endif + + q = class (struct ("w", a, "x", b, "y", c, "z", d), "quaternion"); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/rdivide.m b/octave_packages/quaternion-2.0.0/@quaternion/rdivide.m new file mode 100644 index 0000000..4b61fad --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/rdivide.m @@ -0,0 +1,27 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Element-wise right division for quaternions. Used by Octave for "q1 ./ q2". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function q = rdivide (a, b) + + q = a .* b.^-1; + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/rows.m b/octave_packages/quaternion-2.0.0/@quaternion/rows.m new file mode 100644 index 0000000..7d68692 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/rows.m @@ -0,0 +1,33 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{nr} =} rows (@var{q}) +## Return number of rows @var{nr} of quaternion array @var{q}. +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function r = rows (a) + + if (nargin != 1) + print_usage (); + endif + + r = rows (a.w); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/size.m b/octave_packages/quaternion-2.0.0/@quaternion/size.m new file mode 100644 index 0000000..e00f906 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/size.m @@ -0,0 +1,74 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{nvec} =} size (@var{q}) +## @deftypefnx {Function File} {@var{n} =} size (@var{q}, @var{dim}) +## @deftypefnx {Function File} {[@var{nx}, @var{ny}, @dots{}] =} size (@var{q}) +## Return size of quaternion arrays. +## +## @strong{Inputs} +## @table @var +## @item q +## Quaternion object. +## @item dim +## If given a second argument, @command{size} will return the size of the +## corresponding dimension. +## @end table +## +## @strong{Outputs} +## @table @var +## @item nvec +## Row vector. The first element is the number of rows and the second +## element the number of columns. If @var{q} is an n-dimensional array +## of quaternions, the n-th element of @var{nvec} corresponds to the +## size of the n-th dimension of @var{q}. +## @item n +## Scalar value. The size of the dimension @var{dim}. +## @item nx +## Number of rows. +## @item ny +## Number of columns. +## @item @dots{} +## Sizes of the 3rd to n-th dimensions. +## @end table +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.2 + +function varargout = size (a, b) + + switch (nargout) + case {0, 1} + switch (nargin) + case 1 # nvec = size (q) + varargout{1} = size (a.w); + case 2 # n = size (q, dim) + varargout{1} = size (a.w, b); + otherwise + print_usage (); + endswitch + + otherwise + if (nargin == 1) # [nx, ny, ...] = size (q) + varargout = num2cell (size (a.w)); + else + print_usage (); + endif + endswitch + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/subsasgn.m b/octave_packages/quaternion-2.0.0/@quaternion/subsasgn.m new file mode 100644 index 0000000..8777b5c --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/subsasgn.m @@ -0,0 +1,64 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Subscripted assignment for quaternions. +## Used by Octave for "q.key = value". + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.2 + +function q = subsasgn (q, idx, val) + + switch (idx(1).type) + case "()" # q(...) = val + if (length (idx(1).subs) == 1 && isa (val, "quaternion")) # required by horzcat, vertcat, cat, ... + q(idx(1).subs{:}) = val; # q = cellfun (@quaternion, varargin) + else # general case + val = quaternion (val); + w = subsasgn (q.w, idx, val.w); + x = subsasgn (q.x, idx, val.x); + y = subsasgn (q.y, idx, val.y); + z = subsasgn (q.z, idx, val.z); + q = quaternion (w, x, y, z); + endif + + case "." # q.w = val + if (! is_real_array (val)) + error ("quaternion: subsasgn: invalid argument type, require real array"); + endif + if (! size_equal (subsref (q.w, idx(2:end)), val)) + error ("quaternion: subsasgn: invalid argument size [%s], require dimensions [%s]", \ + num2str (size (val), "%d "), num2str (size (subsref (q.w, idx(2:end))), "%d ")); + endif + switch (tolower (idx(1).subs)) + case {"w", "s"} + q.w = subsasgn (q.w, idx(2:end), val); + case {"x", "i"} + q.x = subsasgn (q.x, idx(2:end), val); + case {"y", "j"} + q.y = subsasgn (q.y, idx(2:end), val); + case {"z", "k"} + q.z = subsasgn (q.z, idx(2:end), val); + otherwise + error ("quaternion: subsasgn: invalid subscript name '%s'", idx(1).subs); + endswitch + + otherwise + error ("quaternion: subsasgn: invalid subscript type '%s'", idx(1).type); + endswitch + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/subsref.m b/octave_packages/quaternion-2.0.0/@quaternion/subsref.m new file mode 100644 index 0000000..32b67b8 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/subsref.m @@ -0,0 +1,60 @@ +## Copyright (C) 2010, 2011, 2012 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Subscripted reference for quaternions. Used by Octave for "q.w". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.4 + +function ret = subsref (q, s) + + if (numel (s) == 0) + ret = q; + return; + endif + + switch (s(1).type) + case "." # q.w + switch (tolower (s(1).subs)) + case {"w", "s"} # scalar part + ret = subsref (q.w, s(2:end)); + case {"x", "i"} + ret = subsref (q.x, s(2:end)); + case {"y", "j"} + ret = subsref (q.y, s(2:end)); + case {"z", "k"} + ret = subsref (q.z, s(2:end)); + case "v" # vector part, scalar part set to zero + q.w = zeros (size (q.w)); + ret = subsref (q, s(2:end)); + otherwise + error ("quaternion: invalid subscript name '%s'", s(1).subs); + endswitch + + case "()" # q(...) + w = subsref (q.w, s(1)); + x = subsref (q.x, s(1)); + y = subsref (q.y, s(1)); + z = subsref (q.z, s(1)); + tmp = quaternion (w, x, y, z); + ret = subsref (tmp, s(2:end)); + + otherwise + error ("quaternion: invalid subscript type '%s'", s(1).type); + endswitch + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/times.m b/octave_packages/quaternion-2.0.0/@quaternion/times.m new file mode 100644 index 0000000..58b2d78 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/times.m @@ -0,0 +1,43 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Element-wise multiplication of two quaternions. Used by Octave for "q1 .* q2". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function a = times (a, b) + + if (! isa (a, "quaternion")) + a = quaternion (a); + endif + + if (! isa (b, "quaternion")) + b = quaternion (b); + endif + + w = a.w .* b.w - a.x .* b.x - a.y .* b.y - a.z .* b.z; + x = a.y .* b.z - a.z .* b.y + a.w .* b.x + a.x .* b.w; + y = a.z .* b.x - a.x .* b.z + a.w .* b.y + a.y .* b.w; + z = a.x .* b.y - a.y .* b.x + a.w .* b.z + a.z .* b.w; + + a.w = w; + a.x = x; + a.y = y; + a.z = z; + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/transpose.m b/octave_packages/quaternion-2.0.0/@quaternion/transpose.m new file mode 100644 index 0000000..1ffd0eb --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/transpose.m @@ -0,0 +1,34 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Transpose of a quaternion. Used by Octave for "q.'". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function a = transpose (a) + + if (nargin != 1) + print_usage (); + endif + + a.w = transpose (a.w); + a.x = transpose (a.x); + a.y = transpose (a.y); + a.z = transpose (a.z); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/uminus.m b/octave_packages/quaternion-2.0.0/@quaternion/uminus.m new file mode 100644 index 0000000..7730da9 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/uminus.m @@ -0,0 +1,30 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Unary minus of a quaternion. Used by Octave for "-q". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function a = uminus (a) + + a.w = -a.w; + a.x = -a.x; + a.y = -a.y; + a.z = -a.z; + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/unit.m b/octave_packages/quaternion-2.0.0/@quaternion/unit.m new file mode 100644 index 0000000..8a439f0 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/unit.m @@ -0,0 +1,38 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{qn} =} unit (@var{q}) +## Normalize quaternion to length 1 (unit quaternion). +## +## @example +## q = w + x*i + y*j + z*k +## unit (q) = q ./ sqrt (w.^2 + x.^2 + y.^2 + z.^2) +## @end example +## @end deftypefn + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function q = unit (a) + + if (nargin != 1) + print_usage (); + endif + + q = a ./ abs (a); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/uplus.m b/octave_packages/quaternion-2.0.0/@quaternion/uplus.m new file mode 100644 index 0000000..5649df8 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/uplus.m @@ -0,0 +1,27 @@ +## Copyright (C) 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Unary plus of a quaternion. Used by Octave for "+q". + +## Author: Lukas Reichlin +## Created: November 2011 +## Version: 0.1 + +function a = uplus (a) + + ## nothing to do here + +endfunction diff --git a/octave_packages/quaternion-2.0.0/@quaternion/vertcat.m b/octave_packages/quaternion-2.0.0/@quaternion/vertcat.m new file mode 100644 index 0000000..50680d8 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/@quaternion/vertcat.m @@ -0,0 +1,34 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## Vertical concatenation of quaternions. Used by Octave for "[q1; q2]". + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function q = vertcat (varargin) + + tmp = cellfun (@quaternion, varargin); # uniformoutput = true ! + + w = vertcat (tmp.w); + x = vertcat (tmp.x); + y = vertcat (tmp.y); + z = vertcat (tmp.z); + + q = quaternion (w, x, y, z); + +endfunction diff --git a/octave_packages/quaternion-2.0.0/doc-cache b/octave_packages/quaternion-2.0.0/doc-cache new file mode 100644 index 0000000..1f0e50a --- /dev/null +++ b/octave_packages/quaternion-2.0.0/doc-cache @@ -0,0 +1,242 @@ +# Created by Octave 3.6.1, Mon Apr 02 12:18:12 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 5 +# name: +# type: sq_string +# elements: 1 +# length: 5 +q2rot + + +# name: +# type: sq_string +# elements: 1 +# length: 814 + -- Function File: [AXIS, ANGLE] = q2rot (Q) + Extract vector/angle form of a unit quaternion Q. + + *Inputs* + Q + Unit quaternion describing the rotation. + + *Outputs* + AXIS + Eigenaxis as a 3-d unit vector `[x, y, z]'. + + ANGLE + Rotation angle in radians. The positive direction is + determined by the right-hand rule applied to AXIS. + + *Example* + octave:1> axis = [0, 0, 1] + axis = + 0 0 1 + octave:2> angle = pi/4 + angle = 0.78540 + octave:3> q = rot2q (axis, angle) + q = 0.9239 + 0i + 0j + 0.3827k + octave:4> [vv, th] = q2rot (q) + vv = + 0 0 1 + th = 0.78540 + octave:5> theta = th*180/pi + theta = 45.000 + octave:6> + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Extract vector/angle form of a unit quaternion Q. + + + +# name: +# type: sq_string +# elements: 1 +# length: 2 +qi + + +# name: +# type: sq_string +# elements: 1 +# length: 355 + @deftypefn {Function File} {} qi + Create x-component of a quaternion's vector part. + + @example + q = w + x*qi + y*qj + z*qk + @end example + + @strong{Example} + @example + @group + octave:1> q1 = quaternion (1, 2, 3, 4) + q1 = 1 + 2i + 3j + 4k + octave:2> q2 = 1 + 2*qi + 3*qj + 4*qk + q2 = 1 + 2i + 3j + 4k + octave:3> + @end group + @end example + + @end deftypefn + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + @deftypefn {Function File} {} qi + Create x-component of a quaternion's vector p + + + +# name: +# type: sq_string +# elements: 1 +# length: 2 +qj + + +# name: +# type: sq_string +# elements: 1 +# length: 355 + @deftypefn {Function File} {} qj + Create y-component of a quaternion's vector part. + + @example + q = w + x*qi + y*qj + z*qk + @end example + + @strong{Example} + @example + @group + octave:1> q1 = quaternion (1, 2, 3, 4) + q1 = 1 + 2i + 3j + 4k + octave:2> q2 = 1 + 2*qi + 3*qj + 4*qk + q2 = 1 + 2i + 3j + 4k + octave:3> + @end group + @end example + + @end deftypefn + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + @deftypefn {Function File} {} qj + Create y-component of a quaternion's vector p + + + +# name: +# type: sq_string +# elements: 1 +# length: 2 +qk + + +# name: +# type: sq_string +# elements: 1 +# length: 355 + @deftypefn {Function File} {} qk + Create z-component of a quaternion's vector part. + + @example + q = w + x*qi + y*qj + z*qk + @end example + + @strong{Example} + @example + @group + octave:1> q1 = quaternion (1, 2, 3, 4) + q1 = 1 + 2i + 3j + 4k + octave:2> q2 = 1 + 2*qi + 3*qj + 4*qk + q2 = 1 + 2i + 3j + 4k + octave:3> + @end group + @end example + + @end deftypefn + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + @deftypefn {Function File} {} qk + Create z-component of a quaternion's vector p + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +rot2q + + +# name: +# type: sq_string +# elements: 1 +# length: 1058 + -- Function File: Q = rot2q (AXIS, ANGLE) + Create unit quaternion Q which describes a rotation of ANGLE + radians about the vector AXIS. This function uses the active + convention where the vector AXIS is rotated by ANGLE radians. If + the coordinate frame should be rotated by ANGLE radians, also + called the passive convention, this is equivalent to rotating the + AXIS by -ANGLE radians. + + *Inputs* + AXIS + Vector `[x, y, z]' describing the axis of rotation. + + ANGLE + Rotation angle in radians. The positive direction is + determined by the right-hand rule applied to AXIS. + + *Outputs* + Q + Unit quaternion describing the rotation. + + *Example* + octave:1> axis = [0, 0, 1]; + octave:2> angle = pi/4; + octave:3> q = rot2q (axis, angle) + q = 0.9239 + 0i + 0j + 0.3827k + octave:4> v = quaternion (1, 1, 0) + v = 0 + 1i + 1j + 0k + octave:5> vr = q * v * conj (q) + vr = 0 + 0i + 1.414j + 0k + octave:6> + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Create unit quaternion Q which describes a rotation of ANGLE radians +about the v + + + + + diff --git a/octave_packages/quaternion-2.0.0/packinfo/.autoload b/octave_packages/quaternion-2.0.0/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/quaternion-2.0.0/packinfo/DESCRIPTION b/octave_packages/quaternion-2.0.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..c4845d3 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: quaternion +Version: 2.0.0 +Date: 2012-03-28 +Author: Lukas Reichlin +Maintainer: Lukas Reichlin +Title: Quaternion +Description: Overloaded operators for quaternions +Depends: octave (>= 3.6.0) +Autoload: yes +License: GPLv3+ +Url: http://octave.sf.net diff --git a/octave_packages/quaternion-2.0.0/packinfo/INDEX b/octave_packages/quaternion-2.0.0/packinfo/INDEX new file mode 100644 index 0000000..897b23f --- /dev/null +++ b/octave_packages/quaternion-2.0.0/packinfo/INDEX @@ -0,0 +1,44 @@ +quaternion >> Quaternion +Quaternions + quaternion + qi + qj + qk + q2rot + rot2q +Methods + @quaternion/abs + @quaternion/blkdiag + @quaternion/cat + @quaternion/columns + @quaternion/conj + @quaternion/diag + @quaternion/diff + @quaternion/exp + @quaternion/inv + @quaternion/ispure + @quaternion/log + @quaternion/norm + @quaternion/rows + @quaternion/size + @quaternion/unit +Overloaded Operators + @quaternion/ctranspose + @quaternion/eq + @quaternion/horzcat + @quaternion/ldivide + @quaternion/minus + @quaternion/mldivide + @quaternion/mpower + @quaternion/mrdivide + @quaternion/mtimes + @quaternion/plus + @quaternion/power + @quaternion/rdivide + @quaternion/subsasgn + @quaternion/subsref + @quaternion/times + @quaternion/transpose + @quaternion/uminus + @quaternion/uplus + @quaternion/vertcat diff --git a/octave_packages/quaternion-2.0.0/packinfo/NEWS b/octave_packages/quaternion-2.0.0/packinfo/NEWS new file mode 100644 index 0000000..9582182 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/packinfo/NEWS @@ -0,0 +1,14 @@ +Summary of important user-visible changes for releases of the quaternion package + +=============================================================================== +quaternion-2.0.0 Release Date: 2012-03-28 Release Manager: Lukas Reichlin +=============================================================================== + +** First official release. Its main features are: + -- Matrices and n-dimensional arrays of quaternions. + -- Overloaded operators due to the use of classes. + -- Operator semantics similar to Octave’s built-in complex numbers. + -- Vectorized code for crunching large quaternion arrays in a speedy manner. + + +=============================================================================== diff --git a/octave_packages/quaternion-2.0.0/q2rot.m b/octave_packages/quaternion-2.0.0/q2rot.m new file mode 100644 index 0000000..389c411 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/q2rot.m @@ -0,0 +1,93 @@ +## Copyright (C) 1998, 1999, 2000, 2002, 2005, 2006, 2007 Auburn University +## Copyright (C) 2010, 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{axis}, @var{angle}] =} q2rot (@var{q}) +## Extract vector/angle form of a unit quaternion @var{q}. +## +## @strong{Inputs} +## @table @var +## @item q +## Unit quaternion describing the rotation. +## @end table +## +## @strong{Outputs} +## @table @var +## @item axis +## Eigenaxis as a 3-d unit vector @code{[x, y, z]}. +## @item angle +## Rotation angle in radians. The positive direction is +## determined by the right-hand rule applied to @var{axis}. +## @end table +## +## @strong{Example} +## @example +## @group +## octave:1> axis = [0, 0, 1] +## axis = +## 0 0 1 +## octave:2> angle = pi/4 +## angle = 0.78540 +## octave:3> q = rot2q (axis, angle) +## q = 0.9239 + 0i + 0j + 0.3827k +## octave:4> [vv, th] = q2rot (q) +## vv = +## 0 0 1 +## th = 0.78540 +## octave:5> theta = th*180/pi +## theta = 45.000 +## octave:6> +## @end group +## @end example +## +## @end deftypefn + +## Adapted from: quaternion by A. S. Hodel +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function [vv, theta] = q2rot (q) + + if (nargin != 1 || nargout != 2) + print_usage (); + endif + + if (! isa (q, "quaternion") || ! isscalar (q.w)) + error ("q2rot: require scalar quaternion as input"); + endif + + if (abs (norm (q) - 1) > 1e-12) + warning ("q2rot: ||q||=%e, setting=1 for vv, theta", norm (q)); + q = unit (q); + endif + + s = q.s; + vv = [q.x, q.y, q.z]; + + theta = acos (s) * 2; + + if (abs (theta) > pi) + theta = theta - sign (theta) * pi; + endif + + sin_th_2 = norm (vv); + + if (sin_th_2 != 0) + vv ./= sin_th_2; + endif + +endfunction \ No newline at end of file diff --git a/octave_packages/quaternion-2.0.0/qi.m b/octave_packages/quaternion-2.0.0/qi.m new file mode 100644 index 0000000..fd68678 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/qi.m @@ -0,0 +1,48 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## @deftypefn {Function File} {} qi +## Create x-component of a quaternion's vector part. +## +## @example +## q = w + x*qi + y*qj + z*qk +## @end example +## +## @strong{Example} +## @example +## @group +## octave:1> q1 = quaternion (1, 2, 3, 4) +## q1 = 1 + 2i + 3j + 4k +## octave:2> q2 = 1 + 2*qi + 3*qj + 4*qk +## q2 = 1 + 2i + 3j + 4k +## octave:3> +## @end group +## @end example +## +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function q = qi + + if (nargin != 0) + print_usage (); + endif + + q = quaternion (0, 1, 0, 0); + +endfunction \ No newline at end of file diff --git a/octave_packages/quaternion-2.0.0/qj.m b/octave_packages/quaternion-2.0.0/qj.m new file mode 100644 index 0000000..89e1cfb --- /dev/null +++ b/octave_packages/quaternion-2.0.0/qj.m @@ -0,0 +1,48 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## @deftypefn {Function File} {} qj +## Create y-component of a quaternion's vector part. +## +## @example +## q = w + x*qi + y*qj + z*qk +## @end example +## +## @strong{Example} +## @example +## @group +## octave:1> q1 = quaternion (1, 2, 3, 4) +## q1 = 1 + 2i + 3j + 4k +## octave:2> q2 = 1 + 2*qi + 3*qj + 4*qk +## q2 = 1 + 2i + 3j + 4k +## octave:3> +## @end group +## @end example +## +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function q = qj + + if (nargin != 0) + print_usage (); + endif + + q = quaternion (0, 0, 1, 0); + +endfunction \ No newline at end of file diff --git a/octave_packages/quaternion-2.0.0/qk.m b/octave_packages/quaternion-2.0.0/qk.m new file mode 100644 index 0000000..c60cc21 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/qk.m @@ -0,0 +1,48 @@ +## Copyright (C) 2010 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## @deftypefn {Function File} {} qk +## Create z-component of a quaternion's vector part. +## +## @example +## q = w + x*qi + y*qj + z*qk +## @end example +## +## @strong{Example} +## @example +## @group +## octave:1> q1 = quaternion (1, 2, 3, 4) +## q1 = 1 + 2i + 3j + 4k +## octave:2> q2 = 1 + 2*qi + 3*qj + 4*qk +## q2 = 1 + 2i + 3j + 4k +## octave:3> +## @end group +## @end example +## +## @end deftypefn + +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function q = qk + + if (nargin != 0) + print_usage (); + endif + + q = quaternion (0, 0, 0, 1); + +endfunction \ No newline at end of file diff --git a/octave_packages/quaternion-2.0.0/rot2q.m b/octave_packages/quaternion-2.0.0/rot2q.m new file mode 100644 index 0000000..8dc3249 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/rot2q.m @@ -0,0 +1,95 @@ +## Copyright (C) 1998, 1999, 2000, 2002, 2005, 2006, 2007 Auburn University +## Copyright (C) 2010, 2011 Lukas F. Reichlin +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} rot2q (@var{axis}, @var{angle}) +## Create unit quaternion @var{q} which describes a rotation of +## @var{angle} radians about the vector @var{axis}. This function uses +## the active convention where the vector @var{axis} is rotated by @var{angle} +## radians. If the coordinate frame should be rotated by @var{angle} +## radians, also called the passive convention, this is equivalent +## to rotating the @var{axis} by @var{-angle} radians. +## +## @strong{Inputs} +## @table @var +## @item axis +## Vector @code{[x, y, z]} describing the axis of rotation. +## @item angle +## Rotation angle in radians. The positive direction is +## determined by the right-hand rule applied to @var{axis}. +## @end table +## +## @strong{Outputs} +## @table @var +## @item q +## Unit quaternion describing the rotation. +## @end table +## +## @strong{Example} +## @example +## @group +## octave:1> axis = [0, 0, 1]; +## octave:2> angle = pi/4; +## octave:3> q = rot2q (axis, angle) +## q = 0.9239 + 0i + 0j + 0.3827k +## octave:4> v = quaternion (1, 1, 0) +## v = 0 + 1i + 1j + 0k +## octave:5> vr = q * v * conj (q) +## vr = 0 + 0i + 1.414j + 0k +## octave:6> +## @end group +## @end example +## +## @end deftypefn + +## Adapted from: quaternion by A. S. Hodel +## Author: Lukas Reichlin +## Created: May 2010 +## Version: 0.1 + +function q = rot2q (vv, theta) + + if (nargin != 2 || nargout != 1) + print_usage (); + endif + + if (! isvector (vv) || length (vv) != 3) + error ("vv must be a length three vector"); + endif + + if (! isscalar (theta)) + error ("theta must be a scalar"); + endif + + if (norm (vv) == 0) + error ("quaternion: vv is zero"); + endif + + if (abs (norm (vv) - 1) > 1e-12) + warning ("quaternion: ||vv|| != 1, normalizing") + vv = vv / norm (vv); + endif + + if (abs (theta) > 2*pi) + warning ("quaternion: |theta| > 2 pi, normalizing") + theta = rem (theta, 2*pi); + endif + + vv = vv * sin (theta / 2); + d = cos (theta / 2); + q = quaternion (d, vv(1), vv(2), vv(3)); + +endfunction \ No newline at end of file diff --git a/octave_packages/quaternion-2.0.0/test_quaternion.m b/octave_packages/quaternion-2.0.0/test_quaternion.m new file mode 100644 index 0000000..b798aa0 --- /dev/null +++ b/octave_packages/quaternion-2.0.0/test_quaternion.m @@ -0,0 +1,4 @@ +test @quaternion/blkdiag +test @quaternion/diag +test @quaternion/diff +test @quaternion/log \ No newline at end of file diff --git a/octave_packages/secs1d-0.0.8/DDG/DDGelectron_driftdiffusion.m b/octave_packages/secs1d-0.0.8/DDG/DDGelectron_driftdiffusion.m new file mode 100644 index 0000000..62da823 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/DDG/DDGelectron_driftdiffusion.m @@ -0,0 +1,82 @@ +function n=DDGelectron_driftdiffusion(psi,x,ng,p,ni,tn,tp,un) + +% n=DDGelectron_driftdiffusion(psi,x,ng,p) +% Solves the continuity equation for electrons +% input: psi electric potential +% x integration domain +% ng initial guess and BCs for electron density +% p hole density (for SRH recombination) +% output: n updated electron density + +## This file is part of +## +## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator +## ------------------------------------------------------------------- +## Copyright (C) 2004-2007 Carlo de Falco +## +## +## +## SECS1D is free software; you can 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. +## +## SECS1D is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with SECS1D; If not, see . + + +nodes = x; +Nnodes =length(nodes); + +elements = [[1:Nnodes-1]' [2:Nnodes]']; +Nelements=size(elements,1); + +Bcnodes = [1;Nnodes]; + +nl = ng(1); +nr = ng(Nnodes); + +h=nodes(elements(:,2))-nodes(elements(:,1)); + +c=1./h; +Bneg=Ubernoulli(-(psi(2:Nnodes)-psi(1:Nnodes-1)),1); +Bpos=Ubernoulli( (psi(2:Nnodes)-psi(1:Nnodes-1)),1); + + +d0 = [c(1).*Bneg(1); c(1:end-1).*Bpos(1:end-1)+c(2:end).*Bneg(2:end); c(end)*Bpos(end)]; +d1 = [1000;-c.* Bpos]; +dm1 = [-c.* Bneg;1000]; + +A = spdiags([dm1 d0 d1],-1:1,Nnodes,Nnodes); +b = zeros(Nnodes,1);%- A * ng; + +% SRH Recombination term +SRHD = tp * (ng + ni) + tn * (p + ni); +SRHL = p ./ SRHD; +SRHR = ni.^2 ./ SRHD; + +ASRH = Ucompmass (nodes,Nnodes,elements,Nelements,SRHL,ones(Nelements,1)); +bSRH = Ucompconst (nodes,Nnodes,elements,Nelements,SRHR,ones(Nelements,1)); + +A = A + ASRH; +b = b + bSRH; + +% Boundary conditions +b(Bcnodes) = []; +b(1) = - A(2,1) * nl; +b(end) = - A(end-1,end) * nr; +A(Bcnodes,:) = []; +A(:,Bcnodes) = []; + +n = [nl; A\b ;nr]; + + +% Last Revision: +% $Author: adb014 $ +% $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ + diff --git a/octave_packages/secs1d-0.0.8/DDG/DDGgummelmap.m b/octave_packages/secs1d-0.0.8/DDG/DDGgummelmap.m new file mode 100644 index 0000000..eaf6f34 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/DDG/DDGgummelmap.m @@ -0,0 +1,147 @@ +function [odata,it,res] =... + DDGgummelmap (x,idata,toll,maxit,ptoll,pmaxit,verbose) + + +% +% [odata,it,res] =... +% DDGgummelmap (x,idata,toll,maxit,ptoll,pmaxit,verbose) +% +% Solves the scaled stationary bipolar DD equation system +% using Gummel algorithm +% +% input: x spatial grid +% idata.D doping profile +% idata.p initial guess for hole concentration +% idata.n initial guess for electron concentration +% idata.V initial guess for electrostatic potential +% idata.Fn initial guess for electron Fermi potential +% idata.Fp initial guess for hole Fermi potential +% idata.l2 scaled electric permittivity (diffusion coefficient in Poisson equation) +% idata.un scaled electron mobility +% idata.up scaled electron mobility +% idata.nis scaled intrinsic carrier density +% idata.tn scaled electron lifetime +% idata.tp scaled hole lifetime +% toll tolerance for Gummel iterarion convergence test +% maxit maximum number of Gummel iterarions +% ptoll tolerance for Newton iterarion convergence test for non linear Poisson +% pmaxit maximum number of Newton iterarions +% verbose verbosity level: 0,1,2 +% +% output: odata.n electron concentration +% odata.p hole concentration +% odata.V electrostatic potential +% odata.Fn electron Fermi potential +% odata.Fp hole Fermi potential +% it number of Gummel iterations performed +% res total potential increment at each step + +## This file is part of +## +## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator +## ------------------------------------------------------------------- +## Copyright (C) 2004-2007 Carlo de Falco +## +## +## +## SECS1D is free software; you can 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. +## +## SECS1D is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with SECS1D; If not, see . + + +odata = idata; + +Nnodes=rows(x); + +D = idata.D; +vout(:,1) = idata.V; +hole_density (:,1) = idata.p; +electron_density (:,1)= idata.n; +fermin (:,1)=idata.Fn; +fermip (:,1)=idata.Fp; + +for i=1:1:maxit + if (verbose>1) + fprintf(1,'*****************************************************************\n'); + fprintf(1,'**** start of gummel iteration number: %d\n',i); + fprintf(1,'*****************************************************************\n'); + end + + if (verbose>1) + fprintf(1,'solving non linear poisson equation\n\n'); + end + [vout(:,2),electron_density(:,2),hole_density(:,2)] =... + DDGnlpoisson (x,[1:Nnodes],vout (:,1),electron_density(:,1),hole_density(:,1),... + fermin(:,1),fermip(:,1),D,idata.l2,ptoll,pmaxit,verbose); + + if (verbose>1) + fprintf (1,'\n\nupdating electron qfl\n\n'); + end + electron_density(:,3)=... + DDGelectron_driftdiffusion(vout(:,2), x, electron_density(:,2),hole_density(:,2),idata.nis,idata.tn,idata.tp,idata.un); + + fermin(:,2) = DDGn2phin(vout(:,2),electron_density(:,3)); + fermin(1,2) = idata.Fn(1); + fermin(end:2) = idata.Fn(end); + + if (verbose>1) + fprintf(1,'updating hole qfl\n\n'); + end + + hole_density(:,3)=... + DDGhole_driftdiffusion(vout(:,2), x, hole_density(:,2),electron_density(:,2),idata.nis,idata.tn,idata.tp,idata.up); + fermip(:,2) = DDGp2phip(vout(:,2),hole_density(:,3)); + fermip(1,2) = idata.Fp(1); + fermip(end,2) = idata.Fp(end); + + if (verbose>1) + fprintf(1,'checking for convergence\n\n'); + end + nrfn= norm(fermin(:,2)-fermin(:,1),inf); + nrfp= norm (fermip(:,2)-fermip(:,1),inf); + nrv = norm (vout(:,2)-vout(:,1),inf); + nrm(i) = max([nrfn;nrfp;nrv]); + + if (verbose>1) + fprintf (1,' max(|phin_(k+1)-phinn_(k)| , |phip_(k+1)-phip_(k)| , |v_(k+1)- v_(k)| )= %d\n',nrm(i)); + end + if (nrm(i)0) + fprintf(1,'\n\nInitial guess computed by DD: # of Gummel iterations = %d\n\n',it); +end + +odata.n = electron_density(:,end); +odata.p = hole_density(:,end); +odata.V = vout(:,end); +odata.Fn = fermin(:,end); +odata.Fp = fermip(:,end); + + + diff --git a/octave_packages/secs1d-0.0.8/DDG/DDGhole_driftdiffusion.m b/octave_packages/secs1d-0.0.8/DDG/DDGhole_driftdiffusion.m new file mode 100644 index 0000000..7e4dd71 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/DDG/DDGhole_driftdiffusion.m @@ -0,0 +1,83 @@ +function p=DDGhole_driftdiffusion(psi,x,pg,n,ni,tn,tp,up) + +% p=DDGhole_driftdiffusion(psi,x,pg,n) +% Solves the continuity equation for holes +% input: psi electric potential +% x spatial grid +% pg initial guess and BCs for hole density +% n electron density (to compute SRH recombination) +% output: p updated hole density + + +## This file is part of +## +## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator +## ------------------------------------------------------------------- +## Copyright (C) 2004-2007 Carlo de Falco +## +## +## +## SECS1D is free software; you can 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. +## +## SECS1D is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with SECS1D; If not, see . + + +nodes = x; +Nnodes =length(nodes); + +elements = [[1:Nnodes-1]' [2:Nnodes]']; +Nelements=size(elements,1); + +Bcnodes = [1;Nnodes]; + +pl = pg(1); +pr = pg(Nnodes); + +h=nodes(elements(:,2))-nodes(elements(:,1)); + +c=up./h; +Bneg=Ubernoulli(-(psi(2:Nnodes)-psi(1:Nnodes-1)),1); +Bpos=Ubernoulli( (psi(2:Nnodes)-psi(1:Nnodes-1)),1); + + +d0 = [c(1).*Bpos(1); c(1:end-1).*Bneg(1:end-1)+c(2:end).*Bpos(2:end); c(end)*Bneg(end)]; +d1 = [1000;-c.* Bneg]; +dm1 = [-c.* Bpos;1000]; + +A = spdiags([dm1 d0 d1],-1:1,Nnodes,Nnodes); +b = zeros(Nnodes,1);% - A * pg; + +% SRH Recombination term +SRHD = tp * (n + ni) + tn * (pg + ni); +SRHL = n ./ SRHD; +SRHR = ni.^2 ./ SRHD; + +ASRH = Ucompmass (nodes,Nnodes,elements,Nelements,SRHL,ones(Nelements,1)); +bSRH = Ucompconst (nodes,Nnodes,elements,Nelements,SRHR,ones(Nelements,1)); + +A = A + ASRH; +b = b + bSRH; + +% Boundary conditions +b(Bcnodes) = []; +b(1) = - A(2,1) * pl; +b(end) = - A(end-1,end) * pr; +A(Bcnodes,:) = []; +A(:,Bcnodes) = []; + +p = [pl; A\b ;pr]; + +% Last Revision: +% $Author: adb014 $ +% $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ + + diff --git a/octave_packages/secs1d-0.0.8/DDG/DDGn2phin.m b/octave_packages/secs1d-0.0.8/DDG/DDGn2phin.m new file mode 100644 index 0000000..40d3444 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/DDG/DDGn2phin.m @@ -0,0 +1,38 @@ +function phin = DDGn2phin (V,n); + +% phin = DDGn2phin (V,n); +% computes the qfl for electrons using Maxwell-Boltzmann +% statistics. + +## This file is part of +## +## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator +## ------------------------------------------------------------------- +## Copyright (C) 2004-2007 Carlo de Falco +## +## +## +## SECS1D is free software; you can 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. +## +## SECS1D is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with SECS1D; If not, see . + + +% load constants +nmin = 0; + +n = n .* (n>nmin) + nmin * (n<=nmin); +phin = V - log(n) ; + + +% Last Revision: +% $Author: adb014 $ +% $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ diff --git a/octave_packages/secs1d-0.0.8/DDG/DDGnlpoisson.m b/octave_packages/secs1d-0.0.8/DDG/DDGnlpoisson.m new file mode 100644 index 0000000..9a3ae57 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/DDG/DDGnlpoisson.m @@ -0,0 +1,255 @@ +function [V,n,p,res,niter] = DDGnlpoisson (x,sinodes,Vin,nin,... + pin,Fnin,Fpin,D,l2,toll,maxit,verbose) + +% [V,n,p,res,niter] = DDGnlpoisson (x,sinodes,Vin,nin,... +% pin,Fnin,Fpin,D,l2,toll,maxit,verbose) +% Solves the non linear Poisson equation +% $$ - lamda^2 *V'' + (n(V,Fn) - p(V,Fp) -D)=0 $$ +% input: x spatial grid +% sinodes index of the nodes of the grid which are in the +% semiconductor subdomain +% (remaining nodes are assumed to be in the oxide subdomain) +% Vin initial guess for the electrostatic potential +% nin initial guess for electron concentration +% pin initial guess for hole concentration +% Fnin initial guess for electron Fermi potential +% Fpin initial guess for hole Fermi potential +% D doping profile +% l2 scaled electric permittivity (diffusion coefficient) +% toll tolerance for convergence test +% maxit maximum number of Newton iterations +% verbose verbosity level: 0,1,2 +% output: V electrostatic potential +% n electron concentration +% p hole concentration +% res residual norm at each step +% niter number of Newton iterations + +## This file is part of +## +## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator +## ------------------------------------------------------------------- +## Copyright (C) 2004-2007 Carlo de Falco +## +## +## +## SECS1D is free software; you can 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. +## +## SECS1D is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with SECS1D; If not, see . + + +%% Set some useful constants +dampit = 10; +dampcoeff = 2; + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% convert grid info to FEM form +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +Ndiricheletnodes = 2; +nodes = x; +sielements = sinodes(1:end-1); + +Nnodes = length(nodes); + + +totdofs = Nnodes - Ndiricheletnodes ; + +elements = [[1:Nnodes-1]' , [2:Nnodes]']; +Nelements = size(elements,1); + +BCnodes = [1;Nnodes]; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% initialization: +%% we're going to solve +%% $$ - lamda^2*(\delta V)'' + (\frac{\partial n}{\partial V} - +%% \frac{\partial p}{\partial V})= -R $$ +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% set $$ n_1 = nin $$ and $$ V = Vin $$ +V = Vin; +Fn = Fnin; +Fp = Fpin; +n = DDGphin2n(V(sinodes),Fn); +p = DDGphip2p(V(sinodes),Fp); +if (sinodes(1)==1) + n(1)=nin(1); + p(1)=pin(1); +end +if (sinodes(end)==Nnodes) + n(end)=nin(end); + p(end)=pin(end); +end + +%%% +%%% Compute LHS matrices +%%% + +%% let's compute FEM approximation of $$ L = - \frac{d^2}{x^2} $$ +L = Ucomplap (nodes,Nnodes,elements,Nelements,l2.*ones(Nelements,1)); + +%% compute $$ Mv = ( n + p) $$ +%% and the (lumped) mass matrix M +Mv = zeros(Nnodes,1); +Mv(sinodes) = (n + p); +Cv = zeros(Nelements,1); +Cv(sielements)= 1; +M = Ucompmass (nodes,Nnodes,elements,Nelements,Mv,Cv); + +%%% +%%% Compute RHS vector (-residual) +%%% + +%% now compute $$ T0 = (n - p - D) $$ +Tv0 = zeros(Nnodes,1); +Tv0(sinodes) = (n - p - D); +Cv = zeros(Nelements,1); +Cv(sielements)= 1; +T0 = Ucompconst (nodes,Nnodes,elements,Nelements,Tv0,Cv); + +%% now we're ready to build LHS matrix and RHS of the linear system for 1st Newton step +A = L + M; +R = L * V + T0; + +%% Apply boundary conditions +A(BCnodes,:) = []; +A(:,BCnodes) = []; + +R(BCnodes) = []; + +%% we need $$ \norm{R_1} $$ and $$ \norm{R_k} $$ for the convergence test +normr(1) = norm(R,inf); +relresnorm = 1; +reldVnorm = 1; +normrnew = normr(1); + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% START OF THE NEWTON CYCLE +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +for newtit=1:maxit + if verbose + fprintf(1,'\n newton iteration: %d, reldVnorm = %e',newtit,reldVnorm); + + end + + dV =[0;(A)\(-R);0]; + + + + %%%%%%%%%%%%%%%%%% + %% Start of the damping procedure + %%%%%%%%%%%%%%%%%% + tk = 1; + for dit = 1:dampit + if verbose + fprintf(1,'\n damping iteration: %d, residual norm = %e',dit,normrnew); + end + Vnew = V + tk * dV; + + n = DDGphin2n(Vnew(sinodes),Fn); + p = DDGphip2p(Vnew(sinodes),Fp); + if (sinodes(1)==1) + n(1)=nin(1); + p(1)=pin(1); + end + if (sinodes(end)==Nnodes) + n(end)=nin(end); + p(end)=pin(end); + end + %%% + %%% Compute LHS matrices + %%% + + %% let's compute FEM approximation of $$ L = - \frac{d^2}{x^2} $$ + %L = Ucomplap (nodes,Nnodes,elements,Nelements,ones(Nelements,1)); + + %% compute $$ Mv = ( n + p) $$ + %% and the (lumped) mass matrix M + Mv = zeros(Nnodes,1); + Mv(sinodes) = (n + p); + Cv = zeros(Nelements,1); + Cv(sielements)= 1; + M = Ucompmass (nodes,Nnodes,elements,Nelements,Mv,Cv); + + %%% + %%% Compute RHS vector (-residual) + %%% + + %% now compute $$ T0 = (n - p - D) $$ + Tv0 = zeros(Nnodes,1); + Tv0(sinodes) = (n - p - D); + Cv = zeros(Nelements,1); + Cv(sielements)= 1; + T0 = Ucompconst (nodes,Nnodes,elements,Nelements,Tv0,Cv); + + %% now we're ready to build LHS matrix and RHS of the linear system for 1st Newton step + Anew = L + M; + Rnew = L * Vnew + T0; + + %% Apply boundary conditions + Anew(BCnodes,:) = []; + Anew(:,BCnodes) = []; + + Rnew(BCnodes) = []; + + if ((dit>1)&(norm(Rnew,inf)>=norm(R,inf))) + if verbose + fprintf(1,'\nexiting damping cycle \n'); + end + break + else + A = Anew; + R = Rnew; + end + + %% compute $$ | R_{k+1} | $$ for the convergence test + normrnew= norm(R,inf); + + % check if more damping is needed + if (normrnew > normr(newtit)) + tk = tk/dampcoeff; + else + if verbose + fprintf(1,'\nexiting damping cycle because residual norm = %e \n',normrnew); + end + break + end + end + + V = Vnew; + normr(newtit+1) = normrnew; + dVnorm = norm(tk*dV,inf); + % check if convergence has been reached + reldVnorm = dVnorm / norm(V,inf); + if (reldVnorm <= toll) + if(verbose) + fprintf(1,'\nexiting newton cycle because reldVnorm= %e \n',reldVnorm); + end + break + end +end + +res = normr; +niter = newtit; + +% Last Revision: +% $Author: adb014 $ +% $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ + + diff --git a/octave_packages/secs1d-0.0.8/DDG/DDGp2phip.m b/octave_packages/secs1d-0.0.8/DDG/DDGp2phip.m new file mode 100644 index 0000000..06f34c1 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/DDG/DDGp2phip.m @@ -0,0 +1,38 @@ +function phip = DDGp2phip (V,p); + +% phip = DDGp2phip (V,p); +% computes the qfl for holes using Maxwell-Boltzmann statistics + +% This file is part of +% +% MNME1D - A 1-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004 Carlo de Falco +% +% +% +% MNME1D is free software; you can 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. +% +% MNME1D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with MNME1D; If not, see . + + +% load constants + + pmin = 0; + + p = p .* (p>pmin) + pmin * (p<=pmin); + phip = V + log(p) ; + + + % Last Revision: + % $Author: adb014 $ + % $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ diff --git a/octave_packages/secs1d-0.0.8/DDG/DDGphin2n.m b/octave_packages/secs1d-0.0.8/DDG/DDGphin2n.m new file mode 100644 index 0000000..eabc7e8 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/DDG/DDGphin2n.m @@ -0,0 +1,36 @@ +function n = DDGphin2n (V,phin); + +% n = DDGphin2n (V,phin); +% computes the electron density using Maxwell-Boltzmann +% statistics. + + +## This file is part of +## +## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator +## ------------------------------------------------------------------- +## Copyright (C) 2004-2007 Carlo de Falco +## +## +## +## SECS1D is free software; you can 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. +## +## SECS1D is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with SECS1D; If not, see . + + + nmin = 0; + n = exp ((V-phin)); + n = n .* (n>nmin) + nmin * (n<=nmin); + + % Last Revision: + % $Author: adb014 $ + % $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ diff --git a/octave_packages/secs1d-0.0.8/DDG/DDGphip2p.m b/octave_packages/secs1d-0.0.8/DDG/DDGphip2p.m new file mode 100644 index 0000000..730a65b --- /dev/null +++ b/octave_packages/secs1d-0.0.8/DDG/DDGphip2p.m @@ -0,0 +1,39 @@ +function p = DDGphip2p (V,phip); + +% p = DDGphip2p (V,phip); +% computes the hole density using Maxwell-Boltzmann +% statistics. + +## This file is part of +## +## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator +## ------------------------------------------------------------------- +## Copyright (C) 2004-2007 Carlo de Falco +## +## +## +## SECS1D is free software; you can 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. +## +## SECS1D is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with SECS1D; If not, see . + + +% load constants + + +pmin = 0; + +p = exp ((phip-V)); +p = p .* (p>pmin) + pmin * (p<=pmin); + +% Last Revision: +% $Author: adb014 $ +% $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ diff --git a/octave_packages/secs1d-0.0.8/DDG/DDGplotresults.m b/octave_packages/secs1d-0.0.8/DDG/DDGplotresults.m new file mode 100644 index 0000000..8b84885 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/DDG/DDGplotresults.m @@ -0,0 +1,53 @@ +function DDGplotresults(x,n,p,V,Fn,Fp); + +% DDGplotresults(x,n,p,V,Fn,Fp); + +## This file is part of +## +## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator +## ------------------------------------------------------------------- +## Copyright (C) 2004-2007 Carlo de Falco +## +## +## +## SECS1D is free software; you can 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. +## +## SECS1D is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with SECS1D; If not, see . + +subplot(2,3,1) +title('Electron Density') +semilogy(x,n) + + +subplot(2,3,2) +title('Hole Density') +semilogy(x,p) + + +subplot(2,3,4) +title('Electron QFL') +plot(x,Fn) + + +subplot(2,3,5) +title('Hole QFL') +plot(x,Fp) + + +subplot(2,3,6) +title('Electric Potential') +plot(x,V) +pause(.1) + +% Last Revision: +% $Author: adb014 $ +% $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ diff --git a/octave_packages/secs1d-0.0.8/DDG/doc-cache b/octave_packages/secs1d-0.0.8/DDG/doc-cache new file mode 100644 index 0000000..0b82265 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/DDG/doc-cache @@ -0,0 +1,295 @@ +# Created by Octave 3.6.1, Thu Mar 22 16:18:37 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 9 +# name: +# type: sq_string +# elements: 1 +# length: 26 +DDGelectron_driftdiffusion + + +# name: +# type: sq_string +# elements: 1 +# length: 327 + n=DDGelectron_driftdiffusion(psi,x,ng,p) + Solves the continuity equation for electrons + input: psi electric potential + x integration domain + ng initial guess and BCs for electron density + p hole density (for SRH recombination) + output: n updated electron density + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + n=DDGelectron_driftdiffusion(psi,x,ng,p) + Solves the continuity equation fo + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +DDGgummelmap + + +# name: +# type: sq_string +# elements: 1 +# length: 1601 + + [odata,it,res] =... + DDGgummelmap (x,idata,toll,maxit,ptoll,pmaxit,verbose) + + Solves the scaled stationary bipolar DD equation system + using Gummel algorithm + + input: x spatial grid + idata.D doping profile + idata.p initial guess for hole concentration + idata.n initial guess for electron concentration + idata.V initial guess for electrostatic potential + idata.Fn initial guess for electron Fermi potential + idata.Fp initial guess for hole Fermi potential + idata.l2 scaled electric permittivity (diffusion coefficient in Poisson equation) + idata.un scaled electron mobility + idata.up scaled electron mobility + idata.nis scaled intrinsic carrier density + idata.tn scaled electron lifetime + idata.tp scaled hole lifetime + toll tolerance for Gummel iterarion convergence test + maxit maximum number of Gummel iterarions + ptoll tolerance for Newton iterarion convergence test for non linear Poisson + pmaxit maximum number of Newton iterarions + verbose verbosity level: 0,1,2 + + output: odata.n electron concentration + odata.p hole concentration + odata.V electrostatic potential + odata.Fn electron Fermi potential + odata.Fp hole Fermi potential + it number of Gummel iterations performed + res total potential increment at each step + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 + + [odata,it,res] =. + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +DDGhole_driftdiffusion + + +# name: +# type: sq_string +# elements: 1 +# length: 329 + p=DDGhole_driftdiffusion(psi,x,pg,n) + Solves the continuity equation for holes + input: psi electric potential + x spatial grid + pg initial guess and BCs for hole density + n electron density (to compute SRH recombination) + output: p updated hole density + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + p=DDGhole_driftdiffusion(psi,x,pg,n) + Solves the continuity equation for ho + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +DDGn2phin + + +# name: +# type: sq_string +# elements: 1 +# length: 110 + phin = DDGn2phin (V,n); + computes the qfl for electrons using Maxwell-Boltzmann + statistics. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + phin = DDGn2phin (V,n); + computes the qfl for electrons using Maxwell-B + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +DDGnlpoisson + + +# name: +# type: sq_string +# elements: 1 +# length: 1235 + [V,n,p,res,niter] = DDGnlpoisson (x,sinodes,Vin,nin,... + pin,Fnin,Fpin,D,l2,toll,maxit,verbose) + Solves the non linear Poisson equation + $$ - lamda^2 *V'' + (n(V,Fn) - p(V,Fp) -D)=0 $$ + input: x spatial grid + sinodes index of the nodes of the grid which are in the + semiconductor subdomain + (remaining nodes are assumed to be in the oxide subdomain) + Vin initial guess for the electrostatic potential + nin initial guess for electron concentration + pin initial guess for hole concentration + Fnin initial guess for electron Fermi potential + Fpin initial guess for hole Fermi potential + D doping profile + l2 scaled electric permittivity (diffusion coefficient) + toll tolerance for convergence test + maxit maximum number of Newton iterations + verbose verbosity level: 0,1,2 + output: V electrostatic potential + n electron concentration + p hole concentration + res residual norm at each step + niter number of Newton iterations + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 + [V,n,p,res,niter] = DDGnlpoisson (x,sinodes,Vin,nin,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +DDGp2phip + + +# name: +# type: sq_string +# elements: 1 +# length: 88 + phip = DDGp2phip (V,p); + computes the qfl for holes using Maxwell-Boltzmann statistics + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + phip = DDGp2phip (V,p); + computes the qfl for holes using Maxwell-Boltzmann sta + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +DDGphin2n + + +# name: +# type: sq_string +# elements: 1 +# length: 109 + n = DDGphin2n (V,phin); + computes the electron density using Maxwell-Boltzmann + statistics. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + n = DDGphin2n (V,phin); + computes the electron density using Maxwell-Bo + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +DDGphip2p + + +# name: +# type: sq_string +# elements: 1 +# length: 105 + p = DDGphip2p (V,phip); + computes the hole density using Maxwell-Boltzmann + statistics. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + p = DDGphip2p (V,phip); + computes the hole density using Maxwell-Boltzm + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +DDGplotresults + + +# name: +# type: sq_string +# elements: 1 +# length: 32 + DDGplotresults(x,n,p,V,Fn,Fp); + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 + DDGplotresults(x,n,p,V,Fn,Fp); + + + + + + diff --git a/octave_packages/secs1d-0.0.8/DDN/DDNnewtonmap.m b/octave_packages/secs1d-0.0.8/DDN/DDNnewtonmap.m new file mode 100644 index 0000000..7f19913 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/DDN/DDNnewtonmap.m @@ -0,0 +1,272 @@ +function [odata,it,res] = DDNnewtonmap (x,idata,toll,maxit,verbose) + +% +% [odata,it,res] = DDNnewtonmap (x,idata,toll,maxit,verbose) +% +% Solves the scaled stationary bipolar DD equation system +% using a coupled Newton algorithm +% +% input: x spatial grid +% idata.D doping profile +% idata.p initial guess for hole concentration +% idata.n initial guess for electron concentration +% idata.V initial guess for electrostatic potential +% idata.Fn initial guess for electron Fermi potential +% idata.Fp initial guess for hole Fermi potential +% idata.l2 scaled electric permittivity (diffusion coefficient in Poisson equation) +% idata.un scaled electron mobility +% idata.up scaled electron mobility +% idata.nis scaled intrinsic carrier density +% idata.tn scaled electron lifetime +% idata.tp scaled hole lifetime +% toll tolerance for Newton iterarion convergence test +% maxit maximum number of Newton iterarions +% verbose verbosity level: 0,1,2 +% +% output: odata.n electron concentration +% odata.p hole concentration +% odata.V electrostatic potential +% odata.Fn electron Fermi potential +% odata.Fp hole Fermi potential +% it number of Newton iterations performed +% res residual at each step + +## This file is part of +## +## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator +## ------------------------------------------------------------------- +## Copyright (C) 2004-2007 Carlo de Falco +## +## +## +## SECS1D is free software; you can 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. +## +## SECS1D is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with SECS1D; If not, see . + +odata = idata; + +Nnodes=rows(x); + +Nelements=Nnodes-1; +elements=[1:Nnodes-1;2:Nnodes]'; +BCnodesp = [1,Nnodes]; +BCnodes = [BCnodesp,BCnodesp+Nnodes,BCnodesp+2*Nnodes]; +totaldofs= Nnodes-2; +dampcoef = 2; +maxdamp = 2; + +V = idata.V; +n = idata.n; +p = idata.p; +D = idata.D; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% create the complete unknown vector +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +u = [V; n; p]; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% build fem matrices +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +L = Ucomplap (x,Nnodes,elements,Nelements,idata.l2*ones(Nelements,1)); +M = Ucompmass (x,Nnodes,elements,Nelements,ones(Nnodes,1),ones(Nelements,1)); +DDn = Uscharfettergummel(x,Nnodes,elements,Nelements,idata.un,1,V); +DDp = Uscharfettergummel(x,Nnodes,elements,Nelements,idata.up,1,-V); + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Initialise RHS +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +r1 = L * V + M * (n - p - D); +r2 = DDn * n; +r3 = DDp * p; + +RHS =- [... +r1; +r2; +r3 +]; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Apply BCs +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +RHS(BCnodes,:)= []; + +nrm = norm(RHS,inf); +res(1) = nrm; + +%%%%%%%%%%%%%%%%%%%%%%% +%% Begin Newton Cycle +%%%%%%%%%%%%%%%%%%%%%%% +for count = 1: maxit + if verbose + fprintf (1,'\n\n\nNewton Iteration Number:%d\n',count); + end + Ln = Ucomplap (x,Nnodes,elements,Nelements,Umediaarmonica(idata.un*n)); + Lp = Ucomplap (x,Nnodes,elements,Nelements,Umediaarmonica(idata.up*p)); + Z = sparse(zeros(Nnodes)); + DDn = Uscharfettergummel(x,Nnodes,elements,Nelements,idata.un,1,V); + DDp = Uscharfettergummel(x,Nnodes,elements,Nelements,idata.up,1,-V); + + A = L; + B = M; + C = -M; + DDD = -Ln; + E = DDn; + F = Z; + G = Lp; + H = Z; + I = DDp; + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %% Build LHS + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + LHS =sparse([ + [A B C]; + [DDD E F]; + [G H I]; + ]); + + %Apply BCs + LHS(BCnodes,:)=[]; + LHS(:,BCnodes)=[]; + + %%%%%%%%%%%%%%%%%%%%%%% + % Solve the linearised system + %%%%%%%%%%%%%%%%%%%%%%% + dutmp = (LHS) \ (RHS); + dv = dutmp(1:totaldofs); + dn = dutmp(totaldofs+1:2*totaldofs); + dp = dutmp(2*totaldofs+1:3*totaldofs); + du = [0;dv;0;0;dn;0;0;dp;0]; + + %%%%%%%%%%%%%%%%%%%%%%% + %% Check Convergence + %%%%%%%%%%%%%%%%%%%%%%% + + nrm_u = norm(u,inf); + + nrm_du = norm(du,inf); + + ratio = nrm_du/nrm_u; + if verbose + fprintf (1,'ratio = %e\n', ratio); + end + + if (ratio <= toll) + V = u(1:Nnodes); + n = u(Nnodes+1:2*Nnodes); + p = u(2*Nnodes+1:end); + res(count) = nrm; + break; + end + + + %%%%%%%%%%%%%%%%%%%%%% + %% begin damping cycle + %%%%%%%%%%%%%%%%%%%%%% + tj = 1; + + + for cc = 1:maxdamp + if verbose + fprintf (1,'\ndamping iteration number:%d\n',cc); + fprintf (1,'reference residual norm:%e\n',nrm); + end + %%%%%%%%%%%%%%%%%%%%%%%%% + % Update the unknown vector + %%%%%%%%%%%%%%%%%%%%%%%%% + utmp = u + tj*du; + Vnew = utmp(1:Nnodes); + nnew = utmp(Nnodes+1:2*Nnodes); + pnew = utmp(2*Nnodes+1:end); + + %%%%%%%%%%%%%%%%% + %% try a new RHS + %%%%%%%%%%%%%%%% + DDn = Uscharfettergummel(x,Nnodes,elements,Nelements,idata.un,1,Vnew); + DDp = Uscharfettergummel(x,Nnodes,elements,Nelements,idata.up,1,-Vnew); + + r1 = L * V + M * (nnew - pnew - D); + r2 = DDn * nnew; + r3 = DDp * pnew; + + RHS =- [... + r1; + r2; + r3 + ]; + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + % Apply BCs + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + RHS(BCnodes,:)= []; + + nrmtmp=norm(RHS,inf); + + %%%%%%%%%%%%%%%%%%%%%%%%% + %% Update the damping coefficient + %%%%%%%%%%%%%%%%%%%%%%%% + if verbose + fprintf(1,'residual norm:%e\n\n', nrmtmp); + end + + if (nrmtmp>nrm) + tj = tj/(dampcoef*cc); + if verbose + fprintf (1,'\ndamping coefficients = %e',tj); + end + else + break; + end + end + + nrm_du = norm(tj*du,inf); + + u = utmp; + + if (count>1) + ratio = nrm_du/nrm_du_old; + if (ratio<.005) + V = u(1:Nnodes); + n = u(Nnodes+1:2*Nnodes); + p = u(2*Nnodes+1:end); + res(count) = nrm; + break; + end + end + + nrm = nrmtmp; + + res(count) = nrm; + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %% convert result vector into distinct output vectors + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + V = u(1:Nnodes); + n = u(Nnodes+1:2*Nnodes); + p = u(2*Nnodes+1:end); + + nrm_du_old = nrm_du; +end + +odata.V = V; +odata.n = n; +odata.p = p; +Fn = V - log(n); +Fp = V + log(p); + +it = count; + + + + diff --git a/octave_packages/secs1d-0.0.8/DDN/doc-cache b/octave_packages/secs1d-0.0.8/DDN/doc-cache new file mode 100644 index 0000000..6d412d5 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/DDN/doc-cache @@ -0,0 +1,61 @@ +# Created by Octave 3.6.1, Thu Mar 22 16:18:37 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 1 +# name: +# type: sq_string +# elements: 1 +# length: 12 +DDNnewtonmap + + +# name: +# type: sq_string +# elements: 1 +# length: 1490 + + [odata,it,res] = DDNnewtonmap (x,idata,toll,maxit,verbose) + + Solves the scaled stationary bipolar DD equation system + using a coupled Newton algorithm + + input: x spatial grid + idata.D doping profile + idata.p initial guess for hole concentration + idata.n initial guess for electron concentration + idata.V initial guess for electrostatic potential + idata.Fn initial guess for electron Fermi potential + idata.Fp initial guess for hole Fermi potential + idata.l2 scaled electric permittivity (diffusion coefficient in Poisson equation) + idata.un scaled electron mobility + idata.up scaled electron mobility + idata.nis scaled intrinsic carrier density + idata.tn scaled electron lifetime + idata.tp scaled hole lifetime + toll tolerance for Newton iterarion convergence test + maxit maximum number of Newton iterarions + verbose verbosity level: 0,1,2 + + output: odata.n electron concentration + odata.p hole concentration + odata.V electrostatic potential + odata.Fn electron Fermi potential + odata.Fp hole Fermi potential + it number of Newton iterations performed + res residual at each step + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 + + [odata,it,res] = DDNnewtonmap (x,idata,toll,maxit,verbose) + + + + + + diff --git a/octave_packages/secs1d-0.0.8/PKG_ADD b/octave_packages/secs1d-0.0.8/PKG_ADD new file mode 100644 index 0000000..8561724 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/PKG_ADD @@ -0,0 +1,7 @@ + +if (! exist (fullfile (fileparts (mfilename ("fullpath")), "inst"), "dir")) +dirlist= {"Utilities","DDG","DDN"}; +for ii=1:length(dirlist) +addpath ( [ fileparts( mfilename("fullpath")) "/" dirlist{ii}]) +end +end diff --git a/octave_packages/secs1d-0.0.8/PKG_DEL b/octave_packages/secs1d-0.0.8/PKG_DEL new file mode 100644 index 0000000..764aeb6 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/PKG_DEL @@ -0,0 +1,7 @@ + +if (! exist (fullfile (fileparts (mfilename ("fullpath")), "inst"), "dir")) +dirlist= {"Utilities","DDG","DDN"}; +for ii=1:length(dirlist) +rmpath ( [ fileparts( mfilename("fullpath")) "/" dirlist{ii}]) +end +end diff --git a/octave_packages/secs1d-0.0.8/Utilities/Ubern.m b/octave_packages/secs1d-0.0.8/Utilities/Ubern.m new file mode 100644 index 0000000..3111f08 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/Utilities/Ubern.m @@ -0,0 +1,98 @@ +function [bp,bn]=Ubern(x) + +% [bp,bn]=Ubern(x) +% +% Bernoulli function +% bp = B(x)=x/(exp(x)-1) +% bn = B(-x)=x+B(x) + + + ## This file is part of + ## + ## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator + ## ------------------------------------------------------------------- + ## Copyright (C) 2004-2007 Carlo de Falco + ## + ## + ## + ## SECS1D is free software; you can 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. + ## + ## SECS1D is distributed in the hope that it will be useful, + ## but WITHOUT ANY WARRANTY; without even the implied warranty of + ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ## GNU General Public License for more details. + ## + ## You should have received a copy of the GNU General Public License + ## along with SECS1D; If not, see . + + +xlim=1e-2; +ax=abs(x); + +% +% Calcola la funz. di Bernoulli per x=0 +% + +if (ax == 0) + bp=1.; + bn=1.; + return +end; + +% +% Calcola la funz. di Bernoulli per valori +% asintotici dell'argomento +% + +if (ax > 80), + if (x >0), + bp=0.; + bn=x; + return + else + bp=-x; + bn=0.; + return + end; +end; + +% +% Calcola la funz. di Bernoulli per valori +% intermedi dell'argomento +% + +if (ax > xlim), + bp=x/(exp(x)-1); + bn=x+bp; + return +else + +% +% Calcola la funz. di Bernoulli per valori +% piccoli dell'argomento mediante sviluppo +% di Taylor troncato dell'esponenziale +% + ii=1; + fp=1.; + fn=1.; + df=1.; + segno=1.; + while (abs(df) > eps), + ii=ii+1; + segno=-segno; + df=df*x/ii; + fp=fp+df; + fn=fn+segno*df; + bp=1./fp; + bn=1./fn; + end; + return +end + + +% Last Revision: +% $Author: adb014 $ +% $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ diff --git a/octave_packages/secs1d-0.0.8/Utilities/Ubernoulli.m b/octave_packages/secs1d-0.0.8/Utilities/Ubernoulli.m new file mode 100644 index 0000000..9b08869 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/Utilities/Ubernoulli.m @@ -0,0 +1,49 @@ + +function b=Ubernoulli(x,sg) + +% +% b=Ubernoulli(x,sg) +% +% Bernoulli function +% b = B(x)=x/(exp(x)-1) if sg==1 +% b = B(-x)=x+B(x) if sg==0 +% also works if x is a vector + + ## This file is part of + ## + ## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator + ## ------------------------------------------------------------------- + ## Copyright (C) 2004-2007 Carlo de Falco + ## + ## + ## + ## SECS1D is free software; you can 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. + ## + ## SECS1D is distributed in the hope that it will be useful, + ## but WITHOUT ANY WARRANTY; without even the implied warranty of + ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ## GNU General Public License for more details. + ## + ## You should have received a copy of the GNU General Public License + ## along with SECS1D; If not, see . + + for count=1:length(x) + [bp,bn] = Ubern(x(count)); + bernp(count,1)=bp; + bernn(count,1)=bn; + end + + if (sg ==1) + b=bernp; + elseif (sg ==0) + b=bernn; + end + + + % Last Revision: + % $Author: adb014 $ + % $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ + diff --git a/octave_packages/secs1d-0.0.8/Utilities/Ucompconst.m b/octave_packages/secs1d-0.0.8/Utilities/Ucompconst.m new file mode 100644 index 0000000..7563015 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/Utilities/Ucompconst.m @@ -0,0 +1,33 @@ +function R = Ucompconst (nodes,Nnodes,elements,Nelements,D,C) + +% R = compconst (nodes,Nnodes,elements,Nelements,D,C); + + ## This file is part of + ## + ## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator + ## ------------------------------------------------------------------- + ## Copyright (C) 2004-2007 Carlo de Falco + ## + ## + ## + ## SECS1D is free software; you can 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. + ## + ## SECS1D is distributed in the hope that it will be useful, + ## but WITHOUT ANY WARRANTY; without even the implied warranty of + ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ## GNU General Public License for more details. + ## + ## You should have received a copy of the GNU General Public License + ## along with SECS1D; If not, see . + + h = (nodes(2:end)-nodes(1:end-1)).*C; + R = D.*[h(1)/2; (h(1:end-1)+h(2:end))/2; h(end)/2]; + + + % Last Revision: + % $Author: adb014 $ + % $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ + diff --git a/octave_packages/secs1d-0.0.8/Utilities/Ucomplap.m b/octave_packages/secs1d-0.0.8/Utilities/Ucomplap.m new file mode 100644 index 0000000..50fa286 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/Utilities/Ucomplap.m @@ -0,0 +1,43 @@ +function L = Ucomplap (nodes,Nnodes,elements,Nelements,coeff) + +% L = Ucomplap (nodes,Nnode,elements,Nelements,coeff) +% Computes the P1 finite element approximation of the +% differential operator - d ( coeff d (.)\dx)\dx + + ## This file is part of + ## + ## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator + ## ------------------------------------------------------------------- + ## Copyright (C) 2004-2007 Carlo de Falco + ## + ## + ## + ## SECS1D is free software; you can 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. + ## + ## SECS1D is distributed in the hope that it will be useful, + ## but WITHOUT ANY WARRANTY; without even the implied warranty of + ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ## GNU General Public License for more details. + ## + ## You should have received a copy of the GNU General Public License + ## along with SECS1D; If not, see . + + h = nodes(2:end)-nodes(1:end-1); + + d0 = [ coeff(1)./h(1); + (coeff(1:end-1)./h(1:end-1))+(coeff(2:end)./h(2:end)); + coeff(end)./h(end)]; + + d1 = [1000; -coeff./h]; + dm1 = [ -coeff./h;1000]; + + L = spdiags([dm1, d0, d1],-1:1,Nnodes,Nnodes); + + + % Last Revision: + % $Author: adb014 $ + % $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ + diff --git a/octave_packages/secs1d-0.0.8/Utilities/Ucompmass.m b/octave_packages/secs1d-0.0.8/Utilities/Ucompmass.m new file mode 100644 index 0000000..6374cbf --- /dev/null +++ b/octave_packages/secs1d-0.0.8/Utilities/Ucompmass.m @@ -0,0 +1,34 @@ +function Bmat = Ucompmass (nodes,Nnodes,elements,Nelements,Bvect,Cvect); + +% Bmat = Ucompmass (nodes,Nnodes,elements,Nelements,Bvect,Cvect); + + ## This file is part of + ## + ## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator + ## ------------------------------------------------------------------- + ## Copyright (C) 2004-2007 Carlo de Falco + ## + ## + ## + ## SECS1D is free software; you can 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. + ## + ## SECS1D is distributed in the hope that it will be useful, + ## but WITHOUT ANY WARRANTY; without even the implied warranty of + ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ## GNU General Public License for more details. + ## + ## You should have received a copy of the GNU General Public License + ## along with SECS1D; If not, see . + + h = (nodes(2:end)-nodes(1:end-1)).*Cvect; + d0 = Bvect.*[h(1)/2; (h(1:end-1)+h(2:end))/2; h(end)/2]; + Bmat = spdiags(d0, 0, Nnodes,Nnodes); + + + % Last Revision: + % $Author: adb014 $ + % $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ + diff --git a/octave_packages/secs1d-0.0.8/Utilities/Udriftdiffusion.m b/octave_packages/secs1d-0.0.8/Utilities/Udriftdiffusion.m new file mode 100644 index 0000000..afa6594 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/Utilities/Udriftdiffusion.m @@ -0,0 +1,54 @@ +function A=Udriftdiffusion(x,psi,coeff) + +%A=Udriftdiffusion(x,psi,coeff) +% +% Builds the Scharfetter-Gummel approximation +% of the differential operator - (coeff (n' - n psi'))' +% + + ## This file is part of + ## + ## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator + ## ------------------------------------------------------------------- + ## Copyright (C) 2004-2007 Carlo de Falco + ## + ## + ## + ## SECS1D is free software; you can 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. + ## + ## SECS1D is distributed in the hope that it will be useful, + ## but WITHOUT ANY WARRANTY; without even the implied warranty of + ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ## GNU General Public License for more details. + ## + ## You should have received a copy of the GNU General Public License + ## along with SECS1D; If not, see . + + nodes = x; + Nnodes =length(nodes); + + elements = [[1:Nnodes-1]' [2:Nnodes]']; + Nelements=size(elements,1); + + Bcnodes = [1;Nnodes]; + + h=nodes(elements(:,2))-nodes(elements(:,1)); + + c=coeff./h; + Bneg=Ubernoulli(-(psi(2:Nnodes)-psi(1:Nnodes-1)),1); + Bpos=Ubernoulli( (psi(2:Nnodes)-psi(1:Nnodes-1)),1); + + + d0 = [c(1).*Bneg(1); c(1:end-1).*Bpos(1:end-1)+c(2:end).*Bneg(2:end); c(end)*Bpos(end)]; + d1 = [1000;-c.* Bpos]; + dm1 = [-c.* Bneg;1000]; + + A = spdiags([dm1 d0 d1],-1:1,Nnodes,Nnodes); + + % Last Revision: + % $Author: adb014 $ + % $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ + diff --git a/octave_packages/secs1d-0.0.8/Utilities/Umediaarmonica.m b/octave_packages/secs1d-0.0.8/Utilities/Umediaarmonica.m new file mode 100644 index 0000000..376114f --- /dev/null +++ b/octave_packages/secs1d-0.0.8/Utilities/Umediaarmonica.m @@ -0,0 +1,35 @@ +function m = Umediaarmonica(w); + +% m = mediaarmonica(w,x); +% returns the harmonic mean value of w in each of the intervals x_i , x_i+1 +% + + ## This file is part of + ## + ## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator + ## ------------------------------------------------------------------- + ## Copyright (C) 2004-2007 Carlo de Falco + ## + ## + ## + ## SECS1D is free software; you can 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. + ## + ## SECS1D is distributed in the hope that it will be useful, + ## but WITHOUT ANY WARRANTY; without even the implied warranty of + ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ## GNU General Public License for more details. + ## + ## You should have received a copy of the GNU General Public License + ## along with SECS1D; If not, see . + + dw = (1./w(1:end-1))+(1./w(2:end)); + m = 2 ./ dw; + + + % Last Revision: + % $Author: adb014 $ + % $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ + diff --git a/octave_packages/secs1d-0.0.8/Utilities/Uscharfettergummel.m b/octave_packages/secs1d-0.0.8/Utilities/Uscharfettergummel.m new file mode 100644 index 0000000..c6f3c3e --- /dev/null +++ b/octave_packages/secs1d-0.0.8/Utilities/Uscharfettergummel.m @@ -0,0 +1,54 @@ +function A=Uscharfettergummel(nodes,Nnodes,elements,Nelements,acoeff,bcoeff,v) + +%A=Uscharfettergummel(nodes,Nnodes,elements,Nelements,acoeff,bcoeff,v) +% +% Builds the Scharfetter-Gummel matrix for the +% the discretization of the LHS +% of the Drift-Diffusion equation: +% +% $ -(a(x) (u' - b v'(x) u))'= f $ +% +% where a(x) is piecewise constant +% and v(x) is piecewise linear, so that +% v'(x) is still piecewise constant +% b is a constant independent of x +% and u is the unknown +% + + ## This file is part of + ## + ## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator + ## ------------------------------------------------------------------- + ## Copyright (C) 2004-2007 Carlo de Falco + ## + ## + ## + ## SECS2D is free software; you can 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. + ## + ## SECS2D is distributed in the hope that it will be useful, + ## but WITHOUT ANY WARRANTY; without even the implied warranty of + ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ## GNU General Public License for more details. + ## + ## You should have received a copy of the GNU General Public License + ## along with SECS2D; If not, see . + + h=nodes(elements(:,2))-nodes(elements(:,1)); + + c=acoeff./h; + Bneg=Ubernoulli(-(v(2:Nnodes)-v(1:Nnodes-1))*bcoeff,1); + Bpos=Ubernoulli( (v(2:Nnodes)-v(1:Nnodes-1))*bcoeff,1); + + + d0 = [c(1).*Bneg(1); c(1:end-1).*Bpos(1:end-1)+c(2:end).*Bneg(2:end); c(end)*Bpos(end)]; + d1 = [1000;-c.* Bpos]; + dm1 = [-c.* Bneg;1000]; + + A = spdiags([dm1 d0 d1],-1:1,Nnodes,Nnodes); + + % Last Revision: + % $Author: adb014 $ + % $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ diff --git a/octave_packages/secs1d-0.0.8/Utilities/constants.m b/octave_packages/secs1d-0.0.8/Utilities/constants.m new file mode 100644 index 0000000..bc1fa52 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/Utilities/constants.m @@ -0,0 +1,73 @@ + +Kb = 1.3806503e-23; +q = 1.602176462e-19; +e0 = 8.854187817e-12; +esir = 11.7; +esio2r = 3.9; +esi = e0 * esir; +esio2 = e0 * esio2r; +hplanck = 6.626e-34; +hbar = ( hplanck/ (2*pi)); +mn0 = 9.11e-31; +mn = 0.26*mn0; +mh = 0.18*mn0; + + +qsue = q / esi; +T0 = 300 ; +Vth = Kb * T0 / q; +un = 1417e-4; +up = 480e-4; +tp = 1e-7; +tn = 1e-7; + +mnl = 0.98*mn0; +mnt = 0.19*mn0; +mndos = (mnl*mnt*mnt)^(1/3); + +mhh = 0.49*mn0; +mlh = 0.16*mn0; +mhdos = (mhh^(3/2)+mlh^(3/2))^(2/3); + +rn = .1; +aleph = hbar^2/(4*rn*q*mn); +alephn = aleph; +rp = .1; +alephp = hbar^2/(4*rp*q*mh); + +Nc = (6/4)*(2*mndos*Kb*T0/(hbar^2*pi))^(3/2); +Nv = (1/4)*(2*mhdos*Kb*T0/(hbar^2*pi))^(3/2); +Eg0 = 1.16964*q; +alfaEg = 4.73e-4*q; +betaEg = 6.36e2; +Egap = Eg0-alfaEg*((T0^2)/(T0+betaEg)); + +ni = sqrt(Nc*Nv)*exp(-Egap/(2*(Kb * T0))); +Phims = - Egap /(2*q); + + +## This file is part of +## +## SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator +## ------------------------------------------------------------------- +## Copyright (C) 2004-2007 Carlo de Falco +## +## +## +## SECS1D is free software; you can 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. +## +## SECS1D is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with SECS1D; If not, see . + +% Last Revision: +% $Author: adb014 $ +% $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ + diff --git a/octave_packages/secs1d-0.0.8/Utilities/doc-cache b/octave_packages/secs1d-0.0.8/Utilities/doc-cache new file mode 100644 index 0000000..a3264ec --- /dev/null +++ b/octave_packages/secs1d-0.0.8/Utilities/doc-cache @@ -0,0 +1,276 @@ +# Created by Octave 3.6.1, Thu Mar 22 16:18:37 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 9 +# name: +# type: sq_string +# elements: 1 +# length: 5 +Ubern + + +# name: +# type: sq_string +# elements: 1 +# length: 82 + [bp,bn]=Ubern(x) + + Bernoulli function + bp = B(x)=x/(exp(x)-1) + bn = B(-x)=x+B(x) + + + +# name: +# type: sq_string +# elements: 1 +# length: 18 + [bp,bn]=Ubern(x) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +Ubernoulli + + +# name: +# type: sq_string +# elements: 1 +# length: 148 + + b=Ubernoulli(x,sg) + + Bernoulli function + b = B(x)=x/(exp(x)-1) if sg==1 + b = B(-x)=x+B(x) if sg==0 + also works if x is a vector + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + b=Ubernoulli(x,sg) + + Bernoulli function + b = B(x)=x/(exp(x)-1) if sg= + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +Ucompconst + + +# name: +# type: sq_string +# elements: 1 +# length: 54 + R = compconst (nodes,Nnodes,elements,Nelements,D,C); + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 + R = compconst (nodes,Nnodes,elements,Nelements,D,C); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +Ucomplap + + +# name: +# type: sq_string +# elements: 1 +# length: 161 + L = Ucomplap (nodes,Nnode,elements,Nelements,coeff) + Computes the P1 finite element approximation of the + differential operator - d ( coeff d (.)\dx)\dx + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + L = Ucomplap (nodes,Nnode,elements,Nelements,coeff) + Computes the P1 finite + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +Ucompmass + + +# name: +# type: sq_string +# elements: 1 +# length: 65 + Bmat = Ucompmass (nodes,Nnodes,elements,Nelements,Bvect,Cvect); + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 + Bmat = Ucompmass (nodes,Nnodes,elements,Nelements,Bvect,Cvect); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +Udriftdiffusion + + +# name: +# type: sq_string +# elements: 1 +# length: 134 +A=Udriftdiffusion(x,psi,coeff) + + Builds the Scharfetter-Gummel approximation + of the differential operator - (coeff (n' - n psi'))' + + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 +A=Udriftdiffusion(x,psi,coeff) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +Umediaarmonica + + +# name: +# type: sq_string +# elements: 1 +# length: 101 + m = mediaarmonica(w,x); + returns the harmonic mean value of w in each of the intervals x_i , x_i+1 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + m = mediaarmonica(w,x); + returns the harmonic mean value of w in each of the in + + + +# name: +# type: sq_string +# elements: 1 +# length: 18 +Uscharfettergummel + + +# name: +# type: sq_string +# elements: 1 +# length: 387 +A=Uscharfettergummel(nodes,Nnodes,elements,Nelements,acoeff,bcoeff,v) + + Builds the Scharfetter-Gummel matrix for the + the discretization of the LHS + of the Drift-Diffusion equation: + + $ -(a(x) (u' - b v'(x) u))'= f $ + + where a(x) is piecewise constant + and v(x) is piecewise linear, so that + v'(x) is still piecewise constant + b is a constant independent of x + and u is the unknown + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +A=Uscharfettergummel(nodes,Nnodes,elements,Nelements,acoeff,bcoeff,v) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +constants + + +# name: +# type: sq_string +# elements: 1 +# length: 814 + This file is part of + + SECS1D - A 1-D Drift--Diffusion Semiconductor Device Simulator + ------------------------------------------------------------------- + Copyright (C) 2004-2007 Carlo de Falco + + + + SECS1D is free software; you can 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. + + SECS1D is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with SECS1D; If not, see . + + + +# name: +# type: sq_string +# elements: 1 +# length: 23 + This file is part of + + + + + + diff --git a/octave_packages/secs1d-0.0.8/doc-cache b/octave_packages/secs1d-0.0.8/doc-cache new file mode 100644 index 0000000..cf8f919 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/doc-cache @@ -0,0 +1,37 @@ +# Created by Octave 3.6.1, Thu Mar 22 16:18:37 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 1 +# name: +# type: sq_string +# elements: 1 +# length: 6 +secs1d + + +# name: +# type: sq_string +# elements: 1 +# length: 319 + Run this only if the package is installed + PKG_ADD: if (! exist (fullfile (fileparts (mfilename ("fullpath")), "inst"), "dir")) + PKG_ADD: dirlist= {"Utilities","DDG","DDN"}; + PKG_ADD: for ii=1:length(dirlist) + PKG_ADD: addpath ( [ fileparts( mfilename("fullpath")) "/" dirlist{ii}]) + PKG_ADD: end + PKG_ADD: end + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Run this only if the package is installed + PKG_ADD: if (! exist (fullfile (file + + + + + diff --git a/octave_packages/secs1d-0.0.8/packinfo/.autoload b/octave_packages/secs1d-0.0.8/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/secs1d-0.0.8/packinfo/DESCRIPTION b/octave_packages/secs1d-0.0.8/packinfo/DESCRIPTION new file mode 100644 index 0000000..c610353 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: SECS1D +Version: 0.0.8 +Date: 2008-08-23 +Author: Carlo de Falco +Maintainer: Carlo de Falco +Title: SEmi Conductor Simulator in 1D +Description: A Drift-Diffusion simulator for 1d semiconductor devices +Categories: Electrical Engineering +Depends: octave (>= 2.9.17) +Autoload: yes +License: GPL version 2 or later +Url: http://www.comson.org/dem diff --git a/octave_packages/secs1d-0.0.8/packinfo/INDEX b/octave_packages/secs1d-0.0.8/packinfo/INDEX new file mode 100644 index 0000000..4a49719 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/packinfo/INDEX @@ -0,0 +1,24 @@ +secs1D >> SEmiConductor Simulator in 1D +DDG + DDGelectron_driftdiffusion + DDGgummelmap + DDGhole_driftdiffusion + DDGn2phin + DDGnlpoisson + DDGp2phip + DDGphin2n + DDGphip2p + DDGplotresults +DDN + DDNnewtonmap +Utilities + constants + Ubern + Ubernoulli + Ucompconst + Ucomplap + Ucompmass + Udriftdiffusion + Umediaarmonica + Uscharfettergummel + secs1d diff --git a/octave_packages/secs1d-0.0.8/secs1d.m b/octave_packages/secs1d-0.0.8/secs1d.m new file mode 100644 index 0000000..cb7ba02 --- /dev/null +++ b/octave_packages/secs1d-0.0.8/secs1d.m @@ -0,0 +1,15 @@ +# Run this only if the package is installed +## PKG_ADD: if (! exist (fullfile (fileparts (mfilename ("fullpath")), "inst"), "dir")) +## PKG_ADD: dirlist= {"Utilities","DDG","DDN"}; +## PKG_ADD: for ii=1:length(dirlist) +## PKG_ADD: addpath ( [ fileparts( mfilename("fullpath")) "/" dirlist{ii}]) +## PKG_ADD: end +## PKG_ADD: end + +# Run this only if the package is installed +## PKG_DEL: if (! exist (fullfile (fileparts (mfilename ("fullpath")), "inst"), "dir")) +## PKG_DEL: dirlist= {"Utilities","DDG","DDN"}; +## PKG_DEL: for ii=1:length(dirlist) +## PKG_DEL: rmpath ( [ fileparts( mfilename("fullpath")) "/" dirlist{ii}]) +## PKG_DEL: end +## PKG_DEL: end diff --git a/octave_packages/secs2d-0.0.8/DDGOX/DDGOXddcurrent.m b/octave_packages/secs2d-0.0.8/DDGOX/DDGOXddcurrent.m new file mode 100644 index 0000000..3237b6a --- /dev/null +++ b/octave_packages/secs2d-0.0.8/DDGOX/DDGOXddcurrent.m @@ -0,0 +1,52 @@ +function [current,divrg]=DDGOXddcurrent(mesh,Sinodes,data,contacts); + +% [current,divrg]=DDGOXddcurrent(mesh,Sinodes,data,contacts); + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +load (file_in_path(path,'constants.mat')) + + +Nelements = size(mesh.t,2); +mob = Ufielddepmob(mesh,data.un,data.Fn,data.vsatn,data.mubn); +An = Uscharfettergummel(mesh,data.V(Sinodes),mob); +mob = Ufielddepmob(mesh,data.up,data.Fp,data.vsatp,data.mubp); +Ap = Uscharfettergummel(mesh,-data.V(Sinodes),mob); +divrg = An * data.n + Ap * data.p; + +for con = 1:length(contacts) + + cedges = []; + cedges=[cedges,find(mesh.e(5,:)==contacts(con))]; + cnodes = mesh.e(1:2,cedges); + cnodes = [cnodes(1,:) cnodes(2,:)]; + cnodes = unique(cnodes); + + current(con) = sum(divrg(cnodes)); + +end + +Is = q*data.us*data.Vs*data.ns; +current = current * Is; + + diff --git a/octave_packages/secs2d-0.0.8/DDGOX/DDGOXelectron_driftdiffusion.m b/octave_packages/secs2d-0.0.8/DDGOX/DDGOXelectron_driftdiffusion.m new file mode 100644 index 0000000..dd9184c --- /dev/null +++ b/octave_packages/secs2d-0.0.8/DDGOX/DDGOXelectron_driftdiffusion.m @@ -0,0 +1,58 @@ +function n=DDGOXelectron_driftdiffusion(mesh,Dsides,nin,pin,V,un,tn,tp,n0,p0) + +%% +% n=DDGelectron_driftdiffusion(mesh,Dsides,nin,pin,V,un,tn,tp,n0,p0) +% IN: +% v = electric potential +% mesh = integration domain +% ng = initial guess and BCs for electron density +% p = hole density (to compute SRH recombination) +% OUT: +% n = updated electron density +%% + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +if (Ucolumns(nin)>Urows(nin)) + nin=nin'; +end + +if (Ucolumns(V)>Urows(V)) + V=V'; +end + +if (Ucolumns(pin)>Urows(pin)) + pin=pin'; +end + +Nnodes = max(size(mesh.p)); +Nelements = max(size(mesh.t)); + +denom = (tp*(nin+sqrt(n0.*p0))+tn*(pin+sqrt(n0.*p0))); +u = un; +U = p0.*n0./denom; +M = pin./denom; +guess = nin; + +n = Udriftdiffusion(mesh,Dsides,guess,M,U,V,u); + + diff --git a/octave_packages/secs2d-0.0.8/DDGOX/DDGOXgummelmap.m b/octave_packages/secs2d-0.0.8/DDGOX/DDGOXgummelmap.m new file mode 100644 index 0000000..ed2a757 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/DDGOX/DDGOXgummelmap.m @@ -0,0 +1,177 @@ +function [odata,it,res] = DDGOXgummelmap (imesh,Dsides,... +Simesh,Sinodes,Sielements,SiDsides,... +idata,toll,maxit,ptoll,pmaxit,verbose) + +% [odata,it,res] = DDGOXgummelmap (imesh,Dsides,... +% Simesh,Sinodes,Sielements,SiDsides,... +% idata,toll,maxit,ptoll,pmaxit,verbose) +% + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +clear DDGOXNLPOISSON_LAP DDGOXNLPOISSON_MASS DDGOXNLPOISSON_RHS DDG_RHS DDG_MASS +global DDGOXNLPOISSON_LAP DDGOXNLPOISSON_MASS DDGOXNLPOISSON_RHS DDG_RHS DDG_MASS + +%%%%%%%%%%%%%%% +%% RRE param %% +RREnnit = [1,0]; +RRErank = 5; +RREpattern = URREcyclingpattern(RREnnit,RRErank,maxit); +%%%%%%%%%%%%%%% + +Nnodes = max(size(imesh.p)); +Nelements = max(size(imesh.t)); +SiNnodes = max(size(Simesh.p)); +SiNelements = max(size(Simesh.t)); + +V (:,1) = idata.V; + +p (:,1) = idata.p; + +n (:,1) = idata.n; + +Fn(:,1) = idata.Fn; +Fp(:,1) = idata.Fp; + +D = idata.D; + +% Set list of nodes with Dirichelet BCs +Dnodes = Unodesonside(imesh,Dsides); + +% Set list of nodes with Dirichelet BCs +SiDnodes = Unodesonside(Simesh,SiDsides); + +nrm = 1; + +for i=1:1:maxit + if (verbose>=1) + fprintf(1,'*****************************************************************\n'); + fprintf(1,'**** start of gummel iteration number: %d\n',i); + fprintf(1,'*****************************************************************\n'); + + end + + if (verbose>=1) + fprintf(1,'solving non linear poisson equation\n'); + if ((i>1)&(verbose>1)) + DDGOXplotresults(imesh,Simesh,n(:,1)*idata.ns,p(:,1)*idata.ns,V(:,1)*idata.Vs,... + Fn(:,1)*idata.Vs,Fp(:,1)*idata.Vs,i,nrm(end),'poisson'); + end + end + + + + [V(:,2),n(:,2),p(:,2)] =... + DDGOXnlpoisson (imesh,Dsides,Sinodes,SiDnodes,Sielements,... + V(:,1),n(:,1),p(:,1),Fn(:,1),Fp(:,1),D,... + idata.l2,idata.l2ox,ptoll,pmaxit,verbose-1); + V(Dnodes,2) = idata.V(Dnodes); + + if (verbose>=1) + fprintf (1,'***\nupdating electron qfl\n'); + if ((i>1)&(verbose>1)) + DDGOXplotresults(imesh,Simesh,n(:,2)*idata.ns,p(:,2)*idata.ns,... + V(:,2)*idata.Vs,Fn(:,1)*idata.Vs,Fp(:,1)*idata.Vs,i,nrm(end),'e- continuity'); + end + end + + mob = Ufielddepmob(Simesh,idata.un,Fn(:,1),idata.vsatn,idata.mubn); + + n(:,3) =DDGOXelectron_driftdiffusion(Simesh,SiDsides,n(:,2),p(:,2),... + V(Sinodes,2),mob,... + idata.tn,idata.tp,idata.ni,idata.ni); + Fn(:,2)=V(Sinodes,2) - log(n(:,3)); + n(SiDnodes,3) = idata.n(SiDnodes); + Fn(SiDnodes,2) = idata.Fn(SiDnodes); + + %%%% store result for RRE + if RREpattern(i)>0 + Fnstore(:,RREpattern(i)) = Fn(:,2); + if RREpattern(i+1)==0 % Apply RRE extrapolation + if (verbose>=1) + fprintf(1,'\n**********\nRRE EXTRAPOLATION STEP\n**********\n'); + end + Fn(:,2) = Urrextrapolation(Fnstore); + end + end + + if (verbose>=1) + fprintf(1,'***\nupdating hole qfl\n'); + if ((i>1)&(verbose>1)) + DDGOXplotresults(imesh,Simesh,n(:,3)*idata.ns,p(:,2)*idata.ns,V(:,2)*idata.Vs,... + Fn(:,2)*idata.Vs,Fp(:,1)*idata.Vs,i,nrm(end),'h+ continuity'); + end + end + + mob = Ufielddepmob(Simesh,idata.up,Fp(:,1),idata.vsatp,idata.mubp); + p(:,3) =DDGOXhole_driftdiffusion(Simesh,SiDsides,n(:,3),p(:,2),... + V(Sinodes,2),mob,... + idata.tn,idata.tp,idata.ni,idata.ni); + Fp(:,2)= V(Sinodes,2) + log(p(:,3)); + p(SiDnodes,3) = idata.p(SiDnodes); + Fp(SiDnodes,2) = idata.Fp(SiDnodes); + + if (verbose>=1) + fprintf(1,'checking for convergence\n'); + end + + nrfn= norm(Fn(:,2)-Fn(:,1),inf); + nrfp= norm (Fp(:,2)-Fp(:,1),inf); + nrv = norm (V(:,2)-V(:,1),inf); + nrm(i) = max([nrfn;nrfp;nrv]); + + if (verbose>1) + figure(2); + semilogy(nrm) + pause(.1) + end + + if (verbose>=1) + fprintf (1,' max(|phin_(k+1)-phinn_(k)| ,...\n |phip_(k+1)-phip_(k)| ,...\n |v_(k+1)- v_(k)| )= %g\n',nrm(i)); + end + if (nrm(i)0) + fprintf(1,'\n***********\nDD simulation over:\n # of Gummel iterations = %d\n\n',it); +end + +odata = idata; + +odata.n = n(:,end); +odata.p = p(:,end); +odata.V = V(:,end); +odata.Fn = Fn(:,end); +odata.Fp = Fp(:,end); diff --git a/octave_packages/secs2d-0.0.8/DDGOX/DDGOXhole_driftdiffusion.m b/octave_packages/secs2d-0.0.8/DDGOX/DDGOXhole_driftdiffusion.m new file mode 100644 index 0000000..d96c8e9 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/DDGOX/DDGOXhole_driftdiffusion.m @@ -0,0 +1,60 @@ +function p=DDGOXhole_driftdiffusion(mesh,Dsides,nin,pin,V,up,tn,tp,n0,p0) + +%% +% p=DDGhole_driftdiffusion(mesh,Dsides,nin,pin,V,up,tn,tp,n0,p0) +% IN: +% v = electric potential +% mesh = integration domain +% nin = initial guess and BCs for electron density +% pin = hole density (to compute SRH recombination) +% OUT: +% p = updated hole density +%% + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +if (Ucolumns(nin)>Urows(nin)) + nin=nin'; +end + +if (Ucolumns(V)>Urows(V)) + V=V'; +end + +if (Ucolumns(pin)>Urows(pin)) + pin=pin'; +end + +Nnodes = max(size(mesh.p)); +Nelements = max(size(mesh.t)); + +denom = (tp*(nin+sqrt(n0.*p0))+tn*(pin+sqrt(n0.*p0))); +u = up; +U = n0.*p0./denom; +M = nin./denom; +guess = pin; +V = -V; + +p = Udriftdiffusion(mesh,Dsides,guess,M,U,V,u); + + + diff --git a/octave_packages/secs2d-0.0.8/DDGOX/DDGOXnlpoisson.m b/octave_packages/secs2d-0.0.8/DDGOX/DDGOXnlpoisson.m new file mode 100644 index 0000000..2ae96a0 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/DDGOX/DDGOXnlpoisson.m @@ -0,0 +1,253 @@ +function [V,n,p,res,niter] = DDGOXnlpoisson (mesh,Dsides,Sinodes,SiDnodes,... + Sielements,Vin,nin,pin,... + Fnin,Fpin,D,l2,l2ox,... + toll,maxit,verbose) + +% +% [V,n,p,res,niter] = DDGOXnlpoisson (mesh,Dsides,Sinodes,Vin,nin,pin,... +% Fnin,Fpin,D,l2,l2ox,toll,maxit,verbose) +% +% solves $$ -\lambda^2 V'' + (n(V,Fn) - p(V,Fp) -D)$$ +% + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +global DDGOXNLPOISSON_LAP DDGOXNLPOISSON_MASS DDGOXNLPOISSON_RHS + +%% Set some useful constants +dampit = 10; +dampcoeff = 2; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% convert input vectors to columns +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +if Ucolumns(D)>Urows(D) + D=D'; +end + + +if Ucolumns(nin)>Urows(nin) + nin=nin'; +end + +if Ucolumns(pin)>Urows(pin) + pin=pin'; +end + +if Ucolumns(Vin)>Urows(Vin) + Vin=Vin'; +end + +if Ucolumns(Fnin)>Urows(Fnin) + Fnin=Fnin'; +end + +if Ucolumns(Fpin)>Urows(Fpin) + Fpin=Fpin'; +end +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% setup FEM data structures +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +nodes=mesh.p; +elements=mesh.t; +Nnodes = length(nodes); +Nelements = length(elements); + +% Set list of nodes with Dirichelet BCs +Dnodes = Unodesonside(mesh,Dsides); + +% Set values of Dirichelet BCs +Bc = zeros(length(Dnodes),1); +% Set list of nodes without Dirichelet BCs +Varnodes = setdiff([1:Nnodes],Dnodes); + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% initialization: +%% we're going to solve +%% $$ - \lambda^2 (\delta V)'' + (\frac{\partial n}{\partial V} - \frac{\partial p}{\partial V})= -R $$ +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% set $$ n_1 = nin $$ and $$ V = Vin $$ +V = Vin; +Fn = Fnin; +Fp = Fpin; +n = exp(V(Sinodes)-Fn); +p = exp(-V(Sinodes)+Fp); +n(SiDnodes) = nin(SiDnodes); +p(SiDnodes) = pin(SiDnodes); + + +%%% +%%% Compute LHS matrices +%%% + +%% let's compute FEM approximation of $$ L = - \frac{d^2}{x^2} $$ +if (isempty(DDGOXNLPOISSON_LAP)) + coeff = l2ox * ones(Nelements,1); + coeff(Sielements)=l2; + DDGOXNLPOISSON_LAP = Ucomplap (mesh,coeff); +end + +%% compute $$ Mv = ( n + p) $$ +%% and the (lumped) mass matrix M +if (isempty(DDGOXNLPOISSON_MASS)) + coeffe = zeros(Nelements,1); + coeffe(Sielements)=1; + DDGOXNLPOISSON_MASS = Ucompmass2(mesh,ones(Nnodes,1),coeffe); +end +freecarr=zeros(Nnodes,1); +freecarr(Sinodes)=(n + p); +Mv = freecarr; +M = DDGOXNLPOISSON_MASS*spdiag(Mv); + +%%% +%%% Compute RHS vector (-residual) +%%% + +%% now compute $$ T0 = \frac{q}{\epsilon} (n - p - D) $$ +if (isempty(DDGOXNLPOISSON_RHS)) + coeffe = zeros(Nelements,1); + coeffe(Sielements)=1; + DDGOXNLPOISSON_RHS = Ucompconst (mesh,ones(Nnodes,1),coeffe); +end +totcharge = zeros(Nnodes,1); +totcharge(Sinodes)=(n - p - D); +Tv0 = totcharge; +T0 = Tv0 .* DDGOXNLPOISSON_RHS; + +%% now we're ready to build LHS matrix and RHS of the linear system for 1st Newton step +A = DDGOXNLPOISSON_LAP + M; +R = DDGOXNLPOISSON_LAP * V + T0; + +%% Apply boundary conditions +A (Dnodes,:) = []; +A (:,Dnodes) = []; +R(Dnodes) = []; + +%% we need $$ \norm{R_1} $$ and $$ \norm{R_k} $$ for the convergence test +normr(1) = norm(R,inf); +relresnorm = 1; +reldVnorm = 1; +normrnew = normr(1); +dV = V*0; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% START OF THE NEWTON CYCLE +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +for newtit=1:maxit + if (verbose>0) + fprintf(1,'\n***\nNewton iteration: %d, reldVnorm = %e\n***\n',newtit,reldVnorm); + end + +% A(1,end)=realmin; + dV(Varnodes) =(A)\(-R); + dV(Dnodes)=0; + + + %%%%%%%%%%%%%%%%%% + %% Start of th damping procedure + %%%%%%%%%%%%%%%%%% + tk = 1; + for dit = 1:dampit + if (verbose>0) + fprintf(1,'\ndamping iteration: %d, residual norm = %e\n',dit,normrnew); + end + Vnew = V + tk * dV; + + n = exp(Vnew(Sinodes)-Fn); + p = exp(-Vnew(Sinodes)+Fp); + n(SiDnodes) = nin(SiDnodes); + p(SiDnodes) = pin(SiDnodes); + + + %%% + %%% Compute LHS matrices + %%% + + %% let's compute FEM approximation of $$ L = - \frac{d^2}{x^2} $$ + %L = Ucomplap (mesh,ones(Nelements,1)); + + %% compute $$ Mv = ( n + p) $$ + %% and the (lumped) mass matrix M + freecarr=zeros(Nnodes,1); + freecarr(Sinodes)=(n + p); + Mv = freecarr; + M = DDGOXNLPOISSON_MASS*spdiag(Mv); + + %%% + %%% Compute RHS vector (-residual) + %%% + + %% now compute $$ T0 = \frac{q}{\epsilon} (n - p - D) $$ + totcharge( Sinodes)=(n - p - D); + Tv0 = totcharge; + T0 = Tv0 .* DDGOXNLPOISSON_RHS;%T0 = Ucompconst (mesh,Tv0,ones(Nelements,1)); + + %% now we're ready to build LHS matrix and RHS of the linear system for 1st Newton step + A = DDGOXNLPOISSON_LAP + M; + R = DDGOXNLPOISSON_LAP * Vnew + T0; + + %% Apply boundary conditions + A (Dnodes,:) = []; + A (:,Dnodes) = []; + R(Dnodes) = []; + + %% compute $$ | R_{k+1} | $$ for the convergence test + normrnew= norm(R,inf); + + % check if more damping is needed + if (normrnew > normr(newtit)) + tk = tk/dampcoeff; + else + if (verbose>0) + fprintf(1,'\nexiting damping cycle because residual norm = %e \n-----------\n',normrnew); + end + break + end + end + + V = Vnew; + normr(newtit+1) = normrnew; + dVnorm = norm(tk*dV,inf); + pause(.1); + % check if convergence has been reached + reldVnorm = dVnorm / norm(V,inf); + if (reldVnorm <= toll) + if(verbose>0) + fprintf(1,'\nexiting newton cycle because reldVnorm= %e \n',reldVnorm); + end + break + end + +end + +res = normr; +niter = newtit; + diff --git a/octave_packages/secs2d-0.0.8/DDGOX/DDGOXplotresults.m b/octave_packages/secs2d-0.0.8/DDGOX/DDGOXplotresults.m new file mode 100644 index 0000000..fccbbf1 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/DDGOX/DDGOXplotresults.m @@ -0,0 +1,54 @@ +function DDGOXplotresults(mesh,Simesh,n,p,V,Fn,Fp,gi,nrm,step); + +% +% DDGOXplotresults(mesh,Simesh,n,p,V,Fn,Fp,gi,nrm,step); +% +% + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + + +f1=figure(1); +subplot(2,3,1) +Updesurf(Simesh,log10(n),'colormap','jet','mesh','off','contour','on'); +title('Electron Density (log)'); grid; colorbar; view(2) + +subplot(2,3,2) +Updesurf(Simesh,log10(p),'colormap','jet','mesh','off'); +title('Hole Density (log)'); grid; colorbar; view(2) + +subplot(2,3,4) +Updesurf(Simesh,Fn,'colormap','jet','mesh','off'); +title('Electron QFL'); grid; colorbar; view(2) + +subplot(2,3,5) +Updesurf(Simesh,Fp,'colormap','jet','mesh','off'); +title('Hole QFL'); grid; colorbar; view(2) + +subplot(1,3,3) +Updesurf(mesh,V,'colormap','jet','mesh','off'); +title('Electric Potential'); grid; colorbar; view(2) +pause(.1) + + diff --git a/octave_packages/secs2d-0.0.8/DDGOX/doc-cache b/octave_packages/secs2d-0.0.8/DDGOX/doc-cache new file mode 100644 index 0000000..df3b2cc --- /dev/null +++ b/octave_packages/secs2d-0.0.8/DDGOX/doc-cache @@ -0,0 +1,184 @@ +# Created by Octave 3.6.1, Sun Mar 25 18:44:37 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 6 +# name: +# type: sq_string +# elements: 1 +# length: 14 +DDGOXddcurrent + + +# name: +# type: sq_string +# elements: 1 +# length: 61 + [current,divrg]=DDGOXddcurrent(mesh,Sinodes,data,contacts); + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 + [current,divrg]=DDGOXddcurrent(mesh,Sinodes,data,contacts); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 28 +DDGOXelectron_driftdiffusion + + +# name: +# type: sq_string +# elements: 1 +# length: 293 + + n=DDGelectron_driftdiffusion(mesh,Dsides,nin,pin,V,un,tn,tp,n0,p0) + IN: + v = electric potential + mesh = integration domain + ng = initial guess and BCs for electron density + p = hole density (to compute SRH recombination) + OUT: + n = updated electron density + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + n=DDGelectron_driftdiffusion(mesh,Dsides,nin,pin,V,un,tn,tp,n0,p0) + IN: + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +DDGOXgummelmap + + +# name: +# type: sq_string +# elements: 1 +# length: 185 + [odata,it,res] = DDGOXgummelmap (imesh,Dsides,... + Simesh,Sinodes,Sielements,SiDsides,... + idata,toll,maxit,ptoll,pmaxit,verbose) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + [odata,it,res] = DDGOXgummelmap (imesh,Dsides,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +DDGOXhole_driftdiffusion + + +# name: +# type: sq_string +# elements: 1 +# length: 286 + + p=DDGhole_driftdiffusion(mesh,Dsides,nin,pin,V,up,tn,tp,n0,p0) + IN: + v = electric potential + mesh = integration domain + nin = initial guess and BCs for electron density + pin = hole density (to compute SRH recombination) + OUT: + p = updated hole density + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + p=DDGhole_driftdiffusion(mesh,Dsides,nin,pin,V,up,tn,tp,n0,p0) + IN: + v + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +DDGOXnlpoisson + + +# name: +# type: sq_string +# elements: 1 +# length: 219 + + [V,n,p,res,niter] = DDGOXnlpoisson (mesh,Dsides,Sinodes,Vin,nin,pin,... + Fnin,Fpin,D,l2,l2ox,toll,maxit,verbose) + + solves $$ -\lambda^2 V'' + (n(V,Fn) - p(V,Fp) -D)$$ + + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 + + [V,n,p,res,niter] = DDGOXnlpoisson (mesh,Dsides,Sinodes,Vin,nin,pin,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +DDGOXplotresults + + +# name: +# type: sq_string +# elements: 1 +# length: 59 + + DDGOXplotresults(mesh,Simesh,n,p,V,Fn,Fp,gi,nrm,step); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 + + DDGOXplotresults(mesh,Simesh,n,p,V,Fn,Fp,gi,nrm,step); + + + + + + diff --git a/octave_packages/secs2d-0.0.8/DDGOXT/DDGOXTelectron_driftdiffusion.m b/octave_packages/secs2d-0.0.8/DDGOXT/DDGOXTelectron_driftdiffusion.m new file mode 100644 index 0000000..7d93b9b --- /dev/null +++ b/octave_packages/secs2d-0.0.8/DDGOXT/DDGOXTelectron_driftdiffusion.m @@ -0,0 +1,60 @@ +function n=DDGOXTelectron_driftdiffusion(mesh,Dsides,nin,pin,V,un,tn,tp,n0,p0,weight) + +%% +% n=DDGelectron_driftdiffusion(mesh,Dsides,nin,pin,V,un,tn,tp,n0,p0,weight) +% +% IN: +% V = electric potential +% mesh = integration domain +% nin = electron density in the past + initial guess +% pin = hole density in the past +% n0,p0 = equilibrium densities +% tn,tp = carrier lifetimes +% weight = BDF weights +% un = mobility +% +% OUT: +% n = updated electron density +% +%% + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + +BDForder = length(weight)-1; + + + +denom = (tp*(nin(:,end)+sqrt(n0.*p0))+tn*(pin(:,end)+sqrt(n0.*p0))); +M = weight(1) + pin(:,end)./denom; + +u = un; + +U = p0.*n0./denom; +for ii=1:BDForder + U += -nin(:,end-ii)*weight(ii+1); +end + +guess = nin(:,end); +n = Udriftdiffusion(mesh,Dsides,guess,M,U,V,u); + + diff --git a/octave_packages/secs2d-0.0.8/DDGOXT/DDGOXTgummelmap.m b/octave_packages/secs2d-0.0.8/DDGOXT/DDGOXTgummelmap.m new file mode 100644 index 0000000..f06ca3f --- /dev/null +++ b/octave_packages/secs2d-0.0.8/DDGOXT/DDGOXTgummelmap.m @@ -0,0 +1,162 @@ +function [odata,it,res] = DDGOXTgummelmap (imesh,Dsides,... + Simesh,Sinodes,Sielements,SiDsides,... + idata,nold,pold,weight,toll,maxit,ptoll,... + pmaxit,verbose) + +# function [odata,it,res] = DDGOXTgummelmap (imesh,Dsides,... +# Simesh,Sinodes,Sielements,SiDsides,... +# idata,oldn,oldp,weight,toll,maxit,ptoll,... +# pmaxit,verbose) + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +clear DDGOXNLPOISSON_LAP DDGOXNLPOISSON_MASS DDGOXNLPOISSON_RHS DDG_RHS DDG_MASS +global DDGOXNLPOISSON_LAP DDGOXNLPOISSON_MASS DDGOXNLPOISSON_RHS DDG_RHS DDG_MASS + +%%%%%%%%%%%%%%% +%% RRE param %% +RREnnit = [5,5]; +RRErank = 4; +RREpattern = URREcyclingpattern(RREnnit,RRErank,maxit); +%%%%%%%%%%%%%%% + +Nnodes = max(size(imesh.p)); +Nelements = max(size(imesh.t)); +SiNnodes = max(size(Simesh.p)); +SiNelements = max(size(Simesh.t)); + +V (:,1) = idata.V; + +p (:,1) = idata.p; + +n (:,1) = idata.n; + +Fn(:,1) = idata.Fn; +Fp(:,1) = idata.Fp; + +D = idata.D; + +% Set list of nodes with Dirichelet BCs +Dnodes = Unodesonside(imesh,Dsides); + +% Set list of nodes with Dirichelet BCs +SiDnodes = Unodesonside(Simesh,SiDsides); + +nrm = 1; + +for i=1:1:maxit + if (verbose>=1) + fprintf(1,'*****************************************************************\n'); + fprintf(1,'**** start of gummel iteration number: %d\n',i); + fprintf(1,'*****************************************************************\n'); + + end + + if (verbose>=1) + fprintf(1,'solving non linear poisson equation\n'); + end + + + + [V(:,2),n(:,2),p(:,2)] =... + DDGOXnlpoisson (imesh,Dsides,Sinodes,SiDnodes,Sielements,... + V(:,1),n(:,1),p(:,1),Fn(:,1),Fp(:,1),D,... + idata.l2,idata.l2ox,ptoll,pmaxit,verbose-1); + V(Dnodes,2) = idata.V(Dnodes); + + if (verbose>=1) + fprintf (1,'***\nupdating electron qfl\n'); + end + + mob = Ufielddepmob(Simesh,idata.un,Fn(:,1),idata.vsatn,idata.mubn); + + n(:,3) =DDGOXTelectron_driftdiffusion(Simesh,SiDsides,[n(:,2),nold],[p(:,2),pold],... + V(Sinodes,2),mob,... + idata.tn,idata.tp,idata.ni,idata.ni,weight); + Fn(:,2)=V(Sinodes,2) - log(n(:,3)); + n(SiDnodes,3) = idata.n(SiDnodes); + Fn(SiDnodes,2) = idata.Fn(SiDnodes); + + %%%% store result for RRE + if RREpattern(i)>0 + Fnstore(:,RREpattern(i)) = Fn(:,2); + if RREpattern(i+1)==0 % Apply RRE extrapolation + if (verbose>=1) + fprintf(1,'\n**********\nRRE EXTRAPOLATION STEP\n**********\n'); + end + Fn(:,2) = Urrextrapolation(Fnstore); + end + end + + if (verbose>=1) + fprintf(1,'***\nupdating hole qfl\n'); + end + + mob = Ufielddepmob(Simesh,idata.up,Fp(:,1),idata.vsatp,idata.mubp); + + p(:,3) =DDGOXThole_driftdiffusion(Simesh,SiDsides,[n(:,3),nold],[p(:,2),pold],... + V(Sinodes,2),mob,... + idata.tn,idata.tp,idata.ni,idata.ni,weight); + + Fp(:,2)= V(Sinodes,2) + log(p(:,3)); + p(SiDnodes,3) = idata.p(SiDnodes); + Fp(SiDnodes,2) = idata.Fp(SiDnodes); + + if (verbose>=1) + fprintf(1,'checking for convergence\n'); + end + + nrfn= norm(Fn(:,2)-Fn(:,1),inf); + nrfp= norm (Fp(:,2)-Fp(:,1),inf); + nrv = norm (V(:,2)-V(:,1),inf); + nrm(i) = max([nrfn;nrfp;nrv]); + + if (verbose>=1) + fprintf (1,' max(|phin_(k+1)-phinn_(k)| ,...\n |phip_(k+1)-phip_(k)| ,...\n |v_(k+1)- v_(k)| )= %g\n',nrm(i)); + end + if (nrm(i)0) + fprintf(1,'\n***********\nDD simulation over:\n # of Gummel iterations = %d\n\n',it); +end + +odata = idata; + +odata.n = n(:,end); +odata.p = p(:,end); +odata.V = V(:,end); +odata.Fn = Fn(:,end); +odata.Fp = Fp(:,end); diff --git a/octave_packages/secs2d-0.0.8/DDGOXT/DDGOXThole_driftdiffusion.m b/octave_packages/secs2d-0.0.8/DDGOXT/DDGOXThole_driftdiffusion.m new file mode 100644 index 0000000..99f2af1 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/DDGOXT/DDGOXThole_driftdiffusion.m @@ -0,0 +1,59 @@ +function p=DDGOXThole_driftdiffusion(mesh,Dsides,nin,pin,V,up,tn,tp,n0,p0,weight) + +%% +% p=DDGhole_driftdiffusion(mesh,Dsides,nin,pin,V,un,tn,tp,n0,p0,weight) +% +% IN: +% V = electric potential +% mesh = integration domain +% nin = electron density in the past +% pin = hole density in the past + initial guess +% n0,p0 = equilibrium densities +% tn,tp = carrier lifetimes +% weight = BDF weights +% up = mobility +% +% OUT: +% p = updated hole density +% +%% + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + +BDForder = length(weight)-1; + +denom = (tp*(nin(:,end)+sqrt(n0.*p0))+tn*(pin(:,end)+sqrt(n0.*p0))); +M = weight(1) + nin(:,end)./denom; + +u = up; + +U = p0.*n0./denom; + +for ii=1:BDForder + U += -pin(:,end-ii)*weight(ii+1); +end + +guess = pin(:,end); +p = Udriftdiffusion(mesh,Dsides,guess,M,U,-V,u); + + diff --git a/octave_packages/secs2d-0.0.8/DDGOXT/doc-cache b/octave_packages/secs2d-0.0.8/DDGOXT/doc-cache new file mode 100644 index 0000000..fd49d68 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/DDGOXT/doc-cache @@ -0,0 +1,115 @@ +# Created by Octave 3.6.1, Sun Mar 25 18:44:37 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 3 +# name: +# type: sq_string +# elements: 1 +# length: 29 +DDGOXTelectron_driftdiffusion + + +# name: +# type: sq_string +# elements: 1 +# length: 417 + + n=DDGelectron_driftdiffusion(mesh,Dsides,nin,pin,V,un,tn,tp,n0,p0,weight) + + IN: + V = electric potential + mesh = integration domain + nin = electron density in the past + initial guess + pin = hole density in the past + n0,p0 = equilibrium densities + tn,tp = carrier lifetimes + weight = BDF weights + un = mobility + + OUT: + n = updated electron density + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 78 + + n=DDGelectron_driftdiffusion(mesh,Dsides,nin,pin,V,un,tn,tp,n0,p0,weight) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +DDGOXTgummelmap + + +# name: +# type: sq_string +# elements: 1 +# length: 187 + function [odata,it,res] = DDGOXTgummelmap (imesh,Dsides,... + Simesh,Sinodes,Sielements,SiDsides,... + idata,oldn,oldp,weight,toll,maxit,ptoll,... + pmaxit,verbose) + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 + function [odata,it,res] = DDGOXTgummelmap (imesh,Dsides,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 +DDGOXThole_driftdiffusion + + +# name: +# type: sq_string +# elements: 1 +# length: 410 + + p=DDGhole_driftdiffusion(mesh,Dsides,nin,pin,V,un,tn,tp,n0,p0,weight) + + IN: + V = electric potential + mesh = integration domain + nin = electron density in the past + pin = hole density in the past + initial guess + n0,p0 = equilibrium densities + tn,tp = carrier lifetimes + weight = BDF weights + up = mobility + + OUT: + p = updated hole density + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 74 + + p=DDGhole_driftdiffusion(mesh,Dsides,nin,pin,V,un,tn,tp,n0,p0,weight) + + + + + + diff --git a/octave_packages/secs2d-0.0.8/METLINES/METLINEScapcomp.m b/octave_packages/secs2d-0.0.8/METLINES/METLINEScapcomp.m new file mode 100644 index 0000000..8e1b374 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/METLINES/METLINEScapcomp.m @@ -0,0 +1,41 @@ +function [C,L,Lii,LiI,LII,Dnodes,varnodes]=... + METLINEScapcomp(imesh,epsilon,contacts) + +## +## +## [C,L,Lii,LiI,LII,Dnodes,varnodes]=METLINEScapcomp(imesh,epsilon,contacts) +## +## + +Ncontacts = length(contacts); +Nnodes = columns(imesh.p); +varnodes = [1:Nnodes]; + +for ii=1:Ncontacts + Dnodes{ii}=Unodesonside(imesh,contacts{ii}); + varnodes = setdiff(varnodes,Dnodes{ii}); +end + +L = Ucomplap (imesh,epsilon); + +for ii=1:Ncontacts + Lii{ii} = L(Dnodes{ii},Dnodes{ii}); + LiI{ii} = L(Dnodes{ii},varnodes); +end +LII = L(varnodes,varnodes); + +for ii=1:Ncontacts + for jj=ii:Ncontacts + if ii==jj + C(ii,jj)=sum(sum(Lii{ii}-LiI{ii}*(LII\(LiI{ii})'))); + else + C(ii,jj)=sum(sum(-LiI{ii}*(LII\(LiI{jj})'))); + end + end +end + +for ii=1:4 + for jj=1:ii-1 + C(ii,jj)=C(jj,ii); + end +end diff --git a/octave_packages/secs2d-0.0.8/METLINES/METLINESdefinepermittivity.m b/octave_packages/secs2d-0.0.8/METLINES/METLINESdefinepermittivity.m new file mode 100644 index 0000000..f240744 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/METLINES/METLINESdefinepermittivity.m @@ -0,0 +1,15 @@ +function epsilon = METLINESdefinepermittivity(omesh,basevalue,varargin); + +## +## +## epsilon = METLINESdefinepermittivity(omesh,basevalue,[regions1, value1,...]); +## +## + +load (file_in_path(path,'constants.mat')); +epsilon = e0*basevalue*ones(size(omesh.t(1,:)))'; + +for ii=1:floor(length(varargin)/2) + [ignore1,ignore2,elements]=Usubmesh(omesh,[],varargin{2*ii-1},1); + epsilon(elements) = varargin{2*ii}*e0; +end diff --git a/octave_packages/secs2d-0.0.8/METLINES/doc-cache b/octave_packages/secs2d-0.0.8/METLINES/doc-cache new file mode 100644 index 0000000..57bd82d --- /dev/null +++ b/octave_packages/secs2d-0.0.8/METLINES/doc-cache @@ -0,0 +1,63 @@ +# Created by Octave 3.6.1, Sun Mar 25 18:44:37 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 2 +# name: +# type: sq_string +# elements: 1 +# length: 15 +METLINEScapcomp + + +# name: +# type: sq_string +# elements: 1 +# length: 79 + + + [C,L,Lii,LiI,LII,Dnodes,varnodes]=METLINEScapcomp(imesh,epsilon,contacts) + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 1 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 +METLINESdefinepermittivity + + +# name: +# type: sq_string +# elements: 1 +# length: 83 + + + epsilon = METLINESdefinepermittivity(omesh,basevalue,[regions1, value1,...]); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 1 + + + + + + + diff --git a/octave_packages/secs2d-0.0.8/PKG_ADD b/octave_packages/secs2d-0.0.8/PKG_ADD new file mode 100644 index 0000000..6d31b59 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/PKG_ADD @@ -0,0 +1,27 @@ + +# Run this only if the package is installed +if (! exist (fullfile (fileparts (mfilename ("fullpath")), "inst"), "dir")) +dirlist= {"Utilities","DDGOX","ThDDGOX","QDDGOX","METLINES","DDGOXT"}; + +for ii=1:length(dirlist) +addpath ( [ fileparts( mfilename("fullpath")) "/" dirlist{ii}]) +end + +__gmsh = file_in_path (EXEC_PATH, "gmsh"); +if (isempty (__gmsh)) +__gmsh = file_in_path (EXEC_PATH, "gmsh.exe"); +if (isempty (__gmsh)) +warning ("gmsh does not seem to be present some functionalities will be disabled"); +endif +endif +clear __gmsh; + +__dx = file_in_path (EXEC_PATH, "dx"); +if (isempty (__dx)) +__dx = file_in_path (EXEC_PATH, "dx.exe"); +if (isempty (__dx)) +warning ("dx does not seem to be present some functionalities will be disabled"); +endif +endif +clear __dx; +end diff --git a/octave_packages/secs2d-0.0.8/PKG_DEL b/octave_packages/secs2d-0.0.8/PKG_DEL new file mode 100644 index 0000000..62f2788 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/PKG_DEL @@ -0,0 +1,9 @@ + +# Run this only if the package is installed +if (! exist (fullfile (fileparts (mfilename ("fullpath")), "inst"), "dir")) +dirlist= {"Utilities","DDGOX","ThDDGOX","QDDGOX","METLINES","DDGOXT"}; + +for ii=1:length(dirlist) +rmpath ( [ fileparts( mfilename("fullpath")) "/" dirlist{ii}]) +end +end diff --git a/octave_packages/secs2d-0.0.8/QDDGOX/QDDGOXcompdens.m b/octave_packages/secs2d-0.0.8/QDDGOX/QDDGOXcompdens.m new file mode 100644 index 0000000..7a4b8a2 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/QDDGOX/QDDGOXcompdens.m @@ -0,0 +1,173 @@ +function w = QDDGOXcompdens(mesh,Dsides,win,vin,fermiin,d2,toll,maxit,verbose); + +% w = QDDGOXcompdens(mesh,Dsides,win,vin,fermiin,d2,toll,maxit,verbose); + +global QDDGOXCOMPDENS_LAP QDDGOXCOMPDENS_MASS QDDGOXCOMPDENS_RHS +%% Set some usefull constants +VErank = 4; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% convert input vectors to columns +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +if Ucolumns(win)>Urows(win) + win=win'; +end +if Ucolumns(vin)>Urows(vin) + vin=vin'; +end +if Ucolumns(fermiin)>Urows(fermiin) + fermiin=fermiin'; +end + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% convert grid info to FEM form +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +nodes = mesh.p; +Nnodes = size(nodes,2); + +elements = mesh.t(1:3,:); +Nelements = size(elements,2); + +Dedges =[]; + +for ii = 1:length(Dsides) + Dedges=[Dedges,find(mesh.e(5,:)==Dsides(ii))]; +end + +% Set list of nodes with Dirichelet BCs +Dnodes = mesh.e(1:2,Dedges); +Dnodes = [Dnodes(1,:) Dnodes(2,:)]; +Dnodes = unique(Dnodes); + +Dvals = win(Dnodes); + +Varnodes = setdiff([1:Nnodes],Dnodes); +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% initialization: +%% we're going to solve +%% $$ -\delta^2 \Lap w_{k+1} + B'(w_k) \delta w_{k+1} = 2 * w_k$$ +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% set $$ w_1 = win $$ +w = win; +wnew = win; + +%% let's compute FEM approximation of $$ L = - \aleph \frac{d^2}{x^2} $$ +if (isempty(QDDGOXCOMPDENS_LAP)) + QDDGOXCOMPDENS_LAP = Ucomplap (mesh,ones(Nelements,1)); +end +L = d2*QDDGOXCOMPDENS_LAP; + +%% now compute $$ G_k = F - V + 2 V_{th} log(w) $$ +if (isempty(QDDGOXCOMPDENS_MASS)) + QDDGOXCOMPDENS_MASS = Ucompmass2 (mesh,ones(Nnodes,1),ones(Nelements,1)); +end +G = fermiin - vin + 2*log(w); +Bmat = QDDGOXCOMPDENS_MASS*sparse(diag(G)); +nrm = 1; +%%%%%%%%%%%%%%%%%%%%%%%% +%%% NEWTON ITERATION START +%%%%%%%%%%%%%%%%%%%%%%%% +converged = 0; +for jnewt =1:ceil(maxit/VErank) + for k=1:VErank + [w(:,k+1),converged,G,L,Bmat]=onenewtit(w(:,k),G,fermiin,vin,L,Bmat,jnewt,mesh,Dnodes,Varnodes,Dvals,Nnodes,Nelements,toll); + if converged + break + end + end + if converged + break + end + w = Urrextrapolation(w); +end +%%%%%%%%%%%%%%%%%%%%%%%% +%%% NEWTON ITERATION END +%%%%%%%%%%%%%%%%%%%%%%%% +w = w(:,end); + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%% ONE NEWTON ITERATION +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +function [w,converged,G,L,Bmat]=onenewtit(w,G,fermiin,vin,L,Bmat,jnewt,mesh,Dnodes,Varnodes,Dvals,Nnodes,Nelements,toll); + + global QDDGOXCOMPDENS_LAP QDDGOXCOMPDENS_MASS QDDGOXCOMPDENS_RHS + dampit = 5; + dampcoeff = 2; + converged = 0; + wnew = w; + + res0 = norm((L + Bmat) * w,inf); + + + %% chose $ t_k $ to ensure positivity of $w$ + mm = -min(G); + pause(1) + + if (mm>2) + tk = max( 1/(mm)); + else + tk = 1; + end + + tmpmat = QDDGOXCOMPDENS_MASS*2; + if (isempty(QDDGOXCOMPDENS_RHS)) + QDDGOXCOMPDENS_RHS = Ucompconst (mesh,ones(Nnodes,1),ones(Nelements,1)); + end + tmpvect= 2*QDDGOXCOMPDENS_RHS.*w; + + %%%%%%%%%%%%%%%%%%%%%%%% + %%% DAMPING ITERATION START + %%%%%%%%%%%%%%%%%%%%%%%% + for idamp = 1:dampit + %% Compute $ B1mat = \frac{2}{t_k} $ + %% and the (lumped) mass matrix B1mat(w_k) + B1mat = tmpmat/tk; + + %% now we're ready to build LHS matrix and RHS of the linear system for 1st Newton step + A = L + B1mat + Bmat; + b = tmpvect/tk; + + %% Apply boundary conditions + A (Dnodes,:) = 0; + b (Dnodes) = 0; + b = b - A (:,Dnodes) * Dvals; + + A(Dnodes,:)= []; + A(:,Dnodes)= []; + + b(Dnodes) = []; + + + wnew(Varnodes) = A\b; + + + %% compute $$ G_{k+1} = F - V + 2 V_{th} log(w) $$ + G = fermiin - vin + 2*log(wnew); + Bmat = QDDGOXCOMPDENS_MASS*sparse(diag(G)); + + res = norm((L + Bmat) * wnew,inf); + + if (res=1) + fprintf(1,'*****************************************************************\n'); + fprintf(1,'**** start of gummel iteration number: %d\n',i); + fprintf(1,'*****************************************************************\n'); + end + + V(:,2)= V(:,1); + G(:,2)= G(:,1); + Gp(:,2)= Gp(:,1); + n(:,2)= n(:,1); + bohmdeltav=inf; + for j=1:smaxit + if (verbose>=1) + fprintf(1,'*---------------------------------------------------------------*\n'); + fprintf(1,'**** start of Poisson-Bohm iteration number: %d (bohmdeltav=%g)\n',j,bohmdeltav); + fprintf(1,'*---------------------------------------------------------------*\n'); + end + + + if (verbose>1) + fprintf(1,'solving non linear poisson equation\n\n'); + end + + [V(:,3),n(:,2),p(:,2)] =... + QDDGOXnlpoisson (imesh,Dsides,Sinodes,[SiDnodes,Intnodes] ,Sielements,... + V(:,2),n(:,1),p(:,1),Fn(:,1),Fp(:,1),G(:,2)+FDn,Gp(:,2)+FDp,D,... + idata.l2,idata.l2ox,ptoll,pmaxit,verbose-1); + + n([SiDnodes,Intnodes],2) = idata.n([SiDnodes,Intnodes]); + p([SiDnodes,Intnodes],2) = idata.p([SiDnodes,Intnodes]); + V(Dnodes,3) = idata.V(Dnodes); + + if (verbose>1) + fprintf(1,'solving non linear Bohm equation for electrons\n\n'); + end + n(Intnodes,2) = idata.n(Intnodes); + + + w = QDDGOXcompdens(Simesh,[SiDsides,Intsides],sqrt(n(:,2)),V(Sinodes,3) + FDn,Fn(:,1),idata.dn2,stoll,smaxit,verbose-1); + n(:,2) = w.^2; + n([SiDnodes,Intnodes],2) = idata.n([SiDnodes,Intnodes]); + G(:,3) = Fn(:,1) - V(Sinodes,3) - FDn + log(n(:,2)); + if (verbose>1) + fprintf(1,'solving non linear Bohm equation for holes\n\n'); + end + + if (options.holes==1) + + p(Intnodes,2) = idata.p(Intnodes); + wp = QDDGOXcompdens(Simesh,[SiDsides,Intsides],sqrt(p(:,2)),-V(Sinodes,3) - FDp,... + -Fp(:,1),idata.dp2,ptoll,pmaxit,verbose-1); + p(:,2) = wp.^2; + p([SiDnodes,Intnodes],2) = idata.p([SiDnodes,Intnodes]); + Gp(:,3) = Fp(:,1) - V(Sinodes,3) - FDp - log(p(:,2)); + + else + Gp(:,3)=G(:,3)*0; + end + + + if (options.FD==1) + fprintf(1,'\n*** APPLYING FD STATISTICS ***\n') + n(:,2) = idata.Nc*Ufermidirac(V(Sinodes,3)+G(:,3)-Fn(:,1)-log(idata.Nc),1/2); + n(SiDnodes,2) = idata.n(SiDnodes); + nMBtmp = exp(V(Sinodes,3)+G(:,3)-Fn(:,1)); + FDn = log(n(:,2)./ nMBtmp); + FDn(SiDnodes) = idata.FDn(SiDnodes); + + p(:,2) = idata.Nv*Ufermidirac(-V(Sinodes,3)-Gp(:,3)+Fp(:,1)-log(idata.Nv),1/2); + p([SiDnodes,Intnodes],2) = idata.p([SiDnodes,Intnodes]); + pMBtmp = exp(-V(Sinodes,3)-Gp(:,3)+Fp(:,1)); + FDp = -log(p(:,2)./ pMBtmp); + FDp(SiDnodes) = idata.FDp(SiDnodes); + end + + bohmdeltav = norm(G(:,3)-G(:,2),inf) +... + norm(Gp(:,3)-Gp(:,2),inf) +... + norm(V(:,3)-V(:,2),inf); + + + %%%% store result for RRE + if RREpattern2(j)>0 + Gstore(:,RREpattern2(j)) = G(:,3); + if RREpattern2(j+1)==0 % Apply RRE extrapolation + G(:,3) = Urrextrapolation(Gstore); + end + end + + G(:,2)=G(:,3); + Gp(:,2)=Gp(:,3); + + + V(:,2)=V(:,3); + + + if (bohmdeltav<=stoll) + if (verbose>1) + fprintf(1,'Exiting poisson-bohm iteration because bohmdeltav=%g\n\n',bohmdeltav); + end + break; + end + end + + if (verbose>1) + fprintf (1,'\n\nupdating electron qfl\n\n'); + end + + mob = Ufielddepmob(Simesh,idata.un,Fn(:,1), ... + idata.vsatn,idata.mubn); + + + n(:,3) = DDGOXelectron_driftdiffusion(Simesh,SiDsides,n(:,2),p(:,2),... + V(Sinodes,3)+G(:,3)+FDn,mob,... + tn,tp,idata.n0,idata.p0); + + + Fn(:,2) = V(Sinodes,3) + G(:,3) + FDn - log(n(:,3)); + Fn(SiDnodes,2) = idata.Fn(SiDnodes); + n([SiDnodes,Intnodes],3) = idata.n([SiDnodes,Intnodes]); + + %%%% store result for RRE + if RREpattern(i)>0 + Fnstore(:,RREpattern(i)) = Fn(:,2); + if RREpattern(i+1)==0 % Apply RRE extrapolation + Fn(:,2) = Urrextrapolation(Fnstore); + end + end + + if (verbose>1) + fprintf(1,'updating hole qfl\n\n'); + end + + mob = Ufielddepmob(Simesh,idata.up,Fp(:,1),idata.vsatp,idata.mubp); + p(:,3) =DDGOXhole_driftdiffusion(Simesh,SiDsides,n(:,3),p(:,2),... + V(Sinodes,3)+Gp(:,3)+FDp,mob,... + tn,tp,idata.n0,idata.p0); + + + if (options.holes==1) + Fp(:,2)=V(Sinodes,3) + Gp(:,3) + FDp + log(p(:,3)); + p([SiDnodes,Intnodes],3) = idata.p([SiDnodes,Intnodes]); + else + Fp(:,2)=Fn(:,2) + 2 * log(idata.ni); + p(:,3) = exp(Fp(:,2)-V(Sinodes,3)-FDp); + p([SiDnodes],3) = idata.p([SiDnodes]); + end + Fp(SiDnodes,2) = idata.Fp(SiDnodes); + + if (verbose>1) + fprintf(1,'checking for convergence\n\n'); + end + + nrfn= norm(Fn(:,2)-Fn(:,1),inf); + nrfp= norm (Fp(:,2)-Fp(:,1),inf); + nrv = norm (V(:,3)-V(:,1),inf); + nrg = norm (G(:,3)-G(:,1),inf); + nrgp = norm (Gp(:,3)-Gp(:,1),inf); + nrm(i) = max([nrfn;nrfp;nrv;nrg;nrgp]); + + figure(2) + semilogy(nrm) + pause(.1) + + + if (verbose>1) + fprintf (1,' max(|phin_(k+1)-phinn_(k)| , |phip_(k+1)-phip_(k)| , |v_(k+1)-v_(k)| |g_(k+1)-g_(k)|)= %d\n',nrm(i)); + end + if (nrm(i)0) + fprintf(1,'\n\nDD: # of Gummel iterations = %d\n\n',it); +end + +odata = idata; + +odata.n = n(:,end); +odata.p = p(:,end); +odata.V = V(:,end); +odata.Fn = Fn(:,end); +odata.Fp = Fp(:,end); +odata.G = G(:,end); +odata.Gp = Gp(:,end); + + diff --git a/octave_packages/secs2d-0.0.8/QDDGOX/QDDGOXnlpoisson.m b/octave_packages/secs2d-0.0.8/QDDGOX/QDDGOXnlpoisson.m new file mode 100644 index 0000000..e623b85 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/QDDGOX/QDDGOXnlpoisson.m @@ -0,0 +1,244 @@ +function [V,n,p,res,niter] = QDDGOXnlpoisson (mesh,Dsides,Sinodes,SiDnodes,... + Sielements,Vin,nin,pin,... + Fnin,Fpin,Gin,Gpin,D,l2,l2ox,... + toll,maxit,verbose) + +% +% [V,n,p,res,niter] = QDDGOXnlpoisson (mesh,Dsides,Sinodes,SiDnodes,... +% Sielements,Vin,nin,pin,... +% Fnin,Fpin,Gin,Gpin,D,l2,l2ox,... +% toll,maxit,verbose) +% +% solves $$ -\lambda^2 V'' + (n(V,Fn) - p(V,Fp) -D)$$ +% + +global DDGOXNLPOISSON_LAP DDGOXNLPOISSON_MASS DDGOXNLPOISSON_RHS + +%% Set some useful constants +dampit = 3; +dampcoeff = 2; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% convert input vectors to columns +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +if Ucolumns(D)>Urows(D) + D=D'; +end + + +if Ucolumns(nin)>Urows(nin) + nin=nin'; +end + +if Ucolumns(pin)>Urows(pin) + pin=pin'; +end + +if Ucolumns(Vin)>Urows(Vin) + Vin=Vin'; +end + +if Ucolumns(Fnin)>Urows(Fnin) + Fnin=Fnin'; +end + +if Ucolumns(Fpin)>Urows(Fpin) + Fpin=Fpin'; +end +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% setup FEM data structures +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +nodes=mesh.p; +elements=mesh.t; +Nnodes = length(nodes); +Nelements = length(elements); + +Dedges =[]; + +for ii = 1:length(Dsides) + Dedges=[Dedges,find(mesh.e(5,:)==Dsides(ii))]; +end + +% Set list of nodes with Dirichelet BCs +Dnodes = mesh.e(1:2,Dedges); +Dnodes = [Dnodes(1,:) Dnodes(2,:)]; +Dnodes = unique(Dnodes); + +% Set values of Dirichelet BCs +Bc = zeros(length(Dnodes),1); +% Set list of nodes without Dirichelet BCs +Varnodes = setdiff([1:Nnodes],Dnodes); + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% initialization: +%% we're going to solve +%% $$ - \lambda^2 (\delta V)'' + (\frac{\partial n}{\partial V} - \frac{\partial p}{\partial V})= -R $$ +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% set $$ n_1 = nin $$ and $$ V = Vin $$ +V = Vin; +Fn = Fnin; +Fp = Fpin; +G = Gin; +Gp = Gpin; +n = exp(V(Sinodes)+G-Fn); +p = exp(-V(Sinodes)-Gp+Fp); +n(SiDnodes) = nin(SiDnodes); +p(SiDnodes) = pin(SiDnodes); + + +%%% +%%% Compute LHS matrices +%%% + +%% let's compute FEM approximation of $$ L = - \frac{d^2}{x^2} $$ +if (isempty(DDGOXNLPOISSON_LAP)) + coeff = l2ox * ones(Nelements,1); + coeff(Sielements)=l2; + DDGOXNLPOISSON_LAP = Ucomplap (mesh,coeff); +end + +%% compute $$ Mv = ( n + p) $$ +%% and the (lumped) mass matrix M +if (isempty(DDGOXNLPOISSON_MASS)) + Cvect = zeros(Nelements,1); + Cvect(Sielements)=1; + DDGOXNLPOISSON_MASS = Ucompmass2 (mesh,ones(Nnodes,1),Cvect); +end +freecarr=zeros(Nnodes,1); +freecarr(Sinodes)=(n + p); +Mv = freecarr; +MV(SiDnodes) = 0; +M = DDGOXNLPOISSON_MASS*sparse(diag(Mv)); + +%%% +%%% Compute RHS vector (-residual) +%%% + +%% now compute $$ T0 = \frac{q}{\epsilon} (n - p - D) $$ +if (isempty(DDGOXNLPOISSON_RHS)) + DDGOXNLPOISSON_RHS = Ucompconst (mesh,ones(Nnodes,1),ones(Nelements,1)); +end +totcharge = zeros(Nnodes,1); +totcharge(Sinodes)=(n - p - D); +Tv0 = totcharge; +T0 = Tv0 .* DDGOXNLPOISSON_RHS; + +%% now we're ready to build LHS matrix and RHS of the linear system for 1st Newton step +A = DDGOXNLPOISSON_LAP + M; +R = DDGOXNLPOISSON_LAP * V + T0; + +%% Apply boundary conditions +A (Dnodes,:) = []; +A (:,Dnodes) = []; +R(Dnodes) = []; + +%% we need $$ \norm{R_1} $$ and $$ \norm{R_k} $$ for the convergence test +normr(1) = norm(R,inf); +relresnorm = 1; +reldVnorm = 1; +normrnew = normr(1); +dV = V*0; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% START OF THE NEWTON CYCLE +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +for newtit=1:maxit + if (verbose>0) + fprintf(1,'\n***\nNewton iteration: %d, reldVnorm = %e\n***\n',newtit,reldVnorm); + + end + + dV(Varnodes) =(A)\(-R); + dV(Dnodes)=0; + + + %%%%%%%%%%%%%%%%%% + %% Start of th damping procedure + %%%%%%%%%%%%%%%%%% + tk = 1; + for dit = 1:dampit + if (verbose>0) + fprintf(1,'\ndamping iteration: %d, residual norm = %e\n',dit,normrnew); + end + Vnew = V + tk * dV; + + n = exp(Vnew(Sinodes)+G-Fn); + p = exp(-Vnew(Sinodes)-Gp+Fp); + n(SiDnodes) = nin(SiDnodes); + p(SiDnodes) = pin(SiDnodes); + + + %%% + %%% Compute LHS matrices + %%% + + %% let's compute FEM approximation of $$ L = - \frac{d^2}{x^2} $$ + %L = Ucomplap (mesh,ones(Nelements,1)); + + %% compute $$ Mv = ( n + p) $$ + %% and the (lumped) mass matrix M + freecarr=zeros(Nnodes,1); + freecarr(Sinodes)=(n + p); + Mv = freecarr; + M = DDGOXNLPOISSON_MASS*sparse(diag(Mv));%M = Ucompmass (mesh,Mv); + + %%% + %%% Compute RHS vector (-residual) + %%% + + %% now compute $$ T0 = \frac{q}{\epsilon} (n - p - D) $$ + totcharge( Sinodes)=(n - p - D); + Tv0 = totcharge; + T0 = Tv0 .* DDGOXNLPOISSON_RHS;%T0 = Ucompconst (mesh,Tv0,ones(Nelements,1)); + + %% now we're ready to build LHS matrix and RHS of the linear system for 1st Newton step + A = DDGOXNLPOISSON_LAP + M; + R = DDGOXNLPOISSON_LAP * Vnew + T0; + + %% Apply boundary conditions + A (Dnodes,:) = []; + A (:,Dnodes) = []; + R(Dnodes) = []; + + %% compute $$ | R_{k+1} | $$ for the convergence test + normrnew= norm(R,inf); + + % check if more damping is needed + if (normrnew > normr(newtit)) + tk = tk/dampcoeff; + else + if (verbose>0) + fprintf(1,'\nexiting damping cycle because residual norm = %e \n-----------\n',normrnew); + end + break + end + end + + V = Vnew; + normr(newtit+1) = normrnew; + dVnorm = norm(tk*dV,inf); + pause(.1); + % check if convergence has been reached + reldVnorm = dVnorm / norm(V,inf); + if (reldVnorm <= toll) + if(verbose>0) + fprintf(1,'\nexiting newton cycle because reldVnorm= %e \n',reldVnorm); + end + break + end + +end + +res = normr; +niter = newtit; + + + diff --git a/octave_packages/secs2d-0.0.8/QDDGOX/doc-cache b/octave_packages/secs2d-0.0.8/QDDGOX/doc-cache new file mode 100644 index 0000000..4efa2f2 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/QDDGOX/doc-cache @@ -0,0 +1,111 @@ +# Created by Octave 3.6.1, Sun Mar 25 18:44:37 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 4 +# name: +# type: sq_string +# elements: 1 +# length: 14 +QDDGOXcompdens + + +# name: +# type: sq_string +# elements: 1 +# length: 73 + w = QDDGOXcompdens(mesh,Dsides,win,vin,fermiin,d2,toll,maxit,verbose); + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 + w = QDDGOXcompdens(mesh,Dsides,win,vin,fermiin,d2,toll,maxit,verbose); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +QDDGOXddcurrent + + +# name: +# type: sq_string +# elements: 1 +# length: 62 + [current,divrg]=QDDGOXddcurrent(mesh,Sinodes,data,contacts); + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 + [current,divrg]=QDDGOXddcurrent(mesh,Sinodes,data,contacts); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +QDDGOXgummelmap + + +# name: +# type: sq_string +# elements: 1 +# length: 171 + [odata,it,res] = QDDGOXgummelmap (imesh,Dsides,... + Simesh,Sinodes,Sielements,SiDsides,Intsides,... + idata,toll,maxit,ptoll,pmaxit,stoll,smaxit,verbose,options); + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 + [odata,it,res] = QDDGOXgummelmap (imesh,Dsides,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +QDDGOXnlpoisson + + +# name: +# type: sq_string +# elements: 1 +# length: 227 + + [V,n,p,res,niter] = QDDGOXnlpoisson (mesh,Dsides,Sinodes,SiDnodes,... + Sielements,Vin,nin,pin,... + Fnin,Fpin,Gin,Gpin,D,l2,l2ox,... + toll,maxit,verbose) + + solves $$ -\lambda^2 V'' + (n(V,Fn) - p(V,Fp) -D)$$ + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 + + [V,n,p,res,niter] = QDDGOXnlpoisson (mesh,Dsides,Sinodes,SiDnodes,. + + + + + diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBN0STD.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBN0STD.m new file mode 100644 index 0000000..15e7855 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBN0STD.m @@ -0,0 +1,6 @@ +function x = ThDDGOXMOBN0STD (imesh,Simesh,Sinodes,Sielements,idata) + Nnodes = columns(Simesh.p); + Nelements = columns(Simesh.t); + x = idata.un * ones(Nelements,1); +endfunction + diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBN1STD.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBN1STD.m new file mode 100644 index 0000000..3b9abbf --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBN1STD.m @@ -0,0 +1,5 @@ +function x = ThDDGOXMOBN1STD (imesh,Simesh,Sinodes,Sielements,idata) + Nnodes = columns(Simesh.p); + Nelements = columns(Simesh.t); + x = idata.Tl./idata.Tn; +endfunction diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBP0STD.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBP0STD.m new file mode 100644 index 0000000..e90659b --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBP0STD.m @@ -0,0 +1,6 @@ +function x = ThDDGOXMOBP0STD (imesh,Simesh,Sinodes,Sielements,idata) + Nnodes = columns(Simesh.p); + Nelements = columns(Simesh.t); + x = idata.up * ones(Nelements,1); +endfunction + diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBP1STD.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBP1STD.m new file mode 100644 index 0000000..46a1bc2 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXMOBP1STD.m @@ -0,0 +1,5 @@ +function x = ThDDGOXMOBP1STD (imesh,Simesh,Sinodes,Sielements,idata) + Nnodes = columns(Simesh.p); + Nelements = columns(Simesh.t); + x = idata.Tl./idata.Tp; +endfunction diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWN0STD.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWN0STD.m new file mode 100644 index 0000000..c98bfc6 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWN0STD.m @@ -0,0 +1,6 @@ +function x = ThDDGOXTWN0STD (imesh,Simesh,Sinodes,Sielements,idata) + Nnodes = columns(Simesh.p); + Nelements = columns(Simesh.t); + x = 1.5 * idata.un * ones(Nelements,1) ./ idata.vsatn^2; +endfunction + diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWN1STD.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWN1STD.m new file mode 100644 index 0000000..3314bbd --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWN1STD.m @@ -0,0 +1,6 @@ +function x = ThDDGOXTWN1STD (imesh,Simesh,Sinodes,Sielements,idata) + Nnodes = columns(Simesh.p); + Nelements = columns(Simesh.t); + x = idata.Tl./(1+idata.Tl./idata.Tn); +endfunction + diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWP0STD.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWP0STD.m new file mode 100644 index 0000000..d0fa39e --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWP0STD.m @@ -0,0 +1,6 @@ +function x = ThDDGOXTWP0STD (imesh,Simesh,Sinodes,Sielements,idata) + Nnodes = columns(Simesh.p); + Nelements = columns(Simesh.t); + x = 1.5 * idata.up * ones(Nelements,1) ./ idata.vsatp^2; +endfunction + diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWP1STD.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWP1STD.m new file mode 100644 index 0000000..4cc488e --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXTWP1STD.m @@ -0,0 +1,5 @@ +function x = ThDDGOXTWP1STD (imesh,Simesh,Sinodes,Sielements,idata) + Nnodes = columns(Simesh.p); + Nelements = columns(Simesh.t); + x = idata.Tl./(1+idata.Tl./idata.Tp); +endfunction diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXddcurrent.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXddcurrent.m new file mode 100644 index 0000000..fa217b4 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXddcurrent.m @@ -0,0 +1,54 @@ +function [current,divrg]=ThDDGOXddcurrent(Simesh,Sinodes,data,contacts); + +% [current,divrg]=DDGOXddcurrent(Simesh,Sinodes,data,contacts); + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +load (file_in_path(path,'constants.mat')) + + +Nelements = size(mesh.t,2); +mobn0 = thermdata.mobn0([],Simesh,Sinodes,[],data); +mobp0 = thermdata.mobp0([],Simesh,Sinodes,[],data); +mobn1 = thermdata.mobn1([],Simesh,Sinodes,[],data); +mobp1 = thermdata.mobp1([],Simesh,Sinodes,[],data); +An = Uscharfettergummel3(Simesh,mobn0,mobn1,data.Tn,data.V(Sinodes)-data.Tn); +Ap = Uscharfettergummel3(Simesh,mobp0,mobp1,data.Tp,-data.V(Sinodes)-data.Tn); +divrg = An * data.n + Ap * data.p; + +for con = 1:length(contacts) + + cedges = []; + cedges=[cedges,find(mesh.e(5,:)==contacts(con))]; + cnodes = mesh.e(1:2,cedges); + cnodes = [cnodes(1,:) cnodes(2,:)]; + cnodes = unique(cnodes); + + current(con) = sum(divrg(cnodes)); + +end + +Is = q*data.us*data.Vs*data.ns; +current = current * Is; + + diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXelectron_driftdiffusion.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXelectron_driftdiffusion.m new file mode 100644 index 0000000..f73c4dc --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXelectron_driftdiffusion.m @@ -0,0 +1,48 @@ +function n=ThDDGOXelectron_driftdiffusion(mesh,Dnodes,n,pin,V,... + Tn,mobn0,mobn1,tn,tp,n0,p0) + + %% + %% n=ThDDGOXelectron_driftdiffusion(mesh,Dnodes,n,pin,V,Tn,un0,un1,tn,tp,n0,p0) + %% + + %% This file is part of + %% + %% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator + %% ------------------------------------------------------------------- + %% Copyright (C) 2004-2006 Carlo de Falco + %% + %% + %% + %% SECS2D is free software; you can 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. + %% + %% SECS2D is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied warranty of + %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + %% GNU General Public License for more details. + %% + %% You should have received a copy of the GNU General Public License + %% along with SECS2D; If not, see . + + Nnodes = columns(mesh.p); + Nelements = columns(mesh.t); + Varnodes = setdiff(1:Nnodes,Dnodes); + + alpha = mobn0; + gamma = mobn1; + eta = Tn; + beta = V-Tn; + Dn = Uscharfettergummel3(mesh,alpha,gamma,eta,beta); + + denom = (tp*(n+sqrt(n0.*p0))+tn*(pin+sqrt(n0.*p0))); + MASS_LHS = Ucompmass2(mesh,pin./denom,ones(Nelements,1)); + + LHS = Dn+MASS_LHS; + + RHS = Ucompconst (mesh,p0.*n0./denom,ones(Nelements,1)); + + n(Varnodes) = LHS(Varnodes,Varnodes) \(RHS(Varnodes) -... + LHS(Varnodes,Dnodes)*n(Dnodes)); + diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXeletiteration.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXeletiteration.m new file mode 100644 index 0000000..f185f79 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXeletiteration.m @@ -0,0 +1,147 @@ +function [odata,nrm]=ThDDGOXeletiteration(imesh,Dsides,... + Simesh,Sinodes,Sielements,SiDsides,... + idata,toll,maxit,ptoll,pmaxit,verbose) + + ## function [odata,nrm]=ThDDGOXeletiteration(imesh,Dsides,... + ## Simesh,Sinodes,Sielements,SiDsides,areaSi,SiPatch,... + ## idata,toll,maxit,ptoll,pmaxit,verbose) + + + global DDGOXNLPOISSON_LAP DDGOXNLPOISSON_MASS DDGOXNLPOISSON_RHS DDG_RHS DDG_MASS + + %%%%%%%%%%%%%%% + %% RRE param %% + RREnnit = [1,2]; + RRErank = 7; + RREpattern = URREcyclingpattern(RREnnit,RRErank,maxit); + %%%%%%%%%%%%%%% + + odata = idata; + V(:,1) = idata.V; + Fn(:,1) = idata.Fn; + Fp(:,1) = idata.Fp; + n(:,1) = idata.n; + p(:,1) = idata.p; + Tl = idata.Tl; + Tn = idata.Tn; + Tp = idata.Tp; + + %% Set list of nodes with Dirichlet BCs + Dnodes = Unodesonside(imesh,Dsides); + SiDnodes = Unodesonside(Simesh,SiDsides); + + SiNelements = columns(Simesh.t); + D = idata.D; + + nrm = 1; + + for ielet=1:maxit + + if (verbose>=1) + fprintf(1,"*** start of inner iteration number: %d\n",ielet); + end + + if (verbose>=1) + fprintf(1,"\t*** solving non linear poisson equation\n"); + end + + + + Fnshift = log(idata.ni) .* (1-Tn); + Fpshift = -log(idata.ni) .* (1-Tp); + + [V(:,2),n(:,2),p(:,2)] = ThDDGOXnlpoisson (imesh,Dsides,Sinodes,SiDnodes,Sielements,... + V(:,1),Tn,Tp,... + n(:,1),p(:,1),Fn(:,1)+Fnshift,Fp(:,1)+Fpshift,D,... + idata.l2,idata.l2ox,ptoll,pmaxit,verbose-1); + + V(Dnodes,2) = idata.V(Dnodes); + + if (verbose>=1) + fprintf (1,"\t***\tupdating electron qfl\n"); + end + + odata.V = V(:,2); + odata.n = n(:,2); + odata.p = p(:,2); + mobn0 = idata.mobn0(imesh,Simesh,Sinodes,Sielements,odata); + mobp0 = idata.mobp0(imesh,Simesh,Sinodes,Sielements,odata); + mobn1 = idata.mobn1(imesh,Simesh,Sinodes,Sielements,odata); + mobp1 = idata.mobp1(imesh,Simesh,Sinodes,Sielements,odata); + + n(:,3) = ThDDGOXelectron_driftdiffusion(Simesh,SiDnodes,n(:,2),p(:,2),... + V(Sinodes,2),Tn,mobn0,mobn1,... + idata.tn,idata.tp,idata.ni,idata.ni); + + Fn(:,2)=V(Sinodes,2) - Tn .* log(n(:,3)) - Fnshift; + n(SiDnodes,3) = idata.n(SiDnodes); + Fn(SiDnodes,2) = idata.Fn(SiDnodes); + + if (verbose>=1) + fprintf(1,"\t***\tupdating hole qfl\n"); + end + + p(:,3) = ThDDGOXhole_driftdiffusion(Simesh,SiDnodes,n(:,3),p(:,2),... + V(Sinodes,2),Tp,mobp0,mobp1,... + idata.tn,idata.tp,idata.ni,idata.ni); + + Fp(:,2)= V(Sinodes,2) + Tp .* log(p(:,3)) - Fpshift; + p(SiDnodes,3) = idata.p(SiDnodes); + Fp(SiDnodes,2) = idata.Fp(SiDnodes); + + ## store result for RRE + if RREpattern(ielet)>0 + Fermistore(:,RREpattern(ielet)) = [Fn(:,2);Fp(:,2)]; + if RREpattern(ielet+1)==0 % Apply RRE extrapolation + if (verbose>=1) + fprintf(1,"\n\t**********\n\tRRE EXTRAPOLATION STEP\n\t**********\n\n"); + end + Fermi = Urrextrapolation(Fermistore); + Fn(:,2) = Fermi(1:rows(Fn)); + Fp(:,2) = Fermi(rows(Fn)+1:end); + end + end + + if (verbose>=1) + fprintf(1,"*** checking for convergence: "); + end + + nrfn= norm (Fn(:,2)-Fn(:,1),inf); + nrfp= norm (Fp(:,2)-Fp(:,1),inf); + nrv = norm (V(:,2)-V(:,1),inf); + nrm(ielet) = max([nrfn;nrfp;nrv]); + + if (verbose>=1) + subplot(1,3,3); + semilogy(nrm) + %%title("max(|dV|,|dFn|,|dFp|)"); + pause(.1) + end + + if (verbose>=1) + fprintf (1," max(|dFn|,|dFp|,|dV| )= %g\n\n",... + nrm(ielet)); + end + if (nrm(ielet)0) + fprintf(1,"\n*** DD simulation over: # of electrical Gummel iterations = %d\n\n",ielet); +end + +odata = idata; + +odata.n = n(:,end); +odata.p = p(:,end); +odata.V = V(:,end); +odata.Fn = Fn(:,end); +odata.Fp = Fp(:,end); diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXgummelmap.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXgummelmap.m new file mode 100644 index 0000000..4e0ff7d --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXgummelmap.m @@ -0,0 +1,69 @@ +function [odata,ith,res] = ThDDGOXgummelmap (imesh,Dsides,... + Simesh,Sinodes,Sielements,SiDsides,... + idata,tol,maxit,ptol,pmaxit,thtol,thmaxit,... + eltol,elmaxit,verbose) + + ## [odata,it,res] = ThDDGOXgummelmap (imesh,Dsides,... + ## Simesh,Sinodes,Sielements,SiDsides,... + ## idata,tol,maxit,ptol,pmaxit,thtol,thmaxit,... + ## eltol,elmaxit,verbose) + + clear DDGOXNLPOISSON_LAP DDGOXNLPOISSON_MASS DDGOXNLPOISSON_RHS DDG_RHS DDG_MASS + global DDGOXNLPOISSON_LAP DDGOXNLPOISSON_MASS DDGOXNLPOISSON_RHS DDG_RHS DDG_MASS + + eletdata = idata; + thermdata = idata; + nrm = 1; + eletnrm = []; + thermnrm = []; + + for ith=1:maxit + + eletdata.Tl = thermdata.Tl; + eletdata.Tn = thermdata.Tn; + eletdata.Tp = thermdata.Tp; + + if (verbose>=1) + fprintf(1,'\n***\n***\tupdating potentials\n***\n'); + end + + [eletdata,innrm1]=ThDDGOXeletiteration(imesh,Dsides,... + Simesh,Sinodes,Sielements,SiDsides,... + eletdata,eltol,elmaxit,ptol,pmaxit,verbose); + eletnrm = [eletnrm,innrm1]; + + thermdata.n = eletdata.n; + thermdata.p = eletdata.p; + thermdata.V = eletdata.V; + + if (verbose>=1) + fprintf(1,'\n***\n***\tupdating temperatures\n***\n'); + end + + [thermdata,innrm] = ThDDGOXthermaliteration(imesh,Dsides,... + Simesh,Sinodes,Sielements,SiDsides,... + thermdata,thtol,thmaxit,2); + + + thermnrm = [eletnrm,innrm]; + + nrm(ith) = max([innrm,innrm1]); + if (verbose>=1) + subplot(1,3,1); + semilogy(nrm) + pause(.1) + end + if (nrm(ith)0) + fprintf(1,"\n***\n***\tThDD simulation over: # \ +of Global iterations = %d\n***\n",ith); + end + break + end + + + end + + res = {nrm,eletnrm,thermnrm}; + odata = thermdata; + \ No newline at end of file diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXhole_driftdiffusion.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXhole_driftdiffusion.m new file mode 100644 index 0000000..b7303c7 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXhole_driftdiffusion.m @@ -0,0 +1,47 @@ +function p=ThDDGOXhole_driftdiffusion(mesh,Dnodes,nin,p,V,... + Tp,mobp0,mobp1,tn,tp,n0,p0) + %% + %% p=ThDDGOXhole_driftdiffusion(mesh,Dnodes,nin,p,V,Tp,monp0,mobp1,tn,tp,n0,p0) + %% + + %% This file is part of + %% + %% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator + %% ------------------------------------------------------------------- + %% Copyright (C) 2004-2006 Carlo de Falco + %% + %% + %% + %% SECS2D is free software; you can 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. + %% + %% SECS2D is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied warranty of + %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + %% GNU General Public License for more details. + %% + %% You should have received a copy of the GNU General Public License + %% along with SECS2D; If not, see . + + Nnodes = columns(mesh.p); + Nelements = columns(mesh.t); + Varnodes = setdiff(1:Nnodes,Dnodes); + + alpha = mobp0; + gamma = mobp1; + eta = Tp; + beta = -V-Tp; + Dp = Uscharfettergummel3(mesh,alpha,gamma,eta,beta); + + denom = (tp*(nin+sqrt(n0.*p0))+tn*(p+sqrt(n0.*p0))); + MASS_LHS = Ucompmass2(mesh,nin./denom,ones(Nelements,1)); + + LHS = Dp+MASS_LHS; + + RHS = Ucompconst (mesh,p0.*n0./denom,ones(Nelements,1)); + + p(Varnodes) = LHS(Varnodes,Varnodes) \(RHS(Varnodes) -... + LHS(Varnodes,Dnodes)*p(Dnodes)); + diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXnlpoisson.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXnlpoisson.m new file mode 100644 index 0000000..a6d2baf --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXnlpoisson.m @@ -0,0 +1,229 @@ +function [V,n,p,res,niter] = ThDDGOXnlpoisson (mesh,Dsides,Sinodes,SiDnodes,... + Sielements,Vin,Vthn,Vthp,... + nin,pin,... + Fnin,Fpin,D,l2,l2ox,... + toll,maxit,verbose) + + %% + %% [V,n,p,res,niter] = DDGOXnlpoisson (mesh,Dsides,Sinodes,Vin,nin,pin,... + %% Fnin,Fpin,D,l2,l2ox,toll,maxit,verbose) + %% + %% solves $$ -\lambda^2 V'' + (n(V,Fn,Tn) - p(V,Fp,Tp) -D) = 0$$ + %% + + + %% This file is part of + %% + %% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator + %% ------------------------------------------------------------------- + %% Copyright (C) 2004-2006 Carlo de Falco + %% + %% + %% + %% SECS2D is free software; you can 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. + %% + %% SECS2D is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied warranty of + %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + %% GNU General Public License for more details. + %% + %% You should have received a copy of the GNU General Public License + %% along with SECS2D; If not, see . + + global DDGOXNLPOISSON_LAP DDGOXNLPOISSON_MASS DDGOXNLPOISSON_RHS + + %% Set some useful constants + dampit = 3; + dampcoeff = 2; + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %% setup FEM data structures + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + nodes=mesh.p; + elements=mesh.t; + Nnodes = length(nodes); + Nelements = length(elements); + + % Set list of nodes with Dirichelet BCs + Dnodes = Unodesonside(mesh,Dsides); + + % Set values of Dirichelet BCs + Bc = zeros(length(Dnodes),1); + % Set list of nodes without Dirichelet BCs + Varnodes = setdiff([1:Nnodes],Dnodes); + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %% + %% initialization: + %% we're going to solve + %% $$ - \lambda^2 (\delta V)'' + %% + (\frac{\partial n}{\partial V} + %% - \frac{\partial p}{\partial V})= -R $$ + %% + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + %% set $$ n_1 = nin $$ and $$ V = Vin $$ + V = Vin; + Fn = Fnin; + Fp = Fpin; + n = exp((V(Sinodes)-Fn)./Vthn); + p = exp((-V(Sinodes)+Fp)./Vthp); + n(SiDnodes) = nin(SiDnodes); + p(SiDnodes) = pin(SiDnodes); + + + %%% + %%% Compute LHS matrices + %%% + + %% let's compute FEM approximation of $$ L = - \frac{d^2}{x^2} $$ + if (isempty(DDGOXNLPOISSON_LAP)) + coeff = l2ox * ones(Nelements,1); + coeff(Sielements)=l2; + DDGOXNLPOISSON_LAP = Ucomplap (mesh,coeff); + end + + %% compute $$ Mv = ( n + p) $$ + %% and the (lumped) mass matrix M + if (isempty(DDGOXNLPOISSON_MASS)) + coeffe = zeros(Nelements,1); + coeffe(Sielements)=1; + DDGOXNLPOISSON_MASS = Ucompmass2(mesh,ones(Nnodes,1),coeffe); + end + freecarr=zeros(Nnodes,1); + freecarr(Sinodes)=(n./Vthn + p./Vthp); + Mv = freecarr; + M = DDGOXNLPOISSON_MASS*spdiag(Mv); + + %%% + %%% Compute RHS vector (-residual) + %%% + + %% now compute $$ T0 = \frac{q}{\epsilon} (n - p - D) $$ + if (isempty(DDGOXNLPOISSON_RHS)) + coeffe = zeros(Nelements,1); + coeffe(Sielements)=1; + DDGOXNLPOISSON_RHS = Ucompconst (mesh,ones(Nnodes,1),coeffe); + end + totcharge = zeros(Nnodes,1); + totcharge(Sinodes)=(n - p - D); + Tv0 = totcharge; + T0 = Tv0 .* DDGOXNLPOISSON_RHS; + + %% now we're ready to build LHS matrix and RHS of the linear system for 1st Newton step + A = DDGOXNLPOISSON_LAP + M; + R = DDGOXNLPOISSON_LAP * V + T0; + + %% Apply boundary conditions + A (Dnodes,:) = []; + A (:,Dnodes) = []; + R(Dnodes) = []; + + %% we need $$ \norm{R_1} $$ and $$ \norm{R_k} $$ for the convergence test + normr(1) = norm(R,inf); + relresnorm = 1; + reldVnorm = 1; + normrnew = normr(1); + dV = V*0; + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %% + %% START OF THE NEWTON CYCLE + %% + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + for newtit=1:maxit + if (verbose>2) + fprintf(1,'\n***\nNewton iteration: %d, reldVnorm = %e\n***\n',newtit,reldVnorm); + end + + % A(1,end)=realmin; + dV(Varnodes) =(A)\(-R); + dV(Dnodes)=0; + + + %%%%%%%%%%%%%%%%%% + %% Start of th damping procedure + %%%%%%%%%%%%%%%%%% + tk = 1; + for dit = 1:dampit + if (verbose>2) + fprintf(1,'\ndamping iteration: %d, residual norm = %e\n',dit,normrnew); + end + Vnew = V + tk * dV; + + n = exp((Vnew(Sinodes)-Fn)./Vthn); + p = exp((-Vnew(Sinodes)+Fp)./Vthp); + n(SiDnodes) = nin(SiDnodes); + p(SiDnodes) = pin(SiDnodes); + + + %%% + %%% Compute LHS matrices + %%% + + %% let's compute FEM approximation of $$ L = - \frac{d^2}{x^2} $$ + %L = Ucomplap (mesh,ones(Nelements,1)); + + %% compute $$ Mv = ( n + p) $$ + %% and the (lumped) mass matrix M + freecarr=zeros(Nnodes,1); + freecarr(Sinodes)=(n./Vthn + p./Vthp); + Mv = freecarr; + M = DDGOXNLPOISSON_MASS*spdiag(Mv); + + %%% + %%% Compute RHS vector (-residual) + %%% + + %% now compute $$ T0 = \frac{q}{\epsilon} (n - p - D) $$ + totcharge( Sinodes)=(n - p - D); + Tv0 = totcharge; + T0 = Tv0 .* DDGOXNLPOISSON_RHS;%T0 = Ucompconst (mesh,Tv0,ones(Nelements,1)); + + %% now we're ready to build LHS matrix and RHS of the linear system for 1st Newton step + A = DDGOXNLPOISSON_LAP + M; + R = DDGOXNLPOISSON_LAP * Vnew + T0; + + %% Apply boundary conditions + A (Dnodes,:) = []; + A (:,Dnodes) = []; + R(Dnodes) = []; + + %% compute $$ | R_{k+1} | $$ for the convergence test + normrnew= norm(R,inf); + + % check if more damping is needed + if (normrnew > normr(newtit)) + tk = tk/dampcoeff; + else + if (verbose>2) + fprintf(1,'\nexiting damping cycle because residual norm = %e \n-----------\n',normrnew); + end + break + end + end + + V = Vnew; + normr(newtit+1) = normrnew; + dVnorm = norm(tk*dV,inf); + pause(.1); + % check if convergence has been reached + reldVnorm = dVnorm / norm(V,inf); + if (reldVnorm <= toll) + if(verbose>2) + fprintf(1,'\nexiting newton cycle because reldVnorm= %e \n',reldVnorm); + end + break + end + + end + + res = normr; + niter = newtit; + diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXthermaliteration.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXthermaliteration.m new file mode 100644 index 0000000..abb8ba8 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXthermaliteration.m @@ -0,0 +1,156 @@ +function [thermdata,nrm] = ThDDGOXthermaliteration(imesh,Dsides,... + Simesh,Sinodes,Sielements,... + SiDsides,thermdata,toll,... + maxit,verbose) + + + %% [thermdata,innrm] = ThDDGOXthermaliteration(imesh,Dsides,... + %% Simesh,Sinodes,Sielements,... + %% SiDsides,thermdata,toll,... + %% maxit,verbose) + + %%%%%%%%%%%%%%% + %% RRE param %% + RREnnit = [10,2]; + RRErank = maxit; + RREpattern = URREcyclingpattern(RREnnit,RRErank,maxit); + %%%%%%%%%%%%%%% + + %% Set list of nodes with Dirichlet BCs + Dnodes = Unodesonside(imesh,Dsides); + SiDnodes = Unodesonside(Simesh,SiDsides); + + Tl = thermdata.Tl; + Tn = thermdata.Tn; + Tp = thermdata.Tp; + + tldampcoef = 1; + tndampcoef = 10; + tpdampcoef = 10; + + mobn0 = thermdata.mobn0(imesh,Simesh,Sinodes,Sielements,thermdata); + mobp0 = thermdata.mobp0(imesh,Simesh,Sinodes,Sielements,thermdata); + mobn1 = thermdata.mobn1(imesh,Simesh,Sinodes,Sielements,thermdata); + mobp1 = thermdata.mobp1(imesh,Simesh,Sinodes,Sielements,thermdata); + twn0 = thermdata.twn0 (imesh,Simesh,Sinodes,Sielements,thermdata); + twp0 = thermdata.twp0 (imesh,Simesh,Sinodes,Sielements,thermdata); + twn1 = thermdata.twn1 (imesh,Simesh,Sinodes,Sielements,thermdata); + twp1 = thermdata.twp1 (imesh,Simesh,Sinodes,Sielements,thermdata); + [Ex,Ey] = Updegrad(Simesh,-thermdata.V(Sinodes)); + E = [Ex;Ey]; + + [jnx,jny] = Ufvsgcurrent3(Simesh,thermdata.n,... + mobn0,mobn1,Tn,thermdata.V(Sinodes)-Tn); + [jpx,jpy] = Ufvsgcurrent3(Simesh,thermdata.p,... + -mobp0,mobp1,Tp,-thermdata.V(Sinodes)-Tp); + + Jn = [jnx;jny]; + Jp = [jpx;jpy]; + + for ith=1:maxit + + if (verbose>=1) + fprintf(1,"*** start of inner iteration number: %d\n",ith); + end + + if (verbose>=1) + fprintf(1,'\t***updating electron temperature\n'); + end + + Tn = ThDDGOXupdateelectron_temp(Simesh,SiDnodes,thermdata.Tn,... + thermdata.n,thermdata.p,... + thermdata.Tl,Jn,E,mobn0,... + twn0,twn1,thermdata.tn,thermdata.tp,... + thermdata.ni,thermdata.ni); + + ##Tn(Tn0) + tndampfact_n = log(1+tndampcoef*dtn)/(tndampcoef*dtn); + Tn = tndampfact_n * Tn + (1-tndampfact_n) * thermdata.Tn; + end + + if (verbose>=1) + fprintf(1,'\t***updating hole temperature\n'); + end + + + Tp = ThDDGOXupdatehole_temp(Simesh,SiDnodes,thermdata.Tp,... + thermdata.n,thermdata.p,... + thermdata.Tl,Jp,E,mobp0,... + twp0,twp1,thermdata.tn,thermdata.tp,... + thermdata.ni,thermdata.ni); + + ##Tp(Tp0) + tpdampfact_p = log(1+tpdampcoef*dtp)/(tpdampcoef*dtp); + Tp = tpdampfact_p * Tp + (1-tpdampfact_p) * thermdata.Tp; + end + + if (verbose>=1) + fprintf(1,'\t***updating lattice temperature\n'); + end + + ## store result for RRE + if RREpattern(ith)>0 + TEMPstore(:,RREpattern(ith)) = [Tn;Tp;Tl]; + if RREpattern(ith+1)==0 % Apply RRE extrapolation + if (verbose>=1) + fprintf(1,"\n\t**********\n\tRRE EXTRAPOLATION STEP\n\t**********\n\n"); + end + TEMP = Urrextrapolation(TEMPstore); + Tn = TEMP(1:rows(Tn)); + Tp = TEMP(rows(Tn)+1:rows(Tn)+rows(Tp)); + Tl = TEMP(rows(Tn)+rows(Tp)+1:end); + end + end + + Tl = ThDDGOXupdatelattice_temp(Simesh,SiDnodes,thermdata.Tl,... + Tn,Tp,thermdata.n,... + thermdata.p,thermdata.kappa,thermdata.Egap,... + thermdata.tn,thermdata.tp,twn0,... + twp0,twn1,twp1,... + thermdata.ni,thermdata.ni); + + ##Tl(Tl 0) + tldampfact = log(1+tldampcoef*dtl)/(tldampcoef*dtl); + Tl = tldampfact * Tl + (1-tldampfact) * thermdata.Tl; + end + + + if (verbose>=1) + fprintf(1,"\t*** checking for convergence:\n "); + end + + nrm(ith) = max([dtl,dtn,dtp]); + + if (verbose>=1) + fprintf (1,"\t\t|dTL|= %g\n",dtl); + fprintf (1,"\t\t|dTn|= %g\n",dtn); + fprintf (1,"\t\t|dTp|= %g\n",dtp); + end + + thermdata.Tl = Tl; + thermdata.Tn = Tn; + thermdata.Tp = Tp; + if (verbose>1) + subplot(1,3,2); + title("max(|dTl|,|dTn|,|dTn|)") + semilogy(nrm) + pause(.1) + end + if nrm(ith)< toll + if (verbose>=1) + fprintf(1,"\n***\n***\texit from thermal iteration \n"); + end + + break + end + +end \ No newline at end of file diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXupdateelectron_temp.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXupdateelectron_temp.m new file mode 100644 index 0000000..62aa788 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXupdateelectron_temp.m @@ -0,0 +1,59 @@ +function Tn = ThDDGOXupdateelectron_temp(imesh,Dnodes,Tn,n,p,Tl,Jn,E,mobn0,... + twn0,twn1,tn,tp,n0,p0) + %% + %% Tn = ThDDGOXupdateelectron_temp(mesh,Dnodes,Tn,n,p,Tl,Jn,E,mobn,... + %% twn0,tn,tp,n0,p0) + %% + + %% This file is part of + %% + %% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator + %% ------------------------------------------------------------------- + %% Copyright (C) 2004-2006 Carlo de Falco + %% + %% + %% + %% SECS2D is free software; you can 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. + %% + %% SECS2D is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied warranty of + %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + %% GNU General Public License for more details. + %% + %% You should have received a copy of the GNU General Public License + %% along with SECS2D; If not, see . + + Nnodes = columns(imesh.p); + Nelements = columns(imesh.t); + Varnodes = setdiff(1:Nnodes,Dnodes); + + alpha = mobn0; + gamma = ones(Nnodes,1); + eta = 1.5 * n .* Tl; + betax = Jn(1,:)./ mobn0'; + betay = Jn(2,:)./ mobn0'; + beta = -2.5*[betax;betay]; + + Sn = Uscharfettergummel3(imesh,alpha,gamma,eta,beta); + + denom = (tp*(n+sqrt(n0.*p0))+tn*(p+sqrt(n0.*p0))); + R = (p.*n)./denom; + MASS_LHS1 = Ucompmass2(imesh,1.5*R,ones(Nelements,1)); + MASS_LHS2 = Ucompmass2(imesh,1.5*n./twn1,1./twn0); + + LHS = Sn + MASS_LHS1 + MASS_LHS2; + + G = (p0.*n0)./denom; + PJoule = Jn(1,:).*E(1,:) + Jn(2,:).*E(2,:); + PJoule(PJoule<0) = 0; + + rhsJoule = Ucompconst (imesh,ones(Nnodes,1),PJoule'); + rhsR_G = Ucompconst (imesh,1.5*G.*Tn,ones(Nelements,1)); + rhsTh_L = Ucompconst (imesh,1.5*n.*Tl./twn1,1./twn0); + RHS = rhsJoule + rhsR_G + rhsTh_L; + + Tn(Varnodes) = LHS(Varnodes,Varnodes) \(RHS(Varnodes) -... + LHS(Varnodes,Dnodes)*Tn(Dnodes)); diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXupdatehole_temp.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXupdatehole_temp.m new file mode 100644 index 0000000..a009540 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXupdatehole_temp.m @@ -0,0 +1,60 @@ +function Tp = ThDDGOXupdatehole_temp(imesh,Dnodes,Tp,n,p,Tl,Jp,E,mobp0,... + twp0,twp1,tn,tp,n0,p0) + %% + %% Tp = ThDDGOXupdatehole_temp(mesh,Dnodes,Tp,n,p,Tl,Jp,E,mobp0,... + %% twp0,twp1,tn,tp,n0,p0) + %% + + %% This file is part of + %% + %% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator + %% ------------------------------------------------------------------- + %% Copyright (C) 2004-2006 Carlo de Falco + %% + %% + %% + %% SECS2D is free software; you can 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. + %% + %% SECS2D is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied warranty of + %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + %% GNU General Public License for more details. + %% + %% You should have received a copy of the GNU General Public License + %% along with SECS2D; If not, see . + + Nnodes = columns(imesh.p); + Nelements = columns(imesh.t); + Varnodes = setdiff(1:Nnodes,Dnodes); + + alpha = mobp0; + gamma = ones(Nnodes,1); + eta = 1.5 * p .* Tl; + betax = Jp(1,:)./ mobp0'; + betay = Jp(2,:)./ mobp0'; + beta = 2.5*[betax;betay]; + + Sn = Uscharfettergummel3(imesh,alpha,gamma,eta,beta); + + denom = (tp*(n+sqrt(n0.*p0))+tn*(p+sqrt(n0.*p0))); + R = (p.*n)./denom; + MASS_LHS1 = Ucompmass2(imesh,1.5*R,ones(Nelements,1)); + MASS_LHS2 = Ucompmass2(imesh,1.5*p./twp1,1./twp0); + + LHS = Sn + MASS_LHS1 + MASS_LHS2; + + G = (p0.*n0)./denom; + PJoule = Jp(1,:).*E(1,:) + Jp(2,:).*E(2,:); + PJoule(PJoule<0) = 0; + + rhsJoule = Ucompconst (imesh,ones(Nnodes,1),PJoule'); + rhsR_G = Ucompconst (imesh,1.5*G.*Tp,ones(Nelements,1)); + rhsTh_L = Ucompconst (imesh,1.5*p.*Tl./twp1,1./twp0); + RHS = rhsJoule + rhsR_G + rhsTh_L; + + Tp(Varnodes) = LHS(Varnodes,Varnodes) \(RHS(Varnodes) -... + LHS(Varnodes,Dnodes)*Tp(Dnodes)); + diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXupdatelattice_temp.m b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXupdatelattice_temp.m new file mode 100644 index 0000000..81ba79b --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/ThDDGOXupdatelattice_temp.m @@ -0,0 +1,52 @@ +function Tl = ThDDGOXupdatelattice_temp(mesh,Dnodes,Tl,Tn,Tp,n,p,... + kappa,Egap,tn,tp,... + twn0,twp0,twn1,twp1,n0,p0) + %% + %% Tl = ThDDGOXupdatelattice_temp(mesh,Dnodes,Tl,Tn,Tp,n,p,... + %% kappa,Egap,tn,tp,... + %% twn0,twp0,twn1,twp1,n0,p0) + + %% This file is part of + %% + %% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator + %% ------------------------------------------------------------------- + %% Copyright (C) 2004-2006 Carlo de Falco + %% + %% + %% + %% SECS2D is free software; you can 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. + %% + %% SECS2D is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied warranty of + %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + %% GNU General Public License for more details. + %% + %% You should have received a copy of the GNU General Public License + %% along with SECS2D; If not, see . + + Nnodes = columns(mesh.p); + Nelements = columns(mesh.t); + Varnodes = setdiff(1:Nnodes,Dnodes); + + alpha = kappa*ones(Nelements,1); + gamma = Tl.^(-4/3); + eta = ones (Nnodes,1); + + L = Uscharfettergummel3(mesh,alpha,gamma,eta,0); + MASS_LHSn = Ucompmass2(mesh,1.5*n./twn1,1./twn0); + MASS_LHSp = Ucompmass2(mesh,1.5*p./twp1,1./twp0); + LHS = L+MASS_LHSn+MASS_LHSp; + + + denom = (tp*(n+sqrt(n0.*p0))+tn*(p+sqrt(n0.*p0))); + U = (p.*n-p0.*n0)./denom; + RHS1 = Ucompconst(mesh,(Egap+1.5*(Tn + Tp)).*U,ones(Nelements,1)); + RHS2n = Ucompconst(mesh,1.5*n.*Tn./twn1,1./twn0); + RHS2p = Ucompconst(mesh,1.5*p.*Tp./twp1,1./twp0); + RHS = RHS1 + RHS2n + RHS2p; + + Tl(Varnodes) = LHS(Varnodes,Varnodes) \... + (RHS(Varnodes) - LHS(Varnodes,Dnodes)*Tl(Dnodes)); diff --git a/octave_packages/secs2d-0.0.8/ThDDGOX/doc-cache b/octave_packages/secs2d-0.0.8/ThDDGOX/doc-cache new file mode 100644 index 0000000..b48dfcf --- /dev/null +++ b/octave_packages/secs2d-0.0.8/ThDDGOX/doc-cache @@ -0,0 +1,271 @@ +# Created by Octave 3.6.1, Sun Mar 25 18:44:37 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 10 +# name: +# type: sq_string +# elements: 1 +# length: 16 +ThDDGOXddcurrent + + +# name: +# type: sq_string +# elements: 1 +# length: 63 + [current,divrg]=DDGOXddcurrent(Simesh,Sinodes,data,contacts); + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 + [current,divrg]=DDGOXddcurrent(Simesh,Sinodes,data,contacts); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +ThDDGOXelectron_driftdiffusion + + +# name: +# type: sq_string +# elements: 1 +# length: 82 + + n=ThDDGOXelectron_driftdiffusion(mesh,Dnodes,n,pin,V,Tn,un0,un1,tn,tp,n0,p0) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + n=ThDDGOXelectron_driftdiffusion(mesh,Dnodes,n,pin,V,Tn,un0,un1,tn,tp,n0,p0) + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +ThDDGOXeletiteration + + +# name: +# type: sq_string +# elements: 1 +# length: 179 + function [odata,nrm]=ThDDGOXeletiteration(imesh,Dsides,... + Simesh,Sinodes,Sielements,SiDsides,areaSi,SiPatch,... + idata,toll,maxit,ptoll,pmaxit,verbose) + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 + function [odata,nrm]=ThDDGOXeletiteration(imesh,Dsides,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +ThDDGOXgummelmap + + +# name: +# type: sq_string +# elements: 1 +# length: 209 + [odata,it,res] = ThDDGOXgummelmap (imesh,Dsides,... + Simesh,Sinodes,Sielements,SiDsides,... + idata,tol,maxit,ptol,pmaxit,thtol,thmaxit,... + eltol,elmaxit,verbose) + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 + [odata,it,res] = ThDDGOXgummelmap (imesh,Dsides,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 +ThDDGOXhole_driftdiffusion + + +# name: +# type: sq_string +# elements: 1 +# length: 81 + + p=ThDDGOXhole_driftdiffusion(mesh,Dnodes,nin,p,V,Tp,monp0,mobp1,tn,tp,n0,p0) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + p=ThDDGOXhole_driftdiffusion(mesh,Dnodes,nin,p,V,Tp,monp0,mobp1,tn,tp,n0,p0) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +ThDDGOXnlpoisson + + +# name: +# type: sq_string +# elements: 1 +# length: 223 + + [V,n,p,res,niter] = DDGOXnlpoisson (mesh,Dsides,Sinodes,Vin,nin,pin,... + Fnin,Fpin,D,l2,l2ox,toll,maxit,verbose) + + solves $$ -\lambda^2 V'' + (n(V,Fn,Tn) - p(V,Fp,Tp) -D) = 0$$ + + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 + + [V,n,p,res,niter] = DDGOXnlpoisson (mesh,Dsides,Sinodes,Vin,nin,pin,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 23 +ThDDGOXthermaliteration + + +# name: +# type: sq_string +# elements: 1 +# length: 237 + [thermdata,innrm] = ThDDGOXthermaliteration(imesh,Dsides,... + Simesh,Sinodes,Sielements,... + SiDsides,thermdata,toll,... + maxit,verbose) + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 + [thermdata,innrm] = ThDDGOXthermaliteration(imesh,Dsides,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 +ThDDGOXupdateelectron_temp + + +# name: +# type: sq_string +# elements: 1 +# length: 124 + + Tn = ThDDGOXupdateelectron_temp(mesh,Dnodes,Tn,n,p,Tl,Jn,E,mobn,... + twn0,tn,tp,n0,p0) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 68 + + Tn = ThDDGOXupdateelectron_temp(mesh,Dnodes,Tn,n,p,Tl,Jn,E,mobn,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +ThDDGOXupdatehole_temp + + +# name: +# type: sq_string +# elements: 1 +# length: 122 + + Tp = ThDDGOXupdatehole_temp(mesh,Dnodes,Tp,n,p,Tl,Jp,E,mobp0,... + twp0,twp1,tn,tp,n0,p0) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 + + Tp = ThDDGOXupdatehole_temp(mesh,Dnodes,Tp,n,p,Tl,Jp,E,mobp0,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 +ThDDGOXupdatelattice_temp + + +# name: +# type: sq_string +# elements: 1 +# length: 142 + + Tl = ThDDGOXupdatelattice_temp(mesh,Dnodes,Tl,Tn,Tp,n,p,... + kappa,Egap,tn,tp,... + twn0,twp0,twn1,twp1,n0,p0) + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 + + Tl = ThDDGOXupdatelattice_temp(mesh,Dnodes,Tl,Tn,Tp,n,p,. + + + + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/UDXappend2Ddata.m b/octave_packages/secs2d-0.0.8/Utilities/UDXappend2Ddata.m new file mode 100644 index 0000000..f5c2fba --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/UDXappend2Ddata.m @@ -0,0 +1,56 @@ +function UDXappend2Ddata(filename,p,t,u,attr_name,attr_rank,attr_shape,endfile) + +% +% UDXappend2Ddata(filename,p,t,u,attr_name,attr_rank,attr_shape) +% +% Apends data to a file in DX form. +% Only one variable can be written to the file +% variable must be a scalar, vector or tensor of doubles +% mesh data in the file must be consistent with this variable +% +% x +% attr_name = name of the variable (type string) +% attr_rank = rank of variable data (0 for scalar, 1 for vector, etc.) +% attr_shape = number of components of variable data (assumed 1 for scalar) +% + +p = p'; +t = t'; +t = t(:,1:3); + +%eval(['!rm -f ',filename]); + +fid=fopen (filename,'a'); +Nnodi = size(p,1); +Ntriangoli = size(t,1); + +fprintf(fid,'\nattribute "element type" string "triangles"\nattribute "ref" string "positions"\n\n'); + +if ((attr_rank==0) & (min(size(u))==1)) + fprintf(fid,'object "%s.data"\nclass array type double rank 0 items %d data follows',attr_name,Nnodi); + fprintf(fid,'\n %1.7e',u); +else + fprintf(fid,'object "%s.data"\nclass array type double rank %d shape %d items %d data follows', ... + attr_name,attr_rank,attr_shape,Nnodi); + for i=1:Nnodi + fprintf(fid,'\n'); + fprintf(fid,' %1.7e',u(i,:)); + end +end +fprintf(fid,['\nattribute "dep" string "positions"\n\n' ... + 'object "%s" class field\n'... + 'component "positions" value "pos"\n'... + 'component "connections" value "con"\n'... + 'component "data" value "%s.data"\n'],... + attr_name,attr_name); + +if(endfile) + fprintf(fid,'\nend\n'); +end + +fclose (fid); + + +% Last Revision: +% $Author: cdf $ +% $Date: 2007-05-22 21:16:23 +0200 (tir, 22 maj 2007) $ diff --git a/octave_packages/secs2d-0.0.8/Utilities/UDXoutput2Ddata.m b/octave_packages/secs2d-0.0.8/Utilities/UDXoutput2Ddata.m new file mode 100644 index 0000000..754a92c --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/UDXoutput2Ddata.m @@ -0,0 +1,115 @@ +function UDXoutput2Ddata(filename,p,t,u,attr_name,attr_rank,attr_shape,endfile) + +## +## UDXoutput2Ddata(filename,p,t,u,attr_name,attr_rank,attr_shape,endfile) +## +## Outputs data in DX form. +## Only one variable can be written to the file +## variable must be a scalar, vector or tensor of doubles +## +## x +## attr_name = name of the variable (type string) +## attr_rank = rank of variable data (0 for scalar, 1 for vector, etc.) +## attr_shape = number of components of variable data (assumed 1 for scalar) +## + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + + + p = p'; + t = t'; + t = t(:,1:3); + + %eval(['!rm -f ',filename]); + + fid=fopen (filename,'w'); + Nnodi = size(p,1); + Ntriangoli = size(t,1); + Ndati = size(u,1); + + fprintf(fid,'object "pos"\nclass array type float rank 1 shape 2 items %d data follows',Nnodi); + + for i=1:Nnodi + fprintf(fid,'\n'); + fprintf(fid,' %1.7e',p(i,:)); + end + + if (min(min(t))==1) + t=t-1; + elseif(min(min(t))~=0) + disp('WARNING: check triangle structure') + end + # In DX format nodes are + # numbered starting from zero, + # instead we want to number + # them starting from 1! + # Here we restore the DX + # format + + fprintf(fid,'\n\nobject "con"\nclass array type int rank 1 shape 3 items %d data follows',Ntriangoli); + for i=1:Ntriangoli + fprintf(fid,'\n'); + fprintf(fid,' %d',t(i,:)); + end + + fprintf(fid,'\nattribute "element type" string "triangles"\nattribute "ref" string "positions"\n\n'); + + if ((attr_rank==0) & (min(size(u))==1)) + fprintf(fid,'object "%s.data"\nclass array type double rank 0 items %d data follows',attr_name,Ndati); + fprintf(fid,'\n %1.7e',u); + + else + fprintf(fid,'object "%s.data"\nclass array type double rank %d shape %d items %d data follows', ... + attr_name,attr_rank,attr_shape,Ndati); + for i=1:Ndati + fprintf(fid,'\n'); + fprintf(fid,' %1.7e',u(i,:)); + end + +end + +if Ndati==Nnodi + fprintf(fid,['\nattribute "dep" string "positions"\n\n' ... + 'object "%s" class field\n'... + 'component "positions" value "pos"\n'... + 'component "connections" value "con"\n'... + 'component "data" value "%s.data"\n'],... + attr_name,attr_name); + elseif Ndati==Ntriangoli + fprintf(fid,['\nattribute "dep" string "connections"\n\n' ... + 'object "%s" class field\n'... + 'component "positions" value "pos"\n'... + 'component "connections" value "con"\n'... + 'component "data" value "%s.data"\n'],... + attr_name,attr_name); +end + + if(endfile) + fprintf(fid,'\nend\n'); + end + + fclose (fid); + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/UDXoutput2Dtimeseries.m b/octave_packages/secs2d-0.0.8/Utilities/UDXoutput2Dtimeseries.m new file mode 100644 index 0000000..662032d --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/UDXoutput2Dtimeseries.m @@ -0,0 +1,58 @@ +function UDXoutput2Dtimeseries(filename,p,t,u,attr_name,attr_rank,attr_shape,time) + +## +## UDXoutput2Dtimeseries(filename,p,t,u,attr_name,attr_rank,attr_shape,time) +## +## Outputs data in DX form. +## Only one variable can be written to the file +## variable must be a scalar, vector or tensor of doubles +## +## attr_name = name of the variable (type string) +## attr_rank = rank of variable data (0 for scalar, 1 for vector, etc.) +## attr_shape = number of components of variable data (assumed 1 for scalar) +## + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +Nsteps = length(time); +if (Nsteps<=1) + endfile = 1; +else + endfile = 0; +end + +UDXoutput2Ddata(filename,p,t,u(:,1:attr_shape),[attr_name "1"],attr_rank,attr_shape,endfile); + +for it = 2:Nsteps + UDXappend2Ddata(filename,p,t,u(:,[1:attr_shape]+attr_shape*(it-1)),... + [attr_name num2str(it)],attr_rank,attr_shape,endfile); +end + +fid=fopen(filename,"a"); + +fprintf (fid, "object \"%s_series\" class series\n",attr_name); +for it = 1:Nsteps + fprintf (fid,"member %d position %g value \"%s\"\n",it-1,time(it),[attr_name num2str(it)]); +end +fprintf (fid, "\nend\n"); +fclose(fid); \ No newline at end of file diff --git a/octave_packages/secs2d-0.0.8/Utilities/URREcyclingpattern.m b/octave_packages/secs2d-0.0.8/Utilities/URREcyclingpattern.m new file mode 100644 index 0000000..778501a --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/URREcyclingpattern.m @@ -0,0 +1,42 @@ +function RREpattern = URREcyclingpattern(RREnnit,RRErank,maxit); + +% prcomputes cycling pattern for RRE extrapolation: +% +% -1 = Do Nothing +% 0 = extrapolate +% 1..RRErank = store +% +% RREpattern = URREcyclingpattern(RREnnit,RRErank,toll); +% + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +RREpattern = zeros(RREnnit(1),1)-1; + +while length(RREpattern). + +xlim= 1e-2; +ax = abs(x); +bp = zeros(size(x)); +bn = bp; + +block1 = find(~ax); +block21 = find((ax>80)&x>0); +block22 = find((ax>80)&x<0); +block3 = find((ax<=80)&(ax>xlim)); +block4 = find((ax<=xlim)&(ax~=0)); + + + +% +% Calcola la funz. di Bernoulli per x=0 +% +% if (ax == 0) +%fprintf(1,' -> executing block 1\n'); +bp(block1)=1.; +bn(block1)=1.; +%end; + +% +% Calcola la funz. di Bernoulli per valori +% asintotici dell'argomento +% +% if (ax > 80), +% fprintf(1,' -> eexecuting block 2\n'); +% if (x >0), +bp(block21)=0.; +bn(block21)=x(block21); +% else +bp(block22)=-x(block22); +bn(block22)=0.; +% end; +% end; + +% +% Calcola la funz. di Bernoulli per valori +% intermedi dell'argomento +% +% if (ax > xlim), +%fprintf(1,' -> eexecuting block 3\n'); +bp(block3)=x(block3)./(exp(x(block3))-1); +bn(block3)=x(block3)+bp(block3); +% else + +% for ii=block4; + +% +% Calcola la funz. di Bernoulli per valori +% piccoli dell'argomento mediante sviluppo +% di Taylor troncato dell'esponenziale +% +%fprintf(1,' -> eexecuting block 4\n'); +if(any(block4))jj=1; + fp=1.*ones(size(block4)); + fn=fp; + df=fp; + segno=1.; + while (norm(df,inf) > eps), + jj=jj+1; + segno=-segno; + df=df.*x(block4)/jj; + fp=fp+df; + fn=fn+segno*df; + end; + bp(block4)=1./fp; + bn(block4)=1./fn; +end +% end + + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ucoloredrubbersheet.net b/octave_packages/secs2d-0.0.8/Utilities/Ucoloredrubbersheet.net new file mode 100644 index 0000000..fd8cf48 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ucoloredrubbersheet.net @@ -0,0 +1,608 @@ +// +// time: Fri May 11 20:21:23 2007 +// +// version: 3.2.0 (format), 4.3.2 (DX) +// +// +// MODULE main +// workspace: width = 533, height = 507 +// layout: snap = 0, width = 50, height = 50, align = NN +// +macro main( +) -> ( +) { + // + // node FileSelector[1]: x = 51, y = 31, inputs = 0, label = FileSelector + // output[1]: visible = 1, type = 32, value = "__FILE__DX__" + // output[2]: visible = 1, type = 32, value = "__FILE__DX__" + // + // + // node Import[1]: x = 104, y = 118, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_FileSelector_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node RubberSheet[1]: x = 216, y = 166, inputs = 4, label = RubberSheet + // +main_RubberSheet_1_out_1 = + RubberSheet( + main_Import_1_out_1, + main_RubberSheet_1_in_2, + main_RubberSheet_1_in_3, + main_RubberSheet_1_in_4 + ) [instance: 1, cache: 1]; + // + // node AutoColor[1]: x = 253, y = 283, inputs = 10, label = AutoColor + // +main_AutoColor_1_out_1, +main_AutoColor_1_out_2 = + AutoColor( + main_RubberSheet_1_out_1, + main_AutoColor_1_in_2, + main_AutoColor_1_in_3, + main_AutoColor_1_in_4, + main_AutoColor_1_in_5, + main_AutoColor_1_in_6, + main_AutoColor_1_in_7, + main_AutoColor_1_in_8, + main_AutoColor_1_in_9, + main_AutoColor_1_in_10 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 49, y = 232, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_RubberSheet_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Color[1]: x = 72, y = 328, inputs = 5, label = Color + // input[2]: defaulting = 0, visible = 1, type = 32, value = "black" + // input[3]: defaulting = 0, visible = 1, type = 5, value = .5 + // +main_Color_1_out_1 = + Color( + main_ShowConnections_1_out_1, + main_Color_1_in_2, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node ColorBar[1]: x = 413, y = 290, inputs = 16, label = ColorBar + // input[9]: defaulting = 0, visible = 0, type = 16777248, value = {"black"} + // +main_ColorBar_1_out_1 = + ColorBar( + main_AutoColor_1_out_2, + main_ColorBar_1_in_2, + main_ColorBar_1_in_3, + main_ColorBar_1_in_4, + main_ColorBar_1_in_5, + main_ColorBar_1_in_6, + main_ColorBar_1_in_7, + main_ColorBar_1_in_8, + main_ColorBar_1_in_9, + main_ColorBar_1_in_10, + main_ColorBar_1_in_11, + main_ColorBar_1_in_12, + main_ColorBar_1_in_13, + main_ColorBar_1_in_14, + main_ColorBar_1_in_15, + main_ColorBar_1_in_16 + ) [instance: 1, cache: 1]; + // + // node Collect[1]: x = 280, y = 393, inputs = 3, label = Collect + // +main_Collect_1_out_1 = + Collect( + main_Color_1_out_1, + main_AutoColor_1_out_1, + main_ColorBar_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 188, y = 445, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 67108863, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[5]: defaulting = 0, visible = 0, type = 8, value = [0.466889 0.863877 0.166499] + // input[6]: defaulting = 0, visible = 0, type = 8, value = [0.466889 0.863877 4.74189] + // input[7]: defaulting = 0, visible = 0, type = 5, value = 1.01623 + // input[8]: defaulting = 0, visible = 0, type = 1, value = 1266 + // input[9]: defaulting = 0, visible = 0, type = 5, value = 0.557267 + // input[10]: defaulting = 0, visible = 0, type = 8, value = [0 1 0] + // input[11]: defaulting = 1, visible = 0, type = 5, value = 12.6739 + // input[12]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[15]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[16]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[17]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[18]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[22]: defaulting = 0, visible = 0, type = 32, value = "snow" + // input[25]: defaulting = 0, visible = 0, type = 32, value = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/doping.tif" + // input[26]: defaulting = 0, visible = 0, type = 32, value = "tiff" + // input[29]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[31]: defaulting = 0, visible = 0, type = 1, value = -5 + // input[33]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[34]: defaulting = 0, visible = 0, type = 3, value = 0 + // input[36]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[37]: defaulting = 0, visible = 0, type = 16777248, value = {"clear", "black", "blue", "blue"} + // input[38]: defaulting = 0, visible = 0, type = 16777248, value = {"background", "grid", "ticks", "labels"} + // input[39]: defaulting = 0, visible = 0, type = 5, value = 0.65 + // input[40]: defaulting = 0, visible = 0, type = 32, value = "roman_d" + // input[41]: defaulting = 0, visible = 0, type = 32, value = "panzoom" + // depth: value = 24 + // window: position = (0.0000,0.0288), size = 1.0000x0.9375 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Collect_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_FileSelector_1_out_1 = "__FILE__DX__"; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_RubberSheet_1_in_2 = NULL; +main_RubberSheet_1_in_3 = NULL; +main_RubberSheet_1_in_4 = NULL; +main_RubberSheet_1_out_1 = NULL; +main_AutoColor_1_in_2 = NULL; +main_AutoColor_1_in_3 = NULL; +main_AutoColor_1_in_4 = NULL; +main_AutoColor_1_in_5 = NULL; +main_AutoColor_1_in_6 = NULL; +main_AutoColor_1_in_7 = NULL; +main_AutoColor_1_in_8 = NULL; +main_AutoColor_1_in_9 = NULL; +main_AutoColor_1_in_10 = NULL; +main_AutoColor_1_out_1 = NULL; +main_AutoColor_1_out_2 = NULL; +main_ShowConnections_1_out_1 = NULL; +main_Color_1_in_2 = "black"; +main_Color_1_in_3 = .5; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +main_ColorBar_1_in_2 = NULL; +main_ColorBar_1_in_3 = NULL; +main_ColorBar_1_in_4 = NULL; +main_ColorBar_1_in_5 = NULL; +main_ColorBar_1_in_6 = NULL; +main_ColorBar_1_in_7 = NULL; +main_ColorBar_1_in_8 = NULL; +main_ColorBar_1_in_9 = {"black"}; +main_ColorBar_1_in_10 = NULL; +main_ColorBar_1_in_11 = NULL; +main_ColorBar_1_in_12 = NULL; +main_ColorBar_1_in_13 = NULL; +main_ColorBar_1_in_14 = NULL; +main_ColorBar_1_in_15 = NULL; +main_ColorBar_1_in_16 = NULL; +main_ColorBar_1_out_1 = NULL; +main_Collect_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 1; +main_Image_1_in_5 = [0.466889 0.863877 0.166499]; +main_Image_1_in_6 = [0.466889 0.863877 4.74189]; +main_Image_1_in_7 = 1.01623; +main_Image_1_in_8 = 1266; +main_Image_1_in_9 = 0.557267; +main_Image_1_in_10 = [0 1 0]; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = 0; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = NULL; +main_Image_1_in_18 = NULL; +main_Image_1_in_19 = 0; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = "snow"; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/doping.tif"; +main_Image_1_in_26 = "tiff"; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = 1; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = -5; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = 1; +main_Image_1_in_34 = 0; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = 1; +main_Image_1_in_37 = {"clear", "black", "blue", "blue"}; +main_Image_1_in_38 = {"background", "grid", "ticks", "labels"}; +main_Image_1_in_39 = 0.65; +main_Image_1_in_40 = "roman_d"; +main_Image_1_in_41 = "panzoom"; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +Executive("product version 4 3 2"); +$sync +main(); diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ucoloredrubbersheetseries.net b/octave_packages/secs2d-0.0.8/Utilities/Ucoloredrubbersheetseries.net new file mode 100644 index 0000000..1c9056f --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ucoloredrubbersheetseries.net @@ -0,0 +1,657 @@ +// +// time: Sat Jun 3 23:21:55 2006 +// +// version: 3.2.0 (format), 4.3.2 (DX) +// +// +// MODULE main +// workspace: width = 629, height = 507 +// layout: snap = 0, width = 50, height = 50, align = NN +// +macro main( +) -> ( +) { + // + // node FileSelector[1]: x = 51, y = 31, inputs = 0, label = FileSelector + // output[1]: visible = 1, type = 32, value = "__FILE__DX__" + // output[2]: visible = 0, type = 32, value = "__FILE__DX__" + // + // + // node Import[1]: x = 104, y = 118, inputs = 6, label = Import + // input[2]: visible = 0 + // input[3]: visible = 0 + // +main_Import_1_out_1 = + Import( + main_FileSelector_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node AutoColor[1]: x = 285, y = 117, inputs = 10, label = AutoColor + // input[7]: visible = 0 + // +main_AutoColor_1_out_1, +main_AutoColor_1_out_2 = + AutoColor( + main_Import_1_out_1, + main_AutoColor_1_in_2, + main_AutoColor_1_in_3, + main_AutoColor_1_in_4, + main_AutoColor_1_in_5, + main_AutoColor_1_in_6, + main_AutoColor_1_in_7, + main_AutoColor_1_in_8, + main_AutoColor_1_in_9, + main_AutoColor_1_in_10 + ) [instance: 1, cache: 1]; + // + // node RubberSheet[1]: x = 273, y = 252, inputs = 4, label = RubberSheet + // input[2]: defaulting = 1, visible = 0, type = 5, value = 1.0 + // +main_RubberSheet_1_out_1 = + RubberSheet( + main_AutoColor_1_out_1, + main_RubberSheet_1_in_2, + main_RubberSheet_1_in_3, + main_RubberSheet_1_in_4 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 49, y = 232, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_RubberSheet_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Color[1]: x = 72, y = 328, inputs = 5, label = Color + // input[2]: defaulting = 0, visible = 0, type = 32, value = "green" + // input[3]: visible = 0 + // +main_Color_1_out_1 = + Color( + main_ShowConnections_1_out_1, + main_Color_1_in_2, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node Statistics[1]: x = 489, y = 120, inputs = 1, label = Statistics + // output[1]: visible = 0 + // output[2]: visible = 0 + // output[3]: visible = 0 + // +main_Statistics_1_out_1, +main_Statistics_1_out_2, +main_Statistics_1_out_3, +main_Statistics_1_out_4, +main_Statistics_1_out_5 = + Statistics( + main_Import_1_out_1 + ) [instance: 1, cache: 1]; + // + // node ColorBar[1]: x = 455, y = 296, inputs = 16, label = ColorBar + // input[2]: visible = 0 + // input[3]: visible = 0 + // input[4]: visible = 0 + // input[6]: visible = 1 + // input[7]: visible = 1 + // input[8]: visible = 0 + // input[9]: defaulting = 0, visible = 0, type = 16777248, value = {"black"} + // +main_ColorBar_1_out_1 = + ColorBar( + main_AutoColor_1_out_2, + main_ColorBar_1_in_2, + main_ColorBar_1_in_3, + main_ColorBar_1_in_4, + main_ColorBar_1_in_5, + main_Statistics_1_out_4, + main_Statistics_1_out_5, + main_ColorBar_1_in_8, + main_ColorBar_1_in_9, + main_ColorBar_1_in_10, + main_ColorBar_1_in_11, + main_ColorBar_1_in_12, + main_ColorBar_1_in_13, + main_ColorBar_1_in_14, + main_ColorBar_1_in_15, + main_ColorBar_1_in_16 + ) [instance: 1, cache: 1]; + // + // node Collect[1]: x = 280, y = 393, inputs = 3, label = Collect + // +main_Collect_1_out_1 = + Collect( + main_Color_1_out_1, + main_RubberSheet_1_out_1, + main_ColorBar_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Format[1]: x = 545, y = 307, inputs = 3, label = Format + // input[1]: defaulting = 0, visible = 1, type = 32, value = "min = %g, max = %g" + // +main_Format_1_out_1 = + Format( + main_Format_1_in_1, + main_Statistics_1_out_4, + main_Statistics_1_out_5 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 188, y = 445, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 67108863, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[5]: defaulting = 0, visible = 0, type = 8, value = [0.406504 0.5 0.060737] + // input[6]: defaulting = 0, visible = 0, type = 8, value = [3.08097 2.11826 1.94289] + // input[7]: defaulting = 0, visible = 0, type = 5, value = 1.95541 + // input[8]: defaulting = 0, visible = 0, type = 1, value = 1010 + // input[9]: defaulting = 0, visible = 0, type = 5, value = 0.669 + // input[10]: defaulting = 0, visible = 0, type = 8, value = [-0.451253 -0.250437 0.856535] + // input[11]: defaulting = 1, visible = 0, type = 5, value = 30.0 + // input[12]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[15]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[16]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[17]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[18]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 3, value = 0 + // input[22]: defaulting = 0, visible = 0, type = 32, value = "snow" + // input[25]: defaulting = 0, visible = 0, type = 32, value = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/doping.tif" + // input[26]: defaulting = 0, visible = 0, type = 32, value = "tiff" + // input[29]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[31]: defaulting = 0, visible = 0, type = 1, value = -5 + // input[33]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[34]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[36]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[37]: defaulting = 0, visible = 0, type = 16777248, value = {"clear", "black", "blue", "blue"} + // input[38]: defaulting = 0, visible = 0, type = 16777248, value = {"background", "grid", "ticks", "labels"} + // input[39]: defaulting = 0, visible = 0, type = 5, value = 0.65 + // input[40]: defaulting = 0, visible = 0, type = 32, value = "roman_d" + // input[41]: defaulting = 0, visible = 0, type = 32, value = "rotate" + // output[1]: visible = 0 + // output[2]: visible = 0 + // output[3]: visible = 0 + // depth: value = 24 + // window: position = (0.0000,0.0286), size = 1.0000x0.9375 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Collect_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; + // + // node Message[1]: x = 557, y = 401, inputs = 3, label = Message + // + Message( + main_Format_1_out_1, + main_Message_1_in_2, + main_Message_1_in_3 + ) [instance: 1, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_FileSelector_1_out_1 = "./.tmp.dx"; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_AutoColor_1_in_2 = NULL; +main_AutoColor_1_in_3 = NULL; +main_AutoColor_1_in_4 = NULL; +main_AutoColor_1_in_5 = NULL; +main_AutoColor_1_in_6 = NULL; +main_AutoColor_1_in_7 = NULL; +main_AutoColor_1_in_8 = NULL; +main_AutoColor_1_in_9 = NULL; +main_AutoColor_1_in_10 = NULL; +main_AutoColor_1_out_1 = NULL; +main_AutoColor_1_out_2 = NULL; +main_RubberSheet_1_in_2 = NULL; +main_RubberSheet_1_in_3 = NULL; +main_RubberSheet_1_in_4 = NULL; +main_RubberSheet_1_out_1 = NULL; +main_ShowConnections_1_out_1 = NULL; +main_Color_1_in_2 = "green"; +main_Color_1_in_3 = NULL; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +main_Statistics_1_out_4 = NULL; +main_Statistics_1_out_5 = NULL; +main_ColorBar_1_in_2 = NULL; +main_ColorBar_1_in_3 = NULL; +main_ColorBar_1_in_4 = NULL; +main_ColorBar_1_in_5 = NULL; +main_ColorBar_1_in_8 = NULL; +main_ColorBar_1_in_9 = {"black"}; +main_ColorBar_1_in_10 = NULL; +main_ColorBar_1_in_11 = NULL; +main_ColorBar_1_in_12 = NULL; +main_ColorBar_1_in_13 = NULL; +main_ColorBar_1_in_14 = NULL; +main_ColorBar_1_in_15 = NULL; +main_ColorBar_1_in_16 = NULL; +main_ColorBar_1_out_1 = NULL; +main_Collect_1_out_1 = NULL; +main_Format_1_in_1 = "min = %g, max = %g"; +main_Format_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 1; +main_Image_1_in_5 = [0.406504 0.5 0.060737]; +main_Image_1_in_6 = [3.08097 2.11826 1.94289]; +main_Image_1_in_7 = 1.95541; +main_Image_1_in_8 = 1010; +main_Image_1_in_9 = 0.669; +main_Image_1_in_10 = [-0.451253 -0.250437 0.856535]; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = 0; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = NULL; +main_Image_1_in_18 = NULL; +main_Image_1_in_19 = 0; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = "snow"; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/doping.tif"; +main_Image_1_in_26 = "tiff"; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = 1; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = -5; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = 1; +main_Image_1_in_34 = 1; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = 1; +main_Image_1_in_37 = {"clear", "black", "blue", "blue"}; +main_Image_1_in_38 = {"background", "grid", "ticks", "labels"}; +main_Image_1_in_39 = 0.65; +main_Image_1_in_40 = "roman_d"; +main_Image_1_in_41 = "rotate"; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +main_Message_1_in_2 = NULL; +main_Message_1_in_3 = NULL; +Executive("product version 4 3 2"); +$sync +main(); diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ucolumns.m b/octave_packages/secs2d-0.0.8/Utilities/Ucolumns.m new file mode 100644 index 0000000..bfa7fcc --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ucolumns.m @@ -0,0 +1,32 @@ +function c=Ucolumns(m) + +% +% function r=columns(m) +% +% Note: octave already has this function, +% this is here only for matlab compatibility + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +c = size(m,2); + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ucompconst.m b/octave_packages/secs2d-0.0.8/Utilities/Ucompconst.m new file mode 100644 index 0000000..f300c3c --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ucompconst.m @@ -0,0 +1,52 @@ +function C = Ucompconst (imesh,coeffn,coeffe) + + %% C = Ucompconst (imesh,coeffn,coeffe) + + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + + Nnodes =size(imesh.p,2); + Nelements =size(imesh.t,2); + + %%fprintf(1,'*--------------------*\n'); + %%fprintf(1,'building RHS\n*'); + + coeff = coeffn(imesh.t(1:3,:)); + wjacdet = imesh.wjacdet; + % build local matrix + Blocmat=zeros(3,Nelements); + for inode=1:3 + Blocmat(inode,:) = coeffe'.*coeff(inode,:).*wjacdet(inode,:); + %%fprintf(1,'----'); + end + + gnode=(imesh.t(1:3,:)); + %%fprintf(1,'--'); + % assemble global matrix + + C = sparse(gnode(:),1,Blocmat(:)); + + %%fprintf(1,'----*\nDONE!\n\n\n'); + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ucomplap.m b/octave_packages/secs2d-0.0.8/Utilities/Ucomplap.m new file mode 100644 index 0000000..eeb2824 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ucomplap.m @@ -0,0 +1,57 @@ +function L = Ucomplap (mesh,coeff) + + % L = Ufastcomplap (mesh,coeff) + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + Nnodes = length(mesh.p); + Nelements = length(mesh.t); + + %%fprintf(1,'*--------------------*\n'); + %%fprintf(1,'building Stiffness Matrix\n*'); + + areak = reshape(sum( mesh.wjacdet,1),1,1,Nelements); + shg = mesh.shg(:,:,:); + M = reshape(coeff,1,1,Nelements); + + % build local matrix + Lloc=zeros(3,3,Nelements); + for inode=1:3 + for jnode=1:3 + + Lloc(inode,jnode,:) = M .* sum( shg(:,inode,:) .* shg(:,jnode,:),1) .* areak; + %%fprintf(1,'-'); + + ginode(inode,jnode,:)=mesh.t(inode,:); + gjnode(inode,jnode,:)=mesh.t(jnode,:); + + %%fprintf(1,'-'); + + end + end + + L = sparse(ginode(:),gjnode(:),Lloc(:)); + %%fprintf(1,'--*\nDONE!\n\n\n'); + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ucompmass2.m b/octave_packages/secs2d-0.0.8/Utilities/Ucompmass2.m new file mode 100644 index 0000000..b93f0da --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ucompmass2.m @@ -0,0 +1,58 @@ +function Bmat = Ucompmass2 (imesh,Bvect,Cvect); + +% Bmat = Ucompmass2 (imesh,Bvect,Cvect); + + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + Nnodes =size(imesh.p,2); + Nelements =size(imesh.t,2); + + %%fprintf(1,'\n*--------------------*\n'); + %%fprintf(1,'building Mass Matrix\n*'); + + wjacdet =imesh.wjacdet(:,:); + coeff =Bvect(imesh.t(1:3,:)); + coeffe =Cvect(:); + + % build local matrix + Blocmat=zeros(3,Nelements); + for inode=1:3 + Blocmat(inode,:) = coeffe'.*coeff(inode,:).*wjacdet(inode,:); + %%fprintf(1,'----'); + end + + gnode=(imesh.t(1:3,:)); + %%fprintf(1,'--'); + + % assemble global matrix + + Bmat = sparse(gnode(:),gnode(:),Blocmat(:)); + + + %%fprintf(1,'----*\nDONE!\n\n\n'); + + + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Udescaling.m b/octave_packages/secs2d-0.0.8/Utilities/Udescaling.m new file mode 100644 index 0000000..017847d --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Udescaling.m @@ -0,0 +1,99 @@ +function [odata,omesh] = Udescaling(imesh,idata); + +% [odata,omesh] = Udescaling(imesh,idata); + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +load (file_in_path(path,'constants.mat')); + +omesh = imesh; +odata = idata; + +% scaling factors +% odata.xs = max(abs([max(imesh.p(1,:))-min(imesh.p(1,:)),max(imesh.p(2,:))-min(imesh.p(2,:))])); +% odata.Vs = Vth; +% odata.ns = norm(idata.D,inf); +% odata.us = un; + +% adimensional constants +% odata.etan2 = hbar^2 / (2*mndos*odata.xs^2*q); +% odata.etap2 = hbar^2 / (2*mpdos*odata.xs^2*q); +% odata.beta = Vth/odata.Vs; +% odata.dn2 = hbar^2 / (6*mndos*odata.xs^2*q*odata.Vs); +% odata.dp2 = hbar^2 / (6*mpdos*odata.xs^2*q*odata.Vs); +% odata.l2 = (odata.Vs*esi) / (odata.ns*odata.xs^2*q); +% odata.un = un/odata.us; +% odata.up = up/odata.us; + +% scaled quantities +odata.D = idata.D*odata.ns; +odata.n = idata.n*odata.ns; +odata.p = idata.p*odata.ns; +odata.Fn = (idata.Fn+log(ni/odata.ns))*odata.Vs; +odata.Fp = (idata.Fp-log(ni/odata.ns))*odata.Vs; +odata.V = idata.V*odata.Vs; +if (isfield(idata,'G')) + odata.G = idata.G*odata.Vs; +end +if (isfield(idata,'dt')) + odata.dt = idata.dt*odata.ts; +end + +if (isfield(idata,'un')) + odata.un = idata.un*odata.us; +else + odata.un = un; +end + +if (isfield(idata,'n0')) + odata.n0 = idata.n0*odata.ns; + odata.p0 = idata.p0*odata.ns; +else + odata.p0 = ni; + odata.n0 = ni; +end + +if (isfield(idata,'up')) + odata.up = idata.up*odata.us; +else + odata.up = up; +end +if (isfield(idata,'FDn')) + odata.FDn = idata.FDn*odata.Vs; +end +if (isfield(idata,'FDp')) + odata.FDp = idata.FDp*odata.Vs; +end + +if (isfield(idata,'Tl')) + odata.Tl = idata.Tl*odata.Ts; +end + +if (isfield(idata,'Tn')) + odata.Tn = idata.Tn*odata.Ts; +end + +if (isfield(idata,'Tp')) + odata.Tp = idata.Tp*odata.Ts; +end + +omesh.p = imesh.p*odata.xs; diff --git a/octave_packages/secs2d-0.0.8/Utilities/Udopdepmob.m b/octave_packages/secs2d-0.0.8/Utilities/Udopdepmob.m new file mode 100644 index 0000000..f44651c --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Udopdepmob.m @@ -0,0 +1,30 @@ +function mob=Udopdepmob (mesh,mu,par,D); + +% Udopdepmob (mu,par,D); + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +NI = sum(D(mesh.t(1:3,:)),1)'/3; +mob = par(1)*exp(-par(4)./NI) +... + (mu-par(2))./(1+(NI/par(5)).^par(7)) -... + par(3)./(1+(par(6)./NI).^par(8)); + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Udrawcurrent.net b/octave_packages/secs2d-0.0.8/Utilities/Udrawcurrent.net new file mode 100644 index 0000000..9cd86c8 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Udrawcurrent.net @@ -0,0 +1,653 @@ +// +// time: Fri May 18 15:17:11 2007 +// +// version: 3.2.0 (format), 4.4.4 (DX) +// +// +// MODULE main +// workspace: width = 645, height = 607 +// layout: snap = 0, width = 50, height = 50, align = NN +// +macro main( +) -> ( +) { + // + // node AutoColor[1]: x = 427, y = 242, inputs = 10, label = AutoColor + // +main_AutoColor_1_out_1, +main_AutoColor_1_out_2 = + AutoColor( + main_AutoColor_1_in_1, + main_AutoColor_1_in_2, + main_AutoColor_1_in_3, + main_AutoColor_1_in_4, + main_AutoColor_1_in_5, + main_AutoColor_1_in_6, + main_AutoColor_1_in_7, + main_AutoColor_1_in_8, + main_AutoColor_1_in_9, + main_AutoColor_1_in_10 + ) [instance: 1, cache: 1]; + // + // node FileSelector[1]: x = 51, y = 31, inputs = 0, label = FileSelector + // output[1]: visible = 1, type = 32, value = "__FILE__DX__" + // output[2]: visible = 1, type = 32, value = "__FILE__DX__" + // + // + // node Import[1]: x = 42, y = 108, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_FileSelector_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node AutoGlyph[1]: x = 51, y = 199, inputs = 7, label = AutoGlyph + // +main_AutoGlyph_1_out_1 = + AutoGlyph( + main_Import_1_out_1, + main_AutoGlyph_1_in_2, + main_AutoGlyph_1_in_3, + main_AutoGlyph_1_in_4, + main_AutoGlyph_1_in_5, + main_AutoGlyph_1_in_6, + main_AutoGlyph_1_in_7 + ) [instance: 1, cache: 1]; + // + // node Color[1]: x = 72, y = 328, inputs = 5, label = Color + // input[2]: defaulting = 0, visible = 1, type = 32, value = "black" + // input[3]: defaulting = 0, visible = 1, type = 5, value = .5 + // +main_Color_1_out_1 = + Color( + main_AutoGlyph_1_out_1, + main_Color_1_in_2, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[2]: x = 262, y = 266, inputs = 1, label = ShowConnections + // +main_ShowConnections_2_out_1 = + ShowConnections( + main_Import_1_out_1 + ) [instance: 2, cache: 1]; + // + // node Color[2]: x = 372, y = 359, inputs = 5, label = Color + // input[2]: defaulting = 0, visible = 1, type = 32, value = "blue" + // +main_Color_2_out_1 = + Color( + main_ShowConnections_2_out_1, + main_Color_2_in_2, + main_Color_2_in_3, + main_Color_2_in_4, + main_Color_2_in_5 + ) [instance: 2, cache: 1]; + // + // node Collect[1]: x = 280, y = 393, inputs = 3, label = Collect + // +main_Collect_1_out_1 = + Collect( + main_Color_1_out_1, + main_Color_2_out_1, + main_Collect_1_in_3 + ) [instance: 1, cache: 1]; + // + // node ColorBar[1]: x = 525, y = 290, inputs = 16, label = ColorBar + // input[9]: defaulting = 0, visible = 0, type = 16777248, value = {"black"} + // +main_ColorBar_1_out_1 = + ColorBar( + main_AutoColor_1_out_2, + main_ColorBar_1_in_2, + main_ColorBar_1_in_3, + main_ColorBar_1_in_4, + main_ColorBar_1_in_5, + main_ColorBar_1_in_6, + main_ColorBar_1_in_7, + main_ColorBar_1_in_8, + main_ColorBar_1_in_9, + main_ColorBar_1_in_10, + main_ColorBar_1_in_11, + main_ColorBar_1_in_12, + main_ColorBar_1_in_13, + main_ColorBar_1_in_14, + main_ColorBar_1_in_15, + main_ColorBar_1_in_16 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 283, y = 483, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 67108863, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[5]: defaulting = 0, visible = 0, type = 8, value = [0.466889 0.863877 0.166499] + // input[6]: defaulting = 0, visible = 0, type = 8, value = [0.466889 0.863877 4.74189] + // input[7]: defaulting = 0, visible = 0, type = 5, value = 1.01623 + // input[8]: defaulting = 0, visible = 0, type = 1, value = 1266 + // input[9]: defaulting = 0, visible = 0, type = 5, value = 0.543049 + // input[10]: defaulting = 0, visible = 0, type = 8, value = [0 1 0] + // input[11]: defaulting = 1, visible = 0, type = 5, value = 12.6739 + // input[12]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[15]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[16]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[17]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[18]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[22]: defaulting = 0, visible = 0, type = 32, value = "snow" + // input[25]: defaulting = 0, visible = 0, type = 32, value = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/doping.tif" + // input[26]: defaulting = 0, visible = 0, type = 32, value = "tiff" + // input[29]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[31]: defaulting = 0, visible = 0, type = 1, value = -5 + // input[33]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[34]: defaulting = 0, visible = 0, type = 3, value = 0 + // input[36]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[37]: defaulting = 0, visible = 0, type = 16777248, value = {"clear", "black", "blue", "blue"} + // input[38]: defaulting = 0, visible = 0, type = 16777248, value = {"background", "grid", "ticks", "labels"} + // input[39]: defaulting = 0, visible = 0, type = 5, value = 0.65 + // input[40]: defaulting = 0, visible = 0, type = 32, value = "roman_d" + // input[41]: defaulting = 0, visible = 0, type = 32, value = "panzoom" + // depth: value = 24 + // window: position = ( nan, inf), size = infx inf + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Collect_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; + // + // node RubberSheet[1]: x = 528, y = 498, inputs = 4, label = RubberSheet + // +main_RubberSheet_1_out_1 = + RubberSheet( + main_RubberSheet_1_in_1, + main_RubberSheet_1_in_2, + main_RubberSheet_1_in_3, + main_RubberSheet_1_in_4 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 95, y = 545, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_ShowConnections_1_in_1 + ) [instance: 1, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_AutoColor_1_in_1 = NULL; +main_AutoColor_1_in_2 = NULL; +main_AutoColor_1_in_3 = NULL; +main_AutoColor_1_in_4 = NULL; +main_AutoColor_1_in_5 = NULL; +main_AutoColor_1_in_6 = NULL; +main_AutoColor_1_in_7 = NULL; +main_AutoColor_1_in_8 = NULL; +main_AutoColor_1_in_9 = NULL; +main_AutoColor_1_in_10 = NULL; +main_AutoColor_1_out_2 = NULL; +main_FileSelector_1_out_1 = "__FILE__DX__"; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_AutoGlyph_1_in_2 = NULL; +main_AutoGlyph_1_in_3 = NULL; +main_AutoGlyph_1_in_4 = NULL; +main_AutoGlyph_1_in_5 = NULL; +main_AutoGlyph_1_in_6 = NULL; +main_AutoGlyph_1_in_7 = NULL; +main_AutoGlyph_1_out_1 = NULL; +main_Color_1_in_2 = "black"; +main_Color_1_in_3 = .5; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +main_ShowConnections_2_out_1 = NULL; +main_Color_2_in_2 = "blue"; +main_Color_2_in_3 = NULL; +main_Color_2_in_4 = NULL; +main_Color_2_in_5 = NULL; +main_Color_2_out_1 = NULL; +main_Collect_1_in_3 = NULL; +main_Collect_1_out_1 = NULL; +main_ColorBar_1_in_2 = NULL; +main_ColorBar_1_in_3 = NULL; +main_ColorBar_1_in_4 = NULL; +main_ColorBar_1_in_5 = NULL; +main_ColorBar_1_in_6 = NULL; +main_ColorBar_1_in_7 = NULL; +main_ColorBar_1_in_8 = NULL; +main_ColorBar_1_in_9 = {"black"}; +main_ColorBar_1_in_10 = NULL; +main_ColorBar_1_in_11 = NULL; +main_ColorBar_1_in_12 = NULL; +main_ColorBar_1_in_13 = NULL; +main_ColorBar_1_in_14 = NULL; +main_ColorBar_1_in_15 = NULL; +main_ColorBar_1_in_16 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 1; +main_Image_1_in_5 = [0.466889 0.863877 0.166499]; +main_Image_1_in_6 = [0.466889 0.863877 4.74189]; +main_Image_1_in_7 = 1.01623; +main_Image_1_in_8 = 1266; +main_Image_1_in_9 = 0.543049; +main_Image_1_in_10 = [0 1 0]; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = 0; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = NULL; +main_Image_1_in_18 = NULL; +main_Image_1_in_19 = 0; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = "snow"; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/doping.tif"; +main_Image_1_in_26 = "tiff"; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = 1; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = -5; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = 1; +main_Image_1_in_34 = 0; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = 1; +main_Image_1_in_37 = {"clear", "black", "blue", "blue"}; +main_Image_1_in_38 = {"background", "grid", "ticks", "labels"}; +main_Image_1_in_39 = 0.65; +main_Image_1_in_40 = "roman_d"; +main_Image_1_in_41 = "panzoom"; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +main_RubberSheet_1_in_1 = NULL; +main_RubberSheet_1_in_2 = NULL; +main_RubberSheet_1_in_3 = NULL; +main_RubberSheet_1_in_4 = NULL; +main_ShowConnections_1_in_1 = NULL; +Executive("product version 4 4 4"); +$sync +main(); diff --git a/octave_packages/secs2d-0.0.8/Utilities/Udrawedge.m b/octave_packages/secs2d-0.0.8/Utilities/Udrawedge.m new file mode 100644 index 0000000..59f57a0 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Udrawedge.m @@ -0,0 +1,57 @@ +function Udrawedge(mesh); + +# Udrawedge(mesh); + + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + dataname = mktemp("/tmp",".dx") + scriptname = mktemp("/tmp",".net"); + + UDXoutput2Ddata(dataname,mesh.p,mesh.t,mesh.p(1,:)','u',0,1,1); + + showmesh = file_in_path(path,"Ushowgrid.net"); + system (["cp " showmesh " " scriptname ]); + system (["sed -i \'s|__FILE__DX__|" dataname "|g\' " scriptname]); + + command = ["dx -program " scriptname " -execute -image >& /dev/null &"]; + system(command); + +endfunction + +function filename = mktemp (direct,ext); + +if (~exist(direct,"dir")) + error("trying to save temporary file to non existing directory") +end + +done=false; + +while ~done + filename = [direct,"/SECS2D.",num2str(floor(rand*1e7)),ext]; + if ~exist(filename,"file") + done =true; + end +end +endfunction \ No newline at end of file diff --git a/octave_packages/secs2d-0.0.8/Utilities/Udriftdepmob.m b/octave_packages/secs2d-0.0.8/Utilities/Udriftdepmob.m new file mode 100644 index 0000000..40990e5 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Udriftdepmob.m @@ -0,0 +1,40 @@ +function mob = Udriftdepmob(imesh,u0,F,V,vsat,b) + + +% mob = Ufielddepmob(imesh,u0,F,vsat,b) +% Computes field dependent mobility + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + + [Ex,Ey]= Updegrad(imesh,-V); + [Fx,Fy]= Updegrad(imesh,F); + fnmod = sqrt(Fx.^2+Fy.^2); + ef = abs(Fx.*Ex+Fy.*Ey)./fnmod; + + if Ucolumns(ef)>Urows(ef) + ef=ef'; + end + + mob = u0 ./ (1+(u0 .* ef ./ vsat).^b).^(1/b); + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Udriftdiffusion.m b/octave_packages/secs2d-0.0.8/Utilities/Udriftdiffusion.m new file mode 100644 index 0000000..602a48f --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Udriftdiffusion.m @@ -0,0 +1,95 @@ +function c=Udriftdiffusion(mesh,Dsides,guess,M,U,V,u) + +%% +% c=Udriftdiffusion(mesh,Dsides,guess,M,U,V,u) +% solves the drift diffusion equation +% $ -div ( u ( \nabla n - n \nabla V)) + M = U $ +%% + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +global DDG_RHS DDG_MASS %DEBUG_SGM + + +if (Ucolumns(guess)>Urows(guess)) + guess=guess'; +end + +if (Ucolumns(V)>Urows(V)) + V=V'; +end + +if (Ucolumns(U)>Urows(U)) + U=U'; +end +Nnodes = max(size(mesh.p)); +Nelements = max(size(mesh.t)); + + +% Set list of nodes with Dirichelet BCs +Dnodes=Unodesonside(mesh,Dsides); + +% Set values of Dirichelet BCs +Bc = guess(Dnodes); +% Set list of nodes without Dirichelet BCs +Varnodes = setdiff([1:Nnodes],Dnodes); + + +% Build LHS matrix and RHS +A = Uscharfettergummel(mesh,V,u); +if (isempty(DDG_MASS)) + DDG_MASS=Ucompmass2(mesh,ones(Nnodes,1),ones(Nelements,1)); +end +A = A + DDG_MASS.*spdiag(M,0); + +if (isempty(DDG_RHS)) + DDG_RHS=Ucompconst(mesh,ones(Nnodes,1),ones(Nelements,1)); +end +b = DDG_RHS.*U; + + + +%%%%%%%%DEBUG%%%%%%%%%%% +%DEBUG_SGM = A; + +%% Apply boundary conditions +A (Dnodes,:) = 0; +b (Dnodes) = 0; +b = b - A (:,Dnodes) * Bc; + +A(Dnodes,:)= []; +A(:,Dnodes)= []; + +b(Dnodes) = []; + +% Enforce positivity +% dA = abs(diag(A)); +% edA= abs(sum(triu(A,1)+tril(A,-1),1)); +% nondominant = find(dA < edA'); +% for ii=1:length(nondominant) +% A(nondominant(ii),nondominant(ii)) = edA(ii); +% end + +c = guess; + +c(Varnodes) = A \ b; + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Udriftdiffusion2.m b/octave_packages/secs2d-0.0.8/Utilities/Udriftdiffusion2.m new file mode 100644 index 0000000..63afa88 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Udriftdiffusion2.m @@ -0,0 +1,75 @@ +function c=Udriftdiffusion2(mesh,Dsides,guess,M,U,V,Vth,u) + +%% +% c=Udriftdiffusion(mesh,Dsides,guess,M,U,V,Vth,u) +% solves the drift diffusion equation +% $ -div ( u ( \nabla (n Vth) - n \nabla V)) + M = U $ +%% + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +global DDG_RHS DDG_MASS %DEBUG_SGM + +Nnodes = max(size(mesh.p)); +Nelements = max(size(mesh.t)); + + +% Set list of nodes with Dirichelet BCs +Dnodes=Unodesonside(mesh,Dsides); + +% Set values of Dirichelet BCs +Bc = guess(Dnodes); + +% Set list of nodes without Dirichelet BCs +Varnodes = setdiff([1:Nnodes],Dnodes); + +% Build LHS matrix and RHS +A = Uscharfettergummel2(mesh,V,u,Vth); +if (isempty(DDG_MASS)) + DDG_MASS=Ucompmass2(mesh,ones(Nnodes,1),ones(Nelements,1)); +end +A = A + DDG_MASS.*spdiag(M,0); + +if (isempty(DDG_RHS)) + DDG_RHS=Ucompconst(mesh,ones(Nnodes,1),ones(Nelements,1)); +end +b = DDG_RHS.*U; + + + +%%%%%%%%DEBUG%%%%%%%%%%% +%DEBUG_SGM = A; + +%% Apply boundary conditions +A (Dnodes,:) = 0; +b (Dnodes) = 0; +b = b - A (:,Dnodes) * Bc; + +A(Dnodes,:)= []; +A(:,Dnodes)= []; + +b(Dnodes) = []; + + +c = guess; +c(Varnodes) = A \ b; + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ufielddepmob.m b/octave_packages/secs2d-0.0.8/Utilities/Ufielddepmob.m new file mode 100644 index 0000000..3c5af8b --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ufielddepmob.m @@ -0,0 +1,43 @@ +function mob = Ufielddepmob(imesh,u0,F,vsat,b) + + +% mob = Ufielddepmob(imesh,u0,F,vsat,b) +% Computes field dependent mobility + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + +[Ex,Ey]=Updegrad(imesh,F); + + +ef = sqrt(Ex.^2+Ey.^2); + +if Ucolumns(ef)>Urows(ef) + ef=ef'; +end +if Ucolumns(u0)>Urows(u0) + u0=u0'; +end + +mob = u0 ./ (1+(u0 .* ef ./ vsat).^b).^(1/b); + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ufvsgcurrent.m b/octave_packages/secs2d-0.0.8/Utilities/Ufvsgcurrent.m new file mode 100644 index 0000000..ea43162 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ufvsgcurrent.m @@ -0,0 +1,74 @@ +function [jx,jy]=Ufvsgcurrent(omesh,n,psi,psith,coeffe); + +% [jx,jy]=Udrawcurrent(omesh,n,psi,psith,coeffe); + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +Nelem = size(omesh.t,2); +jx = NaN*ones(Nelem,1); +jy = jx; + +for iel=1:Nelem + + K = sum(omesh.wjacdet(:,iel)); + + dpsi1 = psi(omesh.t(3,iel))-psi(omesh.t(2,iel)); + dvth1 = psith(omesh.t(3,iel))-psith(omesh.t(2,iel)); + vthm1 = Utemplogm(psith(omesh.t(3,iel)),psith(omesh.t(2,iel))); + [bp,bn] = Ubern((dpsi1-dvth1)/vthm1); + t1 = omesh.p(:,omesh.t(3,iel))-omesh.p(:,omesh.t(2,iel)); + l1 = norm(t1,2); + t1 = t1/l1; + j1 = vthm1*(coeffe(iel)/l1) * ( n(omesh.t(3,iel)) * bp - ... + n(omesh.t(2,iel)) * bn) * t1; + + gg1= omesh.shg(:,2,iel)'*omesh.shg(:,3,iel)*l1^2; + + dpsi2 = psi(omesh.t(1,iel))-psi(omesh.t(3,iel)); + dvth2 = psith(omesh.t(1,iel))-psith(omesh.t(3,iel)); + vthm2 = Utemplogm(psith(omesh.t(1,iel)),psith(omesh.t(3,iel))); + [bp,bn] = Ubern((dpsi2-dvth2)/vthm2); + t2 = omesh.p(:,omesh.t(1,iel))-omesh.p(:,omesh.t(3,iel)); + l2 = norm(t2,2); + t2 = t2/l2; + j2 = vthm2*(coeffe(iel)/l2) * ( n(omesh.t(1,iel)) * bp - ... + n(omesh.t(3,iel)) * bn) * t2; + + gg2= omesh.shg(:,1,iel)'*omesh.shg(:,3,iel)*l2^2; + + dpsi3 = psi(omesh.t(2,iel))-psi(omesh.t(1,iel)); + dvth3 = psith(omesh.t(2,iel))-psith(omesh.t(1,iel)); + vthm3 = Utemplogm(psith(omesh.t(2,iel)),psith(omesh.t(1,iel))); + [bp,bn] = Ubern((dpsi3-dvth3)/vthm3); + t3 = omesh.p(:,omesh.t(2,iel))-omesh.p(:,omesh.t(1,iel)); + l3 = norm(t3,2); + t3 = t3/l3; + j3 = vthm3*(coeffe(iel)/l3) * ( n(omesh.t(2,iel)) * bp - ... + n(omesh.t(1,iel)) * bn) * t3; + + gg3= omesh.shg(:,2,iel)'*omesh.shg(:,1,iel)*l3^2; + + Jk = j1*gg1+j2*gg2+j3*gg3; + jx(iel) = Jk(1); + jy(iel) = Jk(2); + +end \ No newline at end of file diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ufvsgcurrent2.m b/octave_packages/secs2d-0.0.8/Utilities/Ufvsgcurrent2.m new file mode 100644 index 0000000..83b0e17 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ufvsgcurrent2.m @@ -0,0 +1,86 @@ +function [jx,jy]=Ufvsgcurrent2(omesh,n,psi,psith,coeffe); + + %% [jx,jy]=Udrawcurrent2(omesh,n,psi,psith,coeffe); + + %% This file is part of + %% + %% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator + %% ------------------------------------------------------------------- + %% Copyright (C) 2004-2006 Carlo de Falco + %% + %% + %% + %% SECS2D is free software; you can 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. + %% + %% SECS2D is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied warranty of + %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + %% GNU General Public License for more details. + %% + %% Youx should have received a copy of the GNU General Public License + %% along with SECS2D; If not, see . + + Nelem = size(omesh.t,2); + jx = NaN*ones(Nelem,1); + jy = jx; + coeffe = coeffe'; + %%for iel=1:Nelem + + + dpsi1 = (psi(omesh.t(3,:))-psi(omesh.t(2,:)))'; + dvth1 = (psith(omesh.t(3,:))-psith(omesh.t(2,:)))'; + vthm1 = Utemplogm(psith(omesh.t(3,:)),psith(omesh.t(2,:)))'; + [bp,bn] = Ubern((dpsi1-dvth1)./vthm1); + t1x = omesh.p(1,omesh.t(3,:))-omesh.p(1,omesh.t(2,:)); + t1y = omesh.p(2,omesh.t(3,:))-omesh.p(2,omesh.t(2,:)); + l1 = sqrt(t1x.^2+t1y.^2); + t1x = t1x./l1; + t1y = t1y./l1; + + j1x = vthm1.*(coeffe./l1) .* ( n(omesh.t(3,:))' .* bp - ... + n(omesh.t(2,:))' .* bn) .* t1x; + j1y = vthm1.*(coeffe./l1) .* ( n(omesh.t(3,:))' .* bp - ... + n(omesh.t(2,:))' .* bn) .* t1y; + gg1= -reshape(omesh.shg(1,2,:).*omesh.shg(1,3,:)+... + omesh.shg(2,2,:).*omesh.shg(2,3,:),1,[]).*l1.^2; + + dpsi2 = (psi(omesh.t(1,:))-psi(omesh.t(3,:)))'; + dvth2 = (psith(omesh.t(1,:))-psith(omesh.t(3,:)))'; + vthm2 = Utemplogm(psith(omesh.t(1,:)),psith(omesh.t(3,:)))'; + [bp,bn] = Ubern((dpsi2-dvth2)./vthm2); + t2x = omesh.p(1,omesh.t(1,:))-omesh.p(1,omesh.t(3,:)); + t2y = omesh.p(2,omesh.t(1,:))-omesh.p(2,omesh.t(3,:)); + l2 = sqrt(t2x.^2+t2y.^2); + t2x = t2x./l2; + t2y = t2y./l2; + j2x = vthm2.*(coeffe./l2) .* ( n(omesh.t(1,:))' .* bp - ... + n(omesh.t(3,:))' .* bn) .* t2x; + j2y = vthm2.*(coeffe./l2) .* ( n(omesh.t(1,:))' .* bp - ... + n(omesh.t(3,:))' .* bn) .* t2y; + gg2= -reshape(omesh.shg(1,1,:).*omesh.shg(1,3,:)+... + omesh.shg(2,1,:).*omesh.shg(2,3,:),1,[]).*l2.^2; + + dpsi3 = (psi(omesh.t(2,:))-psi(omesh.t(1,:)))'; + dvth3 = (psith(omesh.t(2,:))-psith(omesh.t(1,:)))'; + vthm3 = Utemplogm(psith(omesh.t(2,:)),psith(omesh.t(1,:)))'; + [bp,bn] = Ubern((dpsi3-dvth3)./vthm3); + t3x = omesh.p(1,omesh.t(2,:))-omesh.p(1,omesh.t(1,:)); + t3y = omesh.p(2,omesh.t(2,:))-omesh.p(2,omesh.t(1,:)); + l3 = sqrt(t3x.^2+t3y.^2); + t3x = t3x./l3; + t3y = t3y./l3; + j3x = vthm3.*(coeffe./l3) .* ( n(omesh.t(2,:))' .* bp - ... + n(omesh.t(1,:))' .* bn) .* t3x; + j3y = vthm3.*(coeffe./l3) .* ( n(omesh.t(2,:))' .* bp - ... + n(omesh.t(1,:))' .* bn) .* t3y; + gg3= -reshape(omesh.shg(1,2,:).*omesh.shg(1,1,:)+... + omesh.shg(2,2,:).*omesh.shg(2,1,:),1,[]).*l3.^2; + + jx = j1x.*gg1+j2x.*gg2+j3x.*gg3; + jy = j1y.*gg1+j2y.*gg2+j3y.*gg3; + + %%end + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ufvsgcurrent3.m b/octave_packages/secs2d-0.0.8/Utilities/Ufvsgcurrent3.m new file mode 100644 index 0000000..05650aa --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ufvsgcurrent3.m @@ -0,0 +1,146 @@ +function [Fx,Fy]=Ufvsgcurrent3(mesh,u,alpha,gamma,eta,beta); + + + ## -*- texinfo -*- + ## + ## @deftypefn {Function File} {[@var{jx},@var{jy}]} = Ufvsgcurrent3 @ + ## (@var{mesh}, @var{u}, @var{alpha}, @var{gamma}, @var{eta}, @var{beta}); + ## + ## + ## Builds the Scharfetter-Gummel approximation of the vector + ## field + ## + ## @iftex + ## @tex + ## $ \vect{J}(u) = \alpha \gamma (\eta\vect{\nabla}u-\vect{beta}u) $ + ## @end tex + ## @end iftex + ## @ifinfo + ## J(@var{u}) = @var{alpha}* @var{gamma} * (@var{eta} * grad @var{u} - @var{beta} * @var{u})) + ## @end ifinfo + ## + ## where: + ## @itemize @minus + ## @item @var{alpha} is an element-wise constant scalar function + ## @item @var{eta}, @var{u}, @var{gamma} are piecewise linear + ## conforming scalar functions + ## @item @var{beta} is an element-wise constant vector function + ## @end itemize + ## + ## J(@var{u}) is an element-wise constant vector function + ## + ## Instead of passing the vector field @var{beta} directly + ## one can pass a piecewise linear conforming scalar function + ## @var{phi} as the last input. In such case @var{beta} = grad @var{phi} + ## is assumed. If @var{phi} is a single scalar value @var{beta} + ## is assumed to be 0 in the whole domain. + ## + ## @seealso{Uscharfettergummel3} + ## @end deftypefn + + %% This file is part of + %% + %% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator + %% ------------------------------------------------------------------- + %% Copyright (C) 2004-2006 Carlo de Falco + %% + %% + %% + %% SECS2D is free software; you can 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. + %% + %% SECS2D is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied warranty of + %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + %% GNU General Public License for more details. + %% + %% Youx should have received a copy of the GNU General Public License + %% along with SECS2D; If not, see . + + Nelem = columns(mesh.t); + Nnodes = columns(mesh.p); + + uloc = u(mesh.t(1:3,:)); + + shgx = reshape(mesh.shg(1,:,:),3,Nelem); + shgy = reshape(mesh.shg(2,:,:),3,Nelem); + + x = reshape(mesh.p(1,mesh.t(1:3,:)),3,[]); + dx = [ (x(3,:)-x(2,:)) ; + (x(1,:)-x(3,:)) ; + (x(2,:)-x(1,:)) ]; + + y = reshape(mesh.p(2,mesh.t(1:3,:)),3,[]); + dy = [ (y(3,:)-y(2,:)) ; + (y(1,:) -y(3,:)) ; + (y(2,:) -y(1,:)) ]; + + ##ei = sqrt( dx.^2 + dy.^2 ); + + if all(size(beta)==1) + v12=0;v23=0;v31=0; + elseif all(size(beta)==[2,Nelem]) + v23 = beta(1,:) .* dx(1,:) + beta(2,:) .* dy(1,:); + v31 = beta(1,:) .* dx(2,:) + beta(2,:) .* dy(2,:); + v12 = beta(1,:) .* dx(3,:) + beta(2,:) .* dy(3,:); + elseif all(size(beta)==[Nnodes,1]) + betaloc = beta(mesh.t(1:3,:)); + v23 = betaloc(3,:)-betaloc(2,:); + v31 = betaloc(1,:)-betaloc(3,:); + v12 = betaloc(2,:)-betaloc(1,:); + end + + etaloc = eta(mesh.t(1:3,:)); + + eta23 = etaloc(3,:)-etaloc(2,:); + eta31 = etaloc(1,:)-etaloc(3,:); + eta12 = etaloc(2,:)-etaloc(1,:); + + etalocm1 = Utemplogm(etaloc(2,:),etaloc(3,:)); + etalocm2 = Utemplogm(etaloc(3,:),etaloc(1,:)); + etalocm3 = Utemplogm(etaloc(1,:),etaloc(2,:)); + + gammaloc = gamma(mesh.t(1:3,:)); + geloc = gammaloc.*etaloc; + + gelocm1 = Utemplogm(geloc(2,:),geloc(3,:)); + gelocm2 = Utemplogm(geloc(3,:),geloc(1,:)); + gelocm3 = Utemplogm(geloc(1,:),geloc(2,:)); + + [bp23,bm23] = Ubern( (v23 - eta23)./etalocm1); + [bp31,bm31] = Ubern( (v31 - eta31)./etalocm2); + [bp12,bm12] = Ubern( (v12 - eta12)./etalocm3); + + gfigfj = [ shgx(3,:) .* shgx(2,:) + shgy(3,:) .* shgy(2,:) ; + shgx(1,:) .* shgx(3,:) + shgy(1,:) .* shgy(3,:) ; + shgx(2,:) .* shgx(1,:) + shgy(2,:) .* shgy(1,:) ]; + + Fx = - alpha' .* ( gelocm1 .* etalocm1 .* dx(1,:) .* ... + gfigfj(1,:) .* ... + ( bp23 .* uloc(3,:)./etaloc(3,:) -... + bm23 .* uloc(2,:)./etaloc(2,:)) +... %% 1 + gelocm2 .* etalocm2 .* dx(2,:) .* ... + gfigfj(2,:) .* ... + (bp31 .* uloc(1,:)./etaloc(1,:) -... + bm31 .* uloc(3,:)./etaloc(3,:)) +... %% 2 + gelocm3 .* etalocm3 .* dx(3,:) .* ... + gfigfj(3,:) .* ... + (bp12 .* uloc(2,:)./etaloc(2,:) -... + bm12 .* uloc(1,:)./etaloc(1,:)) ... %% 3 + ); + + Fy = - alpha' .* ( gelocm1 .* etalocm1 .* dy(1,:) .* ... + gfigfj(1,:) .* ... + ( bp23 .* uloc(3,:)./etaloc(3,:) -... + bm23 .* uloc(2,:)./etaloc(2,:)) +... %% 1 + gelocm2 .* etalocm2 .* dy(2,:) .* ... + gfigfj(2,:) .* ... + (bp31 .* uloc(1,:)./etaloc(1,:) -... + bm31 .* uloc(3,:)./etaloc(3,:)) +... %% 2 + gelocm3 .* etalocm3 .* dy(3,:) .* ... + gfigfj(3,:) .* ... + (bp12 .* uloc(2,:)./etaloc(2,:) -... + bm12 .* uloc(1,:)./etaloc(1,:)) ... %% 3 + ); diff --git a/octave_packages/secs2d-0.0.8/Utilities/Uinvfermidirac.m b/octave_packages/secs2d-0.0.8/Utilities/Uinvfermidirac.m new file mode 100644 index 0000000..06d43f0 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Uinvfermidirac.m @@ -0,0 +1,62 @@ +function [fd]=Uinvfermidirac(eta,par); + +% [fd]=Uinvfermidirac(eta,par); + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +% reshape eta into a sorted vector +s = size(eta); +eta = eta(:); +[eta,order] = sort(eta); + +limits = Ufermidirac([-18,18],par); +low = limits(1); +high = limits(2); + +etalow = find(eta<=low); +etahigh = find(eta>=high); +etamid = find((etalow)); + +switch par +case 1/2 + load fdhalf; + fd(etalow) =log(eta(etalow)); + fd(etahigh)=(eta(etahigh)*3*sqrt(pi)/4).^(2/3); + if length(etamid) + fd(etamid) =log(linterp(a(:,2),exp(a(:,1)),eta(etamid))); + end +case -1/2 + load fdmhalf; + fd(etalow) =log(eta(etalow)); + fd(etahigh)=pi*(eta(etahigh).^2)/4; + if length(etamid) + fd(etamid) =log(linterp(a(:,2),exp(a(:,1)),eta(etamid))); + end +otherwise + error(['wrong parameter: par=' num2str(par)]) + return +end + + +% give answer in original order and shape +fd(order) = fd; +fd = reshape(fd,s); diff --git a/octave_packages/secs2d-0.0.8/Utilities/Uise2pde.m b/octave_packages/secs2d-0.0.8/Utilities/Uise2pde.m new file mode 100644 index 0000000..2fc5389 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Uise2pde.m @@ -0,0 +1,672 @@ +function [mesh,data_v]=Uise2pde(grid_file,pref,data_file_v,load_data,out_file) + + +## [mesh,data]=ise2pde3(grid_file,pref,data_file,load_data,out_file) +## ise2pde3 +## estrae dati dal formato DF-ISE di ISE a pdetool di Matlab +## grid_file contiene il nome del file di griglia da estrarre +## pref un prefisso che verra' dato ai files temporanei creati da grep +## data_file e' un cell array delle file da estrarre +## load_data e' un cell array che contiene i nomi delle grandezze da estrarre +## out_file e' il nome del file matlab opzionale per salvare i dati estratti +## +## 17-3-2004 ver 3.1 +## Marco Bellini marco_bellini_1@yahoo.it +## 14.02.2007 ver 3.2 +## Octave porting and bug fixes Carlo de Falco + +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +## +## CHANGES: +## - riconosce i nomi dei contatti e delle regioni +## - tratta anche dispositivi con una sola regione +## - fornisce informazioni sulla conversione +## +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +## +## TO DO LOG: +## +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +##esempio per debug +## prova a costruire una grid per pdetool +##data_file="/home/marco/IseDB/jfet/jsdd2_mdr.dat"; +##grid_file="/home/marco/IseDB/jfet/jsdd2_mdr.grd"; +##pref="/home/marco/IseDB/jfet/jsdd2"; + +## esempio per struttura onda viaggiante +## data_file={"/home/marco/IseDB/prova/spice/on1_onda1_tr_des.dat"}; +## grid_file="/home/marco/IseDB/prova/spice/on_mdr.grd"; +## pref="/home/marco/IseDB/prova/spice/on"; +## load_data={"ElectrostaticPotential"}; + +## dati da estrarre +##load_data={"DopingConcentration","BoronActiveConcentration","PhosphorusActiveConcentration"}; +##load_data={"ElectrostaticPotential","eDensity","hDensity","eCurrentDensity","BeamGeneration"}; + +##pdeplot(p1,e1,t1,"xydata",log10(abs(data(1,:)))',"zdata",log10(abs(data(1,:)))); +##[p1,e1,t1]=ise2pde(grid_file,pref); + +## leggo i vertici +## i punti sono ordinati per regione +## se la prima regione e' l'ossido ed ha 269 punti +## i primi 269 valori in p1 si riferiscono ai punti dell'ossido +## +## nei file di des.cmd di simulazione i punti vengono dati per ogni regione +## quindi i punti della frontiera tra ossido e silicio vengono ripetuti due +## volte (tra l'ossido e tra il silicio): e' necessario prenderli una volta +## sola +## siccome con piu' di due materiali diversi il discorso e' piu' complicato +## si sceglie di considerare in questo programma solo un ossido ed il +## silicio + + +## p1 conterra' le coordinate x e y dei vertici +[s,w]=unix(sprintf("grep Vertices %s",grid_file)); +n_vert_str = regexp(w,'([0-9]+)',"Tokens"); +n_vert=str2num(n_vert_str{1}{1}); +unix(sprintf("grep Vertices -A %d %s | tail -n+2 > %s_vertex.txt",n_vert,grid_file,pref)); +p1=load(strcat(pref,"_vertex.txt")); +unix(sprintf("rm %s_vertex.txt",pref)); +p1(:,2)=-p1(:,2); + + +fprintf("Found %d vertex\n",n_vert); + +##leggo gli edge +## el conterra' l'indice dei vertici degli edges degli elementi +## cioe' l'indice dei vertici dei lati dei triangoli e l'indice dei vertici +## dei segmenti +[s,w]=unix(sprintf("grep Edges %s",grid_file)); +n_edges_str = regexp(w,'([0-9]+)',"Tokens"); +n_edges=str2num(n_edges_str{1}{1}); +unix(sprintf("grep Edges -A %d %s | tail -n+2 > %s_edges.txt",n_edges,grid_file,pref)); +el=load(strcat(pref,"_edges.txt")); +unix(sprintf("rm %s_edges.txt",pref)); +fprintf("Found %d edges\n",n_edges); +clear n_edges; +el=el+1; + + +##leggo gli elementi triangolari +## el_tr contiene gli indici degli edge dei triangoli +[s,w]=unix(sprintf("grep Elements %s",grid_file)); +n_els_str = regexp(w,'([0-9]+)',"Tokens"); +n_els=str2num(n_els_str{1}{1}); +## leggo solo gli elementi che iniziano per 2 e che corrispondono ai +## triangoli, creando un file che contiene solo gli elementi triangolari +unix(sprintf("grep Elements -A %d %s | head -n %d | tail -n %d | awk '$1==2 {print $2,$3,$4}' > %s_elements2.txt",n_els,grid_file,n_els+1,n_els,pref)); +el_tr=load(strcat(pref,"_elements2.txt")); +unix(sprintf("rm %s_elements2.txt",pref)); +fprintf("Found %d triangular elements out of %d elements\n",length(el_tr),n_els); + + +## creo un file che contiene gli elementi "segmenti" +unix(sprintf("grep Elements -A %d %s | head -n %d | tail -n %d | awk '$1==1 {print $2,$3}' > %s_elements1.txt",n_els,grid_file,n_els+1,n_els,pref)); +##el_lin=load(strcat(pref,"_elements1.txt")); +##unix(sprintf("rm %s_elements1.txt",pref)); + + +## creo un indice che dice se l'elemento e' un triangolo o una linea +## e lo salvo nel file pref_linee1.txt; ci sara' un 1 se l'elemento i-esimo +## e' una linea o un 2 se e' un triangolo +unix(sprintf("grep Elements -A %d %s | head -n %d | tail -n %d | awk ' {print $1} ' > %s_linee1.txt",n_els,grid_file,n_els+1,n_els,pref)); +clear n_els; + +## leggo le regions +## cosi posso distinguere tra silicio, contatti e ossido +## al max e' possibile leggere 60 regions +[s,w]=unix(sprintf("grep regions -n %s | grep -v nb_regions | tr -d []=",grid_file)); +w2=w(11:length(w)); +n_regions=0; +l2=length(w2);cont=1;num=1;str="";begin=0; +while (cont %s_loc.txt",... + loc_d-1,grid_file ,loc_u+1,pref) ); +loc=load(sprintf("%s_loc.txt",pref)); +## loc contiene +## 0 per gli elementi interni +## 1 per gli esterni +## 2 per la frontiera +unix(sprintf("rm %s_loc.txt",pref)); +clear loc_u;clear loc_d; + + + + +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +## CONVERSIONE DELLA GRIGLIA +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +n_ed=max(size(el)); +n_el=max(size(el_tr)); + +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +## calcolo di E1 +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +## trova gli elementi sul bordo (esterni) +## del dispositivo (quelli rossi) +ind=find(loc==1); +e1=el(ind,:); + +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +## calcolo di T1 +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +el_si=sign(el_tr)+1; +el_si=sign(el_si); +## el_si contiene le posizioni degli elementi positivi +t1=zeros(n_el,4); + +## elementi tutti positivi: vertice di testa +ind=find( el_si(:,:)==1); +t1(ind)=el(el_tr(ind)+1,1); + +## elementi negativi: vertice di coda +ind=find( el_si(:,:)==0); +t1(ind)=el(-el_tr(ind),2); + +## inserisco il numero di subdominio + +## trovo il delimitatore inferiore di una regione +[s,w]=unix(sprintf("grep material -n %s | grep -v materials | awk '/material/ {print $1 }'",grid_file)); +mat_pos=sscanf(w,"%d:\n"); +[s,w]=unix(sprintf("grep material -n %s | grep -v materials | awk '/material/ {print $2 }' |tr -d =",grid_file)); +mat_type_lim=findstr(w,"\n"); +if isempty(mat_type_lim) + mat_type=w; +else + for ii=1:length(mat_type_lim)-1 + mat_type{ii}=w(mat_type_lim(ii)+1:mat_type_lim(ii+1)-1); + end + mat_type{ii+1}=w(mat_type_lim(ii)+1:end); +end + +[s,w]=unix(sprintf("grep material -n %s | grep -v materials | awk '/material/ {print $4 }' |tr -d =",grid_file)); +mat_name_lim=findstr(w,"\n"); +if isempty(mat_name_lim) + mat_name=w; +else + for ii=1:length(mat_name_lim)-1 + mat_name{ii}=w(mat_name_lim(ii)+1:mat_name_lim(ii+1)-1); + end + mat_name{ii+1}=w(mat_name_lim(ii)+1:end); +end + + +## leggo il tipo di elemento +## se e' un materiale i triangoli appartenenti a quel materiale otterranno +## indice pari all'indice della regione. t1(4,:)' perche' non ho ancora +## trasposto + +## se e' un contatto, i segmenti appartenenti a quel contatto saranno +## indicati con un numero in e(5,:)' (non trasposto) + +el_type=load(strcat(pref,"_linee1.txt")); +indice_tr=zeros(size(el_type)); +## indice_tr e' 1 nelle posizioni che corrispondono agli elementi triangolari nella lista +## totale degli elementi nel file *.grd +indice_tr(find(el_type==2))=1; +## ora faccio la somma cumulativa in modo che nella posizione i-esima del +## vettore degli elementi totali ci sia l'indice che identifica il triangolo +## i-esimo in el_tr : ho costruito una tabella di conversione dall'indice di +## ISE unico per triangoli e segmenti -> indice dei soli triangoli. +indice_tr=cumsum(indice_tr); +clear ind; + +## leggo gli elementi "segmento" +try +el_lin=load(strcat(pref,"_elements1.txt")); +catch +el_lin=-1; +end_try_catch + +## aggiungo 1 perche' gli elementi partono da 0 +el_lin=el_lin+1; +unix(sprintf("rm %s_elements1.txt",pref)); +## costruisco una mappa di conversione anche per gli elementi lineari (indicati da 1 in el_tr). +indice_lin=zeros(size(el_type)); +indice_lin(find(el_type==1))=1; +indice_lin=cumsum(indice_lin); +## +## creo un vettore che indica il tipo di elemento di frontiera +## 1 per i lati del dispositivo (elementi esterni) +## 2 per l'interfaccia ossido-silicio +## da 3 in poi per i contatti + +e_fron=ones(max(size(e1)),1); + +## AGGIUNGO LA FRONTIERA +## +clear ind1; +ind1=find(loc==2); +name_contact{1}="External"; +name_contact{2}="I. Frontier"; + +if (isempty(ind1)==0) +## aggiungo gli elementi di frontiera trovati al vettore degli edges e1 +## mettendo indice 2 + e1=[e1;el(ind1,:)]; + e_fron=[e_fron;2*ones(length(ind1),1)]; +end + +clear el_type + +## numero del contatto +n_contact=3; +## name_material contiene il nome del materiale i-esimo +## name_contact contiene il nome del contatto i-esimo + + +for n=1:n_regions + + if strcmp(mat_type{n},"Contact")==0 + +## leggo gli elementi che costituiscono una regione + if (n~=n_regions) + unix(sprintf(" head -n %d %s | tail -n+%d | tr -d [:cntrl:]} > %s_tmp2.txt", mat_pos(n+1)-2,grid_file,mat_pos(n)+2,pref)); + else +## trattare l'ultima regione che e' diversa + unix(sprintf(" tail -n+%d %s | tr -d [:cntrl:]} > %s_tmp2.txt",mat_pos(n)+2, grid_file,pref) ); + end ## e' l'ultima regione? + tmp_el=load(strcat(pref,"_tmp2.txt")); + tmp_el=tmp_el+1; +## trova i triangoli che fanno parte della regione n + t1(indice_tr(tmp_el),4)=n; + name_material{n}=mat_name{n}; + else +## la regione e' un contatto + + if (n~=n_regions) + unix(sprintf(" head -n %d %s | tail -n+%d | tr -d [:cntrl:]} > %s_tmp2.txt", mat_pos(n+1)-2,grid_file,mat_pos(n)+2,pref)); + else +## trattare l'ultima regione che e' diversa + unix(sprintf(" tail -n+%d %s | tr -d [:cntrl:]} > %s_tmp2.txt", mat_pos(n)+2,grid_file,pref) ); + end ## e' l'ultima regione? + tmp_el=load(strcat(pref,"_tmp2.txt")); +## tmp_el contiene gli indici dei vertici che appartengono al +## contatto: aggiungo 1 perche' ise parte da 0. + tmp_el=tmp_el+1; + +## predo i vertici la cui posizione e' in tmp_el e la converto da +## dessis a pde + e1=[e1;el_lin(indice_lin(tmp_el),:)]; + +## aggiungo il numero del contatto + tmp_el=tmp_el'; + e_fron=[e_fron;n_contact*ones(size(tmp_el))]; + + name_contact{n_contact}=regions(n); + n_contact=n_contact+1; + + + end ## non e' un contatto +end ## fine scansione regioni + +unix(sprintf("rm %s_linee1.txt",pref)); + + +## trasposizione +t1=t1'; +e1=e1'; +p1=p1'; + + + +## individuo a che regione appartengono dei vertici +## fondamentale per leggere i set di dati prodotti dalle simulazioni + +tmpt1=[t1(1,:),t1(2,:),t1(3,:);t1(4,:),t1(4,:),t1(4,:)]; +stmpt1=sortrows(tmpt1',1)'; +dtmpt1=diff(stmpt1(1,:)); +##clear stmpt1; +ind1=find(dtmpt1==1); +##%%% questa prende i valori dei vertici in ordine solo per TEST +##%%% reg_vert=[stmpt1(1,ind1),stmpt1(1,length(dtmpt1)+1)]; + +## reg_vert contiene la regione a cui il punto appartiene +reg_vert=[stmpt1(2,ind1),stmpt1(2,length(dtmpt1)+1)]; +clear tmpt1 stmpt1 dtmpt1 ind1; + + +## individuo i vertici appartenenti alla frontiera +## le righe precedenti hanno assegnato questi punti +## a una o all'altra regione. Nei file delle simulazioni questi +## punti sono assegnati casualmente ad una delle regioni secondo +## un criterio arbitrario. E' necessario individuare i punti alla +## frontiera per tenerne conto. + +## costruisco e1 completo +e1=[e1;zeros(size(e1))]; +e1=[e1;e_fron']; + +## trovo i punti di frontiera +ind1=find(loc==2); +## nel caso la frontiera non esista non fa niente + + + +if (isempty(ind1)~=1) +## controlla se c'e' una frontiera tra diversi elementi + + el=el'; + tmpe1=[el(1,ind1),el(2,ind1)]; + stmpe1=sortrows(tmpe1',1)'; + dtmpe1=diff(stmpe1(1,:)); + clear ind1; +## non e' detto che i vertici di frontiera siano ad incrementi unitari + ind1=find(dtmpe1>0); + +## in teoria dovrei controllare che non ci sia un solo elemento di +## frontiera +## if (length(ind1)>1) + front_vert=[stmpe1(1,ind1),stmpe1(1,length(dtmpe1)+1)]; +## else +## c'e' solo 1 punto di frontiera +##front_vert=[stmpe1(1,ind1)]; +##end + + + +## inserisco anche nel reg_vert l'informazione se un punto e' di frontiera +## in questo modo il valore assoluto indica la regione alla quale e' +## attribuito il valore. +## i punti con valore negativo sono punti di frontiera + + reg_vert(front_vert)=-reg_vert(front_vert); + + clear tmpe1 stmpe1 dtmpe1 ind1; +end % esiste la frontiera + +## % % test +## ind1=find(reg_vert==2); +## plot(p1(1,ind1),p1(2,ind1),'b.') +## whos ind1 +## hold on; +## ind1=find(reg_vert==1); +## whos ind1 +## plot(p1(1,ind1),p1(2,ind1),'g.') +## plot(p1(1,front_vert),p1(2,front_vert),'ro') +## whos front_vert + + + +## es. testato: ok +## ind=find(reg_vert==2); +## plot(p1(1,:),p1(2,:),'b.') +## hold on; +## plot(p1(1,ind1),p1(2,ind1),'g.') + + +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +## DATASETS % +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +if (exist("data_file_v")~=0) +## guardo quanti file devo leggere + n_data_file=max(size(data_file_v)); + + + for nf=1:n_data_file + + data_file=char(data_file_v(nf)); + +## leggo i nomi dei datasets + [s,w]=unix(sprintf("grep datasets %s",data_file)); + w2=w(18:length(w)-1); + + ndatasets=0; + datasets=cell(30,1); + l2=length(w2);cont=1;num=1;str="";begin=0; + while (cont %s_tmp.txt",n_vert,data_file,pref)); + +## estrae le righe che delimitano i dati da estrarre + +## del contiene le righe sotto le quali si trovano i valori sui vertici +## dei triangoli (Values) + [s,w]=unix(sprintf("grep Values -n %s_tmp.txt | awk '/Values/{print $1}' | tr -d : > %s_del.txt",pref,pref)); + del=load(sprintf("%s_del.txt",pref)); + unix(sprintf("rm %s_del.txt",pref)); + +## uel contiene le righe sopra le quali si trovano i valori sui vertici +## dei triangoli (}) + [s,w]=unix(sprintf("grep } -n %s_tmp.txt | awk '/}/ {print $1}' | tr -d : > %s_del.txt",pref,pref)); + uel=load(sprintf("%s_del.txt",pref)); + unix(sprintf("rm %s_del.txt",pref)); + +## nval contiene il numero valori sui vertici contenuto in questa +## sezione del file + [s,w]=unix(sprintf("grep Values %s_tmp.txt | tr -d [:alpha:]{\\(\\) > %s_nval.txt",pref,pref)); + nval=load(sprintf("%s_nval.txt",pref)); + unix(sprintf("rm %s_nval.txt",pref)); + + nload=max(size(load_data)); + data=zeros(nload,n_vert); + +##calcolo gli elementi ripetuti alla frontiera + n_rip=sum(loc==2)+1; + + nl=1;nd=1; + while(nl<=nload) + while(nd<=ndatasets) + if strcmp(load_data(nl),datasets(nd))==1 + +## controllo se il numero dati sui vertici e' < del +## numero totale dei vertici: accade quando c'e' dell' +## ossido + + if (nval(nd) %s_tmp2.txt", ddo, pref,dup,pref)); + tmp=load(strcat(pref,"_tmp2.txt")); ## tmp2 e' il vettore riga dei dati cercati +## inserisco i primi elementi: ossido, cioe' +## regione 2: gli elementi nel file .dat (var: tmp) sono +## ossido interno + frontiera. +## ind1 e' appunto dato da ossido + frontiera + + ind1=find(abs(reg_vert)==2 | reg_vert<0); + + data(nl,ind1)=tmp; + +## leggo la seconda regione + nd=nd+1; + dup=del(nd)+1; + c=1; ## trova il delimitatore successivo + while uel(c)<=dup + c=c+1; + end; + ddo=uel(c); + [s,w]=unix(sprintf(" head -n %d %s_tmp.txt | tail -n+%d | tr -d [:cntrl:]} > %s_tmp2.txt", ddo, pref,dup,pref)); + tmp=load(strcat(pref,"_tmp2.txt")); ## tmp2 e' il vettore riga dei dati cercati +## inserisco i secondi elementi +## silicio + frontiera + clear ind; + ind=find(abs(reg_vert)==1 | reg_vert<0 ); + data(nl,ind)=tmp; + + else +## caso non particolare +## metto a zero i dati della regione mancante + ind1=find(abs(reg_vert)==2 | reg_vert<0); + data(nl,ind1)=0; + +## leggo la regione + dup=del(nd)+1; + c=1; ## trova il delimitatore successivo + while uel(c)<=dup + c=c+1; + end; + ddo=uel(c); + [s,w]=unix(sprintf(" head -n %d %s_tmp.txt | tail -n+%d | tr -d [:cntrl:]} > %s_tmp2.txt", ddo, pref,dup,pref)); + tmp=load(strcat(pref,"_tmp2.txt")); ## tmp2 il vettore riga dei dati cercati + +## inserisco i primi elementi + ind=find(abs(reg_vert)==1 | reg_vert<0 ); + data(nl,ind)=tmp; + +##n_prev_region=length(tmp); +##data(nl,1:n_prev_region)=tmp; + + end ## trattamento casi particolari + + else +## il numero dei dati sui vertici e' = al numero +## dei vertici: uso lo stesso codice di ise2pde + dup=del(nd)+1; + c=1; ## trova il delimitatore successivo + while uel(c)<=dup + c=c+1; + end; + ddo=uel(c); + [s,w]=unix(sprintf(" head -n %d %s_tmp.txt | tail -n+%d | tr -d [:cntrl:]} > %s_tmp2.txt", ddo, pref,dup,pref)); + data(nl,:)=load(strcat(pref,"_tmp2.txt")); ## tmp2 e' il vettore riga dei dati cercati + end ## numero dei vertici = + end %if trovato il set + nd=nd+1; + end %nd + nd=1; + nl=nl+1; + end %nl + + clear nd nl; + + data_v(:,:,nf)=data(:,:); + end ## fine lettura n-esimo data_file + +end ## if c'e' un data_file +clear n_vert w2 l2 cont num str c; + +mesh.p=p1; +mesh.e=e1; +mesh.t=t1; +mesh.materials=name_material; +mesh.contacts=name_contact; + +for cont=1:length(name_material) + fprintf("Extracted region %d : %s\n",cont,char(name_material{cont})); +end; +for cont=3:length(name_contact) + fprintf("Extracted contact %d : %s\n",cont,char(name_contact{cont})); +end; + + +if exist("out_file") + if (exist("data_file_v")~=0) + save (out_file,"mesh","data"); + fprintf("mesh and data saved"); + else + save (out_file,"mesh"); + fprintf("mesh saved"); + end; +end + +unix(sprintf("rm %s_tmp.txt",pref)); +unix(sprintf("rm %s_tmp2.txt",pref)); + +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +## Cdf: Fix edge matrix and build output structure +##%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +return +mesh.e(7,end)=0; +mesh = Umeshproperties(mesh); + +alledges = [mesh.t([1,2,4],:),mesh.t([2,3,4],:),mesh.t([3,1,4],:)]; + + +for iedge = 1:size(mesh.e,2) + whatedgeL = find((mesh.e(1,iedge)==alledges(1,:)& mesh.e(2,iedge)==alledges(2,:))); + whatedgeR = find((mesh.e(1,iedge)==alledges(2,:)& mesh.e(2,iedge)==alledges(1,:))); + + if (length(whatedgeL)==1) + mesh.e(6,iedge)=alledges(3,whatedgeL); + end + + if (length(whatedgeR)==1) + mesh.e(7,iedge)=alledges(3,whatedgeR); + end + +end + +maxedge = max(mesh.e(5,:)); +intedges = find((mesh.e(6,:)~=0)&((mesh.e(7,:)~=0)&((mesh.e(7,:)~=(mesh.e(6,:)) ) ))); +mesh.e (5,intedges) = maxedge+1; +mesh.contacts{end+1} = "Interface"; + +return; \ No newline at end of file diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ujoinmeshes.m b/octave_packages/secs2d-0.0.8/Utilities/Ujoinmeshes.m new file mode 100644 index 0000000..a747db4 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ujoinmeshes.m @@ -0,0 +1,120 @@ +function mesh=Ujoinmeshes(mesh1,mesh2,s1,s2) + +% mesh=Ujoinmeshes(mesh1,mesh2,side1,side2) + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + +% make sure that the outside world is always +% on the same side of the boundary of mesh1 +[mesh1.e(6:7,:),I] = sort(mesh1.e(6:7,:)); +for ic=1:size(mesh1.e,2) + mesh1.e(1:2,ic) = mesh1.e(I(:,ic),ic); +end + +intnodes1=[]; +intnodes2=[]; + + +j1=[];j2=[]; +for is=1:length(s1) + side1 = s1(is);side2 = s2(is); + [i,j] = find(mesh1.e(5,:)==side1); + j1=[j1 j]; + [i,j] = find(mesh2.e(5,:)==side2); + oldregion(side1) = max(max(mesh2.e(6:7,j))); + j2=[j2 j]; +end + +intnodes1=[mesh1.e(1,j1),mesh1.e(2,j1)]; +intnodes2=[mesh2.e(1,j2),mesh2.e(2,j2)]; + +intnodes1 = unique(intnodes1); +[tmp,I] = sort(mesh1.p(1,intnodes1)); +intnodes1 = intnodes1(I); +[tmp,I] = sort(mesh1.p(2,intnodes1)); +intnodes1 = intnodes1(I); + +intnodes2 = unique(intnodes2); +[tmp,I] = sort(mesh2.p(1,intnodes2)); +intnodes2 = intnodes2(I); +[tmp,I] = sort(mesh2.p(2,intnodes2)); +intnodes2 = intnodes2(I); + +% delete redundant edges +mesh2.e(:,j2) = []; + +% change edge numbers +indici=[];consecutivi=[]; +indici = unique(mesh2.e(5,:)); +consecutivi (indici) = [1:length(indici)]+max(mesh1.e(5,:)); +mesh2.e(5,:)=consecutivi(mesh2.e(5,:)); + + +% change node indices in connectivity matrix +% and edge list +indici=[];consecutivi=[]; +indici = 1:size(mesh2.p,2); +offint = setdiff(indici,intnodes2); +consecutivi (offint) = [1:length(offint)]+size(mesh1.p,2); +consecutivi (intnodes2) = intnodes1; +mesh2.e(1:2,:)=consecutivi(mesh2.e(1:2,:)); +mesh2.t(1:3,:)=consecutivi(mesh2.t(1:3,:)); + + +% delete redundant points +mesh2.p(:,intnodes2) = []; + +% set region numbers +regions = unique(mesh1.t(4,:)); +newregions(regions) = 1:length(regions); +mesh1.t(4,:) = newregions(mesh1.t(4,:)); + +% set region numbers +regions = unique(mesh2.t(4,:)); +newregions(regions) = [1:length(regions)]+max(mesh1.t(4,:)); +mesh2.t(4,:) = newregions(mesh2.t(4,:)); +% set adjacent region numbers in edge structure 2 +[i,j] = find(mesh2.e(6:7,:)); +i = i+5; +mesh2.e(i,j) = newregions(mesh2.e(i,j)); +% set adjacent region numbers in edge structure 1 +mesh1.e(6,j1) = newregions(oldregion(mesh1.e(5,j1))); + +% make the new p structure +mesh.p = [mesh1.p mesh2.p]; +mesh.e = [mesh1.e mesh2.e]; +mesh.t = [mesh1.t mesh2.t]; + +% +% %double check to avoid degenerate triangles +% [p,ii,jj]=unique(mesh.p(1:2,:)','rows'); +% mesh.p =p'; +% mesh.e(1:2,:)=jj(mesh.e(1:2,:)); +% mesh.t(1:3,:)=jj(mesh.t(1:3,:)); +% +% [ii,jj] = find (mesh.e(1,:)==mesh.e(2,:)); +% mesh.e(:,jj) = []; +% [ii,jj] = find ((mesh.t(1,:)==mesh.t(2,:))|(mesh.t(1,:)==mesh.t(3,:))|(mesh.t(3,:)==mesh.t(2,:))); +% mesh.t(:,jj) = []; + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Umeshproperties.m b/octave_packages/secs2d-0.0.8/Utilities/Umeshproperties.m new file mode 100644 index 0000000..ef5c651 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Umeshproperties.m @@ -0,0 +1,76 @@ +function mesh=Umeshproperties(mesh) + +% +% mesh=Umeshproperties(mesh) +% precomputes some useful mesh properties +% + + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + + +weight = [1/3 1/3 1/3]; +areakk = 1/2; +Nelements = Ucolumns(mesh.t); + +jac([1,2],:) = [mesh.p(1,mesh.t(2,:))-mesh.p(1,mesh.t(1,:)); + mesh.p(1,mesh.t(3,:))-mesh.p(1,mesh.t(1,:))]; +jac([3,4],:) = [mesh.p(2,mesh.t(2,:))-mesh.p(2,mesh.t(1,:)); + mesh.p(2,mesh.t(3,:))-mesh.p(2,mesh.t(1,:))]; +jacdet = jac(1,:).*jac(4,:)-jac(2,:).*jac(3,:); + +degen=find(jacdet <= 0); +if ~isempty(degen) + fprintf(1,'invalid mesh element: %d fixing...\n',degen); + mesh.t(1:3,degen) = mesh.t([2,1,3],degen); + jac([1,2],degen) = [mesh.p(1,mesh.t(2,degen))-mesh.p(1,mesh.t(1,degen)); + mesh.p(1,mesh.t(3,degen))-mesh.p(1,mesh.t(1,degen))]; + jac([3,4],degen) = [mesh.p(2,mesh.t(2,degen))-mesh.p(2,mesh.t(1,degen)); + mesh.p(2,mesh.t(3,degen))-mesh.p(2,mesh.t(1,degen))]; + jacdet(degen) = jac(1,degen).*jac(4,degen)-jac(2,degen).*jac(3,degen); +end + +for inode = 1:3 + mesh.wjacdet(inode,:) = areakk .* jacdet .* weight(inode); +end + +mesh.shp = eye(3); + +x0 = mesh.p(1,mesh.t(1,:)); +y0 = mesh.p(2,mesh.t(1,:)); +x1 = mesh.p(1,mesh.t(2,:)); +y1 = mesh.p(2,mesh.t(2,:)); +x2 = mesh.p(1,mesh.t(3,:)); +y2 = mesh.p(2,mesh.t(3,:)); + +denom = (-(x1.*y0) + x2.*y0 + x0.*y1 - x2.*y1 - x0.*y2 + x1.*y2); +mesh.shg(1,1,:) = (y1 - y2)./denom; +mesh.shg(2,1,:) = -(x1 - x2)./denom; +mesh.shg(1,2,:) = -(y0 - y2)./denom; +mesh.shg(2,2,:) = (x0 - x2)./denom; +mesh.shg(1,3,:) = (y0 - y1)./denom; +mesh.shg(2,3,:) = -(x0 - x1)./denom; + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Umsh2pdetool.m b/octave_packages/secs2d-0.0.8/Utilities/Umsh2pdetool.m new file mode 100644 index 0000000..63c2ba4 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Umsh2pdetool.m @@ -0,0 +1,61 @@ +function msh=Umsh2pdetool(filename); + +## +## +## loadgmshmesh(filename); +## +## + +awk_command = "BEGIN { filename = ARGV[1] ; gsub(/\\./,""_"",filename) }\n\ +\n\ +/\\$NOD/,/\\$ENDNOD/ { \n\ + if ( FNR>2 ) \n\ + { \n\ + if($0 ~ /^[^\\$]/ ) \n\ + {\n\ + print ""p ( "" $1 "" ,:) = ["" $2 "" "" $3""];"" > filename ""_p.m"" \n\ + }\n\ + } \n\ +} \n\ +\n\ +/\\$ELM/,/\\$ENDNELM/ { \n\ + if ( $1 ~ /\\$ELM/ )\n\ + {\n\ + gsub(/\\$ELM/,""t=["")\n\ + print > filename ""_t.m""\n\ + gsub(/t=\\[/,""e=["")\n\ + print > filename ""_e.m""\n\ +\n\ + } else if ($1 ~ /\\$ENDELM/ ){\n\ + gsub(/\\$ENDELM/,""];"")\n\ + print > filename ""_t.m""\n\ + print > filename ""_e.m""\n\ + }\n\ + else if ( $2 == ""2"" )\n\ + {\n\ + print ( $6 "" "" $7 "" "" $8 "" "" $4) > filename ""_t.m"" \n\ + }\n\ + else if ( $2 == ""1"" )\n\ + {\n\ + print ( $6 "" "" $7 "" 0 0 "" $4 "" 0 0"") > filename ""_e.m"" \n\ + }\n\ + else if ( $2 == ""9"" )\n\ + {\n\ + print ( $6 "" "" $7 "" "" $8 "" "" $9 "" "" $10 "" "" $11 "" "" \ + $4) > filename ""_t.m"" \n\ + }\n\ + else if ( $2 == ""8"" )\n\ + {\n\ + print ( $6 "" "" $7 "" "" $8 "" 0 "" $4) > filename ""_e.m"" \n\ + }\n\ +}\n\ +\n\ +{ }" + +system(["awk '" awk_command "' " filename ".msh"]); +eval([ filename "_msh_p"]); +eval([ filename "_msh_e"]); +eval([ filename "_msh_t"]); + + +msh=struct("p",p',"t",t',"e",e'); \ No newline at end of file diff --git a/octave_packages/secs2d-0.0.8/Utilities/Umshcreatemesh.m b/octave_packages/secs2d-0.0.8/Utilities/Umshcreatemesh.m new file mode 100644 index 0000000..a00986a --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Umshcreatemesh.m @@ -0,0 +1,17 @@ +function omesh=Umshcreatemesh(geometry,scalefactor,refine); + +## +## +## omesh=Umshcreatemesh(geometry,scalefactor); +## +## + +if nargin==2 + refine =1; +end + +system(["gmsh -format msh1 -2 -scale " num2str(scalefactor) " -clscale ",... + num2str(refine) " " geometry ".geo"]); + +omesh= Umsh2pdetool(geometry); +omesh = Umeshproperties(omesh); diff --git a/octave_packages/secs2d-0.0.8/Utilities/Unodesonside.m b/octave_packages/secs2d-0.0.8/Utilities/Unodesonside.m new file mode 100644 index 0000000..95a01ad --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Unodesonside.m @@ -0,0 +1,37 @@ +function Dnodes=Unodesonside(mesh,Dsides); + +% Dnodes=Unodesonside(mesh,Dsides); + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + +Dedges =[]; + +for ii = 1:length(Dsides) + Dedges=[Dedges,find(mesh.e(5,:)==Dsides(ii))]; +end + +% Set list of nodes with Dirichelet BCs +Dnodes = mesh.e(1:2,Dedges); +Dnodes = [Dnodes(1,:) Dnodes(2,:)]; +Dnodes = unique(Dnodes); + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Updegrad.m b/octave_packages/secs2d-0.0.8/Utilities/Updegrad.m new file mode 100644 index 0000000..5f562c4 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Updegrad.m @@ -0,0 +1,39 @@ +function [Fx,Fy]=Updegrad(mesh,F); + +% [Fx,Fy]=Updegrad(mesh,F); +% +% computes piecewise constant +% gradient of a piecewise linear +% scalar function F defined on +% the mesh structure described by mesh + + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + + +shgx = reshape(mesh.shg(1,:,:),3,[]); +Fx = sum(shgx.*F(mesh.t(1:3,:)),1); +shgy = reshape(mesh.shg(2,:,:),3,[]); +Fy = sum(shgy.*F(mesh.t(1:3,:)),1); diff --git a/octave_packages/secs2d-0.0.8/Utilities/Updemesh.m b/octave_packages/secs2d-0.0.8/Utilities/Updemesh.m new file mode 100644 index 0000000..5ffa43e --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Updemesh.m @@ -0,0 +1,75 @@ +function Updemesh(varargin); + +% Udrawedge(mesh); + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + + +if nargin == 1 + + Udrawedge(varargin{1}); + +elseif nargin == 2 + + mesh = varargin{1}; + u = varargin{2}; + + dataname = mktemp("/tmp",".dx"); + scriptname = mktemp("/tmp",".net"); + + UDXoutput2Ddata(dataname,mesh.p,mesh.t,u,'u',0,1,1); + + + showmesh = file_in_path(path,"Urubbersheet.net"); + + system (["cp " showmesh " " scriptname]); + system (["sed -i \'s|__FILE__DX__|" dataname "|g\' " scriptname]); + + command = ["dx -program " scriptname " -execute -image >& /dev/null &"]; + system(command); + +else + + fprintf(1,"wrong number of parameters\n\n") + +end + +endfunction + +function filename = mktemp (direct,ext); + +if (~exist(direct,"dir")) + error("trying to save temporary file to non existing directory") +end + +done=false; + +while ~done + filename = [direct,"/SECS2D.",num2str(floor(rand*1e7)),ext]; + if ~exist(filename,"file") + done =true; + end +end +endfunction \ No newline at end of file diff --git a/octave_packages/secs2d-0.0.8/Utilities/Updesurf.m b/octave_packages/secs2d-0.0.8/Utilities/Updesurf.m new file mode 100644 index 0000000..3961029 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Updesurf.m @@ -0,0 +1,72 @@ +function Updesurf(varargin); + +# Updemesh(varargin); + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + +if nargin == 1 + + Udrawedge(varargin{1}); + +elseif nargin == 2 + + mesh = varargin{1}; + u = varargin{2}; + + dataname = mktemp("/tmp",".dx"); + scriptname = mktemp("/tmp",".net"); + + UDXoutput2Ddata(dataname,mesh.p,mesh.t,u,'u',0,1,1); + + showmesh = file_in_path(path,"Ucoloredrubbersheet.net"); + system (["cp " showmesh " " scriptname]); + system (["sed -i \'s|__FILE__DX__|" dataname "|g\' " scriptname]); + + command = ["dx -program " scriptname " -execute -image >& /dev/null &"]; + system(command); + +else + + fprintf(1,"wrong number of parameters\n\n") + +end + +endfunction + +function filename = mktemp (direct,ext); + +if (~exist(direct,"dir")) + error("trying to save temporary file to non existing directory") +end + +done=false; + +while ~done + filename = [direct,"/SECS2D.",num2str(floor(rand*1e7)),ext]; + if ~exist(filename,"file") + done =true; + end +end +endfunction \ No newline at end of file diff --git a/octave_packages/secs2d-0.0.8/Utilities/Urows.m b/octave_packages/secs2d-0.0.8/Utilities/Urows.m new file mode 100644 index 0000000..73d0bdc --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Urows.m @@ -0,0 +1,31 @@ +function r=Urows(m) + +% +% function r=rows(m) +% + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +s = size(m); +r = s(1); + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Urrextrapolation.m b/octave_packages/secs2d-0.0.8/Utilities/Urrextrapolation.m new file mode 100644 index 0000000..3058538 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Urrextrapolation.m @@ -0,0 +1,40 @@ +function s = Urrextrapolation(X) + +% s = Urrextrapolation(X) +% RRE vector extrapolation see +% Smith, Ford & Sidi SIREV 29 II 06/1987 + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + if (Ucolumns(X)>Urows(X)) + X=X'; + end + + % compute first and second variations + U = X(:,2:end) - X(:,1:end-1); + V = U(:,2:end) - U(:,1:end-1); + + % eliminate unused u_k column + U(:,end) = []; + + s = X(:,1) - U * pinv(V) * U(:,1); + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Urubbersheet.net b/octave_packages/secs2d-0.0.8/Utilities/Urubbersheet.net new file mode 100644 index 0000000..e462620 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Urubbersheet.net @@ -0,0 +1,519 @@ +// +// time: Sun Jan 22 22:27:15 2006 +// +// version: 3.2.0 (format), 4.3.2 (DX) +// +// +// MODULE main +// workspace: width = 319, height = 463 +// layout: snap = 0, width = 50, height = 50, align = NN +// +macro main( +) -> ( +) { + // + // node FileSelector[1]: x = 51, y = 32, inputs = 0, label = FileSelector + // output[1]: visible = 1, type = 32, value = "__FILE__DX__" + // output[2]: visible = 1, type = 32, value = "__FILE__DX__" + // + // + // node Import[1]: x = 104, y = 118, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_FileSelector_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 77, y = 190, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_Import_1_out_1 + ) [instance: 1, cache: 1]; + // + // node RubberSheet[1]: x = 221, y = 272, inputs = 4, label = RubberSheet + // +main_RubberSheet_1_out_1 = + RubberSheet( + main_ShowConnections_1_out_1, + main_RubberSheet_1_in_2, + main_RubberSheet_1_in_3, + main_RubberSheet_1_in_4 + ) [instance: 1, cache: 1]; + // + // node Color[1]: x = 106, y = 286, inputs = 5, label = Color + // input[2]: defaulting = 0, visible = 1, type = 32, value = "white" + // +main_Color_1_out_1 = + Color( + main_RubberSheet_1_out_1, + main_Color_1_in_2, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 69, y = 401, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 67108863, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[5]: defaulting = 0, visible = 0, type = 8, value = [21 30 0] + // input[6]: defaulting = 0, visible = 0, type = 8, value = [16.1231 -127.854 94.5005] + // input[7]: defaulting = 0, visible = 0, type = 5, value = 98.629 + // input[8]: defaulting = 0, visible = 0, type = 1, value = 640 + // input[9]: defaulting = 0, visible = 0, type = 5, value = 0.751 + // input[10]: defaulting = 0, visible = 0, type = 8, value = [0.0793885 0.51022 0.856372] + // input[11]: defaulting = 1, visible = 0, type = 5, value = 30.0001 + // input[12]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[15]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[16]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[17]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[18]: defaulting = 1, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[29]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[41]: defaulting = 0, visible = 0, type = 32, value = "rotate" + // depth: value = 24 + // window: position = (0.0547,0.1497), size = 0.6387x0.6836 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Color_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_FileSelector_1_out_1 = "/tmp/tmp.dx"; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_ShowConnections_1_out_1 = NULL; +main_RubberSheet_1_in_2 = NULL; +main_RubberSheet_1_in_3 = NULL; +main_RubberSheet_1_in_4 = NULL; +main_RubberSheet_1_out_1 = NULL; +main_Color_1_in_2 = "white"; +main_Color_1_in_3 = NULL; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 1; +main_Image_1_in_5 = [21 30 0]; +main_Image_1_in_6 = [16.1231 -127.854 94.5005]; +main_Image_1_in_7 = 98.629; +main_Image_1_in_8 = 640; +main_Image_1_in_9 = 0.751; +main_Image_1_in_10 = [0.0793885 0.51022 0.856372]; +main_Image_1_in_11 = NULL; +main_Image_1_in_12 = 0; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = NULL; +main_Image_1_in_18 = NULL; +main_Image_1_in_19 = 0; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = NULL; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = NULL; +main_Image_1_in_26 = NULL; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = 1; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = NULL; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = NULL; +main_Image_1_in_34 = NULL; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = NULL; +main_Image_1_in_37 = NULL; +main_Image_1_in_38 = NULL; +main_Image_1_in_39 = NULL; +main_Image_1_in_40 = NULL; +main_Image_1_in_41 = "rotate"; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +Executive("product version 4 3 2"); +$sync +main(); diff --git a/octave_packages/secs2d-0.0.8/Utilities/Uscaling.m b/octave_packages/secs2d-0.0.8/Utilities/Uscaling.m new file mode 100644 index 0000000..bc22970 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Uscaling.m @@ -0,0 +1,174 @@ +function [odata,omesh] = Uscaling(imesh,idata); + +% [odata,omesh] = Uscaling(imesh,idata); + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +load (file_in_path(path,'constants.mat')); + +omesh = imesh; +odata = idata; + +% scaling factors +odata.xs = max(abs([max(imesh.p(1,:))-min(imesh.p(1,:)),max(imesh.p(2,:))-min(imesh.p(2,:))])); +odata.Vs = Vth; +odata.ns = norm(idata.D,inf); +odata.us = un; +odata.ts = (odata.xs^2)/(odata.Vs*odata.us); +odata.Ts = T0; +odata.kappas = odata.Vs^2*q*odata.us*odata.ns/odata.Ts; + +% adimensional constants +odata.etan2 = hbar^2 / (2*mndos*odata.xs^2*q*odata.Vs); + +% 3-valley masses +odata.etanxx2 = hbar^2 / (2*mnl*odata.xs^2*q*odata.Vs); +odata.etanxy2 = hbar^2 / (2*mnt*odata.xs^2*q*odata.Vs); + +odata.etanyx2 = hbar^2 / (2*mnt*odata.xs^2*q*odata.Vs); +odata.etanyy2 = hbar^2 / (2*mnl*odata.xs^2*q*odata.Vs); + +odata.etanzx2 = hbar^2 / (2*mnt*odata.xs^2*q*odata.Vs); +odata.etanzy2 = hbar^2 / (2*mnt*odata.xs^2*q*odata.Vs); + + +odata.etap2 = hbar^2 / (2*mhdos*odata.xs^2*q*odata.Vs); +odata.beta = Vth/odata.Vs; +odata.dn2 = hbar^2 / (4*rn*mndos*odata.xs^2*q*odata.Vs); +odata.dp2 = hbar^2 / (4*rp*mhdos*odata.xs^2*q*odata.Vs); +odata.l2 = (odata.Vs*esi) / (odata.ns*odata.xs^2*q); +odata.l2ox = (odata.Vs*esio2) / (odata.ns*odata.xs^2*q); + +if (isfield(idata,'un')) + odata.un = idata.un/odata.us; +else + odata.un = un/odata.us; +end + +if (isfield(idata,'up')) + odata.up = idata.up/odata.us; +else + odata.up = up/odata.us; +end + +if (isfield(idata,'FDn')) + odata.FDn = idata.FDn/odata.Vs; +end +if (isfield(idata,'FDp')) + odata.FDp = idata.FDp/odata.Vs; +end + +if (isfield(idata,'tn')) + odata.tn = idata.tn/odata.ts; +else + odata.tn = tn/odata.ts; +end +if (isfield(idata,'tp')) + odata.tp = idata.tp/odata.ts; +else + odata.tp = tp/odata.ts; +end +if (isfield(idata,'twn')) + odata.twn = idata.twn/odata.ts; +else + odata.twn = twn/odata.ts; +end +if (isfield(idata,'twp')) + odata.twp = idata.twp/odata.ts; +else + odata.twp = twp/odata.ts; +end + +if (isfield(idata,'kappa')) + odata.kappa = idata.kappa /odata.kappas; +else + odata.kappa = kappaSi/odata.kappas; +end + +odata.ni = ni/odata.ns; +if (isfield(idata,'n0')) + odata.n0 = idata.n0 /odata.ns; + odata.p0 = idata.p0 /odata.ns; +else + odata.n0 = ni /odata.ns; + odata.p0 = ni /odata.ns; +end +odata.Nc = Nc/odata.ns; +odata.Nv = Nv/odata.ns; + +odata.ei = Egap/(2*q*odata.Vs) - log(Nv/Nc)/2; +odata.eip = Egap/(2*q*odata.Vs) + log(Nv/Nc)/2; +odata.Egap = Eg0/(q*odata.Vs); + +odata.wn2 = 6*sqrt(mndos*2*Kb*T0/(pi*hbar^2))/(ni*odata.xs^2); + +odata.vsatn = vsatn * odata.xs / (odata.us * odata.Vs); +odata.vsatp = vsatp * odata.xs / (odata.us * odata.Vs); +odata.mubn = mubn; +odata.mubp = mubp; +odata.mudopparn = [ mudopparn(1:3)/odata.us; +mudopparn(4:6)/odata.ns; +mudopparn(7:8) ]; +odata.mudopparp = [ mudopparp(1:3)/odata.us; +mudopparp(4:6)/odata.ns; +mudopparp(7:8) ]; + +% 3-valley weights +odata.wnx2 = 2*sqrt(mnt*2*Kb*odata.Ts/(pi*hbar^2))/(ni*odata.xs^2); +odata.wny2 = odata.wnx2; +odata.wnz2 = 2*sqrt(mnl*2*Kb*odata.Ts/(pi*hbar^2))/(ni*odata.xs^2); + +% 3-valley weights +odata.wnx2FD = 2*sqrt(mnt*2*Kb*odata.Ts/(pi*hbar^2))/(odata.ns*odata.xs^2); +odata.wny2FD = odata.wnx2FD; +odata.wnz2FD = 2*sqrt(mnl*2*Kb*odata.Ts/(pi*hbar^2))/(odata.ns*odata.xs^2); + +odata.mg = Egap/(2*Kb*odata.Ts) - log(Nv/Nc)/2; + + +% scaled quantities +odata.D = idata.D/odata.ns; +odata.n = idata.n/odata.ns; +odata.p = idata.p/odata.ns; +odata.Fn = idata.Fn/odata.Vs-log(ni/odata.ns); +odata.Fp = idata.Fp/odata.Vs+log(ni/odata.ns); +odata.V = idata.V/odata.Vs; +if (isfield(idata,'G')) + odata.G= idata.G/odata.Vs; +end +if (isfield(idata,'dt')) + odata.dt= idata.dt/odata.ts; +end +if (isfield(idata,'Tl')) + odata.Tl= idata.Tl/odata.Ts; +end +if (isfield(idata,'Tn')) + odata.Tn= idata.Tn/odata.Ts; +end +if (isfield(idata,'Tp')) + odata.Tp= idata.Tp/odata.Ts; +end + + +omesh.p = imesh.p/odata.xs; + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Uscharfettergummel.m b/octave_packages/secs2d-0.0.8/Utilities/Uscharfettergummel.m new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/secs2d-0.0.8/Utilities/Uscharfettergummel2.m b/octave_packages/secs2d-0.0.8/Utilities/Uscharfettergummel2.m new file mode 100644 index 0000000..fada6cf --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Uscharfettergummel2.m @@ -0,0 +1,100 @@ +function SG=Uscharfettergummel2(mesh,v,acoeff,bcoeff) + +% +% SG=Ufastscharfettergummel2(mesh,v,acoeff,bcoeff) +% +% +% Builds the Scharfetter-Gummel matrix for the +% the discretization of the LHS +% of the Drift-Diffusion equation: +% +% $ -\div (a(x) (\grad (b(x) u) - b(x) u \grad v'(x) ))= f $ +% +% where a(x) is piecewise constant +% and v(x),b(x) is piecewise linear, so that +% v'(x) is still piecewise constant +% and u is the unknown +% + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + +Nnodes = length(mesh.p); +Nelements = length(mesh.t); + +areak = reshape (sum( mesh.wjacdet,1),1,1,Nelements); +shg = mesh.shg(:,:,:); +M = reshape (acoeff,1,1,Nelements); + + +% build local Laplacian matrix + +Lloc=zeros(3,3,Nelements); + +for inode=1:3 + for jnode=1:3 + + ginode(inode,jnode,:)=mesh.t(inode,:); + gjnode(inode,jnode,:)=mesh.t(jnode,:); + Lloc(inode,jnode,:) = M .* sum( shg(:,inode,:) .* shg(:,jnode,:),1) .* areak; + + end +end + +vloc = v(mesh.t(1:3,:)); +bloc = bcoeff(mesh.t(1:3,:)); + +blocm1 = Utemplogm(bloc(3,:),bloc(2,:)); +blocm2 = Utemplogm(bloc(1,:),bloc(3,:)); +blocm3 = Utemplogm(bloc(1,:),bloc(2,:)); + +[bp12,bm12] = Ubern(((vloc(2,:)-vloc(1,:))-(bloc(2,:)-bloc(1,:)))./blocm3); +[bp13,bm13] = Ubern(((vloc(3,:)-vloc(1,:))-(bloc(3,:)-bloc(1,:)))./blocm2); +[bp23,bm23] = Ubern(((vloc(3,:)-vloc(2,:))-(bloc(3,:)-bloc(2,:)))./blocm1); + +bp12 = reshape(blocm3.*bp12,1,1,Nelements).*Lloc(1,2,:); +bm12 = reshape(blocm3.*bm12,1,1,Nelements).*Lloc(1,2,:); +bp13 = reshape(blocm2.*bp13,1,1,Nelements).*Lloc(1,3,:); +bm13 = reshape(blocm2.*bm13,1,1,Nelements).*Lloc(1,3,:); +bp23 = reshape(blocm1.*bp23,1,1,Nelements).*Lloc(2,3,:); +bm23 = reshape(blocm1.*bm23,1,1,Nelements).*Lloc(2,3,:); + +SGloc(1,1,:) = -bm12-bm13; +SGloc(1,2,:) = bp12; +SGloc(1,3,:) = bp13; + +SGloc(2,1,:) = bm12; +SGloc(2,2,:) = -bp12-bm23; +SGloc(2,3,:) = bp23; + +SGloc(3,1,:) = bm13; +SGloc(3,2,:) = bm23; +SGloc(3,3,:) = -bp13-bp23; + +##SGloc=[-bm12-bm13, bp12 , bp13 +## bm12 , -bp12-bm23, bp23 +## bm13 , bm23 , -bp13-bp23]; + +SG = sparse(ginode(:),gjnode(:),SGloc(:)); + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Uscharfettergummel3.m b/octave_packages/secs2d-0.0.8/Utilities/Uscharfettergummel3.m new file mode 100644 index 0000000..252cc4e --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Uscharfettergummel3.m @@ -0,0 +1,290 @@ +function S = Uscharfettergummel3(mesh,alpha,gamma,eta,beta) + + ## -*- texinfo -*- + ## + ## @deftypefn {Function File} @ + ## {@var{S}} = Uscharfettergummel3 (@var{mesh}, @var{alpha}, @ + ## @var{gamma}, @var{eta}, @var{beta}) + ## + ## + ## Builds the Scharfetter-Gummel matrix for the + ## discretization of the LHS + ## of the equation: + ## + ## @iftex + ## @tex + ## $ -div ( \alpha \gamma ( \eta \vect{\nabla} u - \vect{beta} u )) = f $ + ## @end tex + ## @end iftex + ## @ifinfo + ## -div (@var{alpha} * @var{gamma} (@var{eta} grad u - @var{beta} u )) = f + ## @end ifinfo + ## + ## where: + ## @itemize @minus + ## @item @var{alpha} is an element-wise constant scalar function + ## @item @var{eta}, @var{gamma} are piecewise linear conforming + ## scalar functions + ## @item @var{beta} is an element-wise constant vector function + ## @end itemize + ## + ## Instead of passing the vector field @var{beta} directly + ## one can pass a piecewise linear conforming scalar function + ## @var{phi} as the last input. In such case @var{beta} = grad @var{phi} + ## is assumed. If @var{phi} is a single scalar value @var{beta} + ## is assumed to be 0 in the whole domain. + ## + ## Example: + ## @example + ## [mesh.p,mesh.e,mesh.t] = Ustructmesh([0:1/3:1],[0:1/3:1],1,1:4); + ## mesh = Umeshproperties(mesh); + ## x = mesh.p(1,:)'; + ## Dnodes = Unodesonside(mesh,[2,4]); + ## Nnodes = columns(mesh.p); Nelements = columns(mesh.t); + ## Varnodes = setdiff(1:Nnodes,Dnodes); + ## alpha = ones(Nelements,1); eta = .1*ones(Nnodes,1); + ## beta = [ones(1,Nelements);zeros(1,Nelements)]; + ## gamma = ones(Nnodes,1); + ## f = Ucompconst(mesh,ones(Nnodes,1),ones(Nelements,1)); + ## S = Uscharfettergummel3(mesh,alpha,gamma,eta,beta); + ## u = zeros(Nnodes,1); + ## u(Varnodes) = S(Varnodes,Varnodes)\f(Varnodes); + ## uex = x - (exp(10*x)-1)/(exp(10)-1); + ## assert(u,uex,1e-7) + ## @end example + ## + ## @seealso{Ucomplap, Ucompconst, Ucompmass2, Uscharfettergummel} + ## @end deftypefn + + + %% This file is part of + %% + %% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator + %% ------------------------------------------------------------------- + %% Copyright (C) 2004-2006 Carlo de Falco + %% + %% + %% + %% SECS2D is free software; you can 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. + %% + %% SECS2D is distributed in the hope that it will be useful, + %% but WITHOUT ANY WARRANTY; without even the implied warranty of + %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + %% GNU General Public License for more details. + %% + %% You should have received a copy of the GNU General Public License + %% along with SECS2D; If not, see . + + + Nnodes = columns(mesh.p); + Nelements = columns(mesh.t); + + alphaareak = reshape (alpha.*sum( mesh.wjacdet,1)',1,1,Nelements); + shg = mesh.shg(:,:,:); + + + % build local Laplacian matrix + + Lloc=zeros(3,3,Nelements); + + for inode=1:3 + for jnode=1:3 + ginode(inode,jnode,:)=mesh.t(inode,:); + gjnode(inode,jnode,:)=mesh.t(jnode,:); + Lloc(inode,jnode,:) = sum( shg(:,inode,:) .* shg(:,jnode,:),1)... + .* alphaareak; + end + end + + + x = mesh.p(1,:); + x = x(mesh.t(1:3,:)); + y = mesh.p(2,:); + y = y(mesh.t(1:3,:)); + + if all(size(beta)==1) + v12=0;v23=0;v31=0; + elseif all(size(beta)==[2,Nelements]) + v12 = beta(1,:) .* (x(2,:)-x(1,:)) + beta(2,:) .* (y(2,:)-y(1,:)); + v23 = beta(1,:) .* (x(3,:)-x(2,:)) + beta(2,:) .* (y(3,:)-y(2,:)); + v31 = beta(1,:) .* (x(1,:)-x(3,:)) + beta(2,:) .* (y(1,:)-y(3,:)); + elseif all(size(beta)==[Nnodes,1]) + betaloc = beta(mesh.t(1:3,:)); + v12 = betaloc(2,:)-betaloc(1,:); + v23 = betaloc(3,:)-betaloc(2,:); + v31 = betaloc(1,:)-betaloc(3,:); + end + + etaloc = eta(mesh.t(1:3,:)); + + eta12 = etaloc(2,:)-etaloc(1,:); + eta23 = etaloc(3,:)-etaloc(2,:); + eta31 = etaloc(1,:)-etaloc(3,:); + + etalocm1 = Utemplogm(etaloc(2,:),etaloc(3,:)); + etalocm2 = Utemplogm(etaloc(3,:),etaloc(1,:)); + etalocm3 = Utemplogm(etaloc(1,:),etaloc(2,:)); + + gammaloc = gamma(mesh.t(1:3,:)); + geloc = gammaloc.*etaloc; + + gelocm1 = Utemplogm(geloc(2,:),geloc(3,:)); + gelocm2 = Utemplogm(geloc(3,:),geloc(1,:)); + gelocm3 = Utemplogm(geloc(1,:),geloc(2,:)); + + [bp12,bm12] = Ubern( (v12 - eta12)./etalocm3); + [bp23,bm23] = Ubern( (v23 - eta23)./etalocm1); + [bp31,bm31] = Ubern( (v31 - eta31)./etalocm2); + + bp12 = reshape(gelocm3.*etalocm3.*bp12,1,1,Nelements).*Lloc(1,2,:); + bm12 = reshape(gelocm3.*etalocm3.*bm12,1,1,Nelements).*Lloc(1,2,:); + bp23 = reshape(gelocm1.*etalocm1.*bp23,1,1,Nelements).*Lloc(2,3,:); + bm23 = reshape(gelocm1.*etalocm1.*bm23,1,1,Nelements).*Lloc(2,3,:); + bp31 = reshape(gelocm2.*etalocm2.*bp31,1,1,Nelements).*Lloc(3,1,:); + bm31 = reshape(gelocm2.*etalocm2.*bm31,1,1,Nelements).*Lloc(3,1,:); + + Sloc(1,1,:) = (-bm12-bp31)./reshape(etaloc(1,:),1,1,Nelements); + Sloc(1,2,:) = bp12./reshape(etaloc(2,:),1,1,Nelements); + Sloc(1,3,:) = bm31./reshape(etaloc(3,:),1,1,Nelements); + + Sloc(2,1,:) = bm12./reshape(etaloc(1,:),1,1,Nelements); + Sloc(2,2,:) = (-bp12-bm23)./reshape(etaloc(2,:),1,1,Nelements); + Sloc(2,3,:) = bp23./reshape(etaloc(3,:),1,1,Nelements); + + Sloc(3,1,:) = bp31./reshape(etaloc(1,:),1,1,Nelements); + Sloc(3,2,:) = bm23./reshape(etaloc(2,:),1,1,Nelements); + Sloc(3,3,:) = (-bm31-bp23)./reshape(etaloc(3,:),1,1,Nelements); + + S = sparse(ginode(:),gjnode(:),Sloc(:)); + +endfunction + +%!test +%! [mesh.p,mesh.e,mesh.t] = Ustructmesh([0:1/3:1],[0:1/3:1],1,1:4); +%! mesh = Umeshproperties(mesh); +%! x = mesh.p(1,:)'; +%! Dnodes = Unodesonside(mesh,[2,4]); +%! Nnodes = columns(mesh.p); Nelements = columns(mesh.t); +%! Varnodes = setdiff(1:Nnodes,Dnodes); +%! alpha = ones(Nelements,1); eta = .1*ones(Nnodes,1); +%! beta = [ones(1,Nelements);zeros(1,Nelements)]; +%! gamma = ones(Nnodes,1); +%! f = Ucompconst(mesh,ones(Nnodes,1),ones(Nelements,1)); +%! S = Uscharfettergummel3(mesh,alpha,gamma,eta,beta); +%! u = zeros(Nnodes,1); +%! u(Varnodes) = S(Varnodes,Varnodes)\f(Varnodes); +%! uex = x - (exp(10*x)-1)/(exp(10)-1); +%! assert(u,uex,1e-7) + +%!test +%! [mesh.p,mesh.e,mesh.t] = Ustructmesh([0:1/3:1],[0:1/3:1],1,1:4); +%! mesh = Umeshproperties(mesh); +%! x = mesh.p(1,:)'; +%! Dnodes = Unodesonside(mesh,[2,4]); +%! Nnodes = columns(mesh.p); Nelements = columns(mesh.t); +%! Varnodes = setdiff(1:Nnodes,Dnodes); +%! alpha = ones(Nelements,1); eta = .1*ones(Nnodes,1); +%! beta = x; +%! gamma = ones(Nnodes,1); +%! f = Ucompconst(mesh,ones(Nnodes,1),ones(Nelements,1)); +%! S = Uscharfettergummel3(mesh,alpha,gamma,eta,beta); +%! u = zeros(Nnodes,1); +%! u(Varnodes) = S(Varnodes,Varnodes)\f(Varnodes); +%! uex = x - (exp(10*x)-1)/(exp(10)-1); +%! assert(u,uex,1e-7) + +%!test +%! [mesh.p,mesh.e,mesh.t] = Ustructmesh([0:1/3:1],[0:1/3:1],1,1:4); +%! mesh = Umeshproperties(mesh); +%! x = mesh.p(1,:)'; +%! Dnodes = Unodesonside(mesh,[2,4]); +%! Nnodes = columns(mesh.p); Nelements = columns(mesh.t); +%! Varnodes = setdiff(1:Nnodes,Dnodes); +%! alpha = 10*ones(Nelements,1); eta = .01*ones(Nnodes,1); +%! beta = x/10; +%! gamma = ones(Nnodes,1); +%! f = Ucompconst(mesh,ones(Nnodes,1),ones(Nelements,1)); +%! S = Uscharfettergummel3(mesh,alpha,gamma,eta,beta); +%! u = zeros(Nnodes,1); +%! u(Varnodes) = S(Varnodes,Varnodes)\f(Varnodes); +%! uex = x - (exp(10*x)-1)/(exp(10)-1); +%! assert(u,uex,1e-7) + +%!test +%! [mesh.p,mesh.e,mesh.t] = Ustructmesh([0:1/3:1],[0:1/3:1],1,1:4); +%! mesh = Umeshproperties(mesh); +%! x = mesh.p(1,:)'; +%! Dnodes = Unodesonside(mesh,[2,4]); +%! Nnodes = columns(mesh.p); Nelements = columns(mesh.t); +%! Varnodes = setdiff(1:Nnodes,Dnodes); +%! alpha = 10*ones(Nelements,1); eta = .001*ones(Nnodes,1); +%! beta = x/100; +%! gamma = 10*ones(Nnodes,1); +%! f = Ucompconst(mesh,ones(Nnodes,1),ones(Nelements,1)); +%! S = Uscharfettergummel3(mesh,alpha,gamma,eta,beta); +%! u = zeros(Nnodes,1); +%! u(Varnodes) = S(Varnodes,Varnodes)\f(Varnodes); +%! uex = x - (exp(10*x)-1)/(exp(10)-1); +%! assert(u,uex,1e-7) + +%!test +%! [mesh.p,mesh.e,mesh.t] = Ustructmesh([0:1/1e3:1],[0:1/2:1],1,1:4); +%! mesh = Umeshproperties(mesh); +%! x = mesh.p(1,:)'; +%! Dnodes = Unodesonside(mesh,[2,4]); +%! Nnodes = columns(mesh.p); Nelements = columns(mesh.t); +%! Varnodes = setdiff(1:Nnodes,Dnodes); +%! alpha = 3*ones(Nelements,1); eta = x+1; +%! beta = [ones(1,Nelements);zeros(1,Nelements)]; +%! gamma = 2*x; +%! ff = 2*(6*x.^2+6*x) - (6*x+6).*(1-2*x)+6*(x-x.^2); +%! f = Ucompconst(mesh,ff,ones(Nelements,1)); +%! S = Uscharfettergummel3(mesh,alpha,gamma,eta,beta); +%! u = zeros(Nnodes,1); +%! u(Varnodes) = S(Varnodes,Varnodes)\f(Varnodes); +%! uex = x - x.^2; +%! assert(u,uex,5e-3) + +%!test +%! [mesh.p,mesh.e,mesh.t] = Ustructmesh([0:1/1e3:1],[0:1/2:1],1,1:4); +%! mesh = Umeshproperties(mesh); +%! x = mesh.p(1,:)'; +%! Dnodes = Unodesonside(mesh,[2,4]); +%! Nnodes = columns(mesh.p); Nelements = columns(mesh.t); +%! Varnodes = setdiff(1:Nnodes,Dnodes); +%! alpha = ones(Nelements,1); eta = ones(Nnodes,1); +%! beta = 0; +%! gamma = x+1; +%! ff = 4*x+1; +%! f = Ucompconst(mesh,ff,ones(Nelements,1)); +%! S = Uscharfettergummel3(mesh,alpha,gamma,eta,beta); +%! u = zeros(Nnodes,1); +%! u(Varnodes) = S(Varnodes,Varnodes)\f(Varnodes); +%! uex = x - x.^2; +%! assert(u,uex,1e-7) + +%!test +%! [mesh.p,mesh.e,mesh.t] = Ustructmesh([0:.1:1],[0:.1:1],1,1:4); +%! mesh = Umeshproperties(mesh); +%! x = mesh.p(1,:)';y = mesh.p(2,:)'; +%! Dnodes = Unodesonside(mesh,[1:4]); +%! Nnodes = columns(mesh.p); Nelements = columns(mesh.t); +%! Varnodes = setdiff(1:Nnodes,Dnodes); +%! alpha = ones(Nelements,1); diff = 1e-2; eta=diff*ones(Nnodes,1); +%! beta =[ones(1,Nelements);ones(1,Nelements)]; +%! gamma = x*0+1; +%! ux = y.*(1-exp((y-1)/diff)) .* (1-exp((x-1)/diff)-x.*exp((x-1)/diff)/diff); +%! uy = x.*(1-exp((x-1)/diff)) .* (1-exp((y-1)/diff)-y.*exp((y-1)/diff)/diff); +%! uxx = y.*(1-exp((y-1)/diff)) .* (-2*exp((x-1)/diff)/diff-x.*exp((x-1)/diff)/(diff^2)); +%! uyy = x.*(1-exp((x-1)/diff)) .* (-2*exp((y-1)/diff)/diff-y.*exp((y-1)/diff)/(diff^2)); +%! ff = -diff*(uxx+uyy)+ux+uy; +%! f = Ucompconst(mesh,ff,ones(Nelements,1)); +%! S = Uscharfettergummel3(mesh,alpha,gamma,eta,beta); +%! u = zeros(Nnodes,1); +%! u(Varnodes) = S(Varnodes,Varnodes)\f(Varnodes); +%! uex = x.*y.*(1-exp((x-1)/diff)).*(1-exp((y-1)/diff)); +%! assert(u,uex,1e-7) + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ushowgrid.net b/octave_packages/secs2d-0.0.8/Utilities/Ushowgrid.net new file mode 100644 index 0000000..412addd --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ushowgrid.net @@ -0,0 +1,515 @@ +// +// time: Mon Feb 27 22:33:21 2006 +// +// version: 3.2.0 (format), 4.3.2 (DX) +// +// +// MODULE main +// workspace: width = 500, height = 463 +// layout: snap = 0, width = 50, height = 50, align = NN +// +macro main( +) -> ( +) { + // + // node FileSelector[1]: x = 52, y = 31, inputs = 0, label = FileSelector + // output[1]: visible = 1, type = 32, value = "__FILE__DX__" + // output[2]: visible = 1, type = 32, value = "__FILE__DX__" + // + // + // node Import[1]: x = 104, y = 118, inputs = 6, label = Import + // +main_Import_1_out_1 = + Import( + main_FileSelector_1_out_1, + main_Import_1_in_2, + main_Import_1_in_3, + main_Import_1_in_4, + main_Import_1_in_5, + main_Import_1_in_6 + ) [instance: 1, cache: 1]; + // + // node ShowConnections[1]: x = 101, y = 191, inputs = 1, label = ShowConnections + // +main_ShowConnections_1_out_1 = + ShowConnections( + main_Import_1_out_1 + ) [instance: 1, cache: 1]; + // + // node Color[1]: x = 106, y = 286, inputs = 5, label = Color + // input[2]: defaulting = 0, visible = 1, type = 32, value = "indianred" + // +main_Color_1_out_1 = + Color( + main_ShowConnections_1_out_1, + main_Color_1_in_2, + main_Color_1_in_3, + main_Color_1_in_4, + main_Color_1_in_5 + ) [instance: 1, cache: 1]; + // + // node Image[1]: x = 69, y = 401, inputs = 49, label = Image + // input[1]: defaulting = 0, visible = 0, type = 67108863, value = "Image_1" + // input[4]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[5]: defaulting = 0, visible = 0, type = 8, value = [3.75e-08 2.075e-08 0] + // input[6]: defaulting = 0, visible = 0, type = 8, value = [3.75e-08 2.075e-08 2.15172e-07] + // input[7]: defaulting = 0, visible = 0, type = 5, value = 1.15311e-07 + // input[8]: defaulting = 0, visible = 0, type = 1, value = 640 + // input[9]: defaulting = 0, visible = 0, type = 5, value = 0.750781 + // input[10]: defaulting = 0, visible = 0, type = 8, value = [0 1 0] + // input[11]: defaulting = 0, visible = 0, type = 5, value = 30.0001 + // input[12]: defaulting = 0, visible = 0, type = 1, value = 0 + // input[14]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[15]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[16]: defaulting = 1, visible = 0, type = 32, value = "none" + // input[17]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[18]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[19]: defaulting = 0, visible = 0, type = 1, value = 1 + // input[22]: defaulting = 0, visible = 0, type = 32, value = "snow" + // input[25]: defaulting = 0, visible = 0, type = 32, value = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/grid.tif" + // input[26]: defaulting = 0, visible = 0, type = 32, value = "tiff" + // input[29]: defaulting = 0, visible = 0, type = 3, value = 1 + // input[31]: defaulting = 0, visible = 0, type = 1, value = -15 + // input[33]: defaulting = 0, visible = 0, type = 3, value = 0 + // input[34]: defaulting = 0, visible = 0, type = 3, value = 0 + // input[37]: defaulting = 0, visible = 0, type = 16777248, value = {"clear", "grey5", "saddlebrown", "saddlebrown"} + // input[38]: defaulting = 0, visible = 0, type = 16777248, value = {"background", "grid", "ticks", "labels"} + // input[39]: defaulting = 0, visible = 0, type = 5, value = 0.7 + // input[40]: defaulting = 0, visible = 0, type = 32, value = "roman_s" + // input[41]: defaulting = 0, visible = 0, type = 32, value = "panzoom" + // depth: value = 24 + // window: position = (0.2480,0.1276), size = 0.6387x0.6836 + // internal caching: 1 + // +main_Image_1_out_1, +main_Image_1_out_2, +main_Image_1_out_3 = + Image( + main_Image_1_in_1, + main_Color_1_out_1, + main_Image_1_in_3, + main_Image_1_in_4, + main_Image_1_in_5, + main_Image_1_in_6, + main_Image_1_in_7, + main_Image_1_in_8, + main_Image_1_in_9, + main_Image_1_in_10, + main_Image_1_in_11, + main_Image_1_in_12, + main_Image_1_in_13, + main_Image_1_in_14, + main_Image_1_in_15, + main_Image_1_in_16, + main_Image_1_in_17, + main_Image_1_in_18, + main_Image_1_in_19, + main_Image_1_in_20, + main_Image_1_in_21, + main_Image_1_in_22, + main_Image_1_in_23, + main_Image_1_in_24, + main_Image_1_in_25, + main_Image_1_in_26, + main_Image_1_in_27, + main_Image_1_in_28, + main_Image_1_in_29, + main_Image_1_in_30, + main_Image_1_in_31, + main_Image_1_in_32, + main_Image_1_in_33, + main_Image_1_in_34, + main_Image_1_in_35, + main_Image_1_in_36, + main_Image_1_in_37, + main_Image_1_in_38, + main_Image_1_in_39, + main_Image_1_in_40, + main_Image_1_in_41, + main_Image_1_in_42, + main_Image_1_in_43, + main_Image_1_in_44, + main_Image_1_in_45, + main_Image_1_in_46, + main_Image_1_in_47, + main_Image_1_in_48, + main_Image_1_in_49 + ) [instance: 1, cache: 1]; +// network: end of macro body +CacheScene(main_Image_1_in_1, main_Image_1_out_1, main_Image_1_out_2); +} +main_FileSelector_1_out_1 = "./.tmp.dx"; +main_Import_1_in_2 = NULL; +main_Import_1_in_3 = NULL; +main_Import_1_in_4 = NULL; +main_Import_1_in_5 = NULL; +main_Import_1_in_6 = NULL; +main_Import_1_out_1 = NULL; +main_ShowConnections_1_out_1 = NULL; +main_Color_1_in_2 = "indianred"; +main_Color_1_in_3 = NULL; +main_Color_1_in_4 = NULL; +main_Color_1_in_5 = NULL; +main_Color_1_out_1 = NULL; +macro Image( + id, + object, + where, + useVector, + to, + from, + width, + resolution, + aspect, + up, + viewAngle, + perspective, + options, + buttonState = 1, + buttonUpApprox = "none", + buttonDownApprox = "none", + buttonUpDensity = 1, + buttonDownDensity = 1, + renderMode = 0, + defaultCamera, + reset, + backgroundColor, + throttle, + RECenable = 0, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable = 0, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + interactionMode, + title, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + webOptions) -> ( + object, + camera, + where) +{ + ImageMessage( + id, + backgroundColor, + throttle, + RECenable, + RECfile, + RECformat, + RECresolution, + RECaspect, + AAenable, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels, + interactionMode, + title, + renderMode, + buttonUpApprox, + buttonDownApprox, + buttonUpDensity, + buttonDownDensity) [instance: 1, cache: 1]; + autoCamera = + AutoCamera( + object, + "front", + object, + resolution, + aspect, + [0,1,0], + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + realCamera = + Camera( + to, + from, + width, + resolution, + aspect, + up, + perspective, + viewAngle, + backgroundColor) [instance: 1, cache: 1]; + coloredDefaultCamera = + UpdateCamera(defaultCamera, + background=backgroundColor) [instance: 1, cache: 1]; + nullDefaultCamera = + Inquire(defaultCamera, + "is null + 1") [instance: 1, cache: 1]; + resetCamera = + Switch( + nullDefaultCamera, + coloredDefaultCamera, + autoCamera) [instance: 1, cache: 1]; + resetNull = + Inquire( + reset, + "is null + 1") [instance: 2, cache: 1]; + reset = + Switch( + resetNull, + reset, + 0) [instance: 2, cache: 1]; + whichCamera = + Compute( + "($0 != 0 || $1 == 0) ? 1 : 2", + reset, + useVector) [instance: 1, cache: 1]; + camera = Switch( + whichCamera, + resetCamera, + realCamera) [instance: 3, cache: 1]; + AAobject = + AutoAxes( + object, + camera, + AAlabels, + AAticks, + AAcorners, + AAframe, + AAadjust, + AAcursor, + AAgrid, + AAcolors, + AAannotation, + AAlabelscale, + AAfont, + AAxTickLocs, + AAyTickLocs, + AAzTickLocs, + AAxTickLabels, + AAyTickLabels, + AAzTickLabels) [instance: 1, cache: 1]; + switchAAenable = Compute("$0+1", + AAenable) [instance: 2, cache: 1]; + object = Switch( + switchAAenable, + object, + AAobject) [instance:4, cache: 1]; + SWapproximation_options = + Switch( + buttonState, + buttonUpApprox, + buttonDownApprox) [instance: 5, cache: 1]; + SWdensity_options = + Switch( + buttonState, + buttonUpDensity, + buttonDownDensity) [instance: 6, cache: 1]; + HWapproximation_options = + Format( + "%s,%s", + buttonDownApprox, + buttonUpApprox) [instance: 1, cache: 1]; + HWdensity_options = + Format( + "%d,%d", + buttonDownDensity, + buttonUpDensity) [instance: 2, cache: 1]; + switchRenderMode = Compute( + "$0+1", + renderMode) [instance: 3, cache: 1]; + approximation_options = Switch( + switchRenderMode, + SWapproximation_options, + HWapproximation_options) [instance: 7, cache: 1]; + density_options = Switch( + switchRenderMode, + SWdensity_options, + HWdensity_options) [instance: 8, cache: 1]; + renderModeString = Switch( + switchRenderMode, + "software", + "hardware")[instance: 9, cache: 1]; + object_tag = Inquire( + object, + "object tag")[instance: 3, cache: 1]; + annoted_object = + Options( + object, + "send boxes", + 0, + "cache", + 1, + "object tag", + object_tag, + "ddcamera", + whichCamera, + "rendering approximation", + approximation_options, + "render every", + density_options, + "button state", + buttonState, + "rendering mode", + renderModeString) [instance: 1, cache: 1]; + RECresNull = + Inquire( + RECresolution, + "is null + 1") [instance: 4, cache: 1]; + ImageResolution = + Inquire( + camera, + "camera resolution") [instance: 5, cache: 1]; + RECresolution = + Switch( + RECresNull, + RECresolution, + ImageResolution) [instance: 10, cache: 1]; + RECaspectNull = + Inquire( + RECaspect, + "is null + 1") [instance: 6, cache: 1]; + ImageAspect = + Inquire( + camera, + "camera aspect") [instance: 7, cache: 1]; + RECaspect = + Switch( + RECaspectNull, + RECaspect, + ImageAspect) [instance: 11, cache: 1]; + switchRECenable = Compute( + "$0 == 0 ? 1 : (($2 == $3) && ($4 == $5)) ? ($1 == 1 ? 2 : 3) : 4", + RECenable, + switchRenderMode, + RECresolution, + ImageResolution, + RECaspect, + ImageAspect) [instance: 4, cache: 1]; + NoRECobject, RECNoRerenderObject, RECNoRerHW, RECRerenderObject = Route(switchRECenable, annoted_object); + Display( + NoRECobject, + camera, + where, + throttle) [instance: 1, cache: 1]; + image = + Render( + RECNoRerenderObject, + camera) [instance: 1, cache: 1]; + Display( + image, + NULL, + where, + throttle) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 1, cache: 1]; + rec_where = Display( + RECNoRerHW, + camera, + where, + throttle) [instance: 1, cache: 0]; + rec_image = ReadImageWindow( + rec_where) [instance: 1, cache: 1]; + WriteImage( + rec_image, + RECfile, + RECformat) [instance: 1, cache: 1]; + RECupdateCamera = + UpdateCamera( + camera, + resolution=RECresolution, + aspect=RECaspect) [instance: 2, cache: 1]; + Display( + RECRerenderObject, + camera, + where, + throttle) [instance: 1, cache: 1]; + RECRerenderObject = + ScaleScreen( + RECRerenderObject, + NULL, + RECresolution, + camera) [instance: 1, cache: 1]; + image = + Render( + RECRerenderObject, + RECupdateCamera) [instance: 2, cache: 1]; + WriteImage( + image, + RECfile, + RECformat) [instance: 2, cache: 1]; +} +main_Image_1_in_1 = "Image_1"; +main_Image_1_in_3 = "X24,,"; +main_Image_1_in_4 = 1; +main_Image_1_in_5 = [3.75e-08 2.075e-08 0]; +main_Image_1_in_6 = [3.75e-08 2.075e-08 2.15172e-07]; +main_Image_1_in_7 = 1.15311e-07; +main_Image_1_in_8 = 640; +main_Image_1_in_9 = 0.750781; +main_Image_1_in_10 = [0 1 0]; +main_Image_1_in_11 = 30.0001; +main_Image_1_in_12 = 0; +main_Image_1_in_13 = NULL; +main_Image_1_in_14 = 1; +main_Image_1_in_15 = NULL; +main_Image_1_in_16 = NULL; +main_Image_1_in_17 = 1; +main_Image_1_in_18 = 1; +main_Image_1_in_19 = 1; +main_Image_1_in_20 = NULL; +main_Image_1_in_21 = NULL; +main_Image_1_in_22 = "snow"; +main_Image_1_in_23 = NULL; +main_Image_1_in_25 = "/Users/carlo/Desktop/COMSONDEMO/CoMSON DP/grid.tif"; +main_Image_1_in_26 = "tiff"; +main_Image_1_in_27 = NULL; +main_Image_1_in_28 = NULL; +main_Image_1_in_29 = 1; +main_Image_1_in_30 = NULL; +main_Image_1_in_31 = -15; +main_Image_1_in_32 = NULL; +main_Image_1_in_33 = 0; +main_Image_1_in_34 = 0; +main_Image_1_in_35 = NULL; +main_Image_1_in_36 = NULL; +main_Image_1_in_37 = {"clear", "grey5", "saddlebrown", "saddlebrown"}; +main_Image_1_in_38 = {"background", "grid", "ticks", "labels"}; +main_Image_1_in_39 = 0.7; +main_Image_1_in_40 = "roman_s"; +main_Image_1_in_41 = "panzoom"; +main_Image_1_in_42 = NULL; +main_Image_1_in_43 = NULL; +main_Image_1_in_44 = NULL; +main_Image_1_in_45 = NULL; +main_Image_1_in_46 = NULL; +main_Image_1_in_47 = NULL; +main_Image_1_in_48 = NULL; +main_Image_1_in_49 = NULL; +Executive("product version 4 3 2"); +$sync +main(); diff --git a/octave_packages/secs2d-0.0.8/Utilities/Usmoothguess.m b/octave_packages/secs2d-0.0.8/Utilities/Usmoothguess.m new file mode 100644 index 0000000..cbe638f --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Usmoothguess.m @@ -0,0 +1,20 @@ +function guess = Usmoothguess(mesh,new,old,Dsides); + +% guess = Usmoothguess(mesh,new,old,Dsides); + + if ~isfield("mesh","wjacdet") + mesh = Umeshproperties(mesh); + end + + Nelements = columns(mesh.t); + Nnodes = columns(mesh.p); + + Dnodes = Unodesonside(mesh,Dsides); + varnodes = setdiff([1:Nnodes]',Dnodes); + guess = new; + + A = Ucomplap(mesh,ones(Nelements,1)); + Aie = A(varnodes,Dnodes); + Aii = A(varnodes,varnodes); + + guess(varnodes) = Aii\(-Aie*(new(Dnodes)-old(Dnodes))+Aii*old(varnodes)); diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ustructmesh.m b/octave_packages/secs2d-0.0.8/Utilities/Ustructmesh.m new file mode 100644 index 0000000..167d238 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ustructmesh.m @@ -0,0 +1,34 @@ +function [p,e,t]=Ustructmesh(x,y,region,sides,varargin) + +% [p,e,t]=Ustructmesh(x,y,region,sides,varargin) + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +defaultoption = 'right'; + +if length(varargin)==0 + theoption = defaultoption; +else + theoption = varargin{1}; +end + +[p,e,t]=feval(['Ustructmesh_' theoption],x,y,region,sides); diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ustructmesh_left.m b/octave_packages/secs2d-0.0.8/Utilities/Ustructmesh_left.m new file mode 100644 index 0000000..b44b8c4 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ustructmesh_left.m @@ -0,0 +1,55 @@ +function [p,e,t]=Ustructmesh_left(x,y,region,sides) + +% [p,e,t]=Ustructmesh(x,y,region,sides) + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +x = sort(x); +y = sort(y); + +nx = length(x); +ny = length(y); +[XX,YY] = meshgrid(x,y); +p = [XX(:),YY(:)]'; +iiv (ny,nx)=0; +iiv(:)=1:nx*ny; +iiv(end,:)=[]; +iiv(:,end)=[]; +iiv=iiv(:)'; +t = [[iiv;iiv+ny;iiv+1],[iiv+1;iiv+ny;iiv+ny+1] ]; +t (4,:)=region; + +l1 = 1+ny*([1:nx]-1); +l4 = 1:ny; +l2 = ny*(nx-1)+1:nx*ny; +l3 = ny + l1 -1; + +e = [ l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1]) + l1([2:end]) l2([2:end]) l3([2:end]) l4([2:end]) + [l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1])]*0 + [l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1])]*0 + l1([1:end-1])*0+sides(1) l2([1:end-1])*0+sides(2) l3([1:end-1])*0+sides(3) l4([1:end-1])*0+sides(4) + [l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1])]*0 + [l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1])]*0+region + ]; + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ustructmesh_random.m b/octave_packages/secs2d-0.0.8/Utilities/Ustructmesh_random.m new file mode 100644 index 0000000..9b1ccd4 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ustructmesh_random.m @@ -0,0 +1,63 @@ +function [p,e,t]=Ustructmesh_random(x,y,region,sides) + +% [p,e,t]=Ustructmesh(x,y,region,sides) + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +x = sort(x); +y = sort(y); + +nx = length(x); +ny = length(y); +[XX,YY] = meshgrid(x,y); +p = [XX(:),YY(:)]'; +iiv (ny,nx)=0; +iiv(:)=1:nx*ny; +iiv(end,:)=[]; +iiv(:,end)=[]; +iiv=iiv(:)'; + +niiv = length(iiv); +theperm = iiv(randperm(niiv)); +first = theperm(1:floor(niiv/2)); +second = theperm(floor(niiv/2)+1:end); + +t = [[first;first+ny;first+ny+1],[first;first+ny+1;first+1] ]; +t = [t,[second;second+ny;second+1],[second+ny;second+ny+1;second+1] ]; + +t (4,:)=region; + +l1 = 1+ny*([1:nx]-1); +l4 = 1:ny; +l2 = ny*(nx-1)+1:nx*ny; +l3 = ny + l1 -1; + +e = [ l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1]) + l1([2:end]) l2([2:end]) l3([2:end]) l4([2:end]) + [l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1])]*0 + [l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1])]*0 + l1([1:end-1])*0+sides(1) l2([1:end-1])*0+sides(2) l3([1:end-1])*0+sides(3) l4([1:end-1])*0+sides(4) + [l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1])]*0 + [l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1])]*0+region + ]; + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Ustructmesh_right.m b/octave_packages/secs2d-0.0.8/Utilities/Ustructmesh_right.m new file mode 100644 index 0000000..007375f --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Ustructmesh_right.m @@ -0,0 +1,54 @@ +function [p,e,t]=Ustructmesh_right(x,y,region,sides) + +% [p,e,t]=Ustructmesh(x,y,region,sides) + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +x = sort(x); +y = sort(y); + +nx = length(x); +ny = length(y); +[XX,YY] = meshgrid(x,y); +p = [XX(:),YY(:)]'; +iiv (ny,nx)=0; +iiv(:)=1:nx*ny; +iiv(end,:)=[]; +iiv(:,end)=[]; +iiv=iiv(:)'; +t = [[iiv;iiv+ny;iiv+ny+1],[iiv;iiv+ny+1;iiv+1] ]; +t (4,:)=region; + +l1 = 1+ny*([1:nx]-1); +l4 = 1:ny; +l2 = ny*(nx-1)+1:nx*ny; +l3 = ny + l1 -1; + +e = [ l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1]) + l1([2:end]) l2([2:end]) l3([2:end]) l4([2:end]) + [l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1])]*0 + [l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1])]*0 + l1([1:end-1])*0+sides(1) l2([1:end-1])*0+sides(2) l3([1:end-1])*0+sides(3) l4([1:end-1])*0+sides(4) + [l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1])]*0 + [l1([1:end-1]) l2([1:end-1]) l3([1:end-1]) l4([1:end-1])]*0+region + ]; + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Usubdomains2.m b/octave_packages/secs2d-0.0.8/Utilities/Usubdomains2.m new file mode 100644 index 0000000..f4d7785 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Usubdomains2.m @@ -0,0 +1,75 @@ +function [e,t]=Usubdomains2(p,t,rcts,sidelist); + +% [e,t]=Usubdomains(p,t,rcts,sidelist); + +e=[]; + +%%% subdivide domain according to position of +%%% elements' center of mass + +% get elements' center of mass coordinates +x = p(1,:);y = p(2,:); +mx = sum(x(t(1:3,:)),1)/3; +my = sum(y(t(1:3,:)),1)/3; + +t(4,:) = 1; + +% loop over rectangular regions +for ii = 1:size(rcts,1) + + % find elements with center of mass in this rectangle + trs = find ((mx>rcts(ii,1))&(mxrcts(ii,3))&(my=sidelist(icond,3)) &... +(x2>=sidelist(icond,4)) &... +(y1<=sidelist(icond,5)) &... +(y2<=sidelist(icond,6)) &... +(y1>=sidelist(icond,7)) &... +(y2>=sidelist(icond,8)) ); +eonside = unique(sides([1,2],onside)','rows')'; +eonside(5,:) = icond; + +e=[e,eonside]; +end + +% set left and right subdomain +for ie = 1:size(e,2) +for it=1:size(t,2) + if(((e(1,ie)==t(1,it))&(e(2,ie)==t(2,it)))|... + ((e(1,ie)==t(2,it))&(e(2,ie)==t(3,it)))|... + ((e(1,ie)==t(3,it))&(e(2,ie)==t(1,it)))) + e(6,ie)=t(4,it); + end + if(((e(2,ie)==t(1,it))&(e(1,ie)==t(2,it)))|... + ((e(2,ie)==t(2,it))&(e(1,ie)==t(3,it)))|... + ((e(2,ie)==t(3,it))&(e(1,ie)==t(1,it)))) + e(7,ie)=t(4,it); + end +end +end diff --git a/octave_packages/secs2d-0.0.8/Utilities/Usubmesh.m b/octave_packages/secs2d-0.0.8/Utilities/Usubmesh.m new file mode 100644 index 0000000..4ade558 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Usubmesh.m @@ -0,0 +1,93 @@ +function [omesh,onodes,oelements]=Usubmesh(imesh,intrfc,sdl,short) + +# +# [omesh,onodes,oelements]=Usubmesh(imesh,intrfc,sdl,short) +# +# builds the mesh structure for +# the given list +# of subdomains sdl +# +# NOTE: the intrfc parameter is unused and only kept +# as a legacy + + + +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + + + + + +nsd = length(sdl); + +####### +# the shp field will remain unchanged +if (~short) + omesh.shp = imesh.shp; +end + +####### +# set list of output triangles +oelements=[]; +for isd=1:nsd + oelements = [oelements find(imesh.t(4,:)==sdl(isd))]; +end + +omesh.t = imesh.t(:,oelements); + +####### +# discard unneeded part of shg and wjacdet +if (~short) + omesh.shg= imesh.shg(:,:,oelements); + omesh.wjacdet = imesh.wjacdet(:,oelements); +end + +####### +# set list of output nodes +onodes = unique(reshape(imesh.t(1:3,oelements),1,[])); +omesh.p = imesh.p(:,onodes); + + +####### +# use new node numbering in connectivity matrix +indx(onodes) = [1:length(onodes)]; +iel = [1:length(oelements)]; +omesh.t(1:3,iel) = indx(omesh.t(1:3,iel)); + +####### +# set list of output edges +omesh.e =[]; +for isd=1:nsd + omesh.e = [omesh.e imesh.e(:,imesh.e(7,:)==sdl(isd))]; + omesh.e = [omesh.e imesh.e(:,imesh.e(6,:)==sdl(isd))]; +end +omesh.e=unique(omesh.e',"rows")'; + +####### +# use new node numbering in boundary segment list +ied = [1:size(omesh.e,2)]; +omesh.e(1:2,ied) = indx(omesh.e(1:2,ied)); + +% Last Revision: +% $Author: adb014 $ +% $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ + diff --git a/octave_packages/secs2d-0.0.8/Utilities/Utemplogm.m b/octave_packages/secs2d-0.0.8/Utilities/Utemplogm.m new file mode 100644 index 0000000..06a1e4b --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/Utemplogm.m @@ -0,0 +1,8 @@ +function T = Utemplogm(t1,t2) + +T = zeros(size(t2)); + +sing = abs(t2-t1)< 100*eps ; +T(sing) = (t2(sing)+t1(sing))/2; +T(~sing) = (t2(~sing)-t1(~sing))./log(t2(~sing)./t1(~sing)); + diff --git a/octave_packages/secs2d-0.0.8/Utilities/constants.m b/octave_packages/secs2d-0.0.8/Utilities/constants.m new file mode 100644 index 0000000..72be361 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/constants.m @@ -0,0 +1,111 @@ +% This file is part of +% +% SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator +% ------------------------------------------------------------------- +% Copyright (C) 2004-2006 Carlo de Falco +% +% +% +% SECS2D is free software; you can 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. +% +% SECS2D is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with SECS2D; If not, see . + +Kb = 1.3806503e-23; +q = 1.602176462e-19; +e0 = 8.854187817e-12; +esir = 11.7; +esio2r = 3.9; +esi = e0 * esir; +esio2 = e0 * esio2r; +hplanck = 6.626e-34; +hbar = ( hplanck/ (2*pi)); +mn0 = 9.11e-31; +mn = 0.26*mn0; +mh = 0.18*mn0; + + +qsue = q / esi; +T0 = 300 ; +Vth = Kb * T0 / q; +un = 1417e-4; +up = 480e-4; + +vsatn0 = 1.07e5; +vsatp0 = 8.37e4; +vsatnexp = 0.87; +vsatpexp = 0.52; +vsatn = vsatn0*(300/T0).^vsatnexp; +vsatp = vsatp0*(300/T0).^vsatpexp; + +mubn0 = 1.109; +mubp0 = 1.213; +mubnexp = 0.66; +mubpexp = 0.17; +mubn = mubn0*(T0/300)^mubnexp; +mubp = mubp0*(T0/300)^mubpexp; +mudopparn = [ 52.2e-4 %mumin1 + 52.2e-4 %mumin2 + 43.4e-4 %mu1 + 0e+6 %Pc + 9.68e22 %Cr + 3.43e26 %Cs + 0.680 %alpha + 2.0 %beta + ]; +mudopparp = [ 44.9e-4 %mumin1 + 0.00e-4 %mumin2 + 29.0e-4 %mu1 + 9.23e22 %Pc + 2.23e23 %Cr + 6.10e26 %Cs + 0.719 %alpha + 2.0 %beta + ]; + + +tp = 1e-7; +tn = 1e-7; +twp = .1e-12; +twn = .1e-12; + + +mnl = 0.98*mn0; +mnt = 0.19*mn0; +mndos = (mnl*mnt*mnt)^(1/3); + +mhh = 0.49*mn0; +mlh = 0.16*mn0; +mhdos = (mhh^(3/2)+mlh^(3/2))^(2/3); + +rn = 3; +aleph = hbar^2/(4*rn*q*mn); +alephn = aleph; +rp = .1; +alephp = hbar^2/(4*rp*q*mh); + +Nc = (6/4)*(2*mndos*Kb*T0/(hbar^2*pi))^(3/2); +Nv = (1/4)*(2*mhdos*Kb*T0/(hbar^2*pi))^(3/2); +Eg0 = 1.16964*q; +alfaEg = 4.73e-4*q; +betaEg = 6.36e2; +Egap = Eg0-alfaEg*((T0^2)/(T0+betaEg)); + +ni = sqrt(Nc*Nv)*exp(-Egap/(2*(Kb * T0))); +Phims = -.79;%- Egap /(2*q); + +kappaSi = 154.86; + +% Last Revision: +% $Author: adb014 $ +% $Date: 2008-02-04 16:26:27 +0100 (man, 04 feb 2008) $ + + diff --git a/octave_packages/secs2d-0.0.8/Utilities/constants.mat b/octave_packages/secs2d-0.0.8/Utilities/constants.mat new file mode 100644 index 0000000..cf47cd8 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/constants.mat @@ -0,0 +1,187 @@ +# Created by Octave 2.9.9, Wed May 16 14:37:10 2007 CEST +# name: alfaEg +# type: scalar +7.57829466526e-23 +# name: mudopparn +# type: matrix +# rows: 8 +# columns: 1 + 0.00522 + 0.00522 + 0.00434 + 0 + 9.679999999999999e+22 + 3.43e+26 + 0.68 + 2 +# name: mudopparp +# type: matrix +# rows: 8 +# columns: 1 + 0.00449 + 0 + 0.0029 + 9.230000000000001e+22 + 2.23e+23 + 6.1e+26 + 0.719 + 2 +# name: __nargin__ +# type: scalar +2 +# name: mubnexp +# type: scalar +0.66 +# name: q +# type: scalar +1.602176462e-19 +# name: vsatpexp +# type: scalar +0.52 +# name: Eg0 +# type: scalar +1.87396967701368e-19 +# name: mubn +# type: scalar +1.109 +# name: mubp +# type: scalar +1.213 +# name: kappaSi +# type: scalar +154.86 +# name: hbar +# type: scalar +1.054560652926898e-34 +# name: mubn0 +# type: scalar +1.109 +# name: mubp0 +# type: scalar +1.213 +# name: vsatn +# type: scalar +107000 +# name: vsatp +# type: scalar +83700 +# name: esio2 +# type: scalar +3.45313324863e-11 +# name: alephn +# type: scalar +2.442079557997522e-20 +# name: alephp +# type: scalar +1.05823447513226e-18 +# name: vsatn0 +# type: scalar +107000 +# name: mndos +# type: scalar +2.990630807677018e-31 +# name: vsatp0 +# type: scalar +83700 +# name: vsatnexp +# type: scalar +0.87 +# name: mubpexp +# type: scalar +0.17 +# name: Egap +# type: scalar +1.801101459078488e-19 +# name: esir +# type: scalar +11.7 +# name: Kb +# type: scalar +1.3806503e-23 +# name: betaEg +# type: scalar +636 +# name: Nc +# type: scalar +2.832359512537327e+25 +# name: Nv +# type: scalar +1.021468310220377e+25 +# name: T0 +# type: scalar +300 +# name: esio2r +# type: scalar +3.9 +# name: Phims +# type: scalar +-0.79 +# name: esi +# type: scalar +1.035939974589e-10 +# name: hplanck +# type: scalar +6.626e-34 +# name: Vth +# type: scalar +0.02585202690363829 +# name: e0 +# type: scalar +8.854187817e-12 +# name: twn +# type: scalar +1e-13 +# name: twp +# type: scalar +1e-13 +# name: mhh +# type: scalar +4.4639e-31 +# name: mlh +# type: scalar +1.4576e-31 +# name: mn0 +# type: scalar +9.11e-31 +# name: mnl +# type: scalar +8.927800000000001e-31 +# name: aleph +# type: scalar +2.442079557997522e-20 +# name: mnt +# type: scalar +1.7309e-31 +# name: mh +# type: scalar +1.6398e-31 +# name: mhdos +# type: scalar +5.003201373499014e-31 +# name: mn +# type: scalar +2.3686e-31 +# name: ni +# type: scalar +6140088000559841 +# name: rn +# type: scalar +3 +# name: rp +# type: scalar +0.1 +# name: tn +# type: scalar +1e-07 +# name: tp +# type: scalar +1e-07 +# name: qsue +# type: scalar +1.546591985347075e-09 +# name: un +# type: scalar +0.1417 +# name: up +# type: scalar +0.048 diff --git a/octave_packages/secs2d-0.0.8/Utilities/doc-cache b/octave_packages/secs2d-0.0.8/Utilities/doc-cache new file mode 100644 index 0000000..1280d12 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/Utilities/doc-cache @@ -0,0 +1,1226 @@ +# Created by Octave 3.6.1, Sun Mar 25 18:44:37 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 42 +# name: +# type: sq_string +# elements: 1 +# length: 15 +UDXappend2Ddata + + +# name: +# type: sq_string +# elements: 1 +# length: 521 + + UDXappend2Ddata(filename,p,t,u,attr_name,attr_rank,attr_shape) + + Apends data to a file in DX form. + Only one variable can be written to the file + variable must be a scalar, vector or tensor of doubles + mesh data in the file must be consistent with this variable + + x + attr_name = name of the variable (type string) + attr_rank = rank of variable data (0 for scalar, 1 for vector, etc.) + attr_shape = number of components of variable data (assumed 1 for scalar) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 + + UDXappend2Ddata(filename,p,t,u,attr_name,attr_rank,attr_shape) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +UDXoutput2Ddata + + +# name: +# type: sq_string +# elements: 1 +# length: 457 + + UDXoutput2Ddata(filename,p,t,u,attr_name,attr_rank,attr_shape,endfile) + + Outputs data in DX form. + Only one variable can be written to the file + variable must be a scalar, vector or tensor of doubles + + x + attr_name = name of the variable (type string) + attr_rank = rank of variable data (0 for scalar, 1 for vector, etc.) + attr_shape = number of components of variable data (assumed 1 for scalar) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 + + UDXoutput2Ddata(filename,p,t,u,attr_name,attr_rank,attr_shape,endfile) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +UDXoutput2Dtimeseries + + +# name: +# type: sq_string +# elements: 1 +# length: 455 + + UDXoutput2Dtimeseries(filename,p,t,u,attr_name,attr_rank,attr_shape,time) + + Outputs data in DX form. + Only one variable can be written to the file + variable must be a scalar, vector or tensor of doubles + + attr_name = name of the variable (type string) + attr_rank = rank of variable data (0 for scalar, 1 for vector, etc.) + attr_shape = number of components of variable data (assumed 1 for scalar) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 78 + + UDXoutput2Dtimeseries(filename,p,t,u,attr_name,attr_rank,attr_shape,time) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 18 +URREcyclingpattern + + +# name: +# type: sq_string +# elements: 1 +# length: 181 + prcomputes cycling pattern for RRE extrapolation: + + -1 = Do Nothing + 0 = extrapolate + 1..RRErank = store + + RREpattern = URREcyclingpattern(RREnnit,RRErank,toll); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 + prcomputes cycling pattern for RRE extrapolation: + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +Ubern + + +# name: +# type: sq_string +# elements: 1 +# length: 156 + + [bp,bn]=Ubern(x) + + calcola la funzione di Bernoulli + B(x)=x/(exp(x)-1) in corrispondenza dei + due argomenti Z e -Z, ricordando che risulta + B(-Z)=Z+B(Z) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 + + [bp,bn]=Ubern(x) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +Ucolumns + + +# name: +# type: sq_string +# elements: 1 +# length: 129 + + function r=columns(m) + + Note: octave already has this function, + this is here only for matlab compatibility + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 + + function r=columns(m) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +Ucompconst + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + C = Ucompconst (imesh,coeffn,coeffe) + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + C = Ucompconst (imesh,coeffn,coeffe) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +Ucomplap + + +# name: +# type: sq_string +# elements: 1 +# length: 31 + L = Ufastcomplap (mesh,coeff) + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 + L = Ufastcomplap (mesh,coeff) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +Ucompmass2 + + +# name: +# type: sq_string +# elements: 1 +# length: 41 + Bmat = Ucompmass2 (imesh,Bvect,Cvect); + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 + Bmat = Ucompmass2 (imesh,Bvect,Cvect); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +Udescaling + + +# name: +# type: sq_string +# elements: 1 +# length: 43 + [odata,omesh] = Udescaling(imesh,idata); + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 + [odata,omesh] = Udescaling(imesh,idata); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +Udopdepmob + + +# name: +# type: sq_string +# elements: 1 +# length: 24 + Udopdepmob (mu,par,D); + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 + Udopdepmob (mu,par,D); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +Udrawedge + + +# name: +# type: sq_string +# elements: 1 +# length: 19 + Udrawedge(mesh); + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 + Udrawedge(mesh); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +Udriftdepmob + + +# name: +# type: sq_string +# elements: 1 +# length: 75 + mob = Ufielddepmob(imesh,u0,F,vsat,b) + Computes field dependent mobility + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 + mob = Ufielddepmob(imesh,u0,F,vsat,b) + Computes field dependent mobility + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +Udriftdiffusion + + +# name: +# type: sq_string +# elements: 1 +# length: 134 + + c=Udriftdiffusion(mesh,Dsides,guess,M,U,V,u) + solves the drift diffusion equation + $ -div ( u ( \nabla n - n \nabla V)) + M = U $ + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + c=Udriftdiffusion(mesh,Dsides,guess,M,U,V,u) + solves the drift diffusion equa + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +Udriftdiffusion2 + + +# name: +# type: sq_string +# elements: 1 +# length: 144 + + c=Udriftdiffusion(mesh,Dsides,guess,M,U,V,Vth,u) + solves the drift diffusion equation + $ -div ( u ( \nabla (n Vth) - n \nabla V)) + M = U $ + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + + c=Udriftdiffusion(mesh,Dsides,guess,M,U,V,Vth,u) + solves the drift diffusion + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +Ufielddepmob + + +# name: +# type: sq_string +# elements: 1 +# length: 75 + mob = Ufielddepmob(imesh,u0,F,vsat,b) + Computes field dependent mobility + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 + mob = Ufielddepmob(imesh,u0,F,vsat,b) + Computes field dependent mobility + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +Ufvsgcurrent + + +# name: +# type: sq_string +# elements: 1 +# length: 49 + [jx,jy]=Udrawcurrent(omesh,n,psi,psith,coeffe); + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 + [jx,jy]=Udrawcurrent(omesh,n,psi,psith,coeffe); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +Ufvsgcurrent2 + + +# name: +# type: sq_string +# elements: 1 +# length: 50 + [jx,jy]=Udrawcurrent2(omesh,n,psi,psith,coeffe); + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 + [jx,jy]=Udrawcurrent2(omesh,n,psi,psith,coeffe); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +Ufvsgcurrent3 + + +# name: +# type: sq_string +# elements: 1 +# length: 786 + -- Function File: [JX,JY] = Ufvsgcurrent3 (MESH, U, ALPHA, GAMMA, ETA, + BETA); + Builds the Scharfetter-Gummel approximation of the vector field + + J(U) = ALPHA* GAMMA * (ETA * grad U - BETA * U)) + + where: + - ALPHA is an element-wise constant scalar function + + - ETA, U, GAMMA are piecewise linear conforming scalar functions + + - BETA is an element-wise constant vector function + + J(U) is an element-wise constant vector function + + Instead of passing the vector field BETA directly one can pass a + piecewise linear conforming scalar function PHI as the last input. + In such case BETA = grad PHI is assumed. If PHI is a single + scalar value BETA is assumed to be 0 in the whole domain. + + See also: Uscharfettergummel3 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 +Builds the Scharfetter-Gummel approximation of the vector field + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +Uinvfermidirac + + +# name: +# type: sq_string +# elements: 1 +# length: 32 + [fd]=Uinvfermidirac(eta,par); + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 + [fd]=Uinvfermidirac(eta,par); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +Uise2pde + + +# name: +# type: sq_string +# elements: 1 +# length: 595 + [mesh,data]=ise2pde3(grid_file,pref,data_file,load_data,out_file) + ise2pde3 + estrae dati dal formato DF-ISE di ISE a pdetool di Matlab + grid_file contiene il nome del file di griglia da estrarre + pref un prefisso che verra' dato ai files temporanei creati da grep + data_file e' un cell array delle file da estrarre + load_data e' un cell array che contiene i nomi delle grandezze da estrarre + out_file e' il nome del file matlab opzionale per salvare i dati estratti + + 17-3-2004 ver 3.1 + Marco Bellini marco_bellini_1@yahoo.it + 14.02.2007 ver 3.2 + Octave porting and bug fixes Carlo de Falco + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + [mesh,data]=ise2pde3(grid_file,pref,data_file,load_data,out_file) + ise2pde3 + es + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +Ujoinmeshes + + +# name: +# type: sq_string +# elements: 1 +# length: 44 + mesh=Ujoinmeshes(mesh1,mesh2,side1,side2) + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 + mesh=Ujoinmeshes(mesh1,mesh2,side1,side2) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +Umeshproperties + + +# name: +# type: sq_string +# elements: 1 +# length: 71 + + mesh=Umeshproperties(mesh) + precomputes some useful mesh properties + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 + + mesh=Umeshproperties(mesh) + precomputes some useful mesh properties + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +Umsh2pdetool + + +# name: +# type: sq_string +# elements: 1 +# length: 30 + + + loadgmshmesh(filename); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 1 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +Umshcreatemesh + + +# name: +# type: sq_string +# elements: 1 +# length: 49 + + + omesh=Umshcreatemesh(geometry,scalefactor); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 1 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +Unodesonside + + +# name: +# type: sq_string +# elements: 1 +# length: 35 + Dnodes=Unodesonside(mesh,Dsides); + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 + Dnodes=Unodesonside(mesh,Dsides); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +Updegrad + + +# name: +# type: sq_string +# elements: 1 +# length: 157 + [Fx,Fy]=Updegrad(mesh,F); + + computes piecewise constant + gradient of a piecewise linear + scalar function F defined on + the mesh structure described by mesh + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 + [Fx,Fy]=Updegrad(mesh,F); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +Updemesh + + +# name: +# type: sq_string +# elements: 1 +# length: 19 + Udrawedge(mesh); + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 + Udrawedge(mesh); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +Updesurf + + +# name: +# type: sq_string +# elements: 1 +# length: 22 + Updemesh(varargin); + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 + Updemesh(varargin); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +Urows + + +# name: +# type: sq_string +# elements: 1 +# length: 22 + + function r=rows(m) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 + + function r=rows(m) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +Urrextrapolation + + +# name: +# type: sq_string +# elements: 1 +# length: 99 + s = Urrextrapolation(X) + RRE vector extrapolation see + Smith, Ford & Sidi SIREV 29 II 06/1987 + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + s = Urrextrapolation(X) + RRE vector extrapolation see + Smith, Ford & Sidi S + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +Uscaling + + +# name: +# type: sq_string +# elements: 1 +# length: 40 + [odata,omesh] = Uscaling(imesh,idata); + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 + [odata,omesh] = Uscaling(imesh,idata); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +Uscharfettergummel2 + + +# name: +# type: sq_string +# elements: 1 +# length: 368 + + SG=Ufastscharfettergummel2(mesh,v,acoeff,bcoeff) + + + Builds the Scharfetter-Gummel matrix for the + the discretization of the LHS + of the Drift-Diffusion equation: + + $ -\div (a(x) (\grad (b(x) u) - b(x) u \grad v'(x) ))= f $ + + where a(x) is piecewise constant + and v(x),b(x) is piecewise linear, so that + v'(x) is still piecewise constant + and u is the unknown + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 + + SG=Ufastscharfettergummel2(mesh,v,acoeff,bcoeff) + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +Uscharfettergummel3 + + +# name: +# type: sq_string +# elements: 1 +# length: 1554 + -- Function File: S = Uscharfettergummel3 (MESH, ALPHA, GAMMA, ETA, + BETA) + Builds the Scharfetter-Gummel matrix for the discretization of the + LHS of the equation: + + -div (ALPHA * GAMMA (ETA grad u - BETA u )) = f + + where: + - ALPHA is an element-wise constant scalar function + + - ETA, GAMMA are piecewise linear conforming scalar functions + + - BETA is an element-wise constant vector function + + Instead of passing the vector field BETA directly one can pass a + piecewise linear conforming scalar function PHI as the last input. + In such case BETA = grad PHI is assumed. If PHI is a single + scalar value BETA is assumed to be 0 in the whole domain. + + Example: + [mesh.p,mesh.e,mesh.t] = Ustructmesh([0:1/3:1],[0:1/3:1],1,1:4); + mesh = Umeshproperties(mesh); + x = mesh.p(1,:)'; + Dnodes = Unodesonside(mesh,[2,4]); + Nnodes = columns(mesh.p); Nelements = columns(mesh.t); + Varnodes = setdiff(1:Nnodes,Dnodes); + alpha = ones(Nelements,1); eta = .1*ones(Nnodes,1); + beta = [ones(1,Nelements);zeros(1,Nelements)]; + gamma = ones(Nnodes,1); + f = Ucompconst(mesh,ones(Nnodes,1),ones(Nelements,1)); + S = Uscharfettergummel3(mesh,alpha,gamma,eta,beta); + u = zeros(Nnodes,1); + u(Varnodes) = S(Varnodes,Varnodes)\f(Varnodes); + uex = x - (exp(10*x)-1)/(exp(10)-1); + assert(u,uex,1e-7) + + See also: Ucomplap, Ucompconst, Ucompmass2, Uscharfettergummel + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Builds the Scharfetter-Gummel matrix for the discretization of the LHS +of the eq + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +Usmoothguess + + +# name: +# type: sq_string +# elements: 1 +# length: 44 + guess = Usmoothguess(mesh,new,old,Dsides); + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 + guess = Usmoothguess(mesh,new,old,Dsides); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +Ustructmesh + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + [p,e,t]=Ustructmesh(x,y,region,sides,varargin) + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + [p,e,t]=Ustructmesh(x,y,region,sides,varargin) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +Ustructmesh_left + + +# name: +# type: sq_string +# elements: 1 +# length: 39 + [p,e,t]=Ustructmesh(x,y,region,sides) + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 + [p,e,t]=Ustructmesh(x,y,region,sides) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 18 +Ustructmesh_random + + +# name: +# type: sq_string +# elements: 1 +# length: 39 + [p,e,t]=Ustructmesh(x,y,region,sides) + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 + [p,e,t]=Ustructmesh(x,y,region,sides) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 +Ustructmesh_right + + +# name: +# type: sq_string +# elements: 1 +# length: 39 + [p,e,t]=Ustructmesh(x,y,region,sides) + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 + [p,e,t]=Ustructmesh(x,y,region,sides) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +Usubdomains2 + + +# name: +# type: sq_string +# elements: 1 +# length: 40 + [e,t]=Usubdomains(p,t,rcts,sidelist); + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 + [e,t]=Usubdomains(p,t,rcts,sidelist); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +Usubmesh + + +# name: +# type: sq_string +# elements: 1 +# length: 201 + + [omesh,onodes,oelements]=Usubmesh(imesh,intrfc,sdl,short) + + builds the mesh structure for + the given list + of subdomains sdl + + NOTE: the intrfc parameter is unused and only kept + as a legacy + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 + + [omesh,onodes,oelements]=Usubmesh(imesh,intrfc,sdl,short) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +constants + + +# name: +# type: sq_string +# elements: 1 +# length: 844 + This file is part of + + SECS2D - A 2-D Drift--Diffusion Semiconductor Device Simulator + ------------------------------------------------------------------- + Copyright (C) 2004-2006 Carlo de Falco + + + + SECS2D is free software; you can 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. + + SECS2D is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with SECS2D; If not, see . + + + +# name: +# type: sq_string +# elements: 1 +# length: 23 + This file is part of + + + + + + diff --git a/octave_packages/secs2d-0.0.8/doc-cache b/octave_packages/secs2d-0.0.8/doc-cache new file mode 100644 index 0000000..e119e88 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/doc-cache @@ -0,0 +1,56 @@ +# Created by Octave 3.6.1, Sun Mar 25 18:44:37 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 1 +# name: +# type: sq_string +# elements: 1 +# length: 6 +secs2d + + +# name: +# type: sq_string +# elements: 1 +# length: 1060 + PKG_ADD:# Run this only if the package is installed + PKG_ADD:if (! exist (fullfile (fileparts (mfilename ("fullpath")), "inst"), "dir")) + PKG_ADD: dirlist= {"Utilities","DDGOX","ThDDGOX","QDDGOX","METLINES","DDGOXT"}; + PKG_ADD: + PKG_ADD: for ii=1:length(dirlist) + PKG_ADD: addpath ( [ fileparts( mfilename("fullpath")) "/" dirlist{ii}]) + PKG_ADD: end + PKG_ADD: + PKG_ADD: __gmsh = file_in_path (EXEC_PATH, "gmsh"); + PKG_ADD: if (isempty (__gmsh)) + PKG_ADD: __gmsh = file_in_path (EXEC_PATH, "gmsh.exe"); + PKG_ADD: if (isempty (__gmsh)) + PKG_ADD: warning ("gmsh does not seem to be present some functionalities will be disabled"); + PKG_ADD: endif + PKG_ADD: endif + PKG_ADD: clear __gmsh; + PKG_ADD: + PKG_ADD: __dx = file_in_path (EXEC_PATH, "dx"); + PKG_ADD: if (isempty (__dx)) + PKG_ADD: __dx = file_in_path (EXEC_PATH, "dx.exe"); + PKG_ADD: if (isempty (__dx)) + PKG_ADD: warning ("dx does not seem to be present some functionalities will be disabled"); + PKG_ADD: endif + PKG_ADD: endif + PKG_ADD: clear __dx; + PKG_ADD:end + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + PKG_ADD:# Run this only if the package is installed + PKG_ADD:if (! exist (fullf + + + + + diff --git a/octave_packages/secs2d-0.0.8/packinfo/.autoload b/octave_packages/secs2d-0.0.8/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/secs2d-0.0.8/packinfo/DESCRIPTION b/octave_packages/secs2d-0.0.8/packinfo/DESCRIPTION new file mode 100644 index 0000000..4d10034 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: SECS2D +Version: 0.0.8 +Date: 2009-05-06 +Author: Carlo de Falco +Maintainer: Carlo de Falco +Title: SEmi Conductor Simulator in 2D +Description: A Drift-Diffusion simulator for 2d semiconductor devices +Categories: Electrical Engineering +Depends: octave (>= 2.9.17) +Autoload: yes +License: GPL version 2 or later +Url: http://www.comson.org/dem diff --git a/octave_packages/secs2d-0.0.8/packinfo/INDEX b/octave_packages/secs2d-0.0.8/packinfo/INDEX new file mode 100644 index 0000000..2a8b159 --- /dev/null +++ b/octave_packages/secs2d-0.0.8/packinfo/INDEX @@ -0,0 +1,90 @@ +SECS2D >> SEmiConductor Simulator in 2D +Utilities + Ubern + Ubernoulli + Umediaarmonica + UDXappend2Ddata + UDXoutput2Ddata + UDXoutput2Dtimeseries + URREcyclingpattern + Ucolumns + Ucompmass2 + Udescaling + Udopdepmob + Udrawedge + Udriftdepmob + Udriftdiffusion2 + Ufielddepmob + Ufvsgcurrent + Ufvsgcurrent2 + Ufvsgcurrent3 + Uinvfermidirac + Uise2pde + Ujoinmeshes + Umeshproperties + Umsh2pdetool + Umshcreatemesh + Unodesonside + Updegrad + Updemesh + Updesurf + Urows + Urrextrapolation + Uscaling + Uscharfettergummel2 + Usmoothguess + Ustructmesh + Ustructmesh_left + Ustructmesh_random + Ustructmesh_right + Usubdomains2 + Usubmesh + Utemplogm + secs2d +Finite Element matrix assembly functions + Udriftdiffusion + Ucomplap + Ucompconst + Ucompmass + Uscharfettergummel3 +Physical constants and material properties + constants + +DDGOX + DDGOXddcurrent + DDGOXelectron_driftdiffusion + DDGOXgummelmap + DDGOXhole_driftdiffusion + DDGOXnlpoisson + DDGOXplotresults +DDGOXT + DDGOXTelectron_driftdiffusion + DDGOXTgummelmap + DDGOXThole_driftdiffusion +METLINES + METLINEScapcomp + METLINESdefinepermittivity +QDDGOX + QDDGOXcompdens + QDDGOXddcurrent + QDDGOXgummelmap + QDDGOXnlpoisson +ThDDGOX + ThDDGOXMOBN0STD + ThDDGOXMOBN1STD + ThDDGOXMOBP0STD + ThDDGOXMOBP1STD + ThDDGOXTWN0STD + ThDDGOXTWN1STD + ThDDGOXTWP0STD + ThDDGOXTWP1STD + ThDDGOXddcurrent + ThDDGOXelectron_driftdiffusion + ThDDGOXeletiteration + ThDDGOXgummelmap + ThDDGOXhole_driftdiffusion + ThDDGOXnlpoisson + ThDDGOXthermaliteration + ThDDGOXupdateelectron_temp + ThDDGOXupdatehole_temp + ThDDGOXupdatelattice_temp diff --git a/octave_packages/secs2d-0.0.8/secs2d.m b/octave_packages/secs2d-0.0.8/secs2d.m new file mode 100644 index 0000000..386072b --- /dev/null +++ b/octave_packages/secs2d-0.0.8/secs2d.m @@ -0,0 +1,36 @@ +## PKG_ADD:# Run this only if the package is installed +## PKG_ADD:if (! exist (fullfile (fileparts (mfilename ("fullpath")), "inst"), "dir")) +## PKG_ADD: dirlist= {"Utilities","DDGOX","ThDDGOX","QDDGOX","METLINES","DDGOXT"}; +## PKG_ADD: +## PKG_ADD: for ii=1:length(dirlist) +## PKG_ADD: addpath ( [ fileparts( mfilename("fullpath")) "/" dirlist{ii}]) +## PKG_ADD: end +## PKG_ADD: +## PKG_ADD: __gmsh = file_in_path (EXEC_PATH, "gmsh"); +## PKG_ADD: if (isempty (__gmsh)) +## PKG_ADD: __gmsh = file_in_path (EXEC_PATH, "gmsh.exe"); +## PKG_ADD: if (isempty (__gmsh)) +## PKG_ADD: warning ("gmsh does not seem to be present some functionalities will be disabled"); +## PKG_ADD: endif +## PKG_ADD: endif +## PKG_ADD: clear __gmsh; +## PKG_ADD: +## PKG_ADD: __dx = file_in_path (EXEC_PATH, "dx"); +## PKG_ADD: if (isempty (__dx)) +## PKG_ADD: __dx = file_in_path (EXEC_PATH, "dx.exe"); +## PKG_ADD: if (isempty (__dx)) +## PKG_ADD: warning ("dx does not seem to be present some functionalities will be disabled"); +## PKG_ADD: endif +## PKG_ADD: endif +## PKG_ADD: clear __dx; +## PKG_ADD:end + +## PKG_DEL:# Run this only if the package is installed +## PKG_DEL:if (! exist (fullfile (fileparts (mfilename ("fullpath")), "inst"), "dir")) +## PKG_DEL: dirlist= {"Utilities","DDGOX","ThDDGOX","QDDGOX","METLINES","DDGOXT"}; +## PKG_DEL: +## PKG_DEL: for ii=1:length(dirlist) +## PKG_DEL: rmpath ( [ fileparts( mfilename("fullpath")) "/" dirlist{ii}]) +## PKG_DEL: end +## PKG_DEL:end + diff --git a/octave_packages/signal-1.1.3/__power.m b/octave_packages/signal-1.1.3/__power.m new file mode 100644 index 0000000..feb5d5d --- /dev/null +++ b/octave_packages/signal-1.1.3/__power.m @@ -0,0 +1,89 @@ +## Copyright (C) 1999 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [P, w] = __power (b, a, [, nfft [, Fs]] [, range] [, units]) +## +## Plot the power spectrum of the given ARMA model. +## +## b, a: filter coefficients (b=numerator, a=denominator) +## nfft is number of points at which to sample the power spectrum +## Fs is the sampling frequency of x +## range is 'half' (default) or 'whole' +## units is 'squared' or 'db' (default) +## range and units may be specified any time after the filter, in either +## order +## +## Returns P, the magnitude vector, and w, the frequencies at which it +## is sampled. If there are no return values requested, then plot the power +## spectrum and don't return anything. + +## TODO: consider folding this into freqz --- just one more parameter to +## TODO: distinguish between 'linear', 'log', 'logsquared' and 'squared' + +function [varargout] = __power (b, a, varargin) + if (nargin < 2 || nargin > 6) print_usage; endif + + nfft = []; + Fs = []; + range = []; + range_fact = 1.0; + units = []; + + pos = 0; + for i=1:length(varargin) + arg = varargin{i}; + if strcmp(arg, 'squared') || strcmp(arg, 'db') + units = arg; + elseif strcmp(arg, 'whole') + range = arg; + range_fact = 1.0; + elseif strcmp(arg, 'half') + range = arg; + range_fact = 2.0; + elseif ischar(arg) + usage(usagestr); + elseif pos == 0 + nfft = arg; + pos++; + elseif pos == 1 + Fs = arg; + pos++; + else + usage(usagestr); + endif + endfor + + if isempty(nfft); nfft = 256; endif + if isempty(Fs); Fs = 2; endif + if isempty(range) + range = 'half'; + range_fact = 2.0; + endif + + [P, w] = freqz(b, a, nfft, range, Fs); + + P = (range_fact/Fs)*(P.*conj(P)); + if nargout == 0, + if strcmp(units, 'squared') + plot(w, P, ";;"); + else + plot(w, 10.0*log10(abs(P)), ";;"); + endif + endif + if nargout >= 1, varargout{1} = P; endif + if nargout >= 2, varargout{2} = w; endif + +endfunction + diff --git a/octave_packages/signal-1.1.3/ar_psd.m b/octave_packages/signal-1.1.3/ar_psd.m new file mode 100644 index 0000000..08ea3f4 --- /dev/null +++ b/octave_packages/signal-1.1.3/ar_psd.m @@ -0,0 +1,291 @@ +%% Copyright (C) 2006 Peter V. Lanspeary +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% Usage: +%% [psd,f_out] = ar_psd(a,v,freq,Fs,range,method,plot_type) +%% +%% Calculate the power spectrum of the autoregressive model +%% +%% M +%% x(n) = sqrt(v).e(n) + SUM a(k).x(n-k) +%% k=1 +%% where x(n) is the output of the model and e(n) is white noise. +%% This function is intended for use with +%% [a,v,k] = arburg(x,poles,criterion) +%% which use the Burg (1968) method to calculate a "maximum entropy" +%% autoregressive model of "x". This function runs on octave and matlab. +%% +%% If the "freq" argument is a vector (of frequencies) the spectrum is +%% calculated using the polynomial method and the "method" argument is +%% ignored. For scalar "freq", an integer power of 2, or "method='FFT'", +%% causes the spectrum to be calculated by FFT. Otherwise, the spectrum +%% is calculated as a polynomial. It may be computationally more +%% efficient to use the FFT method if length of the model is not much +%% smaller than the number of frequency values. The spectrum is scaled so +%% that spectral energy (area under spectrum) is the same as the +%% time-domain energy (mean square of the signal). +%% +%% ARGUMENTS: +%% All but the first two arguments are optional and may be empty. +%% +%% a %% [vector] list of M=(order+1) autoregressive model +%% %% coefficients. The first element of "ar_coeffs" is the +%% %% zero-lag coefficient, which always has a value of 1. +%% +%% v %% [real scalar] square of the moving-average coefficient of +%% %% the AR model. +%% +%% freq %% [real vector] frequencies at which power spectral density +%% %% is calculated +%% %% [integer scalar] number of uniformly distributed frequency +%% %% values at which spectral density is calculated. +%% %% [default=256] +%% +%% Fs %% [real scalar] sampling frequency (Hertz) [default=1] +%% +%% CONTROL-STRING ARGUMENTS -- each of these arguments is a character string. +%% Control-string arguments can be in any order after the other arguments. +%% +%% range %% 'half', 'onesided' : frequency range of the spectrum is +%% %% from zero up to but not including sample_f/2. Power +%% %% from negative frequencies is added to the positive +%% %% side of the spectrum. +%% %% 'whole', 'twosided' : frequency range of the spectrum is +%% %% -sample_f/2 to sample_f/2, with negative frequencies +%% %% stored in "wrap around" order after the positive +%% %% frequencies; e.g. frequencies for a 10-point 'twosided' +%% %% spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 +%% %% 'shift', 'centerdc' : same as 'whole' but with the first half +%% %% of the spectrum swapped with second half to put the +%% %% zero-frequency value in the middle. (See "help +%% %% fftshift". If "freq" is vector, 'shift' is ignored. +%% %% If model coefficients "ar_coeffs" are real, the default +%% %% range is 'half', otherwise default range is 'whole'. +%% +%% method %% 'fft': use FFT to calculate power spectrum. +%% %% 'poly': calculate power spectrum as a polynomial of 1/z +%% %% N.B. this argument is ignored if the "freq" argument is a +%% %% vector. The default is 'poly' unless the "freq" +%% %% argument is an integer power of 2. +%% +%% plot_type%% 'plot', 'semilogx', 'semilogy', 'loglog', 'squared' or 'db': +%% %% specifies the type of plot. The default is 'plot', which +%% %% means linear-linear axes. 'squared' is the same as 'plot'. +%% %% 'dB' plots "10*log10(psd)". This argument is ignored and a +%% %% spectrum is not plotted if the caller requires a returned +%% %% value. +%% +%% RETURNED VALUES: +%% If returned values are not required by the caller, the spectrum +%% is plotted and nothing is returned. +%% psd %% [real vector] estimate of power-spectral density +%% f_out %% [real vector] frequency values +%% +%% N.B. arburg runs in octave and matlab, and does not depend on octave-forge +%% or signal-processing-toolbox functions. +%% +%% REFERENCE +%% [1] Equation 2.28 from Steven M. Kay and Stanley Lawrence Marple Jr.: +%% "Spectrum analysis -- a modern perspective", +%% Proceedings of the IEEE, Vol 69, pp 1380-1419, Nov., 1981 +%% + +function [varargout]=ar_psd(a,v,varargin) +%% +%% Check fixed arguments +if ( nargin < 2 ) + error( 'ar_psd: needs at least 2 args. Use help ar_psd.' ); +elseif ( ~isvector(a) || length(a)<2 ) + error( 'ar_psd: arg 1 (a) must be vector, length>=2.' ); +elseif ( ~isscalar(v) ) + error( 'ar_psd: arg 2 (v) must be real scalar >0.' ); +else + real_model = isreal(a); +%% +%% default values for optional areguments + freq = 256; + user_freqs = 0; %% boolean: true for user-specified frequencies + Fs = 1.0; + %% FFT padding factor (is also frequency range divisor): 1=whole, 2=half. + pad_fact = 1 + real_model; + do_shift = 0; + force_FFT = 0; + force_poly = 0; + plot_type = 1; +%% +%% decode and check optional arguments +%% end_numeric_args is boolean; becomes true at 1st string arg + end_numeric_args = 0; + for iarg = 1:length(varargin) + arg = varargin{iarg}; + end_numeric_args = end_numeric_args || ischar(arg); + %% skip empty arguments + if ( isempty(arg) ) + 1; + %% numeric optional arguments must be first, cannot follow string args + %% N.B. older versions of matlab may not have the function "error" so + %% the user writes "function error(msg); disp(msg); end" and we need + %% a "return" here. + elseif ( ~ischar(arg) ) + if ( end_numeric_args ) + error( 'ar_psd: control arg must be string.' ); + %% + %% first optional numeric arg is "freq" + elseif ( iarg == 1 ) + user_freqs = isvector(arg) && length(arg)>1; + if ( ~isscalar(arg) && ~user_freqs ) + error( 'ar_psd: arg 3 (freq) must be vector or scalar.' ); + elseif ( ~user_freqs && ( ~isreal(arg) || ... + fix(arg)~=arg || arg <= 2 || arg >= 1048576 ) ) + error('ar_psd: arg 3 (freq) must be integer >=2, <=1048576' ); + elseif ( user_freqs && ~isreal(arg) ) + error( 'ar_psd: arg 3 (freq) vector must be real.' ); + end + freq = arg(:); % -> column vector + %% + %% second optional numeric arg is "Fs" - sampling frequency + elseif ( iarg == 2 ) + if ( ~isscalar(arg) || ~isreal(arg) || arg<=0 ) + error( 'ar_psd: arg 4 (Fs) must be real positive scalar.' ); + end + Fs = arg; + %% + else + error( 'ar_psd: control arg must be string.' ); + end + %% + %% decode control-string arguments + elseif ( strcmp(arg,'plot') || strcmp(arg,'squared') ) + plot_type = 1; + elseif ( strcmp(arg,'semilogx') ) + plot_type = 2; + elseif ( strcmp(arg,'semilogy') ) + plot_type = 3; + elseif ( strcmp(arg,'loglog') ) + plot_type = 4; + elseif ( strcmp(arg,'dB') ) + plot_type = 5; + elseif ( strcmp(arg,'fft') ) + force_FFT = 1; + force_poly = 0; + elseif ( strcmp(arg,'poly') ) + force_FFT = 0; + force_poly = 1; + elseif ( strcmp(arg,'half') || strcmp(arg,'onesided') ) + pad_fact = 2; % FFT zero-padding factor (pad FFT to double length) + do_shift = 0; + elseif ( strcmp(arg,'whole') || strcmp(arg,'twosided') ) + pad_fact = 1; % FFT zero-padding factor (do not pad) + do_shift = 0; + elseif ( strcmp(arg,'shift') || strcmp(arg,'centerdc') ) + pad_fact = 1; + do_shift = 1; + else + error( 'ar_psd: string arg: illegal value: %s', arg ); + end + end +%% end of decoding and checking args +%% + if ( user_freqs ) + %% user provides (column) vector of frequencies + if ( any(abs(freq)>Fs/2) ) + error( 'ar_psd: arg 3 (freq) cannot exceed half sampling frequency.' ); + elseif ( pad_fact==2 && any(freq<0) ) + error( 'ar_psd: arg 3 (freq) must be positive in onesided spectrum' ); + end + freq_len = length(freq); + fft_len = freq_len; + use_FFT = 0; + do_shift = 0; + else + %% internally generated frequencies + freq_len = freq; + freq = (Fs/pad_fact/freq_len) * [0:freq_len-1]'; + %% decide which method to use (poly or FFT) + is_power_of_2 = rem(log(freq_len),log(2))<10.*eps; + use_FFT = ( ~ force_poly && is_power_of_2 ) || force_FFT; + fft_len = freq_len * pad_fact; + end + end + %% + %% calculate denominator of Equation 2.28, Kay and Marple, ref [1]Jr.: + len_coeffs = length(a); + if ( use_FFT ) + %% FFT method + fft_out = fft( [ a(:); zeros(fft_len-len_coeffs,1) ] ); + else + %% polynomial method + %% complex data on "half" frequency range needs -ve frequency values + if ( pad_fact==2 && ~real_model ) + freq = [freq; -freq(freq_len:-1:1)]; + fft_len = 2*freq_len; + end + fft_out = polyval( a(len_coeffs:-1:1), exp( (-i*2*pi/Fs) * freq ) ); + end + %% + %% The power spectrum (PSD) is the scaled squared reciprocal of amplitude + %% of the FFT/polynomial. This is NOT the reciprocal of the periodogram. + %% The PSD is a continuous function of frequency. For uniformly + %% distributed frequency values, the FFT algorithm might be the most + %% efficient way of calculating it. + %% + psd = ( v / Fs ) ./ ( fft_out .* conj(fft_out) ); + %% + %% range='half' or 'onesided', + %% add PSD at -ve frequencies to PSD at +ve frequencies + %% N.B. unlike periodogram, PSD at zero frequency _is_ doubled. + if ( pad_fact==2 ) + freq = freq(1:freq_len); + if ( real_model ) + %% real data, double the psd + psd = 2 * psd(1:freq_len); + elseif ( use_FFT ) + %% complex data, FFT method, internally-generated frequencies + psd = psd(1:freq_len)+[psd(1); psd(fft_len:-1:freq_len+2)]; + else + %% complex data, polynomial method + %% user-defined and internally-generated frequencies + psd = psd(1:freq_len)+psd(fft_len:-1:freq_len+1); + end + %% + %% range='shift' + %% disabled for user-supplied frequencies + %% Shift zero-frequency to the middle (pad_fact==1) + elseif ( do_shift ) + len2 = fix((fft_len+1)/2); + psd = [psd(len2+1:fft_len); psd(1:len2)]; + freq = [freq(len2+1:fft_len)-Fs; freq(1:len2)]; + end + %% + %% Plot the spectrum if there are no return variables. + if ( nargout >= 2 ) + varargout{1} = psd; + varargout{2} = freq; + elseif ( nargout == 1 ) + varargout{1} = psd; + else + if ( plot_type == 1 ) + plot(freq,psd); + elseif ( plot_type == 2 ) + semilogx(freq,psd); + elseif ( plot_type == 3 ) + semilogy(freq,psd); + elseif ( plot_type == 4 ) + loglog(freq,psd); + elseif ( plot_type == 5 ) + plot(freq,10*log10(psd)); + end + end +end diff --git a/octave_packages/signal-1.1.3/arburg.m b/octave_packages/signal-1.1.3/arburg.m new file mode 100644 index 0000000..a13ff20 --- /dev/null +++ b/octave_packages/signal-1.1.3/arburg.m @@ -0,0 +1,228 @@ +%% Copyright (C) 2006 Peter V. Lanspeary +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% [a,v,k] = arburg(x,poles,criterion) +%% +%% Calculate coefficients of an autoregressive (AR) model of complex data +%% "x" using the whitening lattice-filter method of Burg (1968). The inverse +%% of the model is a moving-average filter which reduces "x" to white noise. +%% The power spectrum of the AR model is an estimate of the maximum +%% entropy power spectrum of the data. The function "ar_psd" calculates the +%% power spectrum of the AR model. +%% +%% ARGUMENTS: +%% x %% [vector] sampled data +%% +%% poles %% [integer scalar] number of poles in the AR model or +%% %% limit to the number of poles if a +%% %% valid "stop_crit" is provided. +%% +%% criterion %% [optional string arg] model-selection criterion. Limits +%% %% the number of poles so that spurious poles are not +%% %% added when the whitened data has no more information +%% %% in it (see Kay & Marple, 1981). Recognised values are +%% %% 'AKICc' -- approximate corrected Kullback information +%% %% criterion (recommended), +%% %% 'KIC' -- Kullback information criterion +%% %% 'AICc' -- corrected Akaike information criterion +%% %% 'AIC' -- Akaike information criterion +%% %% 'FPE' -- final prediction error" criterion +%% %% The default is to NOT use a model-selection criterion +%% +%% RETURNED VALUES: +%% a %% [polynomial/vector] list of (P+1) autoregression coeffic- +%% %% ients; for data input x(n) and white noise e(n), +%% %% the model is +%% %% P+1 +%% %% x(n) = sqrt(v).e(n) + SUM a(k).x(n-k) +%% %% k=1 +%% +%% v %% [real scalar] mean square of residual noise from the +%% %% whitening operation of the Burg lattice filter. +%% +%% k %% [column vector] reflection coefficients defining the +%% %% lattice-filter embodiment of the model +%% +%% HINTS: +%% (1) arburg does not remove the mean from the data. You should remove +%% the mean from the data if you want a power spectrum. A non-zero mean +%% can produce large errors in a power-spectrum estimate. See +%% "help detrend". +%% (2) If you don't know what the value of "poles" should be, choose the +%% largest (reasonable) value you could want and use the recommended +%% value, criterion='AKICc', so that arburg can find it. +%% E.g. arburg(x,64,'AKICc') +%% The AKICc has the least bias and best resolution of the available +%% model-selection criteria. +%% (3) arburg runs in octave and matlab, does not depend on octave forge +%% or signal-processing-toolbox functions. +%% (4) Autoregressive and moving-average filters are stored as polynomials +%% which, in matlab, are row vectors. +%% +%% NOTE ON SELECTION CRITERION +%% AIC, AICc, KIC and AKICc are based on information theory. They attempt +%% to balance the complexity (or length) of the model against how well the +%% model fits the data. AIC and KIC are biassed estimates of the asymmetric +%% and the symmetric Kullback-Leibler divergence respectively. AICc and +%% AKICc attempt to correct the bias. See reference [4]. +%% +%% +%% REFERENCES +%% [1] John Parker Burg (1968) +%% "A new analysis technique for time series data", +%% NATO advanced study Institute on Signal Processing with Emphasis on +%% Underwater Acoustics, Enschede, Netherlands, Aug. 12-23, 1968. +%% +%% [2] Steven M. Kay and Stanley Lawrence Marple Jr.: +%% "Spectrum analysis -- a modern perspective", +%% Proceedings of the IEEE, Vol 69, pp 1380-1419, Nov., 1981 +%% +%% [3] William H. Press and Saul A. Teukolsky and William T. Vetterling and +%% Brian P. Flannery +%% "Numerical recipes in C, The art of scientific computing", 2nd edition, +%% Cambridge University Press, 2002 --- Section 13.7. +%% +%% [4] Abd-Krim Seghouane and Maiza Bekara +%% "A small sample model selection criterion based on Kullback's symmetric +%% divergence", IEEE Transactions on Signal Processing, +%% Vol. 52(12), pp 3314-3323, Dec. 2004 + + +function [varargout] = arburg( x, poles, criterion ) +%% +%% Check arguments +if ( nargin < 2 ) + error( 'arburg(x,poles): Need at least 2 args.' ); +elseif ( ~isvector(x) || length(x) < 3 ) + error( 'arburg: arg 1 (x) must be vector of length >2.' ); +elseif ( ~isscalar(poles) || ~isreal(poles) || fix(poles)~=poles || poles<=0.5) + error( 'arburg: arg 2 (poles) must be positive integer.' ); +elseif ( poles >= length(x)-2 ) + %% lattice-filter algorithm requires "poles0 + error( 'arburg: arg 2 (poles) must be less than length(x)-2.' ); +elseif ( nargin>2 && ~isempty(criterion) && ... + (~ischar(criterion) || size(criterion,1)~=1 ) ) + error( 'arburg: arg 3 (criterion) must be string.' ); +else + %% + %% Set the model-selection-criterion flags. + %% is_AKICc, isa_KIC and is_corrected are short-circuit flags + if ( nargin > 2 && ~isempty(criterion) ) + is_AKICc = strcmp(criterion,'AKICc'); %% AKICc + isa_KIC = is_AKICc || strcmp(criterion,'KIC'); %% KIC or AKICc + is_corrected = is_AKICc || strcmp(criterion,'AICc'); %% AKICc or AICc + use_inf_crit = is_corrected || isa_KIC || strcmp(criterion,'AIC'); + use_FPE = strcmp(criterion,'FPE'); + if ( ~use_inf_crit && ~use_FPE ) + error( 'arburg: value of arg 3 (criterion) not recognised' ); + end + else + use_inf_crit = 0; + use_FPE = 0; + end + %% + %% f(n) = forward prediction error + %% b(n) = backward prediction error + %% Storage of f(n) and b(n) is a little tricky. Because f(n) is always + %% combined with b(n-1), f(1) and b(N) are never used, and therefore are + %% not stored. Not storing unused data makes the calculation of the + %% reflection coefficient look much cleaner :) + %% N.B. {initial v} = {error for zero-order model} = + %% {zero-lag autocorrelation} = E(x*conj(x)) = x*x'/N + %% E = expectation operator + N = length(x); + k = []; + if ( size(x,1) > 1 ) % if x is column vector + f = x(2:N); + b = x(1:N-1); + v = real(x'*x) / N; + else % if x is row vector + f = x(2:N).'; + b = x(1:N-1).'; + v = real(x*x') / N; + end + %% new_crit/old_crit is the mode-selection criterion + new_crit = abs(v); + old_crit = 2 * new_crit; + for p = 1:poles + %% + %% new reflection coeff = -2* E(f.conj(b)) / ( E(f^2)+E(b(^2) ) + last_k= -2 * (b' * f) / ( f' * f + b' * b); + %% Levinson-Durbin recursion for residual + new_v = v * ( 1.0 - real(last_k * conj(last_k)) ); + if ( p > 1 ) + %% + %% Apply the model-selection criterion and break out of loop if it + %% increases (rather than decreases). + %% Do it before we update the old model "a" and "v". + %% + %% * Information Criterion (AKICc, KIC, AICc, AIC) + if ( use_inf_crit ) + old_crit = new_crit; + %% AKICc = log(new_v)+p/N/(N-p)+(3-(p+2)/N)*(p+1)/(N-p-2); + %% KIC = log(new_v)+ 3 *(p+1)/N; + %% AICc = log(new_v)+ 2 *(p+1)/(N-p-2); + %% AIC = log(new_v)+ 2 *(p+1)/N; + %% -- Calculate KIC, AICc & AIC by using is_AKICc, is_KIC and + %% is_corrected to "short circuit" the AKICc calculation. + %% The extra 4--12 scalar arithmetic ops should be quicker than + %% doing if...elseif...elseif...elseif...elseif. + new_crit = log(new_v) + is_AKICc*p/N/(N-p) + ... + (2+isa_KIC-is_AKICc*(p+2)/N) * (p+1) / (N-is_corrected*(p+2)); + if ( new_crit > old_crit ) + break; + end + %% + %% (FPE) Final prediction error + elseif ( use_FPE ) + old_crit = new_crit; + new_crit = new_v * (N+p+1)/(N-p-1); + if ( new_crit > old_crit ) + break; + end + end + %% Update model "a" and "v". + %% Use Levinson-Durbin recursion formula (for complex data). + a = [ prev_a + last_k .* conj(prev_a(p-1:-1:1)) last_k ]; + else %% if( p==1 ) + a = last_k; + end + k = [ k; last_k ]; + v = new_v; + if ( p < poles ) + prev_a = a; + %% calculate new prediction errors (by recursion): + %% f(p,n) = f(p-1,n) + k * b(p-1,n-1) n=2,3,...n + %% b(p,n) = b(p-1,n-1) + conj(k) * f(p-1,n) n=2,3,...n + %% remember f(p,1) is not stored, so don't calculate it; make f(p,2) + %% the first element in f. b(p,n) isn't calculated either. + nn = N-p; + new_f = f(2:nn) + last_k * b(2:nn); + b = b(1:nn-1) + conj(last_k) * f(1:nn-1); + f = new_f; + end + end + %% end of for loop + %% + varargout{1} = [1 a]; + varargout{2} = v; + if ( nargout>=3 ) + varargout{3} = k; + end +end +end + +%% diff --git a/octave_packages/signal-1.1.3/aryule.m b/octave_packages/signal-1.1.3/aryule.m new file mode 100644 index 0000000..f9047d2 --- /dev/null +++ b/octave_packages/signal-1.1.3/aryule.m @@ -0,0 +1,61 @@ +## Copyright (C) 1999 Paul Kienzle +## Copyright (C) 2006 Peter Lanspeary +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [a, v, k] = aryule (x, p) +## +## fits an AR (p)-model with Yule-Walker estimates. +## x = data vector to estimate +## a: AR coefficients +## v: variance of white noise +## k: reflection coeffients for use in lattice filter +## +## The power spectrum of the resulting filter can be plotted with +## pyulear(x, p), or you can plot it directly with ar_psd(a,v,...). +## +## See also: +## pyulear, power, freqz, impz -- for observing characteristics of the model +## arburg -- for alternative spectral estimators +## +## Example: Use example from arburg, but substitute aryule for arburg. +## +## Note: Orphanidis '85 claims lattice filters are more tolerant of +## truncation errors, which is why you might want to use them. However, +## lacking a lattice filter processor, I haven't tested that the lattice +## filter coefficients are reasonable. + +function [a, v, k] = aryule (x, p) + if ( nargin~=2 ) + print_usage; + elseif ( ~isvector(x) || length(x)<3 ) + error( 'aryule: arg 1 (x) must be vector of length >2' ); + elseif ( ~isscalar(p) || fix(p)~=p || p > length(x)-2 ) + error( 'aryule: arg 2 (p) must be an integer >0 and +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{w}] =} barthannwin(@var{L}) +## Compute the modified Bartlett-Hann window of lenght L. +## @seealso{rectwin, bartlett} +## @end deftypefn + +function [w] = barthannwin(L) + if (nargin < 1) + print_usage; + elseif (! isscalar(L) || L < 0) + error("L must be a positive integer"); + endif + L = round(L); + N = L-1; + n = 0:N; + + w = 0.62 -0.48.*abs(n./(L-1) - 0.5)+0.38*cos(2.*pi*(n./(L-1)-0.5)); + w = w'; +endfunction diff --git a/octave_packages/signal-1.1.3/besselap.m b/octave_packages/signal-1.1.3/besselap.m new file mode 100644 index 0000000..e0d6890 --- /dev/null +++ b/octave_packages/signal-1.1.3/besselap.m @@ -0,0 +1,52 @@ +## Copyright (C) 2009 Thomas Sailer +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Return bessel analog filter prototype. +## +## References: +## +## http://en.wikipedia.org/wiki/Bessel_polynomials + +function [zero, pole, gain] = besselap (n) + + if (nargin>1 || nargin<1) + print_usage; + end + + ## interpret the input parameters + if (!(length(n)==1 && n == round(n) && n > 0)) + error ("besselap: filter order n must be a positive integer"); + end + + p0=1; + p1=[1 1]; + for nn=2:n; + px=(2*nn-1)*p1; + py=[p0 0 0]; + px=prepad(px,max(length(px),length(py)),0); + py=prepad(py,length(px)); + p0=p1; + p1=px+py; + endfor; + % p1 now contains the reverse bessel polynomial for n + + % scale it by replacing s->s/w0 so that the gain becomes 1 + p1=p1.*p1(length(p1)).^((length(p1)-1:-1:0)/(length(p1)-1)); + + zero=[]; + pole=roots(p1); + gain=1; + +endfunction diff --git a/octave_packages/signal-1.1.3/besself.m b/octave_packages/signal-1.1.3/besself.m new file mode 100644 index 0000000..44405ab --- /dev/null +++ b/octave_packages/signal-1.1.3/besself.m @@ -0,0 +1,117 @@ +## Copyright (C) 1999 Paul Kienzle +## Copyright (C) 2003 Doug Stewart +## Copyright (C) 2009 Thomas Sailer +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Generate a bessel filter. +## Default is a Laplace space (s) filter. +## +## [b,a] = besself(n, Wc) +## low pass filter with cutoff pi*Wc radians +## +## [b,a] = besself(n, Wc, 'high') +## high pass filter with cutoff pi*Wc radians +## +## [b,a] = besself(n, [Wl, Wh]) +## band pass filter with edges pi*Wl and pi*Wh radians +## +## [b,a] = besself(n, [Wl, Wh], 'stop') +## band reject filter with edges pi*Wl and pi*Wh radians +## +## [z,p,g] = besself(...) +## return filter as zero-pole-gain rather than coefficients of the +## numerator and denominator polynomials. +## +## [...] = besself(...,'z') +## return a discrete space (Z) filter, W must be less than 1. +## +## [a,b,c,d] = besself(...) +## return state-space matrices +## +## References: +## +## Proakis & Manolakis (1992). Digital Signal Processing. New York: +## Macmillan Publishing Company. + +function [a, b, c, d] = besself (n, W, varargin) + + if (nargin>4 || nargin<2) || (nargout>4 || nargout<2) + print_usage; + end + + ## interpret the input parameters + if (!(length(n)==1 && n == round(n) && n > 0)) + error ("besself: filter order n must be a positive integer"); + end + + stop = 0; + digital = 0; + for i=1:length(varargin) + switch varargin{i} + case 's', digital = 0; + case 'z', digital = 1; + case { 'high', 'stop' }, stop = 1; + case { 'low', 'pass' }, stop = 0; + otherwise, error ("besself: expected [high|stop] or [s|z]"); + endswitch + endfor + + + [r, c]=size(W); + if (!(length(W)<=2 && (r==1 || c==1))) + error ("besself: frequency must be given as w0 or [w0, w1]"); + elseif (!(length(W)==1 || length(W) == 2)) + error ("besself: only one filter band allowed"); + elseif (length(W)==2 && !(W(1) < W(2))) + error ("besself: first band edge must be smaller than second"); + endif + + if ( digital && !all(W >= 0 & W <= 1)) + error ("besself: critical frequencies must be in (0 1)"); + elseif ( !digital && !all(W >= 0 )) + error ("besself: critical frequencies must be in (0 inf)"); + endif + + ## Prewarp to the band edges to s plane + if digital + T = 2; # sampling frequency of 2 Hz + W = 2/T*tan(pi*W/T); + endif + + ## Generate splane poles for the prototype bessel filter + [zero, pole, gain] = besselap(n); + + ## splane frequency transform + [zero, pole, gain] = sftrans(zero, pole, gain, W, stop); + + ## Use bilinear transform to convert poles to the z plane + if digital + [zero, pole, gain] = bilinear(zero, pole, gain, T); + endif + + ## convert to the correct output form + if nargout==2, + a = real(gain*poly(zero)); + b = real(poly(pole)); + elseif nargout==3, + a = zero; + b = pole; + c = gain; + else + ## output ss results + [a, b, c, d] = zp2ss (zero, pole, gain); + endif + +endfunction diff --git a/octave_packages/signal-1.1.3/bilinear.m b/octave_packages/signal-1.1.3/bilinear.m new file mode 100644 index 0000000..5cab179 --- /dev/null +++ b/octave_packages/signal-1.1.3/bilinear.m @@ -0,0 +1,104 @@ +## Copyright (C) 1999 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T) +## [Zb, Za] = bilinear(Sb, Sa, T) +## +## Transform a s-plane filter specification into a z-plane +## specification. Filters can be specified in either zero-pole-gain or +## transfer function form. The input form does not have to match the +## output form. 1/T is the sampling frequency represented in the z plane. +## +## Note: this differs from the bilinear function in the signal processing +## toolbox, which uses 1/T rather than T. +## +## Theory: Given a piecewise flat filter design, you can transform it +## from the s-plane to the z-plane while maintaining the band edges by +## means of the bilinear transform. This maps the left hand side of the +## s-plane into the interior of the unit circle. The mapping is highly +## non-linear, so you must design your filter with band edges in the +## s-plane positioned at 2/T tan(w*T/2) so that they will be positioned +## at w after the bilinear transform is complete. +## +## The following table summarizes the transformation: +## +## +---------------+-----------------------+----------------------+ +## | Transform | Zero at x | Pole at x | +## | H(S) | H(S) = S-x | H(S)=1/(S-x) | +## +---------------+-----------------------+----------------------+ +## | 2 z-1 | zero: (2+xT)/(2-xT) | zero: -1 | +## | S -> - --- | pole: -1 | pole: (2+xT)/(2-xT) | +## | T z+1 | gain: (2-xT)/T | gain: (2-xT)/T | +## +---------------+-----------------------+----------------------+ +## +## With tedious algebra, you can derive the above formulae yourself by +## substituting the transform for S into H(S)=S-x for a zero at x or +## H(S)=1/(S-x) for a pole at x, and converting the result into the +## form: +## +## H(Z)=g prod(Z-Xi)/prod(Z-Xj) +## +## Please note that a pole and a zero at the same place exactly cancel. +## This is significant since the bilinear transform creates numerous +## extra poles and zeros, most of which cancel. Those which do not +## cancel have a "fill-in" effect, extending the shorter of the sets to +## have the same number of as the longer of the sets of poles and zeros +## (or at least split the difference in the case of the band pass +## filter). There may be other opportunistic cancellations but I will +## not check for them. +## +## Also note that any pole on the unit circle or beyond will result in +## an unstable filter. Because of cancellation, this will only happen +## if the number of poles is smaller than the number of zeros. The +## analytic design methods all yield more poles than zeros, so this will +## not be a problem. +## +## References: +## +## Proakis & Manolakis (1992). Digital Signal Processing. New York: +## Macmillan Publishing Company. + +function [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T) + + if nargin==3 + T = Sg; + [Sz, Sp, Sg] = tf2zp(Sz, Sp); + elseif nargin!=4 + print_usage; + end + + p = length(Sp); + z = length(Sz); + if z > p || p==0 + error("bilinear: must have at least as many poles as zeros in s-plane"); + end + +## ---------------- ------------------------- ------------------------ +## Bilinear zero: (2+xT)/(2-xT) pole: (2+xT)/(2-xT) +## 2 z-1 pole: -1 zero: -1 +## S -> - --- gain: (2-xT)/T gain: (2-xT)/T +## T z+1 +## ---------------- ------------------------- ------------------------ + Zg = real(Sg * prod((2-Sz*T)/T) / prod((2-Sp*T)/T)); + Zp = (2+Sp*T)./(2-Sp*T); + if isempty(Sz) + Zz = -ones(size(Zp)); + else + Zz = [(2+Sz*T)./(2-Sz*T)]; + Zz = postpad(Zz, p, -1); + end + + if nargout==2, [Zz, Zp] = zp2tf(Zz, Zp, Zg); endif +endfunction diff --git a/octave_packages/signal-1.1.3/bitrevorder.m b/octave_packages/signal-1.1.3/bitrevorder.m new file mode 100644 index 0000000..d9e1322 --- /dev/null +++ b/octave_packages/signal-1.1.3/bitrevorder.m @@ -0,0 +1,98 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y} @var{i}] =} bitrevorder(@var{x}) +## Reorder x in the bit reversed order +## @seealso{fft,ifft} +## @end deftypefn + +function [y i] = bitrevorder(x) + + if(nargin < 1 || nargin >1) + print_usage; + elseif(log2(length(x)) ~= floor(log2(length(x)))) + error('x must have a length equal to a power of 2'); + end + + old_ind = 0:length(x)-1; + new_ind = bi2de(fliplr(de2bi(old_ind))); + i = new_ind + 1; + + y(old_ind+1) = x(i); + +endfunction + +## The following functions, de2bi and bi2de, are from the communications package. +## However, the communications package is already dependent on the signal +## package and to avoid circular dependencies their code was copied here. Anyway, +## in the future bitrevorder should be rewritten as to not use this functions +## at all (and pkg can be fixed to support circular dependencies on pkg load +## as it already does for pkg install). + +## note that aside copying the code from the communication package, their input +## check was removed since in this context they were always being called with +## nargin == 1 + +function b = de2bi (d, n, p, f) + + p = 2; + n = floor ( log (max (max (d), 1)) ./ log (p) ) + 1; + f = 'right-msb'; + + d = d(:); + if ( any (d < 0) || any (d != floor (d)) ) + error ("de2bi: d must only contain non-negative integers"); + endif + + if (isempty (n)) + n = floor ( log (max (max (d), 1)) ./ log (p) ) + 1; + endif + + power = ones (length (d), 1) * (p .^ [0 : n-1] ); + d = d * ones (1, n); + b = floor (rem (d, p*power) ./ power); + + if (strcmp (f, 'left-msb')) + b = b(:,columns(b):-1:1); + elseif (!strcmp (f, 'right-msb')) + error ("de2bi: unrecognized flag"); + endif + +endfunction + + +function d = bi2de (b, p, f) + + p = 2; + f = 'right-msb'; + + if ( any (b(:) < 0) || any (b(:) != floor (b(:))) || any (b(:) > p - 1) ) + error ("bi2de: d must only contain integers in the range [0, p-1]"); + endif + + if (strcmp (f, 'left-msb')) + b = b(:,size(b,2):-1:1); + elseif (!strcmp (f, 'right-msb')) + error ("bi2de: unrecognized flag"); + endif + + if (length (b) == 0) + d = []; + else + d = b * ( p .^ [ 0 : (columns(b)-1) ]' ); + endif + +endfunction diff --git a/octave_packages/signal-1.1.3/blackmanharris.m b/octave_packages/signal-1.1.3/blackmanharris.m new file mode 100644 index 0000000..a18fa85 --- /dev/null +++ b/octave_packages/signal-1.1.3/blackmanharris.m @@ -0,0 +1,36 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{w}] =} blackmanharris(@var{L}) +## Compute the Blackman-Harris window. +## @seealso{rectwin, bartlett} +## @end deftypefn + +function [w] = blackmanharris (L) + if (nargin < 1) + print_usage; + elseif(! isscalar(L)) + error("L must be a number"); + endif + + N = L-1; + a0 = 0.35875; + a1 = 0.48829; + a2 = 0.14128; + a3 = 0.01168; + n = 0:N; + w = a0 - a1.*cos(2.*pi.*n./N) + a2.*cos(4.*pi.*n./N) - a3.*cos(6.*pi.*n./N); +endfunction diff --git a/octave_packages/signal-1.1.3/blackmannuttall.m b/octave_packages/signal-1.1.3/blackmannuttall.m new file mode 100644 index 0000000..e3e588e --- /dev/null +++ b/octave_packages/signal-1.1.3/blackmannuttall.m @@ -0,0 +1,37 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{w}] =} blackmannuttall(@var{L}) +## Compute the Blackman-Nuttall window. +## @seealso{nuttallwin, kaiser} +## @end deftypefn + +function [w] = blackmannuttall(L) + if (nargin < 1) + print_usage; + elseif (! isscalar(L)) + error("L must be a number"); + endif + + N = L-1; + a0 = 0.3635819; + a1 = 0.4891775; + a2 = 0.1365995; + a3 = 0.0106411; + n = 0:N; + w = a0 - a1.*cos(2.*pi.*n./N) + a2.*cos(4.*pi.*n./N) - a3.*cos(6.*pi.*n./N); + w = w.'; +endfunction diff --git a/octave_packages/signal-1.1.3/bohmanwin.m b/octave_packages/signal-1.1.3/bohmanwin.m new file mode 100644 index 0000000..7443221 --- /dev/null +++ b/octave_packages/signal-1.1.3/bohmanwin.m @@ -0,0 +1,51 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{w}] =} bohmanwin(@var{L}) +## Compute the Bohman window of lenght L. +## @seealso{rectwin, bartlett} +## @end deftypefn + +function [w] = bohmanwin(L) + if (nargin < 1) + print_usage + elseif(! isscalar(L)) + error("L must be a number"); + elseif(L < 0) + error('L must be positive'); + end + + if(L ~= floor(L)) + L = round(L); + warning('L rounded to the nearest integer.'); + end + + if(L == 0) + w = []; + + elseif(L == 1) + w = 1; + + else + N = L-1; + n = -N/2:N/2; + + w = (1-2.*abs(n)./N).*cos(2.*pi.*abs(n)./N) + (1./pi).*sin(2.*pi.*abs(n)./N); + w(1) = 0; + w(length(w))=0; + w = w'; + end +endfunction diff --git a/octave_packages/signal-1.1.3/boxcar.m b/octave_packages/signal-1.1.3/boxcar.m new file mode 100644 index 0000000..928a3b5 --- /dev/null +++ b/octave_packages/signal-1.1.3/boxcar.m @@ -0,0 +1,30 @@ +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: w = boxcar (n) +## +## Returns the filter coefficients of a rectangular window of length n. + +function w = boxcar (n) + + if (nargin != 1) + print_usage; + elseif !isscalar(n) || n != floor(n) || n <= 0 + error ("boxcar: n must be an integer > 0"); + endif + + w = ones(n, 1); + +endfunction diff --git a/octave_packages/signal-1.1.3/buffer.m b/octave_packages/signal-1.1.3/buffer.m new file mode 100644 index 0000000..ccca9a0 --- /dev/null +++ b/octave_packages/signal-1.1.3/buffer.m @@ -0,0 +1,275 @@ +## Copyright (C) 2008 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} = } buffer (@var{x}, @var{n}, @var{p}, @var{opt}) +## @deftypefnx {Function File} {[@var{y}, @var{z}, @var{opt}] = } buffer (@dots{}) +## Buffer a signal into a data frame. The arguments to @code{buffer} are +## +## @table @asis +## @item @var{x} +## The data to be buffered. +## +## @item @var{n} +## The number of rows in the produced data buffer. This is an positive +## integer value and must be supplied. +## +## @item @var{p} +## An integer less than @var{n} that specifies the under- or overlap +## between column in the data frame. The default value of @var{p} is 0. +## +## @item @var{opt} +## In the case of an overlap, @var{opt} can be either a vector of length +## @var{p} or the string 'nodelay'. If @var{opt} is a vector, then the +## first @var{p} entries in @var{y} will be filled with these values. If +## @var{opt} is the string 'nodelay', then the first value of @var{y} +## corresponds to the first value of @var{x}. +## +## In the can of an underlap, @var{opt} must be an integer between 0 and +## @code{-@var{p}}. The represents the initial underlap of the first +## column of @var{y}. +## +## The default value for @var{opt} the vector @code{zeros (1, @var{p})} +## in the case of an overlap, or 0 otherwise. +## @end table +## +## In the case of a single output argument, @var{y} will be padded with +## zeros to fill the missing values in the data frame. With two output +## arguments @var{z} is the remaining data that has not been used in the +## current data frame. +## +## Likewise, the output @var{opt} is the overlap, or underlap that might +## be used for a future call to @code{code} to allow continuous buffering. +## @end deftypefn + +function [y, z, opt] = buffer (x, n, p, opt) + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + if (!isscalar (n) || n != floor (n)) + error ("buffer: n must be an inetger"); + endif + if (nargin < 3) + p = 0; + elseif (!isscalar (p) || p != floor (p) || p >= n) + error ("buffer: p must be an inetger less than n"); + endif + if (nargin < 4) + if (p < 0) + opt = 0; + else + opt = zeros (1, p); + endif + endif + + if (rows (x) == 1) + isrowvec = true; + else + isrowvec = false; + endif + + if (p < 0) + if (isscalar (opt) && opt == floor (opt) && opt >= 0 && opt <= -p) + lopt = opt; + else + error ("buffer: expecting fourth argument to be and integer between 0 and -p"); + endif + else + lopt = 0; + endif + + x = x (:); + l = length (x); + m = ceil ((l - lopt) / (n - p)); + y = zeros (n - p, m); + y (1 : l - lopt) = x (lopt + 1 : end); + if (p < 0) + y (end + p + 1 : end, :) = []; + elseif (p > 0) + if (ischar (opt)) + if (strcmp (opt, "nodelay")) + y = [y ; zeros(p, m)]; + if (p > n / 2) + is = n - p + 1; + in = n - p; + ie = is + in - 1; + off = 1; + while (in > 0) + y (is : ie, 1 : end - off) = y (1 : in, 1 + off : end); + off++; + is = ie + 1; + ie = ie + in; + if (ie > n) + ie = n; + endif + in = ie - is + 1; + endwhile + [i, j] = ind2sub([n-p, m], l); + if (all ([i, j] == [n-p, m])) + off --; + endif + y (:, end - off + 2 : end) = []; + else + y (end - p + 1 : end, 1 : end - 1) = y (1 : p, 2 : end); + if (sub2ind([n-p, m], p, m) >= l) + y (:, end) = []; + endif + endif + else + error ("buffer: unexpected string argument"); + endif + elseif (isvector (opt)) + if (length (opt) == p) + lopt = p; + y = [zeros(p, m); y]; + in = p; + off = 1; + while (in > 0) + y (1 : in, off) = opt(off:end); + off++; + in = in - n + p; + endwhile + if (p > n / 2) + in = n - p; + ie = p; + is = p - in + 1; + off = 1; + while (ie > 0) + y (is : ie, 1 + off : end) = ... + y (end - in + 1 : end, 1 : end - off); + off++; + ie = is - 1; + is = is - in; + if (is < 1) + is = 1; + endif + in = ie - is + 1; + endwhile + else + y (1 : p, 2 : end) = y (end - p + 1 : end, 1 : end - 1); + endif + else + error ("buffer: opt vector must be of length p"); + endif + else + error ("buffer: unrecognized fourth argument"); + endif + endif + if (nargout > 1) + if (p >= 0) + [i, j] = ind2sub (size(y), l + lopt + p * (size (y, 2) - 1)); + if (any ([i, j] != size (y))) + z = y (1 + p : i, end); + y (:, end) = []; + else + z = zeros (0, 1); + endif + else + [i, j] = ind2sub (size (y) + [-p, 0], l - lopt); + if (i < size (y, 1)) + z = y (1: i, end); + y (:, end) = []; + else + z = zeros (0, 1); + endif + endif + if (isrowvec) + z = z.'; + endif + if (p < 0) + opt = max(0, size (y, 2) * (n - p) + opt - l); + elseif (p > 0) + opt = y(end-p+1:end)(:); + else + opt = []; + endif + endif +endfunction + +%!error (buffer(1:10, 4.1)) +%!assert (buffer(1:10, 4), reshape([1:10,0,0],[4,3])) +%!assert (buffer(1:10, 4, 1), reshape([0:3,3:6,6:9,9,10,0,0],[4,4])) +%!assert (buffer(1:10, 4, 2), reshape ([0,0:2,1:4,3:6,5:8,7:10],[4,5])) +%!assert (buffer(1:10, 4, 3), [0,0,0:7;0,0:8;0:9;1:10]) +%!error (buffer(1:10, 4, 3.1)) +%!error (buffer(1:10, 4, 4)) +%!assert (buffer(1:10, 4, -1), reshape([1:4,6:9],[4,2])) +%!assert (buffer(1:10, 4, -2), reshape([1:4,7:10],[4,2])) +%!assert (buffer(1:10, 4, -3), reshape([1:4,8:10,0],[4,2])) +%!assert (buffer(1:10, 4, 1, 11), reshape([11,1:3,3:6,6:9,9,10,0,0],[4,4])) +%!error (buffer(1:10, 4, 1, [10,11])) +%!assert (buffer(1:10, 4, 1, 'nodelay'), reshape([1:4,4:7,7:10],[4,3])) +%!error (buffer(1:10, 4, 1, 'badstring')) +%!assert (buffer(1:10, 4, 2,'nodelay'), reshape ([1:4,3:6,5:8,7:10],[4,4])) +%!assert (buffer(1:10, 4, 3, [11,12,13]),[11,12,13,1:7;12,13,1:8;13,1:9;1:10]) +%!assert (buffer(1:10, 4, 3, 'nodelay'),[1:8;2:9;3:10;4:10,0]) +%!assert (buffer(1:11,4,-2,1),reshape([2:5,8:11],4,2)) + +%!test +%! [y, z] = buffer(1:12,4); +%! assert (y, reshape(1:12,4,3)); +%! assert (z, zeros (1,0)); + +%!test +%! [y, z] = buffer(1:11,4); +%! assert (y, reshape(1:8,4,2)); +%! assert (z, [9, 10, 11]); + +%!test +%! [y, z] = buffer([1:12]',4); +%! assert (y, reshape(1:12,4,3)); +%! assert (z, zeros (0,1)); + +%!test +%! [y, z] = buffer([1:11]',4); +%! assert (y, reshape(1:8,4,2)); +%! assert (z, [9; 10; 11]); + +%!test +%! [y,z,opt] = buffer(1:15,4,-2,1); +%! assert (y, reshape([2:5,8:11],4,2)); +%! assert (z, [14, 15]); +%! assert (opt, 0); + +%!test +%! [y,z,opt] = buffer(1:11,4,-2,1); +%! assert (y, reshape([2:5,8:11],4,2)); +%! assert (z, zeros (1,0)); +%! assert (opt, 2); + +%!test +%! [y,z,opt] = buffer([1:15]',4,-2,1); +%! assert (y, reshape([2:5,8:11],4,2)); +%! assert (z, [14; 15]); +%! assert (opt, 0); + +%!test +%! [y,z,opt] = buffer([1:11]',4,-2,1); +%! assert (y, reshape([2:5,8:11],4,2)); +%! assert (z, zeros (0, 1)); +%! assert (opt, 2); + +%!test +%! [y,z,opt] = buffer([1:11],5,2,[-1,0]); +%! assert (y, reshape ([-1:3,2:6,5:9],[5,3])); +%! assert (z, [10, 11]); +%! assert (opt, [8; 9]); + +%!test +%! [y,z,opt] = buffer([1:11]',5,2,[-1,0]); +%! assert (y, reshape ([-1:3,2:6,5:9],[5,3])); +%! assert (z, [10; 11]); +%! assert (opt, [8; 9]); diff --git a/octave_packages/signal-1.1.3/butter.m b/octave_packages/signal-1.1.3/butter.m new file mode 100644 index 0000000..9d2d004 --- /dev/null +++ b/octave_packages/signal-1.1.3/butter.m @@ -0,0 +1,176 @@ +## Copyright (C) 1999 Paul Kienzle +## Copyright (C) 2003 Doug Stewart +## Copyright (C) 2011 Alexander Klein +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Generate a butterworth filter. +## Default is a discrete space (Z) filter. +## +## [b,a] = butter(n, Wc) +## low pass filter with cutoff pi*Wc radians +## +## [b,a] = butter(n, Wc, 'high') +## high pass filter with cutoff pi*Wc radians +## +## [b,a] = butter(n, [Wl, Wh]) +## band pass filter with edges pi*Wl and pi*Wh radians +## +## [b,a] = butter(n, [Wl, Wh], 'stop') +## band reject filter with edges pi*Wl and pi*Wh radians +## +## [z,p,g] = butter(...) +## return filter as zero-pole-gain rather than coefficients of the +## numerator and denominator polynomials. +## +## [...] = butter(...,'s') +## return a Laplace space filter, W can be larger than 1. +## +## [a,b,c,d] = butter(...) +## return state-space matrices +## +## References: +## +## Proakis & Manolakis (1992). Digital Signal Processing. New York: +## Macmillan Publishing Company. + +function [a, b, c, d] = butter (n, W, varargin) + + if (nargin>4 || nargin<2) || (nargout>4 || nargout<2) + print_usage; + end + + ## interpret the input parameters + if (!(length(n)==1 && n == round(n) && n > 0)) + error ("butter: filter order n must be a positive integer"); + end + + stop = 0; + digital = 1; + for i=1:length(varargin) + switch varargin{i} + case 's', digital = 0; + case 'z', digital = 1; + case { 'high', 'stop' }, stop = 1; + case { 'low', 'pass' }, stop = 0; + otherwise, error ("butter: expected [high|stop] or [s|z]"); + endswitch + endfor + + + [r, c]=size(W); + if (!(length(W)<=2 && (r==1 || c==1))) + error ("butter: frequency must be given as w0 or [w0, w1]"); + elseif (!(length(W)==1 || length(W) == 2)) + error ("butter: only one filter band allowed"); + elseif (length(W)==2 && !(W(1) < W(2))) + error ("butter: first band edge must be smaller than second"); + endif + + if ( digital && !all(W >= 0 & W <= 1)) + error ("butter: critical frequencies must be in (0 1)"); + elseif ( !digital && !all(W >= 0 )) + error ("butter: critical frequencies must be in (0 inf)"); + endif + + ## Prewarp to the band edges to s plane + if digital + T = 2; # sampling frequency of 2 Hz + W = 2/T*tan(pi*W/T); + endif + + ## Generate splane poles for the prototype butterworth filter + ## source: Kuc + C = 1; # default cutoff frequency + pole = C*exp(1i*pi*(2*[1:n] + n - 1)/(2*n)); + if mod(n,2) == 1, pole((n+1)/2) = -1; end # pure real value at exp(i*pi) + zero = []; + gain = C^n; + + ## splane frequency transform + [zero, pole, gain] = sftrans(zero, pole, gain, W, stop); + + ## Use bilinear transform to convert poles to the z plane + if digital + [zero, pole, gain] = bilinear(zero, pole, gain, T); + endif + + ## convert to the correct output form + if nargout==2, + a = real(gain*poly(zero)); + b = real(poly(pole)); + elseif nargout==3, + a = zero; + b = pole; + c = gain; + else + ## output ss results + [a, b, c, d] = zp2ss (zero, pole, gain); + endif + +endfunction + +%!shared sf, sf2, off_db +%! off_db = 0.5; +%! ##Sampling frequency must be that high to make the low pass filters pass. +%! sf = 6000; sf2 = sf/2; +%! data=[sinetone(5,sf,10,1),sinetone(10,sf,10,1),sinetone(50,sf,10,1),sinetone(200,sf,10,1),sinetone(400,sf,10,1)]; + +%!test +%! ##Test low pass order 1 with 3dB @ 50Hz +%! data=[sinetone(5,sf,10,1),sinetone(10,sf,10,1),sinetone(50,sf,10,1),sinetone(200,sf,10,1),sinetone(400,sf,10,1)]; +%! [b, a] = butter ( 1, 50 / sf2 ); +%! filtered = filter ( b, a, data ); +%! damp_db = 20 * log10 ( max ( filtered ( end - sf : end, : ) ) ); +%! assert ( [ damp_db( 4 ) - damp_db( 5 ), damp_db( 1 : 3 ) ], [ 6 0 0 -3 ], off_db ) + +%!test +%! ##Test low pass order 4 with 3dB @ 50Hz +%! data=[sinetone(5,sf,10,1),sinetone(10,sf,10,1),sinetone(50,sf,10,1),sinetone(200,sf,10,1),sinetone(400,sf,10,1)]; +%! [b, a] = butter ( 4, 50 / sf2 ); +%! filtered = filter ( b, a, data ); +%! damp_db = 20 * log10 ( max ( filtered ( end - sf : end, : ) ) ); +%! assert ( [ damp_db( 4 ) - damp_db( 5 ), damp_db( 1 : 3 ) ], [ 24 0 0 -3 ], off_db ) + +%!test +%! ##Test high pass order 1 with 3dB @ 50Hz +%! data=[sinetone(5,sf,10,1),sinetone(10,sf,10,1),sinetone(50,sf,10,1),sinetone(200,sf,10,1),sinetone(400,sf,10,1)]; +%! [b, a] = butter ( 1, 50 / sf2, "high" ); +%! filtered = filter ( b, a, data ); +%! damp_db = 20 * log10 ( max ( filtered ( end - sf : end, : ) ) ); +%! assert ( [ damp_db( 2 ) - damp_db( 1 ), damp_db( 3 : end ) ], [ 6 -3 0 0 ], off_db ) + +%!test +%! ##Test high pass order 4 with 3dB @ 50Hz +%! data=[sinetone(5,sf,10,1),sinetone(10,sf,10,1),sinetone(50,sf,10,1),sinetone(200,sf,10,1),sinetone(400,sf,10,1)]; +%! [b, a] = butter ( 4, 50 / sf2, "high" ); +%! filtered = filter ( b, a, data ); +%! damp_db = 20 * log10 ( max ( filtered ( end - sf : end, : ) ) ); +%! assert ( [ damp_db( 2 ) - damp_db( 1 ), damp_db( 3 : end ) ], [ 24 -3 0 0 ], off_db ) + +%!demo +%! sf = 800; sf2 = sf/2; +%! data=[[1;zeros(sf-1,1)],sinetone(25,sf,1,1),sinetone(50,sf,1,1),sinetone(100,sf,1,1)]; +%! [b,a]=butter ( 1, 50 / sf2 ); +%! filtered = filter(b,a,data); +%! +%! clf +%! subplot ( columns ( filtered ), 1, 1) +%! plot(filtered(:,1),";Impulse response;") +%! subplot ( columns ( filtered ), 1, 2 ) +%! plot(filtered(:,2),";25Hz response;") +%! subplot ( columns ( filtered ), 1, 3 ) +%! plot(filtered(:,3),";50Hz response;") +%! subplot ( columns ( filtered ), 1, 4 ) +%! plot(filtered(:,4),";100Hz response;") diff --git a/octave_packages/signal-1.1.3/buttord.m b/octave_packages/signal-1.1.3/buttord.m new file mode 100644 index 0000000..54af87c --- /dev/null +++ b/octave_packages/signal-1.1.3/buttord.m @@ -0,0 +1,82 @@ +## Copyright (C) 1999 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Compute butterworth filter order and cutoff for the desired response +## characteristics. Rp is the allowable decibels of ripple in the pass +## band. Rs is the minimum attenuation in the stop band. +## +## [n, Wc] = buttord(Wp, Ws, Rp, Rs) +## Low pass (WpWs) filter design. Wp is the +## pass band edge and Ws is the stop band edge. Frequencies are +## normalized to [0,1], corresponding to the range [0,Fs/2]. +## +## [n, Wc] = buttord([Wp1, Wp2], [Ws1, Ws2], Rp, Rs) +## Band pass (Ws1Ws) || all(Ws>Wp) || diff(Wp)<=0 || diff(Ws)<=0) + error("buttord: Wp(1) Ws); + Wp(stop) = 1-Wp(stop); # stop will be at most length 1, so no need to + Ws(stop) = 1-Ws(stop); # subtract from ones(1,length(stop)) + + ## warp the target frequencies according to the bilinear transform + Ws = (2/T)*tan(pi*Ws./T); + Wp = (2/T)*tan(pi*Wp./T); + + ## compute minimum n which satisfies all band edge conditions + ## the factor 1/length(Wp) is an artificial correction for the + ## band pass/stop case, which otherwise significantly overdesigns. + qs = log(10^(Rs/10) - 1); + qp = log(10^(Rp/10) - 1); + n = ceil(max(0.5*(qs - qp)./log(Ws./Wp))/length(Wp)); + + ## compute -3dB cutoff given Wp, Rp and n + Wc = exp(log(Wp) - qp/2/n); + + ## unwarp the returned frequency + Wc = atan(T/2*Wc)*T/pi; + + ## if high pass, reverse the sense of the test + Wc(stop) = 1-Wc(stop); + +endfunction diff --git a/octave_packages/signal-1.1.3/cceps.m b/octave_packages/signal-1.1.3/cceps.m new file mode 100644 index 0000000..5b29d2d --- /dev/null +++ b/octave_packages/signal-1.1.3/cceps.m @@ -0,0 +1,76 @@ +## Copyright (C) 1994 Dept of Probability Theory and Statistics TU Wien +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: cceps (x [, correct]) +## +## Returns the complex cepstrum of the vector x. +## If the optional argument correct has the value 1, a correction +## method is applied. The default is not to do this. + +## Author: Andreas Weingessel +## Apr 1, 1994 +## Last modifified by AW on Nov 8, 1994 + +function cep = cceps (x, c) + + if (nargin == 1) + c = 0; + elseif (nargin != 2) + print_usage; + endif + + [nr, nc] = size (x); + if (nc != 1) + if (nr == 1) + x = x'; + nr = nc; + else + error ("cceps: x must be a vector"); + endif + endif + + bad_signal_message = ["cceps: bad signal x, ", ... + "some Fourier coefficients are zero."]; + + F = fft (x); + if (min (abs (F)) == 0) + error (bad_signal_message); + endif + + # determine if correction necessary + half = fix (nr / 2); + cor = 0; + if (2 * half == nr) + cor = (c && (real (F (half + 1)) < 0)); + if (cor) + F = fft (x(1:nr-1)) + if (min (abs (F)) == 0) + error (bad_signal_message); + endif + endif + endif + + cep = fftshift (ifft (log (F))); + + # make result real + if (c) + cep = real (cep); + if (cor) + # make cepstrum of same length as input vector + cep (nr) = 0; + endif + endif + +endfunction diff --git a/octave_packages/signal-1.1.3/cheb.m b/octave_packages/signal-1.1.3/cheb.m new file mode 100644 index 0000000..69a8258 --- /dev/null +++ b/octave_packages/signal-1.1.3/cheb.m @@ -0,0 +1,51 @@ +## Copyright (C) 2002 André Carezia +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Usage: cheb (n, x) +## +## Returns the value of the nth-order Chebyshev polynomial calculated at +## the point x. The Chebyshev polynomials are defined by the equations: +## +## / cos(n acos(x), |x| <= 1 +## Tn(x) = | +## \ cosh(n acosh(x), |x| > 1 +## +## If x is a vector, the output is a vector of the same size, where each +## element is calculated as y(i) = Tn(x(i)). + +function T = cheb (n, x) + if (nargin != 2) + print_usage; + elseif !(isscalar (n) && (n == round(n)) && (n >= 0)) + error ("cheb: n has to be a positive integer"); + endif + + if (max(size(x)) == 0) + T = []; + endif + # avoid resizing latencies + T = zeros(size(x)); + ind = abs (x) <= 1; + if (max(size(ind))) + T(ind) = cos(n*acos(x(ind))); + endif + + ind = abs (x) > 1; + if (max(size(ind))) + T(ind) = cosh(n*acosh(x(ind))); + endif + + T = real(T); +endfunction diff --git a/octave_packages/signal-1.1.3/cheb1ord.m b/octave_packages/signal-1.1.3/cheb1ord.m new file mode 100644 index 0000000..1dd406d --- /dev/null +++ b/octave_packages/signal-1.1.3/cheb1ord.m @@ -0,0 +1,147 @@ +## Copyright (C) 2000 Paul Kienzle +## Copyright (C) 2000 Laurent S. Mazet +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Compute chebyshev type I filter order and cutoff for the desired response +## characteristics. Rp is the allowable decibels of ripple in the pass +## band. Rs is the minimum attenuation in the stop band. +## +## [n, Wc] = cheb1ord(Wp, Ws, Rp, Rs) +## Low pass (WpWs) filter design. Wp is the +## pass band edge and Ws is the stop band edge. Frequencies are +## normalized to [0,1], corresponding to the range [0,Fs/2]. +## +## [n, Wc] = cheb1ord([Wp1, Wp2], [Ws1, Ws2], Rp, Rs) +## Band pass (Ws1Ws) || all(Ws>Wp) || diff(Wp)<=0 || diff(Ws)<=0) + error("cheb1ord: Wp(1) +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Compute chebyshev type II filter order and cutoff for the desired response +## characteristics. Rp is the allowable decibels of ripple in the pass +## band. Rs is the minimum attenuation in the stop band. +## +## [n, Wc] = cheb2ord(Wp, Ws, Rp, Rs) +## Low pass (WpWs) filter design. Wp is the +## pass band edge and Ws is the stop band edge. Frequencies are +## normalized to [0,1], corresponding to the range [0,Fs/2]. +## +## [n, Wc] = cheb2ord([Wp1, Wp2], [Ws1, Ws2], Rp, Rs) +## Band pass (Ws1Ws) || all(Ws>Wp) || diff(Wp)<=0 || diff(Ws)<=0) + error("cheb2ord: Wp(1) +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Usage: chebwin (L, at) +## +## Returns the filter coefficients of the L-point Dolph-Chebyshev window +## with at dB of attenuation in the stop-band of the corresponding +## Fourier transform. +## +## For the definition of the Chebyshev window, see +## +## * Peter Lynch, "The Dolph-Chebyshev Window: A Simple Optimal Filter", +## Monthly Weather Review, Vol. 125, pp. 655-660, April 1997. +## (http://www.maths.tcd.ie/~plynch/Publications/Dolph.pdf) +## +## * C. Dolph, "A current distribution for broadside arrays which +## optimizes the relationship between beam width and side-lobe level", +## Proc. IEEE, 34, pp. 335-348. +## +## The window is described in frequency domain by the expression: +## +## Cheb(L-1, beta * cos(pi * k/L)) +## W(k) = ------------------------------- +## Cheb(L-1, beta) +## +## with +## +## beta = cosh(1/(L-1) * acosh(10^(at/20)) +## +## and Cheb(m,x) denoting the m-th order Chebyshev polynomial calculated +## at the point x. +## +## Note that the denominator in W(k) above is not computed, and after +## the inverse Fourier transform the window is scaled by making its +## maximum value unitary. +## +## See also: kaiser + +function w = chebwin (L, at) + + if (nargin != 2) + print_usage; + elseif !(isscalar (L) && (L == round(L)) && (L > 0)) + error ("chebwin: L has to be a positive integer"); + elseif !(isscalar (at) && (at == real (at))) + error ("chebwin: at has to be a real scalar"); + endif + + if (L == 1) + w = 1; + else + # beta calculation + gamma = 10^(-at/20); + beta = cosh(1/(L-1) * acosh(1/gamma)); + # freq. scale + k = (0:L-1); + x = beta*cos(pi*k/L); + # Chebyshev window (freq. domain) + p = cheb(L-1, x); + # inverse Fourier transform + if (rem(L,2)) + w = real(fft(p)); + M = (L+1)/2; + w = w(1:M)/w(1); + w = [w(M:-1:2) w]'; + else + # half-sample delay (even order) + p = p.*exp(j*pi/L * (0:L-1)); + w = real(fft(p)); + M = L/2+1; + w = w/w(2); + w = [w(M:-1:2) w(2:M)]'; + endif + endif + + w = w ./ max (w (:)); +endfunction diff --git a/octave_packages/signal-1.1.3/cheby1.m b/octave_packages/signal-1.1.3/cheby1.m new file mode 100644 index 0000000..6d2f6b4 --- /dev/null +++ b/octave_packages/signal-1.1.3/cheby1.m @@ -0,0 +1,131 @@ +## Copyright (C) 1999 Paul Kienzle +## Copyright (C) 2003 Doug Stewart +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Generate an Chebyshev type I filter with Rp dB of pass band ripple. +## +## [b, a] = cheby1(n, Rp, Wc) +## low pass filter with cutoff pi*Wc radians +## +## [b, a] = cheby1(n, Rp, Wc, 'high') +## high pass filter with cutoff pi*Wc radians +## +## [b, a] = cheby1(n, Rp, [Wl, Wh]) +## band pass filter with edges pi*Wl and pi*Wh radians +## +## [b, a] = cheby1(n, Rp, [Wl, Wh], 'stop') +## band reject filter with edges pi*Wl and pi*Wh radians +## +## [z, p, g] = cheby1(...) +## return filter as zero-pole-gain rather than coefficients of the +## numerator and denominator polynomials. +## +## [...] = cheby1(...,'s') +## return a Laplace space filter, W can be larger than 1. +## +## [a,b,c,d] = cheby1(...) +## return state-space matrices +## +## References: +## +## Parks & Burrus (1987). Digital Filter Design. New York: +## John Wiley & Sons, Inc. + +function [a,b,c,d] = cheby1(n, Rp, W, varargin) + + if (nargin>5 || nargin<3) || (nargout>4 || nargout<2) + print_usage; + endif + + ## interpret the input parameters + if (!(length(n)==1 && n == round(n) && n > 0)) + error ("cheby1: filter order n must be a positive integer"); + endif + + stop = 0; + digital = 1; + for i=1:length(varargin) + switch varargin{i} + case 's', digital = 0; + case 'z', digital = 1; + case { 'high', 'stop' }, stop = 1; + case { 'low', 'pass' }, stop = 0; + otherwise, error ("cheby1: expected [high|stop] or [s|z]"); + endswitch + endfor + + [r, c]=size(W); + if (!(length(W)<=2 && (r==1 || c==1))) + error ("cheby1: frequency must be given as w0 or [w0, w1]"); + elseif (!(length(W)==1 || length(W) == 2)) + error ("cheby1: only one filter band allowed"); + elseif (length(W)==2 && !(W(1) < W(2))) + error ("cheby1: first band edge must be smaller than second"); + endif + + if ( digital && !all(W >= 0 & W <= 1)) + error ("cheby1: critical frequencies must be in (0 1)"); + elseif ( !digital && !all(W >= 0 )) + error ("cheby1: critical frequencies must be in (0 inf)"); + endif + + if (Rp < 0) + error("cheby1: passband ripple must be positive decibels"); + end + + ## Prewarp to the band edges to s plane + if digital + T = 2; # sampling frequency of 2 Hz + W = 2/T*tan(pi*W/T); + endif + + ## Generate splane poles and zeros for the chebyshev type 1 filter + C = 1; # default cutoff frequency + epsilon = sqrt(10^(Rp/10) - 1); + v0 = asinh(1/epsilon)/n; + pole = exp(1i*pi*[-(n-1):2:(n-1)]/(2*n)); + pole = -sinh(v0)*real(pole) + 1i*cosh(v0)*imag(pole); + zero = []; + + ## compensate for amplitude at s=0 + gain = prod(-pole); + ## if n is even, the ripple starts low, but if n is odd the ripple + ## starts high. We must adjust the s=0 amplitude to compensate. + if (rem(n,2)==0) + gain = gain/10^(Rp/20); + endif + + ## splane frequency transform + [zero, pole, gain] = sftrans(zero, pole, gain, W, stop); + + ## Use bilinear transform to convert poles to the z plane + if digital + [zero, pole, gain] = bilinear(zero, pole, gain, T); + endif + + ## convert to the correct output form + if nargout==2, + a = real(gain*poly(zero)); + b = real(poly(pole)); + elseif nargout==3, + a = zero; + b = pole; + c = gain; + else + ## output ss results + [a, b, c, d] = zp2ss (zero, pole, gain); + endif + +endfunction diff --git a/octave_packages/signal-1.1.3/cheby2.m b/octave_packages/signal-1.1.3/cheby2.m new file mode 100644 index 0000000..4d1a96e --- /dev/null +++ b/octave_packages/signal-1.1.3/cheby2.m @@ -0,0 +1,140 @@ +## Copyright (C) 1999 Paul Kienzle +## Copyright (C) 2003 Doug Stewart +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Generate an Chebyshev type II filter with Rs dB of stop band attenuation. +## +## [b, a] = cheby2(n, Rs, Wc) +## low pass filter with cutoff pi*Wc radians +## +## [b, a] = cheby2(n, Rs, Wc, 'high') +## high pass filter with cutoff pi*Wc radians +## +## [b, a] = cheby2(n, Rs, [Wl, Wh]) +## band pass filter with edges pi*Wl and pi*Wh radians +## +## [b, a] = cheby2(n, Rs, [Wl, Wh], 'stop') +## band reject filter with edges pi*Wl and pi*Wh radians +## +## [z, p, g] = cheby2(...) +## return filter as zero-pole-gain rather than coefficients of the +## numerator and denominator polynomials. +## +## [...] = cheby2(...,'s') +## return a Laplace space filter, W can be larger than 1. +## +## [a,b,c,d] = cheby2(...) +## return state-space matrices +## +## References: +## +## Parks & Burrus (1987). Digital Filter Design. New York: +## John Wiley & Sons, Inc. + +function [a,b,c,d] = cheby2(n, Rs, W, varargin) + + if (nargin>5 || nargin<3) || (nargout>4 || nargout<2) + print_usage; + end + + ## interpret the input parameters + if (!(length(n)==1 && n == round(n) && n > 0)) + error ("cheby2: filter order n must be a positive integer"); + end + + + stop = 0; + digital = 1; + for i=1:length(varargin) + switch varargin{i} + case 's', digital = 0; + case 'z', digital = 1; + case { 'high', 'stop' }, stop = 1; + case { 'low', 'pass' }, stop = 0; + otherwise, error ("cheby2: expected [high|stop] or [s|z]"); + endswitch + endfor + + [r, c]=size(W); + if (!(length(W)<=2 && (r==1 || c==1))) + error ("cheby2: frequency must be given as w0 or [w0, w1]"); + elseif (!(length(W)==1 || length(W) == 2)) + error ("cheby2: only one filter band allowed"); + elseif (length(W)==2 && !(W(1) < W(2))) + error ("cheby2: first band edge must be smaller than second"); + endif + + if ( digital && !all(W >= 0 & W <= 1)) + error ("cheby2: critical frequencies must be in (0 1)"); + elseif ( !digital && !all(W >= 0 )) + error ("cheby2: critical frequencies must be in (0 inf)"); + endif + + if (Rs < 0) + error("cheby2: stopband attenuation must be positive decibels"); + end + + ## Prewarp to the band edges to s plane + if digital + T = 2; # sampling frequency of 2 Hz + W = 2/T*tan(pi*W/T); + endif + + ## Generate splane poles and zeros for the chebyshev type 2 filter + ## From: Stearns, SD; David, RA; (1988). Signal Processing Algorithms. + ## New Jersey: Prentice-Hall. + C = 1; # default cutoff frequency + lambda = 10^(Rs/20); + phi = log(lambda + sqrt(lambda^2-1))/n; + theta = pi*([1:n]-0.5)/n; + alpha = -sinh(phi)*sin(theta); + beta = cosh(phi)*cos(theta); + if (rem(n,2)) + ## drop theta==pi/2 since it results in a zero at infinity + zero = 1i*C./cos(theta([1:(n-1)/2, (n+3)/2:n])); + else + zero = 1i*C./cos(theta); + endif + pole = C./(alpha.^2+beta.^2).*(alpha-1i*beta); + + ## Compensate for amplitude at s=0 + ## Because of the vagaries of floating point computations, the + ## prod(pole)/prod(zero) sometimes comes out as negative and + ## with a small imaginary component even though analytically + ## the gain will always be positive, hence the abs(real(...)) + gain = abs(real(prod(pole)/prod(zero))); + + ## splane frequency transform + [zero, pole, gain] = sftrans(zero, pole, gain, W, stop); + + ## Use bilinear transform to convert poles to the z plane + if digital + [zero, pole, gain] = bilinear(zero, pole, gain, T); + endif + + ## convert to the correct output form + if nargout==2, + a = real(gain*poly(zero)); + b = real(poly(pole)); + elseif nargout==3, + a = zero; + b = pole; + c = gain; + else + ## output ss results + [a, b, c, d] = zp2ss (zero, pole, gain); + endif + +endfunction diff --git a/octave_packages/signal-1.1.3/chirp.m b/octave_packages/signal-1.1.3/chirp.m new file mode 100644 index 0000000..ef43255 --- /dev/null +++ b/octave_packages/signal-1.1.3/chirp.m @@ -0,0 +1,94 @@ +## Copyright (C) 1999-2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: y = chirp(t [, f0 [, t1 [, f1 [, form [, phase]]]]]) +## +## Evaluate a chirp signal at time t. A chirp signal is a frequency +## swept cosine wave. +## +## t: vector of times to evaluate the chirp signal +## f0: frequency at time t=0 [ 0 Hz ] +## t1: time t1 [ 1 sec ] +## f1: frequency at time t=t1 [ 100 Hz ] +## form: shape of frequency sweep +## 'linear' f(t) = (f1-f0)*(t/t1) + f0 +## 'quadratic' f(t) = (f1-f0)*(t/t1)^2 + f0 +## 'logarithmic' f(t) = (f1-f0)^(t/t1) + f0 +## phase: phase shift at t=0 +## +## Example +## specgram(chirp([0:0.001:5])); # linear, 0-100Hz in 1 sec +## specgram(chirp([-2:0.001:15], 400, 10, 100, 'quadratic')); +## soundsc(chirp([0:1/8000:5], 200, 2, 500, "logarithmic"),8000); +## +## If you want a different sweep shape f(t), use the following: +## y = cos(2*pi*integral(f(t)) + 2*pi*f0*t + phase); + +function y = chirp(t, f0, t1, f1, form, phase) + + if nargin < 1 || nargin > 6 + print_usage; + endif + if nargin < 2, f0 = []; endif + if nargin < 3, t1 = []; endif + if nargin < 4, f1 = []; endif + if nargin < 5, form = []; endif + if nargin < 6, phase = []; endif + + if isempty(f0), f0 = 0; endif + if isempty(t1), t1 = 1; endif + if isempty(f1), f1 = 100; endif + if isempty(form), form = "linear"; endif + if isempty(phase), phase = 0; endif + + phase = 2*pi*phase/360; + + if strcmp(form, "linear") + a = pi*(f1 - f0)/t1; + b = 2*pi*f0; + y = cos(a*t.^2 + b*t + phase); + elseif strcmp(form, "quadratic") + a = (2/3*pi*(f1-f0)/t1/t1); + b = 2*pi*f0; + y = cos(a*t.^3 + b*t + phase); + elseif strcmp(form, "logarithmic") + a = 2*pi*t1/log(f1-f0); + b = 2*pi*f0; + x = (f1-f0)^(1/t1); + y = cos(a*x.^t + b*t + phase); + else + error("chirp doesn't understand '%s'",form); + endif + +endfunction + +%!demo +%! specgram(chirp([0:0.001:5]),[],1000); # linear, 0-100Hz in 1 sec +%! %------------------------------------------------------------ +%! % Shows linear sweep of 100 Hz/sec starting at zero for 5 sec +%! % since the sample rate is 1000 Hz, this should be a diagonal +%! % from bottom left to top right. + +%!demo +%! specgram(chirp([-2:0.001:15], 400, 10, 100, 'quadratic')); +%! %------------------------------------------------------------ +%! % Shows a quadratic chirp of 400 Hz at t=0 and 100 Hz at t=10 +%! % Time goes from -2 to 15 seconds. + +%!demo +%! specgram(chirp([0:1/8000:5], 200, 2, 500, "logarithmic"),[],8000); +%! %------------------------------------------------------------ +%! % Shows a logarithmic chirp of 200 Hz at t=0 and 500 Hz at t=2 +%! % Time goes from 0 to 5 seconds at 8000 Hz. diff --git a/octave_packages/signal-1.1.3/cmorwavf.m b/octave_packages/signal-1.1.3/cmorwavf.m new file mode 100644 index 0000000..9c089fa --- /dev/null +++ b/octave_packages/signal-1.1.3/cmorwavf.m @@ -0,0 +1,29 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{psi,x}] =} cmorwavf (@var{lb,ub,n,fb,fc}) +## Compute the Complex Morlet wavelet. +## @end deftypefn + +function [psi,x] = cmorwavf (lb,ub,n,fb,fc) + if (nargin ~= 5) + print_usage; + elseif (n <= 0 || floor(n) ~= n) + error("n must be an integer strictly positive"); + endif + x = linspace(lb,ub,n); + psi =((pi*fb)^(-0.5))*exp(2*i*pi*fc.*x).*exp(-x.^2/fb); +endfunction diff --git a/octave_packages/signal-1.1.3/cohere.m b/octave_packages/signal-1.1.3/cohere.m new file mode 100644 index 0000000..8f9c37c --- /dev/null +++ b/octave_packages/signal-1.1.3/cohere.m @@ -0,0 +1,56 @@ +%% Copyright (C) 2006 Peter V. Lanspeary +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% Usage: +%% [Pxx,freq] = cohere(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) +%% +%% Estimate (mean square) coherence of signals "x" and "y". +%% Use the Welch (1967) periodogram/FFT method. +%% Compatible with Matlab R11 cohere and earlier. +%% See "help pwelch" for description of arguments, hints and references +%% --- especially hint (7) for Matlab R11 defaults. +%% + +function [varargout] = cohere(varargin) +%% + if ( nargin<2 ) + error( 'cohere: Need at least 2 args. Use help cohere.' ); + end + nvarargin = length(varargin); + %% remove any pwelch RESULT args and add 'trans' + for iarg=1:nvarargin + arg = varargin{iarg}; + if ( ~isempty(arg) && ischar(arg) && ( strcmp(arg,'power') || ... + strcmp(arg,'cross') || strcmp(arg,'trans') || ... + strcmp(arg,'coher') || strcmp(arg,'ypower') )) + varargin{iarg} = []; + end + end + varargin{nvarargin+1} = 'coher'; + %% + saved_compatib = pwelch('R11-'); + if ( nargout==0 ) + pwelch(varargin{:}); + elseif ( nargout==1 ) + Pxx = pwelch(varargin{:}); + varargout{1} = Pxx; + elseif ( nargout>=2 ) + [Pxx,f] = pwelch(varargin{:}); + varargout{1} = Pxx; + varargout{2} = f; + end + pwelch(saved_compatib); + saved_compatib = 0; +end diff --git a/octave_packages/signal-1.1.3/convmtx.m b/octave_packages/signal-1.1.3/convmtx.m new file mode 100644 index 0000000..39b1445 --- /dev/null +++ b/octave_packages/signal-1.1.3/convmtx.m @@ -0,0 +1,57 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} convmtx (@var{a}, @var{n}) +## If @var{a} is a column vector and @var{x} is a column vector +## of length @var{n}, then +## +## @code{convmtx(@var{a}, @var{n}) * @var{x}} +## +## gives the convolution of of @var{a} and @var{x} and is the +## same as @code{conv(@var{a}, @var{x})}. The difference is if +## many vectors are to be convolved with the same vector, then +## this technique is possibly faster. +## +## Similarly, if @var{a} is a row vector and @var{x} is a row +## vector of length @var{n}, then +## +## @code{@var{x} * convmtx(@var{a}, @var{n})} +## +## is the same as @code{conv(@var{x}, @var{a})}. +## @end deftypefn +## @seealso{conv} + +function b = convmtx (a, n) + + if (nargin != 2) + print_usage; + endif + + [r, c] = size(a); + + if ((r != 1) && (c != 1)) || (r*c == 0) + error("convmtx: expecting vector argument"); + endif + + b = toeplitz([a(:); zeros(n-1,1)],[a(1); zeros(n-1,1)]); + if (c > r) + b = b.'; + endif + +endfunction + +%!assert(convmtx([3,4,5],3),[3,4,5,0,0;0,3,4,5,0;0,0,3,4,5]) +%!assert(convmtx([3;4;5],3),[3,0,0;4,3,0;5,4,3;0,5,4;0,0,5]) diff --git a/octave_packages/signal-1.1.3/cplxreal.m b/octave_packages/signal-1.1.3/cplxreal.m new file mode 100644 index 0000000..54ff7ad --- /dev/null +++ b/octave_packages/signal-1.1.3/cplxreal.m @@ -0,0 +1,73 @@ +%% Copyright (C) 2005 Julius O. Smith III +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% -*- texinfo -*- +%% @deftypefn {Function File} {[@var{zc}, @var{zr}] =} cplxreal (@var{z}, @var{thresh}) +%% Split the vector z into its complex (@var{zc}) and real (@var{zr}) elements, +%% eliminating one of each complex-conjugate pair. +%% +%% INPUTS:@* +%% @itemize +%% @item +%% @var{z} = row- or column-vector of complex numbers@* +%% @item +%% @var{thresh} = tolerance threshold for numerical comparisons (default = 100*eps) +%% @end itemize +%% +%% RETURNED:@* +%% @itemize +%% @item +%% @var{zc} = elements of @var{z} having positive imaginary parts@* +%% @item +%% @var{zr} = elements of @var{z} having zero imaginary part@* +%% @end itemize +%% +%% Each complex element of @var{z} is assumed to have a complex-conjugate +%% counterpart elsewhere in @var{z} as well. Elements are declared real +%% if their imaginary parts have magnitude less than @var{thresh}. +%% +%% @seealso{cplxpair} +%% @end deftypefn + +function [zc,zr] = cplxreal (z, thresh = 100*eps) + + % interesting for testing: if nargin<2, thresh=1E-3; end + + if isempty(z) + zc=[]; + zr=[]; + else + zcp = cplxpair(z); % sort complex pairs, real roots at end + nz = length(z); + nzrsec = 0; + i=nz; + while i && abs(imag(zcp(i))) +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% Usage: +%% [Pxx,freq] = cpsd(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) +%% +%% Estimate cross power spectrum of data "x" and "y" by the Welch (1967) +%% periodogram/FFT method. +%% See "help pwelch" for description of arguments, hints and references + +function [varargout] = cpsd(varargin) + + %% Check fixed argument + if ( nargin<2 ) + error( 'cpsd: Need at least 2 args. Use help cpsd.' ); + end + nvarargin = length(varargin); + %% remove any pwelch RESULT args and add 'cross' + for iarg=1:nvarargin + arg = varargin{iarg}; + if ( ~isempty(arg) && ischar(arg) && ( strcmp(arg,'power') || ... + strcmp(arg,'cross') || strcmp(arg,'trans') || ... + strcmp(arg,'coher') || strcmp(arg,'ypower') )) + varargin{iarg} = []; + end + end + varargin{nvarargin+1} = 'cross'; + %% + if ( nargout==0 ) + pwelch(varargin{:}); + elseif ( nargout==1 ) + Pxx = pwelch(varargin{:}); + varargout{1} = Pxx; + elseif ( nargout>=2 ) + [Pxx,f] = pwelch(varargin{:}); + varargout{1} = Pxx; + varargout{2} = f; + end +end diff --git a/octave_packages/signal-1.1.3/csd.m b/octave_packages/signal-1.1.3/csd.m new file mode 100644 index 0000000..3ebad04 --- /dev/null +++ b/octave_packages/signal-1.1.3/csd.m @@ -0,0 +1,54 @@ +%% Copyright (C) 2006 Peter V. Lanspeary +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% Usage: +%% [Pxx,freq] = csd(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) +%% +%% Estimate cross power spectrum of data "x" and "y" by the Welch (1967) +%% periodogram/FFT method. Compatible with Matlab R11 csd and earlier. +%% See "help pwelch" for description of arguments, hints and references +%% --- especially hint (7) for Matlab R11 defaults. + +function [varargout] = csd(varargin) + + %% Check fixed argument + if ( nargin<2 ) + error( 'csd: Need at least 2 args. Use help csd.' ); + end + nvarargin = length(varargin); + %% remove any pwelch RESULT args and add 'cross' + for iarg=1:nvarargin + arg = varargin{iarg}; + if ( ~isempty(arg) && ischar(arg) && ( strcmp(arg,'power') || ... + strcmp(arg,'cross') || strcmp(arg,'trans') || ... + strcmp(arg,'coher') || strcmp(arg,'ypower') )) + varargin{iarg} = []; + end + end + varargin{nvarargin+1} = 'cross'; + %% + saved_compatib = pwelch('R11-'); + if ( nargout==0 ) + pwelch(varargin{:}); + elseif ( nargout==1 ) + Pxx = pwelch(varargin{:}); + varargout{1} = Pxx; + elseif ( nargout>=2 ) + [Pxx,f] = pwelch(varargin{:}); + varargout{1} = Pxx; + varargout{2} = f; + end + pwelch(saved_compatib); +end diff --git a/octave_packages/signal-1.1.3/czt.m b/octave_packages/signal-1.1.3/czt.m new file mode 100644 index 0000000..5513548 --- /dev/null +++ b/octave_packages/signal-1.1.3/czt.m @@ -0,0 +1,83 @@ +## Copyright (C) 2004 Daniel Gunyan +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage y=czt(x, m, w, a) +## +## Chirp z-transform. Compute the frequency response starting at a and +## stepping by w for m steps. a is a point in the complex plane, and +## w is the ratio between points in each step (i.e., radius increases +## exponentially, and angle increases linearly). +## +## To evaluate the frequency response for the range f1 to f2 in a signal +## with sampling frequency Fs, use the following: +## m = 32; ## number of points desired +## w = exp(-j*2*pi*(f2-f1)/((m-1)*Fs)); ## freq. step of f2-f1/m +## a = exp(j*2*pi*f1/Fs); ## starting at frequency f1 +## y = czt(x, m, w, a); +## +## If you don't specify them, then the parameters default to a fourier +## transform: +## m=length(x), w=exp(-j*2*pi/m), a=1 +## +## If x is a matrix, the transform will be performed column-by-column. + +## Algorithm (based on Oppenheim and Schafer, "Discrete-Time Signal +## Processing", pp. 623-628): +## make chirp of length -N+1 to max(N-1,M-1) +## chirp => w^([-N+1:max(N-1,M-1)]^2/2) +## multiply x by chirped a and by N-elements of chirp, and call it g +## convolve g with inverse chirp, and call it gg +## pad ffts so that multiplication works +## ifft(fft(g)*fft(1/chirp)) +## multiply gg by M-elements of chirp and call it done + +function y = czt(x, m, w, a) + if nargin < 1 || nargin > 4, print_usage; endif + + [row, col] = size(x); + if row == 1, x = x(:); col = 1; endif + + if nargin < 2 || isempty(m), m = length(x(:,1)); endif + if length(m) > 1, error("czt: m must be a single element\n"); endif + if nargin < 3 || isempty(w), w = exp(-2*j*pi/m); endif + if nargin < 4 || isempty(a), a = 1; endif + if length(w) > 1, error("czt: w must be a single element\n"); endif + if length(a) > 1, error("czt: a must be a single element\n"); endif + + ## indexing to make the statements a little more compact + n = length(x(:,1)); + N = [0:n-1]'+n; + NM = [-(n-1):(m-1)]'+n; + M = [0:m-1]'+n; + + nfft = 2^nextpow2(n+m-1); # fft pad + W2 = w.^(([-(n-1):max(m-1,n-1)]'.^2)/2); # chirp + + for idx = 1:col + fg = fft(x(:,idx).*(a.^-(N-n)).*W2(N), nfft); + fw = fft(1./W2(NM), nfft); + gg = ifft(fg.*fw, nfft); + + y(:,idx) = gg(M).*W2(M); + endfor + + if row == 1, y = y.'; endif +endfunction + +%!shared x +%! x = [1,2,4,1,2,3,5,2,3,5,6,7,8,4,3,6,3,2,5,1]; +%!assert(fft(x),czt(x),10000*eps); +%!assert(fft(x'),czt(x'),10000*eps); +%!assert(fft([x',x']),czt([x',x']),10000*eps); diff --git a/octave_packages/signal-1.1.3/data2fun.m b/octave_packages/signal-1.1.3/data2fun.m new file mode 100644 index 0000000..0a0f054 --- /dev/null +++ b/octave_packages/signal-1.1.3/data2fun.m @@ -0,0 +1,167 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR 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{fhandle}, @var{fullname}] = } data2fun (@var{ti}, @var{yi}) +%% @deftypefnx {Function File} {[ @dots{} ] = } data2fun (@var{ti}, @var{yi},@var{property},@var{value}) +%% Creates a vectorized function based on data samples using interpolation. +%% +%% The values given in @var{yi} (N-by-k matrix) correspond to evaluations of the +%% function y(t) at the points @var{ti} (N-by-1 matrix). +%% The data is interpolated and the function handle to the generated interpolant +%% is returned. +%% +%% The function accepts property-value pairs described below. +%% +%% @table @samp +%% @item file +%% Code is generated and .m file is created. The @var{value} contains the name +%% of the function. The returned function handle is a handle to that file. If +%% @var{value} is empty, then a name is automatically generated using +%% @code{tmpnam} and the file is created in the current directory. @var{value} +%% must not have an extension, since .m will be appended. +%% Numerical value used in the function are stored in a .mat file with the same +%% name as the function. +%% +%% @item interp +%% Type of interpolation. See @code{interp1}. +%% +%% @end table +%% +%% @seealso{interp1} +%% @end deftypefn + +function [fhandle fullfname] = data2fun( t, y, varargin) + + %% Check input arguments + interp_args = {"spline"}; + given = struct("file",false); + if ~isempty(varargin) + % Arguments + interp_args = varargin; + + opt_args = fieldnames (given); + [tf idx] = ismember( opt_args, varargin); + for i=1:numel(opt_args) + given.(opt_args{i}) = tf(i); + end + + if given.file + %% TODO: check that file will be in the path. Otherwise fhabdle(0) fails. + + if !isempty(varargin{idx(1)+1}) + + [DIR fname] = fileparts(varargin{idx(1)+1}); + + else + + [DIR fname] = fileparts (tmpnam (pwd (),"agen_")); + + end + + interp_args(idx(1)+[0 1]) = []; + end + + if isempty(interp_args) + + interp_args = {"spline"}; + + end + end + + pp = interp1 (t, y, interp_args{end}, 'pp'); + + if given.file + fullfname = fullfile (DIR,[fname ".m"]); + save("-binary",[fullfname(1:end-2) ".mat"],"pp"); + + bodystr = [" persistent pp\n" ... + " if isempty(pp)\n" ... + " pp = load([mfilename()" ' ".mat"' "]).pp;\n"... + " end\n\n" ... + " z = ppval(pp, x);"]; + + strfunc = generate_function_str(fname, {"z"}, {"x"}, bodystr); + + fid = fopen ( fullfile (DIR,[fname ".m"]), "w"); + fprintf (fid, "%s", strfunc); + fclose (fid); + + disp(["Function generated: " fullfname ]); + fhandle = eval(["@" fname]); + + else + fullfname = ""; + fhandle = @(t_) ppval (pp, t_); + + end + +endfunction + +function str = generate_function_str(name, oargs, iargs, bodystr) + + striargs = cell2mat ( cellfun (@(x) [x ", "], iargs, "UniformOutput", false)); + striargs = striargs(1:end-2); + + stroargs = cell2mat ( cellfun (@(x) [x ", "], oargs, "UniformOutput", false)); + stroargs = stroargs(1:end-2); + + if !isempty (stroargs) + str = ["function [" stroargs "] = " name "(" striargs ")\n\n" bodystr ... + "\n\nendfunction"]; + else + str = ["function " name "(" striargs ")\n\n" bodystr ... + "\n\nendfunction"]; + end + +endfunction + +%!shared t, y +%! t = linspace(0,1,10); +%! y = t.^2 - 2*t + 1; + +%!test +%! fhandle = data2fun(t,y); +%! assert(y,fhandle(t)); + +%!test +%! [fhandle fname] = data2fun(t,y,"file","testdata2fun"); +%! yt = testdata2fun(t); +%! +%! assert(y,yt); +%! assert(y,fhandle(t)); +%! +%! delete(fname); +%! delete([fname(1:end-2) ".mat"]); + +%!test +%! [fhandle fname] = data2fun(t,y,"file",""); +%! yt = testdata2fun(t); +%! +%! assert(y,yt); +%! assert(y,fhandle(t)); +%! +%! delete(fname); +%! delete([fname(1:end-2) ".mat"]); + +%!test +%! [fhandle fname] = data2fun(t,y,"file","testdata2fun","interp","linear"); +%! yt = testdata2fun(t); +%! +%! assert(y,yt); +%! assert(y,fhandle(t)); +%! +%! delete(fname); +%! delete([fname(1:end-2) ".mat"]); diff --git a/octave_packages/signal-1.1.3/dct.m b/octave_packages/signal-1.1.3/dct.m new file mode 100644 index 0000000..6c52851 --- /dev/null +++ b/octave_packages/signal-1.1.3/dct.m @@ -0,0 +1,91 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## y = dct (x, n) +## Computes the discrete cosine transform of x. If n is given, then +## x is padded or trimmed to length n before computing the transform. +## If x is a matrix, compute the transform along the columns of the +## the matrix. The transform is faster if x is real-valued and even +## length. +## +## The discrete cosine transform X of x can be defined as follows: +## +## N-1 +## X[k] = w(k) sum x[n] cos (pi (2n+1) k / 2N ), k = 0, ..., N-1 +## n=0 +## +## with w(0) = sqrt(1/N) and w(k) = sqrt(2/N), k = 1, ..., N-1. There +## are other definitions with different scaling of X[k], but this form +## is common in image processing. +## +## See also: idct, dct2, idct2, dctmtx + +## From Discrete Cosine Transform notes by Brian Evans at UT Austin, +## http://www.ece.utexas.edu/~bevans/courses/ee381k/lectures/09_DCT/lecture9/ +## the discrete cosine transform of x at k is as follows: +## +## N-1 +## X[k] = sum 2 x[n] cos (pi (2n+1) k / 2N ) +## n=0 +## +## which can be computed using: +## +## y = [ x ; flipud (x) ] +## Y = fft(y) +## X = exp( -j pi [0:N-1] / 2N ) .* Y +## +## or for real, even length x +## +## y = [ even(x) ; flipud(odd(x)) ] +## Y = fft(y) +## X = 2 real { exp( -j pi [0:N-1] / 2N ) .* Y } +## +## Scaling the result by w(k)/2 will give us the desired output. + +function y = dct (x, n) + + if (nargin < 1 || nargin > 2) + print_usage; + endif + + realx = isreal(x); + transpose = (rows (x) == 1); + + if transpose, x = x (:); endif + [nr, nc] = size (x); + if nargin == 1 + n = nr; + elseif n > nr + x = [ x ; zeros(n-nr,nc) ]; + elseif n < nr + x (nr-n+1 : n, :) = []; + endif + + if n == 1 + w = 1/2; + else + w = [ sqrt(1/4/n); sqrt(1/2/n)*exp((-1i*pi/2/n)*[1:n-1]') ] * ones (1, nc); + endif + if ( realx && rem (n, 2) == 0 ) + y = fft ([ x(1:2:n,:) ; x(n:-2:1,:) ]); + y = 2 * real( w .* y ); + else + y = fft ([ x ; flipud(x) ]); + y = w .* y (1:n, :); + if (realx) y = real (y); endif + endif + if transpose, y = y.'; endif + +endfunction diff --git a/octave_packages/signal-1.1.3/dct2.m b/octave_packages/signal-1.1.3/dct2.m new file mode 100644 index 0000000..b5e9f70 --- /dev/null +++ b/octave_packages/signal-1.1.3/dct2.m @@ -0,0 +1,44 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## y = dct2 (x) +## Computes the 2-D discrete cosine transform of matrix x +## +## y = dct2 (x, m, n) or y = dct2 (x, [m n]) +## Computes the 2-D DCT of x after padding or trimming rows to m and +## columns to n. + +function y = dct2 (x, m, n) + + if (nargin < 1 || nargin > 3) + print_usage; + endif + + if nargin == 1 + [m, n] = size(x); + elseif (nargin == 2) + n = m(2); + m = m(1); + endif + + if m == 1 + y = dct (x.', n).'; + elseif n == 1 + y = dct (x, m); + else + y = dct (dct (x, m).', n).'; + endif + +endfunction diff --git a/octave_packages/signal-1.1.3/dctmtx.m b/octave_packages/signal-1.1.3/dctmtx.m new file mode 100644 index 0000000..b47564b --- /dev/null +++ b/octave_packages/signal-1.1.3/dctmtx.m @@ -0,0 +1,46 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## T = dctmtx (n) +## Return the DCT transformation matrix of size n x n. +## +## If A is an n x n matrix, then the following are true: +## T*A == dct(A), T'*A == idct(A) +## T*A*T' == dct2(A), T'*A*T == idct2(A) +## +## A dct transformation matrix is useful for doing things like jpeg +## image compression, in which an 8x8 dct matrix is applied to +## non-overlapping blocks throughout an image and only a subblock on the +## top left of each block is kept. During restoration, the remainder of +## the block is filled with zeros and the inverse transform is applied +## to the block. +## +## See also: dct, idct, dct2, idct2 + +function T = dctmtx(n) + if nargin != 1 + print_usage; + endif + + if n > 1 + T = [ sqrt(1/n)*ones(1,n) ; \ + sqrt(2/n)*cos((pi/2/n)*([1:n-1]'*[1:2:2*n])) ]; + elseif n == 1 + T = 1; + else + error ("dctmtx: n must be at least 1"); + endif + +endfunction diff --git a/octave_packages/signal-1.1.3/decimate.m b/octave_packages/signal-1.1.3/decimate.m new file mode 100644 index 0000000..b023635 --- /dev/null +++ b/octave_packages/signal-1.1.3/decimate.m @@ -0,0 +1,83 @@ +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: y = decimate(x, q [, n] [, ftype]) +## +## Downsample the signal x by a factor of q, using an order n filter +## of ftype 'fir' or 'iir'. By default, an order 8 Chebyshev type I +## filter is used or a 30 point FIR filter if ftype is 'fir'. Note +## that q must be an integer for this rate change method. +## +## Example +## ## Generate a signal that starts away from zero, is slowly varying +## ## at the start and quickly varying at the end, decimate and plot. +## ## Since it starts away from zero, you will see the boundary +## ## effects of the antialiasing filter clearly. Next you will see +## ## how it follows the curve nicely in the slowly varying early +## ## part of the signal, but averages the curve in the quickly +## ## varying late part of the signal. +## t=0:0.01:2; x=chirp(t,2,.5,10,'quadratic')+sin(2*pi*t*0.4); +## y = decimate(x,4); # factor of 4 decimation +## stem(t(1:121)*1000,x(1:121),"-g;Original;"); hold on; # plot original +## stem(t(1:4:121)*1000,y(1:31),"-r;Decimated;"); hold off; # decimated + +function y = decimate(x, q, n, ftype) + + if nargin < 1 || nargin > 4 + print_usage; + elseif q != fix(q) + error("decimate only works with integer q."); + endif + + if nargin<3 + ftype='iir'; + n=[]; + elseif nargin==3 + if ischar(n) + ftype=n; + n=[]; + else + ftype='iir'; + endif + endif + + fir = strcmp(ftype, 'fir'); + if isempty(n) + if fir, n=30; else n=8; endif + endif + + if fir + b = fir1(n, 1/q); + y=fftfilt(b, x); + else + [b, a] = cheby1(n, 0.05, 0.8/q); + y=filtfilt(b,a,x); + endif + y = y(1:q:length(x)); +endfunction + +%!demo +%! t=0:0.01:2; x=chirp(t,2,.5,10,'quadratic')+sin(2*pi*t*0.4); +%! y = decimate(x,4); # factor of 4 decimation +%! stem(t(1:121)*1000,x(1:121),"-g;Original;"); hold on; # plot original +%! stem(t(1:4:121)*1000,y(1:31),"-r;Decimated;"); hold off; # decimated +%! %------------------------------------------------------------------ +%! % The signal to decimate starts away from zero, is slowly varying +%! % at the start and quickly varying at the end, decimate and plot. +%! % Since it starts away from zero, you will see the boundary +%! % effects of the antialiasing filter clearly. You will also see +%! % how it follows the curve nicely in the slowly varying early +%! % part of the signal, but averages the curve in the quickly +%! % varying late part of the signal. diff --git a/octave_packages/signal-1.1.3/dftmtx.m b/octave_packages/signal-1.1.3/dftmtx.m new file mode 100644 index 0000000..36253de --- /dev/null +++ b/octave_packages/signal-1.1.3/dftmtx.m @@ -0,0 +1,36 @@ +## Copyright (C) 2003 David Bateman +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{d} = } dftmtx (@var{n}) +## +## If @var{n} is a scalar, produces a @var{n}-by-@var{n} matrix @var{d} +## such that the Fourier transform of a column vector of length @var{n} +## is given by @code{dftmtx(@var{n}) * x} and the inverse Fourier transform +## is given by @code{inv(dftmtx(@var{n})) * x}. In general this is less +## efficient than calling the @dfn{fft} and @dfn{ifft} directly. +## @end deftypefn + +function d = dftmtx(n) + + if (nargin != 1) + print_usage; + elseif (!isscalar(n)) + error ("dftmtx: argument must be scalar"); + endif + + d = fft(eye(n)); + +endfunction diff --git a/octave_packages/signal-1.1.3/diric.m b/octave_packages/signal-1.1.3/diric.m new file mode 100644 index 0000000..ca50cfb --- /dev/null +++ b/octave_packages/signal-1.1.3/diric.m @@ -0,0 +1,32 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y}] =} diric(@var{x},@var{n}) +## Compute the dirichlet function. +## @seealso{sinc, gauspuls, sawtooth} +## @end deftypefn + +function [y] = diric(x,n) + if (nargin < 2) + print_usage; + elseif (n <= 0 || floor(n) ~= n) + error("n must be an integer strictly positive"); + endif + + y = sin(n.*x./2)./(n.*sin(x./2)); + y(mod(x,2*pi)==0) = (-1).^((n-1).*x(mod(x,2*pi)==0)./(2.*pi)); + +endfunction diff --git a/octave_packages/signal-1.1.3/doc-cache b/octave_packages/signal-1.1.3/doc-cache new file mode 100644 index 0000000..9f8eb9c --- /dev/null +++ b/octave_packages/signal-1.1.3/doc-cache @@ -0,0 +1,5602 @@ +# Created by Octave 3.6.1, Thu May 17 20:38:50 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 130 +# name: +# type: sq_string +# elements: 1 +# length: 6 +ar_psd + + +# name: +# type: sq_string +# elements: 1 +# length: 4320 + Usage: + [psd,f_out] = ar_psd(a,v,freq,Fs,range,method,plot_type) + + Calculate the power spectrum of the autoregressive model + + M + x(n) = sqrt(v).e(n) + SUM a(k).x(n-k) + k=1 + where x(n) is the output of the model and e(n) is white noise. + This function is intended for use with + [a,v,k] = arburg(x,poles,criterion) + which use the Burg (1968) method to calculate a "maximum entropy" + autoregressive model of "x". This function runs on octave and matlab. + + If the "freq" argument is a vector (of frequencies) the spectrum is + calculated using the polynomial method and the "method" argument is + ignored. For scalar "freq", an integer power of 2, or "method='FFT'", + causes the spectrum to be calculated by FFT. Otherwise, the spectrum + is calculated as a polynomial. It may be computationally more + efficient to use the FFT method if length of the model is not much + smaller than the number of frequency values. The spectrum is scaled so + that spectral energy (area under spectrum) is the same as the + time-domain energy (mean square of the signal). + + ARGUMENTS: + All but the first two arguments are optional and may be empty. + + a %% [vector] list of M=(order+1) autoregressive model + %% coefficients. The first element of "ar_coeffs" is the + %% zero-lag coefficient, which always has a value of 1. + + v %% [real scalar] square of the moving-average coefficient of + %% the AR model. + + freq %% [real vector] frequencies at which power spectral density + %% is calculated + %% [integer scalar] number of uniformly distributed frequency + %% values at which spectral density is calculated. + %% [default=256] + + Fs %% [real scalar] sampling frequency (Hertz) [default=1] + + CONTROL-STRING ARGUMENTS -- each of these arguments is a character string. + Control-string arguments can be in any order after the other arguments. + + range %% 'half', 'onesided' : frequency range of the spectrum is + %% from zero up to but not including sample_f/2. Power + %% from negative frequencies is added to the positive + %% side of the spectrum. + %% 'whole', 'twosided' : frequency range of the spectrum is + %% -sample_f/2 to sample_f/2, with negative frequencies + %% stored in "wrap around" order after the positive + %% frequencies; e.g. frequencies for a 10-point 'twosided' + %% spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 + %% 'shift', 'centerdc' : same as 'whole' but with the first half + %% of the spectrum swapped with second half to put the + %% zero-frequency value in the middle. (See "help + %% fftshift". If "freq" is vector, 'shift' is ignored. + %% If model coefficients "ar_coeffs" are real, the default + %% range is 'half', otherwise default range is 'whole'. + + method %% 'fft': use FFT to calculate power spectrum. + %% 'poly': calculate power spectrum as a polynomial of 1/z + %% N.B. this argument is ignored if the "freq" argument is a + %% vector. The default is 'poly' unless the "freq" + %% argument is an integer power of 2. + + plot_type%% 'plot', 'semilogx', 'semilogy', 'loglog', 'squared' or 'db': + %% specifies the type of plot. The default is 'plot', which + %% means linear-linear axes. 'squared' is the same as 'plot'. + %% 'dB' plots "10*log10(psd)". This argument is ignored and a + %% spectrum is not plotted if the caller requires a returned + %% value. + + RETURNED VALUES: + If returned values are not required by the caller, the spectrum + is plotted and nothing is returned. + psd %% [real vector] estimate of power-spectral density + f_out %% [real vector] frequency values + + N.B. arburg runs in octave and matlab, and does not depend on octave-forge + or signal-processing-toolbox functions. + + REFERENCE + [1] Equation 2.28 from Steven M. Kay and Stanley Lawrence Marple Jr.: + "Spectrum analysis -- a modern perspective", + Proceedings of the IEEE, Vol 69, pp 1380-1419, Nov., 1981 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 68 + Usage: + [psd,f_out] = ar_psd(a,v,freq,Fs,range,method,plot_type) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +arburg + + +# name: +# type: sq_string +# elements: 1 +# length: 4080 + [a,v,k] = arburg(x,poles,criterion) + + Calculate coefficients of an autoregressive (AR) model of complex data + "x" using the whitening lattice-filter method of Burg (1968). The inverse + of the model is a moving-average filter which reduces "x" to white noise. + The power spectrum of the AR model is an estimate of the maximum + entropy power spectrum of the data. The function "ar_psd" calculates the + power spectrum of the AR model. + + ARGUMENTS: + x %% [vector] sampled data + + poles %% [integer scalar] number of poles in the AR model or + %% limit to the number of poles if a + %% valid "stop_crit" is provided. + + criterion %% [optional string arg] model-selection criterion. Limits + %% the number of poles so that spurious poles are not + %% added when the whitened data has no more information + %% in it (see Kay & Marple, 1981). Recognised values are + %% 'AKICc' -- approximate corrected Kullback information + %% criterion (recommended), + %% 'KIC' -- Kullback information criterion + %% 'AICc' -- corrected Akaike information criterion + %% 'AIC' -- Akaike information criterion + %% 'FPE' -- final prediction error" criterion + %% The default is to NOT use a model-selection criterion + + RETURNED VALUES: + a %% [polynomial/vector] list of (P+1) autoregression coeffic- + %% ients; for data input x(n) and white noise e(n), + %% the model is + %% P+1 + %% x(n) = sqrt(v).e(n) + SUM a(k).x(n-k) + %% k=1 + + v %% [real scalar] mean square of residual noise from the + %% whitening operation of the Burg lattice filter. + + k %% [column vector] reflection coefficients defining the + %% lattice-filter embodiment of the model + + HINTS: + (1) arburg does not remove the mean from the data. You should remove + the mean from the data if you want a power spectrum. A non-zero mean + can produce large errors in a power-spectrum estimate. See + "help detrend". + (2) If you don't know what the value of "poles" should be, choose the + largest (reasonable) value you could want and use the recommended + value, criterion='AKICc', so that arburg can find it. + E.g. arburg(x,64,'AKICc') + The AKICc has the least bias and best resolution of the available + model-selection criteria. + (3) arburg runs in octave and matlab, does not depend on octave forge + or signal-processing-toolbox functions. + (4) Autoregressive and moving-average filters are stored as polynomials + which, in matlab, are row vectors. + + NOTE ON SELECTION CRITERION + AIC, AICc, KIC and AKICc are based on information theory. They attempt + to balance the complexity (or length) of the model against how well the + model fits the data. AIC and KIC are biassed estimates of the asymmetric + and the symmetric Kullback-Leibler divergence respectively. AICc and + AKICc attempt to correct the bias. See reference [4]. + + + REFERENCES + [1] John Parker Burg (1968) + "A new analysis technique for time series data", + NATO advanced study Institute on Signal Processing with Emphasis on + Underwater Acoustics, Enschede, Netherlands, Aug. 12-23, 1968. + + [2] Steven M. Kay and Stanley Lawrence Marple Jr.: + "Spectrum analysis -- a modern perspective", + Proceedings of the IEEE, Vol 69, pp 1380-1419, Nov., 1981 + + [3] William H. Press and Saul A. Teukolsky and William T. Vetterling and + Brian P. Flannery + "Numerical recipes in C, The art of scientific computing", 2nd edition, + Cambridge University Press, 2002 --- Section 13.7. + + [4] Abd-Krim Seghouane and Maiza Bekara + "A small sample model selection criterion based on Kullback's symmetric + divergence", IEEE Transactions on Signal Processing, + Vol. 52(12), pp 3314-3323, Dec. 2004 + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 + [a,v,k] = arburg(x,poles,criterion) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +aryule + + +# name: +# type: sq_string +# elements: 1 +# length: 799 + usage: [a, v, k] = aryule (x, p) + + fits an AR (p)-model with Yule-Walker estimates. + x = data vector to estimate + a: AR coefficients + v: variance of white noise + k: reflection coeffients for use in lattice filter + + The power spectrum of the resulting filter can be plotted with + pyulear(x, p), or you can plot it directly with ar_psd(a,v,...). + + See also: + pyulear, power, freqz, impz -- for observing characteristics of the model + arburg -- for alternative spectral estimators + + Example: Use example from arburg, but substitute aryule for arburg. + + Note: Orphanidis '85 claims lattice filters are more tolerant of + truncation errors, which is why you might want to use them. However, + lacking a lattice filter processor, I haven't tested that the lattice + filter coefficients are reasonable. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: [a, v, k] = aryule (x, p) + + fits an AR (p)-model with Yule-Walker esti + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +barthannwin + + +# name: +# type: sq_string +# elements: 1 +# length: 136 + -- Function File: [W] = barthannwin(L) + Compute the modified Bartlett-Hann window of lenght L. + + See also: rectwin, bartlett + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Compute the modified Bartlett-Hann window of lenght L. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +besselap + + +# name: +# type: sq_string +# elements: 1 +# length: 105 + Return bessel analog filter prototype. + + References: + + http://en.wikipedia.org/wiki/Bessel_polynomials + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 + Return bessel analog filter prototype. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +besself + + +# name: +# type: sq_string +# elements: 1 +# length: 804 + Generate a bessel filter. + Default is a Laplace space (s) filter. + + [b,a] = besself(n, Wc) + low pass filter with cutoff pi*Wc radians + + [b,a] = besself(n, Wc, 'high') + high pass filter with cutoff pi*Wc radians + + [b,a] = besself(n, [Wl, Wh]) + band pass filter with edges pi*Wl and pi*Wh radians + + [b,a] = besself(n, [Wl, Wh], 'stop') + band reject filter with edges pi*Wl and pi*Wh radians + + [z,p,g] = besself(...) + return filter as zero-pole-gain rather than coefficients of the + numerator and denominator polynomials. + + [...] = besself(...,'z') + return a discrete space (Z) filter, W must be less than 1. + + [a,b,c,d] = besself(...) + return state-space matrices + + References: + + Proakis & Manolakis (1992). Digital Signal Processing. New York: + Macmillan Publishing Company. + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 + Generate a bessel filter. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +bilinear + + +# name: +# type: sq_string +# elements: 1 +# length: 2658 + usage: [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T) + [Zb, Za] = bilinear(Sb, Sa, T) + + Transform a s-plane filter specification into a z-plane + specification. Filters can be specified in either zero-pole-gain or + transfer function form. The input form does not have to match the + output form. 1/T is the sampling frequency represented in the z plane. + + Note: this differs from the bilinear function in the signal processing + toolbox, which uses 1/T rather than T. + + Theory: Given a piecewise flat filter design, you can transform it + from the s-plane to the z-plane while maintaining the band edges by + means of the bilinear transform. This maps the left hand side of the + s-plane into the interior of the unit circle. The mapping is highly + non-linear, so you must design your filter with band edges in the + s-plane positioned at 2/T tan(w*T/2) so that they will be positioned + at w after the bilinear transform is complete. + + The following table summarizes the transformation: + + +---------------+-----------------------+----------------------+ + | Transform | Zero at x | Pole at x | + | H(S) | H(S) = S-x | H(S)=1/(S-x) | + +---------------+-----------------------+----------------------+ + | 2 z-1 | zero: (2+xT)/(2-xT) | zero: -1 | + | S -> - --- | pole: -1 | pole: (2+xT)/(2-xT) | + | T z+1 | gain: (2-xT)/T | gain: (2-xT)/T | + +---------------+-----------------------+----------------------+ + + With tedious algebra, you can derive the above formulae yourself by + substituting the transform for S into H(S)=S-x for a zero at x or + H(S)=1/(S-x) for a pole at x, and converting the result into the + form: + + H(Z)=g prod(Z-Xi)/prod(Z-Xj) + + Please note that a pole and a zero at the same place exactly cancel. + This is significant since the bilinear transform creates numerous + extra poles and zeros, most of which cancel. Those which do not + cancel have a "fill-in" effect, extending the shorter of the sets to + have the same number of as the longer of the sets of poles and zeros + (or at least split the difference in the case of the band pass + filter). There may be other opportunistic cancellations but I will + not check for them. + + Also note that any pole on the unit circle or beyond will result in + an unstable filter. Because of cancellation, this will only happen + if the number of poles is smaller than the number of zeros. The + analytic design methods all yield more poles than zeros, so this will + not be a problem. + + References: + + Proakis & Manolakis (1992). Digital Signal Processing. New York: + Macmillan Publishing Company. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T) + [Zb, Za] = bilinear(Sb, S + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +bitrevorder + + +# name: +# type: sq_string +# elements: 1 +# length: 111 + -- Function File: [Y I] = bitrevorder(X) + Reorder x in the bit reversed order + + See also: fft, ifft + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Reorder x in the bit reversed order + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +blackmanharris + + +# name: +# type: sq_string +# elements: 1 +# length: 120 + -- Function File: [W] = blackmanharris(L) + Compute the Blackman-Harris window. + + See also: rectwin, bartlett + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Compute the Blackman-Harris window. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +blackmannuttall + + +# name: +# type: sq_string +# elements: 1 +# length: 123 + -- Function File: [W] = blackmannuttall(L) + Compute the Blackman-Nuttall window. + + See also: nuttallwin, kaiser + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Compute the Blackman-Nuttall window. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +bohmanwin + + +# name: +# type: sq_string +# elements: 1 +# length: 118 + -- Function File: [W] = bohmanwin(L) + Compute the Bohman window of lenght L. + + See also: rectwin, bartlett + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Compute the Bohman window of lenght L. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +boxcar + + +# name: +# type: sq_string +# elements: 1 +# length: 95 + usage: w = boxcar (n) + + Returns the filter coefficients of a rectangular window of length n. + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 + usage: w = boxcar (n) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +buffer + + +# name: +# type: sq_string +# elements: 1 +# length: 1473 + -- Function File: Y = buffer (X, N, P, OPT) + -- Function File: [Y, Z, OPT] = buffer (...) + Buffer a signal into a data frame. The arguments to `buffer' are + + X + The data to be buffered. + + N + The number of rows in the produced data buffer. This is an + positive integer value and must be supplied. + + P + An integer less than N that specifies the under- or overlap + between column in the data frame. The default value of P is 0. + + OPT + In the case of an overlap, OPT can be either a vector of + length P or the string 'nodelay'. If OPT is a vector, then the + first P entries in Y will be filled with these values. If OPT + is the string 'nodelay', then the first value of Y + corresponds to the first value of X. + + In the can of an underlap, OPT must be an integer between 0 + and `-P'. The represents the initial underlap of the first + column of Y. + + The default value for OPT the vector `zeros (1, P)' in the + case of an overlap, or 0 otherwise. + + In the case of a single output argument, Y will be padded with + zeros to fill the missing values in the data frame. With two output + arguments Z is the remaining data that has not been used in the + current data frame. + + Likewise, the output OPT is the overlap, or underlap that might be + used for a future call to `code' to allow continuous buffering. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Buffer a signal into a data frame. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +butter + + +# name: +# type: sq_string +# elements: 1 +# length: 799 + Generate a butterworth filter. + Default is a discrete space (Z) filter. + + [b,a] = butter(n, Wc) + low pass filter with cutoff pi*Wc radians + + [b,a] = butter(n, Wc, 'high') + high pass filter with cutoff pi*Wc radians + + [b,a] = butter(n, [Wl, Wh]) + band pass filter with edges pi*Wl and pi*Wh radians + + [b,a] = butter(n, [Wl, Wh], 'stop') + band reject filter with edges pi*Wl and pi*Wh radians + + [z,p,g] = butter(...) + return filter as zero-pole-gain rather than coefficients of the + numerator and denominator polynomials. + + [...] = butter(...,'s') + return a Laplace space filter, W can be larger than 1. + + [a,b,c,d] = butter(...) + return state-space matrices + + References: + + Proakis & Manolakis (1992). Digital Signal Processing. New York: + Macmillan Publishing Company. + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 + Generate a butterworth filter. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +buttord + + +# name: +# type: sq_string +# elements: 1 +# length: 1107 + Compute butterworth filter order and cutoff for the desired response + characteristics. Rp is the allowable decibels of ripple in the pass + band. Rs is the minimum attenuation in the stop band. + + [n, Wc] = buttord(Wp, Ws, Rp, Rs) + Low pass (WpWs) filter design. Wp is the + pass band edge and Ws is the stop band edge. Frequencies are + normalized to [0,1], corresponding to the range [0,Fs/2]. + + [n, Wc] = buttord([Wp1, Wp2], [Ws1, Ws2], Rp, Rs) + Band pass (Ws1 +# type: sq_string +# elements: 1 +# length: 80 + Compute butterworth filter order and cutoff for the desired response + character + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +cceps + + +# name: +# type: sq_string +# elements: 1 +# length: 195 + usage: cceps (x [, correct]) + + Returns the complex cepstrum of the vector x. + If the optional argument correct has the value 1, a correction + method is applied. The default is not to do this. + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 + usage: cceps (x [, correct]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +cheb + + +# name: +# type: sq_string +# elements: 1 +# length: 371 + Usage: cheb (n, x) + + Returns the value of the nth-order Chebyshev polynomial calculated at + the point x. The Chebyshev polynomials are defined by the equations: + + / cos(n acos(x), |x| <= 1 + Tn(x) = | + \ cosh(n acosh(x), |x| > 1 + + If x is a vector, the output is a vector of the same size, where each + element is calculated as y(i) = Tn(x(i)). + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 + Usage: cheb (n, x) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +cheb1ord + + +# name: +# type: sq_string +# elements: 1 +# length: 678 + Compute chebyshev type I filter order and cutoff for the desired response + characteristics. Rp is the allowable decibels of ripple in the pass + band. Rs is the minimum attenuation in the stop band. + + [n, Wc] = cheb1ord(Wp, Ws, Rp, Rs) + Low pass (WpWs) filter design. Wp is the + pass band edge and Ws is the stop band edge. Frequencies are + normalized to [0,1], corresponding to the range [0,Fs/2]. + + [n, Wc] = cheb1ord([Wp1, Wp2], [Ws1, Ws2], Rp, Rs) + Band pass (Ws1 +# type: sq_string +# elements: 1 +# length: 80 + Compute chebyshev type I filter order and cutoff for the desired response + char + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +cheb2ord + + +# name: +# type: sq_string +# elements: 1 +# length: 690 + Compute chebyshev type II filter order and cutoff for the desired response + characteristics. Rp is the allowable decibels of ripple in the pass + band. Rs is the minimum attenuation in the stop band. + + [n, Wc] = cheb2ord(Wp, Ws, Rp, Rs) + Low pass (WpWs) filter design. Wp is the + pass band edge and Ws is the stop band edge. Frequencies are + normalized to [0,1], corresponding to the range [0,Fs/2]. + + [n, Wc] = cheb2ord([Wp1, Wp2], [Ws1, Ws2], Rp, Rs) + Band pass (Ws1 +# type: sq_string +# elements: 1 +# length: 80 + Compute chebyshev type II filter order and cutoff for the desired response + cha + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +chebwin + + +# name: +# type: sq_string +# elements: 1 +# length: 1095 + Usage: chebwin (L, at) + + Returns the filter coefficients of the L-point Dolph-Chebyshev window + with at dB of attenuation in the stop-band of the corresponding + Fourier transform. + + For the definition of the Chebyshev window, see + + * Peter Lynch, "The Dolph-Chebyshev Window: A Simple Optimal Filter", + Monthly Weather Review, Vol. 125, pp. 655-660, April 1997. + (http://www.maths.tcd.ie/~plynch/Publications/Dolph.pdf) + + * C. Dolph, "A current distribution for broadside arrays which + optimizes the relationship between beam width and side-lobe level", + Proc. IEEE, 34, pp. 335-348. + + The window is described in frequency domain by the expression: + + Cheb(L-1, beta * cos(pi * k/L)) + W(k) = ------------------------------- + Cheb(L-1, beta) + + with + + beta = cosh(1/(L-1) * acosh(10^(at/20)) + + and Cheb(m,x) denoting the m-th order Chebyshev polynomial calculated + at the point x. + + Note that the denominator in W(k) above is not computed, and after + the inverse Fourier transform the window is scaled by making its + maximum value unitary. + + See also: kaiser + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 + Usage: chebwin (L, at) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +cheby1 + + +# name: +# type: sq_string +# elements: 1 +# length: 802 + Generate an Chebyshev type I filter with Rp dB of pass band ripple. + + [b, a] = cheby1(n, Rp, Wc) + low pass filter with cutoff pi*Wc radians + + [b, a] = cheby1(n, Rp, Wc, 'high') + high pass filter with cutoff pi*Wc radians + + [b, a] = cheby1(n, Rp, [Wl, Wh]) + band pass filter with edges pi*Wl and pi*Wh radians + + [b, a] = cheby1(n, Rp, [Wl, Wh], 'stop') + band reject filter with edges pi*Wl and pi*Wh radians + + [z, p, g] = cheby1(...) + return filter as zero-pole-gain rather than coefficients of the + numerator and denominator polynomials. + + [...] = cheby1(...,'s') + return a Laplace space filter, W can be larger than 1. + + [a,b,c,d] = cheby1(...) + return state-space matrices + + References: + + Parks & Burrus (1987). Digital Filter Design. New York: + John Wiley & Sons, Inc. + + + +# name: +# type: sq_string +# elements: 1 +# length: 68 + Generate an Chebyshev type I filter with Rp dB of pass band ripple. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +cheby2 + + +# name: +# type: sq_string +# elements: 1 +# length: 808 + Generate an Chebyshev type II filter with Rs dB of stop band attenuation. + + [b, a] = cheby2(n, Rs, Wc) + low pass filter with cutoff pi*Wc radians + + [b, a] = cheby2(n, Rs, Wc, 'high') + high pass filter with cutoff pi*Wc radians + + [b, a] = cheby2(n, Rs, [Wl, Wh]) + band pass filter with edges pi*Wl and pi*Wh radians + + [b, a] = cheby2(n, Rs, [Wl, Wh], 'stop') + band reject filter with edges pi*Wl and pi*Wh radians + + [z, p, g] = cheby2(...) + return filter as zero-pole-gain rather than coefficients of the + numerator and denominator polynomials. + + [...] = cheby2(...,'s') + return a Laplace space filter, W can be larger than 1. + + [a,b,c,d] = cheby2(...) + return state-space matrices + + References: + + Parks & Burrus (1987). Digital Filter Design. New York: + John Wiley & Sons, Inc. + + + +# name: +# type: sq_string +# elements: 1 +# length: 74 + Generate an Chebyshev type II filter with Rs dB of stop band attenuation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +chirp + + +# name: +# type: sq_string +# elements: 1 +# length: 811 + usage: y = chirp(t [, f0 [, t1 [, f1 [, form [, phase]]]]]) + + Evaluate a chirp signal at time t. A chirp signal is a frequency + swept cosine wave. + + t: vector of times to evaluate the chirp signal + f0: frequency at time t=0 [ 0 Hz ] + t1: time t1 [ 1 sec ] + f1: frequency at time t=t1 [ 100 Hz ] + form: shape of frequency sweep + 'linear' f(t) = (f1-f0)*(t/t1) + f0 + 'quadratic' f(t) = (f1-f0)*(t/t1)^2 + f0 + 'logarithmic' f(t) = (f1-f0)^(t/t1) + f0 + phase: phase shift at t=0 + + Example + specgram(chirp([0:0.001:5])); # linear, 0-100Hz in 1 sec + specgram(chirp([-2:0.001:15], 400, 10, 100, 'quadratic')); + soundsc(chirp([0:1/8000:5], 200, 2, 500, "logarithmic"),8000); + + If you want a different sweep shape f(t), use the following: + y = cos(2*pi*integral(f(t)) + 2*pi*f0*t + phase); + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 + usage: y = chirp(t [, f0 [, t1 [, f1 [, form [, phase]]]]]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +cmorwavf + + +# name: +# type: sq_string +# elements: 1 +# length: 96 + -- Function File: [PSI,X] = cmorwavf (LB,UB,N,FB,FC) + Compute the Complex Morlet wavelet. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Compute the Complex Morlet wavelet. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +cohere + + +# name: +# type: sq_string +# elements: 1 +# length: 377 + Usage: + [Pxx,freq] = cohere(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) + + Estimate (mean square) coherence of signals "x" and "y". + Use the Welch (1967) periodogram/FFT method. + Compatible with Matlab R11 cohere and earlier. + See "help pwelch" for description of arguments, hints and references + --- especially hint (7) for Matlab R11 defaults. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Usage: + [Pxx,freq] = cohere(x,y,Nfft,Fs,window,overlap,range,plot_type,detren + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +convmtx + + +# name: +# type: sq_string +# elements: 1 +# length: 498 + -- Function File: convmtx (A, N) + If A is a column vector and X is a column vector of length N, then + + `convmtx(A, N) * X' + + gives the convolution of of A and X and is the same as `conv(A, + X)'. The difference is if many vectors are to be convolved with + the same vector, then this technique is possibly faster. + + Similarly, if A is a row vector and X is a row vector of length N, + then + + `X * convmtx(A, N)' + + is the same as `conv(X, A)'. + + See also: conv + + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 +If A is a column vector and X is a column vector of length N, then + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +cplxreal + + +# name: +# type: sq_string +# elements: 1 +# length: 710 + -- Function File: [ZC, ZR] = cplxreal (Z, THRESH) + Split the vector z into its complex (ZC) and real (ZR) elements, + eliminating one of each complex-conjugate pair. + + INPUTS: + * Z = row- or column-vector of complex numbers + * THRESH = tolerance threshold for numerical comparisons + (default = 100*eps) + + RETURNED: + * ZC = elements of Z having positive imaginary parts + * ZR = elements of Z having zero imaginary part + + Each complex element of Z is assumed to have a complex-conjugate + counterpart elsewhere in Z as well. Elements are declared real if + their imaginary parts have magnitude less than THRESH. + + See also: cplxpair + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Split the vector z into its complex (ZC) and real (ZR) elements, +eliminating one + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +cpsd + + +# name: +# type: sq_string +# elements: 1 +# length: 260 + Usage: + [Pxx,freq] = cpsd(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) + + Estimate cross power spectrum of data "x" and "y" by the Welch (1967) + periodogram/FFT method. + See "help pwelch" for description of arguments, hints and references + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Usage: + [Pxx,freq] = cpsd(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +csd + + +# name: +# type: sq_string +# elements: 1 +# length: 358 + Usage: + [Pxx,freq] = csd(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) + + Estimate cross power spectrum of data "x" and "y" by the Welch (1967) + periodogram/FFT method. Compatible with Matlab R11 csd and earlier. + See "help pwelch" for description of arguments, hints and references + --- especially hint (7) for Matlab R11 defaults. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Usage: + [Pxx,freq] = csd(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +czt + + +# name: +# type: sq_string +# elements: 1 +# length: 828 + usage y=czt(x, m, w, a) + + Chirp z-transform. Compute the frequency response starting at a and + stepping by w for m steps. a is a point in the complex plane, and + w is the ratio between points in each step (i.e., radius increases + exponentially, and angle increases linearly). + + To evaluate the frequency response for the range f1 to f2 in a signal + with sampling frequency Fs, use the following: + m = 32; ## number of points desired + w = exp(-j*2*pi*(f2-f1)/((m-1)*Fs)); ## freq. step of f2-f1/m + a = exp(j*2*pi*f1/Fs); ## starting at frequency f1 + y = czt(x, m, w, a); + + If you don't specify them, then the parameters default to a fourier + transform: + m=length(x), w=exp(-j*2*pi/m), a=1 + + If x is a matrix, the transform will be performed column-by-column. + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 + usage y=czt(x, m, w, a) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +data2fun + + +# name: +# type: sq_string +# elements: 1 +# length: 1111 + -- Function File: [FHANDLE, FULLNAME] = data2fun (TI, YI) + -- Function File: [ ... ] = data2fun (TI, YI,PROPERTY,VALUE) + Creates a vectorized function based on data samples using + interpolation. + + The values given in YI (N-by-k matrix) correspond to evaluations + of the function y(t) at the points TI (N-by-1 matrix). The data + is interpolated and the function handle to the generated + interpolant is returned. + + The function accepts property-value pairs described below. + + `file' + Code is generated and .m file is created. The VALUE contains + the name of the function. The returned function handle is a + handle to that file. If VALUE is empty, then a name is + automatically generated using `tmpnam' and the file is + created in the current directory. VALUE must not have an + extension, since .m will be appended. Numerical value used + in the function are stored in a .mat file with the same name + as the function. + + `interp' + Type of interpolation. See `interp1'. + + + See also: interp1 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 +Creates a vectorized function based on data samples using interpolation. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +dct + + +# name: +# type: sq_string +# elements: 1 +# length: 687 + y = dct (x, n) + Computes the discrete cosine transform of x. If n is given, then + x is padded or trimmed to length n before computing the transform. + If x is a matrix, compute the transform along the columns of the + the matrix. The transform is faster if x is real-valued and even + length. + + The discrete cosine transform X of x can be defined as follows: + + N-1 + X[k] = w(k) sum x[n] cos (pi (2n+1) k / 2N ), k = 0, ..., N-1 + n=0 + + with w(0) = sqrt(1/N) and w(k) = sqrt(2/N), k = 1, ..., N-1. There + are other definitions with different scaling of X[k], but this form + is common in image processing. + + See also: idct, dct2, idct2, dctmtx + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 + y = dct (x, n) + Computes the discrete cosine transform of x. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +dct2 + + +# name: +# type: sq_string +# elements: 1 +# length: 202 + y = dct2 (x) + Computes the 2-D discrete cosine transform of matrix x + + y = dct2 (x, m, n) or y = dct2 (x, [m n]) + Computes the 2-D DCT of x after padding or trimming rows to m and + columns to n. + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 + y = dct2 (x) + Computes the 2-D discrete cosine transform of matrix x + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +dctmtx + + +# name: +# type: sq_string +# elements: 1 +# length: 599 + T = dctmtx (n) + Return the DCT transformation matrix of size n x n. + + If A is an n x n matrix, then the following are true: + T*A == dct(A), T'*A == idct(A) + T*A*T' == dct2(A), T'*A*T == idct2(A) + + A dct transformation matrix is useful for doing things like jpeg + image compression, in which an 8x8 dct matrix is applied to + non-overlapping blocks throughout an image and only a subblock on the + top left of each block is kept. During restoration, the remainder of + the block is filled with zeros and the inverse transform is applied + to the block. + + See also: dct, idct, dct2, idct2 + + + +# name: +# type: sq_string +# elements: 1 +# length: 68 + T = dctmtx (n) + Return the DCT transformation matrix of size n x n. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +decimate + + +# name: +# type: sq_string +# elements: 1 +# length: 1021 + usage: y = decimate(x, q [, n] [, ftype]) + + Downsample the signal x by a factor of q, using an order n filter + of ftype 'fir' or 'iir'. By default, an order 8 Chebyshev type I + filter is used or a 30 point FIR filter if ftype is 'fir'. Note + that q must be an integer for this rate change method. + + Example + ## Generate a signal that starts away from zero, is slowly varying + ## at the start and quickly varying at the end, decimate and plot. + ## Since it starts away from zero, you will see the boundary + ## effects of the antialiasing filter clearly. Next you will see + ## how it follows the curve nicely in the slowly varying early + ## part of the signal, but averages the curve in the quickly + ## varying late part of the signal. + t=0:0.01:2; x=chirp(t,2,.5,10,'quadratic')+sin(2*pi*t*0.4); + y = decimate(x,4); # factor of 4 decimation + stem(t(1:121)*1000,x(1:121),"-g;Original;"); hold on; # plot original + stem(t(1:4:121)*1000,y(1:31),"-r;Decimated;"); hold off; # decimated + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 + usage: y = decimate(x, q [, n] [, ftype]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +dftmtx + + +# name: +# type: sq_string +# elements: 1 +# length: 343 + -- Function File: D = dftmtx (N) + If N is a scalar, produces a N-by-N matrix D such that the Fourier + transform of a column vector of length N is given by `dftmtx(N) * + x' and the inverse Fourier transform is given by `inv(dftmtx(N)) * + x'. In general this is less efficient than calling the "fft" and + "ifft" directly. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +If N is a scalar, produces a N-by-N matrix D such that the Fourier +transform of + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +diric + + +# name: +# type: sq_string +# elements: 1 +# length: 116 + -- Function File: [Y] = diric(X,N) + Compute the dirichlet function. + + See also: sinc, gauspuls, sawtooth + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 +Compute the dirichlet function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +downsample + + +# name: +# type: sq_string +# elements: 1 +# length: 511 + -- Function File: Y = downsample (X, N) + -- Function File: Y = downsample (X, N, OFFSET) + Downsample the signal, selecting every nth element. If X is a + matrix, downsample every column. + + For most signals you will want to use `decimate' instead since it + prefilters the high frequency components of the signal and avoids + aliasing effects. + + If OFFSET is defined, select every nth element starting at sample + OFFSET. + + See also: decimate, interp, resample, upfirdn, upsample + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Downsample the signal, selecting every nth element. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +dst + + +# name: +# type: sq_string +# elements: 1 +# length: 482 + -- Function File: Y = dst (X) + -- Function File: Y = dst (X, N) + Computes the type I discrete sine transform of X. If N is given, + then X is padded or trimmed to length N before computing the + transform. If X is a matrix, compute the transform along the + columns of the the matrix. + + The discrete sine transform X of x can be defined as follows: + + N + X[k] = sum x[n] sin (pi n k / (N+1) ), k = 1, ..., N + n=1 + + See also: idst + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Computes the type I discrete sine transform of X. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +dwt + + +# name: +# type: sq_string +# elements: 1 +# length: 111 + -- Function File: [CA CD] = dwt(X,LO_D,HI_D) + Comupte de discrete wavelet transform of x with one level. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Comupte de discrete wavelet transform of x with one level. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ellip + + +# name: +# type: sq_string +# elements: 1 +# length: 1050 + N-ellip 0.2.1 +usage: [Zz, Zp, Zg] = ellip(n, Rp, Rs, Wp, stype,'s') + + Generate an Elliptic or Cauer filter (discrete and contnuious). + + [b,a] = ellip(n, Rp, Rs, Wp) + low pass filter with order n, cutoff pi*Wp radians, Rp decibels + of ripple in the passband and a stopband Rs decibels down. + + [b,a] = ellip(n, Rp, Rs, Wp, 'high') + high pass filter with cutoff pi*Wp... + + [b,a] = ellip(n, Rp, Rs, [Wl, Wh]) + band pass filter with band pass edges pi*Wl and pi*Wh ... + + [b,a] = ellip(n, Rp, Rs, [Wl, Wh], 'stop') + band reject filter with edges pi*Wl and pi*Wh, ... + + [z,p,g] = ellip(...) + return filter as zero-pole-gain. + + [...] = ellip(...,'s') + return a Laplace space filter, W can be larger than 1. + + [a,b,c,d] = ellip(...) + return state-space matrices + + References: + + - Oppenheim, Alan V., Discrete Time Signal Processing, Hardcover, 1999. + - Parente Ribeiro, E., Notas de aula da disciplina TE498 - Processamento + Digital de Sinais, UFPR, 2001/2002. + - Kienzle, Paul, functions from Octave-Forge, 1999 (http://octave.sf.net). + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + N-ellip 0. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +ellipord + + +# name: +# type: sq_string +# elements: 1 +# length: 346 + usage: [n,wp] = ellipord(wp,ws, rp,rs) + + Calculate the order for the elliptic filter (discrete) + wp: Cutoff frequency + ws: Stopband edge + rp: decibels of ripple in the passband. + rs: decibels of ripple in the stopband. + + References: + + - Lamar, Marcus Vinicius, Notas de aula da disciplina TE 456 - Circuitos + Analogicos II, UFPR, 2001/2002. + + + +# name: +# type: sq_string +# elements: 1 +# length: 40 + usage: [n,wp] = ellipord(wp,ws, rp,rs) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +fht + + +# name: +# type: sq_string +# elements: 1 +# length: 788 + -- Function File: m = fht ( d, n, dim ) + The function fht calculates Fast Hartley Transform where D is + the real input vector (matrix), and M is the real-transform + vector. For matrices the hartley transform is calculated along the + columns by default. The options N,and DIM are similar to the + options of FFT function. + + The forward and inverse hartley transforms are the same (except + for a scale factor of 1/N for the inverse hartley transform), but + implemented using different functions . + + The definition of the forward hartley transform for vector d, + + m[K] = \sum_i=0^N-1 d[i]*(cos[K*2*pi*i/N] + sin[K*2*pi*i/N]), for + 0 <= K < N. m[K] = \sum_i=0^N-1 d[i]*CAS[K*i], for 0 <= K < N. + + fht(1:4) + + See also: ifht, fft + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +The function fht calculates Fast Hartley Transform where D is the +real input v + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +filtfilt + + +# name: +# type: sq_string +# elements: 1 +# length: 673 + usage: y = filtfilt(b, a, x) + + Forward and reverse filter the signal. This corrects for phase + distortion introduced by a one-pass filter, though it does square the + magnitude response in the process. That's the theory at least. In + practice the phase correction is not perfect, and magnitude response + is distorted, particularly in the stop band. + + Example + [b, a]=butter(3, 0.1); % 10 Hz low-pass filter + t = 0:0.01:1.0; % 1 second sample + x=sin(2*pi*t*2.3)+0.25*randn(size(t)); % 2.3 Hz sinusoid+noise + y = filtfilt(b,a,x); z = filter(b,a,x); % apply filter + plot(t,x,';data;',t,y,';filtfilt;',t,z,';filter;') + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 + usage: y = filtfilt(b, a, x) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +filtic + + +# name: +# type: sq_string +# elements: 1 +# length: 718 + Set initial condition vector for filter function + The vector zf has the same values that would be obtained + from function filter given past inputs x and outputs y + + The vectors x and y contain the most recent inputs and outputs + respectively, with the newest values first: + + x = [x(-1) x(-2) ... x(-nb)], nb = length(b)-1 + y = [y(-1) y(-2) ... y(-na)], na = length(a)-a + + If length(x) +# type: sq_string +# elements: 1 +# length: 80 + Set initial condition vector for filter function + The vector zf has the same va + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +fir1 + + +# name: +# type: sq_string +# elements: 1 +# length: 1180 + usage: b = fir1(n, w [, type] [, window] [, noscale]) + + Produce an order n FIR filter with the given frequency cutoff, + returning the n+1 filter coefficients in b. + + n: order of the filter (1 less than the length of the filter) + w: band edges + strictly increasing vector in range [0, 1] + singleton for highpass or lowpass, vector pair for bandpass or + bandstop, or vector for alternating pass/stop filter. + type: choose between pass and stop bands + 'high' for highpass filter, cutoff at w + 'stop' for bandstop filter, edges at w = [lo, hi] + 'DC-0' for bandstop as first band of multiband filter + 'DC-1' for bandpass as first band of multiband filter + window: smoothing window + defaults to hamming(n+1) row vector + returned filter is the same shape as the smoothing window + noscale: choose whether to normalize or not + 'scale': set the magnitude of the center of the first passband to 1 + 'noscale': don't normalize + + To apply the filter, use the return vector b: + y=filter(b,1,x); + + Examples: + freqz(fir1(40,0.3)); + freqz(fir1(15,[0.2, 0.5], 'stop')); # note the zero-crossing at 0.1 + freqz(fir1(15,[0.2, 0.5], 'stop', 'noscale')); + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 + usage: b = fir1(n, w [, type] [, window] [, noscale]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +fir2 + + +# name: +# type: sq_string +# elements: 1 +# length: 1197 + usage: b = fir2(n, f, m [, grid_n [, ramp_n]] [, window]) + + Produce an FIR filter of order n with arbitrary frequency response, + returning the n+1 filter coefficients in b. + + n: order of the filter (1 less than the length of the filter) + f: frequency at band edges + f is a vector of nondecreasing elements in [0,1] + the first element must be 0 and the last element must be 1 + if elements are identical, it indicates a jump in freq. response + m: magnitude at band edges + m is a vector of length(f) + grid_n: length of ideal frequency response function + defaults to 512, should be a power of 2 bigger than n + ramp_n: transition width for jumps in filter response + defaults to grid_n/20; a wider ramp gives wider transitions + but has better stopband characteristics. + window: smoothing window + defaults to hamming(n+1) row vector + returned filter is the same shape as the smoothing window + + To apply the filter, use the return vector b: + y=filter(b,1,x); + Note that plot(f,m) shows target response. + + Example: + f=[0, 0.3, 0.3, 0.6, 0.6, 1]; m=[0, 0, 1, 1/2, 0, 0]; + [h, w] = freqz(fir2(100,f,m)); + plot(f,m,';target response;',w/pi,abs(h),';filter response;'); + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 + usage: b = fir2(n, f, m [, grid_n [, ramp_n]] [, window]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +firls + + +# name: +# type: sq_string +# elements: 1 +# length: 908 + b = firls(N, F, A); + b = firls(N, F, A, W); + + FIR filter design using least squares method. Returns a length N+1 + linear phase filter such that the integral of the weighted mean + squared error in the specified bands is minimized. + + F specifies the frequencies of the band edges, normalized so that + half the sample frequency is equal to 1. Each band is specified by + two frequencies, to the vector must have an even length. + + A specifies the amplitude of the desired response at each band edge. + + W is an optional weighting function that contains one value for each + band that weights the mean squared error in that band. A must be the + same length as F, and W must be half the length of F. + + The least squares optimization algorithm for computing FIR filter + coefficients is derived in detail in: + + I. Selesnick, "Linear-Phase FIR Filter Design by Least Squares," + http://cnx.org/content/m10577 + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 + b = firls(N, F, A); + b = firls(N, F, A, W); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +flattopwin + + +# name: +# type: sq_string +# elements: 1 +# length: 679 + flattopwin(L, [periodic|symmetric]) + + Return the window f(w): + + f(w) = 1 - 1.93 cos(2 pi w) + 1.29 cos(4 pi w) + - 0.388 cos(6 pi w) + 0.0322cos(8 pi w) + + where w = i/(L-1) for i=0:L-1 for a symmetric window, or + w = i/L for i=0:L-1 for a periodic window. The default + is symmetric. The returned window is normalized to a peak + of 1 at w = 0.5. + + This window has low pass-band ripple, but high bandwidth. + + According to [1]: + + The main use for the Flat Top window is for calibration, due + to its negligible amplitude errors. + + [1] Gade, S; Herlufsen, H; (1987) "Use of weighting functions in DFT/FFT + analysis (Part I)", Bruel & Kjaer Technical Review No.3. + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 + flattopwin(L, [periodic|symmetric]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +fracshift + + +# name: +# type: sq_string +# elements: 1 +# length: 279 + -- Function File: [Y H]= fracshift(X,D) + -- Function File: Y = fracshift(X,D,H) + Shift the series X by a (possibly fractional) number of samples D. + The interpolator H is either specified or either designed with a + Kaiser-windowed sinecard. + + See also: circshift + + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +Shift the series X by a (possibly fractional) number of samples D. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +freqs + + +# name: +# type: sq_string +# elements: 1 +# length: 300 + Usage: H = freqs(B,A,W); + + Compute the s-plane frequency response of the IIR filter B(s)/A(s) as + H = polyval(B,j*W)./polyval(A,j*W). If called with no output + argument, a plot of magnitude and phase are displayed. + + Example: + B = [1 2]; A = [1 1]; + w = linspace(0,4,128); + freqs(B,A,w); + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 + Usage: H = freqs(B,A,W); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +freqs_plot + + +# name: +# type: sq_string +# elements: 1 +# length: 90 + -- Function File: freqs_plot (W, H) + Plot the amplitude and phase of the vector H. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Plot the amplitude and phase of the vector H. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +fwhm + + +# name: +# type: sq_string +# elements: 1 +# length: 1318 + Compute peak full-width at half maximum (FWHM) or at another level of peak + maximum for vector or matrix data y, optionally sampled as y(x). If y is + a matrix, return FWHM for each column as a row vector. + Syntax: + f = fwhm({x, } y {, 'zero'|'min' {, 'rlevel', rlevel}}) + f = fwhm({x, } y {, 'alevel', alevel}) + Examples: + f = fwhm(y) + f = fwhm(x, y) + f = fwhm(x, y, 'zero') + f = fwhm(x, y, 'min') + f = fwhm(x, y, 'alevel', 15.3) + f = fwhm(x, y, 'zero', 'rlevel', 0.5) + f = fwhm(x, y, 'min', 'rlevel', 0.1) + + The default option 'zero' computes fwhm at half maximum, i.e. 0.5*max(y). + The option 'min' computes fwhm at the middle curve, i.e. 0.5*(min(y)+max(y)). + + The option 'rlevel' computes full-width at the given relative level of peak + profile, i.e. at rlevel*max(y) or rlevel*(min(y)+max(y)), respectively. + For example, fwhm(..., 'rlevel', 0.1) computes full width at 10 % of peak + maximum with respect to zero or minimum; FWHM is equivalent to + fwhm(..., 'rlevel', 0.5). + + The option 'alevel' computes full-width at the given absolute level of y. + + Return 0 if FWHM does not exist (e.g. monotonous function or the function + does not cut horizontal line at rlevel*max(y) or rlevel*(max(y)+min(y)) or + alevel, respectively). + + Compatibility: Octave 3.x, Matlab + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Compute peak full-width at half maximum (FWHM) or at another level of peak + max + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +gauspuls + + +# name: +# type: sq_string +# elements: 1 +# length: 97 + -- Function File: [Y] = gauspuls(T,FC,BW) + Return the Gaussian modulated sinusoidal pulse. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Return the Gaussian modulated sinusoidal pulse. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +gaussian + + +# name: +# type: sq_string +# elements: 1 +# length: 442 + usage: w = gaussian(n, a) + + Generate an n-point gaussian convolution window of the given + width. Use larger a for a narrower window. Use larger n for + longer tails. + + w = exp ( -(a*x)^2/2 ) + + for x = linspace ( -(n-1)/2, (n-1)/2, n ). + + Width a is measured in frequency units (sample rate/num samples). + It should be f when multiplying in the time domain, but 1/f when + multiplying in the frequency domain (for use in convolutions). + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 + usage: w = gaussian(n, a) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +gausswin + + +# name: +# type: sq_string +# elements: 1 +# length: 227 + usage: w = gausswin(L, a) + + Generate an L-point gaussian window of the given width. Use larger a + for a narrow window. Use larger L for a smoother curve. + + w = exp ( -(a*x)^2/2 ) + + for x = linspace(-(L-1)/L, (L-1)/L, L) + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 + usage: w = gausswin(L, a) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +gmonopuls + + +# name: +# type: sq_string +# elements: 1 +# length: 78 + -- Function File: [Y] = gmonopuls(T,FC) + Return the gaussian monopulse. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Return the gaussian monopulse. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +grpdelay + + +# name: +# type: sq_string +# elements: 1 +# length: 2463 + Compute the group delay of a filter. + + [g, w] = grpdelay(b) + returns the group delay g of the FIR filter with coefficients b. + The response is evaluated at 512 angular frequencies between 0 and + pi. w is a vector containing the 512 frequencies. + The group delay is in units of samples. It can be converted + to seconds by multiplying by the sampling period (or dividing by + the sampling rate fs). + + [g, w] = grpdelay(b,a) + returns the group delay of the rational IIR filter whose numerator + has coefficients b and denominator coefficients a. + + [g, w] = grpdelay(b,a,n) + returns the group delay evaluated at n angular frequencies. For fastest + computation n should factor into a small number of small primes. + + [g, w] = grpdelay(b,a,n,'whole') + evaluates the group delay at n frequencies between 0 and 2*pi. + + [g, f] = grpdelay(b,a,n,Fs) + evaluates the group delay at n frequencies between 0 and Fs/2. + + [g, f] = grpdelay(b,a,n,'whole',Fs) + evaluates the group delay at n frequencies between 0 and Fs. + + [g, w] = grpdelay(b,a,w) + evaluates the group delay at frequencies w (radians per sample). + + [g, f] = grpdelay(b,a,f,Fs) + evaluates the group delay at frequencies f (in Hz). + + grpdelay(...) + plots the group delay vs. frequency. + + If the denominator of the computation becomes too small, the group delay + is set to zero. (The group delay approaches infinity when + there are poles or zeros very close to the unit circle in the z plane.) + + Theory: group delay, g(w) = -d/dw [arg{H(e^jw)}], is the rate of change of + phase with respect to frequency. It can be computed as: + + d/dw H(e^-jw) + g(w) = ------------- + H(e^-jw) + + where + H(z) = B(z)/A(z) = sum(b_k z^k)/sum(a_k z^k). + + By the quotient rule, + A(z) d/dw B(z) - B(z) d/dw A(z) + d/dw H(z) = ------------------------------- + A(z) A(z) + Substituting into the expression above yields: + A dB - B dA + g(w) = ----------- = dB/B - dA/A + A B + + Note that, + d/dw B(e^-jw) = sum(k b_k e^-jwk) + d/dw A(e^-jw) = sum(k a_k e^-jwk) + which is just the FFT of the coefficients multiplied by a ramp. + + As a further optimization when nfft>>length(a), the IIR filter (b,a) + is converted to the FIR filter conv(b,fliplr(conj(a))). + For further details, see + http://ccrma.stanford.edu/~jos/filters/Numerical_Computation_Group_Delay.html + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 + Compute the group delay of a filter. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +hann + + +# name: +# type: sq_string +# elements: 1 +# length: 28 + w = hann(n) + see hanning + + + +# name: +# type: sq_string +# elements: 1 +# length: 28 + w = hann(n) + see hanning + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +hilbert + + +# name: +# type: sq_string +# elements: 1 +# length: 647 + -- Function File: H = hilbert (F,N,DIM) + Analytic extension of real valued signal + + `H=hilbert(F)' computes the extension of the real valued signal F + to an analytic signal. If F is a matrix, the transformation is + applied to each column. For N-D arrays, the transformation is + applied to the first non-singleton dimension. + + `real(H)' contains the original signal F. `imag(H)' contains the + Hilbert transform of F. + + `hilbert(F,N)' does the same using a length N Hilbert transform. + The result will also have length N. + + `hilbert(F,[],DIM)' or `hilbert(F,N,DIM)' does the same along + dimension dim. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +Analytic extension of real valued signal + + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +idct + + +# name: +# type: sq_string +# elements: 1 +# length: 584 + y = dct (x, n) + Computes the inverse discrete cosine transform of x. If n is + given, then x is padded or trimmed to length n before computing + the transform. If x is a matrix, compute the transform along the + columns of the the matrix. The transform is faster if x is + real-valued and even length. + + The inverse discrete cosine transform x of X can be defined as follows: + + N-1 + x[n] = sum w(k) X[k] cos (pi (2n+1) k / 2N ), n = 0, ..., N-1 + k=0 + + with w(0) = sqrt(1/N) and w(k) = sqrt(2/N), k = 1, ..., N-1 + + See also: idct, dct2, idct2, dctmtx + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 + y = dct (x, n) + Computes the inverse discrete cosine transform of x. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +idct2 + + +# name: +# type: sq_string +# elements: 1 +# length: 221 + y = idct2 (x) + Computes the inverse 2-D discrete cosine transform of matrix x + + y = idct2 (x, m, n) or y = idct2 (x, [m n]) + Computes the 2-D inverse DCT of x after padding or trimming rows to m and + columns to n. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + y = idct2 (x) + Computes the inverse 2-D discrete cosine transform of matrix x + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +idst + + +# name: +# type: sq_string +# elements: 1 +# length: 333 + -- Function File: Y = idst (X) + -- Function File: Y = idst (X, N) + Computes the inverse type I discrete sine transform of Y. If N is + given, then Y is padded or trimmed to length N before computing + the transform. If Y is a matrix, compute the transform along the + columns of the the matrix. + + See also: dst + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 +Computes the inverse type I discrete sine transform of Y. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +ifht + + +# name: +# type: sq_string +# elements: 1 +# length: 805 + -- Function File: m = ifht ( d, n, dim ) + The function ifht calculates Fast Hartley Transform where D is + the real input vector (matrix), and M is the real-transform + vector. For matrices the hartley transform is calculated along the + columns by default. The options N, and DIM are similar to the + options of FFT function. + + The forward and inverse hartley transforms are the same (except + for a scale factor of 1/N for the inverse hartley transform), but + implemented using different functions . + + The definition of the forward hartley transform for vector d, + + m[K] = 1/N \sum_i=0^N-1 d[i]*(cos[K*2*pi*i/N] + sin[K*2*pi*i/N]), + for 0 <= K < N. m[K] = 1/N \sum_i=0^N-1 d[i]*CAS[K*i], for 0 <= + K < N. + + ifht(1:4) + + See also: fht, fft + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +The function ifht calculates Fast Hartley Transform where D is the +real input + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +iirlp2mb + + +# name: +# type: sq_string +# elements: 1 +# length: 1305 + IIR Low Pass Filter to Multiband Filter Transformation + + [Num,Den,AllpassNum,AllpassDen] = iirlp2mb(B,A,Wo,Wt) + [Num,Den,AllpassNum,AllpassDen] = iirlp2mb(B,A,Wo,Wt,Pass) + + Num,Den: numerator,denominator of the transformed filter + AllpassNum,AllpassDen: numerator,denominator of allpass transform, + B,A: numerator,denominator of prototype low pass filter + Wo: normalized_angular_frequency/pi to be transformed + Wt: [phi=normalized_angular_frequencies]/pi target vector + Pass: This parameter may have values 'pass' or 'stop'. If + not given, it defaults to the value of 'pass'. + + With normalized ang. freq. targets 0 < phi(1) < ... < phi(n) < pi radians + + for Pass == 'pass', the target multiband magnitude will be: + -------- ---------- -----------... + / \ / \ / . + 0 phi(1) phi(2) phi(3) phi(4) phi(5) (phi(6)) pi + + for Pass == 'stop', the target multiband magnitude will be: + ------- --------- ----------... + \ / \ / . + 0 phi(1) phi(2) phi(3) phi(4) (phi(5)) pi + + Example of use: + [B, A] = butter(6, 0.5); + [Num, Den] = iirlp2mb(B, A, 0.5, [.2 .4 .6 .8]); + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 + IIR Low Pass Filter to Multiband Filter Transformation + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +impinvar + + +# name: +# type: sq_string +# elements: 1 +# length: 877 + -- Function File: [B_OUT, A_OUT] = impinvar (B, A, FS, TOL) + -- Function File: [B_OUT, A_OUT] = impinvar (B, A, FS) + -- Function File: [B_OUT, A_OUT] = impinvar (B, A) + Converts analog filter with coefficients B and A to digital, + conserving impulse response. + + If FS is not specificied, or is an empty vector, it defaults to + 1Hz. + + If TOL is not specified, it defaults to 0.0001 (0.1%) This + function does the inverse of impinvar so that the following + example should restore the original values of A and B. + + `invimpinvar' implements the reverse of this function. + [b, a] = impinvar (b, a); + [b, a] = invimpinvar (b, a); + + Reference: Thomas J. Cavicchi (1996) "Impulse invariance and + multiple-order poles". IEEE transactions on signal processing, Vol + 40 (9): 2344-2347 + + See also: bilinear, invimpinvar + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Converts analog filter with coefficients B and A to digital, conserving +impulse + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +impz + + +# name: +# type: sq_string +# elements: 1 +# length: 545 + usage: [x, t] = impz(b [, a, n, fs]) + + Generate impulse-response characteristics of the filter. The filter + coefficients correspond to the the z-plane rational function with + numerator b and denominator a. If a is not specified, it defaults to + 1. If n is not specified, or specified as [], it will be chosen such + that the signal has a chance to die down to -120dB, or to not explode + beyond 120dB, or to show five periods if there is no significant + damping. If no return arguments are requested, plot the results. + + See also: freqz, zplane + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + usage: [x, t] = impz(b [, a, n, fs]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +interp + + +# name: +# type: sq_string +# elements: 1 +# length: 631 + usage: y = interp(x, q [, n [, Wc]]) + + Upsample the signal x by a factor of q, using an order 2*q*n+1 FIR + filter. Note that q must be an integer for this rate change method. + n defaults to 4 and Wc defaults to 0.5. + + Example + # Generate a signal. + t=0:0.01:2; x=chirp(t,2,.5,10,'quadratic')+sin(2*pi*t*0.4); + y = interp(x(1:4:length(x)),4,4,1); # interpolate a sub-sample + stem(t(1:121)*1000,x(1:121),"-g;Original;"); hold on; + stem(t(1:121)*1000,y(1:121),"-r;Interpolated;"); + stem(t(1:4:121)*1000,x(1:4:121),"-b;Subsampled;"); hold off; + + See also: decimate, resample + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + usage: y = interp(x, q [, n [, Wc]]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +invfreq + + +# name: +# type: sq_string +# elements: 1 +# length: 1687 + usage: [B,A] = invfreq(H,F,nB,nA) + [B,A] = invfreq(H,F,nB,nA,W) + [B,A] = invfreq(H,F,nB,nA,W,[],[],plane) + [B,A] = invfreq(H,F,nB,nA,W,iter,tol,plane) + + Fit filter B(z)/A(z) or B(s)/A(s) to complex frequency response at + frequency points F. A and B are real polynomial coefficients of order + nA and nB respectively. Optionally, the fit-errors can be weighted vs + frequency according to the weights W. Also, the transform plane can be + specified as either 's' for continuous time or 'z' for discrete time. 'z' + is chosen by default. Eventually, Steiglitz-McBride iterations will be + specified by iter and tol. + + H: desired complex frequency response + It is assumed that A and B are real polynomials, hence H is one-sided. + F: vector of frequency samples in radians + nA: order of denominator polynomial A + nB: order of numerator polynomial B + plane='z': F on unit circle (discrete-time spectra, z-plane design) + plane='s': F on jw axis (continuous-time spectra, s-plane design) + H(k) = spectral samples of filter frequency response at points zk, + where zk=exp(sqrt(-1)*F(k)) when plane='z' (F(k) in [0,.5]) + and zk=(sqrt(-1)*F(k)) when plane='s' (F(k) nonnegative) + Example: + [B,A] = butter(12,1/4); + [H,w] = freqz(B,A,128); + [Bh,Ah] = invfreq(H,F,4,4); + Hh = freqz(Bh,Ah); + disp(sprintf('||frequency response error|| = %f',norm(H-Hh))); + + References: J. O. Smith, "Techniques for Digital Filter Design and System + Identification with Application to the Violin, Ph.D. Dissertation, + Elec. Eng. Dept., Stanford University, June 1983, page 50; or, + + http://ccrma.stanford.edu/~jos/filters/FFT_Based_Equation_Error_Method.html + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: [B,A] = invfreq(H,F,nB,nA) + [B,A] = invfreq(H,F,nB,nA,W) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +invfreqs + + +# name: +# type: sq_string +# elements: 1 +# length: 943 + Usage: [B,A] = invfreqs(H,F,nB,nA) + [B,A] = invfreqs(H,F,nB,nA,W) + [B,A] = invfreqs(H,F,nB,nA,W,iter,tol,'trace') + + Fit filter B(s)/A(s)to the complex frequency response H at frequency + points F. A and B are real polynomial coefficients of order nA and nB. + Optionally, the fit-errors can be weighted vs frequency according to + the weights W. + Note: all the guts are in invfreq.m + + H: desired complex frequency response + F: frequency (must be same length as H) + nA: order of the denominator polynomial A + nB: order of the numerator polynomial B + W: vector of weights (must be same length as F) + + Example: + B = [1/2 1]; + A = [1 1]; + w = linspace(0,4,128); + H = freqs(B,A,w); + [Bh,Ah] = invfreqs(H,w,1,1); + Hh = freqs(Bh,Ah,w); + plot(w,[abs(H);abs(Hh)]) + legend('Original','Measured'); + err = norm(H-Hh); + disp(sprintf('L2 norm of frequency response error = %f',err)); + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Usage: [B,A] = invfreqs(H,F,nB,nA) + [B,A] = invfreqs(H,F,nB,nA,W) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +invfreqz + + +# name: +# type: sq_string +# elements: 1 +# length: 819 + usage: [B,A] = invfreqz(H,F,nB,nA) + [B,A] = invfreqz(H,F,nB,nA,W) + [B,A] = invfreqz(H,F,nB,nA,W,iter,tol,'trace') + + Fit filter B(z)/A(z)to the complex frequency response H at frequency + points F. A and B are real polynomial coefficients of order nA and nB. + Optionally, the fit-errors can be weighted vs frequency according to + the weights W. + Note: all the guts are in invfreq.m + + H: desired complex frequency response + F: normalized frequncy (0 to pi) (must be same length as H) + nA: order of the denominator polynomial A + nB: order of the numerator polynomial B + W: vector of weights (must be same length as F) + + Example: + [B,A] = butter(4,1/4); + [H,F] = freqz(B,A); + [Bh,Ah] = invfreq(H,F,4,4); + Hh = freqz(Bh,Ah); + disp(sprintf('||frequency response error|| = %f',norm(H-Hh))); + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: [B,A] = invfreqz(H,F,nB,nA) + [B,A] = invfreqz(H,F,nB,nA,W) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +invimpinvar + + +# name: +# type: sq_string +# elements: 1 +# length: 823 + -- Function File: [B_OUT, A_OUT] = invimpinvar (B, A, FS, TOL) + -- Function File: [B_OUT, A_OUT] = invimpinvar (B, A, FS) + -- Function File: [B_OUT, A_OUT] = invimpinvar (B, A) + Converts digital filter with coefficients B and A to analog, + conserving impulse response. + + This function does the inverse of impinvar so that the following + example should restore the original values of A and B. + [b, a] = impinvar (b, a); + [b, a] = invimpinvar (b, a); + + If FS is not specificied, or is an empty vector, it defaults to + 1Hz. + + If TOL is not specified, it defaults to 0.0001 (0.1%) + + Reference: Thomas J. Cavicchi (1996) "Impulse invariance and + multiple-order poles". IEEE transactions on signal processing, Vol + 40 (9): 2344-2347 + + See also: bilinear, impinvar + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Converts digital filter with coefficients B and A to analog, conserving +impulse + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +kaiser + + +# name: +# type: sq_string +# elements: 1 +# length: 454 + usage: kaiser (L, beta) + + Returns the filter coefficients of the L-point Kaiser window with + parameter beta. + + For the definition of the Kaiser window, see A. V. Oppenheim & + R. W. Schafer, "Discrete-Time Signal Processing". + + The continuous version of width L centered about x=0 is: + + besseli(0, beta * sqrt(1-(2*x/L).^2)) + k(x) = -------------------------------------, L/2 <= x <= L/2 + besseli(0, beta) + + See also: kaiserord + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 + usage: kaiser (L, beta) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +kaiserord + + +# name: +# type: sq_string +# elements: 1 +# length: 1809 + usage: [n, Wn, beta, ftype] = kaiserord(f, m, dev [, fs]) + + Returns the parameters needed for fir1 to produce a filter of the + desired specification from a kaiser window: + n: order of the filter (length of filter minus 1) + Wn: band edges for use in fir1 + beta: parameter for kaiser window of length n+1 + ftype: choose between pass and stop bands + b = fir1(n,Wn,kaiser(n+1,beta),ftype,'noscale'); + + f: frequency bands, given as pairs, with the first half of the + first pair assumed to start at 0 and the last half of the last + pair assumed to end at 1. It is important to separate the + band edges, since narrow transition regions require large order + filters. + m: magnitude within each band. Should be non-zero for pass band + and zero for stop band. All passbands must have the same + magnitude, or you will get the error that pass and stop bands + must be strictly alternating. + dev: deviation within each band. Since all bands in the resulting + filter have the same deviation, only the minimum deviation is + used. In this version, a single scalar will work just as well. + fs: sampling rate. Used to convert the frequency specification into + the [0, 1], where 1 corresponds to the Nyquist frequency, fs/2. + + The Kaiser window parameters n and beta are computed from the + relation between ripple (A=-20*log10(dev)) and transition width + (dw in radians) discovered empirically by Kaiser: + + / 0.1102(A-8.7) A > 50 + beta = | 0.5842(A-21)^0.4 + 0.07886(A-21) 21 <= A <= 50 + \ 0.0 A < 21 + + n = (A-8)/(2.285 dw) + + Example + [n, w, beta, ftype] = kaiserord([1000,1200], [1,0], [0.05,0.05], 11025); + freqz(fir1(n,w,kaiser(n+1,beta),ftype,'noscale'),1,[],11025); + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 + usage: [n, Wn, beta, ftype] = kaiserord(f, m, dev [, fs]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +levinson + + +# name: +# type: sq_string +# elements: 1 +# length: 818 + usage: [a, v, ref] = levinson (acf [, p]) + + Use the Durbin-Levinson algorithm to solve: + toeplitz(acf(1:p)) * x = -acf(2:p+1). + The solution [1, x'] is the denominator of an all pole filter + approximation to the signal x which generated the autocorrelation + function acf. + + acf is the autocorrelation function for lags 0 to p. + p defaults to length(acf)-1. + Returns + a=[1, x'] the denominator filter coefficients. + v= variance of the white noise = square of the numerator constant + ref = reflection coefficients = coefficients of the lattice + implementation of the filter + Use freqz(sqrt(v),a) to plot the power spectrum. + + REFERENCE + [1] Steven M. Kay and Stanley Lawrence Marple Jr.: + "Spectrum analysis -- a modern perspective", + Proceedings of the IEEE, Vol 69, pp 1380-1419, Nov., 1981 + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 + usage: [a, v, ref] = levinson (acf [, p]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +marcumq + + +# name: +# type: sq_string +# elements: 1 +# length: 963 + -- Function File: Q = marcumq (A, B) + -- Function File: Q = marcumq (A, B, M) + -- Function File: Q = marcumq (A, B, M, TOL) + Compute the generalized Marcum Q function of order M with + noncentrality parameter A and argument B. If the order M is + omitted it defaults to 1. An optional relative tolerance TOL may + be included, the default is `eps'. + + If the input arguments are commensurate vectors, this function + will produce a table of values. + + This function computes Marcum's Q function using the infinite + Bessel series, truncated when the relative error is less than the + specified tolerance. The accuracy is limited by that of the + Bessel functions, so reducing the tolerance is probably not useful. + + Reference: Marcum, "Tables of Q Functions", Rand Corporation. + + Reference: R.T. Short, "Computation of Noncentral Chi-squared and + Rice Random Variables", www.phaselockedsystems.com/publications + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the generalized Marcum Q function of order M with noncentrality +paramete + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +mexihat + + +# name: +# type: sq_string +# elements: 1 +# length: 85 + -- Function File: [PSI,X] = mexihat(LB,UB,N) + Compute the Mexican hat wavelet. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 +Compute the Mexican hat wavelet. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +meyeraux + + +# name: +# type: sq_string +# elements: 1 +# length: 89 + -- Function File: [Y] = meyeraux(X) + Compute the Meyer wavelet auxiliary function. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Compute the Meyer wavelet auxiliary function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +morlet + + +# name: +# type: sq_string +# elements: 1 +# length: 79 + -- Function File: [PSI,X] = morlet(LB,UB,N) + Compute the Morlet wavelet. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 +Compute the Morlet wavelet. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +mscohere + + +# name: +# type: sq_string +# elements: 1 +# length: 270 + Usage: + [Pxx,freq]=mscohere(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) + + Estimate (mean square) coherence of signals "x" and "y". + Use the Welch (1967) periodogram/FFT method. + See "help pwelch" for description of arguments, hints and references + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Usage: + [Pxx,freq]=mscohere(x,y,Nfft,Fs,window,overlap,range,plot_type,detren + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ncauer + + +# name: +# type: sq_string +# elements: 1 +# length: 383 + usage: [Zz, Zp, Zg] = ncauer(Rp, Rs, n) + + Analog prototype for Cauer filter. + [z, p, g]=ncauer(Rp, Rs, ws) + Rp = Passband ripple + Rs = Stopband ripple + Ws = Desired order + + References: + + - Serra, Celso Penteado, Teoria e Projeto de Filtros, Campinas: CARTGRAF, + 1983. + - Lamar, Marcus Vinicius, Notas de aula da disciplina TE 456 - Circuitos + Analogicos II, UFPR, 2001/2002. + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 + usage: [Zz, Zp, Zg] = ncauer(Rp, Rs, n) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +nuttallwin + + +# name: +# type: sq_string +# elements: 1 +# length: 154 + -- Function File: [W] = nuttallwin(L) + Compute the Blackman-Harris window defined by Nuttall of length L. + + See also: blackman, blackmanharris + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +Compute the Blackman-Harris window defined by Nuttall of length L. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +parzenwin + + +# name: +# type: sq_string +# elements: 1 +# length: 118 + -- Function File: [W] = parzenwin(L) + Compute the Parzen window of lenght L. + + See also: rectwin, bartlett + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 +Compute the Parzen window of lenght L. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +pburg + + +# name: +# type: sq_string +# elements: 1 +# length: 3783 + usage: + [psd,f_out] = pburg(x,poles,freq,Fs,range,method,plot_type,criterion) + + Calculate Burg maximum-entropy power spectral density. + The functions "arburg" and "ar_psd" do all the work. + See "help arburg" and "help ar_psd" for further details. + + ARGUMENTS: + All but the first two arguments are optional and may be empty. + x %% [vector] sampled data + + poles %% [integer scalar] required number of poles of the AR model + + freq %% [real vector] frequencies at which power spectral density + %% is calculated + %% [integer scalar] number of uniformly distributed frequency + %% values at which spectral density is calculated. + %% [default=256] + + Fs %% [real scalar] sampling frequency (Hertz) [default=1] + + + CONTROL-STRING ARGUMENTS -- each of these arguments is a character string. + Control-string arguments can be in any order after the other arguments. + + + range %% 'half', 'onesided' : frequency range of the spectrum is + %% from zero up to but not including sample_f/2. Power + %% from negative frequencies is added to the positive + %% side of the spectrum. + %% 'whole', 'twosided' : frequency range of the spectrum is + %% -sample_f/2 to sample_f/2, with negative frequencies + %% stored in "wrap around" order after the positive + %% frequencies; e.g. frequencies for a 10-point 'twosided' + %% spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 + %% 'shift', 'centerdc' : same as 'whole' but with the first half + %% of the spectrum swapped with second half to put the + %% zero-frequency value in the middle. (See "help + %% fftshift". If "freq" is vector, 'shift' is ignored. + %% If model coefficients "ar_coeffs" are real, the default + %% range is 'half', otherwise default range is 'whole'. + + method %% 'fft': use FFT to calculate power spectral density. + %% 'poly': calculate spectral density as a polynomial of 1/z + %% N.B. this argument is ignored if the "freq" argument is a + %% vector. The default is 'poly' unless the "freq" + %% argument is an integer power of 2. + + plot_type %% 'plot', 'semilogx', 'semilogy', 'loglog', 'squared' or 'db': + %% specifies the type of plot. The default is 'plot', which + %% means linear-linear axes. 'squared' is the same as 'plot'. + %% 'dB' plots "10*log10(psd)". This argument is ignored and a + %% spectrum is not plotted if the caller requires a returned + %% value. + + criterion %% [optional string arg] model-selection criterion. Limits + %% the number of poles so that spurious poles are not + %% added when the whitened data has no more information + %% in it (see Kay & Marple, 1981). Recognised values are + %% 'AKICc' -- approximate corrected Kullback information + %% criterion (recommended), + %% 'KIC' -- Kullback information criterion + %% 'AICc' -- corrected Akaike information criterion + %% 'AIC' -- Akaike information criterion + %% 'FPE' -- final prediction error" criterion + %% The default is to NOT use a model-selection criterion + + RETURNED VALUES: + If return values are not required by the caller, the spectrum + is plotted and nothing is returned. + psd %% [real vector] power-spectral density estimate + f_out %% [real vector] frequency values + + HINTS + This function is a wrapper for arburg and ar_psd. + See "help arburg", "help ar_psd". + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: + [psd,f_out] = pburg(x,poles,freq,Fs,range,method,plot_type,criterion + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +pei_tseng_notch + + +# name: +# type: sq_string +# elements: 1 +# length: 707 + -- Function File: [ B, A ] = pei_tseng_notch ( FREQUENCIES, + BANDWIDTHS + Return coefficients for an IIR notch-filter with one or more + filter frequencies and according (very narrow) bandwidths to be + used with `filter' or `filtfilt'. The filter construction is + based on an allpass which performs a reversal of phase at the + filter frequencies. Thus, the mean of the phase-distorted and the + original signal has the respective frequencies removed. See the + demo for an illustration. + + Original source: Pei, Soo-Chang, and Chien-Cheng Tseng "IIR + Multiple Notch Filter Design Based on Allpass Filter" 1996 IEEE + Tencon doi: 10.1109/TENCON.1996.608814) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return coefficients for an IIR notch-filter with one or more filter +frequencies + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +polystab + + +# name: +# type: sq_string +# elements: 1 +# length: 156 + b = polystab(a) + + Stabalize the polynomial transfer function by replacing all roots + outside the unit circle with their reflection inside the unit circle. + + + +# name: +# type: sq_string +# elements: 1 +# length: 17 + b = polystab(a) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +pulstran + + +# name: +# type: sq_string +# elements: 1 +# length: 1187 + usage: y=pulstran(t,d,'func',...) + y=pulstran(t,d,p,Fs,'interp') + + Generate the signal y=sum(func(t+d,...)) for each d. If d is a + matrix of two columns, the first column is the delay d and the second + column is the amplitude a, and y=sum(a*func(t+d)) for each d,a. + Clearly, func must be a function which accepts a vector of times. + Any extra arguments needed for the function must be tagged on the end. + + Example + fs = 11025; # arbitrary sample rate + f0 = 100; # pulse train sample rate + w = 0.001; # pulse width of 1 millisecond + auplot(pulstran(0:1/fs:0.1, 0:1/f0:0.1, 'rectpuls', w), fs); + + If instead of a function name you supply a pulse shape sampled at + frequency Fs (default 1 Hz), an interpolated version of the pulse + is added at each delay d. The interpolation stays within the the + time range of the delayed pulse. The interpolation method defaults + to linear, but it can be any interpolation method accepted by the + function interp1. + + Example + fs = 11025; # arbitrary sample rate + f0 = 100; # pulse train sample rate + w = boxcar(10); # pulse width of 1 millisecond at 10 kHz + auplot(pulstran(0:1/fs:0.1, 0:1/f0:0.1, w, 10000), fs); + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 + usage: y=pulstran(t,d,'func',. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +pwelch + + +# name: +# type: sq_string +# elements: 1 +# length: 7140 + USAGE: + [spectra,freq] = pwelch(x,window,overlap,Nfft,Fs, + range,plot_type,detrend,sloppy) + Estimate power spectral density of data "x" by the Welch (1967) + periodogram/FFT method. All arguments except "x" are optional. + The data is divided into segments. If "window" is a vector, each + segment has the same length as "window" and is multiplied by "window" + before (optional) zero-padding and calculation of its periodogram. If + "window" is a scalar, each segment has a length of "window" and a + Hamming window is used. + The spectral density is the mean of the periodograms, scaled so that + area under the spectrum is the same as the mean square of the + data. This equivalence is supposed to be exact, but in practice there + is a mismatch of up to 0.5% when comparing area under a periodogram + with the mean square of the data. + + [spectra,freq] = pwelch(x,y,window,overlap,Nfft,Fs, + range,plot_type,detrend,sloppy,results) + Two-channel spectrum analyser. Estimate power spectral density, cross- + spectral density, transfer function and/or coherence functions of time- + series input data "x" and output data "y" by the Welch (1967) + periodogram/FFT method. + pwelch treats the second argument as "y" if there is a control-string + argument "cross", "trans", "coher" or "ypower"; "power" does not force + the 2nd argument to be treated as "y". All other arguments are + optional. All spectra are returned in matrix "spectra". + + [spectra,Pxx_ci,freq] = pwelch(x,window,overlap,Nfft,Fs,conf, + range,plot_type,detrend,sloppy) + [spectra,Pxx_ci,freq] = pwelch(x,y,window,overlap,Nfft,Fs,conf, + range,plot_type,detrend,sloppy,results) + Estimates confidence intervals for the spectral density. + See Hint (7) below for compatibility options. Confidence level "conf" + is the 6th or 7th numeric argument. If "results" control-string + arguments are used, one of them must be "power" when the "conf" + argument is present; pwelch can estimate confidence intervals only for + the power spectrum of the "x" data. It does not know how to estimate + confidence intervals of the cross-power spectrum, transfer function or + coherence; if you can suggest a good method, please send a bug report. + + ARGUMENTS + All but the first argument are optional and may be empty, except that + the "results" argument may require the second argument to be "y". + + x %% [non-empty vector] system-input time-series data + y %% [non-empty vector] system-output time-series data + + window %% [real vector] of window-function values between 0 and 1; the + %% data segment has the same length as the window. + %% Default window shape is Hamming. + %% [integer scalar] length of each data segment. The default + %% value is window=sqrt(length(x)) rounded up to the + %% nearest integer power of 2; see 'sloppy' argument. + + overlap %% [real scalar] segment overlap expressed as a multiple of + %% window or segment length. 0 <= overlap < 1, + %% The default is overlap=0.5 . + + Nfft %% [integer scalar] Length of FFT. The default is the length + %% of the "window" vector or has the same value as the + %% scalar "window" argument. If Nfft is larger than the + %% segment length, "seg_len", the data segment is padded + %% with "Nfft-seg_len" zeros. The default is no padding. + %% Nfft values smaller than the length of the data + %% segment (or window) are ignored silently. + + Fs %% [real scalar] sampling frequency (Hertz); default=1.0 + + conf %% [real scalar] confidence level between 0 and 1. Confidence + %% intervals of the spectral density are estimated from + %% scatter in the periodograms and are returned as Pxx_ci. + %% Pxx_ci(:,1) is the lower bound of the confidence + %% interval and Pxx_ci(:,2) is the upper bound. If there + %% are three return values, or conf is an empty matrix, + %% confidence intervals are calculated for conf=0.95 . + %% If conf is zero or is not given, confidence intervals + %% are not calculated. Confidence intervals can be + %% obtained only for the power spectral density of x; + %% nothing else. + + CONTROL-STRING ARGUMENTS -- each of these arguments is a character string. + Control-string arguments must be after the other arguments but can be in + any order. + + range %% 'half', 'onesided' : frequency range of the spectrum is + %% zero up to but not including Fs/2. Power from + %% negative frequencies is added to the positive side of + %% the spectrum, but not at zero or Nyquist (Fs/2) + %% frequencies. This keeps power equal in time and + %% spectral domains. See reference [2]. + %% 'whole', 'twosided' : frequency range of the spectrum is + %% -Fs/2 to Fs/2, with negative frequencies + %% stored in "wrap around" order after the positive + %% frequencies; e.g. frequencies for a 10-point 'twosided' + %% spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 + %% 'shift', 'centerdc' : same as 'whole' but with the first half + %% of the spectrum swapped with second half to put the + %% zero-frequency value in the middle. (See "help + %% fftshift". + %% If data (x and y) are real, the default range is 'half', + %% otherwise default range is 'whole'. + + plot_type %% 'plot', 'semilogx', 'semilogy', 'loglog', 'squared' or 'db': + %% specifies the type of plot. The default is 'plot', which + %% means linear-linear axes. 'squared' is the same as 'plot'. + %% 'dB' plots "10*log10(psd)". This argument is ignored and a + %% spectrum is not plotted if the caller requires a returned + %% value. + + detrend %% 'no-strip', 'none' -- do NOT remove mean value from the data + %% 'short', 'mean' -- remove the mean value of each segment from + %% each segment of the data. + %% 'linear', -- remove linear trend from each segment of + %% the data. + %% 'long-mean' -- remove the mean value from the data before + %% splitting it into segments. This is the default. + + sloppy %% 'sloppy': FFT length is rounded up to the nearest integer + %% power of 2 by zero padding. FFT length is adjusted + %% after addition of padding by explicit Nfft argument. + %% The default is to use exactly the FFT and window/ + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + USAGE: + [spectra,freq] = pwelch(x,window,overlap,Nfft,Fs, + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +pyulear + + +# name: +# type: sq_string +# elements: 1 +# length: 3140 + usage: + [psd,f_out] = pyulear(x,poles,freq,Fs,range,method,plot_type) + + Calculates a Yule-Walker autoregressive (all-pole) model of the data "x" + and computes the power spectrum of the model. This is a wrapper for + functions "aryule" and "ar_psd" which perform the argument checking. + See "help aryule" and "help ar_psd" for further details. + + ARGUMENTS: + All but the first two arguments are optional and may be empty. + x %% [vector] sampled data + + poles %% [integer scalar] required number of poles of the AR model + + freq %% [real vector] frequencies at which power spectral density + %% is calculated + %% [integer scalar] number of uniformly distributed frequency + %% values at which spectral density is calculated. + %% [default=256] + + Fs %% [real scalar] sampling frequency (Hertz) [default=1] + + + CONTROL-STRING ARGUMENTS -- each of these arguments is a character string. + Control-string arguments can be in any order after the other arguments. + + + range %% 'half', 'onesided' : frequency range of the spectrum is + %% from zero up to but not including sample_f/2. Power + %% from negative frequencies is added to the positive + %% side of the spectrum. + %% 'whole', 'twosided' : frequency range of the spectrum is + %% -sample_f/2 to sample_f/2, with negative frequencies + %% stored in "wrap around" order after the positive + %% frequencies; e.g. frequencies for a 10-point 'twosided' + %% spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 + %% 'shift', 'centerdc' : same as 'whole' but with the first half + %% of the spectrum swapped with second half to put the + %% zero-frequency value in the middle. (See "help + %% fftshift". If "freq" is vector, 'shift' is ignored. + %% If model coefficients "ar_coeffs" are real, the default + %% range is 'half', otherwise default range is 'whole'. + + method %% 'fft': use FFT to calculate power spectrum. + %% 'poly': calculate power spectrum as a polynomial of 1/z + %% N.B. this argument is ignored if the "freq" argument is a + %% vector. The default is 'poly' unless the "freq" + %% argument is an integer power of 2. + + plot_type %% 'plot', 'semilogx', 'semilogy', 'loglog', 'squared' or 'db': + %% specifies the type of plot. The default is 'plot', which + %% means linear-linear axes. 'squared' is the same as 'plot'. + %% 'dB' plots "10*log10(psd)". This argument is ignored and a + %% spectrum is not plotted if the caller requires a returned + %% value. + + RETURNED VALUES: + If return values are not required by the caller, the spectrum + is plotted and nothing is returned. + psd %% [real vector] power-spectrum estimate + f_out %% [real vector] frequency values + + HINTS + This function is a wrapper for aryule and ar_psd. + See "help aryule", "help ar_psd". + + + +# name: +# type: sq_string +# elements: 1 +# length: 74 + usage: + [psd,f_out] = pyulear(x,poles,freq,Fs,range,method,plot_type) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +qp_kaiser + + +# name: +# type: sq_string +# elements: 1 +# length: 602 + Usage: qp_kaiser (nb, at, linear) + + Computes a finite impulse response (FIR) filter for use with a + quasi-perfect reconstruction polyphase-network filter bank. This + version utilizes a Kaiser window to shape the frequency response of + the designed filter. Tha number nb of bands and the desired + attenuation at in the stop-band are given as parameters. + + The Kaiser window is multiplied by the ideal impulse response + h(n)=a.sinc(a.n) and converted to its minimum-phase version by means + of a Hilbert transform. + + By using a third non-null argument, the minimum-phase calculation is + ommited at all. + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 + Usage: qp_kaiser (nb, at, linear) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +rceps + + +# name: +# type: sq_string +# elements: 1 +# length: 693 + usage: [y, xm] = rceps(x) + Produce the cepstrum of the signal x, and if desired, the minimum + phase reconstruction of the signal x. If x is a matrix, do so + for each column of the matrix. + + Example + f0=70; Fs=10000; # 100 Hz fundamental, 10kHz sampling rate + a=poly(0.985*exp(1i*pi*[0.1, -0.1, 0.3, -0.3])); # two formants + s=0.005*randn(1024,1); # Noise excitation signal + s(1:Fs/f0:length(s)) = 1; # Impulse glottal wave + x=filter(1,a,s); # Speech signal in x + [y, xm] = rceps(x.*hanning(1024)); # cepstrum and min phase reconstruction + + Reference + Programs for digital signal processing. IEEE Press. + New York: John Wiley & Sons. 1979. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + usage: [y, xm] = rceps(x) + Produce the cepstrum of the signal x, and if desir + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +rectpuls + + +# name: +# type: sq_string +# elements: 1 +# length: 429 + usage: y = rectpuls(t, w) + + Generate a rectangular pulse over the interval [-w/2,w/2), sampled at + times t. This is useful with the function pulstran for generating a + series pulses. + + Example + fs = 11025; # arbitrary sample rate + f0 = 100; # pulse train sample rate + w = 0.3/f0; # pulse width 3/10th the distance between pulses + auplot(pulstran(0:1/fs:4/f0, 0:1/f0:4/f0, 'rectpuls', w), fs); + + See also: pulstran + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 + usage: y = rectpuls(t, w) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +rectwin + + +# name: +# type: sq_string +# elements: 1 +# length: 142 + -- Function File: [W] = rectwin(L) + Return the filter coefficients of a rectangle window of length L. + + See also: hamming, hanning + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 +Return the filter coefficients of a rectangle window of length L. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +resample + + +# name: +# type: sq_string +# elements: 1 +# length: 637 + -- Function File: [Y H]= resample(X,P,Q) + -- Function File: Y = resample(X,P,Q,H) + Change the sample rate of X by a factor of P/Q. This is performed + using a polyphase algorithm. The impulse response H of the + antialiasing filter is either specified or either designed with a + Kaiser-windowed sinecard. + + Ref [1] J. G. Proakis and D. G. Manolakis, Digital Signal + Processing: Principles, Algorithms, and Applications, 4th ed., + Prentice Hall, 2007. Chap. 6 + + Ref [2] A. V. Oppenheim, R. W. Schafer and J. R. Buck, + Discrete-time signal processing, Signal processing series, + Prentice-Hall, 1999 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Change the sample rate of X by a factor of P/Q. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +residued + + +# name: +# type: sq_string +# elements: 1 +# length: 1061 + -- Function File: [R, P, F, M] = residued (B, A) + Compute the partial fraction expansion (PFE) of filter H(z) = + B(z)/A(z). In the usual PFE function `residuez', the IIR part + (poles P and residues R) is driven _in parallel_ with the FIR part + (F). In this variant (`residued') the IIR part is driven by the + _output_ of the FIR part. This structure can be more accurate in + signal modeling applications. + + INPUTS: B and A are vectors specifying the digital filter H(z) = + B(z)/A(z). Say `help filter' for documentation of the B and A + filter coefficients. + + RETURNED: + * R = column vector containing the filter-pole residues + * P = column vector containing the filter poles + * F = row vector containing the FIR part, if any + * M = column vector of pole multiplicities + + EXAMPLES: + Say `test residued verbose' to see a number of examples. + + For the theory of operation, see + + + See also: residue residued + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 +Compute the partial fraction expansion (PFE) of filter H(z) = B(z)/A(z). + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +residuez + + +# name: +# type: sq_string +# elements: 1 +# length: 750 + -- Function File: [R, P, F, M] = residuez (B, A) + Compute the partial fraction expansion of filter H(z) = B(z)/A(z). + + INPUTS: B and A are vectors specifying the digital filter H(z) = + B(z)/A(z). Say `help filter' for documentation of the B and A + filter coefficients. + + RETURNED: + * R = column vector containing the filter-pole residues + * P = column vector containing the filter poles + * F = row vector containing the FIR part, if any + * M = column vector of pole multiplicities + + EXAMPLES: + Say `test residuez verbose' to see a number of examples. + + For the theory of operation, see + + + See also: residue residued + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +Compute the partial fraction expansion of filter H(z) = B(z)/A(z). + + + +# name: +# type: sq_string +# elements: 1 +# length: 18 +sampled2continuous + + +# name: +# type: sq_string +# elements: 1 +# length: 402 + Usage: + + xt = sampled2continuous( xn , T, t ) + + Calculate the x(t) reconstructed + from samples x[n] sampled at a rate 1/T samples + per unit time. + + t is all the instants of time when you need x(t) + from x[n]; this time is relative to x[0] and not + an absolute time. + + This function can be used to calculate sampling rate + effects on aliasing, actual signal reconstruction + from discrete samples. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Usage: + + xt = sampled2continuous( xn , T, t ) + + Calculate the x(t) reconstruc + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +sawtooth + + +# name: +# type: sq_string +# elements: 1 +# length: 664 + -- Function File: [Y] = sawtooth(T) + -- Function File: [Y] = sawtooth(T,WIDTH) + Generates a sawtooth wave of period `2 * pi' with limits `+1/-1' + for the elements of T. + + WIDTH is a real number between `0' and `1' which specifies the + point between `0' and `2 * pi' where the maximum is. The function + increases linearly from `-1' to `1' in `[0, 2 * pi * WIDTH]' + interval, and decreases linearly from `1' to `-1' in the interval + `[2 * pi * WIDTH, 2 * pi]'. + + If WIDTH is 0.5, the function generates a standard triangular wave. + + If WIDTH is not specified, it takes a value of 1, which is a + standard sawtooth function. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Generates a sawtooth wave of period `2 * pi' with limits `+1/-1' for +the elemen + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +sftrans + + +# name: +# type: sq_string +# elements: 1 +# length: 3640 + usage: [Sz, Sp, Sg] = sftrans(Sz, Sp, Sg, W, stop) + + Transform band edges of a generic lowpass filter (cutoff at W=1) + represented in splane zero-pole-gain form. W is the edge of the + target filter (or edges if band pass or band stop). Stop is true for + high pass and band stop filters or false for low pass and band pass + filters. Filter edges are specified in radians, from 0 to pi (the + nyquist frequency). + + Theory: Given a low pass filter represented by poles and zeros in the + splane, you can convert it to a low pass, high pass, band pass or + band stop by transforming each of the poles and zeros individually. + The following table summarizes the transformation: + + Transform Zero at x Pole at x + ---------------- ------------------------- ------------------------ + Low Pass zero: Fc x/C pole: Fc x/C + S -> C S/Fc gain: C/Fc gain: Fc/C + ---------------- ------------------------- ------------------------ + High Pass zero: Fc C/x pole: Fc C/x + S -> C Fc/S pole: 0 zero: 0 + gain: -x gain: -1/x + ---------------- ------------------------- ------------------------ + Band Pass zero: b ± sqrt(b^2-FhFl) pole: b ± sqrt(b^2-FhFl) + S^2+FhFl pole: 0 zero: 0 + S -> C -------- gain: C/(Fh-Fl) gain: (Fh-Fl)/C + S(Fh-Fl) b=x/C (Fh-Fl)/2 b=x/C (Fh-Fl)/2 + ---------------- ------------------------- ------------------------ + Band Stop zero: b ± sqrt(b^2-FhFl) pole: b ± sqrt(b^2-FhFl) + S(Fh-Fl) pole: ±sqrt(-FhFl) zero: ±sqrt(-FhFl) + S -> C -------- gain: -x gain: -1/x + S^2+FhFl b=C/x (Fh-Fl)/2 b=C/x (Fh-Fl)/2 + ---------------- ------------------------- ------------------------ + Bilinear zero: (2+xT)/(2-xT) pole: (2+xT)/(2-xT) + 2 z-1 pole: -1 zero: -1 + S -> - --- gain: (2-xT)/T gain: (2-xT)/T + T z+1 + ---------------- ------------------------- ------------------------ + + where C is the cutoff frequency of the initial lowpass filter, Fc is + the edge of the target low/high pass filter and [Fl,Fh] are the edges + of the target band pass/stop filter. With abundant tedious algebra, + you can derive the above formulae yourself by substituting the + transform for S into H(S)=S-x for a zero at x or H(S)=1/(S-x) for a + pole at x, and converting the result into the form: + + H(S)=g prod(S-Xi)/prod(S-Xj) + + The transforms are from the references. The actual pole-zero-gain + changes I derived myself. + + Please note that a pole and a zero at the same place exactly cancel. + This is significant for High Pass, Band Pass and Band Stop filters + which create numerous extra poles and zeros, most of which cancel. + Those which do not cancel have a "fill-in" effect, extending the + shorter of the sets to have the same number of as the longer of the + sets of poles and zeros (or at least split the difference in the case + of the band pass filter). There may be other opportunistic + cancellations but I will not check for them. + + Also note that any pole on the unit circle or beyond will result in + an unstable filter. Because of cancellation, this will only happen + if the number of poles is smaller than the number of zeros and the + filter is high pass or band pass. The analytic design methods all + yield more poles than zeros, so this will not be a problem. + + References: + + Proakis & Manolakis (1992). Digital Signal Processing. New York: + Macmillan Publishing Company. + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 + usage: [Sz, Sp, Sg] = sftrans(Sz, Sp, Sg, W, stop) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +sgolay + + +# name: +# type: sq_string +# elements: 1 +# length: 1079 + F = sgolay (p, n [, m [, ts]]) + Computes the filter coefficients for all Savitzsky-Golay smoothing + filters of order p for length n (odd). m can be used in order to + get directly the mth derivative. In this case, ts is a scaling factor. + + The early rows of F smooth based on future values and later rows + smooth based on past values, with the middle row using half future + and half past. In particular, you can use row i to estimate x(k) + based on the i-1 preceding values and the n-i following values of x + values as y(k) = F(i,:) * x(k-i+1:k+n-i). + + Normally, you would apply the first (n-1)/2 rows to the first k + points of the vector, the last k rows to the last k points of the + vector and middle row to the remainder, but for example if you were + running on a realtime system where you wanted to smooth based on the + all the data collected up to the current time, with a lag of five + samples, you could apply just the filter on row n-5 to your window + of length n each time you added a new sample. + + Reference: Numerical recipes in C. p 650 + + See also: sgolayfilt + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + F = sgolay (p, n [, m [, ts]]) + Computes the filter coefficients for all Savi + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +sgolayfilt + + +# name: +# type: sq_string +# elements: 1 +# length: 857 + y = sgolayfilt (x, p, n [, m [, ts]]) + Smooth the data in x with a Savitsky-Golay smoothing filter of + polynomial order p and length n, n odd, n > p. By default, p=3 + and n=p+2 or n=p+3 if p is even. + + y = sgolayfilt (x, F) + Smooth the data in x with smoothing filter F computed by sgolay. + + These filters are particularly good at preserving lineshape while + removing high frequency squiggles. Particularly, compare a 5 sample + averager, an order 5 butterworth lowpass filter (cutoff 1/3) and + sgolayfilt(x, 3, 5), the best cubic estimated from 5 points: + + [b, a] = butter(5,1/3); + x=[zeros(1,15), 10*ones(1,10), zeros(1,15)]; + plot(sgolayfilt(x),"r;sgolayfilt;",... + filtfilt(ones(1,5)/5,1,x),"g;5 sample average;",... + filtfilt(b,a,x),"c;order 5 butterworth;",... + x,"+b;original data;"); + + See also: sgolay + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + y = sgolayfilt (x, p, n [, m [, ts]]) + Smooth the data in x with a Savitsky- + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +shanwavf + + +# name: +# type: sq_string +# elements: 1 +# length: 97 + -- Function File: [PSI,X] = shanwavf (LB,UB,N,FB,FC) + Compute the Complex Shannon wavelet. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Compute the Complex Shannon wavelet. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +sigmoid_train + + +# name: +# type: sq_string +# elements: 1 +# length: 555 + -- Function File: Y = sigmoid_train(T, RANGES, RC) + Evaluates a train of sigmoid functions at T. + + The number and duration of each sigmoid is determined from RANGES. + Each row of RANGES represents a real interval, e.g. if sigmod `i' + starts at `t=0.1' and ends at `t=0.5', then `RANGES(i,:) = [0.1 + 0.5]'. The input RC is a array that defines the rising and + falling time constants of each sigmoids. Its size must equal the + size of RANGES. + + Run `demo sigmoid_train' to some examples of the use of this + function. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 +Evaluates a train of sigmoid functions at T. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +sos2tf + + +# name: +# type: sq_string +# elements: 1 +# length: 808 + -- Function File: [B, A] = sos2tf (SOS, BSCALE) + Convert series second-order sections to direct form H(z) = + B(z)/A(z). + + INPUTS: + * SOS = matrix of series second-order sections, one per row: + SOS = [B1.' A1.'; ...; BN.' AN.'], where + `B1.'==[b0 b1 b2] and A1.'==[1 a1 a2]' for section 1, etc. + b0 must be nonzero for each section. + See `filter()' for documentation of the second-order + direct-form filter coefficients Bi and Ai. + + * BSCALE is an overall gain factor that effectively scales the + output B vector (or any one of the input Bi vectors). + + RETURNED: B and A are vectors specifying the digital filter H(z) = + B(z)/A(z). See `filter()' for further details. + + See also: tf2sos zp2sos sos2pz zp2tf tf2zp + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 +Convert series second-order sections to direct form H(z) = B(z)/A(z). + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +sos2zp + + +# name: +# type: sq_string +# elements: 1 +# length: 1009 + -- Function File: [Z, P, G] = sos2zp (SOS, BSCALE) + Convert series second-order sections to zeros, poles, and gains + (pole residues). + + INPUTS: + * SOS = matrix of series second-order sections, one per row: + SOS = [B1.' A1.'; ...; BN.' AN.'], where + `B1.'==[b0 b1 b2] and A1.'==[1 a1 a2]' for section 1, etc. + b0 must be nonzero for each section. See `filter()' for + documentation of the second-order direct-form filter + coefficients Bi and Ai. + + * BSCALE is an overall gain factor that effectively scales any + one of the input Bi vectors. + + RETURNED: + * Z = column-vector containing all zeros (roots of B(z)) + * P = column-vector containing all poles (roots of A(z)) + * G = overall gain = B(Inf) + + EXAMPLE: + [z,p,g] = sos2zp([1 0 1, 1 0 -0.81; 1 0 0, 1 0 0.49]) + => z = [i; -i; 0; 0], p = [0.9, -0.9, 0.7i, -0.7i], g=1 + + See also: zp2sos sos2tf tf2sos zp2tf tf2zp + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Convert series second-order sections to zeros, poles, and gains (pole +residues). + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +specgram + + +# name: +# type: sq_string +# elements: 1 +# length: 4570 + usage: [S [, f [, t]]] = specgram(x [, n [, Fs [, window [, overlap]]]]) + + Generate a spectrogram for the signal. This chops the signal into + overlapping slices, windows each slice and applies a Fourier + transform to determine the frequency components at that slice. + + x: vector of samples + n: size of fourier transform window, or [] for default=256 + Fs: sample rate, or [] for default=2 Hz + window: shape of the fourier transform window, or [] for default=hanning(n) + Note: window length can be specified instead, in which case + window=hanning(length) + overlap: overlap with previous window, or [] for default=length(window)/2 + + Return values + S is complex output of the FFT, one row per slice + f is the frequency indices corresponding to the rows of S. + t is the time indices corresponding to the columns of S. + If no return value is requested, the spectrogram is displayed instead. + + Example + x = chirp([0:0.001:2],0,2,500); # freq. sweep from 0-500 over 2 sec. + Fs=1000; # sampled every 0.001 sec so rate is 1 kHz + step=ceil(20*Fs/1000); # one spectral slice every 20 ms + window=ceil(100*Fs/1000); # 100 ms data window + specgram(x, 2^nextpow2(window), Fs, window, window-step); + + ## 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= minF & f <= maxF); + + Then there is the choice of colormap. A brightness varying colormap + such as copper or bone gives good shape to the ridges and valleys. A + hue varying colormap such as jet or hsv gives an indication of the + steepness of the slopes. The final spectrogram is displayed in log + energy scale and by convention has low frequencies on the bottom of + the image: + + imagesc(t, f, flipud(log(S(idx,:)))); + + + +# name: +# type: sq_string +# elements: 1 +# length: 74 + usage: [S [, f [, t]]] = specgram(x [, n [, Fs [, window [, overlap]]]]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +square + + +# name: +# type: sq_string +# elements: 1 +# length: 379 + -- Function File: S = square(T, DUTY) + -- Function File: S = square(T) + Generate a square wave of period 2 pi with limits +1/-1. + + If DUTY is specified, the square wave is +1 for that portion of + the time. + + on time + duty cycle = ------------------ + on time + off time + + See also: cos, sawtooth, sin, tripuls + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 +Generate a square wave of period 2 pi with limits +1/-1. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ss2tf + + +# name: +# type: sq_string +# elements: 1 +# length: 355 + -- Function File: [NUM, DEN] = ss2tf (A, B, C, D) + Conversion from transfer function to state-space. The state space + system: + . + x = Ax + Bu + y = Cx + Du + + is converted to a transfer function: + + num(s) + G(s)=------- + den(s) + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Conversion from transfer function to state-space. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ss2zp + + +# name: +# type: sq_string +# elements: 1 +# length: 172 + -- Function File: [POL, ZER, K] = ss2zp (A, B, C, D) + Converts a state space representation to a set of poles and zeros; + K is a gain associated with the zeros. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Converts a state space representation to a set of poles and zeros; K is +a gain a + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +tf2sos + + +# name: +# type: sq_string +# elements: 1 +# length: 1051 + -- Function File: [SOS, G] = tf2sos (B, A) + Convert direct-form filter coefficients to series second-order + sections. + + INPUTS: B and A are vectors specifying the digital filter H(z) = + B(z)/A(z). See `filter()' for documentation of the B and A filter + coefficients. + + RETURNED: SOS = matrix of series second-order sections, one per + row: + SOS = [B1.' A1.'; ...; BN.' AN.'], where + `B1.'==[b0 b1 b2] and A1.'==[1 a1 a2]' for section 1, etc. + b0 must be nonzero for each section (zeros at infinity not + supported). BSCALE is an overall gain factor that effectively + scales any one of the Bi vectors. + + EXAMPLE: + B=[1 0 0 0 0 1]; + A=[1 0 0 0 0 .9]; + [sos,g] = tf2sos(B,A) + + sos = + + 1.00000 0.61803 1.00000 1.00000 0.60515 0.95873 + 1.00000 -1.61803 1.00000 1.00000 -1.58430 0.95873 + 1.00000 1.00000 -0.00000 1.00000 0.97915 -0.00000 + + g = 1 + + See also: sos2tf zp2sos sos2pz zp2tf tf2zp + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 72 +Convert direct-form filter coefficients to series second-order sections. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +tf2ss + + +# name: +# type: sq_string +# elements: 1 +# length: 518 + -- Function File: [A, B, C, D] = tf2ss (NUM, DEN) + Conversion from transfer function to state-space. The state space + system: + . + x = Ax + Bu + y = Cx + Du + is obtained from a transfer function: + num(s) + G(s)=------- + den(s) + + The state space system matrices obtained from this function will + be in observable companion form as Wolovich's Observable Structure + Theorem is used. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Conversion from transfer function to state-space. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +tf2zp + + +# name: +# type: sq_string +# elements: 1 +# length: 241 + -- Function File: [ZER, POL, K] = tf2zp (NUM, DEN) + Converts transfer functions to poles-and-zero representations. + + Returns the zeros and poles of the system defined by NUM/DEN. K + is a gain associated with the system zeros. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 +Converts transfer functions to poles-and-zero representations. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +tfe + + +# name: +# type: sq_string +# elements: 1 +# length: 381 + Usage: + [Pxx,freq] = tfe(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) + + Estimate transfer function of system with input "x" and output "y". + Use the Welch (1967) periodogram/FFT method. + Compatible with Matlab R11 tfe and earlier. + See "help pwelch" for description of arguments, hints and references + --- especially hint (7) for Matlab R11 defaults. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Usage: + [Pxx,freq] = tfe(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +tfestimate + + +# name: +# type: sq_string +# elements: 1 +# length: 284 + Usage: + [Pxx,freq]=tfestimate(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) + + Estimate transfer function of system with input "x" and output "y". + Use the Welch (1967) periodogram/FFT method. + See "help pwelch" for description of arguments, hints and references. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Usage: + [Pxx,freq]=tfestimate(x,y,Nfft,Fs,window,overlap,range,plot_type,detr + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +triang + + +# name: +# type: sq_string +# elements: 1 +# length: 277 + usage: w = triang (L) + + Returns the filter coefficients of a triangular window of length L. + Unlike the bartlett window, triang does not go to zero at the edges + of the window. For odd L, triang(L) is equal to bartlett(L+2) except + for the zeros at the edges of the window. + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 + usage: w = triang (L) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +tripuls + + +# name: +# type: sq_string +# elements: 1 +# length: 629 + usage: y = tripuls(t, w, skew) + + Generate a triangular pulse over the interval [-w/2,w/2), sampled at + times t. This is useful with the function pulstran for generating a + series pulses. + + skew is a value between -1 and 1, indicating the relative placement + of the peak within the width. -1 indicates that the peak should be + at -w/2, and 1 indicates that the peak should be at w/2. + + Example + fs = 11025; # arbitrary sample rate + f0 = 100; # pulse train sample rate + w = 0.3/f0; # pulse width 3/10th the distance between pulses + auplot(pulstran(0:1/fs:4/f0, 0:1/f0:4/f0, 'tripuls', w), fs); + + See also: pulstran + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 + usage: y = tripuls(t, w, skew) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +tukeywin + + +# name: +# type: sq_string +# elements: 1 +# length: 633 + -- Function File: W = tukeywin (L, R) + Return the filter coefficients of a Tukey window (also known as the + cosine-tapered window) of length L. R defines the ratio between + the constant section and and the cosine section. It has to be + between 0 and 1. The function returns a Hanning window for R egals + 0 and a full box for R egals 1. By default R is set to 1/2. + + For a definition of the Tukey window, see e.g. Fredric J. Harris, + "On the Use of Windows for Harmonic Analysis with the Discrete + Fourier Transform, Proceedings of the IEEE", Vol. 66, No. 1, + January 1978, Page 67, Equation 38. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the filter coefficients of a Tukey window (also known as the +cosine-taper + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +upsample + + +# name: +# type: sq_string +# elements: 1 +# length: 372 + -- Function File: Y = upsample (X, N) + -- Function File: Y = upsample (X, N, OFFSET) + Upsample the signal, inserting n-1 zeros between every element. + + If X is a matrix, upsample every column. + + If OFFSET is specified, control the position of the inserted + sample in the block of n zeros. + + See also: decimate, downsample, interp, resample, upfirdn + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Upsample the signal, inserting n-1 zeros between every element. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +welchwin + + +# name: +# type: sq_string +# elements: 1 +# length: 696 + -- Function File: [W] = welchwin(L,C) + Returns a row vector containing a Welch window, given by + W(n)=1-(n/N-1)^2, n=[0,1, ... L-1]. Argument L is the length of + the window. Optional argument C specifies a "symmetric" window + (the default), or a "periodic" window. + + A symmetric window has zero at each end and maximum in the middle; + L must be an integer larger than 2. `if c=="symmetric", N=(L-1)/2' + + A periodic window wraps around the cyclic interval [0,1, ... L-1], + and is intended for use with the DFT (functions fft(), + periodogram() etc). L must be an integer larger than 1. `if + c=="periodic", N=L/2'. + + See also: blackman, kaiser + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Returns a row vector containing a Welch window, given by +W(n)=1-(n/N-1)^2, n=[ + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +window + + +# name: +# type: sq_string +# elements: 1 +# length: 221 + -- Function File: W = window (F, N, OPTS) + Create a N-point windowing from the function F. The function F can + be for example `@blackman'. Any additional arguments OPT are + passed to the windowing function. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Create a N-point windowing from the function F. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +wkeep + + +# name: +# type: sq_string +# elements: 1 +# length: 127 + -- Function File: [Y] = wkeep(X,L,OPT) + Extract the elements of x of size l from the center, the right or + the left. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 75 +Extract the elements of x of size l from the center, the right or the +left. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +wrev + + +# name: +# type: sq_string +# elements: 1 +# length: 121 + -- Function File: [Y] = wrev(X) + Reverse the order of the element of the vector x. + + See also: flipud, fliplr + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Reverse the order of the element of the vector x. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +xcorr + + +# name: +# type: sq_string +# elements: 1 +# length: 2493 + usage: [R, lag] = xcorr (X [, Y] [, maxlag] [, scale]) + + Estimate the cross correlation R_xy(k) of vector arguments X and Y + or, if Y is omitted, estimate autocorrelation R_xx(k) of vector X, + for a range of lags k specified by argument "maxlag". If X is a + matrix, each column of X is correlated with itself and every other + column. + + The cross-correlation estimate between vectors "x" and "y" (of + length N) for lag "k" is given by + R_xy(k) = sum_{i=1}^{N}{x_{i+k} conj(y_i), + where data not provided (for example x(-1), y(N+1)) is zero. + + ARGUMENTS + X [non-empty; real or complex; vector or matrix] data + + Y [real or complex vector] data + If X is a matrix (not a vector), Y must be omitted. + Y may be omitted if X is a vector; in this case xcorr + estimates the autocorrelation of X. + + maxlag [integer scalar] maximum correlation lag + If omitted, the default value is N-1, where N is the + greater of the lengths of X and Y or, if X is a matrix, + the number of rows in X. + + scale [character string] specifies the type of scaling applied + to the correlation vector (or matrix). is one of: + 'none' return the unscaled correlation, R, + 'biased' return the biased average, R/N, + 'unbiased' return the unbiassed average, R(k)/(N-|k|), + 'coeff' return the correlation coefficient, R/(rms(x).rms(y)), + where "k" is the lag, and "N" is the length of X. + If omitted, the default value is "none". + If Y is supplied but does not have the ame length as X, + scale must be "none". + + RETURNED VARIABLES + R array of correlation estimates + lag row vector of correlation lags [-maxlag:maxlag] + + The array of correlation estimates has one of the following forms. + (1) Cross-correlation estimate if X and Y are vectors. + (2) Autocorrelation estimate if is a vector and Y is omitted, + (3) If X is a matrix, R is an matrix containing the cross- + correlation estimate of each column with every other column. + Lag varies with the first index so that R has 2*maxlag+1 + rows and P^2 columns where P is the number of columns in X. + If Rij(k) is the correlation between columns i and j of X + R(k+maxlag+1,P*(i-1)+j) == Rij(k) + for lag k in [-maxlag:maxlag], or + R(:,P*(i-1)+j) == xcorr(X(:,i),X(:,j)). + "reshape(R(k,:),P,P)" is the cross-correlation matrix for X(k,:). + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 + usage: [R, lag] = xcorr (X [, Y] [, maxlag] [, scale]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +xcorr2 + + +# name: +# type: sq_string +# elements: 1 +# length: 1046 + -- Function File: C = xcorr2 (A) + -- Function File: C = xcorr2 (A, B) + -- Function File: C = xcorr2 (..., SCALE) + Compute the 2D cross-correlation of matrices A and B. + + If B is not specified, it defaults to the same matrix as A, i.e., + it's the same as `xcorr(A, A)'. + + The optional argument SCALE, defines the type of scaling applied + to the cross-correlation matrix (defaults to "none"). Possible + values are: + * "biased" + + Scales the raw cross-correlation by the maximum number of + elements of A and B involved in the generation of any element + of C. + + * "unbiased" + + Scales the raw correlation by dividing each element in the + cross-correlation matrix by the number of products A and B + used to generate that element + + * "coeff" + + Normalizes the sequence so that the largest cross-correlation + element is identically 1.0. + + * "none" + + No scaling (this is the default). + + See also: conv2, corr2, xcorr + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Compute the 2D cross-correlation of matrices A and B. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +xcov + + +# name: +# type: sq_string +# elements: 1 +# length: 630 + usage: [c, lag] = xcov (X [, Y] [, maxlag] [, scale]) + + Compute covariance at various lags [=correlation(x-mean(x),y-mean(y))]. + + X: input vector + Y: if specified, compute cross-covariance between X and Y, + otherwise compute autocovariance of X. + maxlag: is specified, use lag range [-maxlag:maxlag], + otherwise use range [-n+1:n-1]. + Scale: + 'biased' for covariance=raw/N, + 'unbiased' for covariance=raw/(N-|lag|), + 'coeff' for covariance=raw/(covariance at lag 0), + 'none' for covariance=raw + 'none' is the default. + + Returns the covariance for each lag in the range, plus an + optional vector of lags. + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 + usage: [c, lag] = xcov (X [, Y] [, maxlag] [, scale]) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +zerocrossing + + +# name: +# type: sq_string +# elements: 1 +# length: 186 + -- Function File: X0 = zerocrossing (X, Y) + Estimates the points at which a given waveform y=y(x) crosses the + x-axis using linear interpolation. + + See also: fzero, roots + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Estimates the points at which a given waveform y=y(x) crosses the +x-axis using l + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +zp2sos + + +# name: +# type: sq_string +# elements: 1 +# length: 1179 + -- Function File: [SOS, G] = zp2sos (Z, P) + Convert filter poles and zeros to second-order sections. + + INPUTS: + * Z = column-vector containing the filter zeros + * P = column-vector containing the filter poles + * G = overall filter gain factor + + RETURNED: + * SOS = matrix of series second-order sections, one per row: + SOS = [B1.' A1.'; ...; BN.' AN.'], where + `B1.'==[b0 b1 b2] and A1.'==[1 a1 a2]' for section 1, etc. + b0 must be nonzero for each section. + See `filter()' for documentation of the second-order + direct-form filter coefficients Bi and %Ai, i=1:N. + + * BSCALE is an overall gain factor that effectively scales any + one of the Bi vectors. + + EXAMPLE: + [z,p,g] = tf2zp([1 0 0 0 0 1],[1 0 0 0 0 .9]); + [sos,g] = zp2sos(z,p,g) + + sos = + 1.0000 0.6180 1.0000 1.0000 0.6051 0.9587 + 1.0000 -1.6180 1.0000 1.0000 -1.5843 0.9587 + 1.0000 1.0000 0 1.0000 0.9791 0 + + g = + 1 + + See also: sos2pz sos2tf tf2sos zp2tf tf2zp + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 +Convert filter poles and zeros to second-order sections. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +zp2ss + + +# name: +# type: sq_string +# elements: 1 +# length: 556 + -- Function File: [A, B, C, D] = zp2ss (ZER, POL, K) + Conversion from zero / pole to state space. + + *Inputs* + ZER + POL + Vectors of (possibly) complex poles and zeros of a transfer + function. Complex values must come in conjugate pairs (i.e., + x+jy in ZER means that x-jy is also in ZER). + + K + Real scalar (leading coefficient). + + *Outputs* + A + B + C + D + The state space system, in the form: + . + x = Ax + Bu + y = Cx + Du + + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 +Conversion from zero / pole to state space. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +zp2tf + + +# name: +# type: sq_string +# elements: 1 +# length: 326 + -- Function File: [NUM, DEN] = zp2tf (ZER, POL, K) + Converts zeros / poles to a transfer function. + + *Inputs* + ZER + POL + Vectors of (possibly complex) poles and zeros of a transfer + function. Complex values must appear in conjugate pairs. + + K + Real scalar (leading coefficient). + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Converts zeros / poles to a transfer function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +zplane + + +# name: +# type: sq_string +# elements: 1 +# length: 1223 + usage: zplane(b [, a]) or zplane(z [, p]) + + Plot the poles and zeros. If the arguments are row vectors then they + represent filter coefficients (numerator polynomial b and denominator + polynomial a), but if they are column vectors or matrices then they + represent poles and zeros. + + This is a horrid interface, but I didn't choose it; better would be + to accept b,a or z,p,g like other functions. The saving grace is + that poly(x) always returns a row vector and roots(x) always returns + a column vector, so it is usually right. You must only be careful + when you are creating filters by hand. + + Note that due to the nature of the roots() function, poles and zeros + may be displayed as occurring around a circle rather than at a single + point. + + The transfer function is + + B(z) b0 + b1 z^(-1) + b2 z^(-2) + ... + bM z^(-M) + H(z) = ---- = -------------------------------------------- + A(z) a0 + a1 z^(-1) + a2 z^(-2) + ... + aN z^(-N) + + b0 (z - z1) (z - z2) ... (z - zM) + = -- z^(-M+N) ------------------------------ + a0 (z - p1) (z - p2) ... (z - pN) + + The denominator a defaults to 1, and the poles p defaults to []. + + + +# name: +# type: sq_string +# elements: 1 +# length: 43 + usage: zplane(b [, a]) or zplane(z [, p]) + + + + + + diff --git a/octave_packages/signal-1.1.3/downsample.m b/octave_packages/signal-1.1.3/downsample.m new file mode 100644 index 0000000..2a32eeb --- /dev/null +++ b/octave_packages/signal-1.1.3/downsample.m @@ -0,0 +1,39 @@ +## Author: Paul Kienzle (2007) +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} downsample (@var{x}, @var{n}) +## @deftypefnx {Function File} {@var{y} =} downsample (@var{x}, @var{n}, @var{offset}) +## Downsample the signal, selecting every nth element. If @var{x} +## is a matrix, downsample every column. +## +## For most signals you will want to use @code{decimate} instead since +## it prefilters the high frequency components of the signal and +## avoids aliasing effects. +## +## If @var{offset} is defined, select every nth element starting at +## sample @var{offset}. +## @seealso{decimate, interp, resample, upfirdn, upsample} +## @end deftypefn + +function y = downsample (x, n, phase = 0) + + if nargin<2 || nargin>3, print_usage; end + + if phase > n - 1 + warning("This is incompatible with Matlab (phase = 0:n-1). See ... + octave-forge signal package release notes for details.") + end + + if isvector(x) + y = x(phase + 1:n:end); + else + y = x(phase + 1:n:end,:); + end +endfunction + +%!assert(downsample([1,2,3,4,5],2),[1,3,5]); +%!assert(downsample([1;2;3;4;5],2),[1;3;5]); +%!assert(downsample([1,2;3,4;5,6;7,8;9,10],2),[1,2;5,6;9,10]); +%!assert(downsample([1,2,3,4,5],2,1),[2,4]); +%!assert(downsample([1,2;3,4;5,6;7,8;9,10],2,1),[3,4;7,8]); diff --git a/octave_packages/signal-1.1.3/dst.m b/octave_packages/signal-1.1.3/dst.m new file mode 100644 index 0000000..aa82424 --- /dev/null +++ b/octave_packages/signal-1.1.3/dst.m @@ -0,0 +1,58 @@ +## Author: Paul Kienzle (2006) +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} dst (@var{x}) +## @deftypefnx {Function File} {@var{y} =} dst (@var{x}, @var{n}) +## Computes the type I discrete sine transform of @var{x}. If @var{n} is given, +## then @var{x} is padded or trimmed to length @var{n} before computing the transform. +## If @var{x} is a matrix, compute the transform along the columns of the +## the matrix. +## +## The discrete sine transform X of x can be defined as follows: +## +## @verbatim +## N +## X[k] = sum x[n] sin (pi n k / (N+1) ), k = 1, ..., N +## n=1 +## @end verbatim +## +## @seealso{idst} +## @end deftypefn + +function y = dst (x, n) + + if (nargin < 1 || nargin > 2) + print_usage; + endif + + transpose = (rows (x) == 1); + if transpose, x = x (:); endif + + [nr, nc] = size (x); + if nargin == 1 + n = nr; + elseif n > nr + x = [ x ; zeros(n-nr,nc) ]; + elseif n < nr + x (nr-n+1 : n, :) = []; + endif + + y = fft ([ zeros(1,nc); x ; zeros(1,nc); -flipud(x) ])/-2j; + y = y(2:nr+1,:); + if isreal(x), y = real (y); endif + + ## Compare directly against the slow transform + # y2 = x; + # w = pi*[1:n]'/(n+1); + # for k = 1:n, y2(k) = sum(x(:).*sin(k*w)); end + # y = [y,y2]; + + if transpose, y = y.'; endif + +endfunction + +%!test +%! x = log(linspace(0.1,1,32)); +%! y = dst(x); +%! assert(y(3), sum(x.*sin(3*pi*[1:32]/33)), 100*eps) diff --git a/octave_packages/signal-1.1.3/dwt.m b/octave_packages/signal-1.1.3/dwt.m new file mode 100644 index 0000000..024a124 --- /dev/null +++ b/octave_packages/signal-1.1.3/dwt.m @@ -0,0 +1,33 @@ +## Copyright (C) 2008 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{ca} @var{cd}] =} dwt(@var{x,lo_d,hi_d}) +## Comupte de discrete wavelet transform of x with one level. +## @end deftypefn + +function [ca cd] = dwt(x,lo_d,hi_d) + if (nargin < 3|| nargin > 3) + print_usage; + elseif(~isvector(x) || ~isvector(lo_d) || ~isvector(hi_d)) + error('x, hi_d and lo_d must be vectors'); + end + + h = filter(hi_d,1,x); + g = filter(lo_d,1,x); + + cd = downsample(h,2); + ca = downsample(g,2); +endfunction diff --git a/octave_packages/signal-1.1.3/ellip.m b/octave_packages/signal-1.1.3/ellip.m new file mode 100644 index 0000000..5bfb3ab --- /dev/null +++ b/octave_packages/signal-1.1.3/ellip.m @@ -0,0 +1,164 @@ +## Copyright (C) 2001 Paulo Neis +## Copyright (C) 2003 Doug Stewart +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## N-ellip 0.2.1 +##usage: [Zz, Zp, Zg] = ellip(n, Rp, Rs, Wp, stype,'s') +## +## Generate an Elliptic or Cauer filter (discrete and contnuious). +## +## [b,a] = ellip(n, Rp, Rs, Wp) +## low pass filter with order n, cutoff pi*Wp radians, Rp decibels +## of ripple in the passband and a stopband Rs decibels down. +## +## [b,a] = ellip(n, Rp, Rs, Wp, 'high') +## high pass filter with cutoff pi*Wp... +## +## [b,a] = ellip(n, Rp, Rs, [Wl, Wh]) +## band pass filter with band pass edges pi*Wl and pi*Wh ... +## +## [b,a] = ellip(n, Rp, Rs, [Wl, Wh], 'stop') +## band reject filter with edges pi*Wl and pi*Wh, ... +## +## [z,p,g] = ellip(...) +## return filter as zero-pole-gain. +## +## [...] = ellip(...,'s') +## return a Laplace space filter, W can be larger than 1. +## +## [a,b,c,d] = ellip(...) +## return state-space matrices +## +## References: +## +## - Oppenheim, Alan V., Discrete Time Signal Processing, Hardcover, 1999. +## - Parente Ribeiro, E., Notas de aula da disciplina TE498 - Processamento +## Digital de Sinais, UFPR, 2001/2002. +## - Kienzle, Paul, functions from Octave-Forge, 1999 (http://octave.sf.net). + + +function [a,b,c,d] = ellip(n, Rp, Rs, W, varargin) + + if (nargin>6 || nargin<4) || (nargout>4 || nargout<2) + print_usage; + endif + + ## interpret the input parameters + if (!(length(n)==1 && n == round(n) && n > 0)) + error ("ellip: filter order n must be a positive integer"); + endif + + + stop = 0; + digital = 1; + for i=1:length(varargin) + switch varargin{i} + case 's', digital = 0; + case 'z', digital = 1; + case { 'high', 'stop' }, stop = 1; + case { 'low', 'pass' }, stop = 0; + otherwise, error ("ellip: expected [high|stop] or [s|z]"); + endswitch + endfor + + [r, c]=size(W); + if (!(length(W)<=2 && (r==1 || c==1))) + error ("ellip: frequency must be given as w0 or [w0, w1]"); + elseif (!(length(W)==1 || length(W) == 2)) + error ("ellip: only one filter band allowed"); + elseif (length(W)==2 && !(W(1) < W(2))) + error ("ellip: first band edge must be smaller than second"); + endif + + if ( digital && !all(W >= 0 & W <= 1)) + error ("ellip: critical frequencies must be in (0 1)"); + elseif ( !digital && !all(W >= 0 )) + error ("ellip: critical frequencies must be in (0 inf)"); + endif + + if (Rp < 0) + error("ellip: passband ripple must be positive decibels"); + endif + + if (Rs < 0) + error("ellip: stopband ripple must be positive decibels"); + end + + + ##Prewarp the digital frequencies + if digital + T = 2; # sampling frequency of 2 Hz + W = tan(pi*W/T); + endif + + ##Generate s-plane poles, zeros and gain + [zero, pole, gain] = ncauer(Rp, Rs, n); + + ## splane frequency transform + [zero, pole, gain] = sftrans(zero, pole, gain, W, stop); + + ## Use bilinear transform to convert poles to the z plane + if digital + [zero, pole, gain] = bilinear(zero, pole, gain, T); + endif + + + ## convert to the correct output form + if nargout==2, + a = real(gain*poly(zero)); + b = real(poly(pole)); + elseif nargout==3, + a = zero; + b = pole; + c = gain; + else + ## output ss results + [a, b, c, d] = zp2ss (zero, pole, gain); + endif + +endfunction + +%!demo +%! clc +%! disp('---------------------------> NELLIP 0.2 EXAMPLE <-------------------------') +%! x=input("Let's calculate the filter order: [ENTER]"); +%! disp("") +%! x=input("[n, Ws] = ellipord([.1 .2],.4,1,90); [ENTER]"); +%! [n, Ws] = ellipord([.1 .2],.4,1,90) +%! disp("") +%! x=input("Let's calculate the filter: [ENTER]"); +%! disp("") +%! x=input("[b,a]=ellip(5,1,90,[.1,.2]); [ENTER]"); +%! [b,a]=ellip(5,1,90,[.1,.2]) +%! disp("") +%! x=input("Let's calculate the frequency response: [ENTER]"); +%! disp("") +%! x=input("[h,w]=freqz(b,a); [ENTER]"); +%! [h,w]=freqz(b,a); +%! +%! xlabel("Frequency"); +%! ylabel("abs(H[w])[dB]"); +%! axis([0,1,-100,0]); +%! plot(w./pi, 20*log10(abs(h)), ';;') +%! +%! hold('on'); +%! x=ones(1,length(h)); +%! plot(w./pi, x.*-1, ';-1 dB;') +%! plot(w./pi, x.*-90, ';-90 dB;') +%! hold('off'); +%! +%! xlabel("") +%! ylabel("") +%! clc diff --git a/octave_packages/signal-1.1.3/ellipord.m b/octave_packages/signal-1.1.3/ellipord.m new file mode 100644 index 0000000..7c1fe46 --- /dev/null +++ b/octave_packages/signal-1.1.3/ellipord.m @@ -0,0 +1,90 @@ +## Copyright (C) 2001 Paulo Neis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [n,wp] = ellipord(wp,ws, rp,rs) +## +## Calculate the order for the elliptic filter (discrete) +## wp: Cutoff frequency +## ws: Stopband edge +## rp: decibels of ripple in the passband. +## rs: decibels of ripple in the stopband. +## +## References: +## +## - Lamar, Marcus Vinicius, Notas de aula da disciplina TE 456 - Circuitos +## Analogicos II, UFPR, 2001/2002. + +function [n, Wp] = ellipord(Wp, Ws, Rp, Rs) + + [rp, cp]=size(Wp); + [rs, cs]=size(Ws); + if ( !(length(Wp)<=2 && (rp==1 || cp==1) && length(Ws)<=2 && (rs==1 || cs==1)) ) + error ("ellipord: frequency must be given as w0 or [w0, w1]"); + elseif (!all(Wp >= 0 & Wp <= 1 & Ws >= 0 & Ws <= 1)) ##### + error ("ellipord: critical frequencies must be in (0 1)"); + elseif (!(length(Wp)==1 || length(Wp) == 2 & length(Ws)==1 || length(Ws) == 2)) + error ("ellipord: only one filter band allowed"); + elseif (length(Wp)==2 && !(Wp(1) < Wp(2))) + error ("ellipord: first band edge must be smaller than second"); + elseif (length(Ws)==2 && !(length(Wp)==2)) + error ("ellipord: you must specify band pass borders."); + elseif (length(Wp)==2 && length(Ws)==2 && !(Ws(1) < Wp(1) && Ws(2) > Wp(2)) ) + error ("ellipord: ( Wp(1), Wp(2) ) must be inside of interval ( Ws(1), Ws(2) )"); + elseif (length(Wp)==2 && length(Ws)==1 && !(Ws < Wp(1) || Ws > Wp(2)) ) + error ("ellipord: Ws must be out of interval ( Wp(1), Wp(2) )"); + endif + + # sampling frequency of 2 Hz + T = 2; + + Wpw = tan(pi.*Wp./T); # prewarp + Wsw = tan(pi.*Ws./T); # prewarp + + ##pass/stop band to low pass filter transform: + if (length(Wpw)==2 && length(Wsw)==2) + wp=1; + w02 = Wpw(1) * Wpw(2); # Central frequency of stop/pass band (square) + w3 = w02/Wsw(2); + w4 = w02/Wsw(1); + if (w3 > Wsw(1)) + ws = (Wsw(2)-w3)/(Wpw(2)-Wpw(1)); + elseif (w4 < Wsw(2)) + ws = (w4-Wsw(1))/(Wpw(2)-Wpw(1)); + else + ws = (Wsw(2)-Wsw(1))/(Wpw(2)-Wpw(1)); + endif + elseif (length(Wpw)==2 && length(Wsw)==1) + wp=1; + w02 = Wpw(1) * Wpw(2); + if (Wsw > Wpw(2)) + w3 = w02/Wsw; + ws = (Wsw - w3)/(Wpw(2) - Wpw(1)); + else + w4 = w02/Wsw; + ws = (w4 - Wsw)/(Wpw(2) - Wpw(1)); + endif + else + wp = Wpw; + ws = Wsw; + endif + + k=wp/ws; + k1=sqrt(1-k^2); + q0=(1/2)*((1-sqrt(k1))/(1+sqrt(k1))); + q= q0 + 2*q0^5 + 15*q0^9 + 150*q0^13; %(....) + D=(10^(0.1*Rs)-1)/(10^(0.1*Rp)-1); + + n=ceil(log10(16*D)/log10(1/q)); +endfunction diff --git a/octave_packages/signal-1.1.3/fht.m b/octave_packages/signal-1.1.3/fht.m new file mode 100644 index 0000000..2a85f09 --- /dev/null +++ b/octave_packages/signal-1.1.3/fht.m @@ -0,0 +1,69 @@ +## Copyright (C) 2008 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {m = } fht ( d, n, dim ) +## @cindex linear algebra +## The function fht calculates Fast Hartley Transform +## where @var{d} is the real input vector (matrix), and @var{m} +## is the real-transform vector. For matrices the hartley transform +## is calculated along the columns by default. The options +## @var{n},and @var{dim} are similar to the options of FFT function. +## +## The forward and inverse hartley transforms are the same (except for a +## scale factor of 1/N for the inverse hartley transform), but +## implemented using different functions . +## +## The definition of the forward hartley transform for vector d, +## @math{ +## m[K] = \sum_{i=0}^{N-1} d[i]*(cos[K*2*pi*i/N] + sin[K*2*pi*i/N]), for 0 <= K < N. +## m[K] = \sum_{i=0}^{N-1} d[i]*CAS[K*i], for 0 <= K < N. } +## +## @example +## fht(1:4) +## @end example +## @seealso{ifht,fft} +## @end deftypefn + +function m = fht( d, n, dim ) + + if ( nargin < 1 ) + print_usage(); + end + + if ( nargin == 3 ) + Y = fft(d,n,dim); + elseif ( nargin == 2 ) + Y = fft(d,n); + else + Y = fft(d); + end + + m = real(Y) - imag(Y); + +# -- Traditional -- +# N = length(d); +# for K = 1:N +# i = 0:N-1; +# t = 2*pi*(K-1).*i/N; +# ker = (cos(t) + sin(t)); +# val = dot(d,ker); +# m(K) = val; +# end + +end +%! +%!assert( fht([1 2 3 4]),[10 -4 -2 0] ) +%! diff --git a/octave_packages/signal-1.1.3/filtfilt.m b/octave_packages/signal-1.1.3/filtfilt.m new file mode 100644 index 0000000..07a3618 --- /dev/null +++ b/octave_packages/signal-1.1.3/filtfilt.m @@ -0,0 +1,124 @@ +## Copyright (C) 1999 Paul Kienzle +## Copyright (C) 2007 Francesco Potortì +## Copyright (C) 2008 Luca Citi +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: y = filtfilt(b, a, x) +## +## Forward and reverse filter the signal. This corrects for phase +## distortion introduced by a one-pass filter, though it does square the +## magnitude response in the process. That's the theory at least. In +## practice the phase correction is not perfect, and magnitude response +## is distorted, particularly in the stop band. +#### +## Example +## [b, a]=butter(3, 0.1); % 10 Hz low-pass filter +## t = 0:0.01:1.0; % 1 second sample +## x=sin(2*pi*t*2.3)+0.25*randn(size(t)); % 2.3 Hz sinusoid+noise +## y = filtfilt(b,a,x); z = filter(b,a,x); % apply filter +## plot(t,x,';data;',t,y,';filtfilt;',t,z,';filter;') + + +## TODO: (pkienzle) My version seems to have similar quality to matlab, +## but both are pretty bad. They do remove gross lag errors, though. + + +function y = filtfilt(b, a, x) + if (nargin != 3) + print_usage; + end + rotate = (size(x,1)==1); + if rotate, # a row vector + x = x(:); # make it a column vector + endif + + lx = size(x,1); + a = a(:).'; + b = b(:).'; + lb = length(b); + la = length(a); + n = max(lb, la); + lrefl = 3 * (n - 1); + if la < n, a(n) = 0; end + if lb < n, b(n) = 0; end + + ## Compute a the initial state taking inspiration from + ## Likhterov & Kopeika, 2003. "Hardware-efficient technique for + ## minimizing startup transients in Direct Form II digital filters" + kdc = sum(b) / sum(a); + if (abs(kdc) < inf) # neither NaN nor +/- Inf + si = fliplr(cumsum(fliplr(b - kdc * a))); + else + si = zeros(size(a)); # fall back to zero initialization + end + si(1) = []; + + for (c = 1:size(x,2)) # filter all columns, one by one + v = [2*x(1,c)-x((lrefl+1):-1:2,c); x(:,c); + 2*x(end,c)-x((end-1):-1:end-lrefl,c)]; # a column vector + + ## Do forward and reverse filtering + v = filter(b,a,v,si*v(1)); # forward filter + v = flipud(filter(b,a,flipud(v),si*v(end))); # reverse filter + y(:,c) = v((lrefl+1):(lx+lrefl)); + endfor + + if (rotate) # x was a row vector + y = rot90(y); # rotate it back + endif + +endfunction + +%!error filtfilt (); + +%!error filtfilt (1, 2, 3, 4); + +%!test +%! randn('state',0); +%! r = randn(1,200); +%! [b,a] = butter(10, [.2, .25]); +%! yfb = filtfilt(b, a, r); +%! assert (size(r), size(yfb)); +%! assert (mean(abs(yfb)) < 1e3); +%! assert (mean(abs(yfb)) < mean(abs(r))); +%! ybf = fliplr(filtfilt(b, a, fliplr(r))); +%! assert (mean(abs(ybf)) < 1e3); +%! assert (mean(abs(ybf)) < mean(abs(r))); + +%!test +%! randn('state',0); +%! r = randn(1,1000); +%! s = 10 * sin(pi * 4e-2 * (1:length(r))); +%! [b,a] = cheby1(2, .5, [4e-4 8e-2]); +%! y = filtfilt(b, a, r+s); +%! assert (size(r), size(y)); +%! assert (mean(abs(y)) < 1e3); +%! assert (corr(s(250:750), y(250:750)) > .95) +%! [b,a] = butter(2, [4e-4 8e-2]); +%! yb = filtfilt(b, a, r+s); +%! assert (mean(abs(yb)) < 1e3); +%! assert (corr(y, yb) > .99) + +%!test +%! randn('state',0); +%! r = randn(1,1000); +%! s = 10 * sin(pi * 4e-2 * (1:length(r))); +%! [b,a] = butter(2, [4e-4 8e-2]); +%! y = filtfilt(b, a, [r.' s.']); +%! yr = filtfilt(b, a, r); +%! ys = filtfilt(b, a, s); +%! assert (y, [yr.' ys.']); +%! y2 = filtfilt(b.', a.', [r.' s.']); +%! assert (y, y2); diff --git a/octave_packages/signal-1.1.3/filtic.m b/octave_packages/signal-1.1.3/filtic.m new file mode 100644 index 0000000..117e710 --- /dev/null +++ b/octave_packages/signal-1.1.3/filtic.m @@ -0,0 +1,136 @@ +## Copyright (C) 2004 David Billinghurst +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Set initial condition vector for filter function +## The vector zf has the same values that would be obtained +## from function filter given past inputs x and outputs y +## +## The vectors x and y contain the most recent inputs and outputs +## respectively, with the newest values first: +## +## x = [x(-1) x(-2) ... x(-nb)], nb = length(b)-1 +## y = [y(-1) y(-2) ... y(-na)], na = length(a)-a +## +## If length(x)4 || nargin<3) || (nargout>1) + print_usage; + endif + if nargin < 4, x = []; endif + + nz = max(length(a)-1,length(b)-1); + zf=zeros(nz,1); + + # Pad arrays a and b to length nz+1 if required + if length(a)<(nz+1) + a(length(a)+1:nz+1)=0; + endif + if length(b)<(nz+1) + b(length(b)+1:nz+1)=0; + endif + # Pad arrays x and y to length nz if required + if length(x) < nz + x(length(x)+1:nz)=0; + endif + if length(y) < nz + y(length(y)+1:nz)=0; + endif + + for i=nz:-1:1 + for j=i:nz-1 + zf(j) = b(j+1)*x(i) - a(j+1)*y(i)+zf(j+1); + endfor + zf(nz)=b(nz+1)*x(i)-a(nz+1)*y(i); + endfor + +endfunction + +%!test +%! ## Simple low pass filter +%! b=[0.25 0.25]; +%! a=[1.0 -0.5]; +%! zf_ref=0.75; +%! zf=filtic(b,a,[1.0],[1.0]); +%! assert(zf,zf_ref,8*eps); +%! +%!test +%! ## Simple high pass filter +%! b=[0.25 -0.25]; +%! a=[1.0 0.5]; +%! zf_ref = [-0.25]; +%! zf=filtic(b,a,[0.0],[1.0]); +%! assert(zf,zf_ref,8*eps); +%! +%!test +%! ## Second order cases +%! [b,a]=butter(2,0.4); +%! N=1000; ## Long enough for filter to settle +%! xx=ones(1,N); +%! [yy,zf_ref] = filter(b,a,xx); +%! x=xx(N:-1:N-1); +%! y=yy(N:-1:N-1); +%! zf = filtic(b,a,y,x); +%! assert(zf,zf_ref,8*eps); +%! +%! xx = cos(2*pi*linspace(0,N-1,N)/8); +%! [yy,zf_ref] = filter(b,a,xx); +%! x=xx(N:-1:N-1); +%! y=yy(N:-1:N-1); +%! zf = filtic(b,a,y,x); +%! assert(zf,zf_ref,8*eps); +%! +%!test +%! ## Third order filter - takes longer to settle +%! N=10000; +%! [b,a]=cheby1(3,10,0.5); +%! xx=ones(1,N); +%! [yy,zf_ref] = filter(b,a,xx); +%! x=xx(N:-1:N-2); +%! y=yy(N:-1:N-2); +%! zf = filtic(b,a,y,x); +%! assert(zf,zf_ref,8*eps); +%! +%!test +%! ## Eight order high pass filter +%! N=10000; +%! [b,a]=butter(8,0.2); +%! xx = cos(2*pi*linspace(0,N-1,N)/8); +%! [yy,zf_ref] = filter(b,a,xx); +%! x=xx(N:-1:N-7); +%! y=yy(N:-1:N-7); +%! zf = filtic(b,a,y,x); +%! assert(zf,zf_ref,8*eps); +%! +%!test +%! ## Case with 3 args +%! [b,a]=butter(2,0.4); +%! N=100; +%! xx=[ones(1,N) zeros(1,2)]; +%! [yy,zf_ref] = filter(b,a,xx); +%! y=[yy(N+2) yy(N+1)]; +%! zf=filtic(b,a,y); +%! assert(zf,zf_ref,8*eps); + diff --git a/octave_packages/signal-1.1.3/fir1.m b/octave_packages/signal-1.1.3/fir1.m new file mode 100644 index 0000000..0e454a1 --- /dev/null +++ b/octave_packages/signal-1.1.3/fir1.m @@ -0,0 +1,152 @@ +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: b = fir1(n, w [, type] [, window] [, noscale]) +## +## Produce an order n FIR filter with the given frequency cutoff, +## returning the n+1 filter coefficients in b. +## +## n: order of the filter (1 less than the length of the filter) +## w: band edges +## strictly increasing vector in range [0, 1] +## singleton for highpass or lowpass, vector pair for bandpass or +## bandstop, or vector for alternating pass/stop filter. +## type: choose between pass and stop bands +## 'high' for highpass filter, cutoff at w +## 'stop' for bandstop filter, edges at w = [lo, hi] +## 'DC-0' for bandstop as first band of multiband filter +## 'DC-1' for bandpass as first band of multiband filter +## window: smoothing window +## defaults to hamming(n+1) row vector +## returned filter is the same shape as the smoothing window +## noscale: choose whether to normalize or not +## 'scale': set the magnitude of the center of the first passband to 1 +## 'noscale': don't normalize +## +## To apply the filter, use the return vector b: +## y=filter(b,1,x); +## +## Examples: +## freqz(fir1(40,0.3)); +## freqz(fir1(15,[0.2, 0.5], 'stop')); # note the zero-crossing at 0.1 +## freqz(fir1(15,[0.2, 0.5], 'stop', 'noscale')); + +## TODO: Consider using exact expression (in terms of sinc) for the +## TODO: impulse response rather than relying on fir2. +## TODO: Find reference to the requirement that order be even for +## TODO: filters that end high. Figure out what to do with the +## TODO: window in these cases +function b = fir1(n, w, varargin) + + if nargin < 2 || nargin > 5 + print_usage; + endif + + ## Assign default window, filter type and scale. + ## If single band edge, the first band defaults to a pass band to + ## create a lowpass filter. If multiple band edges, the first band + ## defaults to a stop band so that the two band case defaults to a + ## band pass filter. Ick. + window = []; + scale = 1; + ftype = (length(w)==1); + + ## sort arglist, normalize any string + for i=1:length(varargin) + arg = varargin{i}; + if ischar(arg), arg=lower(arg);end + if isempty(arg) continue; end # octave bug---can't switch on [] + switch arg + case {'low','stop','dc-1'}, ftype = 1; + case {'high','pass','bandpass','dc-0'}, ftype = 0; + case {'scale'}, scale = 1; + case {'noscale'}, scale = 0; + otherwise window = arg; + end + endfor + + ## build response function according to fir2 requirements + bands = length(w)+1; + f = zeros(1,2*bands); + f(1) = 0; f(2*bands)=1; + f(2:2:2*bands-1) = w; + f(3:2:2*bands-1) = w; + m = zeros(1,2*bands); + m(1:2:2*bands) = rem([1:bands]-(1-ftype),2); + m(2:2:2*bands) = m(1:2:2*bands); + + ## Increment the order if the final band is a pass band. Something + ## about having a nyquist frequency of zero causing problems. + if rem(n,2)==1 && m(2*bands)==1, + warning("n must be even for highpass and bandstop filters. Incrementing."); + n = n+1; + if isvector(window) && isreal(window) && !ischar(window) + ## Extend the window using interpolation + M = length(window); + if M == 1, + window = [window; window]; + elseif M < 4 + window = interp1(linspace(0,1,M),window,linspace(0,1,M+1),'linear'); + else + window = interp1(linspace(0,1,M),window,linspace(0,1,M+1),'spline'); + endif + endif + endif + + ## compute the filter + b = fir2(n, f, m, 512, 2, window); + + ## normalize filter magnitude + if scale == 1 + ## find the middle of the first band edge + ## find the frequency of the normalizing gain + if m(1) == 1 + ## if the first band is a passband, use DC gain + w_o = 0; + elseif f(4) == 1 + ## for a highpass filter, + ## use the gain at half the sample frequency + w_o = 1; + else + ## otherwise, use the gain at the center + ## frequency of the first passband + w_o = f(3) + (f(4)-f(3))/2; + endif + + ## compute |h(w_o)|^-1 + renorm = 1/abs(polyval(b, exp(-1i*pi*w_o))); + + ## normalize the filter + b = renorm*b; + endif +endfunction + +%!demo +%! freqz(fir1(40,0.3)); +%!demo +%! freqz(fir1(15,[0.2, 0.5], 'stop')); # note the zero-crossing at 0.1 +%!demo +%! freqz(fir1(15,[0.2, 0.5], 'stop', 'noscale')); + +%!assert(fir1(2, .5, 'low', @hanning, 'scale'), [0 1 0]'); +%!assert(fir1(2, .5, 'low', "hanning", 'scale'), [0 1 0]'); +%!assert(fir1(2, .5, 'low', hanning(3), 'scale'), [0 1 0]'); + +%!assert(fir1(10,.5,'noscale'), fir1(10,.5,'low','hamming','noscale')); +%!assert(fir1(10,.5,'high'), fir1(10,.5,'high','hamming','scale')); +%!assert(fir1(10,.5,'boxcar'), fir1(10,.5,'low','boxcar','scale')); +%!assert(fir1(10,.5,'hanning','scale'), fir1(10,.5,'scale','hanning','low')); +%!assert(fir1(10,.5,'haNNing','NOscale'), fir1(10,.5,'noscale','Hanning','LOW')); +%!assert(fir1(10,.5,'boxcar',[]), fir1(10,.5,'boxcar')); diff --git a/octave_packages/signal-1.1.3/fir2.m b/octave_packages/signal-1.1.3/fir2.m new file mode 100644 index 0000000..ba5e252 --- /dev/null +++ b/octave_packages/signal-1.1.3/fir2.m @@ -0,0 +1,174 @@ +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: b = fir2(n, f, m [, grid_n [, ramp_n]] [, window]) +## +## Produce an FIR filter of order n with arbitrary frequency response, +## returning the n+1 filter coefficients in b. +## +## n: order of the filter (1 less than the length of the filter) +## f: frequency at band edges +## f is a vector of nondecreasing elements in [0,1] +## the first element must be 0 and the last element must be 1 +## if elements are identical, it indicates a jump in freq. response +## m: magnitude at band edges +## m is a vector of length(f) +## grid_n: length of ideal frequency response function +## defaults to 512, should be a power of 2 bigger than n +## ramp_n: transition width for jumps in filter response +## defaults to grid_n/20; a wider ramp gives wider transitions +## but has better stopband characteristics. +## window: smoothing window +## defaults to hamming(n+1) row vector +## returned filter is the same shape as the smoothing window +## +## To apply the filter, use the return vector b: +## y=filter(b,1,x); +## Note that plot(f,m) shows target response. +## +## Example: +## f=[0, 0.3, 0.3, 0.6, 0.6, 1]; m=[0, 0, 1, 1/2, 0, 0]; +## [h, w] = freqz(fir2(100,f,m)); +## plot(f,m,';target response;',w/pi,abs(h),';filter response;'); + +function b = fir2(n, f, m, grid_n, ramp_n, window) + + if nargin < 3 || nargin > 6 + print_usage; + endif + + ## verify frequency and magnitude vectors are reasonable + t = length(f); + if t<2 || f(1)!=0 || f(t)!=1 || any(diff(f)<0) + usage("frequency must be nondecreasing starting from 0 and ending at 1"); + endif + if t != length(m) + usage("frequency and magnitude vectors must be the same length"); + endif + + ## find the grid spacing and ramp width + if (nargin>4 && length(grid_n)>1) || \ + (nargin>5 && (length(grid_n)>1 || length(ramp_n)>1)) + usage("grid_n and ramp_n must be integers"); + endif + if nargin < 4, grid_n=512; endif + if nargin < 5, ramp_n=grid_n/20; endif + + ## find the window parameter, or default to hamming + w=[]; + if length(grid_n)>1, w=grid_n; grid_n=512; endif + if length(ramp_n)>1, w=ramp_n; ramp_n=grid_n/20; endif + if nargin < 6, window=w; endif + if isempty(window), window=hamming(n+1); endif + if !isreal(window) || ischar(window), window=feval(window, n+1); endif + if length(window) != n+1, usage("window must be of length n+1"); endif + + ## make sure grid is big enough for the window + if 2*grid_n < n+1, grid_n = 2^nextpow2(n+1); endif + + ## Apply ramps to discontinuities + if (ramp_n > 0) + ## remember original frequency points prior to applying ramps + basef = f(:); basem = m(:); + + ## separate identical frequencies, but keep the midpoint + idx = find (diff(f) == 0); + f(idx) = f(idx) - ramp_n/grid_n/2; + f(idx+1) = f(idx+1) + ramp_n/grid_n/2; + f = [f(:);basef(idx)]'; + + ## make sure the grid points stay monotonic in [0,1] + f(f<0) = 0; + f(f>1) = 1; + f = unique([f(:);basef(idx)(:)]'); + + ## preserve window shape even though f may have changed + m = interp1(basef, basem, f); + + # axis([-.1 1.1 -.1 1.1]) + # plot(f,m,'-xb;ramped;',basef,basem,'-or;original;'); pause; + endif + + ## interpolate between grid points + grid = interp1(f,m,linspace(0,1,grid_n+1)'); + # hold on; plot(linspace(0,1,grid_n+1),grid,'-+g;grid;'); hold off; pause; + + ## Transform frequency response into time response and + ## center the response about n/2, truncating the excess + if (rem(n,2) == 0) + b = ifft([grid ; grid(grid_n:-1:2)]); + mid = (n+1)/2; + b = real ([ b([end-floor(mid)+1:end]) ; b(1:ceil(mid)) ]); + else + ## Add zeros to interpolate by 2, then pick the odd values below. + b = ifft([grid ; zeros(grid_n*2,1) ;grid(grid_n:-1:2)]); + b = 2 * real([ b([end-n+1:2:end]) ; b(2:2:(n+1))]); + endif + ## Multiplication in the time domain is convolution in frequency, + ## so multiply by our window now to smooth the frequency response. + if rows(window) > 1 + b = b .* window; + else + b = b' .* window; + endif +endfunction + +%!demo +%! f=[0, 0.3, 0.3, 0.6, 0.6, 1]; m=[0, 0, 1, 1/2, 0, 0]; +%! [h, w] = freqz(fir2(100,f,m)); +%! subplot(121); +%! plot(f,m,';target response;',w/pi,abs(h),';filter response;'); +%! subplot(122); +%! plot(f,20*log10(m+1e-5),';target response (dB);',... +%! w/pi,20*log10(abs(h)),';filter response (dB);'); + +%!demo +%! f=[0, 0.3, 0.3, 0.6, 0.6, 1]; m=[0, 0, 1, 1/2, 0, 0]; +%! plot(f,20*log10(m+1e-5),';target response;'); +%! hold on; +%! [h, w] = freqz(fir2(50,f,m,512,0)); +%! plot(w/pi,20*log10(abs(h)),';filter response (ramp=0);'); +%! [h, w] = freqz(fir2(50,f,m,512,25.6)); +%! plot(w/pi,20*log10(abs(h)),';filter response (ramp=pi/20 rad);'); +%! [h, w] = freqz(fir2(50,f,m,512,51.2)); +%! plot(w/pi,20*log10(abs(h)),';filter response (ramp=pi/10 rad);'); +%! hold off; + +%!demo +%! % Classical Jakes spectrum +%! % X represents the normalized frequency from 0 +%! % to the maximum Doppler frequency +%! asymptote = 2/3; +%! X = linspace(0,asymptote-0.0001,200); +%! Y = (1 - (X./asymptote).^2).^(-1/4); +%! +%! % The target frequency response is 0 after the asymptote +%! X = [X, asymptote, 1]; +%! Y = [Y, 0, 0]; +%! +%! title('Theoretical/Synthesized CLASS spectrum'); +%! xlabel('Normalized frequency (Fs=2)'); +%! ylabel('Magnitude'); +%! +%! plot(X,Y,'b;Target spectrum;'); +%! hold on; +%! [H,F]=freqz(fir2(20, X, Y)); +%! plot(F/pi,abs(H),'c;Synthesized spectrum (n=20);'); +%! [H,F]=freqz(fir2(50, X, Y)); +%! plot(F/pi,abs(H),'r;Synthesized spectrum (n=50);'); +%! [H,F]=freqz(fir2(200, X, Y)); +%! plot(F/pi,abs(H),'g;Synthesized spectrum (n=200);'); +%! hold off; +%! xlabel(''); ylabel(''); title(''); diff --git a/octave_packages/signal-1.1.3/firls.m b/octave_packages/signal-1.1.3/firls.m new file mode 100644 index 0000000..e79e6fc --- /dev/null +++ b/octave_packages/signal-1.1.3/firls.m @@ -0,0 +1,109 @@ +## Copyright (C) 2006 Quentin Spencer +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## b = firls(N, F, A); +## b = firls(N, F, A, W); +## +## FIR filter design using least squares method. Returns a length N+1 +## linear phase filter such that the integral of the weighted mean +## squared error in the specified bands is minimized. +## +## F specifies the frequencies of the band edges, normalized so that +## half the sample frequency is equal to 1. Each band is specified by +## two frequencies, to the vector must have an even length. +## +## A specifies the amplitude of the desired response at each band edge. +## +## W is an optional weighting function that contains one value for each +## band that weights the mean squared error in that band. A must be the +## same length as F, and W must be half the length of F. +## +## The least squares optimization algorithm for computing FIR filter +## coefficients is derived in detail in: +## +## I. Selesnick, "Linear-Phase FIR Filter Design by Least Squares," +## http://cnx.org/content/m10577 + +function coef = firls(N, frequencies, pass, weight, str); + + if nargin<3 || nargin>6 + print_usage; + elseif nargin==3 + weight = ones(1, length(pass)/2); + str = []; + elseif nargin==4 + if ischar(weight) + str = weight; + weight = ones (size (pass)); + else + str = []; + end + end + if length (frequencies) ~= length (pass) + error("F and A must have equal lengths."); + elseif 2 * length (weight) ~= length (pass) + error("W must contain one weight per band."); + elseif ischar(str) + error("This feature is implemented yet"); + else + + M = N/2; + w = kron(weight(:), [-1; 1]); + omega = frequencies * pi; + i1 = 1:2:length(omega); + i2 = 2:2:length(omega); + + ## Generate the matrix Q + ## As illustrated in the above-cited reference, the matrix can be + ## expressed as the sum of a Hankel and Toeplitz matrix. A factor of + ## 1/2 has been dropped and the final filter coefficients multiplied + ## by 2 to compensate. + cos_ints = [omega; sin((1:N)' * omega)]; + q = [1, 1./(1:N)]' .* (cos_ints * w); + Q = toeplitz (q(1:M+1)) + hankel (q(1:M+1), q(M+1:end)); + + ## The vector b is derived from solving the integral: + ## + ## _ w + ## / 2 + ## b = / W(w) D(w) cos(kw) dw + ## k / w + ## - 1 + ## + ## Since we assume that W(w) is constant over each band (if not, the + ## computation of Q above would be considerably more complex), but + ## D(w) is allowed to be a linear function, in general the function + ## W(w) D(w) is linear. The computations below are derived from the + ## fact that: + ## _ + ## / a ax + b + ## / (ax + b) cos(nx) dx = --- cos (nx) + ------ sin(nx) + ## / 2 n + ## - n + ## + cos_ints2 = [omega(i1).^2 - omega(i2).^2; ... + cos((1:M)' * omega(i2)) - cos((1:M)' * omega(i1))] ./ ... + ([2, 1:M]' * (omega(i2) - omega(i1))); + d = [-weight .* pass(i1); weight .* pass(i2)] (:); + b = [1, 1./(1:M)]' .* ((kron (cos_ints2, [1, 1]) + cos_ints(1:M+1,:)) * d); + + ## Having computed the components Q and b of the matrix equation, + ## solve for the filter coefficients. + a = Q \ b; + coef = [ a(end:-1:2); 2 * a(1); a(2:end) ]; + + end + +endfunction diff --git a/octave_packages/signal-1.1.3/flattopwin.m b/octave_packages/signal-1.1.3/flattopwin.m new file mode 100644 index 0000000..7fb439c --- /dev/null +++ b/octave_packages/signal-1.1.3/flattopwin.m @@ -0,0 +1,45 @@ +## Author: Paul Kienzle (2004) +## This program is granted to the public domain. + +## flattopwin(L, [periodic|symmetric]) +## +## Return the window f(w): +## +## f(w) = 1 - 1.93 cos(2 pi w) + 1.29 cos(4 pi w) +## - 0.388 cos(6 pi w) + 0.0322cos(8 pi w) +## +## where w = i/(L-1) for i=0:L-1 for a symmetric window, or +## w = i/L for i=0:L-1 for a periodic window. The default +## is symmetric. The returned window is normalized to a peak +## of 1 at w = 0.5. +## +## This window has low pass-band ripple, but high bandwidth. +## +## According to [1]: +## +## The main use for the Flat Top window is for calibration, due +## to its negligible amplitude errors. +## +## [1] Gade, S; Herlufsen, H; (1987) "Use of weighting functions in DFT/FFT +## analysis (Part I)", Bruel & Kjaer Technical Review No.3. + +function w = flattopwin (L, sym) + if nargin == 0 || nargin > 2 + print_usage; + endif + + divisor = L-1; + if nargin > 1 + match = strmatch(sym,['periodic';'symmetric']); + if isempty(match), + error("window type must be periodic or symmetric"); + elseif match == 1 + divisor = L; + else + divisor = L-1; + endif + endif + + x = 2*pi*[0:L-1]'/divisor; + w = (1-1.93*cos(x)+1.29*cos(2*x)-0.388*cos(3*x)+0.0322*cos(4*x))/4.6402; +endfunction diff --git a/octave_packages/signal-1.1.3/fracshift.m b/octave_packages/signal-1.1.3/fracshift.m new file mode 100644 index 0000000..bb30305 --- /dev/null +++ b/octave_packages/signal-1.1.3/fracshift.m @@ -0,0 +1,177 @@ +## Copyright (C) 2008 Eric Chassande-Mottin, CNRS (France) +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y} @var{h}]=} fracshift(@var{x},@var{d}) +## @deftypefnx {Function File} {@var{y} =} fracshift(@var{x},@var{d},@var{h}) +## Shift the series @var{x} by a (possibly fractional) number of samples @var{d}. +## The interpolator @var{h} is either specified or either designed with a Kaiser-windowed sinecard. +## @end deftypefn +## @seealso{circshift} + +## Ref [1] A. V. Oppenheim, R. W. Schafer and J. R. Buck, +## Discrete-time signal processing, Signal processing series, +## Prentice-Hall, 1999 +## +## Ref [2] T.I. Laakso, V. Valimaki, M. Karjalainen and U.K. Laine +## Splitting the unit delay, IEEE Signal Processing Magazine, +## vol. 13, no. 1, pp 30--59 Jan 1996 + +function [y, h] = fracshift( x, d, h ) + + if nargchk(2,3,nargin) + print_usage; + endif; + + ## if the delay is an exact integer, use circshift + if d==fix(d) + y=circshift(x,d); + return + endif; + + ## filter design if required + + if (nargin < 4) + + ## properties of the interpolation filter + + log10_rejection = -3.0; + stopband_cutoff_f = 1.0 / 2.0; + roll_off_width = stopband_cutoff_f / 10; + + ## determine filter length + ## use empirical formula from [1] Chap 7, Eq. (7.63) p 476 + + rejection_dB = -20.0*log10_rejection; + L = ceil((rejection_dB-8.0) / (28.714 * roll_off_width)); + + ## ideal sinc filter + + t=(-L:L)'; + ideal_filter=2*stopband_cutoff_f*sinc(2*stopband_cutoff_f*(t-(d-fix(d)))); + + ## determine parameter of Kaiser window + ## use empirical formula from [1] Chap 7, Eq. (7.62) p 474 + + if ((rejection_dB>=21) && (rejection_dB<=50)) + beta = 0.5842 * (rejection_dB-21.0)^0.4 + 0.07886 * (rejection_dB-21.0); + elseif (rejection_dB>50) + beta = 0.1102 * (rejection_dB-8.7); + else + beta = 0.0; + endif + + ## apodize ideal (sincard) filter response + + m = 2*L; + t = (0 : m)' - (d-fix(d)); + t = 2 * beta / m * sqrt (t .* (m - t)); + w = besseli (0, t) / besseli (0, beta); + h = w.*ideal_filter; + + endif + + ## check if input is a row vector + isrowvector=false; + if ((rows(x)==1) && (columns(x)>1)) + x=x(:); + isrowvector=true; + endif + + ## check if filter is a vector + if ~isvector(h) + error("fracshift.m: the filter h should be a vector"); + endif + + Lx = length(x); + Lh = length(h); + L = ( Lh - 1 )/2.0; + Ly = Lx; + + ## pre and postpad filter response + hpad = prepad(h,Lh); + offset = floor(L); + hpad = postpad(hpad,Ly + offset); + + ## filtering + xfilt = upfirdn(x,hpad,1,1); + y = xfilt(offset+1:offset+Ly,:); + + y=circshift(y,fix(d)); + + if isrowvector, + y=y.'; + endif + +endfunction + +%!test +%! N=1024; +%! d=1.5; +%! t=(0:N-1)-N/2; +%! tt=t-d; +%! err=zeros(N/2,1); +%! for n = 0:N/2-1, +%! phi0=2*pi*rand; +%! f0=n/N; +%! sigma=N/4; +%! x=exp(-t'.^2/(2*sigma)).*sin(2*pi*f0*t' + phi0); +%! [y,h]=fracshift(x,d); +%! xx=exp(-tt'.^2/(2*sigma)).*sin(2*pi*f0*tt' + phi0); +%! err(n+1)=max(abs(y-xx)); +%! endfor; +%! rolloff=.1; +%! rejection=10^-3; +%! idx_inband=1:ceil((1-rolloff)*N/2)-1; +%! assert(max(err(idx_inband)) +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Usage: H = freqs(B,A,W); +## +## Compute the s-plane frequency response of the IIR filter B(s)/A(s) as +## H = polyval(B,j*W)./polyval(A,j*W). If called with no output +## argument, a plot of magnitude and phase are displayed. +## +## Example: +## B = [1 2]; A = [1 1]; +## w = linspace(0,4,128); +## freqs(B,A,w); + +function [H] = freqs(B,A,W) + + if (nargin ~= 3 || nargout>1) + print_usage; + end + + H = polyval(B,j*W)./polyval(A,j*W); + + if nargout<1 + freqs_plot(W,H); + end + +endfunction + +%!demo +%! B = [1 2]; +%! A = [1 1]; +%! w = linspace(0,4,128); +%! freqs(B,A,w); diff --git a/octave_packages/signal-1.1.3/freqs_plot.m b/octave_packages/signal-1.1.3/freqs_plot.m new file mode 100644 index 0000000..db54a49 --- /dev/null +++ b/octave_packages/signal-1.1.3/freqs_plot.m @@ -0,0 +1,50 @@ +## Copyright (C) 2003 Julius O. Smith III +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} freqs_plot (@var{w}, @var{h}) +## Plot the amplitude and phase of the vector @var{h}. +## +## @end deftypefn + +function freqs_plot(w,h) + n = length(w); + mag = 20*log10(abs(h)); + phase = unwrap(arg(h)); + maxmag = max(mag); + + subplot(211); + plot(w, mag, ";Magnitude (dB);"); + title('Frequency response plot by freqs'); + axis("labely"); + ylabel("dB"); + xlabel(""); + grid("on"); + if (maxmag - min(mag) > 100) % make 100 a parameter? + axis([w(1), w(n), maxmag-100, maxmag]); + else + axis("autoy"); + endif + + subplot(212); + plot(w, phase/(2*pi), ";Phase (radians/2pi);"); + axis("label"); + title(""); + grid("on"); + axis("autoy"); + xlabel("Frequency (rad/sec)"); + ylabel("Cycles"); + axis([w(1), w(n)]); +endfunction diff --git a/octave_packages/signal-1.1.3/fwhm.m b/octave_packages/signal-1.1.3/fwhm.m new file mode 100644 index 0000000..23be442 --- /dev/null +++ b/octave_packages/signal-1.1.3/fwhm.m @@ -0,0 +1,171 @@ +%% Author: Petr Mikulik (2009) +%% This program is granted to the public domain. + +%% Compute peak full-width at half maximum (FWHM) or at another level of peak +%% maximum for vector or matrix data y, optionally sampled as y(x). If y is +%% a matrix, return FWHM for each column as a row vector. +%% Syntax: +%% f = fwhm({x, } y {, 'zero'|'min' {, 'rlevel', rlevel}}) +%% f = fwhm({x, } y {, 'alevel', alevel}) +%% Examples: +%% f = fwhm(y) +%% f = fwhm(x, y) +%% f = fwhm(x, y, 'zero') +%% f = fwhm(x, y, 'min') +%% f = fwhm(x, y, 'alevel', 15.3) +%% f = fwhm(x, y, 'zero', 'rlevel', 0.5) +%% f = fwhm(x, y, 'min', 'rlevel', 0.1) +%% +%% The default option 'zero' computes fwhm at half maximum, i.e. 0.5*max(y). +%% The option 'min' computes fwhm at the middle curve, i.e. 0.5*(min(y)+max(y)). +%% +%% The option 'rlevel' computes full-width at the given relative level of peak +%% profile, i.e. at rlevel*max(y) or rlevel*(min(y)+max(y)), respectively. +%% For example, fwhm(..., 'rlevel', 0.1) computes full width at 10 % of peak +%% maximum with respect to zero or minimum; FWHM is equivalent to +%% fwhm(..., 'rlevel', 0.5). +%% +%% The option 'alevel' computes full-width at the given absolute level of y. +%% +%% Return 0 if FWHM does not exist (e.g. monotonous function or the function +%% does not cut horizontal line at rlevel*max(y) or rlevel*(max(y)+min(y)) or +%% alevel, respectively). +%% +%% Compatibility: Octave 3.x, Matlab + +function myfwhm = fwhm (y, varargin) + + if nargin < 1 || nargin > 5 + print_usage; + end + opt = 'zero'; + is_alevel = 0; + level = 0.5; + if nargin==1 + x = 1:length(y); + else + if ischar(varargin{1}) + x = 1:length(y); + k = 1; + else + x = y; + y = varargin{1}; + k = 2; + end + while k <= length(varargin) + if strcmp(varargin{k}, 'alevel') + is_alevel = 1; + k = k+1; + if k > length(varargin) + error('option "alevel" requires an argument'); + end + level = varargin{k}; + if ~isreal(level) || length(level) > 1 + error('argument of "alevel" must be real number'); + end + k = k+1; + break + end + if any(strcmp(varargin{k}, {'zero', 'min'})) + opt = varargin{k}; + k = k+1; + end + if k > length(varargin) break; end + if strcmp(varargin{k}, 'rlevel') + k = k+1; + if k > length(varargin) + error('option "rlevel" requires an argument'); + end + level = varargin{k}; + if ~isreal(level) || length(level) > 1 || level(1) < 0 || level(:) > 1 + error('argument of "rlevel" must be real number from 0 to 1 (it is 0.5 for fwhm)'); + end + k = k+1; + break + end + break + end + if k ~= length(varargin)+1 + error('fwhm: extraneous option(s)'); + end + end + + % test the y matrix + [nr, nc] = size(y); + if (nr == 1 && nc > 1) + y = y'; nr = nc; nc = 1; + end + + if length(x) ~= nr + error('dimension of input arguments do not match'); + end + + % Shift matrix columns so that y(+-xfwhm) = 0: + if is_alevel + % case: full-width at the given absolute position + y = y - level; + else + if strcmp(opt, 'zero') + % case: full-width at half maximum + y = y - level * repmat(max(y), nr, 1); + else + % case: full-width above background + y = y - level * repmat((max(y) + min(y)), nr, 1); + end + end + + % Trial for a "vectorizing" calculation of fwhm (i.e. all + % columns in one shot): + % myfwhm = zeros(1,nc); % default: 0 for fwhm undefined + % ind = find (y(1:end-1, :) .* y(2:end, :) <= 0); + % [r1,c1] = ind2sub(size(y), ind); + % ... difficult to proceed further. + % Thus calculate fwhm for each column independently: + myfwhm = zeros(1,nc); % default: 0 for fwhm undefined + for n=1:nc + yy = y(:, n); + ind = find((yy(1:end-1) .* yy(2:end)) <= 0); + if length(ind) >= 2 && yy(ind(1)) > 0 % must start ascending + ind = ind(2:end); + end + [mx, imax] = max(yy); % protection against constant or (almost) monotonous functions + if length(ind) >= 2 && imax >= ind(1) && imax <= ind(end) + ind1 = ind(1); + ind2 = ind1 + 1; + xx1 = x(ind1) - yy(ind1) * (x(ind2) - x(ind1)) / (yy(ind2) - yy(ind1)); + ind1 = ind(end); + ind2 = ind1 + 1; + xx2 = x(ind1) - yy(ind1) * (x(ind2) - x(ind1)) / (yy(ind2) - yy(ind1)); + myfwhm(n) = xx2 - xx1; + end + end +end + +%!test +%! x=-pi:0.001:pi; y=cos(x); +%! assert( abs(fwhm(x, y) - 2*pi/3) < 0.01 ); +%! +%!test +%! assert( fwhm(-10:10) == 0 && fwhm(ones(1,50)) == 0 ); +%! +%!test +%! x=-20:1:20; +%! y1=-4+zeros(size(x)); y1(4:10)=8; +%! y2=-2+zeros(size(x)); y2(4:11)=2; +%! y3= 2+zeros(size(x)); y3(5:13)=10; +%! assert( max(abs(fwhm(x, [y1;y2;y3]') - [20.0/3,7.5,9.25])) < 0.01 ); +%! +%!test +%! x=1:3; y=[-1,3,-1]; assert(abs(fwhm(x,y)-0.75)<0.001 && abs(fwhm(x,y,'zero')-0.75)<0.001 && abs(fwhm(x,y,'min')-1.0)<0.001); +%! +%!test +%! x=1:3; y=[-1,3,-1]; assert(abs(fwhm(x,y, 'rlevel', 0.1)-1.35)<0.001 && abs(fwhm(x,y,'zero', 'rlevel', 0.1)-1.35)<0.001 && abs(fwhm(x,y,'min', 'rlevel', 0.1)-1.40)<0.001); +%! +%!test +%! x=1:3; y=[-1,3,-1]; assert(abs(fwhm(x,y, 'alevel', 2.5)-0.25)<0.001 && abs(fwhm(x,y,'alevel', -0.5)-1.75)<0.001); +%! +%!test +%! x=-10:10; assert( fwhm(x.*x) == 0 ); +%! +%!test +%! x=-5:5; y=18-x.*x; assert( abs(fwhm(y)-6.0) < 0.001 && abs(fwhm(x,y,'zero')-6.0) < 0.001 && abs(fwhm(x,y,'min')-7.0 ) < 0.001); diff --git a/octave_packages/signal-1.1.3/gauspuls.m b/octave_packages/signal-1.1.3/gauspuls.m new file mode 100644 index 0000000..72106e8 --- /dev/null +++ b/octave_packages/signal-1.1.3/gauspuls.m @@ -0,0 +1,29 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y}] =} gauspuls(@var{t},@var{fc},@var{bw}) +## Return the Gaussian modulated sinusoidal pulse. +## @end deftypefn + +function [y] = gauspuls(t, fc = 1e3, bw = 0.5) + if nargin<1, print_usage; end + if fc < 0 , error("fc must be positive"); end + if bw <= 0, error("bw must be stricltly positive"); end + + fv = -(bw.^2.*fc.^2)/(8.*log(10.^(-6/20))); + tv = 1/(4.*pi.^2.*fv); + y = exp(-t.*t/(2.*tv)).*cos(2.*pi.*fc.*t); +endfunction diff --git a/octave_packages/signal-1.1.3/gaussian.m b/octave_packages/signal-1.1.3/gaussian.m new file mode 100644 index 0000000..366ac31 --- /dev/null +++ b/octave_packages/signal-1.1.3/gaussian.m @@ -0,0 +1,38 @@ +## Copyright (C) 1999 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: w = gaussian(n, a) +## +## Generate an n-point gaussian convolution window of the given +## width. Use larger a for a narrower window. Use larger n for +## longer tails. +## +## w = exp ( -(a*x)^2/2 ) +## +## for x = linspace ( -(n-1)/2, (n-1)/2, n ). +## +## Width a is measured in frequency units (sample rate/num samples). +## It should be f when multiplying in the time domain, but 1/f when +## multiplying in the frequency domain (for use in convolutions). + +function x = gaussian(n, w) + + if nargin < 1 || nargin > 2 + print_usage; + end + if nargin == 1, w = 1; endif + x = exp(-0.5*(([0:n-1]'-(n-1)/2)*w).^2); + +endfunction diff --git a/octave_packages/signal-1.1.3/gausswin.m b/octave_packages/signal-1.1.3/gausswin.m new file mode 100644 index 0000000..33232f7 --- /dev/null +++ b/octave_packages/signal-1.1.3/gausswin.m @@ -0,0 +1,33 @@ +## Copyright (C) 1999 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: w = gausswin(L, a) +## +## Generate an L-point gaussian window of the given width. Use larger a +## for a narrow window. Use larger L for a smoother curve. +## +## w = exp ( -(a*x)^2/2 ) +## +## for x = linspace(-(L-1)/L, (L-1)/L, L) + +function x = gausswin(L, w) + + if nargin < 1 || nargin > 2 + print_usage; + end + if nargin == 1, w = 2.5; endif + x = exp ( -0.5 * ( w/L * [ -(L-1) : 2 : L-1 ]' ) .^ 2 ); + +endfunction diff --git a/octave_packages/signal-1.1.3/gmonopuls.m b/octave_packages/signal-1.1.3/gmonopuls.m new file mode 100644 index 0000000..304bb79 --- /dev/null +++ b/octave_packages/signal-1.1.3/gmonopuls.m @@ -0,0 +1,25 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y}] =} gmonopuls(@var{t},@var{fc}) +## Return the gaussian monopulse. +## @end deftypefn + +function [y] = gmonopuls(t, fc = 1e3) + if (nargin<1 || nargin > 2), print_usage; end + if fc < 0 , error("fc must be positive"); end + y = 2*sqrt(exp(1)) .* pi.*t.*fc.*exp(-2 .* (pi.*t.*fc).^2); +endfunction diff --git a/octave_packages/signal-1.1.3/grpdelay.m b/octave_packages/signal-1.1.3/grpdelay.m new file mode 100644 index 0000000..5bddc5a --- /dev/null +++ b/octave_packages/signal-1.1.3/grpdelay.m @@ -0,0 +1,321 @@ +## Copyright (C) 2000 Paul Kienzle +## Copyright (C) 2004 Julius O. Smith III +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Compute the group delay of a filter. +## +## [g, w] = grpdelay(b) +## returns the group delay g of the FIR filter with coefficients b. +## The response is evaluated at 512 angular frequencies between 0 and +## pi. w is a vector containing the 512 frequencies. +## The group delay is in units of samples. It can be converted +## to seconds by multiplying by the sampling period (or dividing by +## the sampling rate fs). +## +## [g, w] = grpdelay(b,a) +## returns the group delay of the rational IIR filter whose numerator +## has coefficients b and denominator coefficients a. +## +## [g, w] = grpdelay(b,a,n) +## returns the group delay evaluated at n angular frequencies. For fastest +## computation n should factor into a small number of small primes. +## +## [g, w] = grpdelay(b,a,n,'whole') +## evaluates the group delay at n frequencies between 0 and 2*pi. +## +## [g, f] = grpdelay(b,a,n,Fs) +## evaluates the group delay at n frequencies between 0 and Fs/2. +## +## [g, f] = grpdelay(b,a,n,'whole',Fs) +## evaluates the group delay at n frequencies between 0 and Fs. +## +## [g, w] = grpdelay(b,a,w) +## evaluates the group delay at frequencies w (radians per sample). +## +## [g, f] = grpdelay(b,a,f,Fs) +## evaluates the group delay at frequencies f (in Hz). +## +## grpdelay(...) +## plots the group delay vs. frequency. +## +## If the denominator of the computation becomes too small, the group delay +## is set to zero. (The group delay approaches infinity when +## there are poles or zeros very close to the unit circle in the z plane.) +## +## Theory: group delay, g(w) = -d/dw [arg{H(e^jw)}], is the rate of change of +## phase with respect to frequency. It can be computed as: +## +## d/dw H(e^-jw) +## g(w) = ------------- +## H(e^-jw) +## +## where +## H(z) = B(z)/A(z) = sum(b_k z^k)/sum(a_k z^k). +## +## By the quotient rule, +## A(z) d/dw B(z) - B(z) d/dw A(z) +## d/dw H(z) = ------------------------------- +## A(z) A(z) +## Substituting into the expression above yields: +## A dB - B dA +## g(w) = ----------- = dB/B - dA/A +## A B +## +## Note that, +## d/dw B(e^-jw) = sum(k b_k e^-jwk) +## d/dw A(e^-jw) = sum(k a_k e^-jwk) +## which is just the FFT of the coefficients multiplied by a ramp. +## +## As a further optimization when nfft>>length(a), the IIR filter (b,a) +## is converted to the FIR filter conv(b,fliplr(conj(a))). +## For further details, see +## http://ccrma.stanford.edu/~jos/filters/Numerical_Computation_Group_Delay.html + +function [gd,w] = grpdelay(b,a=1,nfft=512,whole,Fs) + + if (nargin<1 || nargin>5) + print_usage; + end + HzFlag=0; + if length(nfft)>1 + if nargin>4 + print_usage(); + elseif nargin>3 % grpdelay(B,A,F,Fs) + Fs = whole; + HzFlag=1; + else % grpdelay(B,A,W) + Fs = 1; + end + w = 2*pi*nfft/Fs; + nfft = length(w)*2; + whole = ''; + else + if nargin<5 + Fs=1; % return w in radians per sample + if nargin<4, whole=''; + elseif ~ischar(whole) + Fs = whole; + HzFlag=1; + whole = ''; + end + if nargin<3, nfft=512; end + if nargin<2, a=1; end + else + HzFlag=1; + end + + if isempty(nfft), nfft = 512; end + if ~strcmp(whole,'whole'), nfft = 2*nfft; end + w = Fs*[0:nfft-1]/nfft; + end + + if ~HzFlag, w = w * 2*pi; end + + oa = length(a)-1; % order of a(z) + if oa<0, a=1; oa=0; end % a can be [] + ob = length(b)-1; % order of b(z) + if ob<0, b=1; ob=0; end % b can be [] as well + oc = oa + ob; % order of c(z) + + c = conv(b,fliplr(conj(a))); % c(z) = b(z)*conj(a)(1/z)*z^(-oa) + cr = c.*[0:oc]; % cr(z) = derivative of c wrt 1/z + num = fft(cr,nfft); + den = fft(c,nfft); + minmag = 10*eps; + polebins = find(abs(den) +## Copyright (C) 2007 Peter L. Soendergaard +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} hilbert (@var{f},@var{N},@var{dim}) +## Analytic extension of real valued signal +## +## @code{@var{h}=hilbert(@var{f})} computes the extension of the real +## valued signal @var{f} to an analytic signal. If @var{f} is a matrix, +## the transformation is applied to each column. For N-D arrays, +## the transformation is applied to the first non-singleton dimension. +## +## @code{real(@var{h})} contains the original signal @var{f}. +## @code{imag(@var{h})} contains the Hilbert transform of @var{f}. +## +## @code{hilbert(@var{f},@var{N})} does the same using a length @var{N} +## Hilbert transform. The result will also have length @var{N}. +## +## @code{hilbert(@var{f},[],@var{dim})} or +## @code{hilbert(@var{f},@var{N},@var{dim})} does the same along +## dimension dim. +## @end deftypefn + +function f=hilbert(f, N = [], dim = []) + + % ------ PRE: initialization and dimension shifting --------- + + if (nargin<1 || nargin>3) + print_usage; + end + + if ~isreal(f) + warning ('HILBERT: ignoring imaginary part of signal'); + f = real (f); + end + + D=ndims(f); + + % Dummy assignment. + order=1; + + if isempty(dim) + dim=1; + + if sum(size(f)>1)==1 + % We have a vector, find the dimension where it lives. + dim=find(size(f)>1); + end + + else + if (numel(dim)~=1 || ~isnumeric(dim)) + error('HILBERT: dim must be a scalar.'); + end + if rem(dim,1)~=0 + error('HILBERT: dim must be an integer.'); + end + if (dim<1) || (dim>D) + error('HILBERT: dim must be in the range from 1 to %d.',D); + end + + end + + if (numel(N)>1 || ~isnumeric(N)) + error('N must be a scalar.'); + elseif (~isempty(N) && rem(N,1)~=0) + error('N must be an integer.'); + end + + if dim>1 + order=[dim, 1:dim-1,dim+1:D]; + + % Put the desired dimension first. + f=permute(f,order); + + end + + Ls=size(f,1); + + % If N is empty it is set to be the length of the transform. + if isempty(N) + N=Ls; + end + + % Remember the exact size for later and modify it for the new length + permutedsize=size(f); + permutedsize(1)=N; + + % Reshape f to a matrix. + f=reshape(f,size(f,1),numel(f)/size(f,1)); + W=size(f,2); + + if ~isempty(N) + f=postpad(f,N); + end + + % ------- actual computation ----------------- + if N>2 + f=fft(f); + + if rem(N,2)==0 + f=[f(1,:); + 2*f(2:N/2,:); + f(N/2+1,:); + zeros(N/2-1,W)]; + else + f=[f(1,:); + 2*f(2:(N+1)/2,:); + zeros((N-1)/2,W)]; + end + + f=ifft(f); + end + + % ------- POST: Restoration of dimensions ------------ + + % Restore the original, permuted shape. + f=reshape(f,permutedsize); + + if dim>1 + % Undo the permutation. + f=ipermute(f,order); + end + +endfunction + +%!demo +%! % notice that the imaginary signal is phase-shifted 90 degrees +%! t=linspace(0,10,256); +%! z = hilbert(sin(2*pi*0.5*t)); +%! grid on; plot(t,real(z),';real;',t,imag(z),';imag;'); + +%!demo +%! % the magnitude of the hilbert transform eliminates the carrier +%! t=linspace(0,10,1024); +%! x=5*cos(0.2*t).*sin(100*t); +%! grid on; plot(t,x,'g;z;',t,abs(hilbert(x)),'b;|hilbert(z)|;'); diff --git a/octave_packages/signal-1.1.3/idct.m b/octave_packages/signal-1.1.3/idct.m new file mode 100644 index 0000000..56c032f --- /dev/null +++ b/octave_packages/signal-1.1.3/idct.m @@ -0,0 +1,74 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## y = dct (x, n) +## Computes the inverse discrete cosine transform of x. If n is +## given, then x is padded or trimmed to length n before computing +## the transform. If x is a matrix, compute the transform along the +## columns of the the matrix. The transform is faster if x is +## real-valued and even length. +## +## The inverse discrete cosine transform x of X can be defined as follows: +## +## N-1 +## x[n] = sum w(k) X[k] cos (pi (2n+1) k / 2N ), n = 0, ..., N-1 +## k=0 +## +## with w(0) = sqrt(1/N) and w(k) = sqrt(2/N), k = 1, ..., N-1 +## +## See also: idct, dct2, idct2, dctmtx + +function y = idct (x, n) + + if (nargin < 1 || nargin > 2) + print_usage; + endif + + realx = isreal(x); + transpose = (rows (x) == 1); + + if transpose, x = x (:); endif + [nr, nc] = size (x); + if nargin == 1 + n = nr; + elseif n > nr + x = [ x ; zeros(n-nr,nc) ]; + elseif n < nr + x (n-nr+1 : n, :) = []; + endif + + if ( realx && rem (n, 2) == 0 ) + w = [ sqrt(n/4); sqrt(n/2)*exp((1i*pi/2/n)*[1:n-1]') ] * ones (1, nc); + y = ifft (w .* x); + y([1:2:n, n:-2:1], :) = 2*real(y); + elseif n == 1 + y = x; + else + ## reverse the steps of dct using inverse operations + ## 1. undo post-fft scaling + w = [ sqrt(4*n); sqrt(2*n)*exp((1i*pi/2/n)*[1:n-1]') ] * ones (1, nc); + y = x.*w; + + ## 2. reconstruct fft result and invert it + w = exp(-1i*pi*[n-1:-1:1]'/n) * ones(1,nc); + y = ifft ( [ y ; zeros(1,nc); y(n:-1:2,:).*w ] ); + + ## 3. keep only the original data; toss the reversed copy + y = y(1:n, :); + if (realx) y = real (y); endif + endif + if transpose, y = y.'; endif + +endfunction diff --git a/octave_packages/signal-1.1.3/idct2.m b/octave_packages/signal-1.1.3/idct2.m new file mode 100644 index 0000000..a9caba7 --- /dev/null +++ b/octave_packages/signal-1.1.3/idct2.m @@ -0,0 +1,44 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## y = idct2 (x) +## Computes the inverse 2-D discrete cosine transform of matrix x +## +## y = idct2 (x, m, n) or y = idct2 (x, [m n]) +## Computes the 2-D inverse DCT of x after padding or trimming rows to m and +## columns to n. + +function y = idct2 (x, m, n) + + if (nargin < 1 || nargin > 3) + print_usage; + endif + + if nargin == 1 + [m, n] = size (x); + elseif (nargin == 2) + n = m (2); + m = m (1); + endif + + if m == 1 + y = idct (x.', n).'; + elseif n == 1 + y = idct (x, m); + else + y = idct (idct (x, m).', n).'; + endif + +endfunction diff --git a/octave_packages/signal-1.1.3/idst.m b/octave_packages/signal-1.1.3/idst.m new file mode 100644 index 0000000..fe7cd2b --- /dev/null +++ b/octave_packages/signal-1.1.3/idst.m @@ -0,0 +1,30 @@ +## Author: Paul Kienzle (2006) +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} idst (@var{x}) +## @deftypefnx {Function File} {@var{y} =} idst (@var{x}, @var{n}) +## Computes the inverse type I discrete sine transform of @var{y}. If @var{n} is +## given, then @var{y} is padded or trimmed to length @var{n} before computing +## the transform. If @var{y} is a matrix, compute the transform along the +## columns of the the matrix. +## @seealso{dst} +## @end deftypefn + +function x = idst (y, n) + + if (nargin < 1 || nargin > 2) + print_usage; + endif + + if nargin == 1, + n = size(y,1); + if n==1, n = size(y,2); end + end + x = dst(y, n) * 2/(n+1); + +endfunction + +%!test +%! x = log(gausswin(32)); +%! assert(x, idst(dst(x)), 100*eps) diff --git a/octave_packages/signal-1.1.3/ifht.m b/octave_packages/signal-1.1.3/ifht.m new file mode 100644 index 0000000..67b3518 --- /dev/null +++ b/octave_packages/signal-1.1.3/ifht.m @@ -0,0 +1,68 @@ +## Copyright (C) 2008 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {m = } ifht ( d, n, dim ) +## @cindex linear algebra +## The function ifht calculates Fast Hartley Transform +## where @var{d} is the real input vector (matrix), and @var{m} +## is the real-transform vector. For matrices the hartley transform +## is calculated along the columns by default. The options @var{n}, +## and @var{dim} are similar to the options of FFT function. +## +## The forward and inverse hartley transforms are the same (except for a +## scale factor of 1/N for the inverse hartley transform), but +## implemented using different functions . +## +## The definition of the forward hartley transform for vector d, +## @math{ +## m[K] = 1/N \sum_{i=0}^{N-1} d[i]*(cos[K*2*pi*i/N] + sin[K*2*pi*i/N]), for 0 <= K < N. +## m[K] = 1/N \sum_{i=0}^{N-1} d[i]*CAS[K*i], for 0 <= K < N. } +## +## @example +## ifht(1:4) +## @end example +## @seealso{fht,fft} +## @end deftypefn + +function m = ifht( d, n, dim ) + + if ( nargin < 1 ) + print_usage(); + end + + if ( nargin == 3 ) + Y = ifft(d,n,dim); + elseif ( nargin == 2 ) + Y = ifft(d,n); + else + Y = ifft(d); + end + + m = real(Y) + imag(Y); + +# -- Traditional -- +# N = length(d); +# for K = 1:N +# i = 0:N-1; +# t = (2*pi*(K-1).*i/N); +# ker = (cos(t) + sin(t)); +# val = dot(d,ker)./N; +# m(K) = val; +# end + +end + +%!assert(ifht(fht(1:4)),[1 2 3 4]) diff --git a/octave_packages/signal-1.1.3/iirlp2mb.m b/octave_packages/signal-1.1.3/iirlp2mb.m new file mode 100644 index 0000000..3d79006 --- /dev/null +++ b/octave_packages/signal-1.1.3/iirlp2mb.m @@ -0,0 +1,318 @@ +## Copyright (C) 2011 Alan J. Greenberger +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## IIR Low Pass Filter to Multiband Filter Transformation +## +## [Num,Den,AllpassNum,AllpassDen] = iirlp2mb(B,A,Wo,Wt) +## [Num,Den,AllpassNum,AllpassDen] = iirlp2mb(B,A,Wo,Wt,Pass) +## +## Num,Den: numerator,denominator of the transformed filter +## AllpassNum,AllpassDen: numerator,denominator of allpass transform, +## B,A: numerator,denominator of prototype low pass filter +## Wo: normalized_angular_frequency/pi to be transformed +## Wt: [phi=normalized_angular_frequencies]/pi target vector +## Pass: This parameter may have values 'pass' or 'stop'. If +## not given, it defaults to the value of 'pass'. +## +## With normalized ang. freq. targets 0 < phi(1) < ... < phi(n) < pi radians +## +## for Pass == 'pass', the target multiband magnitude will be: +## -------- ---------- -----------... +## / \ / \ / . +## 0 phi(1) phi(2) phi(3) phi(4) phi(5) (phi(6)) pi +## +## for Pass == 'stop', the target multiband magnitude will be: +## ------- --------- ----------... +## \ / \ / . +## 0 phi(1) phi(2) phi(3) phi(4) (phi(5)) pi +## +## Example of use: +## [B, A] = butter(6, 0.5); +## [Num, Den] = iirlp2mb(B, A, 0.5, [.2 .4 .6 .8]); + +function [Num,Den,AllpassNum,AllpassDen] = iirlp2mb(varargin) + usage = sprintf( + "%s: Usage: [Num,Den,AllpassNum,AllpassDen]=iirlp2mb(B,A,Wo,Wt[,Pass])\n" + ,mfilename()); + B = varargin{1}; # numerator polynomial of prototype low pass filter + A = varargin{2}; # denominator polynomial of prototype low pass filter + Wo = varargin{3}; # (normalized angular frequency)/pi to be transformed + Wt = varargin{4}; # vector of (norm. angular frequency)/pi transform targets + # [phi(1) phi(2) ... ]/pi + if(nargin < 4 || nargin > 5) + error("%s",usage) + endif + if(nargin == 5) + Pass = varargin{5}; + switch(Pass) + case 'pass' + pass_stop = -1; + case 'stop' + pass_stop = 1; + otherwise + error("Pass must be 'pass' or 'stop'\n%s",usage) + endswitch + else + pass_stop = -1; # Pass == 'pass' is the default + endif + if(Wo <= 0) + error("Wo is %f <= 0\n%s",Wo,usage); + endif + if(Wo >= 1) + error("Wo is %f >= 1\n%s",Wo,usage); + endif + oWt = 0; + for i = 1 : length(Wt) + if(Wt(i) <= 0) + error("Wt(%d) is %f <= 0\n%s",i,Wt(i),usage); + endif + if(Wt(i) >= 1) + error("Wt(%d) is %f >= 1\n%s",i,Wt(i),usage); + endif + if(Wt(i) <= oWt) + error("Wt(%d) = %f, not monotonically increasing\n%s",i,Wt(i),usage); + else + oWt = Wt(i); + endif + endfor + + # B(z) + # Inputs B,A specify the low pass IIR prototype filter G(z) = ---- . + # A(z) + # This module transforms G(z) into a multiband filter using the iterative + # algorithm from: + # [FFM] G. Feyh, J. Franchitti, and C. Mullis, "All-Pass Filter + # Interpolation and Frequency Transformation Problem", Proceedings 20th + # Asilomar Conference on Signals, Systems and Computers, Nov. 1986, pp. + # 164-168, IEEE. + # [FFM] moves the prototype filter position at normalized angular frequency + # .5*pi to the places specified in the Wt vector times pi. In this module, + # a generalization allows the position to be moved on the prototype filter + # to be specified as Wo*pi instead of being fixed at .5*pi. This is + # implemented using two successive allpass transformations. + # KK(z) + # In the first stage, find allpass J(z) = ---- such that + # K(z) + # jWo*pi -j.5*pi + # J(e ) = e (low pass to low pass transformation) + # + # PP(z) + # In the second stage, find allpass H(z) = ---- such that + # P(z) + # jWt(k)*pi -j(2k - 1)*.5*pi + # H(e ) = e (low pass to multiband transformation) + # + # ^ + # The variable PP used here corresponds to P in [FFM]. + # len = length(P(z)) == length(PP(z)), the number of polynomial coefficients + # + # len 1-i len 1-i + # P(z) = SUM P(i)z ; PP(z) = SUM PP(i)z ; PP(i) == P(len + 1 - i) + # i=1 i=1 (allpass condition) + # Note: (len - 1) == n in [FFM] eq. 3 + # + # The first stage computes the denominator of an allpass for translating + # from a prototype with position .5 to one with a position of Wo. It has the + # form: + # -1 + # K(2) - z + # ----------- + # -1 + # 1 - K(2)z + # + # From the low pass to low pass tranformation in Table 7.1 p. 529 of A. + # Oppenheim and R. Schafer, Discrete-Time Signal Processing 3rd edition, + # Prentice Hall 2010, one can see that the denominator of an allpass for + # going in the opposite direction can be obtained by a sign reversal of the + # second coefficient, K(2), of the vector K (the index 2 not to be confused + # with a value of z, which is implicit). + + # The first stage allpass denominator computation + K = apd([pi * Wo]); + + # The second stage allpass computation + phi = pi * Wt; # vector of normalized angular frequencies between 0 and pi + P = apd(phi); # calculate denominator of allpass for this target vector + PP = revco(P); # numerator of allpass has reversed coefficients of P + + # The total allpass filter from the two consecutive stages can be written as + # PP + # K(2) - --- + # P P + # ----------- * --- + # PP P + # 1 - K(2)--- + # P + AllpassDen = P - (K(2) * PP); + AllpassDen /= AllpassDen(1); # normalize + AllpassNum = pass_stop * revco(AllpassDen); + [Num,Den] = transform(B,A,AllpassNum,AllpassDen,pass_stop); +endfunction + +function [Num,Den] = transform(B,A,PP,P,pass_stop) + # Given G(Z) = B(Z)/A(Z) and allpass H(z) = PP(z)/P(z), compute G(H(z)) + # For Pass = 'pass', transformed filter is: + # 2 nb-1 + # B1 + B2(PP/P) + B3(PP/P)^ + ... + Bnb(PP/P)^ + # ------------------------------------------------- + # 2 na-1 + # A1 + A2(PP/P) + A3(PP/P)^ + ... + Ana(PP/P)^ + # For Pass = 'stop', use powers of (-PP/P) + # + na = length(A); # the number of coefficients in A + nb = length(B); # the number of coefficients in B + # common low pass iir filters have na == nb but in general might not + n = max(na,nb); # the greater of the number of coefficients + # n-1 + # Multiply top and bottom by P^ yields: + # + # n-1 n-2 2 n-3 nb-1 n-nb + # B1(P^ ) + B2(PP)(P^ ) + B3(PP^ )(P^ ) + ... + Bnb(PP^ )(P^ ) + # --------------------------------------------------------------------- + # n-1 n-2 2 n-3 na-1 n-na + # A1(P^ ) + A2(PP)(P^ ) + A3(PP^ )(P^ ) + ... + Ana(PP^ )(P^ ) + + # Compute and store powers of P as a matrix of coefficients because we will + # need to use them in descending power order + global Ppower; # to hold coefficients of powers of P, access inside ppower() + np = length(P); + powcols = np + (np-1)*(n-2); # number of coefficients in P^(n-1) + # initialize to "Not Available" with n-1 rows for powers 1 to (n-1) and + # the number of columns needed to hold coefficients for P^(n-1) + Ppower = NA(n-1,powcols); + Ptemp = P; # start with P to the 1st power + for i = 1 : n-1 # i is the power + for j = 1 : length(Ptemp) # j is the coefficient index for this power + Ppower(i,j) = Ptemp(j); + endfor + Ptemp = conv(Ptemp,P); # increase power of P by one + endfor + + # Compute numerator and denominator of transformed filter + Num = []; + Den = []; + for i = 1 : n + # n-i + # Regenerate P^ (p_pownmi) + if((n-i) == 0) + p_pownmi = [1]; + else + p_pownmi = ppower(n-i,powcols); + endif + # i-1 + # Regenerate PP^ (pp_powim1) + if(i == 1) + pp_powim1 = [1]; + else + pp_powim1 = revco(ppower(i-1,powcols)); + endif + if(i <= nb) + Bterm = (pass_stop^(i-1))*B(i)*conv(pp_powim1,p_pownmi); + Num = polysum(Num,Bterm); + endif + if(i <= na) + Aterm = (pass_stop^(i-1))*A(i)*conv(pp_powim1,p_pownmi); + Den = polysum(Den,Aterm); + endif + endfor + # Scale both numerator and denominator to have Den(1) = 1 + temp = Den(1); + for i = 1 : length(Den) + Den(i) = Den(i) / temp; + endfor + for i = 1 : length(Num) + Num(i) = Num(i) / temp; + endfor +endfunction + +function P = apd(phi) # all pass denominator + # Given phi, a vector of normalized angular frequency transformation targets, + # return P, the denominator of an allpass H(z) + lenphi = length(phi); + Pkm1 = 1; # P0 initial condition from [FFM] eq. 22 + for k = 1 : lenphi + P = pk(Pkm1, k, phi(k)); # iterate + Pkm1 = P; + endfor +endfunction + +function Pk = pk(Pkm1, k, phik) # kth iteration of P(z) + # Given Pkminus1, k, and phi(k) in radians , return Pk + # + # From [FFM] eq. 19 : k + # Pk = (z+1 )sin(phi(k)/2)Pkm1 - (-1) (z-1 )cos(phi(k)/2)PPkm1 + # Factoring out z + # -1 k -1 + # = z((1+z )sin(phi(k)/2)Pkm1 - (-1) (1-z )cos(phi(k)/2)PPkm1) + # PPk can also have z factored out. In H=PP/P, z in PPk will cancel z in Pk, + # so just leave out. Use + # -1 k -1 + # PK = (1+z )sin(phi(k)/2)Pkm1 - (-1) (1-z )cos(phi(k)/2)PPkm1 + # (expand) k + # = sin(phi(k)/2)Pkm1 - (-1) cos(phi(k)/2)PPkm1 + # + # -1 k -1 + # + z sin(phi(k)/2)Pkm1 + (-1) z cos(phi(k)/2)PPkm1 + Pk = zeros(1,k+1); # there are k+1 coefficients in Pk + sin_k = sin(phik/2); + cos_k = cos(phik/2); + for i = 1 : k + Pk(i) += sin_k * Pkm1(i) - ((-1)^k * cos_k * Pkm1(k+1-i)); + # + # -1 + # Multiplication by z just shifts by one coefficient + Pk(i+1) += sin_k * Pkm1(i) + ((-1)^k * cos_k * Pkm1(k+1-i)); + endfor + # now normalize to Pk(1) = 1 (again will cancel with same factor in PPk) + Pk1 = Pk(1); + for i = 1 : k+1 + Pk(i) = Pk(i) / Pk1; + endfor +endfunction + +function PP = revco(p) # reverse components of vector + l = length(p); + for i = 1 : l + PP(l + 1 - i) = p(i); + endfor +endfunction + +function p = ppower(i,powcols) # Regenerate ith power of P from stored PPower + global Ppower + if(i == 0) + p = 1; + else + p = []; + for j = 1 : powcols + if(isna(Ppower(i,j))) + break; + endif + p = horzcat(p, Ppower(i,j)); + endfor + endif +endfunction + +function poly = polysum(p1,p2) # add polynomials of possibly different length + n1 = length(p1); + n2 = length(p2); + if(n1 > n2) + # pad p2 + p2 = horzcat(p2, zeros(1,n1-n2)); + elseif(n2 > n1) + # pad p1 + p1 = horzcat(p1, zeros(1,n2-n1)); + endif + poly = p1 + p2; +endfunction diff --git a/octave_packages/signal-1.1.3/impinvar.m b/octave_packages/signal-1.1.3/impinvar.m new file mode 100644 index 0000000..aaee706 --- /dev/null +++ b/octave_packages/signal-1.1.3/impinvar.m @@ -0,0 +1,146 @@ +## Copyright (c) 2007 R.G.H. Eschauzier +## Copyright (c) 2011 Carnë Draug +## Copyright (c) 2011 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR 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{b_out}, @var{a_out}] =} impinvar (@var{b}, @var{a}, @var{fs}, @var{tol}) +## @deftypefnx{Function File} {[@var{b_out}, @var{a_out}] =} impinvar (@var{b}, @var{a}, @var{fs}) +## @deftypefnx{Function File} {[@var{b_out}, @var{a_out}] =} impinvar (@var{b}, @var{a}) +## Converts analog filter with coefficients @var{b} and @var{a} to digital, +## conserving impulse response. +## +## If @var{fs} is not specificied, or is an empty vector, it defaults to 1Hz. +## +## If @var{tol} is not specified, it defaults to 0.0001 (0.1%) +## This function does the inverse of impinvar so that the following example should +## restore the original values of @var{a} and @var{b}. +## +## @command{invimpinvar} implements the reverse of this function. +## @example +## [b, a] = impinvar (b, a); +## [b, a] = invimpinvar (b, a); +## @end example +## +## Reference: Thomas J. Cavicchi (1996) ``Impulse invariance and multiple-order +## poles''. IEEE transactions on signal processing, Vol 40 (9): 2344--2347 +## +## @seealso{bilinear, invimpinvar} +## @end deftypefn + +function [b_out, a_out] = impinvar (b_in, a_in, fs = 1, tol = 0.0001) + + if (nargin <2) + print_usage; + endif + + ## to be compatible with the matlab implementation where an empty vector can + ## be used to get the default + if (isempty(fs)) + ts = 1; + else + ts = 1/fs; # we should be using sampling frequencies to be compatible with Matlab + endif + + [r_in, p_in, k_in] = residue(b_in, a_in); % partial fraction expansion + + n = length(r_in); % Number of poles/residues + + if (length(k_in)>0) % Greater than zero means we cannot do impulse invariance + error("Order numerator >= order denominator"); + endif + + r_out = zeros(1,n); % Residues of H(z) + p_out = zeros(1,n); % Poles of H(z) + k_out = 0; % Contstant term of H(z) + + i=1; + while (i<=n) + m = 1; + first_pole = p_in(i); % Pole in the s-domain + while (i +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [x, t] = impz(b [, a, n, fs]) +## +## Generate impulse-response characteristics of the filter. The filter +## coefficients correspond to the the z-plane rational function with +## numerator b and denominator a. If a is not specified, it defaults to +## 1. If n is not specified, or specified as [], it will be chosen such +## that the signal has a chance to die down to -120dB, or to not explode +## beyond 120dB, or to show five periods if there is no significant +## damping. If no return arguments are requested, plot the results. +## +## See also: freqz, zplane + +## TODO: Call equivalent function from control toolbox since it is +## TODO: probably more sophisticated than this one, and since it +## TODO: is silly to maintain two different versions of essentially +## TODO: the same thing. +function [x_r, t_r] = impz(b, a = [1], n = [], fs = 1) + + if nargin == 0 || nargin > 4 + print_usage; + end + + if isempty(n) && length(a) > 1 + precision = 1e-6; + r = roots(a); + maxpole = max(abs(r)); + if (maxpole > 1+precision) # unstable -- cutoff at 120 dB + n = floor(6/log10(maxpole)); + elseif (maxpole < 1-precision) # stable -- cutoff at -120 dB + n = floor(-6/log10(maxpole)); + else # periodic -- cutoff after 5 cycles + n = 30; + + # find longest period less than infinity + # cutoff after 5 cycles (w=10*pi) + rperiodic = r(find(abs(r)>=1-precision & abs(arg(r))>0)); + if !isempty(rperiodic) + n_periodic = ceil(10*pi./min(abs(arg(rperiodic)))); + if (n_periodic > n) + n = n_periodic; + end + end + + # find most damped pole + # cutoff at -60 dB + rdamped = r(find(abs(r)<1-precision)); + if !isempty(rdamped) + n_damped = floor(-3/log10(max(abs(rdamped)))); + if (n_damped > n) + n = n_damped; + end + end + end + n = n + length(b); + elseif isempty(n) + n = length(b); + end + + if length(a) == 1 + x = fftfilt(b/a, [1, zeros(1,n-1)]); + else + x = filter(b, a, [1, zeros(1,n-1)]); + end + t = [0:n-1]/fs; + + if nargout >= 1 x_r = x; end; + if nargout >= 2 t_r = t; end; + if nargout == 0 + unwind_protect + title "Impulse Response"; + if (fs > 1000) + t = t * 1000; + xlabel("Time (msec)"); + else + xlabel("Time (sec)"); + end + plot(t, x, "^r;;"); + unwind_protect_cleanup + title ("") + xlabel ("") + end_unwind_protect + end + +endfunction diff --git a/octave_packages/signal-1.1.3/interp.m b/octave_packages/signal-1.1.3/interp.m new file mode 100644 index 0000000..d129783 --- /dev/null +++ b/octave_packages/signal-1.1.3/interp.m @@ -0,0 +1,58 @@ +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: y = interp(x, q [, n [, Wc]]) +## +## Upsample the signal x by a factor of q, using an order 2*q*n+1 FIR +## filter. Note that q must be an integer for this rate change method. +## n defaults to 4 and Wc defaults to 0.5. +## +## Example +## # Generate a signal. +## t=0:0.01:2; x=chirp(t,2,.5,10,'quadratic')+sin(2*pi*t*0.4); +## y = interp(x(1:4:length(x)),4,4,1); # interpolate a sub-sample +## stem(t(1:121)*1000,x(1:121),"-g;Original;"); hold on; +## stem(t(1:121)*1000,y(1:121),"-r;Interpolated;"); +## stem(t(1:4:121)*1000,x(1:4:121),"-b;Subsampled;"); hold off; +## +## See also: decimate, resample + +function y = interp(x, q, n = 4, Wc = 0.5) + + if nargin < 1 || nargin > 4, + print_usage; + endif + if q != fix(q), error("decimate only works with integer q."); endif + + if rows(x)>1 + y = zeros(length(x)*q+q*n+1,1); + else + y = zeros(1,length(x)*q+q*n+1); + endif + y(1:q:length(x)*q) = x; + b = fir1(2*q*n+1, Wc/q); + y=q*fftfilt(b, y); + y(1:q*n+1) = []; # adjust for zero filter delay +endfunction + +%!demo +%! ## Generate a signal. +%! t=0:0.01:2; x=chirp(t,2,.5,10,'quadratic')+sin(2*pi*t*0.4); +%! y = interp(x(1:4:length(x)),4,4,1); # interpolate a sub-sample +%! plot(t(1:121)*1000,y(1:121),"r-+;Interpolated;"); hold on; +%! stem(t(1:4:121)*1000,x(1:4:121),"ob;Original;"); hold off; +%! +%! % graph shows interpolated signal following through the +%! % sample points of the original signal. diff --git a/octave_packages/signal-1.1.3/invfreq.m b/octave_packages/signal-1.1.3/invfreq.m new file mode 100644 index 0000000..45f5a6d --- /dev/null +++ b/octave_packages/signal-1.1.3/invfreq.m @@ -0,0 +1,234 @@ +%% Copyright (C) 1986, 2000, 2003 Julius O. Smith III +%% Copyright (C) 2007 Rolf Schirmacher +%% Copyright (C) 2003 Andrew Fitting +%% Copyright (C) 2010 Pascal Dupuis +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% usage: [B,A] = invfreq(H,F,nB,nA) +%% [B,A] = invfreq(H,F,nB,nA,W) +%% [B,A] = invfreq(H,F,nB,nA,W,[],[],plane) +%% [B,A] = invfreq(H,F,nB,nA,W,iter,tol,plane) +%% +%% Fit filter B(z)/A(z) or B(s)/A(s) to complex frequency response at +%% frequency points F. A and B are real polynomial coefficients of order +%% nA and nB respectively. Optionally, the fit-errors can be weighted vs +%% frequency according to the weights W. Also, the transform plane can be +%% specified as either 's' for continuous time or 'z' for discrete time. 'z' +%% is chosen by default. Eventually, Steiglitz-McBride iterations will be +%% specified by iter and tol. +%% +%% H: desired complex frequency response +%% It is assumed that A and B are real polynomials, hence H is one-sided. +%% F: vector of frequency samples in radians +%% nA: order of denominator polynomial A +%% nB: order of numerator polynomial B +%% plane='z': F on unit circle (discrete-time spectra, z-plane design) +%% plane='s': F on jw axis (continuous-time spectra, s-plane design) +%% H(k) = spectral samples of filter frequency response at points zk, +%% where zk=exp(sqrt(-1)*F(k)) when plane='z' (F(k) in [0,.5]) +%% and zk=(sqrt(-1)*F(k)) when plane='s' (F(k) nonnegative) +%% Example: +%% [B,A] = butter(12,1/4); +%% [H,w] = freqz(B,A,128); +%% [Bh,Ah] = invfreq(H,F,4,4); +%% Hh = freqz(Bh,Ah); +%% disp(sprintf('||frequency response error|| = %f',norm(H-Hh))); +%% +%% References: J. O. Smith, "Techniques for Digital Filter Design and System +%% Identification with Application to the Violin, Ph.D. Dissertation, +%% Elec. Eng. Dept., Stanford University, June 1983, page 50; or, +%% +%% http://ccrma.stanford.edu/~jos/filters/FFT_Based_Equation_Error_Method.html + +%% TODO: implement Steiglitz-McBride iterations +%% TODO: improve numerical stability for high order filters (matlab is a bit better) +%% TODO: modify to accept more argument configurations + +function [B, A, SigN] = invfreq(H, F, nB, nA, W, iter, tol, tr, plane, varargin) + if length(nB) > 1, zB = nB(2); nB = nB(1); else zB = 0; end + n = max(nA, nB); + m = n+1; mA = nA+1; mB = nB+1; + nF = length(F); + if nF ~= length(H), disp('invfreqz: length of H and F must be the same'); end; + if nargin < 5 || isempty(W), W = ones(1, nF); end; + if nargin < 6, iter = []; end + if nargin < 7 tol = []; end + if nargin < 8 || isempty(tr), tr = ''; end + if nargin < 9, plane = 'z'; end + if nargin < 10, varargin = {}; end + if iter~=[], disp('no implementation for iter yet'),end + if tol ~=[], disp('no implementation for tol yet'),end + if (plane ~= 'z' && plane ~= 's'), disp('invfreqz: Error in plane argument'), end + + [reg, prop ] = parseparams(varargin); + %# should we normalise freqs to avoid matrices with rank deficiency ? + norm = false; + %# by default, use Ordinary Least Square to solve normal equations + method = 'LS'; + if length(prop) > 0 + indi = 1; while indi <= length(prop) + switch prop{indi} + case 'norm' + if indi < length(prop) && ~ischar(prop{indi+1}), + norm = logical(prop{indi+1}); + prop(indi:indi+1) = []; + continue + else + norm = true; prop(indi) = []; + continue + end + case 'method' + if indi < length(prop) && ischar(prop{indi+1}), + method = prop{indi+1}; + prop(indi:indi+1) = []; + continue + else + error('invfreq.m: incorrect/missing method argument'); + end + otherwise %# FIXME: just skip it for now + disp(sprintf("Ignoring unkown argument %s", varargin{indi})); + indi = indi + 1; + end + end + end + + Ruu = zeros(mB, mB); Ryy = zeros(nA, nA); Ryu = zeros(nA, mB); + Pu = zeros(mB, 1); Py = zeros(nA,1); + if strcmp(tr,'trace') + disp(' ') + disp('Computing nonuniformly sampled, equation-error, rational filter.'); + disp(['plane = ',plane]); + disp(' ') + end + + s = sqrt(-1)*F; + switch plane + case 'z' + if max(F) > pi || min(F) < 0 + disp('hey, you frequency is outside the range 0 to pi, making my own') + F = linspace(0, pi, length(H)); + s = sqrt(-1)*F; + end + s = exp(-s); + case 's' + if max(F) > 1e6 && n > 5, + if ~norm, + disp('Be carefull, there are risks of generating singular matrices'); + disp('Call invfreqs as (..., "norm", true) to avoid it'); + else + Fmax = max(F); s = sqrt(-1)*F/Fmax; + end + end + end + + for k=1:nF, + Zk = (s(k).^[0:n]).'; + Hk = H(k); + aHks = Hk*conj(Hk); + Rk = (W(k)*Zk)*Zk'; + rRk = real(Rk); + Ruu = Ruu + rRk(1:mB, 1:mB); + Ryy = Ryy + aHks*rRk(2:mA, 2:mA); + Ryu = Ryu + real(Hk*Rk(2:mA, 1:mB)); + Pu = Pu + W(k)*real(conj(Hk)*Zk(1:mB)); + Py = Py + (W(k)*aHks)*real(Zk(2:mA)); + end; + Rr = ones(length(s), mB+nA); Zk = s; + for k = 1:min(nA, nB), + Rr(:, 1+k) = Zk; + Rr(:, mB+k) = -Zk.*H; + Zk = Zk.*s; + end + for k = 1+min(nA, nB):max(nA, nB)-1, + if k <= nB, Rr(:, 1+k) = Zk; end + if k <= nA, Rr(:, mB+k) = -Zk.*H; end + Zk = Zk.*s; + end + k = k+1; + if k <= nB, Rr(:, 1+k) = Zk; end + if k <= nA, Rr(:, mB+k) = -Zk.*H; end + + %# complex to real equation system -- this ensures real solution + Rr = Rr(:, 1+zB:end); + Rr = [real(Rr); imag(Rr)]; Pr = [real(H(:)); imag(H(:))]; + %# normal equations -- keep for ref + %# Rn= [Ruu(1+zB:mB, 1+zB:mB), -Ryu(:, 1+zB:mB)'; -Ryu(:, 1+zB:mB), Ryy]; + %# Pn= [Pu(1+zB:mB); -Py]; + + switch method + case {'ls' 'LS'} + %# avoid scaling errors with Theta = R\P; + %# [Q, R] = qr([Rn Pn]); Theta = R(1:end, 1:end-1)\R(1:end, end); + [Q, R] = qr([Rr Pr], 0); Theta = R(1:end-1, 1:end-1)\R(1:end-1, end); + %# SigN = R(end, end-1); + SigN = R(end, end); + case {'tls' 'TLS'} + % [U, S, V] = svd([Rn Pn]); + % SigN = S(end, end-1); + % Theta = -V(1:end-1, end)/V(end, end); + [U, S, V] = svd([Rr Pr], 0); + SigN = S(end, end); + Theta = -V(1:end-1, end)/V(end, end); + case {'mls' 'MLS' 'qr' 'QR'} + % [Q, R] = qr([Rn Pn], 0); + %# solve the noised part -- DO NOT USE ECONOMY SIZE ! + % [U, S, V] = svd(R(nA+1:end, nA+1:end)); + % SigN = S(end, end-1); + % Theta = -V(1:end-1, end)/V(end, end); + %# unnoised part -- remove B contribution and back-substitute + % Theta = [R(1:nA, 1:nA)\(R(1:nA, end) - R(1:nA, nA+1:end-1)*Theta) + % Theta]; + %# solve the noised part -- economy size OK as #rows > #columns + [Q, R] = qr([Rr Pr], 0); + eB = mB-zB; sA = eB+1; + [U, S, V] = svd(R(sA:end, sA:end)); + %# noised (A) coefficients + Theta = -V(1:end-1, end)/V(end, end); + %# unnoised (B) part -- remove A contribution and back-substitute + Theta = [R(1:eB, 1:eB)\(R(1:eB, end) - R(1:eB, sA:end-1)*Theta) + Theta]; + SigN = S(end, end); + otherwise + error("invfreq: unknown method %s", method); + end + + B = [zeros(zB, 1); Theta(1:mB-zB)].'; + A = [1; Theta(mB-zB+(1:nA))].'; + + if strcmp(plane,'s') + B = B(mB:-1:1); + A = A(mA:-1:1); + if norm, %# Frequencies were normalised -- unscale coefficients + Zk = Fmax.^[n:-1:0].'; + for k = nB:-1:1+zB, B(k) = B(k)/Zk(k); end + for k = nA:-1:1, A(k) = A(k)/Zk(k); end + end + end +endfunction + +%!demo +%! order = 6; % order of test filter +%! fc = 1/2; % sampling rate / 4 +%! n = 128; % frequency grid size +%! [B, A] = butter(order,fc); +%! [H, w] = freqz(B,A,n); +%! [Bh, Ah] = invfreq(H,w,order,order); +%! [Hh, wh] = freqz(Bh,Ah,n); +%! xlabel("Frequency (rad/sample)"); +%! ylabel("Magnitude"); +%! plot(w,[abs(H), abs(Hh)]) +%! legend('Original','Measured'); +%! err = norm(H-Hh); +%! disp(sprintf('L2 norm of frequency response error = %f',err)); diff --git a/octave_packages/signal-1.1.3/invfreqs.m b/octave_packages/signal-1.1.3/invfreqs.m new file mode 100644 index 0000000..2ed9e77 --- /dev/null +++ b/octave_packages/signal-1.1.3/invfreqs.m @@ -0,0 +1,93 @@ +%% Copyright (C) 1986,2003 Julius O. Smith III +%% Copyright (C) 2003 Andrew Fitting +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% Usage: [B,A] = invfreqs(H,F,nB,nA) +%% [B,A] = invfreqs(H,F,nB,nA,W) +%% [B,A] = invfreqs(H,F,nB,nA,W,iter,tol,'trace') +%% +%% Fit filter B(s)/A(s)to the complex frequency response H at frequency +%% points F. A and B are real polynomial coefficients of order nA and nB. +%% Optionally, the fit-errors can be weighted vs frequency according to +%% the weights W. +%% Note: all the guts are in invfreq.m +%% +%% H: desired complex frequency response +%% F: frequency (must be same length as H) +%% nA: order of the denominator polynomial A +%% nB: order of the numerator polynomial B +%% W: vector of weights (must be same length as F) +%% +%% Example: +%% B = [1/2 1]; +%% A = [1 1]; +%% w = linspace(0,4,128); +%% H = freqs(B,A,w); +%% [Bh,Ah] = invfreqs(H,w,1,1); +%% Hh = freqs(Bh,Ah,w); +%% plot(w,[abs(H);abs(Hh)]) +%% legend('Original','Measured'); +%% err = norm(H-Hh); +%% disp(sprintf('L2 norm of frequency response error = %f',err)); + +% TODO: check invfreq.m for todo's + +function [B, A, SigN] = invfreqs(H,F,nB,nA,W,iter,tol,tr, varargin) + + if nargin < 9 + varargin = {}; + if nargin < 8 + tr = ''; + if nargin < 7 + tol = []; + if nargin < 6 + iter = []; + if nargin < 5 + W = ones(1,length(F)); + end + end + end + end + end + + % now for the real work + [B, A, SigN] = invfreq(H, F,nB, nA, W, iter, tol, tr, 's', varargin{:}); +endfunction + +%!demo +%! B = [1/2 1]; +%! B = [1 0 0]; +%! A = [1 1]; +%! %#A = [1 36 630 6930 51975 270270 945945 2027025 2027025]/2027025; +%! A = [1 21 210 1260 4725 10395 10395]/10395; +%! A = [1 6 15 15]/15; +%! w = linspace(0, 8, 128); +%! H0 = freqs(B, A, w); +%! Nn = (randn(size(w))+j*randn(size(w)))/sqrt(2); +%! order = length(A) - 1; +%! [Bh, Ah, Sig0] = invfreqs(H0, w, [length(B)-1 2], length(A)-1); +%! Hh = freqs(Bh,Ah,w); +%! [BLS, ALS, SigLS] = invfreqs(H0+1e-5*Nn, w, [2 2], order, [], [], [], [], "method", "LS"); +%! HLS = freqs(BLS, ALS, w); +%! [BTLS, ATLS, SigTLS] = invfreqs(H0+1e-5*Nn, w, [2 2], order, [], [], [], [], "method", "TLS"); +%! HTLS = freqs(BTLS, ATLS, w); +%! [BMLS, AMLS, SigMLS] = invfreqs(H0+1e-5*Nn, w, [2 2], order, [], [], [], [], "method", "QR"); +%! HMLS = freqs(BMLS, AMLS, w); +%! xlabel("Frequency (rad/sec)"); +%! ylabel("Magnitude"); +%! plot(w,[abs(H0); abs(Hh)]) +%! legend('Original','Measured'); +%! err = norm(H0-Hh); +%! disp(sprintf('L2 norm of frequency response error = %f',err)); diff --git a/octave_packages/signal-1.1.3/invfreqz.m b/octave_packages/signal-1.1.3/invfreqz.m new file mode 100644 index 0000000..2a88e58 --- /dev/null +++ b/octave_packages/signal-1.1.3/invfreqz.m @@ -0,0 +1,87 @@ +%% Copyright (C) 1986,2003 Julius O. Smith III +%% Copyright (C) 2003 Andrew Fitting +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% usage: [B,A] = invfreqz(H,F,nB,nA) +%% [B,A] = invfreqz(H,F,nB,nA,W) +%% [B,A] = invfreqz(H,F,nB,nA,W,iter,tol,'trace') +%% +%% Fit filter B(z)/A(z)to the complex frequency response H at frequency +%% points F. A and B are real polynomial coefficients of order nA and nB. +%% Optionally, the fit-errors can be weighted vs frequency according to +%% the weights W. +%% Note: all the guts are in invfreq.m +%% +%% H: desired complex frequency response +%% F: normalized frequncy (0 to pi) (must be same length as H) +%% nA: order of the denominator polynomial A +%% nB: order of the numerator polynomial B +%% W: vector of weights (must be same length as F) +%% +%% Example: +%% [B,A] = butter(4,1/4); +%% [H,F] = freqz(B,A); +%% [Bh,Ah] = invfreq(H,F,4,4); +%% Hh = freqz(Bh,Ah); +%% disp(sprintf('||frequency response error|| = %f',norm(H-Hh))); + +%% TODO: check invfreq.m for todo's + +function [B, A, SigN] = invfreqz(H, F, nB, nA, W, iter, tol, tr, varargin) + +if nargin < 9 + varargin = {}; + if nargin < 8 + tr = ''; + if nargin < 7 + tol = []; + if nargin < 6 + iter = []; + if nargin < 5 + W = ones(1,length(F)); + end + end + end + end +end + + +% now for the real work +[B, A, SigN] = invfreq(H, F, nB, nA, W, iter, tol, tr, 'z', varargin{:}); + +endfunction + +%!demo +%! order = 9; % order of test filter +%! % going to 10 or above leads to numerical instabilities and large errors +%! fc = 1/2; % sampling rate / 4 +%! n = 128; % frequency grid size +%! [B0, A0] = butter(order, fc); +%! [H0, w] = freqz(B0, A0, n); +%! Nn = (randn(size(w))+j*randn(size(w)))/sqrt(2); +%! [Bh, Ah, Sig0] = invfreqz(H0, w, order, order); +%! [Hh, wh] = freqz(Bh, Ah, n); +%! [BLS, ALS, SigLS] = invfreqz(H0+1e-5*Nn, w, order, order, [], [], [], [], "method", "LS"); +%! HLS = freqz(BLS, ALS, n); +%! [BTLS, ATLS, SigTLS] = invfreqz(H0+1e-5*Nn, w, order, order, [], [], [], [], "method", "TLS"); +%! HTLS = freqz(BTLS, ATLS, n); +%! [BMLS, AMLS, SigMLS] = invfreqz(H0+1e-5*Nn, w, order, order, [], [], [], [], "method", "QR"); +%! HMLS = freqz(BMLS, AMLS, n); +%! xlabel("Frequency (rad/sample)"); +%! ylabel("Magnitude"); +%! plot(w,[abs(H0) abs(Hh)]) +%! legend('Original','Measured'); +%! err = norm(H0-Hh); +%! disp(sprintf('L2 norm of frequency response error = %f',err)); diff --git a/octave_packages/signal-1.1.3/invimpinvar.m b/octave_packages/signal-1.1.3/invimpinvar.m new file mode 100644 index 0000000..30b89fd --- /dev/null +++ b/octave_packages/signal-1.1.3/invimpinvar.m @@ -0,0 +1,149 @@ +## Copyright (c) 2007 R.G.H. Eschauzier +## Copyright (c) 2011 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {[@var{b_out}, @var{a_out}] =} invimpinvar (@var{b}, @var{a}, @var{fs}, @var{tol}) +## @deftypefnx{Function File} {[@var{b_out}, @var{a_out}] =} invimpinvar (@var{b}, @var{a}, @var{fs}) +## @deftypefnx{Function File} {[@var{b_out}, @var{a_out}] =} invimpinvar (@var{b}, @var{a}) +## Converts digital filter with coefficients @var{b} and @var{a} to analog, +## conserving impulse response. +## +## This function does the inverse of impinvar so that the following example should +## restore the original values of @var{a} and @var{b}. +## @example +## [b, a] = impinvar (b, a); +## [b, a] = invimpinvar (b, a); +## @end example +## +## If @var{fs} is not specificied, or is an empty vector, it defaults to 1Hz. +## +## If @var{tol} is not specified, it defaults to 0.0001 (0.1%) +## +## Reference: Thomas J. Cavicchi (1996) ``Impulse invariance and multiple-order +## poles''. IEEE transactions on signal processing, Vol 40 (9): 2344--2347 +## +## @seealso{bilinear, impinvar} +## @end deftypefn + +## Impulse invariant conversion from s to z domain +function [b_out, a_out] = invimpinvar (b_in, a_in, fs = 1, tol = 0.0001) + + if (nargin <2) + print_usage; + endif + + ## to be compatible with the matlab implementation where an empty vector can + ## be used to get the default + if (isempty(fs)) + ts = 1; + else + ts = 1/fs; # we should be using sampling frequencies to be compatible with Matlab + endif + + b_in = [b_in 0]; %so we can calculate in z instead of z^-1 + + [r_in, p_in, k_in] = residue(b_in, a_in); % partial fraction expansion + + n = length(r_in); % Number of poles/residues + + if (length(k_in) > 1) % Greater than one means we cannot do impulse invariance + error("Order numerator > order denominator"); + endif + + r_out = zeros(1,n); % Residues of H(s) + sm_out = zeros(1,n); % Poles of H(s) + + i=1; + while (i<=n) + m=1; + first_pole = p_in(i); % Pole in the z-domain + while (i1) % Go through residues starting from highest order down + r_out(j) = r_in(j) / ((ts * p_in)^j); % Back to binomial coefficient for highest order (always 1) + r_in(1:j) -= r_out(j) * polyrev(h1_z_deriv(j-1,p_in,ts)); % Subtract highest order result, leaving r_in(j) zero + j--; + endwhile + + %% Single pole (no multiplicity) + r_out(1) = r_in(1) / ((ts * p_in)); + k_out = r_in(1) / p_in; + sm_out = log(p_in) / ts; + +endfunction + + +%!function err = ztoserr(bz,az,fs) +%! +%! % number of time steps +%! n=100; +%! +%! % make sure system is realizable (no delays) +%! bz=prepad(bz,length(az)-1,0,2); +%! +%! % inverse impulse invariant transform to s-domain +%! [bs as]=invimpinvar(bz,az,fs); +%! +%! % create sys object of transfer function +%! s=tf(bs,as); +%! +%! % calculate impulse response of continuous time system +%! % at discrete time intervals 1/fs +%! ys=impulse(s,(n-1)/fs,1/fs)'; +%! +%! % impulse response of discrete time system +%! yz=filter(bz,az,[1 zeros(1,n-1)]); +%! +%! % find rms error +%! err=sqrt(sum((yz*fs.-ys).^2)/length(ys)); +%! endfunction +%! +%!assert(ztoserr([1],[1 -0.5],0.01),0,0.0001); +%!assert(ztoserr([1],[1 -1 0.25],0.01),0,0.0001); +%!assert(ztoserr([1 1],[1 -1 0.25],0.01),0,0.0001); +%!assert(ztoserr([1],[1 -1.5 0.75 -0.125],0.01),0,0.0001); +%!assert(ztoserr([1 1],[1 -1.5 0.75 -0.125],0.01),0,0.0001); +%!assert(ztoserr([1 1 1],[1 -1.5 0.75 -0.125],0.01),0,0.0001); +%!assert(ztoserr([1],[1 0 0.25],0.01),0,0.0001); +%!assert(ztoserr([1 1],[1 0 0.25],0.01),0,0.0001); +%!assert(ztoserr([1],[1 0 0.5 0 0.0625],0.01),0,0.0001); +%!assert(ztoserr([1 1],[1 0 0.5 0 0.0625],0.01),0,0.0001); +%!assert(ztoserr([1 1 1],[1 0 0.5 0 0.0625],0.01),0,0.0001); +%!assert(ztoserr([1 1 1 1],[1 0 0.5 0 0.0625],0.01),0,0.0001); diff --git a/octave_packages/signal-1.1.3/kaiser.m b/octave_packages/signal-1.1.3/kaiser.m new file mode 100644 index 0000000..dd4dfc7 --- /dev/null +++ b/octave_packages/signal-1.1.3/kaiser.m @@ -0,0 +1,55 @@ +## Copyright (C) 1995, 1996, 1997 Kurt Hornik +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: kaiser (L, beta) +## +## Returns the filter coefficients of the L-point Kaiser window with +## parameter beta. +## +## For the definition of the Kaiser window, see A. V. Oppenheim & +## R. W. Schafer, "Discrete-Time Signal Processing". +## +## The continuous version of width L centered about x=0 is: +## +## besseli(0, beta * sqrt(1-(2*x/L).^2)) +## k(x) = -------------------------------------, L/2 <= x <= L/2 +## besseli(0, beta) +## +## See also: kaiserord + +function w = kaiser (L, beta = 0.5) + + if (nargin < 1) + print_usage; + elseif !(isscalar (L) && (L == round (L)) && (L > 0)) + error ("kaiser: L has to be a positive integer"); + elseif !(isscalar (beta) && (beta == real (beta))) + error ("kaiser: beta has to be a real scalar"); + endif + + if (L == 1) + w = 1; + else + m = L - 1; + k = (0 : m)'; + k = 2 * beta / m * sqrt (k .* (m - k)); + w = besseli (0, k) / besseli (0, beta); + endif + +endfunction + +%!demo +%! % use demo("kaiserord"); diff --git a/octave_packages/signal-1.1.3/kaiserord.m b/octave_packages/signal-1.1.3/kaiserord.m new file mode 100644 index 0000000..2e7cf25 --- /dev/null +++ b/octave_packages/signal-1.1.3/kaiserord.m @@ -0,0 +1,147 @@ +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [n, Wn, beta, ftype] = kaiserord(f, m, dev [, fs]) +## +## Returns the parameters needed for fir1 to produce a filter of the +## desired specification from a kaiser window: +## n: order of the filter (length of filter minus 1) +## Wn: band edges for use in fir1 +## beta: parameter for kaiser window of length n+1 +## ftype: choose between pass and stop bands +## b = fir1(n,Wn,kaiser(n+1,beta),ftype,'noscale'); +## +## f: frequency bands, given as pairs, with the first half of the +## first pair assumed to start at 0 and the last half of the last +## pair assumed to end at 1. It is important to separate the +## band edges, since narrow transition regions require large order +## filters. +## m: magnitude within each band. Should be non-zero for pass band +## and zero for stop band. All passbands must have the same +## magnitude, or you will get the error that pass and stop bands +## must be strictly alternating. +## dev: deviation within each band. Since all bands in the resulting +## filter have the same deviation, only the minimum deviation is +## used. In this version, a single scalar will work just as well. +## fs: sampling rate. Used to convert the frequency specification into +## the [0, 1], where 1 corresponds to the Nyquist frequency, fs/2. +## +## The Kaiser window parameters n and beta are computed from the +## relation between ripple (A=-20*log10(dev)) and transition width +## (dw in radians) discovered empirically by Kaiser: +## +## / 0.1102(A-8.7) A > 50 +## beta = | 0.5842(A-21)^0.4 + 0.07886(A-21) 21 <= A <= 50 +## \ 0.0 A < 21 +## +## n = (A-8)/(2.285 dw) +## +## Example +## [n, w, beta, ftype] = kaiserord([1000,1200], [1,0], [0.05,0.05], 11025); +## freqz(fir1(n,w,kaiser(n+1,beta),ftype,'noscale'),1,[],11025); + +## TODO: order is underestimated for the final test case: 2 stop bands. +## TODO: octave> ftest("kaiserord") # shows test cases + +function [n, w, beta, ftype] = kaiserord(f, m, dev, fs) + + if (nargin<2 || nargin>4) + print_usage; + endif + + ## default sampling rate parameter + if nargin<4, fs=2; endif + + ## parameter checking + if length(f)!=2*length(m)-2 + error("kaiserord must have one magnitude for each frequency band"); + endif + if any(m(1:length(m)-2)!=m(3:length(m))) + error("kaiserord pass and stop bands must be strictly alternating"); + endif + if length(dev)!=length(m) && length(dev)!=1 + error("kaiserord must have one deviation for each frequency band"); + endif + dev = min(dev); + if dev <= 0, error("kaiserord must have dev>0"); endif + + ## use midpoints of the transition region for band edges + w = (f(1:2:length(f))+f(2:2:length(f)))/fs; + + ## determine ftype + if length(w) == 1 + if m(1)>m(2), ftype='low'; else ftype='high'; endif + elseif length(w) == 2 + if m(1)>m(2), ftype='stop'; else ftype='pass'; endif + else + if m(1)>m(2), ftype='DC-1'; else ftype='DC-0'; endif + endif + + ## compute beta from dev + A = -20*log10(dev); + if (A > 50) + beta = 0.1102*(A-8.7); + elseif (A >= 21) + beta = 0.5842*(A-21)^0.4 + 0.07886*(A-21); + else + beta = 0.0; + endif + + ## compute n from beta and dev + dw = 2*pi*min(f(2:2:length(f))-f(1:2:length(f)))/fs; + n = max(1,ceil((A-8)/(2.285*dw))); + + ## if last band is high, make sure the order of the filter is even. + if ((m(1)>m(2)) == (rem(length(w),2)==0)) && rem(n,2)==1, n = n+1; endif +endfunction + +%!demo +%! Fs = 11025; +%! for i=1:4 +%! if i==1, +%! subplot(221); bands=[1200, 1500]; mag=[1, 0]; dev=[0.1, 0.1]; +%! elseif i==2 +%! subplot(222); bands=[1000, 1500]; mag=[0, 1]; dev=[0.1, 0.1]; +%! elseif i==3 +%! subplot(223); bands=[1000, 1200, 3000, 3500]; mag=[0, 1, 0]; dev=0.1; +%! elseif i==4 +%! subplot(224); bands=100*[10, 13, 15, 20, 30, 33, 35, 40]; +%! mag=[1, 0, 1, 0, 1]; dev=0.05; +%! endif +%! [n, w, beta, ftype] = kaiserord(bands, mag, dev, Fs); +%! d=max(1,fix(n/10)); +%! if mag(length(mag))==1 && rem(d,2)==1, d=d+1; endif +%! [h, f] = freqz(fir1(n,w,ftype,kaiser(n+1,beta),'noscale'),1,[],Fs); +%! hm = freqz(fir1(n-d,w,ftype,kaiser(n-d+1,beta),'noscale'),1,[],Fs); +%! plot(f,abs(hm),sprintf("r;order %d;",n-d), ... +%! f,abs(h), sprintf("b;order %d;",n)); +%! b = [0, bands, Fs/2]; hold on; +%! for i=2:2:length(b), +%! hi=mag(i/2)+dev(1); lo=max(mag(i/2)-dev(1),0); +%! plot([b(i-1), b(i), b(i), b(i-1), b(i-1)],[hi, hi, lo, lo, hi],"c;;"); +%! endfor; hold off; +%! endfor +%! +%! %-------------------------------------------------------------- +%! % A filter meets the specifications if its frequency response +%! % passes through the ends of the criteria boxes, and fails if +%! % it passes through the top or the bottom. The criteria are +%! % met precisely if the frequency response only passes through +%! % the corners of the boxes. The blue line is the filter order +%! % returned by kaiserord, and the red line is some lower filter +%! % order. Confirm that the blue filter meets the criteria and +%! % the red line fails. + +%!# XXX FIXME XXX extend demo to show detail at criteria box corners diff --git a/octave_packages/signal-1.1.3/levinson.m b/octave_packages/signal-1.1.3/levinson.m new file mode 100644 index 0000000..6cb2002 --- /dev/null +++ b/octave_packages/signal-1.1.3/levinson.m @@ -0,0 +1,84 @@ +## Copyright (C) 1999 Paul Kienzle +## Copyright (C) 2006 Peter V. Lanspeary, +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [a, v, ref] = levinson (acf [, p]) +## +## Use the Durbin-Levinson algorithm to solve: +## toeplitz(acf(1:p)) * x = -acf(2:p+1). +## The solution [1, x'] is the denominator of an all pole filter +## approximation to the signal x which generated the autocorrelation +## function acf. +## +## acf is the autocorrelation function for lags 0 to p. +## p defaults to length(acf)-1. +## Returns +## a=[1, x'] the denominator filter coefficients. +## v= variance of the white noise = square of the numerator constant +## ref = reflection coefficients = coefficients of the lattice +## implementation of the filter +## Use freqz(sqrt(v),a) to plot the power spectrum. +## +## REFERENCE +## [1] Steven M. Kay and Stanley Lawrence Marple Jr.: +## "Spectrum analysis -- a modern perspective", +## Proceedings of the IEEE, Vol 69, pp 1380-1419, Nov., 1981 + +## Based on: +## yulewalker.m +## Copyright (C) 1995 Friedrich Leisch +## GPL license + +## TODO: Matlab doesn't return reflection coefficients and +## TODO: errors in addition to the polynomial a. +## TODO: What is the difference between aryule, levinson, +## TODO: ac2poly, ac2ar, lpc, etc.? + +function [a, v, ref] = levinson (acf, p) + if ( nargin<1 ) + print_usage; + elseif( ~isvector(acf) || length(acf)<2 ) + error( "levinson: arg 1 (acf) must be vector of length >1\n"); + elseif ( nargin>1 && ( ~isscalar(p) || fix(p)~=p ) ) + error( "levinson: arg 2 (p) must be integer >0\n"); + else + if ((nargin == 1)||(p>=length(acf))) p = length(acf) - 1; endif + if( columns(acf)>1 ) acf=acf(:); endif # force a column vector + + if nargout < 3 && p < 100 + ## direct solution [O(p^3), but no loops so slightly faster for small p] + ## Kay & Marple Eqn (2.39) + R = toeplitz(acf(1:p), conj(acf(1:p))); + a = R \ -acf(2:p+1); + a = [ 1, a.' ]; + v = real( a*conj(acf(1:p+1)) ); + else + ## durbin-levinson [O(p^2), so significantly faster for large p] + ## Kay & Marple Eqns (2.42-2.46) + ref = zeros(p,1); + g = -acf(2)/acf(1); + a = [ g ]; + v = real( ( 1 - g*conj(g)) * acf(1) ); + ref(1) = g; + for t = 2 : p + g = -(acf(t+1) + a * acf(t:-1:2)) / v; + a = [ a+g*conj(a(t-1:-1:1)), g ]; + v = v * ( 1 - real(g*conj(g)) ) ; + ref(t) = g; + endfor + a = [1, a]; + endif + endif +endfunction diff --git a/octave_packages/signal-1.1.3/marcumq.m b/octave_packages/signal-1.1.3/marcumq.m new file mode 100644 index 0000000..d9dac9e --- /dev/null +++ b/octave_packages/signal-1.1.3/marcumq.m @@ -0,0 +1,389 @@ +## Copyright (C) 2012 Robert T. Short +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{Q} = } marcumq (@var{a}, @var{b}) +## @deftypefnx {Function File} {@var{Q} = } marcumq (@var{a}, @var{b}, @var{m}) +## @deftypefnx {Function File} {@var{Q} = } marcumq (@var{a}, @var{b}, @var{m}, @var{tol}) +## +## Compute the generalized Marcum Q function of order @var{M} with +## noncentrality parameter @var{a} and argument @var{b}. If the order +## @var{M} is omitted it defaults to 1. An optional relative tolerance +## @var{tol} may be included, the default is @code{eps}. +## +## If the input arguments are commensurate vectors, this function +## will produce a table of values. +## +## This function computes Marcum's Q function using the infinite +## Bessel series, truncated when the relative error is less than +## the specified tolerance. The accuracy is limited by that of +## the Bessel functions, so reducing the tolerance is probably +## not useful. +## +## Reference: Marcum, "Tables of Q Functions", Rand Corporation. +## +## Reference: R.T. Short, "Computation of Noncentral Chi-squared +## and Rice Random Variables", www.phaselockedsystems.com/publications +## +## @end deftypefn + +function Q = marcumq(a,b,M=1,tol=eps) + + if ( (nargin<2) || (nargin>4) ) + print_usage(); + end + if ( any(a<0) || any(b<0) ) + error("Parameters to marcumq must be positive"); + end + if ( any(M<0) || any(floor(M)~=M) ) + error("M must be a positive integer"); + end + + nr = max([size(a,1) size(b,1) size(M,1)]); + nc = max([size(a,2) size(b,2) size(M,2)]); + a = padarray(a, [nr - size(a,1) nc - size(a,2)], "replicate", "post"); + b = padarray(b, [nr - size(b,1) nc - size(b,2)], "replicate", "post"); + M = padarray(M, [nr - size(M,1) nc - size(M,2)], "replicate", "post"); + + Q = arrayfun(@mq, a,b,M,tol); + +end + +% Subfunction to compute the actual Marcum Q function. +function Q = mq(a,b,M,tol) + % Special cases. + if (b==0) + Q = 1; + N = 0; + return; + end + if (a==0) + k = 0:(M-1); + Q = exp(-b^2/2)*sum(b.^(2*k)./(2.^k .* factorial(k))); + N = 0; + return; + end + + % The basic iteration. If a1 were generating from Marcum's tables by +% using the formula +% Q_M(a,b) = Q(a,b) + exp(-(a-b)^2/2)*sum_{k=1}^{M-1}(b/a)^k*exp(-ab)*I_k(ab) +% +%!test +%! M = 2; +%! a = [0.00;0.05;1.00;2.00;3.00;4.00;5.00;6.00;7.00;8.00;9.00;10.00;11.00;12.00;13.00;14.00;15.00;16.00;17.00;18.00;19.00;20.00;21.00;22.00;23.00;24.000000]; +%! +%! b = [ 0.00, 0.10, 2.10, 7.10, 12.10, 17.10]; +%! Q = [1.000000, 0.999987, 0.353353, 0.000000, 0.000000, 0.000000; +%! 1.000000, 0.999988, 0.353687, 0.000000, 0.000000, 0.000000; +%! 1.000000, 0.999992, 0.478229, 0.000000, 0.000000, 0.000000; +%! 1.000000, 0.999999, 0.745094, 0.000001, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.934771, 0.000077, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.992266, 0.002393, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.999607, 0.032264, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.999992, 0.192257, 0.000000, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.545174, 0.000000, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.864230, 0.000040, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.981589, 0.001555, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.998957, 0.024784, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.999976, 0.166055, 0.000000; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.509823, 0.000000; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.846066, 0.000032; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.978062, 0.001335; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.998699, 0.022409; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.999970, 0.156421; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.495223; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.837820; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.976328; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.998564; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999966; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000]; +%! q = marcumq(a,b,M); +%! assert(q,Q,1e-6); + +%!test +%! M = 5; +%! a = [0.00;0.05;1.00;2.00;3.00;4.00;5.00;6.00;7.00;8.00;9.00;10.00;11.00;12.00;13.00;14.00;15.00;16.00;17.00;18.00;19.00;20.00;21.00;22.00;23.00;24.000000]; +%! +%! b = [ 0.00, 0.10, 2.10, 7.10, 12.10, 17.10]; +%! Q = [1.000000, 1.000000, 0.926962, 0.000000, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.927021, 0.000000, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.947475, 0.000001, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.980857, 0.000033, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.996633, 0.000800, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.999729, 0.011720, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.999990, 0.088999, 0.000000, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.341096, 0.000000, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.705475, 0.000002, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.933009, 0.000134, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.993118, 0.003793, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.999702, 0.045408, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.999995, 0.238953, 0.000000; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.607903, 0.000001; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.896007, 0.000073; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.987642, 0.002480; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.999389, 0.034450; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.999988, 0.203879; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.565165; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.876284; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.984209; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999165; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999983; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000]; +%! q = marcumq(a,b,M); +%! assert(q,Q,1e-6); + +%!test +%! M = 10; +%! a = [0.00;0.05;1.00;2.00;3.00;4.00;5.00;6.00;7.00;8.00;9.00;10.00;11.00;12.00;13.00;14.00;15.00;16.00;17.00;18.00;19.00;20.00;21.00;22.00;23.00;24.000000]; +%! +%! b = [ 0.00, 0.10, 2.10, 7.10, 12.10, 17.10]; +%! Q = [1.000000, 1.000000, 0.999898, 0.000193, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.999897, 0.000194, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.999931, 0.000416, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.999980, 0.002377, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.999997, 0.016409, 0.000000, 0.000000; +%! 1.000000, 1.000000, 0.999999, 0.088005, 0.000000, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.302521, 0.000000, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.638401, 0.000000, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.894322, 0.000022, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.984732, 0.000840, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.998997, 0.014160, 0.000000; +%! 1.000000, 1.000000, 1.000000, 0.999972, 0.107999, 0.000000; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.391181, 0.000000; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.754631, 0.000004; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.951354, 0.000266; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.995732, 0.006444; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.999843, 0.065902; +%! 1.000000, 1.000000, 1.000000, 1.000000, 0.999998, 0.299616; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.676336; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.925312; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.992390; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999679; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999995; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; +%! 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000]; +%! q = marcumq(a,b,M); +%! assert(q,Q,1e-6); diff --git a/octave_packages/signal-1.1.3/mexihat.m b/octave_packages/signal-1.1.3/mexihat.m new file mode 100644 index 0000000..410b462 --- /dev/null +++ b/octave_packages/signal-1.1.3/mexihat.m @@ -0,0 +1,29 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{psi,x}] =} mexihat(@var{lb,ub,n}) +## Compute the Mexican hat wavelet. +## @end deftypefn + +function [psi,x] = mexihat(lb,ub,n) + if (nargin < 3); print_usage; end + + if (n <= 0) + error("n must be strictly positive"); + endif + x = linspace(lb,ub,n); + psi = (1-x.^2).*(2/(sqrt(3)*pi^0.25)) .* exp(-x.^2/2) ; +endfunction diff --git a/octave_packages/signal-1.1.3/meyeraux.m b/octave_packages/signal-1.1.3/meyeraux.m new file mode 100644 index 0000000..f5dc12e --- /dev/null +++ b/octave_packages/signal-1.1.3/meyeraux.m @@ -0,0 +1,25 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y}] =} meyeraux(@var{x}) +## Compute the Meyer wavelet auxiliary function. +## @end deftypefn + +function [y] = meyeraux(x) + if (nargin < 1); print_usage; end + + y = 35.*x.^4-84.*x.^5+70.*x.^6-20.*x.^7; +endfunction diff --git a/octave_packages/signal-1.1.3/morlet.m b/octave_packages/signal-1.1.3/morlet.m new file mode 100644 index 0000000..d25d14b --- /dev/null +++ b/octave_packages/signal-1.1.3/morlet.m @@ -0,0 +1,29 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{psi,x}] =} morlet(@var{lb,ub,n}) +## Compute the Morlet wavelet. +## @end deftypefn + +function [psi,x] = morlet(lb,ub,n) + if (nargin < 3); print_usage; end + + if (n <= 0) + error("n must be strictly positive"); + endif + x = linspace(lb,ub,n); + psi = cos(5.*x) .* exp(-x.^2/2) ; +endfunction diff --git a/octave_packages/signal-1.1.3/mscohere.m b/octave_packages/signal-1.1.3/mscohere.m new file mode 100644 index 0000000..2cd7674 --- /dev/null +++ b/octave_packages/signal-1.1.3/mscohere.m @@ -0,0 +1,52 @@ +%% Copyright (C) 2006 Peter V. Lanspeary +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% Usage: +%% [Pxx,freq]=mscohere(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) +%% +%% Estimate (mean square) coherence of signals "x" and "y". +%% Use the Welch (1967) periodogram/FFT method. +%% See "help pwelch" for description of arguments, hints and references + + +function [varargout] = mscohere(varargin) + %% + %% Check fixed argument + if ( nargin<2 ) + error( 'mscohere: Need at least 2 args. Use help mscohere' ); + end + nvarargin = length(varargin); + %% remove any pwelch RESULT args and add 'cross' + for iarg=1:nvarargin + arg = varargin{iarg}; + if ( ~isempty(arg) && ischar(arg) && ( strcmp(arg,'power') || ... + strcmp(arg,'cross') || strcmp(arg,'trans') || ... + strcmp(arg,'coher') || strcmp(arg,'ypower') )) + varargin{iarg} = []; + end + end + varargin{nvarargin+1} = 'coher'; + %% + if ( nargout==0 ) + pwelch(varargin{:}); + elseif ( nargout==1 ) + Pxx = pwelch(varargin{:}); + varargout{1} = Pxx; + elseif ( nargout>=2 ) + [Pxx,f] = pwelch(varargin{:}); + varargout{1} = Pxx; + varargout{2} = f; + end +end diff --git a/octave_packages/signal-1.1.3/ncauer.m b/octave_packages/signal-1.1.3/ncauer.m new file mode 100644 index 0000000..7a1c7f7 --- /dev/null +++ b/octave_packages/signal-1.1.3/ncauer.m @@ -0,0 +1,133 @@ +## Copyright (C) 2001 Paulo Neis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [Zz, Zp, Zg] = ncauer(Rp, Rs, n) +## +## Analog prototype for Cauer filter. +## [z, p, g]=ncauer(Rp, Rs, ws) +## Rp = Passband ripple +## Rs = Stopband ripple +## Ws = Desired order +## +## References: +## +## - Serra, Celso Penteado, Teoria e Projeto de Filtros, Campinas: CARTGRAF, +## 1983. +## - Lamar, Marcus Vinicius, Notas de aula da disciplina TE 456 - Circuitos +## Analogicos II, UFPR, 2001/2002. + +function [zer, pol, T0]=ncauer(Rp, Rs, n) + + ## Cutoff frequency = 1: + wp=1; + + ## Stop band edge ws: + ws=__ellip_ws(n, Rp, Rs); + + k=wp/ws; + k1=sqrt(1-k^2); + q0=(1/2)*((1-sqrt(k1))/(1+sqrt(k1))); + q= q0 + 2*q0^5 + 15*q0^9 + 150*q0^13; %(....) + D=(10^(0.1*Rs)-1)/(10^(0.1*Rp)-1); + + ##Filter order maybe this, but not used now: + ##n=ceil(log10(16*D)/log10(1/q)) + + l=(1/(2*n))*log((10^(0.05*Rp)+1)/(10^(0.05*Rp)-1)); + sig01=0; sig02=0; + for m=0 : 30 + sig01=sig01+(-1)^m * q^(m*(m+1)) * sinh((2*m+1)*l); + end + for m=1 : 30 + sig02=sig02+(-1)^m * q^(m^2) * cosh(2*m*l); + end + sig0=abs((2*q^(1/4)*sig01)/(1+2*sig02)); + + w=sqrt((1+k*sig0^2)*(1+sig0^2/k)); + # + if rem(n,2) + r=(n-1)/2; + else + r=n/2; + end + # + wi=zeros(1,r); + for ii=1 : r + if rem(n,2) + mu=ii; + else + mu=ii-1/2; + end + soma1=0; + for m=0 : 30 + soma1 = soma1 + 2*q^(1/4) * ((-1)^m * q^(m*(m+1)) * sin(((2*m+1)*pi*mu)/n)); + end + soma2=0; + for m=1 : 30 + soma2 = soma2 + 2*((-1)^m * q^(m^2) * cos((2*m*pi*mu)/n)); + end + wi(ii)=(soma1/(1+soma2)); + end + # + Vi=sqrt((1-(k.*(wi.^2))).*(1-(wi.^2)/k)); + A0i=1./(wi.^2); + sqrA0i=1./(wi); + B0i=((sig0.*Vi).^2 + (w.*wi).^2)./((1+sig0^2.*wi.^2).^2); + B1i=(2 * sig0.*Vi)./(1 + sig0^2 * wi.^2); + + ##Gain T0: + if rem(n,2) + T0=sig0*prod(B0i./A0i)*sqrt(ws); + else + T0=10^(-0.05*Rp)*prod(B0i./A0i); + end + + ##zeros: + zer=[i*sqrA0i, -i*sqrA0i]; + + ##poles: + pol=[(-2*sig0*Vi+2*i*wi.*w)./(2*(1+sig0^2*wi.^2)), (-2*sig0*Vi-2*i*wi.*w)./(2*(1+sig0^2*wi.^2))]; + + ##If n odd, there is a real pole -sig0: + if rem(n,2) + pol=[pol, -sig0]; + end + + ## + pol=(sqrt(ws)).*pol; + zer=(sqrt(ws)).*zer; + +endfunction + +## usage: ws = __ellip_ws(n, rp, rs) +## Calculate the stop band edge for the Cauer filter. +function ws=__ellip_ws(n, rp, rs) + kl0 = ((10^(0.1*rp)-1)/(10^(0.1*rs)-1)); + k0 = (1-kl0); + int = ellipke([kl0 ; k0]); + ql0 = int(1); + q0 = int(2); + x = n*ql0/q0; + kl = fminbnd(@(y) __ellip_ws_min(y,x) ,eps, 1-eps); + ws = sqrt(1/kl); +endfunction + +## usage: err = __ellip_ws_min(kl, x) +function err=__ellip_ws_min(kl, x) + int=ellipke([kl; 1-kl]); + ql=int(1); + q=int(2); + err=abs((ql/q)-x); +endfunction diff --git a/octave_packages/signal-1.1.3/nuttallwin.m b/octave_packages/signal-1.1.3/nuttallwin.m new file mode 100644 index 0000000..5493768 --- /dev/null +++ b/octave_packages/signal-1.1.3/nuttallwin.m @@ -0,0 +1,42 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{w}] =} nuttallwin(@var{L}) +## Compute the Blackman-Harris window defined by Nuttall of length L. +## @seealso{blackman, blackmanharris} +## @end deftypefn + +function [w] = nuttallwin(L) + if (nargin != 1); print_usage; end + + if(L < 0) + error('L must be positive'); + end + + if(L ~= floor(L)) + L = round(L); + warning('L rounded to the nearest integer.'); + end + + N = L-1; + a0 = 0.355768; + a1 = 0.487396; + a2 = 0.144232; + a3 = 0.012604; + n = -N/2:N/2; + w = a0 + a1.*cos(2.*pi.*n./N) + a2.*cos(4.*pi.*n./N) + a3.*cos(6.*pi.*n./N); + w = w'; +endfunction diff --git a/octave_packages/signal-1.1.3/packinfo/.autoload b/octave_packages/signal-1.1.3/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/signal-1.1.3/packinfo/DESCRIPTION b/octave_packages/signal-1.1.3/packinfo/DESCRIPTION new file mode 100644 index 0000000..dff6158 --- /dev/null +++ b/octave_packages/signal-1.1.3/packinfo/DESCRIPTION @@ -0,0 +1,11 @@ +Name: Signal +Version: 1.1.3 +Date: 2012-05-12 +Author: various authors +Maintainer: Octave-Forge community +Title: Signal Processing. +Description: Signal processing tools, including filtering, windowing and display functions. +Depends: octave (>= 3.6.0), optim (>= 1.0.0), specfun, control (>= 2.2.3), image +Autoload: yes +License: GPLv3+, public domain +Url: http://octave.sf.net diff --git a/octave_packages/signal-1.1.3/packinfo/INDEX b/octave_packages/signal-1.1.3/packinfo/INDEX new file mode 100644 index 0000000..1ad2237 --- /dev/null +++ b/octave_packages/signal-1.1.3/packinfo/INDEX @@ -0,0 +1,162 @@ +$SPCTOOLS= in spline directory of Dennis Brown's SPCtools +$TFTB= try Time-Frequency Tool box + +signal >> Signal processing +Signals + diric + gauspuls + gmonopuls + pulstran + tripuls + rectpuls + sawtooth + square + chirp + vco modulate demod= $TFTB + specgram + buffer + mexihat + meyeraux + morlet + shanwavf + cmorwavf + sigmoid_train +Filtering + filtfilt + filtic + sgolayfilt + sosfilt + medfilt1 +Filter analysis + freqs freqs_plot + grpdelay + impz + zplane + fwhm +Filter conversion + convmtx + residuez + residued + sos2tf + sos2zp + ss2tf + ss2zp + tf2sos + tf2ss + tf2zp + zp2sos + zp2ss + zp2tf + polystab +IIR Filter design + besself + butter + cheby1 + cheby2 + ellip + ncauer + buttord + cheb1ord + cheb2ord + ellipord + besselap + sftrans + bilinear + impinvar + iirlp2mb +FIR filter design + fir1 + fir2 + firls + kaiserord + remez + sgolay + qp_kaiser + cl2bp +Transforms + czt + dctmtx + dct2 + idct2 + dct + idct + dst + idst + dftmtx + hilbert + rceps + cceps + cplxreal + bitrevorder + dwt + fht + ifht +Power spectrum analysis + pwelch + tfe + tfestimate + cohere + csd + ar_psd + cpsd + mscohere + pburg + pcov pmcov pmtm pmusic= $SPCTOOLS + pyulear + xcorr + xcorr2 + xcov + __power +Window functions + window + barthannwin + blackmanharris + blackmannuttall + bohmanwin + boxcar + chebwin flattopwin + hann + kaiser + nuttallwin + triang + gaussian gausswin + tukeywin + rectwin + welchwin + parzenwin +System identification + arburg + arcov= use ar_covar $SPCTOOLS + armcov= use ar_mdcov $SPCTOOLS + prony= use ar_prony $SPCTOOLS + aryule + invfreq + invfreqs + invfreqz + levinson +Sample rate change + decimate + interp + downsample + upsample + resample + upfirdn + data2fun +Compatibility + buttap= use butter(n,1,'s') + cheb1ap= use cheby1(n,Rp,1,'s') + cheb2ap= use cheby2(n,Rs,1,'s') + ellipap= use ellip(n,Rp,Rs,1,'s') + lp2bp= use sftrans + lp2bs= use sftrans + lp2hp= use sftrans + lp2lp= use sftrans + yulewalk=use yulewalker +Utility + buffer + fracshift + marcumq + wkeep + wrev + zerocrossing + sampled2continuous diff --git a/octave_packages/signal-1.1.3/packinfo/NEWS b/octave_packages/signal-1.1.3/packinfo/NEWS new file mode 100644 index 0000000..35ba83b --- /dev/null +++ b/octave_packages/signal-1.1.3/packinfo/NEWS @@ -0,0 +1,69 @@ +Summary of important user-visible changes for releases of the signal package + +=============================================================================== +signal-1.1.3 Release Date: 2012-05-12 Release Manager: Carnë Draug +=============================================================================== + + ** signal is no longer dependent on the audio package. + + ** signal is now dependent on the image package. + + ** The function `marcumq' was imported from the communications package and has + been completely rewritten to improve performance and fix computational + errors. + + ** Package is no longer automatically loaded. + + ** The functions `__ellip_ws' and `__ellip_ws_min' have been removed (they + are now subfunctions of `ncauer'. + + ** The function `blackmanharris' was fixed to have even symmetry. + +=============================================================================== +signal-1.1.2 Release Date: 2012-01-06 Release Manager: Lukas Reichlin +=============================================================================== + + * Added the following filter conversion functions: + ss2tf + ss2zp + tf2ss + tf2zp + zp2ss + zp2tf + +=============================================================================== +signal-1.1.1 Release Date: 2011-11-06 Release Manager: Juan Pablo Carbajal +=============================================================================== + + * Following function now show help text correctly instead of copyright notice: + downsample + dst + flattopwin + fwhm + idst + square + upsample + * Apply pathc by Paul Dreik to cl2bp_lib.h. + +=============================================================================== +signal-1.1.0 Release Date: 2011-11-04 Release Manager: Juan Pablo Carbajal +=============================================================================== + +* Minor bug fixes in: + blackmannuttall.m + xcorr.m + filtfilt.m + invfreq.m + invfreqs.m + resample.m + +* New functions added: + data2fun.m + impinvar.m + invimpinvar.m + sigmoid_train.m + pei_tseng_notch.m + iirlp2mb.m + +* Not implemented functions removed from the documentation. +* All demos are now working! diff --git a/octave_packages/signal-1.1.3/parzenwin.m b/octave_packages/signal-1.1.3/parzenwin.m new file mode 100644 index 0000000..62cee3b --- /dev/null +++ b/octave_packages/signal-1.1.3/parzenwin.m @@ -0,0 +1,43 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{w}] =} parzenwin(@var{L}) +## Compute the Parzen window of lenght L. +## @seealso{rectwin, bartlett} +## @end deftypefn + +function w = parzenwin (L) + if(nargin != 1) + print_usage; + elseif(L < 0) + error('L must be positive'); + end + + if(L ~= floor(L)) + L = round(L); + end + + N = L-1; + n = -(N/2):N/2; + n1 = n(find(abs(n) <= N/4)); + n2 = n(find(n > N/4)); + n3 = n(find(n < -N/4)); + + w1 = 1 -6.*(abs(n1)./(L/2)).^2 + 6*(abs(n1)./(L/2)).^3; + w2 = 2.*(1-abs(n2)./(L/2)).^3; + w3 = 2.*(1-abs(n3)./(L/2)).^3; + w = [w3 w1 w2]'; +endfunction diff --git a/octave_packages/signal-1.1.3/pburg.m b/octave_packages/signal-1.1.3/pburg.m new file mode 100644 index 0000000..4f272e0 --- /dev/null +++ b/octave_packages/signal-1.1.3/pburg.m @@ -0,0 +1,148 @@ +%% Copyright (C) 2006 Peter V. Lanspeary +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% usage: +%% [psd,f_out] = pburg(x,poles,freq,Fs,range,method,plot_type,criterion) +%% +%% Calculate Burg maximum-entropy power spectral density. +%% The functions "arburg" and "ar_psd" do all the work. +%% See "help arburg" and "help ar_psd" for further details. +%% +%% ARGUMENTS: +%% All but the first two arguments are optional and may be empty. +%% x %% [vector] sampled data +%% +%% poles %% [integer scalar] required number of poles of the AR model +%% +%% freq %% [real vector] frequencies at which power spectral density +%% %% is calculated +%% %% [integer scalar] number of uniformly distributed frequency +%% %% values at which spectral density is calculated. +%% %% [default=256] +%% +%% Fs %% [real scalar] sampling frequency (Hertz) [default=1] +%% +%% +%% CONTROL-STRING ARGUMENTS -- each of these arguments is a character string. +%% Control-string arguments can be in any order after the other arguments. +%% +%% +%% range %% 'half', 'onesided' : frequency range of the spectrum is +%% %% from zero up to but not including sample_f/2. Power +%% %% from negative frequencies is added to the positive +%% %% side of the spectrum. +%% %% 'whole', 'twosided' : frequency range of the spectrum is +%% %% -sample_f/2 to sample_f/2, with negative frequencies +%% %% stored in "wrap around" order after the positive +%% %% frequencies; e.g. frequencies for a 10-point 'twosided' +%% %% spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 +%% %% 'shift', 'centerdc' : same as 'whole' but with the first half +%% %% of the spectrum swapped with second half to put the +%% %% zero-frequency value in the middle. (See "help +%% %% fftshift". If "freq" is vector, 'shift' is ignored. +%% %% If model coefficients "ar_coeffs" are real, the default +%% %% range is 'half', otherwise default range is 'whole'. +%% +%% method %% 'fft': use FFT to calculate power spectral density. +%% %% 'poly': calculate spectral density as a polynomial of 1/z +%% %% N.B. this argument is ignored if the "freq" argument is a +%% %% vector. The default is 'poly' unless the "freq" +%% %% argument is an integer power of 2. +%% +%% plot_type %% 'plot', 'semilogx', 'semilogy', 'loglog', 'squared' or 'db': +%% %% specifies the type of plot. The default is 'plot', which +%% %% means linear-linear axes. 'squared' is the same as 'plot'. +%% %% 'dB' plots "10*log10(psd)". This argument is ignored and a +%% %% spectrum is not plotted if the caller requires a returned +%% %% value. +%% +%% criterion %% [optional string arg] model-selection criterion. Limits +%% %% the number of poles so that spurious poles are not +%% %% added when the whitened data has no more information +%% %% in it (see Kay & Marple, 1981). Recognised values are +%% %% 'AKICc' -- approximate corrected Kullback information +%% %% criterion (recommended), +%% %% 'KIC' -- Kullback information criterion +%% %% 'AICc' -- corrected Akaike information criterion +%% %% 'AIC' -- Akaike information criterion +%% %% 'FPE' -- final prediction error" criterion +%% %% The default is to NOT use a model-selection criterion +%% +%% RETURNED VALUES: +%% If return values are not required by the caller, the spectrum +%% is plotted and nothing is returned. +%% psd %% [real vector] power-spectral density estimate +%% f_out %% [real vector] frequency values +%% +%% HINTS +%% This function is a wrapper for arburg and ar_psd. +%% See "help arburg", "help ar_psd". + +function [psd,f_out]=pburg(x,poles,varargin) + %% + if ( nargin<2 ) + error( 'pburg: need at least 2 args. Use "help pburg"' ); + end + nvarargin=length(varargin); + criterion=[]; + %% + %% Search for a "criterion" arg. If found, remove it + %% from "varargin" list and feed it to arburg instead. + for iarg = 1: nvarargin + arrgh = varargin{iarg}; + if ( ischar(arrgh) && ( strcmp(arrgh,'AKICc') ||... + strcmp(arrgh,'KIC') || strcmp(arrgh,'AICc') ||... + strcmp(arrgh,'AIC') || strcmp(arrgh,'FPE') ) ) + criterion=arrgh; + if ( nvarargin>1 ) + varargin{iarg}= []; + else + varargin={}; + end + end + end + %% + [ar_coeffs,residual]=arburg(x,poles,criterion); + if ( nargout==0 ) + ar_psd(ar_coeffs,residual,varargin{:}); + elseif ( nargout==1 ) + psd = ar_psd(ar_coeffs,residual,varargin{:}); + elseif ( nargout>=2 ) + [psd,f_out] = ar_psd(ar_coeffs,residual,varargin{:}); + end +end + +%!demo +%! fflush(stdout); +%! rand('seed',2038014164); +%! a = [ 1.0 -1.6216505 1.1102795 -0.4621741 0.2075552 -0.018756746 ]; +%! signal = detrend(filter(0.70181,a,rand(1,16384))); +%! % frequency shift by modulating with exp(j.omega.t) +%! skewed = signal.*exp(2*pi*i*2/25*[1:16384]); +%! Fs = 25; +%! hold on +%! pburg(signal,3,[],Fs); +%! input('Onesided 3-pole spectrum. Press ENTER', 's' ); +%! pburg(signal,4,[],Fs,'whole'); +%! input('Twosided 4-pole spectrum of same data. Press ENTER', 's' ); +%! pburg(signal,5,128,Fs,'shift', 'semilogy'); +%! input('Twosided, centred zero-frequency, 5-pole. Press ENTER', 's' ); +%! pburg(skewed,7,128,Fs,'AKICc','shift','semilogy'); +%! input('Complex data, AKICc chooses no. of poles. Press ENTER', 's' ); +%! user_freq=[-0.2:0.02:0.2]*Fs; +%! pburg(skewed,7,user_freq,Fs,'AKICc','semilogy'); +%! input('User-specified frequency values. Press ENTER', 's' ); +%! hold off +%! clf diff --git a/octave_packages/signal-1.1.3/pei_tseng_notch.m b/octave_packages/signal-1.1.3/pei_tseng_notch.m new file mode 100644 index 0000000..b9cd1df --- /dev/null +++ b/octave_packages/signal-1.1.3/pei_tseng_notch.m @@ -0,0 +1,119 @@ +## Copyright (C) 2011 Alexander Klein +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} { [ @var{b}, @var{a} ] } = pei_tseng_notch ( @var{frequencies}, @var{bandwidths} +## Return coefficients for an IIR notch-filter with one or more filter frequencies and according (very narrow) bandwidths +## to be used with @code{filter} or @code{filtfilt}. +## The filter construction is based on an allpass which performs a reversal of phase at the filter frequencies. +## Thus, the mean of the phase-distorted and the original signal has the respective frequencies removed. +## See the demo for an illustration. +## +## Original source: +## Pei, Soo-Chang, and Chien-Cheng Tseng +## "IIR Multiple Notch Filter Design Based on Allpass Filter" +## 1996 IEEE Tencon +## doi: 10.1109/TENCON.1996.608814) +## @end deftypefn + +## TODO: Implement Laplace-space frequencies and bandwidths, and perhaps better range checking for bandwidths? + +function [ b, a ] = pei_tseng_notch ( frequencies, bandwidths ) + + err = nargchk ( 2, 2, nargin, "string" ); + + if ( err ) + error ( err ); + elseif ( !isvector ( frequencies ) || !isvector ( bandwidths ) ) + error ( "All arguments must be vectors!" ) + elseif ( length ( frequencies ) != length ( bandwidths ) ) + error ( "All arguments must be of equal length!" ) + elseif ( !all ( frequencies > 0 && frequencies < 1 ) ) + error ( "All frequencies must be in (0, 1)!" ) + elseif ( !all ( bandwidths > 0 && bandwidths < 1 ) ) + error ( "All bandwidths must be in (0, 1)!" ) + endif + + ##Ensure row vectors + frequencies = frequencies (:)'; + bandwidths = bandwidths (:)'; + + + ##Normalise appropriately + frequencies *= pi; + bandwidths *= pi; + M2 = 2 * length ( frequencies ); + + + ##Splice centre and offset frequencies ( Equation 11 ) + omega = vec ( [ frequencies - bandwidths / 2; frequencies ] ); + + ##Splice centre and offset phases ( Equations 12 ) + factors = ( 1 : 2 : M2 ); + phi = vec ( [ -pi * factors + pi / 2; -pi * factors ] ); + + ##Create linear equation + t_beta = tan ( ( phi + M2 * omega ) / 2 ); + + Q = zeros ( M2 ); + + for k = 1 : M2 + Q ( : ,k ) = sin ( k .* omega ) - t_beta .* cos ( k .* omega ); + endfor + + ##Compute coefficients of system function ( Equations 19, 20 ) ... + h_a = ( Q \ t_beta )' ; + denom = [ 1, h_a ]; + num = [ fliplr( h_a ), 1 ]; + + ##... and transform them to coefficients for difference equations + a = denom; + b = ( num + denom ) / 2; + +endfunction + +%!test +%! ##2Hz bandwidth +%! sf = 800; sf2 = sf/2; +%! data=[sinetone(49,sf,10,1),sinetone(50,sf,10,1),sinetone(51,sf,10,1)]; +%! [b, a] = pei_tseng_notch ( 50 / sf2, 2 / sf2 ); +%! filtered = filter ( b, a, data ); +%! damp_db = 20 * log10 ( max ( filtered ( end - 1000 : end, : ) ) ); +%! assert ( damp_db, [ -3 -251.9 -3 ], 0.1 ) + +%!test +%! ##1Hz bandwidth +%! sf = 800; sf2 = sf/2; +%! data=[sinetone(49.5,sf,10,1),sinetone(50,sf,10,1),sinetone(50.5,sf,10,1)]; +%! [b, a] = pei_tseng_notch ( 50 / sf2, 1 / sf2 ); +%! filtered = filter ( b, a, data ); +%! damp_db = 20 * log10 ( max ( filtered ( end - 1000 : end, : ) ) ); +%! assert ( damp_db, [ -3 -240.4 -3 ], 0.1 ) + +%!demo +%! sf = 800; sf2 = sf/2; +%! data=[[1;zeros(sf-1,1)],sinetone(49,sf,1,1),sinetone(50,sf,1,1),sinetone(51,sf,1,1)]; +%! [b,a]=pei_tseng_notch ( 50 / sf2, 2/sf2 ); +%! filtered = filter(b,a,data); +%! +%! clf +%! subplot ( columns ( filtered ), 1, 1) +%! plot(filtered(:,1),";Impulse response;") +%! subplot ( columns ( filtered ), 1, 2 ) +%! plot(filtered(:,2),";49Hz response;") +%! subplot ( columns ( filtered ), 1, 3 ) +%! plot(filtered(:,3),";50Hz response;") +%! subplot ( columns ( filtered ), 1, 4 ) +%! plot(filtered(:,4),";51Hz response;") diff --git a/octave_packages/signal-1.1.3/polystab.m b/octave_packages/signal-1.1.3/polystab.m new file mode 100644 index 0000000..822b2c4 --- /dev/null +++ b/octave_packages/signal-1.1.3/polystab.m @@ -0,0 +1,29 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## b = polystab(a) +## +## Stabalize the polynomial transfer function by replacing all roots +## outside the unit circle with their reflection inside the unit circle. + +function b = polystab(a) + + r = roots(a); + v = find(abs(r)>1); + r(v) = 1./conj(r(v)); + b = a(1) * poly ( r ); + if isreal(a), b = real(b); endif + +endfunction diff --git a/octave_packages/signal-1.1.3/private/h1_z_deriv.m b/octave_packages/signal-1.1.3/private/h1_z_deriv.m new file mode 100644 index 0000000..c998ce6 --- /dev/null +++ b/octave_packages/signal-1.1.3/private/h1_z_deriv.m @@ -0,0 +1,53 @@ +## Copyright (C) 2007 R.G.H. Eschauzier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Adapted by Carnë Draug on 2011 + +## This function is necessary for impinvar and invimpinvar of the signal package + +## Find {-zd/dz}^n*H1(z). I.e., first differentiate, then multiply by -z, then differentiate, etc. +## The result is (ts^(n+1))*(b(1)*p/(z-p)^1 + b(2)*p^2/(z-p)^2 + b(n+1)*p^(n+1)/(z-p)^(n+1)). +## Works for n>0. +function b = h1_z_deriv(n, p, ts) + + %% Build the vector d that holds coefficients for all the derivatives of H1(z) + %% The results reads d(n)*z^(1)*(d/dz)^(1)*H1(z) + d(n-1)*z^(2)*(d/dz)^(2)*H1(z) +...+ d(1)*z^(n)*(d/dz)^(n)*H1(z) + d = (-1)^n; % Vector with the derivatives of H1(z) + for i= (1:n-1) + d = [d 0]; % Shift result right (multiply by -z) + d += prepad(polyder(d), i+1, 0, 2); % Add the derivative + endfor + + %% Build output vector + b = zeros (1, n + 1); + for i = (1:n) + b += d(i) * prepad(h1_deriv(n-i+1), n+1, 0, 2); + endfor + + b *= ts^(n+1)/factorial(n); + + %% Multiply coefficients with p^i, where i is the index of the coeff. + b.*=p.^(n+1:-1:1); + +endfunction + +## Find (z^n)*(d/dz)^n*H1(z), where H1(z)=ts*z/(z-p), ts=sampling period, +## p=exp(sm*ts) and sm is the s-domain pole with multiplicity n+1. +## The result is (ts^(n+1))*(b(1)*p/(z-p)^1 + b(2)*p^2/(z-p)^2 + b(n+1)*p^(n+1)/(z-p)^(n+1)), +## where b(i) is the binomial coefficient bincoeff(n,i) times n!. Works for n>0. +function b = h1_deriv(n) + b = factorial(n)*bincoeff(n,0:n); % Binomial coefficients: [1], [1 1], [1 2 1], [1 3 3 1], etc. + b *= (-1)^n; +endfunction diff --git a/octave_packages/signal-1.1.3/private/inv_residue.m b/octave_packages/signal-1.1.3/private/inv_residue.m new file mode 100644 index 0000000..0bb1603 --- /dev/null +++ b/octave_packages/signal-1.1.3/private/inv_residue.m @@ -0,0 +1,56 @@ +## Copyright (C) 2007 R.G.H. Eschauzier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Adapted by Carnë Draug on 2011 + +## This function is necessary for impinvar and invimpinvar of the signal package + +## Inverse of Octave residue function +function [b_out, a_out] = inv_residue(r_in, p_in, k_in, tol) + + n = length(r_in); % Number of poles/residues + + k = 0; % Capture contstant term + if (length(k_in)==1) % A single direct term (order N = order D) + k = k_in(1); % Capture constant term + elseif (length(k_in)>1) % Greater than one means non-physical system + error("Order numerator > order denominator"); + endif + + a_out = poly(p_in); + + b_out = zeros(1,n+1); + b_out += k*a_out; % Constant term: add k times denominator to numerator + i=1; + while (i<=n) + term = [1 -p_in(i)]; % Term to be factored out + p = r_in(i)*deconv(a_out,term); % Residue times resulting polynomial + p = prepad(p, n+1, 0, 2); % Pad for proper length + b_out += p; + + m = 1; + mterm = term; + first_pole = p_in(i); + while (i +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Adapted by Carnë Draug on 2011 + +## This function is necessary for impinvar and invimpinvar of the signal package + +## Reverse the coefficients of a polynomial +function p_out = polyrev (p_in) + p_out = p_in(end:-1:1); +endfunction diff --git a/octave_packages/signal-1.1.3/private/to_real.m b/octave_packages/signal-1.1.3/private/to_real.m new file mode 100644 index 0000000..a865de9 --- /dev/null +++ b/octave_packages/signal-1.1.3/private/to_real.m @@ -0,0 +1,23 @@ +## Copyright (C) 2007 R.G.H. Eschauzier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Adapted by Carnë Draug on 2011 + +## This function is necessary for impinvar and invimpinvar of the signal package + +## Round complex number to nearest real number +function p_out = to_real(p_in) + p_out = abs(p_in) .* sign(real(p_in)); +endfunction diff --git a/octave_packages/signal-1.1.3/pulstran.m b/octave_packages/signal-1.1.3/pulstran.m new file mode 100644 index 0000000..bd0426c --- /dev/null +++ b/octave_packages/signal-1.1.3/pulstran.m @@ -0,0 +1,144 @@ +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: y=pulstran(t,d,'func',...) +## y=pulstran(t,d,p,Fs,'interp') +## +## Generate the signal y=sum(func(t+d,...)) for each d. If d is a +## matrix of two columns, the first column is the delay d and the second +## column is the amplitude a, and y=sum(a*func(t+d)) for each d,a. +## Clearly, func must be a function which accepts a vector of times. +## Any extra arguments needed for the function must be tagged on the end. +## +## Example +## fs = 11025; # arbitrary sample rate +## f0 = 100; # pulse train sample rate +## w = 0.001; # pulse width of 1 millisecond +## auplot(pulstran(0:1/fs:0.1, 0:1/f0:0.1, 'rectpuls', w), fs); +## +## If instead of a function name you supply a pulse shape sampled at +## frequency Fs (default 1 Hz), an interpolated version of the pulse +## is added at each delay d. The interpolation stays within the the +## time range of the delayed pulse. The interpolation method defaults +## to linear, but it can be any interpolation method accepted by the +## function interp1. +## +## Example +## fs = 11025; # arbitrary sample rate +## f0 = 100; # pulse train sample rate +## w = boxcar(10); # pulse width of 1 millisecond at 10 kHz +## auplot(pulstran(0:1/fs:0.1, 0:1/f0:0.1, w, 10000), fs); + +## TODO: Make it faster. It is currently unusable for anything real. +## TODO: It may not be possible to speed it up with the present interface. +## TODO: See speech/voice.m for a better way. + +## Note that pulstran can be used for some pretty strange things such +## as simple band-limited interpolation: +## xf = 0:0.05:10; yf = sin(2*pi*xf/5); +## xp = 0:10; yp = sin(2*pi*xp/5); # .2 Hz sine sampled every second +## s = pulstran(xf, [xp, yp],'sinc'); +## plot(f, yf, ";original;", xf, s, ";sinc;",xp,yp,"*;;"); +## You wouldn't want to do this in practice since it is expensive, and +## since it works much better with a windowed sinc function, at least +## for short samples. + +function y = pulstran(t, d, pulse, varargin) + + if nargin<3 || (!ischar(pulse) && nargin>5) + print_usage; + endif + y = zeros(size(t)); + if isempty(y), return; endif + if rows(d) == 1, d=d'; endif + if columns(d) == 2, + a=d(:,2); + else + a=ones(rows(d),1); + endif + if ischar(pulse) + ## apply function t+d for all d + for i=1:rows(d) + y = y+a(i)*feval(pulse,t-d(i,1),varargin{:}); + endfor + else + ## interpolate each pulse at the specified times + Fs = 1; method = 'linear'; + if nargin==4 + arg=varargin{1}; + if ischar(arg), + method=arg; + else + Fs = arg; + endif + elseif nargin==5 + Fs = varargin{1}; + method = varargin{2}; + endif + span = (length(pulse)-1)/Fs; + t_pulse = (0:length(pulse)-1)/Fs; + for i=1:rows(d) + dt = t-d(i,1); + idx = find(dt>=0 & dt<=span); + y(idx) = y(idx) + a(i)*interp1(t_pulse, pulse, dt(idx), method); + endfor + endif +endfunction + +%!error pulstran +%!error pulstran(1,2,3,4,5,6) + +%!## parameter size and shape checking +%!shared t,d +%! t = 0:0.01:1; d=0:0.1:1; +%!assert (isempty(pulstran([], d, 'sin'))); +%!assert (pulstran(t, [], 'sin'), zeros(size(t))); +%!assert (isempty(pulstran([], d, boxcar(5)))); +%!assert (pulstran(t, [], boxcar(5)), zeros(size(t))); +%!assert (size(pulstran(t,d,'sin')), size(t)); +%!assert (size(pulstran(t,d','sin')), size(t)); +%!assert (size(pulstran(t',d,'sin')), size(t')); +%!assert (size(pulstran(t,d','sin')), size(t)); + +%!demo +%! fs = 11025; # arbitrary sample rate +%! f0 = 100; # pulse train sample rate +%! w = 0.003; # pulse width of 3 milliseconds +%! t = 0:1/fs:0.1; d=0:1/f0:0.1; # define sample times and pulse times +%! a = hanning(length(d)); # define pulse amplitudes +%! +%! subplot(221); title("rectpuls"); +%! auplot(pulstran(t', d', 'rectpuls', w), fs); +%! hold on; plot(d*1000,ones(size(d)),'g*;pulse;'); hold off; +%! +%! subplot(223); title("sinc => band limited interpolation"); +%! auplot(pulstran(f0*t, [f0*d', a], 'sinc'), fs); +%! hold on; plot(d*1000,a,'g*;pulse;'); hold off; +%! +%! subplot(222); title("interpolated boxcar"); +%! pulse = boxcar(30); # pulse width of 3 ms at 10 kHz +%! auplot(pulstran(t, d', pulse, 10000), fs); +%! hold on; plot(d*1000,ones(size(d)),'g*;pulse;'); hold off; +%! +%! subplot(224); title("interpolated asymmetric sin"); +%! pulse = sin(2*pi*[0:0.0001:w]/w).*[w:-0.0001:0]; +%! auplot(pulstran(t', [d', a], pulse', 10000), fs); +%! hold on; plot(d*1000,a*w,'g*;pulse;'); hold off; title(""); +%! +%! %---------------------------------------------------------- +%! % Should see (1) rectangular pulses centered on *, +%! % (2) rectangular pulses to the right of *, +%! % (3) smooth interpolation between the *'s, and +%! % (4) asymetric sines to the right of * diff --git a/octave_packages/signal-1.1.3/pwelch.m b/octave_packages/signal-1.1.3/pwelch.m new file mode 100644 index 0000000..c543783 --- /dev/null +++ b/octave_packages/signal-1.1.3/pwelch.m @@ -0,0 +1,955 @@ +%% Copyright (C) 2006 Peter V. Lanspeary +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% USAGE: +%% [spectra,freq] = pwelch(x,window,overlap,Nfft,Fs, +%% range,plot_type,detrend,sloppy) +%% Estimate power spectral density of data "x" by the Welch (1967) +%% periodogram/FFT method. All arguments except "x" are optional. +%% The data is divided into segments. If "window" is a vector, each +%% segment has the same length as "window" and is multiplied by "window" +%% before (optional) zero-padding and calculation of its periodogram. If +%% "window" is a scalar, each segment has a length of "window" and a +%% Hamming window is used. +%% The spectral density is the mean of the periodograms, scaled so that +%% area under the spectrum is the same as the mean square of the +%% data. This equivalence is supposed to be exact, but in practice there +%% is a mismatch of up to 0.5% when comparing area under a periodogram +%% with the mean square of the data. +%% +%% [spectra,freq] = pwelch(x,y,window,overlap,Nfft,Fs, +%% range,plot_type,detrend,sloppy,results) +%% Two-channel spectrum analyser. Estimate power spectral density, cross- +%% spectral density, transfer function and/or coherence functions of time- +%% series input data "x" and output data "y" by the Welch (1967) +%% periodogram/FFT method. +%% pwelch treats the second argument as "y" if there is a control-string +%% argument "cross", "trans", "coher" or "ypower"; "power" does not force +%% the 2nd argument to be treated as "y". All other arguments are +%% optional. All spectra are returned in matrix "spectra". +%% +%% [spectra,Pxx_ci,freq] = pwelch(x,window,overlap,Nfft,Fs,conf, +%% range,plot_type,detrend,sloppy) +%% [spectra,Pxx_ci,freq] = pwelch(x,y,window,overlap,Nfft,Fs,conf, +%% range,plot_type,detrend,sloppy,results) +%% Estimates confidence intervals for the spectral density. +%% See Hint (7) below for compatibility options. Confidence level "conf" +%% is the 6th or 7th numeric argument. If "results" control-string +%% arguments are used, one of them must be "power" when the "conf" +%% argument is present; pwelch can estimate confidence intervals only for +%% the power spectrum of the "x" data. It does not know how to estimate +%% confidence intervals of the cross-power spectrum, transfer function or +%% coherence; if you can suggest a good method, please send a bug report. +%% +%% ARGUMENTS +%% All but the first argument are optional and may be empty, except that +%% the "results" argument may require the second argument to be "y". +%% +%% x %% [non-empty vector] system-input time-series data +%% y %% [non-empty vector] system-output time-series data +%% +%% window %% [real vector] of window-function values between 0 and 1; the +%% %% data segment has the same length as the window. +%% %% Default window shape is Hamming. +%% %% [integer scalar] length of each data segment. The default +%% %% value is window=sqrt(length(x)) rounded up to the +%% %% nearest integer power of 2; see 'sloppy' argument. +%% +%% overlap %% [real scalar] segment overlap expressed as a multiple of +%% %% window or segment length. 0 <= overlap < 1, +%% %% The default is overlap=0.5 . +%% +%% Nfft %% [integer scalar] Length of FFT. The default is the length +%% %% of the "window" vector or has the same value as the +%% %% scalar "window" argument. If Nfft is larger than the +%% %% segment length, "seg_len", the data segment is padded +%% %% with "Nfft-seg_len" zeros. The default is no padding. +%% %% Nfft values smaller than the length of the data +%% %% segment (or window) are ignored silently. +%% +%% Fs %% [real scalar] sampling frequency (Hertz); default=1.0 +%% +%% conf %% [real scalar] confidence level between 0 and 1. Confidence +%% %% intervals of the spectral density are estimated from +%% %% scatter in the periodograms and are returned as Pxx_ci. +%% %% Pxx_ci(:,1) is the lower bound of the confidence +%% %% interval and Pxx_ci(:,2) is the upper bound. If there +%% %% are three return values, or conf is an empty matrix, +%% %% confidence intervals are calculated for conf=0.95 . +%% %% If conf is zero or is not given, confidence intervals +%% %% are not calculated. Confidence intervals can be +%% %% obtained only for the power spectral density of x; +%% %% nothing else. +%% +%% CONTROL-STRING ARGUMENTS -- each of these arguments is a character string. +%% Control-string arguments must be after the other arguments but can be in +%% any order. +%% +%% range %% 'half', 'onesided' : frequency range of the spectrum is +%% %% zero up to but not including Fs/2. Power from +%% %% negative frequencies is added to the positive side of +%% %% the spectrum, but not at zero or Nyquist (Fs/2) +%% %% frequencies. This keeps power equal in time and +%% %% spectral domains. See reference [2]. +%% %% 'whole', 'twosided' : frequency range of the spectrum is +%% %% -Fs/2 to Fs/2, with negative frequencies +%% %% stored in "wrap around" order after the positive +%% %% frequencies; e.g. frequencies for a 10-point 'twosided' +%% %% spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 +%% %% 'shift', 'centerdc' : same as 'whole' but with the first half +%% %% of the spectrum swapped with second half to put the +%% %% zero-frequency value in the middle. (See "help +%% %% fftshift". +%% %% If data (x and y) are real, the default range is 'half', +%% %% otherwise default range is 'whole'. +%% +%% plot_type %% 'plot', 'semilogx', 'semilogy', 'loglog', 'squared' or 'db': +%% %% specifies the type of plot. The default is 'plot', which +%% %% means linear-linear axes. 'squared' is the same as 'plot'. +%% %% 'dB' plots "10*log10(psd)". This argument is ignored and a +%% %% spectrum is not plotted if the caller requires a returned +%% %% value. +%% +%% detrend %% 'no-strip', 'none' -- do NOT remove mean value from the data +%% %% 'short', 'mean' -- remove the mean value of each segment from +%% %% each segment of the data. +%% %% 'linear', -- remove linear trend from each segment of +%% %% the data. +%% %% 'long-mean' -- remove the mean value from the data before +%% %% splitting it into segments. This is the default. +%% +%% sloppy %% 'sloppy': FFT length is rounded up to the nearest integer +%% %% power of 2 by zero padding. FFT length is adjusted +%% %% after addition of padding by explicit Nfft argument. +%% %% The default is to use exactly the FFT and window/ + +%% %% segment lengths specified in argument list. +%% +%% results %% specifies what results to return (in the order specified +%% %% and as many as desired). +%% %% 'power' calculate power spectral density of "x" +%% %% 'cross' calculate cross spectral density of "x" and "y" +%% %% 'trans' calculate transfer function of a system with +%% %% input "x" and output "y" +%% %% 'coher' calculate coherence function of "x" and "y" +%% %% 'ypower' calculate power spectral density of "y" +%% %% The default is 'power', with argument "y" omitted. +%% +%% RETURNED VALUES: +%% If return values are not required by the caller, the results are +%% plotted and nothing is returned. +%% +%% spectra %% [real-or-complex matrix] columns of the matrix contain results +%% %% in the same order as specified by "results" arguments. +%% %% Each column contains one of the result vectors. +%% +%% Pxx_ci %% [real matrix] estimate of confidence interval for power +%% %% spectral density of x. First column is the lower +%% %% bound. Second column is the upper bound. +%% +%% freq %% [real column vector] frequency values +%% +%% HINTS +%% 1) EMPTY ARGS: +%% if you don't want to use an optional argument you can leave it empty +%% by writing its value as []. +%% 2) FOR BEGINNERS: +%% The profusion of arguments may make pwelch difficult to use, and an +%% unskilled user can easily produce a meaningless result or can easily +%% mis-interpret the result. With real data "x" and sampling frequency +%% "Fs", the easiest and best way for a beginner to use pwelch is +%% probably "pwelch(x,[],[],[],Fs)". Use the "window" argument to +%% control the length of the spectrum vector. For real data and integer +%% scalar M, "pwelch(x,2*M,[],[],Fs)" gives an M+1 point spectrum. +%% Run "demo pwelch" (octave only). +%% 3) WINDOWING FUNCTIONS: +%% Without a window function, sharp spectral peaks can have strong +%% sidelobes because the FFT of a data in a segment is in effect convolved +%% with a rectangular window. A window function which tapers off +%% (gradually) at the ends produces much weaker sidelobes in the FFT. +%% Hann (hanning), hamming, bartlett, blackman, flattopwin etc are +%% available as separate Matlab/sigproc or Octave functions. The sidelobes +%% of the Hann window have a roll-off rate of 60dB/decade of frequency. +%% The first sidelobe of the Hamming window is suppressed and is about 12dB +%% lower than the first Hann sidelobe, but the roll-off rate is only +%% 20dB/decade. You can inspect the FFT of a Hann window by plotting +%% "abs(fft(postpad(hanning(256),4096,0)))". +%% The default window is Hamming. +%% 4) ZERO PADDING: +%% Zero-padding reduces the frequency step in the +%% spectrum, and produces an artificially smoothed spectrum. For example, +%% "Nfft=2*length(window)" gives twice as many frequency values, but +%% adjacent PSD (power spectral density) values are not independent; +%% adjacent PSD values are independent if "Nfft=length(window)", which is +%% the default value of Nfft. +%% 5) REMOVING MEAN FROM SIGNAL: +%% If the mean is not removed from the signal there is a large spectral +%% peak at zero frequency and the sidelobes of this peak are likely to +%% swamp the rest of the spectrum. For this reason, the default behaviour +%% is to remove the mean. However, the matlab pwelch does not do this. +%% 6) WARNING ON CONFIDENCE INTERVALS +%% Confidence intervals are obtained by measuring the sample variance of +%% the periodograms and assuming that the periodograms have a Gaussian +%% probability distribution. This assumption is not accurate. If, for +%% example, the data (x) is Gaussian, the periodogram has a Rayleigh +%% distribution. However, the confidence intervals may still be useful. +%% +%% 7) COMPATIBILITY WITH Matlab R11, R12, etc +%% When used without the second data (y) argument, arguments are compatible +%% with the pwelch of Matlab R12, R13, R14, 2006a and 2006b except that +%% 1) overlap is expressed as a multiple of window length --- +%% effect of overlap scales with window length +%% 2) default values of length(window), Nfft and Fs are more sensible, and +%% 3) Goertzel algorithm is not available so Nfft cannot be an array of +%% frequencies as in Matlab 2006b. +%% Pwelch has four persistent Matlab-compatibility levels. Calling pwelch +%% with an empty first argument sets the order of arguments and defaults +%% specified above in the USAGE and ARGUMENTS section of this documentation. +%% prev_compat=pwelch([]); +%% [Pxx,f]=pwelch(x,window,overlap,Nfft,Fs,conf,...); +%% Calling pwelch with a single string argument (as described below) gives +%% compatibility with Matlab R11 or R12, or the R14 spectrum.welch +%% defaults. The returned value is the PREVIOUS compatibility string. +%% +%% Matlab R11: For compatibility with the Matlab R11 pwelch: +%% prev_compat=pwelch('R11-'); +%% [Pxx,f]=pwelch(x,Nfft,Fs,window,overlap,conf,range,units); +%% %% units of overlap are "number of samples" +%% %% defaults: Nfft=min(length(x),256), Fs=2*pi, length(window)=Nfft, +%% %% window=Hanning, do not detrend, +%% %% N.B. "Sloppy" is not available. +%% +%% Matlab R12: For compatibility with Matlab R12 to 2006a pwelch: +%% prev_compat=pwelch('R12+'); +%% [Pxx,f]=pwelch(x,window,overlap,nfft,Fs,...); +%% %% units of overlap are "number of samples" +%% %% defaults: length(window)==length(x)/8, window=Hamming, +%% %% Nfft=max(256,NextPow2), Fs=2*pi, do not detrend +%% %% NextPow2 is the next power of 2 greater than or equal to the +%% %% window length. "Sloppy", "conf" are not available. Default +%% %% window length gives very poor amplitude resolution. +%% +%% To adopt defaults of the Matlab R14 "spectrum.welch" spectrum object +%% associated "psd" method. +%% prev_compat=pwelch('psd'); +%% [Pxx,f] = pwelch(x,window,overlap,Nfft,Fs,conf,...); +%% %% overlap is expressed as a percentage of window length, +%% %% defaults: length(window)==64, Nfft=max(256,NextPow2), Fs=2*pi +%% %% do not detrend +%% %% NextPow2 is the next power of 2 greater than or equal to the +%% %% window length. "Sloppy" is not available. +%% %% Default window length gives coarse frequency resolution. +%% +%% +%% REFERENCES +%% [1] Peter D. Welch (June 1967): +%% "The use of fast Fourier transform for the estimation of power spectra: +%% a method based on time averaging over short, modified periodograms." +%% IEEE Transactions on Audio Electroacoustics, Vol AU-15(6), pp 70-73 +%% +%% [2] William H. Press and Saul A. Teukolsky and William T. Vetterling and +%% Brian P. Flannery", +%% "Numerical recipes in C, The art of scientific computing", 2nd edition, +%% Cambridge University Press, 2002 --- Section 13.7. +%% [3] Paul Kienzle (1999-2001): "pwelch", http://octave.sourceforge.net/ + +function [varargout] = pwelch(x,varargin) + %% + %% COMPATIBILITY LEVEL + %% Argument positions and defaults depend on compatibility level selected + %% by calling pwelch without arguments or with a single string argument. + %% native: compatib=1; prev_compat=pwelch(); prev_compat=pwelch([]); + %% matlab R11: compatib=2; prev_compat=pwelch('R11-'); + %% matlab R12: compatib=3; prev_compat=pwelch('R12+'); + %% spectrum.welch defaults: compatib=4; prev_compat=pwelch('psd'); + %% In each case, the returned value is the PREVIOUS compatibility string. + %% + compat_str = {[]; 'R11-'; 'R12+'; 'psd'}; + persistent compatib; + if ( isempty(compatib) || compatib<=0 || compatib>4 ) + %% legal values are 1, 2, 3, 4 + + compatib = 1; + end + if ( nargin <= 0 ) + error( 'pwelch: Need at least 1 arg. Use "help pwelch".' ); + elseif ( nargin==1 && (ischar(x) || isempty(x)) ) + varargout{1} = compat_str{compatib}; + if ( isempty(x) ) % native + compatib = 1; + elseif ( strcmp(x,'R11-') ) + compatib = 2; + elseif ( strcmp(x,'R12+') ) + compatib = 3; + elseif ( strcmp(x,'psd') ) + compatib = 4; + else + error( 'pwelch: compatibility arg must be empty, R11-, R12+ or psd' ); + end + %% return + %% + %% Check fixed argument + elseif ( isempty(x) || ~isvector(x) ) + error( 'pwelch: arg 1 (x) must be vector.' ); + else + %% force x to be COLUMN vector + if ( size(x,1)==1 ) + x=x(:); + end + %% + %% Look through all args to check if cross PSD, transfer function or + %% coherence is required. If yes, the second arg is data vector "y". + arg2_is_y = 0; + x_len = length(x); + nvarargin = length(varargin); + for iarg=1:nvarargin + arg = varargin{iarg}; + if ( ~isempty(arg) && ischar(arg) && ... + ( strcmp(arg,'cross') || strcmp(arg,'trans') || ... + strcmp(arg,'coher') || strcmp(arg,'ypower') )) + %% OK. Need "y". Grab it from 2nd arg. + arg = varargin{1}; + if ( nargin<2 || isempty(arg) || ~isvector(arg) || length(arg)~=x_len ) + error( 'pwelch: arg 2 (y) must be vector, same length as x.' ); + end + %% force COLUMN vector + y = varargin{1}(:); + arg2_is_y = 1; + break; + end + end + %% + %% COMPATIBILITY + %% To select default argument values, "compatib" is used as an array index. + %% Index values are 1=native, 2=R11, 3=R12, 4=spectrum.welch + %% + %% argument positions: + %% arg_posn = varargin index of window, overlap, Nfft, Fs and conf + %% args respectively, a value of zero ==>> arg does not exist + arg_posn = [1 2 3 4 5; %% native + 3 4 1 2 5; %% Matlab R11- pwelch + 1 2 3 4 0; %% Matlab R12+ pwelch + 1 2 3 4 5]; %% spectrum.welch defaults + arg_posn = arg_posn(compatib,:) + arg2_is_y; + %% + %% SPECIFY SOME DEFAULT VALUES for (not all) optional arguments + %% Use compatib as array index. + %% Fs = sampling frequency + Fs = [ 1.0 2*pi 2*pi 2*pi ]; + Fs = Fs(compatib); + %% plot_type: 1='plot'|'squared'; 5='db'|'dB' + plot_type = [ 1 5 5 5 ]; + plot_type = plot_type(compatib); + %% rm_mean: 3='long-mean'; 0='no-strip'|'none' + rm_mean = [ 3 0 0 0 ]; + rm_mean = rm_mean(compatib); + %% use max_overlap=x_len-1 because seg_len is not available yet + %% units of overlap are different for each version: + %% fraction, samples, or percent + max_overlap = [ 0.95 x_len-1 x_len-1 95]; + max_overlap = max_overlap(compatib); + %% default confidence interval + %% if there are more than 2 return values and if there is a "conf" arg + conf = 0.95 * (nargout>2) * (arg_posn(5)>0); + %% + is_win = 0; % =0 means valid window arg is not provided yet + Nfft = []; % default depends on segment length + overlap = []; % WARNING: units can be #samples, fraction or percentage + range = ~isreal(x) || ( arg2_is_y && ~isreal(y) ); + is_sloppy = 0; + n_results = 0; + do_power = 0; + do_cross = 0; + do_trans = 0; + do_coher = 0; + do_ypower = 0; + %% + %% DECODE AND CHECK OPTIONAL ARGUMENTS + end_numeric_args = 0; + for iarg = 1+arg2_is_y:nvarargin + arg = varargin{iarg}; + if ( ischar(arg) ) + %% first string arg ==> no more numeric args + %% non-string args cannot follow a string arg + end_numeric_args = 1; + %% + %% decode control-string arguments + if ( strcmp(arg,'sloppy') ) + is_sloppy = ~is_win || is_win==1; + elseif ( strcmp(arg,'plot') || strcmp(arg,'squared') ) + plot_type = 1; + elseif ( strcmp(arg,'semilogx') ) + plot_type = 2; + elseif ( strcmp(arg,'semilogy') ) + plot_type = 3; + elseif ( strcmp(arg,'loglog') ) + plot_type = 4; + elseif ( strcmp(arg,'db') || strcmp(arg,'dB') ) + plot_type = 5; + elseif ( strcmp(arg,'half') || strcmp(arg,'onesided') ) + range = 0; + elseif ( strcmp(arg,'whole') || strcmp(arg,'twosided') ) + range = 1; + elseif ( strcmp(arg,'shift') || strcmp(arg,'centerdc') ) + range = 2; + elseif ( strcmp(arg,'long-mean') ) + rm_mean = 3; + elseif ( strcmp(arg,'linear') ) + rm_mean = 2; + elseif ( strcmp(arg,'short') || strcmp(arg,'mean') ) + rm_mean = 1; + elseif ( strcmp(arg,'no-strip') || strcmp(arg,'none') ) + rm_mean = 0; + elseif ( strcmp(arg, 'power' ) ) + if ( ~do_power ) + n_results = n_results+1; + do_power = n_results; + end + elseif ( strcmp(arg, 'cross' ) ) + if ( ~do_cross ) + n_results = n_results+1; + do_cross = n_results; + end + elseif ( strcmp(arg, 'trans' ) ) + if ( ~do_trans ) + n_results = n_results+1; + do_trans = n_results; + end + elseif ( strcmp(arg, 'coher' ) ) + if ( ~do_coher ) + n_results = n_results+1; + do_coher = n_results; + end + elseif ( strcmp(arg, 'ypower' ) ) + if ( ~do_ypower ) + n_results = n_results+1; + do_ypower = n_results; + end + else + error( 'pwelch: string arg %d illegal value: %s', iarg+1, arg ); + end + %% end of processing string args + %% + elseif ( end_numeric_args ) + if ( ~isempty(arg) ) + %% found non-string arg after a string arg ... oops + error( 'pwelch: control arg must be string' ); + end + %% + %% first 4 optional arguments are numeric -- in fixed order + %% + %% deal with "Fs" and "conf" first because empty arg is a special default + %% -- "Fs" arg -- sampling frequency + elseif ( iarg == arg_posn(4) ) + if ( isempty(arg) ) + Fs = 1; + elseif ( ~isscalar(arg) || ~isreal(arg) || arg<0 ) + error( 'pwelch: arg %d (Fs) must be real scalar >0', iarg+1 ); + else + Fs = arg; + end + %% + %% -- "conf" arg -- confidence level + %% guard against the "it cannot happen" iarg==0 + elseif ( arg_posn(5) && iarg == arg_posn(5) ) + if ( isempty(arg) ) + conf = 0.95; + elseif ( ~isscalar(arg) || ~isreal(arg) || arg < 0.0 || arg >= 1.0 ) + error( 'pwelch: arg %d (conf) must be real scalar, >=0, <1',iarg+1 ); + else + conf = arg; + end + %% + %% skip all empty args from this point onward + elseif ( isempty(arg) ) + 1; + %% + %% -- "window" arg -- window function + elseif ( iarg == arg_posn(1) ) + if ( isscalar(arg) ) + is_win = 1; + elseif ( isvector(arg) ) + is_win = length(arg); + if ( size(arg,2)>1 ) %% vector must be COLUMN vector + arg = arg(:); + end + else + is_win = 0; + end + if ( ~is_win ) + error( 'pwelch: arg %d (window) must be scalar or vector', iarg+1 ); + elseif ( is_win==1 && ( ~isreal(arg) || fix(arg)~=arg || arg<=3 ) ) + error( 'pwelch: arg %d (window) must be integer >3', iarg+1 ); + elseif ( is_win>1 && ( ~isreal(arg) || any(arg<0) ) ) + error( 'pwelch: arg %d (window) vector must be real and >=0',iarg+1); + end + window = arg; + is_sloppy = 0; + %% + %% -- "overlap" arg -- segment overlap + elseif ( iarg == arg_posn(2) ) + if (~isscalar(arg) || ~isreal(arg) || arg<0 || arg>max_overlap ) + error( 'pwelch: arg %d (overlap) must be real from 0 to %f', ... + iarg+1, max_overlap ); + end + overlap = arg; + %% + %% -- "Nfft" arg -- FFT length + elseif ( iarg == arg_posn(3) ) + if ( ~isscalar(arg) || ~isreal(arg) || fix(arg)~=arg || arg<0 ) + error( 'pwelch: arg %d (Nfft) must be integer >=0', iarg+1 ); + end + Nfft = arg; + %% + else + error( 'pwelch: arg %d must be string', iarg+1 ); + end + end + if ( conf>0 && (n_results && ~do_power ) ) + error('pwelch: can give confidence interval for x power spectrum only' ); + end + %% + %% end DECODE AND CHECK OPTIONAL ARGUMENTS. + %% + %% SETUP REMAINING PARAMETERS + %% default action is to calculate power spectrum only + if ( ~n_results ) + n_results = 1; + do_power = 1; + end + need_Pxx = do_power || do_trans || do_coher; + need_Pxy = do_cross || do_trans || do_coher; + need_Pyy = do_coher || do_ypower; + log_two = log(2); + nearly_one = 0.99999999999; + %% + %% compatibility-options + %% provides exact compatibility with Matlab R11 or R12 + %% + %% Matlab R11 compatibility + if ( compatib==2 ) + if ( isempty(Nfft) ) + Nfft = min( 256, x_len ); + end + if ( is_win > 1 ) + seg_len = min( length(window), Nfft ); + window = window(1:seg_len); + else + if ( is_win ) + %% window arg is scalar + seg_len = window; + else + seg_len = Nfft; + end + %% make Hann window (don't depend on sigproc) + xx = seg_len - 1; + window = 0.5 - 0.5 * cos( (2*pi/xx)*[0:xx].' ); + end + %% + %% Matlab R12 compatibility + elseif ( compatib==3 ) + if ( is_win > 1 ) + %% window arg provides window function + seg_len = length(window); + else + %% window arg does not provide window function; use Hamming + if ( is_win ) + %% window arg is scalar + seg_len = window; + else + %% window arg not available; use R12 default, 8 windows + %% ignore overlap arg; use overlap=50% -- only choice that makes sense + %% this is the magic formula for 8 segments with 50% overlap + seg_len = fix( (x_len-3)*2/9 ); + end + %% make Hamming window (don't depend on sigproc) + xx = seg_len - 1; + window = 0.54 - 0.46 * cos( (2*pi/xx)*[0:xx].' ); + end + if ( isempty(Nfft) ) + Nfft = max( 256, 2^ceil(log(seg_len)*nearly_one/log_two) ); + end + %% + %% Matlab R14 psd(spectrum.welch) defaults + elseif ( compatib==4 ) + if ( is_win > 1 ) + %% window arg provides window function + seg_len = length(window); + else + %% window arg does not provide window function; use Hamming + if ( is_win ) + %% window arg is scalar + seg_len = window; + else + %% window arg not available; use default seg_len = 64 + seg_len = 64; + end + %% make Hamming window (don't depend on sigproc) + xx = seg_len - 1; + window = 0.54 - 0.46 * cos( (2*pi/xx)*[0:xx].' ); + end + %% Now we know segment length, + %% so we can set default overlap as number of samples + if ( ~isempty(overlap) ) + overlap = fix(seg_len * overlap / 100 ); + end + if ( isempty(Nfft) ) + Nfft = max( 256, 2^ceil(log(seg_len)*nearly_one/log_two) ); + end + %% + %% default compatibility level + else %if ( compatib==1 ) + %% calculate/adjust segment length, window function + if ( is_win > 1 ) + %% window arg provides window function + seg_len = length(window); + else + %% window arg does not provide window function; use Hamming + if ( is_win ) %% window arg is scalar + seg_len = window; + else + %% window arg not available; use default length: + %% = sqrt(length(x)) rounded up to nearest integer power of 2 + if ( isempty(overlap) ) + overlap=0.5; + end + seg_len = 2 ^ ceil( log(sqrt(x_len/(1-overlap)))*nearly_one/log_two ); + end + %% make Hamming window (don't depend on sigproc) + xx = seg_len - 1; + window = 0.54 - 0.46 * cos( (2*pi/xx)*[0:xx].' ); + end + %% Now we know segment length, + %% so we can set default overlap as number of samples + if ( ~isempty(overlap) ) + overlap = fix(seg_len * overlap); + end + %% + %% calculate FFT length + if ( isempty(Nfft) ) + Nfft = seg_len; + end + if ( is_sloppy ) + Nfft = 2 ^ ceil( log(Nfft) * nearly_one / log_two ); + end + end + %% end of compatibility options + %% + %% minimum FFT length is seg_len + Nfft = max( Nfft, seg_len ); + %% Mean square of window is required for normalising PSD amplitude. + win_meansq = (window.' * window) / seg_len; + %% + %% Set default or check overlap. + if ( isempty(overlap) ) + overlap = fix(seg_len /2); + elseif ( overlap >= seg_len ) + error( 'pwelch: arg (overlap=%d) too big. Must be 0 ) + Vxx = xx; + else + Vxx = []; + end + n_ffts = 0; + for start_seg = [1:seg_len-overlap:x_len-seg_len+1] + end_seg = start_seg+seg_len-1; + %% Don't truncate/remove the zero padding in xx and yy + if ( need_Pxx || need_Pxy ) + if ( rm_mean==1 ) % remove mean from segment + xx(1:seg_len) = window .* ( ... + x(start_seg:end_seg) - sum(x(start_seg:end_seg)) / seg_len); + elseif ( rm_mean == 2 ) % remove linear trend from segment + xx(1:seg_len) = window .* detrend( x(start_seg:end_seg) ); + else % rm_mean==0 or 3 + xx(1:seg_len) = window .* x(start_seg:end_seg); + end + fft_x = fft(xx); + end + if ( need_Pxy || need_Pyy ) + if ( rm_mean==1 ) % remove mean from segment + yy(1:seg_len) = window .* ( ... + y(start_seg:end_seg) - sum(y(start_seg:end_seg)) / seg_len); + elseif ( rm_mean == 2 ) % remove linear trend from segment + yy(1:seg_len) = window .* detrend( y(start_seg:end_seg) ); + else % rm_mean==0 or 3 + yy(1:seg_len) = window .* y(start_seg:end_seg); + end + fft_y = fft(yy); + end + if ( need_Pxx ) + %% force Pxx to be real; pgram = periodogram + pgram = real(fft_x .* conj(fft_x)); + Pxx = Pxx + pgram; + %% sum of squared periodograms is required for confidence interval + if ( conf>0 ) + Vxx = Vxx + pgram .^2; + end + end + if ( need_Pxy ) + %% Pxy (cross power spectrum) is complex. Do not force to be real. + Pxy = Pxy + fft_y .* conj(fft_x); + end + if ( need_Pyy ) + %% force Pyy to be real + Pyy = Pyy + real(fft_y .* conj(fft_y)); + end + n_ffts = n_ffts +1; + end + %% + %% Calculate confidence interval + %% -- incorrectly assumes that the periodogram has Gaussian probability + %% distribution (actually, it has a single-sided (e.g. exponential) + %% distribution. + %% Sample variance of periodograms is (Vxx-Pxx.^2/n_ffts)/(n_ffts-1). + %% This method of calculating variance is more susceptible to round-off + %% error, but is quicker, and for double-precision arithmetic and the + %% inherently noisy periodogram (variance==mean^2), it should be OK. + if ( conf>0 && need_Pxx ) + if ( n_ffts<2 ) + Vxx = zeros(Nfft,1); + else + %% Should use student distribution here (for unknown variance), but tinv + %% is not a core Matlab function (is in statistics toolbox. Grrr) + Vxx = (erfinv(conf)*sqrt(2*n_ffts/(n_ffts-1))) * sqrt(Vxx-Pxx.^2/n_ffts); + end + end + %% + %% Convert two-sided spectra to one-sided spectra (if range == 0). + %% For one-sided spectra, contributions from negative frequencies are added + %% to the positive side of the spectrum -- but not at zero or Nyquist + %% (half sampling) frequencies. This keeps power equal in time and spectral + %% domains, as required by Parseval theorem. + %% + if ( range == 0 ) + if ( ~ rem(Nfft,2) ) %% one-sided, Nfft is even + psd_len = Nfft/2+1; + if ( need_Pxx ) + Pxx = Pxx(1:psd_len) + [0; Pxx(Nfft:-1:psd_len+1); 0]; + if ( conf>0 ) + Vxx = Vxx(1:psd_len) + [0; Vxx(Nfft:-1:psd_len+1); 0]; + end + end + if ( need_Pxy ) + Pxy = Pxy(1:psd_len) + conj([0; Pxy(Nfft:-1:psd_len+1); 0]); + end + if ( need_Pyy ) + Pyy = Pyy(1:psd_len) + [0; Pyy(Nfft:-1:psd_len+1); 0]; + end + else %% one-sided, Nfft is odd + psd_len = (Nfft+1)/2; + if ( need_Pxx ) + Pxx = Pxx(1:psd_len) + [0; Pxx(Nfft:-1:psd_len+1)]; + if ( conf>0 ) + Vxx = Vxx(1:psd_len) + [0; Vxx(Nfft:-1:psd_len+1)]; + end + end + if ( need_Pxy ) + Pxy = Pxy(1:psd_len) + conj([0; Pxy(Nfft:-1:psd_len+1)]); + end + if ( need_Pyy ) + Pyy = Pyy(1:psd_len) + [0; Pyy(Nfft:-1:psd_len+1)]; + end + end + else %% two-sided (and shifted) + psd_len = Nfft; + end + %% end MAIN CALCULATIONS + %% + %% SCALING AND OUTPUT + %% Put all results in matrix, one row per spectrum + %% Pxx, Pxy, Pyy are sums of periodograms, so "n_ffts" + %% in the scale factor converts them into averages + spectra = zeros(psd_len,n_results); + spect_type = zeros(n_results,1); + scale = n_ffts * seg_len * Fs * win_meansq; + if ( do_power ) + spectra(:,do_power) = Pxx / scale; + spect_type(do_power) = 1; + if ( conf>0 ) + Vxx = [Pxx-Vxx Pxx+Vxx]/scale; + end + end + if ( do_cross ) + spectra(:,do_cross) = Pxy / scale; + spect_type(do_cross) = 2; + end + if ( do_trans ) + spectra(:,do_trans) = Pxy ./ Pxx; + spect_type(do_trans) = 3; + end + if ( do_coher ) + %% force coherence to be real + spectra(:,do_coher) = real(Pxy .* conj(Pxy)) ./ Pxx ./ Pyy; + spect_type(do_coher) = 4; + end + if ( do_ypower ) + spectra(:,do_ypower) = Pyy / scale; + spect_type(do_ypower) = 5; + end + freq = [0:psd_len-1].' * ( Fs / Nfft ); + %% + %% range='shift': Shift zero-frequency to the middle + if ( range == 2 ) + len2 = fix((Nfft+1)/2); + spectra = [ spectra(len2+1:Nfft,:); spectra(1:len2,:)]; + freq = [ freq(len2+1:Nfft)-Fs; freq(1:len2)]; + if ( conf>0 ) + Vxx = [ Vxx(len2+1:Nfft,:); Vxx(1:len2,:)]; + end + end + %% + %% RETURN RESULTS or PLOT + if ( nargout>=2 && conf>0 ) + varargout{2} = Vxx; + end + if ( nargout>=(2+(conf>0)) ) + %% frequency is 2nd or 3rd return value, + %% depends on if 2nd is confidence interval + varargout{2+(conf>0)} = freq; + end + if ( nargout>=1 ) + varargout{1} = spectra; + else + %% + %% Plot the spectra if there are no return variables. + plot_title=['power spectrum x '; + 'cross spectrum '; + 'transfer function'; + 'coherence '; + 'power spectrum y ' ]; + for ii = 1: n_results + if ( conf>0 && spect_type(ii)==1 ) + Vxxxx = Vxx; + else + Vxxxx = []; + end + if ( n_results > 1 ) + figure(); + end + if ( plot_type == 1 ) + plot(freq,[abs(spectra(:,ii)) Vxxxx]); + elseif ( plot_type == 2 ) + semilogx(freq,[abs(spectra(:,ii)) Vxxxx]); + elseif ( plot_type == 3 ) + semilogy(freq,[abs(spectra(:,ii)) Vxxxx]); + elseif ( plot_type == 4 ) + loglog(freq,[abs(spectra(:,ii)) Vxxxx]); + elseif ( plot_type == 5 ) % db + ylabel( 'amplitude (dB)' ); + plot(freq,[10*log10(abs(spectra(:,ii))) 10*log10(abs(Vxxxx))]); + end + title( char(plot_title(spect_type(ii),:)) ); + ylabel( 'amplitude' ); + %% Plot phase of cross spectrum and transfer function + if ( spect_type(ii)==2 || spect_type(ii)==3 ) + figure(); + if ( plot_type==2 || plot_type==4 ) + semilogx(freq,180/pi*angle(spectra(:,ii))); + else + plot(freq,180/pi*angle(spectra(:,ii))); + end + title( char(plot_title(spect_type(ii),:)) ); + ylabel( 'phase' ); + end + end %for + end + end +end + +%!demo +%! fflush(stdout); +%! rand('seed',2038014164); +%! a = [ 1.0 -1.6216505 1.1102795 -0.4621741 0.2075552 -0.018756746 ]; +%! white = rand(1,16384); +%! signal = detrend(filter(0.70181,a,white)); +%! % frequency shift by modulating with exp(j.omega.t) +%! skewed = signal.*exp(2*pi*i*2/25*[1:16384]); +%! Fs = 25; % sampling frequency +%! hold off +%! pwelch([]); +%! pwelch(signal); +%! disp('Default settings: Fs=1Hz, overlap=0.5, no padding' ) +%! input('Onesided power spectral density (real data). Press ENTER', 's' ); +%! hold on +%! pwelch(skewed); +%! disp('Frequency-shifted complex data. Twosided wrap-around spectrum.' ); +%! input('Area is same as one-sided spectrum. Press ENTER', 's' ); +%! pwelch(signal,'shift','semilogy'); +%! input('Twosided, centred zero-frequency, lin-log plot. Press ENTER', 's' ); +%! hold off +%! figure(); +%! pwelch(skewed,[],[],[],Fs,'shift','semilogy'); +%! input('Actual Fs=25 Hz. Note change of scales. Press ENTER', 's' ); +%! pwelch(skewed,[],[],[],Fs,0.95,'shift','semilogy'); +%! input('Spectral density with 95% confidence interval. Press ENTER', 's' ); +%! pwelch('R12+'); +%! pwelch(signal,'squared'); +%! input('Spectral density with Matlab R12 defaults. Press ENTER', 's' ); +%! figure(); +%! pwelch([]); +%! pwelch(signal,3640,[],4096,2*pi,[],'no-strip'); +%! input('Same spectrum with 95% confidence interval. Press ENTER', 's' ); +%! figure(); +%! pwelch(signal,[],[],[],2*pi,0.95,'no-strip'); +%! input('95% confidence interval with native defaults. Press ENTER', 's' ); +%! pwelch(signal,64,[],[],2*pi,'no-strip'); +%! input('Only 32 frequency values in this spectrum. Press ENTER', 's' ); +%! hold on +%! pwelch(signal,64,[],256,2*pi,'no-strip'); +%! input('4:1 zero padding gives artificial smoothing. Press ENTER', 's' ); +%! figure(); +%! pwelch('psd'); +%! pwelch(signal,'squared'); +%! input('Just like Matlab spectrum.welch(...) defaults. Press ENTER', 's' ); +%! hold off +%! pwelch({}); +%! pwelch(white,signal,'trans','coher','short') +%! input('Transfer and coherence functions. Press ENTER', 's' ); +%! disp('Use "close all" to remove plotting windows.' ); diff --git a/octave_packages/signal-1.1.3/pyulear.m b/octave_packages/signal-1.1.3/pyulear.m new file mode 100644 index 0000000..709ca59 --- /dev/null +++ b/octave_packages/signal-1.1.3/pyulear.m @@ -0,0 +1,120 @@ +%% Copyright (C) 2006 Peter V. Lanspeary +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% usage: +%% [psd,f_out] = pyulear(x,poles,freq,Fs,range,method,plot_type) +%% +%% Calculates a Yule-Walker autoregressive (all-pole) model of the data "x" +%% and computes the power spectrum of the model. This is a wrapper for +%% functions "aryule" and "ar_psd" which perform the argument checking. +%% See "help aryule" and "help ar_psd" for further details. +%% +%% ARGUMENTS: +%% All but the first two arguments are optional and may be empty. +%% x %% [vector] sampled data +%% +%% poles %% [integer scalar] required number of poles of the AR model +%% +%% freq %% [real vector] frequencies at which power spectral density +%% %% is calculated +%% %% [integer scalar] number of uniformly distributed frequency +%% %% values at which spectral density is calculated. +%% %% [default=256] +%% +%% Fs %% [real scalar] sampling frequency (Hertz) [default=1] +%% +%% +%% CONTROL-STRING ARGUMENTS -- each of these arguments is a character string. +%% Control-string arguments can be in any order after the other arguments. +%% +%% +%% range %% 'half', 'onesided' : frequency range of the spectrum is +%% %% from zero up to but not including sample_f/2. Power +%% %% from negative frequencies is added to the positive +%% %% side of the spectrum. +%% %% 'whole', 'twosided' : frequency range of the spectrum is +%% %% -sample_f/2 to sample_f/2, with negative frequencies +%% %% stored in "wrap around" order after the positive +%% %% frequencies; e.g. frequencies for a 10-point 'twosided' +%% %% spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 +%% %% 'shift', 'centerdc' : same as 'whole' but with the first half +%% %% of the spectrum swapped with second half to put the +%% %% zero-frequency value in the middle. (See "help +%% %% fftshift". If "freq" is vector, 'shift' is ignored. +%% %% If model coefficients "ar_coeffs" are real, the default +%% %% range is 'half', otherwise default range is 'whole'. +%% +%% method %% 'fft': use FFT to calculate power spectrum. +%% %% 'poly': calculate power spectrum as a polynomial of 1/z +%% %% N.B. this argument is ignored if the "freq" argument is a +%% %% vector. The default is 'poly' unless the "freq" +%% %% argument is an integer power of 2. +%% +%% plot_type %% 'plot', 'semilogx', 'semilogy', 'loglog', 'squared' or 'db': +%% %% specifies the type of plot. The default is 'plot', which +%% %% means linear-linear axes. 'squared' is the same as 'plot'. +%% %% 'dB' plots "10*log10(psd)". This argument is ignored and a +%% %% spectrum is not plotted if the caller requires a returned +%% %% value. +%% +%% RETURNED VALUES: +%% If return values are not required by the caller, the spectrum +%% is plotted and nothing is returned. +%% psd %% [real vector] power-spectrum estimate +%% f_out %% [real vector] frequency values +%% +%% HINTS +%% This function is a wrapper for aryule and ar_psd. +%% See "help aryule", "help ar_psd". + +function [psd,f_out]=pyulear(x,poles,varargin) + %% + if ( nargin<2 ) + error( 'pburg: need at least 2 args. Use "help pburg"' ); + end + %% + [ar_coeffs,residual,k]=aryule(x,poles); + if ( nargout==0 ) + ar_psd(ar_coeffs,residual,varargin{:}); + elseif ( nargout==1 ) + psd = ar_psd(ar_coeffs,residual,varargin{:}); + elseif ( nargout>=2 ) + [psd,f_out] = ar_psd(ar_coeffs,residual,varargin{:}); + end +end + +%!demo +%! fflush(stdout); +%! rand('seed',2038014164); +%! a = [ 1.0 -1.6216505 1.1102795 -0.4621741 0.2075552 -0.018756746 ]; +%! signal = detrend(filter(0.70181,a,rand(1,16384))); +%! % frequency shift by modulating with exp(j.omega.t) +%! skewed = signal.*exp(2*pi*i*2/25*[1:16384]); +%! Fs = 25; +%! hold on +%! pyulear(signal,3,[],Fs); +%! disp( 'Results from this demo should be nearly the same as pburg demo' ); +%! input('Onesided 3-pole spectrum. Press ENTER', 's' ); +%! pyulear(signal,4,[],Fs,'whole'); +%! input('Twosided 4-pole spectrum of same data. Press ENTER', 's' ); +%! pyulear(signal,5,128,Fs,'shift', 'semilogy'); +%! input('Twosided, centred zero-frequency, 5-pole. Press ENTER', 's' ); +%! pyulear(skewed,7,128,Fs,'shift','semilogy'); +%! input('Complex data, frequency-shifted. Press ENTER', 's' ); +%! user_freq=[-0.2:0.02:0.2]*Fs; +%! pyulear(skewed,7,user_freq,Fs,'semilogy'); +%! input('User-specified frequency values. Press ENTER', 's' ); +%! hold off +%! clf diff --git a/octave_packages/signal-1.1.3/qp_kaiser.m b/octave_packages/signal-1.1.3/qp_kaiser.m new file mode 100644 index 0000000..c1b4c2e --- /dev/null +++ b/octave_packages/signal-1.1.3/qp_kaiser.m @@ -0,0 +1,90 @@ +## Copyright (C) 2002 André Carezia +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Usage: qp_kaiser (nb, at, linear) +## +## Computes a finite impulse response (FIR) filter for use with a +## quasi-perfect reconstruction polyphase-network filter bank. This +## version utilizes a Kaiser window to shape the frequency response of +## the designed filter. Tha number nb of bands and the desired +## attenuation at in the stop-band are given as parameters. +## +## The Kaiser window is multiplied by the ideal impulse response +## h(n)=a.sinc(a.n) and converted to its minimum-phase version by means +## of a Hilbert transform. +## +## By using a third non-null argument, the minimum-phase calculation is +## ommited at all. + +function h = qp_kaiser (nb, at, linear = 0) + + if (nargin < 2) + print_usage; + elseif !(isscalar (nb) && (nb == round(nb)) && (nb >= 0)) + error ("qp_kaiser: nb has to be a positive integer"); + elseif !(isscalar (at) && (at == real (at))) + error ("qp_kaiser: at has to be a real constant"); + endif + + # Bandwidth + bandwidth = pi/nb; + + # Attenuation correction (empirically + # determined by M. Gerken + # ) + corr = (1.4+0.6*(at-20)/80)^(20/at); + at = corr * at; + + # size of window (rounded to next odd + # integer) + N = (at - 8) / (2.285*bandwidth); + M = fix(N/2); + N = 2*M + 1; + + # Kaiser window + if (at>50) + beta = 0.1102 * (at - 8.7); + elseif (at>21) + beta = 0.5842 * (at - 21)^0.4 + 0.07886 * (at - 21); + else + beta = 0; + endif + w = kaiser(N,beta); + # squared in freq. domain + wsquared = conv(w,w); + + # multiplied by ideal lowpass filter + n = -(N-1):(N-1); + hideal = 1/nb * sinc(n/nb); + hcomp = wsquared .* hideal; + + # extract square-root of response and + # compute minimum-phase version + Ndft = 2^15; + Hsqr = sqrt(abs(fft(hcomp,Ndft))); + if (linear) + h = real(ifft(Hsqr)); + h = h(2:N); + h = [fliplr(h) h(1) h]; + else + Hmin = Hsqr .* exp(-j*imag(hilbert(log(Hsqr)))); + h = real(ifft(Hmin)); + h = h(1:N); + endif + # truncate and fix amplitude scale + # (H(0)=1) + h = h / sum(h); + +endfunction diff --git a/octave_packages/signal-1.1.3/rceps.m b/octave_packages/signal-1.1.3/rceps.m new file mode 100644 index 0000000..14df8c9 --- /dev/null +++ b/octave_packages/signal-1.1.3/rceps.m @@ -0,0 +1,105 @@ +## Copyright (C) 1999 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [y, xm] = rceps(x) +## Produce the cepstrum of the signal x, and if desired, the minimum +## phase reconstruction of the signal x. If x is a matrix, do so +## for each column of the matrix. +## +## Example +## f0=70; Fs=10000; # 100 Hz fundamental, 10kHz sampling rate +## a=poly(0.985*exp(1i*pi*[0.1, -0.1, 0.3, -0.3])); # two formants +## s=0.005*randn(1024,1); # Noise excitation signal +## s(1:Fs/f0:length(s)) = 1; # Impulse glottal wave +## x=filter(1,a,s); # Speech signal in x +## [y, xm] = rceps(x.*hanning(1024)); # cepstrum and min phase reconstruction +## +## Reference +## Programs for digital signal processing. IEEE Press. +## New York: John Wiley & Sons. 1979. + +function [y, ym] = rceps(x) + if (nargin != 1) + print_usage; + end + y = real(ifft(log(abs(fft(x))))); + if nargout == 2 + n=length(x); + if rows(x)==1 + if rem(n,2)==1 + ym = [y(1), 2*y(2:n/2), zeros(1,n/2-1)]; + else + ym = [y(1), 2*y(2:n/2), y(n/2+1), zeros(1,n/2-1)]; + endif + else + if rem(n,2)==1 + ym = [y(1,:); 2*y(2:n/2,:); zeros(n/2-1,columns(y))]; + else + ym = [y(1,:); 2*y(2:n/2,:); y(n/2+1,:); zeros(n/2-1,columns(y))]; + endif + endif + ym = real(ifft(exp(fft(ym)))); + endif +endfunction + +%!error rceps +%!error rceps(1,2) # too many arguments + +%!test +%! ## accepts matrices +%! x=randn(32,3); +%! [y, xm] = rceps(x); +%! ## check the mag-phase response of the reproduction +%! hx = fft(x); +%! hxm = fft(xm); +%! assert(abs(hx), abs(hxm), 200*eps); # good magnitude response match +%! #XXX FIXME XXX test for minimum phase? Stop using random datasets! +%! #assert(arg(hx) != arg(hxm)); # phase mismatch + +%!test +%! ## accepts column and row vectors +%! x=randn(256,1); +%! [y, xm] = rceps(x); +%! [yt, xmt] = rceps(x.'); +%! tol = 1e-14; +%! assert(yt.', y, tol); +%! assert(xmt.', xm, tol); + +%!demo +%! f0=70; Fs=10000; # 100 Hz fundamental, 10kHz sampling rate +%! a=real(poly(0.985*exp(1i*pi*[0.1, -0.1, 0.3, -0.3]))); # two formants +%! s=0.05*randn(1024,1); # Noise excitation signal +%! s(floor(1:Fs/f0:length(s))) = 1; # Impulse glottal wave +%! x=filter(1,a,s); # Speech signal in x +%! [y, xm] = rceps(x); # cepstrum and minimum phase x +%! [hx, w] = freqz(x,1,[],Fs); hxm = freqz(xm); +%! figure(1); +%! subplot(311); +%! auplot(x,Fs,'b',';signal;'); +%! hold on; auplot(xm,Fs,'g',';reconstruction;'); +%! hold off; +%! subplot(312); +%! axis("ticy"); +%! plot(w,log(abs(hx)), ";magnitude;", ... +%! w,log(abs(hxm)),";reconstruction;"); +%! subplot(313); +%! axis("on"); +%! plot(w,unwrap(arg(hx))/(2*pi), ";phase;",... +%! w,unwrap(arg(hxm))/(2*pi),";reconstruction;"); +%! figure(2); auplot(y,Fs,';cepstrum;'); +%! %------------------------------------------------------------- +%! % confirm the magnitude spectrum is identical in the signal +%! % and the reconstruction and that there are peaks in the +%! % cepstrum at 14 ms intervals corresponding to an F0 of 70 Hz. diff --git a/octave_packages/signal-1.1.3/rectpuls.m b/octave_packages/signal-1.1.3/rectpuls.m new file mode 100644 index 0000000..8d68672 --- /dev/null +++ b/octave_packages/signal-1.1.3/rectpuls.m @@ -0,0 +1,57 @@ +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: y = rectpuls(t, w) +## +## Generate a rectangular pulse over the interval [-w/2,w/2), sampled at +## times t. This is useful with the function pulstran for generating a +## series pulses. +## +## Example +## fs = 11025; # arbitrary sample rate +## f0 = 100; # pulse train sample rate +## w = 0.3/f0; # pulse width 3/10th the distance between pulses +## auplot(pulstran(0:1/fs:4/f0, 0:1/f0:4/f0, 'rectpuls', w), fs); +## +## See also: pulstran + +function y = rectpuls(t, w = 1) + + if nargin<1 || nargin>2, + print_usage; + endif + + y = zeros(size(t)); + idx = find(t>=-w/2 & t < w/2); + try wfi = warning("off", "Octave:fortran-indexing"); + catch wfi = 0; + end + unwind_protect + y(idx) = ones(size(idx)); + unwind_protect_cleanup + warning(wfi); + end_unwind_protect +endfunction + +%!assert(rectpuls(0:1/100:0.3,.1), rectpuls([0:1/100:0.3]',.1)'); +%!assert(isempty(rectpuls([],.1))); +%!demo +%! fs = 11025; # arbitrary sample rate +%! f0 = 100; # pulse train sample rate +%! w = 0.3/f0; # pulse width 1/10th the distance between pulses +%! ylabel("amplitude"); xlabel("time (ms)"); +%! title("graph shows 3 ms pulses at 0,10,20,30 and 40 ms"); +%! auplot(pulstran(0:1/fs:4/f0, 0:1/f0:4/f0, 'rectpuls', w), fs); +%! title(""); xlabel(""); ylabel(""); diff --git a/octave_packages/signal-1.1.3/rectwin.m b/octave_packages/signal-1.1.3/rectwin.m new file mode 100644 index 0000000..b8aaa29 --- /dev/null +++ b/octave_packages/signal-1.1.3/rectwin.m @@ -0,0 +1,25 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{w}] =} rectwin(@var{L}) +## Return the filter coefficients of a rectangle window of length L. +## @seealso{hamming, hanning} +## @end deftypefn + +function w = rectwin(L) + if (nargin < 1); print_usage; end + w = ones(round(L),1); +endfunction diff --git a/octave_packages/signal-1.1.3/resample.m b/octave_packages/signal-1.1.3/resample.m new file mode 100644 index 0000000..3a76aeb --- /dev/null +++ b/octave_packages/signal-1.1.3/resample.m @@ -0,0 +1,192 @@ +## Copyright (C) 2008 Eric Chassande-Mottin, CNRS (France) +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y} @var{h}]=} resample(@var{x},@var{p},@var{q}) +## @deftypefnx {Function File} {@var{y} =} resample(@var{x},@var{p},@var{q},@var{h}) +## Change the sample rate of @var{x} by a factor of @var{p}/@var{q}. This is +## performed using a polyphase algorithm. The impulse response @var{h} of the antialiasing +## filter is either specified or either designed with a Kaiser-windowed sinecard. +## +## Ref [1] J. G. Proakis and D. G. Manolakis, +## Digital Signal Processing: Principles, Algorithms, and Applications, +## 4th ed., Prentice Hall, 2007. Chap. 6 +## +## Ref [2] A. V. Oppenheim, R. W. Schafer and J. R. Buck, +## Discrete-time signal processing, Signal processing series, +## Prentice-Hall, 1999 +## @end deftypefn + +function [y, h] = resample( x, p, q, h ) + + if nargchk(3,4,nargin) + print_usage; + elseif any([p q]<=0) || any([p q]~=floor([p q])), + error("resample.m: p and q must be positive integers"); + endif + + ## simplify decimation and interpolation factors + + great_common_divisor=gcd(p,q); + if (great_common_divisor>1) + p=p/great_common_divisor; + q=q/great_common_divisor; + endif + + ## filter design if required + + if (nargin < 4) + + ## properties of the antialiasing filter + + log10_rejection = -3.0; + stopband_cutoff_f = 1.0/(2.0 * max(p,q)); + roll_off_width = stopband_cutoff_f / 10.0; + + ## determine filter length + ## use empirical formula from [2] Chap 7, Eq. (7.63) p 476 + + rejection_dB = -20.0*log10_rejection; + L = ceil((rejection_dB-8.0) / (28.714 * roll_off_width)); + + ## ideal sinc filter + + t=(-L:L)'; + ideal_filter=2*p*stopband_cutoff_f*sinc(2*stopband_cutoff_f*t); + + ## determine parameter of Kaiser window + ## use empirical formula from [2] Chap 7, Eq. (7.62) p 474 + + if ((rejection_dB>=21) && (rejection_dB<=50)) + beta = 0.5842 * (rejection_dB-21.0)^0.4 + 0.07886 * (rejection_dB-21.0); + elseif (rejection_dB>50) + beta = 0.1102 * (rejection_dB-8.7); + else + beta = 0.0; + endif + + ## apodize ideal filter response + + h=kaiser(2*L+1,beta).*ideal_filter; + + endif + + ## check if input is a row vector + isrowvector=false; + if ((rows(x)==1) && (columns(x)>1)) + x=x(:); + isrowvector=true; + endif + + ## check if filter is a vector + if ~isvector(h) + error("resample.m: the filter h should be a vector"); + endif + + Lx = rows(x); + Lh = length(h); + L = ( Lh - 1 )/2.0; + Ly = ceil(Lx*p/q); + + ## pre and postpad filter response + + nz_pre = floor(q-mod(L,q)); + hpad = prepad(h,Lh+nz_pre); + + offset = floor((L+nz_pre)/q); + nz_post = 0; + while ceil( ( (Lx-1)*p + nz_pre + Lh + nz_post )/q ) - offset < Ly + nz_post++; + endwhile + hpad = postpad(hpad,Lh + nz_pre + nz_post); + + ## filtering + xfilt = upfirdn(x,hpad,p,q); + y = xfilt(offset+1:offset+Ly,:); + + if isrowvector, + y=y.'; + endif + +endfunction + +%!test +%! N=512; +%! p=3; q=5; +%! r=p/q; +%! NN=ceil(r*N); +%! t=0:N-1; +%! tt=0:NN-1; +%! err=zeros(N/2,1); +%! for n = 0:N/2-1, +%! phi0=2*pi*rand; +%! f0=n/N; +%! x=sin(2*pi*f0*t' + phi0); +%! [y,h]=resample(x,p,q); +%! xx=sin(2*pi*f0/r*tt' + phi0); +%! t0=ceil((length(h)-1)/2/q); +%! idx=t0+1:NN-t0; +%! err(n+1)=max(abs(y(idx)-xx(idx))); +%! endfor; +%! rolloff=.1; +%! rejection=10^-3; +%! idx_inband=1:ceil((1-rolloff/2)*r*N/2)-1; +%! assert(max(err(idx_inband)) +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% -*- texinfo -*- +%% @deftypefn {Function File} {[@var{r}, @var{p}, @var{f}, @var{m}] =} residued (@var{B}, @var{A}) +%% Compute the partial fraction expansion (PFE) of filter +%% @math{H(z) = B(z)/A(z)}. +%% In the usual PFE function @code{residuez}, +%% the IIR part (poles @var{p} and residues +%% @var{r}) is driven @emph{in parallel} with the FIR part (@var{f}). +%% In this variant (@code{residued}) the IIR part is driven +%% by the @emph{output} of the FIR part. This structure can be +%% more accurate in signal modeling applications. +%% +%% INPUTS: +%% @var{B} and @var{A} are vectors specifying the digital filter @math{H(z) = B(z)/A(z)}. +%% Say @code{help filter} for documentation of the @var{B} and @var{A} +%% filter coefficients. +%% +%% RETURNED: +%% @itemize +%% @item @var{r} = column vector containing the filter-pole residues@* +%% @item @var{p} = column vector containing the filter poles@* +%% @item @var{f} = row vector containing the FIR part, if any@* +%% @item @var{m} = column vector of pole multiplicities +%% @end itemize +%% +%% EXAMPLES: +%% @example +%% Say @code{test residued verbose} to see a number of examples. +%% @end example +%% +%% For the theory of operation, see +%% @indicateurl{http://ccrma.stanford.edu/~jos/filters/residued.html} +%% +%% @seealso{residue residued} +%% @end deftypefn + +function [r, p, f, m] = residued(b, a, toler) + % RESIDUED - return residues, poles, and FIR part of B(z)/A(z) + % + % Let nb = length(b), na = length(a), and N=na-1 = no. of poles. + % If nb +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% -*- texinfo -*- +%% @deftypefn {Function File} {[@var{r}, @var{p}, @var{f}, @var{m}] =} residuez (@var{B}, @var{A}) +%% Compute the partial fraction expansion of filter @math{H(z) = B(z)/A(z)}. +%% +%% INPUTS: +%% @var{B} and @var{A} are vectors specifying the digital filter @math{H(z) = B(z)/A(z)}. +%% Say @code{help filter} for documentation of the @var{B} and @var{A} +%% filter coefficients. +%% +%% RETURNED: +%% @itemize +%% @item @var{r} = column vector containing the filter-pole residues@* +%% @item @var{p} = column vector containing the filter poles@* +%% @item @var{f} = row vector containing the FIR part, if any@* +%% @item @var{m} = column vector of pole multiplicities +%% @end itemize +%% +%% EXAMPLES: +%% @example +%% Say @code{test residuez verbose} to see a number of examples. +%% @end example +%% +%% For the theory of operation, see +%% @indicateurl{http://ccrma.stanford.edu/~jos/filters/residuez.html} +%% +%% @seealso{residue residued} +%% @end deftypefn + +function [r, p, f, m] = residuez(B, A, tol) + % RESIDUEZ - return residues, poles, and FIR part of B(z)/A(z) + % + % Let nb = length(b), na = length(a), and N=na-1 = no. of poles. + % If nb= na, the FIR part f will not be empty. + % Let M = nb-na+1 = order of f = length(f)-1). Then the returned filter is + % + % H(z) = f(1) + f(2)/z + f(3)/z^2 + ... + f(M+1)/z^M + R(z) + % + % where R(z) is the parallel one-pole filter bank defined above. + % Note, in particular, that the impulse-response of the one-pole + % filter bank is in parallel with that of the the FIR part. This can + % be wasteful when matching the initial impulse response is important, + % since F(z) can already match the first N terms of the impulse + % response. To obtain a decomposition in which the impulse response of + % the IIR part R(z) starts after that of the FIR part F(z), use RESIDUED. + % + % J.O. Smith, 9/19/05 + + if nargin==3 + warning("tolerance ignored"); + end + NUM = B(:)'; DEN = A(:)'; + % Matlab's residue does not return m (since it is implied by p): + [r,p,f,m]=residue(conj(fliplr(NUM)),conj(fliplr(DEN))); + p = 1 ./ p; + r = r .* ((-p) .^m); + if f, f = conj(fliplr(f)); end +end + +%!test +%! B=[1 -2 1]; A=[1 -1]; +%! [r,p,f,m] = residuez(B,A); +%! assert(r,0,100*eps); +%! assert(p,1,100*eps); +%! assert(f,[1 -1],100*eps); +%! assert(m,1,100*eps); + +%!test +%! B=1; A=[1 -1j]; +%! [r,p,f,m] = residuez(B,A); +%! assert(r,1,100*eps); +%! assert(p,1j,100*eps); +%! assert(f,[],100*eps); +%! assert(m,1,100*eps); + +%!test +%! B=1; A=[1 -1 .25]; +%! [r,p,f,m] = residuez(B,A); +%! [rs,is] = sort(r); +%! assert(rs,[0;1],1e-7); +%! assert(p(is),[0.5;0.5],1e-8); +%! assert(f,[],100*eps); +%! assert(m(is),[1;2],100*eps); + +%!test +%! B=1; A=[1 -0.75 .125]; +%! [r,p,f,m] = residuez(B,A); +%! [rs,is] = sort(r); +%! assert(rs,[-1;2],100*eps); +%! assert(p(is),[0.25;0.5],100*eps); +%! assert(f,[],100*eps); +%! assert(m(is),[1;1],100*eps); + +%!test +%! B=[1,6,2]; A=[1,-2,1]; +%! [r,p,f,m] = residuez(B,A); +%! [rs,is] = sort(r); +%! assert(rs,[-10;9],1e-7); +%! assert(p(is),[1;1],1e-8); +%! assert(f,[2],100*eps); +%! assert(m(is),[1;2],100*eps); + +%!test +%! B=[6,2]; A=[1,-2,1]; +%! [r,p,f,m] = residuez(B,A); +%! [rs,is] = sort(r); +%! assert(rs,[-2;8],1e-7); +%! assert(p(is),[1;1],1e-8); +%! assert(f,[],100*eps); +%! assert(m(is),[1;2],100*eps); + +%!test +%! B=[1,6,6,2]; A=[1,-2,1]; +%! [r,p,f,m] = residuez(B,A); +%! [rs,is] = sort(r); +%! assert(rs,[-24;15],2e-7); +%! assert(p(is),[1;1],1e-8); +%! assert(f,[10,2],100*eps); +%! assert(m(is),[1;2],100*eps); + +%!test +%! B=[1,6,6,2]; A=[1,-(2+j),(1+2j),-j]; +%! [r,p,f,m] = residuez(B,A); +%! [rs,is] = sort(r); +%! assert(rs,[-2+2.5j;7.5+7.5j;-4.5-12j],1E-6); +%! assert(p(is),[1j;1;1],1E-6); +%! assert(f,-2j,1E-6); +%! assert(m(is),[1;2;1],1E-6); + +%!test +%! B=[1,0,1]; A=[1,0,0,0,0,-1]; +%! [r,p,f,m] = residuez(B,A); +%! [as,is] = sort(angle(p)); +%! rise = [ ... +%! 0.26180339887499 - 0.19021130325903i; ... +%! 0.03819660112501 + 0.11755705045849i; ... +%! 0.4; ... +%! 0.03819660112501 - 0.11755705045849i; ... +%! 0.26180339887499 + 0.19021130325903i;]; +%! pise = [ ... +%! -0.80901699437495 - 0.58778525229247i; ... +%! 0.30901699437495 - 0.95105651629515i; ... +%! 1; ... +%! 0.30901699437495 + 0.95105651629515i; ... +%! -0.80901699437495 + 0.58778525229247i]; +%! assert(r(is),rise,100*eps); +%! assert(p(is),pise,100*eps); +%! assert(f,[],100*eps); +%! assert(m,[1;1;1;1;1],100*eps); diff --git a/octave_packages/signal-1.1.3/sampled2continuous.m b/octave_packages/signal-1.1.3/sampled2continuous.m new file mode 100644 index 0000000..92102ae --- /dev/null +++ b/octave_packages/signal-1.1.3/sampled2continuous.m @@ -0,0 +1,43 @@ +## Copyright (C) 2009 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Usage: +## +## xt = sampled2continuous( xn , T, t ) +## +## Calculate the x(t) reconstructed +## from samples x[n] sampled at a rate 1/T samples +## per unit time. +## +## t is all the instants of time when you need x(t) +## from x[n]; this time is relative to x[0] and not +## an absolute time. +## +## This function can be used to calculate sampling rate +## effects on aliasing, actual signal reconstruction +## from discrete samples. + +function xt = sampled2continuous( xn , T, t ) + if ( nargin < 3 ) + print_usage() + endif + + N = length( xn ); + xn = reshape( xn, N, 1 ); + [TT,tt]= meshgrid(T*(0:N-1)',t); + S = sinc((tt -TT)./T); + xt = S*xn; + return +end diff --git a/octave_packages/signal-1.1.3/sawtooth.m b/octave_packages/signal-1.1.3/sawtooth.m new file mode 100644 index 0000000..7707d8f --- /dev/null +++ b/octave_packages/signal-1.1.3/sawtooth.m @@ -0,0 +1,59 @@ +## Copyright (C) 2007 Juan Aguado +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y}] =} sawtooth(@var{t}) +## @deftypefnx {Function File} {[@var{y}] =} sawtooth(@var{t},@var{width}) +## Generates a sawtooth wave of period @code{2 * pi} with limits @code{+1/-1} +## for the elements of @var{t}. +## +## @var{width} is a real number between @code{0} and @code{1} which specifies +## the point between @code{0} and @code{2 * pi} where the maximum is. The +## function increases linearly from @code{-1} to @code{1} in @code{[0, 2 * +## pi * @var{width}]} interval, and decreases linearly from @code{1} to +## @code{-1} in the interval @code{[2 * pi * @var{width}, 2 * pi]}. +## +## If @var{width} is 0.5, the function generates a standard triangular wave. +## +## If @var{width} is not specified, it takes a value of 1, which is a standard +## sawtooth function. +## @end deftypefn + +function y = sawtooth (t,width) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 1) + width = 1; + else + if (width < 0 || width > 1 || ! isreal (width)) + error ("width must be a real number between 0 and 1."); + endif + endif + + t = mod (t / (2 * pi), 1); + y = zeros (size (t)); + + if (width != 0) + y (t < width) = 2 * t (t < width) / width - 1; + endif + + if (width != 1) + y( t >= width) = -2 * (t (t >= width) - width) / (1 - width) + 1; + endif + +endfunction diff --git a/octave_packages/signal-1.1.3/sftrans.m b/octave_packages/signal-1.1.3/sftrans.m new file mode 100644 index 0000000..0c6dc7d --- /dev/null +++ b/octave_packages/signal-1.1.3/sftrans.m @@ -0,0 +1,183 @@ +## Copyright (C) 1999-2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [Sz, Sp, Sg] = sftrans(Sz, Sp, Sg, W, stop) +## +## Transform band edges of a generic lowpass filter (cutoff at W=1) +## represented in splane zero-pole-gain form. W is the edge of the +## target filter (or edges if band pass or band stop). Stop is true for +## high pass and band stop filters or false for low pass and band pass +## filters. Filter edges are specified in radians, from 0 to pi (the +## nyquist frequency). +## +## Theory: Given a low pass filter represented by poles and zeros in the +## splane, you can convert it to a low pass, high pass, band pass or +## band stop by transforming each of the poles and zeros individually. +## The following table summarizes the transformation: +## +## Transform Zero at x Pole at x +## ---------------- ------------------------- ------------------------ +## Low Pass zero: Fc x/C pole: Fc x/C +## S -> C S/Fc gain: C/Fc gain: Fc/C +## ---------------- ------------------------- ------------------------ +## High Pass zero: Fc C/x pole: Fc C/x +## S -> C Fc/S pole: 0 zero: 0 +## gain: -x gain: -1/x +## ---------------- ------------------------- ------------------------ +## Band Pass zero: b ± sqrt(b^2-FhFl) pole: b ± sqrt(b^2-FhFl) +## S^2+FhFl pole: 0 zero: 0 +## S -> C -------- gain: C/(Fh-Fl) gain: (Fh-Fl)/C +## S(Fh-Fl) b=x/C (Fh-Fl)/2 b=x/C (Fh-Fl)/2 +## ---------------- ------------------------- ------------------------ +## Band Stop zero: b ± sqrt(b^2-FhFl) pole: b ± sqrt(b^2-FhFl) +## S(Fh-Fl) pole: ±sqrt(-FhFl) zero: ±sqrt(-FhFl) +## S -> C -------- gain: -x gain: -1/x +## S^2+FhFl b=C/x (Fh-Fl)/2 b=C/x (Fh-Fl)/2 +## ---------------- ------------------------- ------------------------ +## Bilinear zero: (2+xT)/(2-xT) pole: (2+xT)/(2-xT) +## 2 z-1 pole: -1 zero: -1 +## S -> - --- gain: (2-xT)/T gain: (2-xT)/T +## T z+1 +## ---------------- ------------------------- ------------------------ +## +## where C is the cutoff frequency of the initial lowpass filter, Fc is +## the edge of the target low/high pass filter and [Fl,Fh] are the edges +## of the target band pass/stop filter. With abundant tedious algebra, +## you can derive the above formulae yourself by substituting the +## transform for S into H(S)=S-x for a zero at x or H(S)=1/(S-x) for a +## pole at x, and converting the result into the form: +## +## H(S)=g prod(S-Xi)/prod(S-Xj) +## +## The transforms are from the references. The actual pole-zero-gain +## changes I derived myself. +## +## Please note that a pole and a zero at the same place exactly cancel. +## This is significant for High Pass, Band Pass and Band Stop filters +## which create numerous extra poles and zeros, most of which cancel. +## Those which do not cancel have a "fill-in" effect, extending the +## shorter of the sets to have the same number of as the longer of the +## sets of poles and zeros (or at least split the difference in the case +## of the band pass filter). There may be other opportunistic +## cancellations but I will not check for them. +## +## Also note that any pole on the unit circle or beyond will result in +## an unstable filter. Because of cancellation, this will only happen +## if the number of poles is smaller than the number of zeros and the +## filter is high pass or band pass. The analytic design methods all +## yield more poles than zeros, so this will not be a problem. +## +## References: +## +## Proakis & Manolakis (1992). Digital Signal Processing. New York: +## Macmillan Publishing Company. + +function [Sz, Sp, Sg] = sftrans(Sz, Sp, Sg, W, stop) + + if (nargin != 5) + print_usage; + end + + C = 1; + p = length(Sp); + z = length(Sz); + if z > p || p == 0 + error("sftrans: must have at least as many poles as zeros in s-plane"); + end + + if length(W)==2 + Fl = W(1); + Fh = W(2); + if stop +## ---------------- ------------------------- ------------------------ +## Band Stop zero: b ± sqrt(b^2-FhFl) pole: b ± sqrt(b^2-FhFl) +## S(Fh-Fl) pole: ±sqrt(-FhFl) zero: ±sqrt(-FhFl) +## S -> C -------- gain: -x gain: -1/x +## S^2+FhFl b=C/x (Fh-Fl)/2 b=C/x (Fh-Fl)/2 +## ---------------- ------------------------- ------------------------ + if (isempty(Sz)) + Sg = Sg * real (1./ prod(-Sp)); + elseif (isempty(Sp)) + Sg = Sg * real(prod(-Sz)); + else + Sg = Sg * real(prod(-Sz)/prod(-Sp)); + endif + b = (C*(Fh-Fl)/2)./Sp; + Sp = [b+sqrt(b.^2-Fh*Fl), b-sqrt(b.^2-Fh*Fl)]; + extend = [sqrt(-Fh*Fl), -sqrt(-Fh*Fl)]; + if isempty(Sz) + Sz = [extend(1+rem([1:2*p],2))]; + else + b = (C*(Fh-Fl)/2)./Sz; + Sz = [b+sqrt(b.^2-Fh*Fl), b-sqrt(b.^2-Fh*Fl)]; + if (p > z) + Sz = [Sz, extend(1+rem([1:2*(p-z)],2))]; + end + end + else +## ---------------- ------------------------- ------------------------ +## Band Pass zero: b ± sqrt(b^2-FhFl) pole: b ± sqrt(b^2-FhFl) +## S^2+FhFl pole: 0 zero: 0 +## S -> C -------- gain: C/(Fh-Fl) gain: (Fh-Fl)/C +## S(Fh-Fl) b=x/C (Fh-Fl)/2 b=x/C (Fh-Fl)/2 +## ---------------- ------------------------- ------------------------ + Sg = Sg * (C/(Fh-Fl))^(z-p); + b = Sp*((Fh-Fl)/(2*C)); + Sp = [b+sqrt(b.^2-Fh*Fl), b-sqrt(b.^2-Fh*Fl)]; + if isempty(Sz) + Sz = zeros(1,p); + else + b = Sz*((Fh-Fl)/(2*C)); + Sz = [b+sqrt(b.^2-Fh*Fl), b-sqrt(b.^2-Fh*Fl)]; + if (p>z) + Sz = [Sz, zeros(1, (p-z))]; + end + end + end + else + Fc = W; + if stop +## ---------------- ------------------------- ------------------------ +## High Pass zero: Fc C/x pole: Fc C/x +## S -> C Fc/S pole: 0 zero: 0 +## gain: -x gain: -1/x +## ---------------- ------------------------- ------------------------ + if (isempty(Sz)) + Sg = Sg * real (1./ prod(-Sp)); + elseif (isempty(Sp)) + Sg = Sg * real(prod(-Sz)); + else + Sg = Sg * real(prod(-Sz)/prod(-Sp)); + endif + Sp = C * Fc ./ Sp; + if isempty(Sz) + Sz = zeros(1,p); + else + Sz = [C * Fc ./ Sz]; + if (p > z) + Sz = [Sz, zeros(1,p-z)]; + end + end + else +## ---------------- ------------------------- ------------------------ +## Low Pass zero: Fc x/C pole: Fc x/C +## S -> C S/Fc gain: C/Fc gain: Fc/C +## ---------------- ------------------------- ------------------------ + Sg = Sg * (C/Fc)^(z-p); + Sp = Fc * Sp / C; + Sz = Fc * Sz / C; + end + end +endfunction diff --git a/octave_packages/signal-1.1.3/sgolay.m b/octave_packages/signal-1.1.3/sgolay.m new file mode 100644 index 0000000..a35e768 --- /dev/null +++ b/octave_packages/signal-1.1.3/sgolay.m @@ -0,0 +1,104 @@ +## Copyright (C) 2001 Paul Kienzle +## Copyright (C) 2004 Pascal Dupuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## F = sgolay (p, n [, m [, ts]]) +## Computes the filter coefficients for all Savitzsky-Golay smoothing +## filters of order p for length n (odd). m can be used in order to +## get directly the mth derivative. In this case, ts is a scaling factor. +## +## The early rows of F smooth based on future values and later rows +## smooth based on past values, with the middle row using half future +## and half past. In particular, you can use row i to estimate x(k) +## based on the i-1 preceding values and the n-i following values of x +## values as y(k) = F(i,:) * x(k-i+1:k+n-i). +## +## Normally, you would apply the first (n-1)/2 rows to the first k +## points of the vector, the last k rows to the last k points of the +## vector and middle row to the remainder, but for example if you were +## running on a realtime system where you wanted to smooth based on the +## all the data collected up to the current time, with a lag of five +## samples, you could apply just the filter on row n-5 to your window +## of length n each time you added a new sample. +## +## Reference: Numerical recipes in C. p 650 +## +## See also: sgolayfilt + +## Based on smooth.m by E. Farhi + +function F = sgolay (p, n, m = 0, ts = 1) + + if (nargin < 2 || nargin > 4) + print_usage; + elseif rem(n,2) != 1 + error ("sgolay needs an odd filter length n"); + elseif p >= n + error ("sgolay needs filter length n larger than polynomial order p"); + else + if length(m) > 1, error("weight vector unimplemented"); endif + + ## Construct a set of filters from complete causal to completely + ## noncausal, one filter per row. For the bulk of your data you + ## will use the central filter, but towards the ends you will need + ## a filter that doesn't go beyond the end points. + F = zeros (n, n); + k = floor (n/2); + for row = 1:k+1 + ## Construct a matrix of weights Cij = xi ^ j. The points xi are + ## equally spaced on the unit grid, with past points using negative + ## values and future points using positive values. + C = ( [(1:n)-row]'*ones(1,p+1) ) .^ ( ones(n,1)*[0:p] ); + ## A = pseudo-inverse (C), so C*A = I; this is constructed from the SVD + A = pinv(C); + ## Take the row of the matrix corresponding to the derivative + ## you want to compute. + F(row,:) = A(1+m,:); + end + ## The filters shifted to the right are symmetric with those to the left. + F(k+2:n,:) = (-1)^m*F(k:-1:1,n:-1:1); + + endif + F = F * ( prod(1:m) / (ts^m) ); +endfunction + +%!test +%! N=2^12; +%! t=[0:N-1]'/N; +%! dt=t(2)-t(1); +%! w = 2*pi*50; +%! offset = 0.5; # 50 Hz carrier +%! # exponential modulation and its derivatives +%! d = 1+exp(-3*(t-offset)); +%! dd = -3*exp(-3*(t-offset)); +%! d2d = 9*exp(-3*(t-offset)); +%! d3d = -27*exp(-3*(t-offset)); +%! # modulated carrier and its derivatives +%! x = d.*sin(w*t); +%! dx = dd.*sin(w*t) + w*d.*cos(w*t); +%! d2x = (d2d-w^2*d).*sin(w*t) + 2*w*dd.*cos(w*t); +%! d3x = (d3d-3*w^2*dd).*sin(w*t) + (3*w*d2d-w^3*d).*cos(w*t); +%! +%! y = sgolayfilt(x,sgolay(8,41,0,dt)); +%! assert(norm(y-x)/norm(x),0,5e-6); +%! +%! y = sgolayfilt(x,sgolay(8,41,1,dt)); +%! assert(norm(y-dx)/norm(dx),0,5e-6); +%! +%! y = sgolayfilt(x,sgolay(8,41,2,dt)); +%! assert(norm(y-d2x)/norm(d2x),0,1e-5); +%! +%! y = sgolayfilt(x,sgolay(8,41,3,dt)); +%! assert(norm(y-d3x)/norm(d3x),0,1e-4); diff --git a/octave_packages/signal-1.1.3/sgolayfilt.m b/octave_packages/signal-1.1.3/sgolayfilt.m new file mode 100644 index 0000000..6ea1749 --- /dev/null +++ b/octave_packages/signal-1.1.3/sgolayfilt.m @@ -0,0 +1,117 @@ +## Copyright (C) 2001 Paul Kienzle +## Copyright (C) 2004 Pascal Dupuis +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## y = sgolayfilt (x, p, n [, m [, ts]]) +## Smooth the data in x with a Savitsky-Golay smoothing filter of +## polynomial order p and length n, n odd, n > p. By default, p=3 +## and n=p+2 or n=p+3 if p is even. +## +## y = sgolayfilt (x, F) +## Smooth the data in x with smoothing filter F computed by sgolay. +## +## These filters are particularly good at preserving lineshape while +## removing high frequency squiggles. Particularly, compare a 5 sample +## averager, an order 5 butterworth lowpass filter (cutoff 1/3) and +## sgolayfilt(x, 3, 5), the best cubic estimated from 5 points: +## +## [b, a] = butter(5,1/3); +## x=[zeros(1,15), 10*ones(1,10), zeros(1,15)]; +## plot(sgolayfilt(x),"r;sgolayfilt;",... +## filtfilt(ones(1,5)/5,1,x),"g;5 sample average;",... +## filtfilt(b,a,x),"c;order 5 butterworth;",... +## x,"+b;original data;"); +## +## See also: sgolay + +## TODO: Patch filter.cc so that it accepts matrix arguments + +function y = sgolayfilt (x, p = 3, n, m = 0, ts = 1) + + if nargin < 1 || nargin > 5 + print_usage; + endif + + if (nargin >= 3) + F = sgolay(p, n, m, ts); + elseif (prod(size(p)) == 1) + n = p+3-rem(p,2); + F = sgolay(p, n); + else + F = p; + n = size(F,1); + if (size(F,1) != size(F,2)) + error("sgolayfilt(x,F): F is not a Savitzsky-Golay filter set"); + endif + endif + + transpose = (size(x,1) == 1); + if (transpose) x = x.'; endif; + len = size(x,1); + if (len < n) + error("sgolayfilt: insufficient data for filter"); + endif + + ## The first k rows of F are used to filter the first k points + ## of the data set based on the first n points of the data set. + ## The last k rows of F are used to filter the last k points + ## of the data set based on the last n points of the dataset. + ## The remaining data is filtered using the central row of F. + ## As the filter coefficients are used in the reverse order of what + ## seems the logical notation, reverse F(k+1, :) so that antisymmetric + ## sequences are used with the right sign. + + k = floor(n/2); + z = filter(F(k+1,n:-1:1), 1, x); + y = [ F(1:k,:)*x(1:n,:) ; z(n:len,:) ; F(k+2:n,:)*x(len-n+1:len,:) ]; + + if (transpose) y = y.'; endif + +endfunction + +%!demo +%! [b, a] = butter(5,1/3); +%! x=[zeros(1,15), 10*ones(1,10), zeros(1,15)]; +%! subplot(121); title("boxcar"); +%! axis([1 40 -2 15]); +%! plot(sgolayfilt(x),"r;sgolay(3,5);",... +%! filtfilt(ones(1,5)/5,1,x),"g;5 sample average;",... +%! filtfilt(b,a,x),"c;order 5 butterworth;",... +%! x,"+b;original data;"); title(""); +%! +%! x=x+randn(size(x))/2; +%! subplot(122); title("boxcar+noise"); +%! plot(sgolayfilt(x,3,5),"r;sgolay(3,5);",... +%! filtfilt(ones(1,5)/5,1,x),"g;5 sample average;",... +%! filtfilt(b,a,x),"c;order 5 butterworth;",... +%! x,"+b;original data;"); title(""); + +%!demo +%! [b, a] = butter(5,1/3); +%! t = 0:0.01:1.0; % 1 second sample +%! x=cos(2*pi*t*3); % 3 Hz sinusoid +%! subplot(121); title("sinusoid"); +%! axis([0 1 -1.5 2.5]); +%! plot(t,sgolayfilt(x,3,5),"r;sgolay(3,5);",... +%! t,filtfilt(ones(1,5)/5,1,x),"g;5 sample average;",... +%! t,filtfilt(b,a,x),"c;order 5 butterworth;",... +%! t,x,"+b;original data;"); title(""); +%! +%! x=x+0.2*randn(size(x)); % signal+noise +%! subplot(122); title("sinusoid+noise"); +%! plot(t,sgolayfilt(x',3,5),"r;sgolay(3,5);",... +%! t,filtfilt(ones(1,5)/5,1,x),"g;5 sample average;",... +%! t,filtfilt(b,a,x),"c;order 5 butterworth;",... +%! t,x,"+b;original data;"); title(""); diff --git a/octave_packages/signal-1.1.3/shanwavf.m b/octave_packages/signal-1.1.3/shanwavf.m new file mode 100644 index 0000000..a3e87d4 --- /dev/null +++ b/octave_packages/signal-1.1.3/shanwavf.m @@ -0,0 +1,32 @@ +## Copyright (C) 2007 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{psi,x}] =} shanwavf (@var{lb,ub,n,fb,fc}) +## Compute the Complex Shannon wavelet. +## @end deftypefn + +function [psi,x] = shanwavf (lb,ub,n,fb,fc) + if (nargin < 5) + print_usage; + elseif (n <= 0 || floor(n) ~= n) + error("n must be an integer strictly positive"); + elseif (fc <= 0 || fb <= 0) + error("fc and fb must be strictly positive"); + endif + + x = linspace(lb,ub,n); + psi = (fb.^0.5).*(sinc(fb.*x).*exp(2.*i.*pi.*fc.*x)); +endfunction diff --git a/octave_packages/signal-1.1.3/sigmoid_train.m b/octave_packages/signal-1.1.3/sigmoid_train.m new file mode 100644 index 0000000..7e1c974 --- /dev/null +++ b/octave_packages/signal-1.1.3/sigmoid_train.m @@ -0,0 +1,119 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR 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{y} = sigmoid_train(@var{t}, @var{ranges}, @var{rc}) +%% +%% Evaluates a train of sigmoid functions at @var{t}. +%% +%% The number and duration of each sigmoid is determined from @var{ranges}. Each +%% row of @var{ranges} represents a real interval, e.g. if sigmod @code{i} starts +%% at @code{t=0.1} and ends at @code{t=0.5}, then @code{@var{ranges}(i,:) = [0.1 +%% 0.5]}. +%% The input @var{rc} is a array that defines the rising and falling time +%% constants of each sigmoids. Its size must equal the size of @var{ranges}. +%% +%% Run @code{demo sigmoid_train} to some examples of the use of this function. +%% +%% @end deftypefn + +function envelope = sigmoid_train (t, range, timeconstant) + + % number of sigmoids + nRanges = size (range, 1); + + %% Parse time constants + if isscalar (timeconstant) + %% All bumps have the same time constant and are symmetric + timeconstant = timeconstant * ones (nRanges,2); + + elseif any( size(timeconstant) != [1 1]) + + %% All bumps have different time constant but are symmetric + if length(timeconstant) ~= nRanges + error('signalError','Length of time constant must equal number of ranges.') + end + if isrow (timeconstant) + timeconstant = timeconstant'; + end + timeconstant = repmat (timeconstant,1,2); + + end + + %% Make sure t is horizontal + flag_transposed = false; + if iscolumn (t) + t = t.'; + flag_transposed = true; + end + [ncol nrow] = size (t); + + % Compute arguments of each sigmoid + T = repmat (t, nRanges, 1); + RC1 = repmat (timeconstant(:,1), 1, nrow); + RC2 = repmat (timeconstant(:,2), 1, nrow); + a_up = (repmat (range(:,1), 1 ,nrow) - T)./RC1; + a_dw = (repmat (range(:,2), 1 ,nrow) - T)./RC2; + + % Evaluate the sigmoids and mix them + Y = 1 ./ ( 1 + exp (a_up) ) .* (1 - 1 ./ ( 1 + exp (a_dw) ) ); + envelope = max(Y,[],1); + + if flag_transposed + envelope = envelope.'; + end + +end + +%!demo +%! % Vectorized +%! t = linspace (0, 2, 500); +%! range = [0.1 0.4; 0.6 0.8; 1 2]; +%! rc = [1e-2 1e-2; 1e-3 1e-3; 2e-2 2e-2]; +%! y = sigmoid_train (t, range, rc); +%! +%! close all +%! for i=1:3 +%! patch ([range(i,[2 2]) range(i,[1 1])], [0 1 1 0],... +%! 'facecolor', [1 0.8 0.8],'edgecolor','none'); +%! end +%! hold on; plot (t, y, 'b;Sigmoid train;','linewidth',2); hold off +%! xlabel('time'); ylabel('S(t)') +%! title ('Vectorized use of sigmoid train') +%! axis tight +%! +%! %------------------------------------------------------------------------- +%! % The colored regions show the limits defined in range. + +%!demo +%! % On demand +%! t = linspace(0,2,200).'; +%! ran = [0.5 1; 1.5 1.7]; +%! rc = 3e-2; +%! dxdt = @(x_,t_) [ x_(2); sigmoid_train(t_, ran, rc) ]; +%! y = lsode(dxdt,[0 0],t); +%! +%! close all +%! for i=1:2 +%! patch ([ran(i,[2 2]) ran(i,[1 1])], [0 1 1 0],... +%! 'facecolor', [1 0.8 0.8],'edgecolor','none'); +%! end +%! hold on; plot (t, y(:,2), 'b;Speed;','linewidth',2); hold off +%! xlabel('time'); ylabel('V(t)') +%! title ('On demand use of sigmoid train') +%! axis tight +%! +%! %------------------------------------------------------------------------- +%! % The colored regions show periods when the force is active. diff --git a/octave_packages/signal-1.1.3/sos2tf.m b/octave_packages/signal-1.1.3/sos2tf.m new file mode 100644 index 0000000..1db3510 --- /dev/null +++ b/octave_packages/signal-1.1.3/sos2tf.m @@ -0,0 +1,91 @@ +%% Copyright (C) 2005 Julius O. Smith III +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% -*- texinfo -*- +%% @deftypefn {Function File} {[@var{B}, @var{A}] =} sos2tf (@var{sos}, @var{Bscale}) +%% Convert series second-order sections to direct form @math{H(z) = B(z)/A(z)}. +%% +%% INPUTS: +%% @itemize +%% +%% @item +%% @var{sos} = matrix of series second-order sections, one per row:@* +%% @var{sos} = [@var{B1}.' @var{A1}.'; ...; @var{BN}.' @var{AN}.'], where@* +%% @code{@var{B1}.'==[b0 b1 b2] and @var{A1}.'==[1 a1 a2]} for +%% section 1, etc.@* +%% b0 must be nonzero for each section.@* +%% See @code{filter()} for documentation of the +%% second-order direct-form filter coefficients @var{B}i and @var{A}i. +%% +%% @item +%% @var{Bscale} is an overall gain factor that effectively scales +%% the output @var{B} vector (or any one of the input @var{B}i vectors). +%% @end itemize +%% +%% RETURNED: +%% @var{B} and @var{A} are vectors specifying the digital filter @math{H(z) = B(z)/A(z)}. +%% See @code{filter()} for further details. +%% +%% @seealso{tf2sos zp2sos sos2pz zp2tf tf2zp} +%% @end deftypefn + +function [B,A] = sos2tf(sos, Bscale = 1) + + if (nargin < 1 || nargin > 2) + print_usage; + endif + + [N,M] = size(sos); + + if M~=6 + error('sos2tf: sos matrix should be N by 6'); + end + + A = 1; + B = 1; + + for i=1:N + B = conv(B, sos(i,1:3)); + A = conv(A, sos(i,4:6)); + end + + nB = length(B); + while nB && B(nB)==0 + B=B(1:nB-1); + nB=length(B); + end + + nA = length(A); + while nA && A(nA)==0 + A=A(1:nA-1); + nA=length(A); + end + B = B * Bscale; + +endfunction + +%!test +%! B=[1 1]; +%! A=[1 0.5]; +%! [sos,g] = tf2sos(B,A); +%! [Bh,Ah] = sos2tf(sos,g); +%! assert({Bh,Ah},{B,A},10*eps); + +%!test +%! B=[1 0 0 0 0 1]; +%! A=[1 0 0 0 0 0.9]; +%! [sos,g] = tf2sos(B,A); +%! [Bh,Ah] = sos2tf(sos,g); +%! assert({Bh,Ah},{B,A},100*eps); diff --git a/octave_packages/signal-1.1.3/sos2zp.m b/octave_packages/signal-1.1.3/sos2zp.m new file mode 100644 index 0000000..e13603b --- /dev/null +++ b/octave_packages/signal-1.1.3/sos2zp.m @@ -0,0 +1,92 @@ +%% Copyright (C) 2005 Julius O. Smith III +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% -*- texinfo -*- +%% @deftypefn {Function File} {[@var{z}, @var{p}, @var{g}] =} sos2zp (@var{sos}, @var{Bscale}) +%% Convert series second-order sections to zeros, poles, and gains +%% (pole residues). +%% +%% INPUTS:@* +%% @itemize +%% +%% @item +%% @var{sos} = matrix of series second-order sections, one per row:@* +%% @var{sos} = [@var{B1}.' @var{A1}.'; ...; @var{BN}.' @var{AN}.'], where@* +%% @code{@var{B1}.'==[b0 b1 b2] and @var{A1}.'==[1 a1 a2]} for +%% section 1, etc.@* +%% b0 must be nonzero for each section. +%% See @code{filter()} for documentation of the +%% second-order direct-form filter coefficients @var{B}i and @var{A}i. +%% +%% @item +%% @var{Bscale} is an overall gain factor that effectively scales +%% any one of the input @var{B}i vectors. +%% @end itemize +%% +%% RETURNED: +%% @itemize +%% @item +%% @var{z} = column-vector containing all zeros (roots of B(z))@* +%% @item +%% @var{p} = column-vector containing all poles (roots of A(z))@* +%% @item +%% @var{g} = overall gain = @var{B}(Inf) +%% @end itemize +%% +%% EXAMPLE: +%% @example +%% [z,p,g] = sos2zp([1 0 1, 1 0 -0.81; 1 0 0, 1 0 0.49]) +%% => z = [i; -i; 0; 0], p = [0.9, -0.9, 0.7i, -0.7i], g=1 +%% @end example +%% +%% @seealso{zp2sos sos2tf tf2sos zp2tf tf2zp} +%% @end deftypefn + +function [z,p,g] = sos2zp (sos, Bscale = 1) + + if (nargin < 1 || nargin > 2) + print_usage; + endif + + gains = sos(:,1); % All b0 coeffs + g = prod(gains)*Bscale; % pole-zero gain + if g==0, error('sos2zp: one or more section gains is zero'); end + sos(:,1:3) = sos(:,1:3)./ [gains gains gains]; + + [N,m] = size(sos); + if m~=6, error('sos2zp: sos matrix should be N by 6'); end + + z = zeros(2*N,1); + p = zeros(2*N,1); + for i=1:N + ndx = [2*i-1:2*i]; + zi = roots(sos(i,1:3)); + z(ndx) = zi; + pi = roots(sos(i,4:6)); + p(ndx) = pi; + end +end + +%!test +%! b1t=[1 2 3]; a1t=[1 .2 .3]; +%! b2t=[4 5 6]; a2t=[1 .4 .5]; +%! sos=[b1t a1t; b2t a2t]; +%! z = [-1-1.41421356237310i;-1+1.41421356237310i;... +%! -0.625-1.05326872164704i;-0.625+1.05326872164704i]; +%! p = [-0.2-0.678232998312527i;-0.2+0.678232998312527i;... +%! -0.1-0.538516480713450i;-0.1+0.538516480713450i]; +%! k = 4; +%! [z2,p2,k2] = sos2zp(sos,1); +%! assert({cplxpair(z2),cplxpair(p2),k2},{z,p,k},100*eps); diff --git a/octave_packages/signal-1.1.3/specgram.m b/octave_packages/signal-1.1.3/specgram.m new file mode 100644 index 0000000..f5c2b1a --- /dev/null +++ b/octave_packages/signal-1.1.3/specgram.m @@ -0,0 +1,219 @@ +## Copyright (C) 1999-2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [S [, f [, t]]] = specgram(x [, n [, Fs [, window [, overlap]]]]) +## +## Generate a spectrogram for the signal. This chops the signal into +## overlapping slices, windows each slice and applies a Fourier +## transform to determine the frequency components at that slice. +## +## x: vector of samples +## n: size of fourier transform window, or [] for default=256 +## Fs: sample rate, or [] for default=2 Hz +## window: shape of the fourier transform window, or [] for default=hanning(n) +## Note: window length can be specified instead, in which case +## window=hanning(length) +## overlap: overlap with previous window, or [] for default=length(window)/2 +## +## Return values +## S is complex output of the FFT, one row per slice +## f is the frequency indices corresponding to the rows of S. +## t is the time indices corresponding to the columns of S. +## If no return value is requested, the spectrogram is displayed instead. +## +## Example +## x = chirp([0:0.001:2],0,2,500); # freq. sweep from 0-500 over 2 sec. +## Fs=1000; # sampled every 0.001 sec so rate is 1 kHz +## step=ceil(20*Fs/1000); # one spectral slice every 20 ms +## window=ceil(100*Fs/1000); # 100 ms data window +## specgram(x, 2^nextpow2(window), Fs, window, window-step); +## +## ## 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= minF & f <= maxF); +## +## Then there is the choice of colormap. A brightness varying colormap +## such as copper or bone gives good shape to the ridges and valleys. A +## hue varying colormap such as jet or hsv gives an indication of the +## steepness of the slopes. The final spectrogram is displayed in log +## energy scale and by convention has low frequencies on the bottom of +## the image: +## +## imagesc(t, f, flipud(log(S(idx,:)))); + +function [S_r, f_r, t_r] = specgram(x, n = min(256, length(x)), Fs = 2, window = hanning(n), overlap = ceil(length(window)/2)) + + if nargin < 1 || nargin > 5 + print_usage; + ## make sure x is a vector + elseif columns(x) != 1 && rows(x) != 1 + error ("specgram data must be a vector"); + end + if columns(x) != 1, x = x'; end + + ## if only the window length is given, generate hanning window + if length(window) == 1, window = hanning(window); end + + ## should be extended to accept a vector of frequencies at which to + ## evaluate the fourier transform (via filterbank or chirp + ## z-transform) + if length(n)>1, + error("specgram doesn't handle frequency vectors yet"); + endif + + ## compute window offsets + win_size = length(window); + if (win_size > n) + n = win_size; + warning ("specgram fft size adjusted to %d", n); + end + step = win_size - overlap; + + ## build matrix of windowed data slices + offset = [ 1 : step : length(x)-win_size ]; + S = zeros (n, length(offset)); + for i=1:length(offset) + S(1:win_size, i) = x(offset(i):offset(i)+win_size-1) .* window; + endfor + + ## compute fourier transform + S = fft (S); + + ## extract the positive frequency components + if rem(n,2)==1 + ret_n = (n+1)/2; + else + ret_n = n/2; + end + S = S(1:ret_n, :); + + f = [0:ret_n-1]*Fs/n; + t = offset/Fs; + if nargout==0 + imagesc(t, f, 20*log10(abs(S))); + set (gca (), "ydir", "normal"); + xlabel ("Time") + ylabel ("Frequency") + endif + if nargout>0, S_r = S; endif + if nargout>1, f_r = f; endif + if nargout>2, t_r = t; endif + +endfunction + +%!shared S,f,t,x +%! Fs=1000; +%! x = chirp([0:1/Fs:2],0,2,500); # freq. sweep from 0-500 over 2 sec. +%! step=ceil(20*Fs/1000); # one spectral slice every 20 ms +%! window=ceil(100*Fs/1000); # 100 ms data window +%! [S, f, t] = specgram(x); + +%! ## test of returned shape +%!assert (rows(S), 128) +%!assert (columns(f), rows(S)) +%!assert (columns(t), columns(S)) +%!test [S, f, t] = specgram(x'); +%!assert (rows(S), 128) +%!assert (columns(f), rows(S)); +%!assert (columns(t), columns(S)); +%!error (isempty(specgram([]))); +%!error (isempty(specgram([1, 2 ; 3, 4]))); +%!error (specgram) + +%!demo +%! Fs=1000; +%! x = chirp([0:1/Fs:2],0,2,500); # freq. sweep from 0-500 over 2 sec. +%! step=ceil(20*Fs/1000); # one spectral slice every 20 ms +%! window=ceil(100*Fs/1000); # 100 ms data window +%! +%! ## test of automatic plot +%! [S, f, t] = specgram(x); +%! specgram(x, 2^nextpow2(window), Fs, window, window-step); +%! disp("shows a diagonal from bottom left to top right"); +%! input("press enter:","s"); +%! +%! ## test of returned values +%! S = specgram(x, 2^nextpow2(window), Fs, window, window-step); +%! imagesc(20*log10(flipud(abs(S)))); +%! disp("same again, but this time using returned value"); + +%!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 (2006) +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{s} =} square(@var{t}, @var{duty}) +## @deftypefnx {Function File} {@var{s} =} square(@var{t}) +## Generate a square wave of period 2 pi with limits +1/-1. +## +## If @var{duty} is specified, the square wave is +1 for +## that portion of the time. +## +## @verbatim +## on time +## duty cycle = ------------------ +## on time + off time +## @end verbatim +## +## @seealso{cos, sawtooth, sin, tripuls} +## @end deftypefn + +function v = square (t, duty = 0.5) + + if (nargin < 1 || nargin > 2) + print_usage; + endif + + t /= 2*pi; + v = ones(size(t)); + v(t-floor(t) >= duty) = -1; + +endfunction diff --git a/octave_packages/signal-1.1.3/ss2tf.m b/octave_packages/signal-1.1.3/ss2tf.m new file mode 100644 index 0000000..89b050e --- /dev/null +++ b/octave_packages/signal-1.1.3/ss2tf.m @@ -0,0 +1,62 @@ +## Copyright (C) 1994, 1996, 2000, 2004, 2005, 2007 Auburn University +## Copyright (C) 2012 Lukas F. Reichlin +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{num}, @var{den}] =} ss2tf (@var{a}, @var{b}, @var{c}, @var{d}) +## Conversion from transfer function to state-space. +## The state space system: +## @iftex +## @tex +## $$ \dot x = Ax + Bu $$ +## $$ y = Cx + Du $$ +## @end tex +## @end iftex +## @ifinfo +## @example +## . +## x = Ax + Bu +## y = Cx + Du +## @end example +## @end ifinfo +## +## is converted to a transfer function: +## @iftex +## @tex +## $$ G(s) = { { \rm num }(s) \over { \rm den }(s) } $$ +## @end tex +## @end iftex +## @ifinfo +## @example +## +## num(s) +## G(s)=------- +## den(s) +## @end example +## @end ifinfo +## +## @end deftypefn + +## Author: R. Bruce Tenison + +function [num, den] = ss2tf (varargin) + + if (nargin == 0) + print_usage (); + endif + + [num, den] = tfdata (ss (varargin{:}), "vector"); + +endfunction diff --git a/octave_packages/signal-1.1.3/ss2zp.m b/octave_packages/signal-1.1.3/ss2zp.m new file mode 100644 index 0000000..677fde1 --- /dev/null +++ b/octave_packages/signal-1.1.3/ss2zp.m @@ -0,0 +1,34 @@ +## Copyright (C) 1994, 1996, 2000, 2004, 2005, 2006, 2007 Auburn University +## Copyright (C) 2012 Lukas F. Reichlin +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pol}, @var{zer}, @var{k}] =} ss2zp (@var{a}, @var{b}, @var{c}, @var{d}) +## Converts a state space representation to a set of poles and zeros; +## @var{k} is a gain associated with the zeros. +## +## @end deftypefn + +## Author: David Clem + +function [z, p, k] = ss2zp (varargin) + + if (nargin == 0) + print_usage (); + endif + + [z, p, k] = zpkdata (ss (varargin{:}), "vector"); + +endfunction diff --git a/octave_packages/signal-1.1.3/tf2sos.m b/octave_packages/signal-1.1.3/tf2sos.m new file mode 100644 index 0000000..98aaf72 --- /dev/null +++ b/octave_packages/signal-1.1.3/tf2sos.m @@ -0,0 +1,64 @@ +%% Copyright (C) 2005 Julius O. Smith III +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% -*- texinfo -*- +%% @deftypefn {Function File} {[@var{sos}, @var{g}] =} tf2sos (@var{B}, @var{A}) +%% Convert direct-form filter coefficients to series second-order sections. +%% +%% INPUTS: +%% @var{B} and @var{A} are vectors specifying the digital filter @math{H(z) = B(z)/A(z)}. +%% See @code{filter()} for documentation of the @var{B} and @var{A} +%% filter coefficients. +%% +%% RETURNED: +%% @var{sos} = matrix of series second-order sections, one per row:@* +%% @var{sos} = [@var{B1}.' @var{A1}.'; ...; @var{BN}.' @var{AN}.'], where@* +%% @code{@var{B1}.'==[b0 b1 b2] and @var{A1}.'==[1 a1 a2]} for +%% section 1, etc.@* +%% b0 must be nonzero for each section (zeros at infinity not supported). +%% @var{Bscale} is an overall gain factor that effectively scales +%% any one of the @var{B}i vectors. +%% +%% EXAMPLE: +%% @example +%% B=[1 0 0 0 0 1]; +%% A=[1 0 0 0 0 .9]; +%% [sos,g] = tf2sos(B,A) +%% +%% sos = +%% +%% 1.00000 0.61803 1.00000 1.00000 0.60515 0.95873 +%% 1.00000 -1.61803 1.00000 1.00000 -1.58430 0.95873 +%% 1.00000 1.00000 -0.00000 1.00000 0.97915 -0.00000 +%% +%% g = 1 +%% +%% @end example +%% +%% @seealso{sos2tf zp2sos sos2pz zp2tf tf2zp} +%% @end deftypefn + +function [sos,g] = tf2sos (B, A) + + [z,p,g] = tf2zp(B(:)',A(:)'); + sos = zp2sos(z,p,g); + +endfunction + +%!test +%! B=[1 0 0 0 0 1]; A=[1 0 0 0 0 .9]; +%! [sos,g] = tf2sos(B,A); +%! [Bh,Ah] = sos2tf(sos,g); +%! assert({Bh,Ah},{B,A},100*eps); diff --git a/octave_packages/signal-1.1.3/tf2ss.m b/octave_packages/signal-1.1.3/tf2ss.m new file mode 100644 index 0000000..1c7aac1 --- /dev/null +++ b/octave_packages/signal-1.1.3/tf2ss.m @@ -0,0 +1,63 @@ +## Copyright (C) 1994-1996, 1998, 2000, 2002, 2004, 2005, 2007 Auburn University +## Copyright (C) 2012 Lukas F. Reichlin +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{a}, @var{b}, @var{c}, @var{d}] =} tf2ss (@var{num}, @var{den}) +## Conversion from transfer function to state-space. +## The state space system: +## @iftex +## @tex +## $$ \dot x = Ax + Bu $$ +## $$ y = Cx + Du $$ +## @end tex +## @end iftex +## @ifinfo +## @example +## . +## x = Ax + Bu +## y = Cx + Du +## @end example +## @end ifinfo +## is obtained from a transfer function: +## @iftex +## @tex +## $$ G(s) = { { \rm num }(s) \over { \rm den }(s) } $$ +## @end tex +## @end iftex +## @ifinfo +## @example +## num(s) +## G(s)=------- +## den(s) +## @end example +## @end ifinfo +## +## The state space system matrices obtained from this function +## will be in observable companion form as Wolovich's Observable +## Structure Theorem is used. +## @end deftypefn + +## Author: R. Bruce Tenison + +function [a, b, c, d, e] = tf2ss (varargin) + + if (nargin == 0) + print_usage (); + endif + + [a, b, c, d, e] = dssdata (tf (varargin{:}), []); + +endfunction diff --git a/octave_packages/signal-1.1.3/tf2zp.m b/octave_packages/signal-1.1.3/tf2zp.m new file mode 100644 index 0000000..1966335 --- /dev/null +++ b/octave_packages/signal-1.1.3/tf2zp.m @@ -0,0 +1,36 @@ +## Copyright (C) 1996, 1998, 2000, 2003, 2004, 2005, 2006, 2007 Auburn University +## Copyright (C) 2012 Lukas F. Reichlin +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{zer}, @var{pol}, @var{k}] =} tf2zp (@var{num}, @var{den}) +## Converts transfer functions to poles-and-zero representations. +## +## Returns the zeros and poles of the system defined +## by @var{num}/@var{den}. +## @var{k} is a gain associated with the system zeros. +## @end deftypefn + +## Author: A. S. Hodel + +function [z, p, k] = tf2zp (varargin) + + if (nargin == 0) + print_usage (); + endif + + [z, p, k] = zpkdata (tf (varargin{:}), "vector"); + +endfunction diff --git a/octave_packages/signal-1.1.3/tfe.m b/octave_packages/signal-1.1.3/tfe.m new file mode 100644 index 0000000..fe993b8 --- /dev/null +++ b/octave_packages/signal-1.1.3/tfe.m @@ -0,0 +1,55 @@ +%% Copyright (C) 2006 Peter V. Lanspeary +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% Usage: +%% [Pxx,freq] = tfe(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) +%% +%% Estimate transfer function of system with input "x" and output "y". +%% Use the Welch (1967) periodogram/FFT method. +%% Compatible with Matlab R11 tfe and earlier. +%% See "help pwelch" for description of arguments, hints and references +%% --- especially hint (7) for Matlab R11 defaults. + +function [varargout] = tfe(varargin) + %% + %% Check fixed argument + if ( nargin<2 ) + error( 'tfe: Need at least 2 args. Use help tfe.' ); + end + nvarargin = length(varargin); + %% remove any pwelch RESULT args and add 'trans' + for iarg=1:nvarargin + arg = varargin{iarg}; + if ( ~isempty(arg) && ischar(arg) && ( strcmp(arg,'power') || ... + strcmp(arg,'cross') || strcmp(arg,'trans') || ... + strcmp(arg,'coher') || strcmp(arg,'ypower') )) + varargin{iarg} = []; + end + end + varargin{nvarargin+1} = 'trans'; + %% + saved_compatib = pwelch('R11-'); + if ( nargout==0 ) + pwelch(varargin{:}); + elseif ( nargout==1 ) + Pxx = pwelch(varargin{:}); + varargout{1} = Pxx; + elseif ( nargout>=2 ) + [Pxx,f] = pwelch(varargin{:}); + varargout{1} = Pxx; + varargout{2} = f; + end + pwelch(saved_compatib); +end diff --git a/octave_packages/signal-1.1.3/tfestimate.m b/octave_packages/signal-1.1.3/tfestimate.m new file mode 100644 index 0000000..35b1216 --- /dev/null +++ b/octave_packages/signal-1.1.3/tfestimate.m @@ -0,0 +1,51 @@ +%% Copyright (C) 2006 Peter V. Lanspeary +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% Usage: +%% [Pxx,freq]=tfestimate(x,y,Nfft,Fs,window,overlap,range,plot_type,detrend) +%% +%% Estimate transfer function of system with input "x" and output "y". +%% Use the Welch (1967) periodogram/FFT method. +%% See "help pwelch" for description of arguments, hints and references. + +function [varargout] = tfestimate(varargin) + %% + %% Check fixed argument + if ( nargin<2 ) + error( 'tfestimate: Need at least 2 args. Use help tfestimate' ); + end + nvarargin = length(varargin); + %% remove any pwelch RESULT args and add 'cross' + for iarg=1:nvarargin + arg = varargin{iarg}; + if ( ~isempty(arg) && ischar(arg) && ( strcmp(arg,'power') || ... + strcmp(arg,'cross') || strcmp(arg,'trans') || ... + strcmp(arg,'coher') || strcmp(arg,'ypower') )) + varargin{iarg} = []; + end + end + varargin{nvarargin+1} = 'trans'; + %% + if ( nargout==0 ) + pwelch(varargin{:}); + elseif ( nargout==1 ) + Pxx = pwelch(varargin{:}); + varargout{1} = Pxx; + elseif ( nargout>=2 ) + [Pxx,f] = pwelch(varargin{:}); + varargout{1} = Pxx; + varargout{2} = f; + end +end diff --git a/octave_packages/signal-1.1.3/triang.m b/octave_packages/signal-1.1.3/triang.m new file mode 100644 index 0000000..10d5f27 --- /dev/null +++ b/octave_packages/signal-1.1.3/triang.m @@ -0,0 +1,64 @@ +## Copyright (C) 2000-2002 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: w = triang (L) +## +## Returns the filter coefficients of a triangular window of length L. +## Unlike the bartlett window, triang does not go to zero at the edges +## of the window. For odd L, triang(L) is equal to bartlett(L+2) except +## for the zeros at the edges of the window. + +function w = triang(L) + if (nargin != 1) + print_usage; + elseif (!isscalar(L) || L != fix (L) || L < 1) + error("triang: L has to be an integer > 0"); + endif + w = 1 - abs ([-(L-1):2:(L-1)]' / (L+rem(L,2))); +endfunction + +%!error triang +%!error triang(1,2) +%!error triang([1,2]); +%!assert (triang(1), 1) +%!assert (triang(2), [1; 1]/2) +%!assert (triang(3), [1; 2; 1]/2); +%!assert (triang(4), [1; 3; 3; 1]/4); +%!test +%! x = bartlett(5); +%! assert (triang(3), x(2:4)); + +%!demo +%! subplot(221); axis([-1, 1, 0, 1.3]); grid("on"); +%! title("comparison with continuous for odd n"); +%! n=7; k=(n-1)/2; t=[-k:0.1:k]/(k+1); +%! plot(t,1-abs(t),";continuous;",[-k:k]/(k+1),triang(n),"g*;discrete;"); +%! +%! subplot(222); axis([-1, 1, 0, 1.3]); grid("on"); +%! n=8; k=(n-1)/2; t=[-k:0.1:k]/(k+1/2); +%! title("note the higher peak for even n"); +%! plot(t,1+1/n-abs(t),";continuous;",[-k:k]/(k+1/2),triang(n),"g*;discrete;"); +%! +%! subplot(223); axis; grid("off"); +%! title("n odd, triang(n)==bartlett(n+2)"); +%! n=7; +%! plot(0:n+1,bartlett(n+2),"g-*;bartlett;",triang(n),"r-+;triang;"); +%! +%! subplot(224); axis; grid("off"); +%! title("n even, triang(n)!=bartlett(n+2)"); +%! n=8; +%! plot(0:n+1,bartlett(n+2),"g-*;bartlett;",triang(n),"r-+;triang;"); +%! +%! subplot(111); title(""); diff --git a/octave_packages/signal-1.1.3/tripuls.m b/octave_packages/signal-1.1.3/tripuls.m new file mode 100644 index 0000000..9fb7f3d --- /dev/null +++ b/octave_packages/signal-1.1.3/tripuls.m @@ -0,0 +1,67 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: y = tripuls(t, w, skew) +## +## Generate a triangular pulse over the interval [-w/2,w/2), sampled at +## times t. This is useful with the function pulstran for generating a +## series pulses. +## +## skew is a value between -1 and 1, indicating the relative placement +## of the peak within the width. -1 indicates that the peak should be +## at -w/2, and 1 indicates that the peak should be at w/2. +## +## Example +## fs = 11025; # arbitrary sample rate +## f0 = 100; # pulse train sample rate +## w = 0.3/f0; # pulse width 3/10th the distance between pulses +## auplot(pulstran(0:1/fs:4/f0, 0:1/f0:4/f0, 'tripuls', w), fs); +## +## See also: pulstran + +function y = tripuls (t, w = 1, skew = 0) + + if nargin<1 || nargin>3, + print_usage; + endif + + y = zeros(size(t)); + peak = skew*w/2; + try wfi = warning("off", "Octave:fortran-indexing"); + catch wfi = 0; + end + unwind_protect + idx = find(t>=-w/2 & t <= peak); + if (idx) y(idx) = ( t(idx) + w/2 ) / ( peak + w/2 ); endif + idx = find(t>peak & t < w/2); + if (idx) y(idx) = ( t(idx) - w/2 ) / ( peak - w/2 ); endif + unwind_protect_cleanup + warning(wfi); + end_unwind_protect +endfunction + +%!assert(tripuls(0:1/100:0.3,.1), tripuls([0:1/100:0.3]',.1)'); +%!assert(isempty(tripuls([],.1))); +%!demo +%! fs = 11025; # arbitrary sample rate +%! f0 = 100; # pulse train sample rate +%! w = 0.5/f0; # pulse width 1/10th the distance between pulses +%! subplot(211); ylabel("amplitude"); xlabel("time (ms)"); +%! title("graph shows 5 ms pulses at 0,10,20,30 and 40 ms"); +%! auplot(pulstran(0:1/fs:4/f0, 0:1/f0:4/f0, 'tripuls', w), fs); +%! subplot(212); +%! title("graph shows 5 ms pulses at 0,10,20,30 and 40 ms, skew -0.5"); +%! auplot(pulstran(0:1/fs:4/f0, 0:1/f0:4/f0, 'tripuls', w, -0.5), fs); +%! title(""); xlabel(""); ylabel(""); diff --git a/octave_packages/signal-1.1.3/tukeywin.m b/octave_packages/signal-1.1.3/tukeywin.m new file mode 100644 index 0000000..0c8a91f --- /dev/null +++ b/octave_packages/signal-1.1.3/tukeywin.m @@ -0,0 +1,67 @@ +## Copyright (C) 2007 Laurent Mazet +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{w} =} tukeywin (@var{L}, @var{r}) +## Return the filter coefficients of a Tukey window (also known as the +## cosine-tapered window) of length @var{L}. @var{r} defines the ratio +## between the constant section and and the cosine section. It has to be +## between 0 and 1. The function returns a Hanning window for @var{r} +## egals 0 and a full box for @var{r} egals 1. By default @var{r} is set +## to 1/2. +## +## For a definition of the Tukey window, see e.g. Fredric J. Harris, +## "On the Use of Windows for Harmonic Analysis with the Discrete Fourier +## Transform, Proceedings of the IEEE", Vol. 66, No. 1, January 1978, +## Page 67, Equation 38. +## @end deftypefn + +function w = tukeywin (L, r = 1/2) + + if (nargin < 1 || nargin > 2) + print_usage; + elseif (nargin == 2) + ## check that 0 < r < 1 + if r > 1 + r = 1; + elseif r < 0 + r = 0; + endif + endif + + ## generate window + switch r + case 0, + ## full box + w = ones (L, 1); + case 1, + ## Hanning window + w = hanning (L); + otherwise + ## cosine-tapered window + t = linspace(0,1,L)(1:end/2)'; + w = (1 + cos(pi*(2*t/r-1)))/2; + w(floor(r*(L-1)/2)+2:end) = 1; + w = [w; ones(mod(L,2)); flipud(w)]; + endswitch + +endfunction + +%!demo +%! L = 100; +%! r = 1/3; +%! w = tukeywin (L, r); +%! title(sprintf("%d-point Tukey window, R = %d/%d", L, [p, q] = rat(r), q)); +%! plot(w); diff --git a/octave_packages/signal-1.1.3/upsample.m b/octave_packages/signal-1.1.3/upsample.m new file mode 100644 index 0000000..f54714a --- /dev/null +++ b/octave_packages/signal-1.1.3/upsample.m @@ -0,0 +1,39 @@ +## Author: Paul Kienzle (2007) +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} upsample (@var{x}, @var{n}) +## @deftypefnx {Function File} {@var{y} =} upsample (@var{x}, @var{n}, @var{offset}) +## Upsample the signal, inserting n-1 zeros between every element. +## +## If @var{x} is a matrix, upsample every column. +## +## If @var{offset} is specified, control the position of the inserted sample in +## the block of n zeros. +## @seealso{decimate, downsample, interp, resample, upfirdn} +## @end deftypefn + +function y = upsample (x, n, phase = 0) + if nargin<2 || nargin>3, print_usage; end + + if phase > n - 1 + warning("This is incompatible with Matlab (phase = 0:n-1). See ... + octave-forge signal package release notes for details." ) + end + + [nr,nc] = size(x); + if any([nr,nc]==1), + y = zeros(n*nr*nc,1); + y(phase + 1:n:end) = x; + if nr==1, y = y.'; end + else + y = zeros(n*nr,nc); + y(phase + 1:n:end,:) = x; + end +end + +%!assert(upsample([1,3,5],2),[1,0,3,0,5,0]); +%!assert(upsample([1;3;5],2),[1;0;3;0;5;0]); +%!assert(upsample([1,2;5,6;9,10],2),[1,2;0,0;5,6;0,0;9,10;0,0]); +%!assert(upsample([2,4],2,1),[0,2,0,4]); +%!assert(upsample([3,4;7,8],2,1),[0,0;3,4;0,0;7,8]); diff --git a/octave_packages/signal-1.1.3/welchwin.m b/octave_packages/signal-1.1.3/welchwin.m new file mode 100644 index 0000000..59cc98b --- /dev/null +++ b/octave_packages/signal-1.1.3/welchwin.m @@ -0,0 +1,97 @@ +## Copyright (C) 2007 Muthiah Annamalai +## Copyright (C) 2008-2009 Mike Gross +## Copyright (C) 2008-2009 Peter V. Lanspeary +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{w}] =} welchwin(@var{L},@var{c}) +## Returns a row vector containing a Welch window, given by +## @var{w}(n)=1-(n/N-1)^2, n=[0,1, ... @var{L}-1]. +## Argument @var{L} is the length of the window. +## Optional argument @var{c} specifies a "symmetric" window (the default), +## or a "periodic" window. +## +## A symmetric window has zero at each end and maximum in the middle; +## @var{L} must be an integer larger than 2. +## @code{if c=="symmetric", N=(L-1)/2} +## +## A periodic window wraps around the cyclic interval [0,1, ... @var{L}-1], +## and is intended for use with the DFT (functions fft(), +## periodogram() etc). +## @var{L} must be an integer larger than 1. +## @code{if c=="periodic", N=@var{L}/2}. +## +## @seealso{blackman, kaiser} +## @end deftypefn + +function [w] = welchwin(L,c) + if (nargin < 1 || nargin>2 ) + print_usage; + endif + symmetric=1; + if ( nargin==2 && ! isempty(c) ) + if ( ! ischar(c) || size(c,1) != 1 || + ( ! strcmp(c,'periodic') && ! strcmp(c,'symmetric') ) ) + error( "arg 2 (c) must be \"periodic\" or \"symmetric\"" ) + endif + symmetric = ! strcmp(c,'periodic'); + endif + ## + ## Periodic window is not properly defined if L<2. + ## Symmetric window is not properly defined if L<3. + min_L = 2 + symmetric; + if ( ! isreal(L) || ! isscalar(L) || L. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{w} =} window (@var{f}, @var{n}, @var{opts}) +## Create a @var{n}-point windowing from the function @var{f}. The +## function @var{f} can be for example @code{@@blackman}. Any additional +## arguments @var{opt} are passed to the windowing function. +## @end deftypefn + +function wout = window (f, n, varargin) + if (nargin == 0) + error ("window: UI tool not supported"); + elseif (nargin > 1) + w = feval (f, n, varargin{:}); + if (nargout > 0) + wout = w; + endif + else + print_usage (); + endif +endfunction diff --git a/octave_packages/signal-1.1.3/wkeep.m b/octave_packages/signal-1.1.3/wkeep.m new file mode 100644 index 0000000..80ca108 --- /dev/null +++ b/octave_packages/signal-1.1.3/wkeep.m @@ -0,0 +1,65 @@ +## Copyright (C) 2008 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y}] =} wkeep(@var{x,l,opt}) +## Extract the elements of x of size l from the center, the right or the left. +## @end deftypefn + +function y = wkeep(x,l,opt = 'c') + + if (nargin < 2|| nargin > 3); print_usage; end + if(isvector(x)) + + if(l > length(x)) + error('l must be or equal the size of x'); + end + + if(opt=='c') + s = (length(x)-l)./2; + y = x(1+floor(s):end-ceil(s)); + + elseif(opt=='l') + y=x(1:l); + + elseif(opt=='r') + y = x(end-l+1:end); + + else + error('opt must be equal to c, l or r'); + end + else + if(length(l) == 2) + s1 = (length(x)-l(1))./2; + s2 = (length(x)-l(2))./2; + else + error('For a matrix l must be a 1x2 vector'); + end + + if(nargin==2) + y = x(1+floor(s1):end-ceil(s1),1+floor(s2):end-ceil(s2)); + else + if(length(opt) == 2) + firstr=opt(1); + firstc=opt(2); + else + error('For a matrix l must be a 1x2 vector'); + end + + y=x(firstr:firstr+l(1)-1,firstc:firstc+l(2)-1); + end + + end +end diff --git a/octave_packages/signal-1.1.3/wrev.m b/octave_packages/signal-1.1.3/wrev.m new file mode 100644 index 0000000..bbc6004 --- /dev/null +++ b/octave_packages/signal-1.1.3/wrev.m @@ -0,0 +1,30 @@ +## Copyright (C) 2008 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y}] =} wrev(@var{x}) +## Reverse the order of the element of the vector x. +## @seealso{flipud, fliplr} +## @end deftypefn + +function y = wrev(x) + if (nargin < 1|| nargin > 1); print_usage; end + if(~isvector(x)) + error('x must be a vector'); + end + l = length(x); + k = 0:l-1; + y = x(l-k); +endfunction diff --git a/octave_packages/signal-1.1.3/xcorr.m b/octave_packages/signal-1.1.3/xcorr.m new file mode 100644 index 0000000..15207d0 --- /dev/null +++ b/octave_packages/signal-1.1.3/xcorr.m @@ -0,0 +1,283 @@ +## Copyright (C) 1999-2001 Paul Kienzle +## Copyright (C) 2004 +## Copyright (C) 2008,2010 Peter Lanspeary +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [R, lag] = xcorr (X [, Y] [, maxlag] [, scale]) +## +## Estimate the cross correlation R_xy(k) of vector arguments X and Y +## or, if Y is omitted, estimate autocorrelation R_xx(k) of vector X, +## for a range of lags k specified by argument "maxlag". If X is a +## matrix, each column of X is correlated with itself and every other +## column. +## +## The cross-correlation estimate between vectors "x" and "y" (of +## length N) for lag "k" is given by +## R_xy(k) = sum_{i=1}^{N}{x_{i+k} conj(y_i), +## where data not provided (for example x(-1), y(N+1)) is zero. +## +## ARGUMENTS +## X [non-empty; real or complex; vector or matrix] data +## +## Y [real or complex vector] data +## If X is a matrix (not a vector), Y must be omitted. +## Y may be omitted if X is a vector; in this case xcorr +## estimates the autocorrelation of X. +## +## maxlag [integer scalar] maximum correlation lag +## If omitted, the default value is N-1, where N is the +## greater of the lengths of X and Y or, if X is a matrix, +## the number of rows in X. +## +## scale [character string] specifies the type of scaling applied +## to the correlation vector (or matrix). is one of: +## 'none' return the unscaled correlation, R, +## 'biased' return the biased average, R/N, +## 'unbiased' return the unbiassed average, R(k)/(N-|k|), +## 'coeff' return the correlation coefficient, R/(rms(x).rms(y)), +## where "k" is the lag, and "N" is the length of X. +## If omitted, the default value is "none". +## If Y is supplied but does not have the ame length as X, +## scale must be "none". +## +## RETURNED VARIABLES +## R array of correlation estimates +## lag row vector of correlation lags [-maxlag:maxlag] +## +## The array of correlation estimates has one of the following forms. +## (1) Cross-correlation estimate if X and Y are vectors. +## (2) Autocorrelation estimate if is a vector and Y is omitted, +## (3) If X is a matrix, R is an matrix containing the cross- +## correlation estimate of each column with every other column. +## Lag varies with the first index so that R has 2*maxlag+1 +## rows and P^2 columns where P is the number of columns in X. +## If Rij(k) is the correlation between columns i and j of X +## R(k+maxlag+1,P*(i-1)+j) == Rij(k) +## for lag k in [-maxlag:maxlag], or +## R(:,P*(i-1)+j) == xcorr(X(:,i),X(:,j)). +## "reshape(R(k,:),P,P)" is the cross-correlation matrix for X(k,:). +## + +## The cross-correlation estimate is calculated by a "spectral" method +## in which the FFT of the first vector is multiplied element-by-element +## with the FFT of second vector. The computational effort depends on +## the length N of the vectors and is independent of the number of lags +## requested. If you only need a few lags, the "direct sum" method may +## be faster: +## +## Ref: Stearns, SD and David, RA (1988). Signal Processing Algorithms. +## New Jersey: Prentice-Hall. + +## unbiased: +## ( hankel(x(1:k),[x(k:N); zeros(k-1,1)]) * y ) ./ [N:-1:N-k+1](:) +## biased: +## ( hankel(x(1:k),[x(k:N); zeros(k-1,1)]) * y ) ./ N +## +## If length(x) == length(y) + k, then you can use the simpler +## ( hankel(x(1:k),x(k:N-k)) * y ) ./ N + +function [R, lags] = xcorr (X, Y, maxlag, scale) + + if (nargin < 1 || nargin > 4) + print_usage; + endif + + ## assign arguments that are missing from the list + ## or reassign (right shift) them according to data type + if nargin==1 + Y=[]; maxlag=[]; scale=[]; + elseif nargin==2 + maxlag=[]; scale=[]; + if ischar(Y), scale=Y; Y=[]; + elseif isscalar(Y), maxlag=Y; Y=[]; + endif + elseif nargin==3 + scale=[]; + if ischar(maxlag), scale=maxlag; maxlag=[]; endif + if isscalar(Y), maxlag=Y; Y=[]; endif + endif + + ## assign defaults to missing arguments + if isvector(X) + ## if isempty(Y), Y=X; endif ## this line disables code for autocorr'n + N = max(length(X),length(Y)); + else + N = rows(X); + endif + if isempty(maxlag), maxlag=N-1; endif + if isempty(scale), scale='none'; endif + + ## check argument values + if isempty(X) || isscalar(X) || ischar(Y) || ! ismatrix(X) + error("xcorr: X must be a vector or matrix"); + endif + if isscalar(Y) || ischar(Y) || (!isempty(Y) && !isvector(Y)) + error("xcorr: Y must be a vector"); + endif + if !isempty(Y) && !isvector(X) + error("xcorr: X must be a vector if Y is specified"); + endif + if !isscalar(maxlag) || !isreal(maxlag) || maxlag<0 || fix(maxlag)!=maxlag + error("xcorr: maxlag must be a single non-negative integer"); + endif + ## + ## sanity check on number of requested lags + ## Correlations for lags in excess of +/-(N-1) + ## (a) are not calculated by the FFT algorithm, + ## (b) are all zero; so provide them by padding + ## the results (with zeros) before returning. + if (maxlag > N-1) + pad_result = maxlag - (N - 1); + maxlag = N - 1; + %error("xcorr: maxlag must be less than length(X)"); + else + pad_result = 0; + endif + if isvector(X) && isvector(Y) && length(X) != length(Y) && \ + !strcmp(scale,'none') + error("xcorr: scale must be 'none' if length(X) != length(Y)") + endif + + P = columns(X); + M = 2^nextpow2(N + maxlag); + if !isvector(X) + ## For matrix X, correlate each column "i" with all other "j" columns + R = zeros(2*maxlag+1,P^2); + + ## do FFTs of padded column vectors + pre = fft (postpad (prepad (X, N+maxlag), M) ); + post = conj (fft (postpad (X, M))); + + ## do autocorrelations (each column with itself) + ## -- if result R is reshaped to 3D matrix (i.e. R=reshape(R,M,P,P)) + ## the autocorrelations are on leading diagonal columns of R, + ## where i==j in R(:,i,j) + cor = ifft (post .* pre); + R(:, 1:P+1:P^2) = cor (1:2*maxlag+1,:); + + ## do the cross correlations + ## -- these are the off-diagonal colummn of the reshaped 3D result + ## matrix -- i!=j in R(:,i,j) + for i=1:P-1 + j = i+1:P; + cor = ifft( pre(:,i*ones(length(j),1)) .* post(:,j) ); + R(:,(i-1)*P+j) = cor(1:2*maxlag+1,:); + R(:,(j-1)*P+i) = conj( flipud( cor(1:2*maxlag+1,:) ) ); + endfor + elseif isempty(Y) + ## compute autocorrelation of a single vector + post = fft( postpad(X(:),M) ); + cor = ifft( post .* conj(post) ); + R = [ conj(cor(maxlag+1:-1:2)) ; cor(1:maxlag+1) ]; + else + ## compute cross-correlation of X and Y + ## If one of X & Y is a row vector, the other can be a column vector. + pre = fft( postpad( prepad( X(:), length(X)+maxlag ), M) ); + post = fft( postpad( Y(:), M ) ); + cor = ifft( pre .* conj(post) ); + R = cor(1:2*maxlag+1); + endif + + ## if inputs are real, outputs should be real, so ignore the + ## insignificant complex portion left over from the FFT + if isreal(X) && (isempty(Y) || isreal(Y)) + R=real(R); + endif + + ## correct for bias + if strcmp(scale, 'biased') + R = R ./ N; + elseif strcmp(scale, 'unbiased') + R = R ./ ( [ N-maxlag:N-1, N, N-1:-1:N-maxlag ]' * ones(1,columns(R)) ); + elseif strcmp(scale, 'coeff') + ## R = R ./ R(maxlag+1) works only for autocorrelation + ## For cross correlation coeff, divide by rms(X)*rms(Y). + if !isvector(X) + ## for matrix (more than 1 column) X + rms = sqrt( sumsq(X) ); + R = R ./ ( ones(rows(R),1) * reshape(rms.'*rms,1,[]) ); + elseif isempty(Y) + ## for autocorrelation, R(zero-lag) is the mean square. + R = R / R(maxlag+1); + else + ## for vectors X and Y + R = R / sqrt( sumsq(X)*sumsq(Y) ); + endif + elseif !strcmp(scale, 'none') + error("xcorr: scale must be 'biased', 'unbiased', 'coeff' or 'none'"); + endif + + ## Pad result if necessary + ## (most likely is not required, use "if" to avoid uncessary code) + ## At this point, lag varies with the first index in R; + ## so pad **before** the transpose. + if pad_result + R_pad = zeros(pad_result,columns(R)); + R = [R_pad; R; R_pad]; + endif + ## Correct the shape (transpose) so it is the same as the first input vector + if isvector(X) && P > 1 + R = R.'; + endif + + ## return the lag indices if desired + if nargout == 2 + maxlag += pad_result; + lags = [-maxlag:maxlag]; + endif + +endfunction + +##------------ Use brute force to compute the correlation ------- +##if !isvector(X) +## ## For matrix X, compute cross-correlation of all columns +## R = zeros(2*maxlag+1,P^2); +## for i=1:P +## for j=i:P +## idx = (i-1)*P+j; +## R(maxlag+1,idx) = X(i)*X(j)'; +## for k = 1:maxlag +## R(maxlag+1-k,idx) = X(k+1:N,i) * X(1:N-k,j)'; +## R(maxlag+1+k,idx) = X(k:N-k,i) * X(k+1:N,j)'; +## endfor +## if (i!=j), R(:,(j-1)*P+i) = conj(flipud(R(:,idx))); endif +## endfor +## endfor +##elseif isempty(Y) +## ## reshape X so that dot product comes out right +## X = reshape(X, 1, N); +## +## ## compute autocorrelation for 0:maxlag +## R = zeros (2*maxlag + 1, 1); +## for k=0:maxlag +## R(maxlag+1+k) = X(1:N-k) * X(k+1:N)'; +## endfor +## +## ## use symmetry for -maxlag:-1 +## R(1:maxlag) = conj(R(2*maxlag+1:-1:maxlag+2)); +##else +## ## reshape and pad so X and Y are the same length +## X = reshape(postpad(X,N), 1, N); +## Y = reshape(postpad(Y,N), 1, N)'; +## +## ## compute cross-correlation +## R = zeros (2*maxlag + 1, 1); +## R(maxlag+1) = X*Y; +## for k=1:maxlag +## R(maxlag+1-k) = X(k+1:N) * Y(1:N-k); +## R(maxlag+1+k) = X(k:N-k) * Y(k+1:N); +## endfor +##endif +##-------------------------------------------------------------- diff --git a/octave_packages/signal-1.1.3/xcorr2.m b/octave_packages/signal-1.1.3/xcorr2.m new file mode 100644 index 0000000..43286b0 --- /dev/null +++ b/octave_packages/signal-1.1.3/xcorr2.m @@ -0,0 +1,87 @@ +## Copyright (C) 2000 Dave Cogdell +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{c} =} xcorr2 (@var{a}) +## @deftypefnx {Function File} {@var{c} =} xcorr2 (@var{a}, @var{b}) +## @deftypefnx {Function File} {@var{c} =} xcorr2 (@dots{}, @var{scale}) +## Compute the 2D cross-correlation of matrices @var{a} and @var{b}. +## +## If @var{b} is not specified, it defaults to the same matrix as @var{a}, i.e., +## it's the same as @code{xcorr(@var{a}, @var{a})}. +## +## The optional argument @var{scale}, defines the type of scaling applied to the +## cross-correlation matrix (defaults to "none"). Possible values are: +## @itemize @bullet +## @item "biased" +## +## Scales the raw cross-correlation by the maximum number of elements of @var{a} +## and @var{b} involved in the generation of any element of @var{c}. +## +## @item "unbiased" +## +## Scales the raw correlation by dividing each element in the cross-correlation +## matrix by the number of products @var{a} and @var{b} used to generate that +## element +## +## @item "coeff" +## +## Normalizes the sequence so that the largest cross-correlation element is +## identically 1.0. +## +## @item "none" +## +## No scaling (this is the default). +## @end itemize +## @seealso{conv2, corr2, xcorr} +## @end deftypefn + +function c = xcorr2 (a, b = a, biasflag = "none") + + if (nargin < 1 || nargin > 3) + print_usage; + elseif (nargin == 2 && ischar (b)) + biasflag = b; + b = a; + endif + + ## compute correlation + [ma,na] = size(a); + [mb,nb] = size(b); + c = conv2 (a, conj (b (mb:-1:1, nb:-1:1))); + + ## bias routines by Dave Cogdell (cogdelld@asme.org) + ## optimized by Paul Kienzle (pkienzle@users.sf.net) + if strcmp(lower(biasflag), 'biased'), + c = c / ( min ([ma, mb]) * min ([na, nb]) ); + elseif strcmp(lower(biasflag), 'unbiased'), + lo = min ([na,nb]); + hi = max ([na, nb]); + row = [ 1:(lo-1), lo*ones(1,hi-lo+1), (lo-1):-1:1 ]; + + lo = min ([ma,mb]); + hi = max ([ma, mb]); + col = [ 1:(lo-1), lo*ones(1,hi-lo+1), (lo-1):-1:1 ]'; + + bias = col*row; + c = c./bias; + + elseif strcmp(lower(biasflag),'coeff'), + c = c/max(c(:))'; + else + error ("invalid type of scale %s", biasflag); + endif +endfunction diff --git a/octave_packages/signal-1.1.3/xcov.m b/octave_packages/signal-1.1.3/xcov.m new file mode 100644 index 0000000..9b51603 --- /dev/null +++ b/octave_packages/signal-1.1.3/xcov.m @@ -0,0 +1,62 @@ +## Copyright (C) 1999, 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: [c, lag] = xcov (X [, Y] [, maxlag] [, scale]) +## +## Compute covariance at various lags [=correlation(x-mean(x),y-mean(y))]. +## +## X: input vector +## Y: if specified, compute cross-covariance between X and Y, +## otherwise compute autocovariance of X. +## maxlag: is specified, use lag range [-maxlag:maxlag], +## otherwise use range [-n+1:n-1]. +## Scale: +## 'biased' for covariance=raw/N, +## 'unbiased' for covariance=raw/(N-|lag|), +## 'coeff' for covariance=raw/(covariance at lag 0), +## 'none' for covariance=raw +## 'none' is the default. +## +## Returns the covariance for each lag in the range, plus an +## optional vector of lags. + +function [retval, lags] = xcov (X, Y, maxlag, scale) + + if (nargin < 1 || nargin > 4) + print_usage; + endif + + if nargin==1 + Y=[]; maxlag=[]; scale=[]; + elseif nargin==2 + maxlag=[]; scale=[]; + if ischar(Y), scale=Y; Y=[]; + elseif isscalar(Y), maxlag=Y; Y=[]; + endif + elseif nargin==3 + scale=[]; + if ischar(maxlag), scale=maxlag; maxlag=[]; endif + if isscalar(Y), maxlag=Y; Y=[]; endif + endif + + ## XXX FIXME XXX --- should let center(Y) deal with [] + ## [retval, lags] = xcorr(center(X), center(Y), maxlag, scale); + if (!isempty(Y)) + [retval, lags] = xcorr(center(X), center(Y), maxlag, scale); + else + [retval, lags] = xcorr(center(X), maxlag, scale); + endif + +endfunction diff --git a/octave_packages/signal-1.1.3/zerocrossing.m b/octave_packages/signal-1.1.3/zerocrossing.m new file mode 100644 index 0000000..db553ab --- /dev/null +++ b/octave_packages/signal-1.1.3/zerocrossing.m @@ -0,0 +1,72 @@ +## Copyright (C) 2008 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 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x0}} = zerocrossing (@var{x}, @ +## @var{y}) +## Estimates the points at which a given waveform y=y(x) crosses the +## x-axis using linear interpolation. +## @seealso{fzero, roots} +## @end deftypefn + +function retval = zerocrossing (x,y) + + x = x(:);y = y(:); + crossing_intervals = (y(1:end-1).*y(2:end) <= 0); + left_ends = (x(1:end-1))(crossing_intervals); + right_ends = (x(2:end))(crossing_intervals); + left_vals = (y(1:end-1))(crossing_intervals); + right_vals = (y(2:end))(crossing_intervals); + mid_points = (left_ends+right_ends)/2; + zero_intervals = find(left_vals==right_vals); + retval1 = mid_points(zero_intervals); + left_ends(zero_intervals) = []; + right_ends(zero_intervals) = []; + left_vals(zero_intervals) = []; + right_vals(zero_intervals) = []; + retval2=left_ends-(right_ends-left_ends).*left_vals./(right_vals-left_vals); + retval = union(retval1,retval2); + +endfunction + +%!test +%! x = linspace(0,1,100); +%! y = rand(1,100)-0.5; +%! x0= zerocrossing(x,y); +%! y0 = interp1(x,y,x0); +%! assert(norm(y0,inf), 0, 100*eps) + +%!test +%! x = linspace(0,1,100); +%! y = rand(1,100)-0.5; +%! y(10:20) = 0; +%! x0= zerocrossing(x,y); +%! y0 = interp1(x,y,x0); +%! assert(norm(y0,inf), 0, 100*eps) + +%!demo +%! x = linspace(0,1,100); +%! y = rand(1,100)-0.5; +%! x0= zerocrossing(x,y); +%! y0 = interp1(x,y,x0); +%! plot(x,y,x0,y0,'x') + +%!demo +%! x = linspace(0,1,100); +%! y = rand(1,100)-0.5; +%! y(10:20) = 0; +%! x0= zerocrossing(x,y); +%! y0 = interp1(x,y,x0); +%! plot(x,y,x0,y0,'x') diff --git a/octave_packages/signal-1.1.3/zp2sos.m b/octave_packages/signal-1.1.3/zp2sos.m new file mode 100644 index 0000000..6397e61 --- /dev/null +++ b/octave_packages/signal-1.1.3/zp2sos.m @@ -0,0 +1,136 @@ +%% Copyright (C) 2005 Julius O. Smith III +%% +%% This program is free software; you can redistribute it and/or modify it under +%% the terms of the GNU General Public License as published by the Free Software +%% Foundation; either version 3 of the License, or (at your option) any later +%% version. +%% +%% This program is distributed in the hope that it will be useful, but WITHOUT +%% ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +%% FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +%% details. +%% +%% You should have received a copy of the GNU General Public License along with +%% this program; if not, see . + +%% -*- texinfo -*- +%% @deftypefn {Function File} {[@var{sos}, @var{g}] =} zp2sos (@var{z}, @var{p}) +%% Convert filter poles and zeros to second-order sections. +%% +%% INPUTS:@* +%% @itemize +%% @item +%% @var{z} = column-vector containing the filter zeros@* +%% @item +%% @var{p} = column-vector containing the filter poles@* +%% @item +%% @var{g} = overall filter gain factor +%% @end itemize +%% +%% RETURNED: +%% @itemize +%% @item +%% @var{sos} = matrix of series second-order sections, one per row:@* +%% @var{sos} = [@var{B1}.' @var{A1}.'; ...; @var{BN}.' @var{AN}.'], where@* +%% @code{@var{B1}.'==[b0 b1 b2] and @var{A1}.'==[1 a1 a2]} for +%% section 1, etc.@* +%% b0 must be nonzero for each section.@* +%% See @code{filter()} for documentation of the +%% second-order direct-form filter coefficients @var{B}i and +%% %@var{A}i, i=1:N. +%% +%% @item +%% @var{Bscale} is an overall gain factor that effectively scales +%% any one of the @var{B}i vectors. +%% @end itemize +%% +%% EXAMPLE: +%% @example +%% [z,p,g] = tf2zp([1 0 0 0 0 1],[1 0 0 0 0 .9]); +%% [sos,g] = zp2sos(z,p,g) +%% +%% sos = +%% 1.0000 0.6180 1.0000 1.0000 0.6051 0.9587 +%% 1.0000 -1.6180 1.0000 1.0000 -1.5843 0.9587 +%% 1.0000 1.0000 0 1.0000 0.9791 0 +%% +%% g = +%% 1 +%% @end example +%% +%% @seealso{sos2pz sos2tf tf2sos zp2tf tf2zp} +%% @end deftypefn + +function [sos,g] = zp2sos(z,p,g) + + if nargin<3, g=1; end + if nargin<2, p=[]; end + + [zc,zr] = cplxreal(z); + [pc,pr] = cplxreal(p); + + % zc,zr,pc,pr + + nzc=length(zc); + npc=length(pc); + + nzr=length(zr); + npr=length(pr); + + % Pair up real zeros: + if nzr + if mod(nzr,2)==1, zr=[zr;0]; nzr=nzr+1; end + nzrsec = nzr/2; + zrms = -zr(1:2:nzr-1)-zr(2:2:nzr); + zrp = zr(1:2:nzr-1).*zr(2:2:nzr); + else + nzrsec = 0; + end + + % Pair up real poles: + if npr + if mod(npr,2)==1, pr=[pr;0]; npr=npr+1; end + nprsec = npr/2; + prms = -pr(1:2:npr-1)-pr(2:2:npr); + prp = pr(1:2:npr-1).*pr(2:2:npr); + else + nprsec = 0; + end + + nsecs = max(nzc+nzrsec,npc+nprsec); + + % Convert complex zeros and poles to real 2nd-order section form: + zcm2r = -2*real(zc); + zca2 = abs(zc).^2; + pcm2r = -2*real(pc); + pca2 = abs(pc).^2; + + sos = zeros(nsecs,6); + sos(:,1) = ones(nsecs,1); % all 2nd-order polynomials are monic + sos(:,4) = ones(nsecs,1); + + nzrl=nzc+nzrsec; % index of last real zero section + nprl=npc+nprsec; % index of last real pole section + + for i=1:nsecs + + if i<=nzc % lay down a complex zero pair: + sos(i,2:3) = [zcm2r(i) zca2(i)]; + elseif i<=nzrl % lay down a pair of real zeros: + sos(i,2:3) = [zrms(i-nzc) zrp(i-nzc)]; + end + + if i<=npc % lay down a complex pole pair: + sos(i,5:6) = [pcm2r(i) pca2(i)]; + elseif i<=nprl % lay down a pair of real poles: + sos(i,5:6) = [prms(i-npc) prp(i-npc)]; + end + end +end + +%!test +%! B=[1 0 0 0 0 1]; A=[1 0 0 0 0 .9]; +%! [z,p,g] = tf2zp(B,A); +%! [sos,g] = zp2sos(z,p,g); +%! [Bh,Ah] = sos2tf(sos,g); +%! assert({Bh,Ah},{B,A},100*eps); diff --git a/octave_packages/signal-1.1.3/zp2ss.m b/octave_packages/signal-1.1.3/zp2ss.m new file mode 100644 index 0000000..8991ef6 --- /dev/null +++ b/octave_packages/signal-1.1.3/zp2ss.m @@ -0,0 +1,65 @@ +## Copyright (C) 1994, 1996, 2000, 2002, 2003, 2004, 2005, 2007 Auburn University +## Copyright (C) 2012 Lukas F. Reichlin +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{a}, @var{b}, @var{c}, @var{d}] =} zp2ss (@var{zer}, @var{pol}, @var{k}) +## Conversion from zero / pole to state space. +## +## @strong{Inputs} +## @table @var +## @item zer +## @itemx pol +## Vectors of (possibly) complex poles and zeros of a transfer +## function. Complex values must come in conjugate pairs +## (i.e., @math{x+jy} in @var{zer} means that @math{x-jy} is also in @var{zer}). +## @item k +## Real scalar (leading coefficient). +## @end table +## +## @strong{Outputs} +## @table @var +## @item @var{a} +## @itemx @var{b} +## @itemx @var{c} +## @itemx @var{d} +## The state space system, in the form: +## @iftex +## @tex +## $$ \dot x = Ax + Bu $$ +## $$ y = Cx + Du $$ +## @end tex +## @end iftex +## @ifinfo +## @example +## . +## x = Ax + Bu +## y = Cx + Du +## @end example +## @end ifinfo +## @end table +## @end deftypefn + +## Author: David Clem + +function [a, b, c, d, e] = zp2ss (varargin) + + if (nargin == 0) + print_usage (); + endif + + [a, b, c, d, e] = dssdata (zpk (varargin{:}), []); + +endfunction diff --git a/octave_packages/signal-1.1.3/zp2tf.m b/octave_packages/signal-1.1.3/zp2tf.m new file mode 100644 index 0000000..0d6bec6 --- /dev/null +++ b/octave_packages/signal-1.1.3/zp2tf.m @@ -0,0 +1,43 @@ +## Copyright (C) 1996, 1998, 2000, 2002, 2004, 2005, 2007 Auburn University +## Copyright (C) 2012 Lukas F. Reichlin +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{num}, @var{den}] =} zp2tf (@var{zer}, @var{pol}, @var{k}) +## Converts zeros / poles to a transfer function. +## +## @strong{Inputs} +## @table @var +## @item zer +## @itemx pol +## Vectors of (possibly complex) poles and zeros of a transfer +## function. Complex values must appear in conjugate pairs. +## @item k +## Real scalar (leading coefficient). +## @end table +## @end deftypefn + +## Author: A. S. Hodel +## (With help from students Ingram, McGowan.) + +function [num, den] = zp2tf (varargin) + + if (nargin == 0) + print_usage (); + endif + + [num, den] = tfdata (zpk (varargin{:}), "vector"); + +endfunction diff --git a/octave_packages/signal-1.1.3/zplane.m b/octave_packages/signal-1.1.3/zplane.m new file mode 100644 index 0000000..7a0704b --- /dev/null +++ b/octave_packages/signal-1.1.3/zplane.m @@ -0,0 +1,152 @@ +## Copyright (C) 1999, 2001 Paul Kienzle +## Copyright (C) 2004 Stefan van der Walt +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## usage: zplane(b [, a]) or zplane(z [, p]) +## +## Plot the poles and zeros. If the arguments are row vectors then they +## represent filter coefficients (numerator polynomial b and denominator +## polynomial a), but if they are column vectors or matrices then they +## represent poles and zeros. +## +## This is a horrid interface, but I didn't choose it; better would be +## to accept b,a or z,p,g like other functions. The saving grace is +## that poly(x) always returns a row vector and roots(x) always returns +## a column vector, so it is usually right. You must only be careful +## when you are creating filters by hand. +## +## Note that due to the nature of the roots() function, poles and zeros +## may be displayed as occurring around a circle rather than at a single +## point. +## +## The transfer function is +## +## B(z) b0 + b1 z^(-1) + b2 z^(-2) + ... + bM z^(-M) +## H(z) = ---- = -------------------------------------------- +## A(z) a0 + a1 z^(-1) + a2 z^(-2) + ... + aN z^(-N) +## +## b0 (z - z1) (z - z2) ... (z - zM) +## = -- z^(-M+N) ------------------------------ +## a0 (z - p1) (z - p2) ... (z - pN) +## +## The denominator a defaults to 1, and the poles p defaults to []. + +## TODO: Consider a plot-like interface: +## TODO: zplane(x1,y1,fmt1,x2,y2,fmt2,...) +## TODO: with y_i or fmt_i optional as usual. This would allow +## TODO: legends and control over point colour and filters of +## TODO: different orders. +function zplane(z, p = []) + + if (nargin < 1 || nargin > 2) + print_usage; + end + if columns(z)>1 || columns(p)>1 + if rows(z)>1 || rows(p)>1 + ## matrix form: columns are already zeros/poles + else + ## z -> b + ## p -> a + if isempty(z), z=1; endif + if isempty(p), p=1; endif + + M = length(z) - 1; + N = length(p) - 1; + z = [ roots(z); zeros(N - M, 1) ]; + p = [ roots(p); zeros(M - N, 1) ]; + endif + endif + + + xmin = min([-1; real(z(:)); real(p(:))]); + xmax = max([ 1; real(z(:)); real(p(:))]); + ymin = min([-1; imag(z(:)); imag(p(:))]); + ymax = max([ 1; imag(z(:)); imag(p(:))]); + xfluff = max([0.05*(xmax-xmin), (1.05*(ymax-ymin)-(xmax-xmin))/10]); + yfluff = max([0.05*(ymax-ymin), (1.05*(xmax-xmin)-(ymax-ymin))/10]); + xmin = xmin - xfluff; + xmax = xmax + xfluff; + ymin = ymin - yfluff; + ymax = ymax + yfluff; + + text(); + plot_with_labels(z, "o"); + plot_with_labels(p, "x"); + refresh; + + r = exp(2i*pi*[0:100]/100); + plot(real(r), imag(r),'k'); hold on; + axis equal; + grid on; + axis(1.05*[xmin, xmax, ymin, ymax]); + if (!isempty(p)) + h = plot(real(p), imag(p), "bx"); + set (h, 'MarkerSize', 7); + endif + if (!isempty(z)) + h = plot(real(z), imag(z), "bo"); + set (h, 'MarkerSize', 7); + endif + hold off; +endfunction + +function plot_with_labels(x, symbol) + if ( !isempty(x) ) + + x_u = unique(x(:)); + + for i = 1:length(x_u) + n = sum(x_u(i) == x(:)); + if (n > 1) + text(real(x_u(i)), imag(x_u(i)), [" " num2str(n)]); + endif + endfor + + col = "rgbcmy"; + for c = 1:columns(x) + plot(real( x(:,c) ), imag( x(:,c) ), [col(mod(c,6)),symbol ";;"]); + endfor + + endif +endfunction + +%!demo +%! ## construct target system: +%! ## symmetric zero-pole pairs at r*exp(iw),r*exp(-iw) +%! ## zero-pole singletons at s +%! pw=[0.2, 0.4, 0.45, 0.95]; #pw = [0.4]; +%! pr=[0.98, 0.98, 0.98, 0.96]; #pr = [0.85]; +%! ps=[]; +%! zw=[0.3]; # zw=[]; +%! zr=[0.95]; # zr=[]; +%! zs=[]; +%! +%! ## system function for target system +%! p=[[pr, pr].*exp(1i*pi*[pw, -pw]), ps]'; +%! z=[[zr, zr].*exp(1i*pi*[zw, -zw]), zs]'; +%! M = length(z); N = length(p); +%! sys_a = [ zeros(1, M-N), real(poly(p)) ]; +%! sys_b = [ zeros(1, N-M), real(poly(z)) ]; +%! disp("The first two graphs should be identical, with poles at (r,w)="); +%! disp(sprintf(" (%.2f,%.2f)", [pr ; pw])); +%! disp("and zeros at (r,w)="); +%! disp(sprintf(" (%.2f,%.2f)", [zr ; zw])); +%! disp("with reflection across the horizontal plane"); +%! subplot(231); title("transfer function form"); zplane(sys_b, sys_a); +%! subplot(232); title("pole-zero form"); zplane(z,p); +%! subplot(233); title("empty p"); zplane(z); +%! subplot(234); title("empty a"); zplane(sys_b); +%! disp("The matrix plot has 2 sets of points, one inside the other"); +%! subplot(235); title("matrix"); zplane([z, 0.7*z], [p, 0.7*p]); diff --git a/octave_packages/sockets-1.0.8/packinfo/.autoload b/octave_packages/sockets-1.0.8/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/sockets-1.0.8/packinfo/DESCRIPTION b/octave_packages/sockets-1.0.8/packinfo/DESCRIPTION new file mode 100644 index 0000000..5fae5e9 --- /dev/null +++ b/octave_packages/sockets-1.0.8/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: sockets +Version: 1.0.8 +Date: 2012-06-22 +Author: John Swensen +Maintainer: Paul Dreik +Title: Sockets +Description: Socket functions for networking from within octave. +Categories: Sockets +Depends: octave (>= 2.9.10) +Autoload: yes +License: GPLv3+ +Url: http://octave.sourceforge.net diff --git a/octave_packages/sockets-1.0.8/packinfo/INDEX b/octave_packages/sockets-1.0.8/packinfo/INDEX new file mode 100644 index 0000000..e15fada --- /dev/null +++ b/octave_packages/sockets-1.0.8/packinfo/INDEX @@ -0,0 +1,25 @@ +sockets >> Sockets +Sockets + socket + bind + connect + disconnect + accept + send + recv + gethostbyname + listen +Socket constants + AF_LOCAL + AF_UNIX + AF_INET + AF_APPLETALK + SOCK_STREAM + SOCK_DGRAM + SOCK_SEQPACKET + SOCK_RAW + SOCK_RDM + MSG_PEEK + MSG_DONTWAIT + MSG_WAITALL + load_socket_constants diff --git a/octave_packages/sockets-1.0.8/packinfo/NEWS b/octave_packages/sockets-1.0.8/packinfo/NEWS new file mode 100644 index 0000000..0552247 --- /dev/null +++ b/octave_packages/sockets-1.0.8/packinfo/NEWS @@ -0,0 +1,4 @@ +Summary of important user-visible changes for sockets 1.0.8: +------------------------------------------------------------------- + + ** updated function documentation with more details diff --git a/octave_packages/specfun-1.1.0/Ci.m b/octave_packages/specfun-1.1.0/Ci.m new file mode 100644 index 0000000..845e03a --- /dev/null +++ b/octave_packages/specfun-1.1.0/Ci.m @@ -0,0 +1,39 @@ +## Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} Ci (@var{z}) +## Compute the cosine integral function defined by: +## @verbatim +## Inf +## / +## Ci(x) = | cos(t)/t dt +## / +## x +## @end verbatim +## @seealso{cosint, Si, sinint, expint, expint_Ei} +## @end deftypefn + +function y = Ci(z) + if (nargin != 1) + print_usage; + endif + y = z; + y(z == 0) = -Inf; + y(real(z) == 0 & imag(z) >0) = 0.5*(expint_Ei(i.*y(real(z) == 0 & imag(z) >0))+expint_Ei(-i.*y(real(z) == 0 & imag(z) >0)))+ i.*pi./2; + y(real(z) == 0 & imag(z) <0) = 0.5*(expint_Ei(i.*y(real(z) == 0 & imag(z) <0))+expint_Ei(-i.*y(real(z) == 0 & imag(z) <0)))-i*pi./2; + y(real(z)>=0) = -0.5.*(expint_E1(i.*y(real(z)>=0) )+expint_E1(-i.*y(real(z)>=0) )); + y(real(z)<0) = -0.5.*(expint_E1(-i.*y(real(z)<0))+expint_E1(i.*y(real(z)<0)))+i*pi; +endfunction diff --git a/octave_packages/specfun-1.1.0/Si.m b/octave_packages/specfun-1.1.0/Si.m new file mode 100644 index 0000000..d7142d1 --- /dev/null +++ b/octave_packages/specfun-1.1.0/Si.m @@ -0,0 +1,44 @@ +## Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} Si (@var{x}) +## Compute the sine integral defined by: +## @verbatim +## x +## / +## Si(x) = | sin(t)/t dt +## / +## 0 +## @end verbatim +## @end deftypefn + +function y = Si(x) + if (nargin != 1) + print_usage; + endif + y = zeros(size(x)); + if prod(size(x)) < 101 + for k = 1:prod(size(x)) + y(k) = sum(besselj([0:100]+0.5,(x(k)/2)).^2); + endfor + y = y.*pi; + else + for k=0:100 + y += besselj(k+0.5,x/2).^2; + endfor + y = y.*pi; + endif +endfunction diff --git a/octave_packages/specfun-1.1.0/cosint.m b/octave_packages/specfun-1.1.0/cosint.m new file mode 100644 index 0000000..2de14ff --- /dev/null +++ b/octave_packages/specfun-1.1.0/cosint.m @@ -0,0 +1,34 @@ +## Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} cosint (@var{z}) +## Compute the cosine integral function defined by: +## @verbatim +## Inf +## / +## cosint(x) = | cos(t)/t dt +## / +## x +## @end verbatim +## @seealso{Ci, Si, sinint, expint, expint_Ei} +## @end deftypefn + +function y = cosint(z) + if (nargin != 1) + print_usage; + endif + y = Ci(z); +endfunction diff --git a/octave_packages/specfun-1.1.0/dirac.m b/octave_packages/specfun-1.1.0/dirac.m new file mode 100644 index 0000000..8e42874 --- /dev/null +++ b/octave_packages/specfun-1.1.0/dirac.m @@ -0,0 +1,28 @@ +## Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} dirac(@var{x}) +## Compute the dirac delta function. +## @seealso{heaviside} +## @end deftypefn + +function y = dirac(x) + if (nargin != 1) + print_usage; + endif + y = double(x == 0.); + y(x == 0) = Inf; +endfunction diff --git a/octave_packages/specfun-1.1.0/doc-cache b/octave_packages/specfun-1.1.0/doc-cache new file mode 100644 index 0000000..4bf750a --- /dev/null +++ b/octave_packages/specfun-1.1.0/doc-cache @@ -0,0 +1,742 @@ +# Created by Octave 3.6.1, Sun Mar 11 22:05:14 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 19 +# name: +# type: sq_string +# elements: 1 +# length: 2 +Ci + + +# name: +# type: sq_string +# elements: 1 +# length: 275 + -- Function File: Y = Ci (Z) + Compute the cosine integral function defined by: Inf + / + Ci(x) = | cos(t)/t dt + / + x + + See also: cosint, Si, sinint, expint, expint_Ei + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the cosine integral function defined by: + Inf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 2 +Si + + +# name: +# type: sq_string +# elements: 1 +# length: 207 + -- Function File: Y = Si (X) + Compute the sine integral defined by: x + / + Si(x) = | sin(t)/t dt + / + 0 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the sine integral defined by: + x + / + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +cosint + + +# name: +# type: sq_string +# elements: 1 +# length: 275 + -- Function File: Y = cosint (Z) + Compute the cosine integral function defined by: Inf + / + cosint(x) = | cos(t)/t dt + / + x + + See also: Ci, Si, sinint, expint, expint_Ei + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the cosine integral function defined by: + Inf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +dirac + + +# name: +# type: sq_string +# elements: 1 +# length: 99 + -- Function File: Y = dirac(X) + Compute the dirac delta function. + + See also: heaviside + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Compute the dirac delta function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +ellipke + + +# name: +# type: sq_string +# elements: 1 +# length: 410 + -- Function File: [K, E] = ellipke (M[,TOL]) + Compute complete elliptic integral of first K(M) and second E(M). + + M is either real array or scalar with 0 <= m <= 1 + + TOL will be ignored (MATLAB uses this to allow faster, less + accurate approximation) + + Ref: Abramowitz, Milton and Stegun, Irene A. Handbook of + Mathematical Functions, Dover, 1965, Chapter 17. + + See also: ellipj + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 +Compute complete elliptic integral of first K(M) and second E(M). + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +erfcinv + + +# name: +# type: sq_string +# elements: 1 +# length: 122 + -- Function File: erfcinv (X) + Compute the inverse complementary error function. + + See also: erfc, erf, erfinv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Compute the inverse complementary error function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +expint + + +# name: +# type: sq_string +# elements: 1 +# length: 251 + -- Function File: Y = expint (X) + Compute the exponential integral, infinity + / + expint(x) = | exp(t)/t dt + / + x + + See also: expint_E1, expint_Ei + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the exponential integral, + infinity + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +expint_E1 + + +# name: +# type: sq_string +# elements: 1 +# length: 251 + -- Function File: Y = expint_E1 (X) + Compute the exponential integral, infinity + / + expint(x) = | exp(t)/t dt + / + x + + See also: expint, expint_Ei + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the exponential integral, + infinity + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +expint_Ei + + +# name: +# type: sq_string +# elements: 1 +# length: 263 + -- Function File: Y = expint_Ei (X) + Compute the exponential integral, infinity + / + expint_Ei(x) = - | exp(t)/t dt + / + -x + + See also: expint, expint_E1 + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the exponential integral, + infinity + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +heaviside + + +# name: +# type: sq_string +# elements: 1 +# length: 400 + -- Function File: heaviside(X) + -- Function File: heaviside(X, ZERO_VALUE) + Compute the Heaviside step function. + + The Heaviside function is defined as + + Heaviside (X) = 1, X > 0 + Heaviside (X) = 0, X < 0 + + The value of the Heaviside function at X = 0 is by default 0.5, + but can be changed via the optional second input argument. + + See also: dirac + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Compute the Heaviside step function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +laguerre + + +# name: +# type: sq_string +# elements: 1 +# length: 171 + -- Function File: Y = laguerre (X,N) + -- Function File: [Y P]= laguerre (X,N) + Compute the value of the Laguerre polynomial of order N for each + element of X + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 78 +Compute the value of the Laguerre polynomial of order N for each +element of X + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +lambertw + + +# name: +# type: sq_string +# elements: 1 +# length: 1029 + -- Function File: X = lambertw (Z) + -- Function File: X = lambertw (Z, N) + Compute the Lambert W function of Z. + + This function satisfies W(z).*exp(W(z)) = z, and can thus be used + to express solutions of transcendental equations involving + exponentials or logarithms. + + N must be integer, and specifies the branch of W to be computed; + W(z) is a shorthand for W(0,z), the principal branch. Branches 0 + and -1 are the only ones that can take on non-complex values. + + If either N or Z are non-scalar, the function is mapped to each + element; both may be non-scalar provided their dimensions agree. + + This implementation should return values within 2.5*eps of its + counterpart in Maple V, release 3 or later. Please report any + discrepancies to the author, Nici Schraudolph + . + + For further details, see: + + Corless, Gonnet, Hare, Jeffrey, and Knuth (1996), `On the Lambert + W Function', Advances in Computational Mathematics 5(4):329-359. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Compute the Lambert W function of Z. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +laplacian + + +# name: +# type: sq_string +# elements: 1 +# length: 3694 + LAPLACIAN Sparse Negative Laplacian in 1D, 2D, or 3D + + [~,~,A]=LAPLACIAN(N) generates a sparse negative 3D Laplacian matrix + with Dirichlet boundary conditions, from a rectangular cuboid regular + grid with j x k x l interior grid points if N = [j k l], using the + standard 7-point finite-difference scheme, The grid size is always + one in all directions. + + [~,~,A]=LAPLACIAN(N,B) specifies boundary conditions with a cell array + B. For example, B = {'DD' 'DN' 'P'} will Dirichlet boundary conditions + ('DD') in the x-direction, Dirichlet-Neumann conditions ('DN') in the + y-direction and period conditions ('P') in the z-direction. Possible + values for the elements of B are 'DD', 'DN', 'ND', 'NN' and 'P'. + + LAMBDA = LAPLACIAN(N,B,M) or LAPLACIAN(N,M) outputs the m smallest + eigenvalues of the matrix, computed by an exact known formula, see + http://en.wikipedia.org/wiki/Eigenvalues_and_eigenvectors_of_the_second_derivative + It will produce a warning if the mth eigenvalue is equal to the + (m+1)th eigenvalue. If m is absebt or zero, lambda will be empty. + + [LAMBDA,V] = LAPLACIAN(N,B,M) also outputs orthonormal eigenvectors + associated with the corresponding m smallest eigenvalues. + + [LAMBDA,V,A] = LAPLACIAN(N,B,M) produces a 2D or 1D negative + Laplacian matrix if the length of N and B are 2 or 1 respectively. + It uses the standard 5-point scheme for 2D, and 3-point scheme for 1D. + + % Examples: + [lambda,V,A] = laplacian([100,45,55],{'DD' 'NN' 'P'}, 20); + % Everything for 3D negative Laplacian with mixed boundary conditions. + laplacian([100,45,55],{'DD' 'NN' 'P'}, 20); + % or + lambda = laplacian([100,45,55],{'DD' 'NN' 'P'}, 20); + % computes the eigenvalues only + + [~,V,~] = laplacian([200 200],{'DD' 'DN'},30); + % Eigenvectors of 2D negative Laplacian with mixed boundary conditions. + + [~,~,A] = laplacian(200,{'DN'},30); + % 1D negative Laplacian matrix A with mixed boundary conditions. + + % Example to test if outputs correct eigenvalues and vectors: + [lambda,V,A] = laplacian([13,10,6],{'DD' 'DN' 'P'},30); + [Veig D] = eig(full(A)); lambdaeig = diag(D(1:30,1:30)); + max(abs(lambda-lambdaeig)) %checking eigenvalues + subspace(V,Veig(:,1:30)) %checking the invariant subspace + subspace(V(:,1),Veig(:,1)) %checking selected eigenvectors + subspace(V(:,29:30),Veig(:,29:30)) %a multiple eigenvalue + + % Example showing equivalence between laplacian.m and built-in MATLAB + % DELSQ for the 2D case. The output of the last command shall be 0. + A1 = delsq(numgrid('S',32)); % input 'S' specifies square grid. + [~,~,A2] = laplacian([30,30]); + norm(A1-A2,inf) + + Class support for inputs: + N - row vector float double + B - cell array + M - scalar float double + + Class support for outputs: + lambda and V - full float double, A - sparse float double. + + Note: the actual numerical entries of A fit int8 format, but only + double data class is currently (2010) supported for sparse matrices. + + This program is designed to efficiently compute eigenvalues, + eigenvectors, and the sparse matrix of the (1-3)D negative Laplacian + on a rectangular grid for Dirichlet, Neumann, and Periodic boundary + conditions using tensor sums of 1D Laplacians. For more information on + tensor products, see + http://en.wikipedia.org/wiki/Kronecker_sum_of_discrete_Laplacians + For 2D case in MATLAB, see + http://www.mathworks.com/access/helpdesk/help/techdoc/ref/kron.html. + + This code is also part of the BLOPEX package: + http://en.wikipedia.org/wiki/BLOPEX or directly + http://code.google.com/p/blopex/ + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 + LAPLACIAN Sparse Negative Laplacian in 1D, 2D, or 3D + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +multinom + + +# name: +# type: sq_string +# elements: 1 +# length: 588 + -- Function File: [Y ALPHA] = multinom (X, N) + -- Function File: [Y ALPHA] = multinom (X, N,SORT) + Returns the terms (monomials) of the multinomial expansion of + degree n. + + (x1 + x2 + ... + xm)^N + + X is a nT-by-m matrix where each column represents a different + variable, the output Y has the same format. The order of the + terms is inherited from multinom_exp and can be controlled through + the optional argument SORT and is passed to the function `sort'. + The exponents are returned in ALPHA. + + See also: multinom_exp, multinom_coeff, sort + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +Returns the terms (monomials) of the multinomial expansion of degree n. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +multinom_coeff + + +# name: +# type: sq_string +# elements: 1 +# length: 937 + -- Function File: [C ALPHA] = multinom_coeff (M, N) + -- Function File: [C ALPHA] = multinom_coeff (M, N,ORDER) + Produces the coefficients of the multinomial expansion + + (x1 + x2 + ... + xm).^n + + For example, for m=3, n=3 the expansion is + + (x1+x2+x3)^3 = + = x1^3 + x2^3 + x3^3 + + + 3 x1^2 x2 + 3 x1^2 x3 + 3 x2^2 x1 + 3 x2^2 x3 + + + 3 x3^2 x1 + 3 x3^2 x2 + 6 x1 x2 x3 + + and the coefficients are [6 3 3 3 3 3 3 1 1 1]. + + The order of the coefficients is defined by the optinal argument + ORDER. It is passed to the function `multion_exp'. See the help + of that function for explanation. The multinomial coefficients + are generated using + + / \ + | n | n! + | | = ------------------------ + | k | k(1)!k(2)! ... k(end)! + \ / + + See also: multinom, multinom_exp + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Produces the coefficients of the multinomial expansion + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +multinom_exp + + +# name: +# type: sq_string +# elements: 1 +# length: 700 + -- Function File: ALPHA = multinom_exp (M, N) + -- Function File: ALPHA = multinom_exp (M, N,SORT) + Returns the exponents of the terms in the multinomial expansion + + (x1 + x2 + ... + xm).^N + + For example, for m=2, n=3 the expansion has the terms + + x1^3, x2^3, x1^2*x2, x1*x2^2 + + then `alpha = [3 0; 2 1; 1 2; 0 3]'; + + The optional argument SORT is passed to function `sort' to sort + the exponents by the maximum degree. The example above calling ` + multinom(m,n,"ascend")' produces + + `alpha = [2 1; 1 2; 3 0; 0 3]'; + + calling ` multinom(m,n,"descend")' produces + + `alpha = [3 0; 0 3; 2 1; 1 2]'; + + See also: multinom, multinom_coeff, sort + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 +Returns the exponents of the terms in the multinomial expansion + + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +psi + + +# name: +# type: sq_string +# elements: 1 +# length: 201 + -- Function File: Y = psi (X) + Compute the psi function, for each value of X. + + d + psi(x) = __ log(gamma(x)) + dx + + See also: gamma, gammainc, gammaln + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Compute the psi function, for each value of X. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +sinint + + +# name: +# type: sq_string +# elements: 1 +# length: 96 + -- Function File: Y = sinint (X) + Compute the sine integral function. + + See also: Si + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Compute the sine integral function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +zeta + + +# name: +# type: sq_string +# elements: 1 +# length: 95 + -- Function File: Z = zeta (T) + Compute the Riemann's Zeta function. + + See also: Si + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Compute the Riemann's Zeta function. + + + + + diff --git a/octave_packages/specfun-1.1.0/ellipke.m b/octave_packages/specfun-1.1.0/ellipke.m new file mode 100644 index 0000000..2f1e73a --- /dev/null +++ b/octave_packages/specfun-1.1.0/ellipke.m @@ -0,0 +1,125 @@ +## Copyright (C) 2001 David Billinghurst +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{k}, @var{e}] =} ellipke (@var{m}[,@var{tol}]) +## Compute complete elliptic integral of first K(@var{m}) and second E(@var{m}). +## +## @var{m} is either real array or scalar with 0 <= m <= 1 +## +## @var{tol} will be ignored (@sc{Matlab} uses this to allow faster, less +## accurate approximation) +## +## Ref: Abramowitz, Milton and Stegun, Irene A. Handbook of Mathematical +## Functions, Dover, 1965, Chapter 17. +## @seealso{ellipj} +## @end deftypefn + +## Author: David Billinghurst +## Created: 31 January 2001 +## 2001-02-01 Paul Kienzle +## * vectorized +## * included function name in error messages +## 2003-1-18 Jaakko Ruohio +## * extended for m < 0 + +function [k,e] = ellipke( m ) + + if (nargin < 1 || nargin > 2) + print_usage; + endif + + k = e = zeros(size(m)); + m = m(:); + if any(~isreal(m)) + error("ellipke must have real m"); + endif + if any(m>1) + error("ellipke must have m <= 1"); + endif + + Nmax = 16; + idx = find(m == 1); + if (!isempty(idx)) + k(idx) = Inf; + e(idx) = 1.0; + endif + + idx = find(m == -Inf); + if (!isempty(idx)) + k(idx) = 0.0; + e(idx) = Inf; + endif + + ## Arithmetic-Geometric Mean (AGM) algorithm + ## ( Abramowitz and Stegun, Section 17.6 ) + idx = find(m != 1 & m != -Inf); + if (!isempty(idx)) + idx_neg = find(m < 0 & m != -Inf); + mult_k = 1./sqrt(1-m(idx_neg)); + mult_e = sqrt(1-m(idx_neg)); + m(idx_neg) = -m(idx_neg)./(1-m(idx_neg)); + a = ones(length(idx),1); + b = sqrt(1.0-m(idx)); + c = sqrt(m(idx)); + f = 0.5; + sum = f*c.*c; + for n = 2:Nmax + t = (a+b)/2; + c = (a-b)/2; + b = sqrt(a.*b); + a = t; + f = f * 2; + sum = sum + f*c.*c; + if all(c./a < eps), break; endif + endfor + if n >= Nmax, error("ellipke: not enough workspace"); endif + k(idx) = 0.5*pi./a; + e(idx) = 0.5*pi.*(1.0-sum)./a; + k(idx_neg) = mult_k.*k(idx_neg); + e(idx_neg) = mult_e.*e(idx_neg); + endif + +endfunction + +%!test +%! ## Test complete elliptic functions of first and second kind +%! ## against "exact" solution from Mathematica 3.0 +%! ## +%! ## David Billinghurst +%! ## 1 February 2001 +%! m = [0.0; 0.01; 0.1; 0.5; 0.9; 0.99; 1.0 ]; +%! [k,e] = ellipke(m); +%! +%! # K(1.0) is really infinity - see below +%! K = [ +%! 1.5707963267948966192; +%! 1.5747455615173559527; +%! 1.6124413487202193982; +%! 1.8540746773013719184; +%! 2.5780921133481731882; +%! 3.6956373629898746778; +%! 0.0 ]; +%! E = [ +%! 1.5707963267948966192; +%! 1.5668619420216682912; +%! 1.5307576368977632025; +%! 1.3506438810476755025; +%! 1.1047747327040733261; +%! 1.0159935450252239356; +%! 1.0 ]; +%! if k(7)==Inf, k(7)=0.0; endif; +%! assert(K,k,8*eps); +%! assert(E,e,8*eps); diff --git a/octave_packages/specfun-1.1.0/erfcinv.m b/octave_packages/specfun-1.1.0/erfcinv.m new file mode 100644 index 0000000..16aaf73 --- /dev/null +++ b/octave_packages/specfun-1.1.0/erfcinv.m @@ -0,0 +1,27 @@ +## Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} erfcinv (@var{x}) +## Compute the inverse complementary error function. +## @seealso{erfc,erf,erfinv} +## @end deftypefn + +function y = erfcinv(x) + if (nargin != 1) + print_usage; + endif + y = erfinv(1-x); +endfunction diff --git a/octave_packages/specfun-1.1.0/expint.m b/octave_packages/specfun-1.1.0/expint.m new file mode 100644 index 0000000..20667a1 --- /dev/null +++ b/octave_packages/specfun-1.1.0/expint.m @@ -0,0 +1,34 @@ +## Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} expint (@var{x}) +## Compute the exponential integral, +## @verbatim +## infinity +## / +## expint(x) = | exp(t)/t dt +## / +## x +## @end verbatim +## @seealso{expint_E1, expint_Ei} +## @end deftypefn + +function y = expint(x) + if (nargin != 1) + print_usage; + endif + y = expint_E1(x); +endfunction diff --git a/octave_packages/specfun-1.1.0/expint_E1.m b/octave_packages/specfun-1.1.0/expint_E1.m new file mode 100644 index 0000000..8ba595e --- /dev/null +++ b/octave_packages/specfun-1.1.0/expint_E1.m @@ -0,0 +1,38 @@ +## Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} expint_E1 (@var{x}) +## Compute the exponential integral, +## @verbatim +## infinity +## / +## expint(x) = | exp(t)/t dt +## / +## x +## @end verbatim +## @seealso{expint, expint_Ei} +## @end deftypefn + +function y = expint_E1(x) + if (nargin != 1) + print_usage; + endif + y = x; + y(imag(x) > 0 & imag(x) != 0) = -expint_Ei(-y(imag(x) > 0 & imag(x) != 0)) -i.*pi; + y(imag(x) < 0 & imag(x) != 0) = -expint_Ei(-y(imag(x) < 0 & imag(x) != 0)) +i.*pi; + y(real(x) >= 0 & imag(x)==0) = -expint_Ei(-y(real(x) >= 0 & imag(x)==0)); + y(real(x) < 0 & imag(x)==0) = -expint_Ei(-y(real(x) < 0 & imag(x)==0)) -i.*pi; +endfunction diff --git a/octave_packages/specfun-1.1.0/expint_Ei.m b/octave_packages/specfun-1.1.0/expint_Ei.m new file mode 100644 index 0000000..ee972fb --- /dev/null +++ b/octave_packages/specfun-1.1.0/expint_Ei.m @@ -0,0 +1,63 @@ +## Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} expint_Ei (@var{x}) +## Compute the exponential integral, +## @verbatim +## infinity +## / +## expint_Ei(x) = - | exp(t)/t dt +## / +## -x +## @end verbatim +## @seealso{expint, expint_E1} +## @end deftypefn + +function y = expint_Ei(x) + if (nargin != 1) + print_usage; + endif + y = zeros(size(x)); + F = @(x) exp(-x)./x; + s = prod(size(x)); + for t = 1:s; + if(x(t)<0 && imag(x(t)) == 0) + y(t) = -quad(F,-x(t),Inf); + else + if(abs(x(t)) > 2 && imag(x(t)) == 0) + y(t) = expint_Ei(2) - quad(F,-x(t),-2); + else + if(abs(x(t)) >= 10) + if(imag(x(t)) <= 0) + a1 = 4.03640; + a2 = 1.15198; + b1 = 5.03637; + b2 = 4.19160; + y(t) = -(x(t).^2 - a1.*x(t) + a2)./((x(t).^2-b1.*x(t)+b2).*(-x(t)).*exp(-x(t)))-i.*pi; + else + y(t) = conj(expint_Ei(conj(x(t)))); + endif; + ## Serie Expansion + else + for k = 1:100; + y(t) = y(t) + x(t).^k./(k.*factorial(k)); + endfor + y(t) = 0.577215664901532860606512090082402431 + log(x(t)) + y(t); + endif + endif + endif + endfor +endfunction diff --git a/octave_packages/specfun-1.1.0/heaviside.m b/octave_packages/specfun-1.1.0/heaviside.m new file mode 100644 index 0000000..fcd0f77 --- /dev/null +++ b/octave_packages/specfun-1.1.0/heaviside.m @@ -0,0 +1,41 @@ +## Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} heaviside(@var{x}) +## @deftypefnx{Function File} {} heaviside(@var{x}, @var{zero_value}) +## Compute the Heaviside step function. +## +## The Heaviside function is defined as +## +## @example +## Heaviside (@var{x}) = 1, @var{x} > 0 +## Heaviside (@var{x}) = 0, @var{x} < 0 +## @end example +## +## @noindent +## The value of the Heaviside function at @var{x} = 0 is by default 0.5, +## but can be changed via the optional second input argument. +## @seealso{dirac} +## @end deftypefn + +function y = heaviside (x, zero_value = 0.5) + if (nargin < 1) + print_usage (); + endif + + y = cast (x > 0, class (x)); + y (x == 0) = zero_value; +endfunction diff --git a/octave_packages/specfun-1.1.0/laguerre.m b/octave_packages/specfun-1.1.0/laguerre.m new file mode 100644 index 0000000..a6b5f36 --- /dev/null +++ b/octave_packages/specfun-1.1.0/laguerre.m @@ -0,0 +1,91 @@ +## Copyright (C) 2008 Eric Chassande-Mottin +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} = } laguerre (@var{x},@var{n}) +## @deftypefnx {Function File} {[@var{y} @var{p}]= } laguerre (@var{x},@var{n}) +## +## Compute the value of the Laguerre polynomial of order @var{n} for each element of @var{x} +## +## @end deftypefn + +function [y,p]=laguerre(x,n) + + if (nargin != 2) + print_usage; + elseif (n < 0 || !isscalar (n)) + error("second argument 'n' must be a positive integer"); + endif + + p0=1; + p1=[-1 1]; + + if (n==0) + p=p0; + elseif (n==1) + p=p1; + elseif (n > 1) + % recursive calculation of the polynomial coefficients + for k=2:n + p=zeros(1,k+1); + p(1) = -p1(1)/k; + p(2) = ((2*k-1)*p1(1)-p1(2))/k; + if (k > 2) + p(3:k) = ((2*k-1)*p1(2:k-1)-p1(3:k)-(k-1)*p0(1:k-2))/k; + endif + p(k+1) = ((2*k-1)*p1(k)-(k-1)*p0(k-1))/k; + p0=p1; + p1=p; + endfor + endif + + y=polyval(p,x); + +endfunction + +%!test +%! x=rand; +%! y1=laguerre(x,0); +%! p0=[1]; +%! y2=polyval(p0,x); +%! assert(y1-y2,0,eps); + +%!test +%! x=rand; +%! y1=laguerre(x,1); +%! p1=[-1 1]; +%! y2=polyval(p1,x); +%! assert(y1-y2,0,eps); + +%!test +%! x=rand; +%! y1=laguerre(x,2); +%! p2=[.5 -2 1]; +%! y2=polyval(p2,x); +%! assert(y1-y2,0,eps); + +%!test +%! x=rand; +%! y1=laguerre(x,3); +%! p3=[-1/6 9/6 -18/6 1]; +%! y2=polyval(p3,x); +%! assert(y1-y2,0,eps); + +%!test +%! x=rand; +%! y1=laguerre(x,4); +%! p4=[1/24 -16/24 72/24 -96/24 1]; +%! y2=polyval(p4,x); +%! assert(y1-y2,0,eps); diff --git a/octave_packages/specfun-1.1.0/lambertw.m b/octave_packages/specfun-1.1.0/lambertw.m new file mode 100644 index 0000000..1454a05 --- /dev/null +++ b/octave_packages/specfun-1.1.0/lambertw.m @@ -0,0 +1,101 @@ +%% Copyright (C) 1998 by Nicol N. Schraudolph +%% +%% This program is free software; you can redistribute and/or +%% modify it under the terms of the GNU General Public +%% License as published by the Free Software Foundation; +%% either version 3, 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{x} = } lambertw (@var{z}) +## @deftypefnx {Function File} {@var{x} = } lambertw (@var{z}, @var{n}) +## Compute the Lambert W function of @var{z}. +## +## This function satisfies W(z).*exp(W(z)) = z, and can thus be used to express +## solutions of transcendental equations involving exponentials or logarithms. +## +## @var{n} must be integer, and specifies the branch of W to be computed; +## W(z) is a shorthand for W(0,z), the principal branch. Branches +## 0 and -1 are the only ones that can take on non-complex values. +## +## If either @var{n} or @var{z} are non-scalar, the function is mapped to each +## element; both may be non-scalar provided their dimensions agree. +## +## This implementation should return values within 2.5*eps of its +## counterpart in Maple V, release 3 or later. Please report any +## discrepancies to the author, Nici Schraudolph . +## +## For further details, see: +## +## Corless, Gonnet, Hare, Jeffrey, and Knuth (1996), `On the Lambert +## W Function', Advances in Computational Mathematics 5(4):329-359. +## @end deftypefn + +%% Author: Nicol N. Schraudolph +%% Version: 1.0 +%% Created: 07 Aug 1998 +%% Keywords: Lambert W Omega special transcendental function + +function w = lambertw(b,z) + if (nargin == 1) + z = b; + b = 0; + else + %% some error checking + if (nargin != 2) + print_usage; + else + if (any(round(real(b)) != b)) + usage('branch number for lambertw must be integer') + end + end + end + + %% series expansion about -1/e + % + % p = (1 - 2*abs(b)).*sqrt(2*e*z + 2); + % w = (11/72)*p; + % w = (w - 1/3).*p; + % w = (w + 1).*p - 1 + % + % first-order version suffices: + % + w = (1 - 2*abs(b)).*sqrt(2*e*z + 2) - 1; + + %% asymptotic expansion at 0 and Inf + % + v = log(z + ~(z | b)) + 2*pi*I*b; + v = v - log(v + ~v); + + %% choose strategy for initial guess + % + c = abs(z + 1/e); + c = (c > 1.45 - 1.1*abs(b)); + c = c | (b.*imag(z) > 0) | (~imag(z) & (b == 1)); + w = (1 - c).*w + c.*v; + + %% Halley iteration + % + for n = 1:10 + p = exp(w); + t = w.*p - z; + f = (w != -1); + t = f.*t./(p.*(w + f) - 0.5*(w + 2.0).*t./(w + f)); + w = w - t; + if (abs(real(t)) < (2.48*eps)*(1.0 + abs(real(w))) + && abs(imag(t)) < (2.48*eps)*(1.0 + abs(imag(w)))) + return + end + end + warning('iteration limit reached, result of lambertw may be inaccurate'); +end + diff --git a/octave_packages/specfun-1.1.0/laplacian.m b/octave_packages/specfun-1.1.0/laplacian.m new file mode 100644 index 0000000..06f73e9 --- /dev/null +++ b/octave_packages/specfun-1.1.0/laplacian.m @@ -0,0 +1,495 @@ +## Copyright (c) 2010-2011 Andrew V. Knyazev +## Copyright (c) 2010-2011 Bryan C. Smith +## 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 nor the +## names of its contributors may be used to endorse or promote products +## derived from this software without specific prior written permission. +## +## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +## ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +## WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +## DISCLAIMED. IN NO EVENT SHALL 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. + +% LAPLACIAN Sparse Negative Laplacian in 1D, 2D, or 3D +% +% [~,~,A]=LAPLACIAN(N) generates a sparse negative 3D Laplacian matrix +% with Dirichlet boundary conditions, from a rectangular cuboid regular +% grid with j x k x l interior grid points if N = [j k l], using the +% standard 7-point finite-difference scheme, The grid size is always +% one in all directions. +% +% [~,~,A]=LAPLACIAN(N,B) specifies boundary conditions with a cell array +% B. For example, B = {'DD' 'DN' 'P'} will Dirichlet boundary conditions +% ('DD') in the x-direction, Dirichlet-Neumann conditions ('DN') in the +% y-direction and period conditions ('P') in the z-direction. Possible +% values for the elements of B are 'DD', 'DN', 'ND', 'NN' and 'P'. +% +% LAMBDA = LAPLACIAN(N,B,M) or LAPLACIAN(N,M) outputs the m smallest +% eigenvalues of the matrix, computed by an exact known formula, see +% http://en.wikipedia.org/wiki/Eigenvalues_and_eigenvectors_of_the_second_derivative +% It will produce a warning if the mth eigenvalue is equal to the +% (m+1)th eigenvalue. If m is absebt or zero, lambda will be empty. +% +% [LAMBDA,V] = LAPLACIAN(N,B,M) also outputs orthonormal eigenvectors +% associated with the corresponding m smallest eigenvalues. +% +% [LAMBDA,V,A] = LAPLACIAN(N,B,M) produces a 2D or 1D negative +% Laplacian matrix if the length of N and B are 2 or 1 respectively. +% It uses the standard 5-point scheme for 2D, and 3-point scheme for 1D. +% +% % Examples: +% [lambda,V,A] = laplacian([100,45,55],{'DD' 'NN' 'P'}, 20); +% % Everything for 3D negative Laplacian with mixed boundary conditions. +% laplacian([100,45,55],{'DD' 'NN' 'P'}, 20); +% % or +% lambda = laplacian([100,45,55],{'DD' 'NN' 'P'}, 20); +% % computes the eigenvalues only +% +% [~,V,~] = laplacian([200 200],{'DD' 'DN'},30); +% % Eigenvectors of 2D negative Laplacian with mixed boundary conditions. +% +% [~,~,A] = laplacian(200,{'DN'},30); +% % 1D negative Laplacian matrix A with mixed boundary conditions. +% +% % Example to test if outputs correct eigenvalues and vectors: +% [lambda,V,A] = laplacian([13,10,6],{'DD' 'DN' 'P'},30); +% [Veig D] = eig(full(A)); lambdaeig = diag(D(1:30,1:30)); +% max(abs(lambda-lambdaeig)) %checking eigenvalues +% subspace(V,Veig(:,1:30)) %checking the invariant subspace +% subspace(V(:,1),Veig(:,1)) %checking selected eigenvectors +% subspace(V(:,29:30),Veig(:,29:30)) %a multiple eigenvalue +% +% % Example showing equivalence between laplacian.m and built-in MATLAB +% % DELSQ for the 2D case. The output of the last command shall be 0. +% A1 = delsq(numgrid('S',32)); % input 'S' specifies square grid. +% [~,~,A2] = laplacian([30,30]); +% norm(A1-A2,inf) +% +% Class support for inputs: +% N - row vector float double +% B - cell array +% M - scalar float double +% +% Class support for outputs: +% lambda and V - full float double, A - sparse float double. +% +% Note: the actual numerical entries of A fit int8 format, but only +% double data class is currently (2010) supported for sparse matrices. +% +% This program is designed to efficiently compute eigenvalues, +% eigenvectors, and the sparse matrix of the (1-3)D negative Laplacian +% on a rectangular grid for Dirichlet, Neumann, and Periodic boundary +% conditions using tensor sums of 1D Laplacians. For more information on +% tensor products, see +% http://en.wikipedia.org/wiki/Kronecker_sum_of_discrete_Laplacians +% For 2D case in MATLAB, see +% http://www.mathworks.com/access/helpdesk/help/techdoc/ref/kron.html. +% +% This code is also part of the BLOPEX package: +% http://en.wikipedia.org/wiki/BLOPEX or directly +% http://code.google.com/p/blopex/ + +% Revision 1.1 changes: rearranged the output variables, always compute +% the eigenvalues, compute eigenvectors and/or the matrix on demand only. + +% $Revision: 1.1 $ $Date: 1-Aug-2011 +% Tested in MATLAB 7.11.0 (R2010b) and Octave 3.4.0. + +function [lambda, V, A] = laplacian(varargin) + + % Input/Output handling. + if (nargin < 1 || nargin > 3) + print_usage; + endif + + u = varargin{1}; + dim2 = size(u); + if dim2(1) ~= 1 + error('BLOPEX:laplacian:WrongVectorOfGridPoints',... + '%s','Number of grid points must be in a row vector.') + end + if dim2(2) > 3 + error('BLOPEX:laplacian:WrongNumberOfGridPoints',... + '%s','Number of grid points must be a 1, 2, or 3') + end + dim=dim2(2); clear dim2; + + uint = round(u); + if max(uint~=u) + warning('BLOPEX:laplacian:NonIntegerGridSize',... + '%s','Grid sizes must be integers. Rounding...'); + u = uint; clear uint + end + if max(u<=0 ) + error('BLOPEX:laplacian:NonIntegerGridSize',... + '%s','Grid sizes must be positive.'); + end + + if nargin == 3 + m = varargin{3}; + B = varargin{2}; + elseif nargin == 2 + f = varargin{2}; + a = whos('regep','f'); + if sum(a.class(1:4)=='cell') == 4 + B = f; + m = 0; + elseif sum(a.class(1:4)=='doub') == 4 + if dim == 1 + B = {'DD'}; + elseif dim == 2 + B = {'DD' 'DD'}; + else + B = {'DD' 'DD' 'DD'}; + end + m = f; + else + error('BLOPEX:laplacian:InvalidClass',... + '%s','Second input must be either class double or a cell array.'); + end + else + if dim == 1 + B = {'DD'}; + elseif dim == 2 + B = {'DD' 'DD'}; + else + B = {'DD' 'DD' 'DD'}; + end + m = 0; + end + + if max(size(m) - [1 1]) ~= 0 + error('BLOPEX:laplacian:WrongNumberOfEigenvalues',... + '%s','The requested number of eigenvalues must be a scalar.'); + end + + maxeigs = prod(u); + mint = round(m); + if mint ~= m || mint > maxeigs + error('BLOPEX:laplacian:InvalidNumberOfEigs',... + '%s','Number of eigenvalues output must be a nonnegative ',... + 'integer no bigger than number of grid points.'); + end + m = mint; + + bdryerr = 0; + a = whos('regep','B'); + if sum(a.class(1:4)=='cell') ~= 4 || sum(a.size == [1 dim]) ~= 2 + bdryerr = 1; + else + BB = zeros(1, 2*dim); + for i = 1:dim + if (length(B{i}) == 1) + if B{i} == 'P' + BB(i) = 3; + BB(i + dim) = 3; + else + bdryerr = 1; + end + elseif (length(B{i}) == 2) + if B{i}(1) == 'D' + BB(i) = 1; + elseif B{i}(1) == 'N' + BB(i) = 2; + else + bdryerr = 1; + end + if B{i}(2) == 'D' + BB(i + dim) = 1; + elseif B{i}(2) == 'N' + BB(i + dim) = 2; + else + bdryerr = 1; + end + else + bdryerr = 1; + end + end + end + + if bdryerr == 1 + error('BLOPEX:laplacian:InvalidBdryConds',... + '%s','Boundary conditions must be a cell of length 3 for 3D, 2',... + ' for 2D, 1 for 1D, with values ''DD'', ''DN'', ''ND'', ''NN''',... + ', or ''P''.'); + end + + % Set the component matrices. SPDIAGS converts int8 into double anyway. + e1 = ones(u(1),1); %e1 = ones(u(1),1,'int8'); + if dim > 1 + e2 = ones(u(2),1); + end + if dim > 2 + e3 = ones(u(3),1); + end + + % Calculate m smallest exact eigenvalues. + if m > 0 + if (BB(1) == 1) && (BB(1+dim) == 1) + a1 = pi/2/(u(1)+1); + N = (1:u(1))'; + elseif (BB(1) == 2) && (BB(1+dim) == 2) + a1 = pi/2/u(1); + N = (0:(u(1)-1))'; + elseif ((BB(1) == 1) && (BB(1+dim) == 2)) || ((BB(1) == 2)... + && (BB(1+dim) == 1)) + a1 = pi/4/(u(1)+0.5); + N = 2*(1:u(1))' - 1; + else + a1 = pi/u(1); + N = floor((1:u(1))/2)'; + end + + lambda1 = 4*sin(a1*N).^2; + + if dim > 1 + if (BB(2) == 1) && (BB(2+dim) == 1) + a2 = pi/2/(u(2)+1); + N = (1:u(2))'; + elseif (BB(2) == 2) && (BB(2+dim) == 2) + a2 = pi/2/u(2); + N = (0:(u(2)-1))'; + elseif ((BB(2) == 1) && (BB(2+dim) == 2)) || ((BB(2) == 2)... + && (BB(2+dim) == 1)) + a2 = pi/4/(u(2)+0.5); + N = 2*(1:u(2))' - 1; + else + a2 = pi/u(2); + N = floor((1:u(2))/2)'; + end + lambda2 = 4*sin(a2*N).^2; + else + lambda2 = 0; + end + + if dim > 2 + if (BB(3) == 1) && (BB(6) == 1) + a3 = pi/2/(u(3)+1); + N = (1:u(3))'; + elseif (BB(3) == 2) && (BB(6) == 2) + a3 = pi/2/u(3); + N = (0:(u(3)-1))'; + elseif ((BB(3) == 1) && (BB(6) == 2)) || ((BB(3) == 2)... + && (BB(6) == 1)) + a3 = pi/4/(u(3)+0.5); + N = 2*(1:u(3))' - 1; + else + a3 = pi/u(3); + N = floor((1:u(3))/2)'; + end + lambda3 = 4*sin(a3*N).^2; + else + lambda3 = 0; + end + + if dim == 1 + lambda = lambda1; + elseif dim == 2 + lambda = kron(e2,lambda1) + kron(lambda2, e1); + else + lambda = kron(e3,kron(e2,lambda1)) + kron(e3,kron(lambda2,e1))... + + kron(lambda3,kron(e2,e1)); + end + [lambda, p] = sort(lambda); + if m < maxeigs - 0.1 + w = lambda(m+1); + else + w = inf; + end + lambda = lambda(1:m); + p = p(1:m)'; + else + lambda = []; + end + + V = []; + if nargout > 1 && m > 0 % Calculate eigenvectors if specified in output. + + p1 = mod(p-1,u(1))+1; + + if (BB(1) == 1) && (BB(1+dim) == 1) + V1 = sin(kron((1:u(1))'*(pi/(u(1)+1)),p1))*(2/(u(1)+1))^0.5; + elseif (BB(1) == 2) && (BB(1+dim) == 2) + V1 = cos(kron((0.5:1:u(1)-0.5)'*(pi/u(1)),p1-1))*(2/u(1))^0.5; + V1(:,p1==1) = 1/u(1)^0.5; + elseif ((BB(1) == 1) && (BB(1+dim) == 2)) + V1 = sin(kron((1:u(1))'*(pi/2/(u(1)+0.5)),2*p1 - 1))... + *(2/(u(1)+0.5))^0.5; + elseif ((BB(1) == 2) && (BB(1+dim) == 1)) + V1 = cos(kron((0.5:1:u(1)-0.5)'*(pi/2/(u(1)+0.5)),2*p1 - 1))... + *(2/(u(1)+0.5))^0.5; + else + V1 = zeros(u(1),m); + a = (0.5:1:u(1)-0.5)'; + V1(:,mod(p1,2)==1) = cos(a*(pi/u(1)*(p1(mod(p1,2)==1)-1)))... + *(2/u(1))^0.5; + pp = p1(mod(p1,2)==0); + if ~isempty(pp) + V1(:,mod(p1,2)==0) = sin(a*(pi/u(1)*p1(mod(p1,2)==0)))... + *(2/u(1))^0.5; + end + V1(:,p1==1) = 1/u(1)^0.5; + if mod(u(1),2) == 0 + V1(:,p1==u(1)) = V1(:,p1==u(1))/2^0.5; + end + end + + + if dim > 1 + p2 = mod(p-p1,u(1)*u(2)); + p3 = (p - p2 - p1)/(u(1)*u(2)) + 1; + p2 = p2/u(1) + 1; + if (BB(2) == 1) && (BB(2+dim) == 1) + V2 = sin(kron((1:u(2))'*(pi/(u(2)+1)),p2))*(2/(u(2)+1))^0.5; + elseif (BB(2) == 2) && (BB(2+dim) == 2) + V2 = cos(kron((0.5:1:u(2)-0.5)'*(pi/u(2)),p2-1))*(2/u(2))^0.5; + V2(:,p2==1) = 1/u(2)^0.5; + elseif ((BB(2) == 1) && (BB(2+dim) == 2)) + V2 = sin(kron((1:u(2))'*(pi/2/(u(2)+0.5)),2*p2 - 1))... + *(2/(u(2)+0.5))^0.5; + elseif ((BB(2) == 2) && (BB(2+dim) == 1)) + V2 = cos(kron((0.5:1:u(2)-0.5)'*(pi/2/(u(2)+0.5)),2*p2 - 1))... + *(2/(u(2)+0.5))^0.5; + else + V2 = zeros(u(2),m); + a = (0.5:1:u(2)-0.5)'; + V2(:,mod(p2,2)==1) = cos(a*(pi/u(2)*(p2(mod(p2,2)==1)-1)))... + *(2/u(2))^0.5; + pp = p2(mod(p2,2)==0); + if ~isempty(pp) + V2(:,mod(p2,2)==0) = sin(a*(pi/u(2)*p2(mod(p2,2)==0)))... + *(2/u(2))^0.5; + end + V2(:,p2==1) = 1/u(2)^0.5; + if mod(u(2),2) == 0 + V2(:,p2==u(2)) = V2(:,p2==u(2))/2^0.5; + end + end + else + V2 = ones(1,m); + end + + if dim > 2 + if (BB(3) == 1) && (BB(3+dim) == 1) + V3 = sin(kron((1:u(3))'*(pi/(u(3)+1)),p3))*(2/(u(3)+1))^0.5; + elseif (BB(3) == 2) && (BB(3+dim) == 2) + V3 = cos(kron((0.5:1:u(3)-0.5)'*(pi/u(3)),p3-1))*(2/u(3))^0.5; + V3(:,p3==1) = 1/u(3)^0.5; + elseif ((BB(3) == 1) && (BB(3+dim) == 2)) + V3 = sin(kron((1:u(3))'*(pi/2/(u(3)+0.5)),2*p3 - 1))... + *(2/(u(3)+0.5))^0.5; + elseif ((BB(3) == 2) && (BB(3+dim) == 1)) + V3 = cos(kron((0.5:1:u(3)-0.5)'*(pi/2/(u(3)+0.5)),2*p3 - 1))... + *(2/(u(3)+0.5))^0.5; + else + V3 = zeros(u(3),m); + a = (0.5:1:u(3)-0.5)'; + V3(:,mod(p3,2)==1) = cos(a*(pi/u(3)*(p3(mod(p3,2)==1)-1)))... + *(2/u(3))^0.5; + pp = p1(mod(p3,2)==0); + if ~isempty(pp) + V3(:,mod(p3,2)==0) = sin(a*(pi/u(3)*p3(mod(p3,2)==0)))... + *(2/u(3))^0.5; + end + V3(:,p3==1) = 1/u(3)^0.5; + if mod(u(3),2) == 0 + V3(:,p3==u(3)) = V3(:,p3==u(3))/2^0.5; + end + + end + else + V3 = ones(1,m); + end + + if dim == 1 + V = V1; + elseif dim == 2 + V = kron(e2,V1).*kron(V2,e1); + else + V = kron(e3, kron(e2, V1)).*kron(e3, kron(V2, e1))... + .*kron(kron(V3,e2),e1); + end + + if m ~= 0 + if abs(lambda(m) - w) < maxeigs*eps('double') + sprintf('\n%s','Warning: (m+1)th eigenvalue is nearly equal',... + ' to mth.') + + end + end + + end + + A = []; + if nargout > 2 %also calulate the matrix if specified in the output + + % Set the component matrices. SPDIAGS converts int8 into double anyway. + % e1 = ones(u(1),1); %e1 = ones(u(1),1,'int8'); + D1x = spdiags([-e1 2*e1 -e1], [-1 0 1], u(1),u(1)); + if dim > 1 + % e2 = ones(u(2),1); + D1y = spdiags([-e2 2*e2 -e2], [-1 0 1], u(2),u(2)); + end + if dim > 2 + % e3 = ones(u(3),1); + D1z = spdiags([-e3 2*e3 -e3], [-1 0 1], u(3),u(3)); + end + + + % Set boundary conditions if other than Dirichlet. + for i = 1:dim + if BB(i) == 2 + eval(['D1' char(119 + i) '(1,1) = 1;']) + elseif BB(i) == 3 + eval(['D1' char(119 + i) '(1,' num2str(u(i)) ') = D1'... + char(119 + i) '(1,' num2str(u(i)) ') -1;']); + eval(['D1' char(119 + i) '(' num2str(u(i)) ',1) = D1'... + char(119 + i) '(' num2str(u(i)) ',1) -1;']); + end + + if BB(i+dim) == 2 + eval(['D1' char(119 + i)... + '(',num2str(u(i)),',',num2str(u(i)),') = 1;']) + end + end + + % Form A using tensor products of lower dimensional Laplacians + Ix = speye(u(1)); + if dim == 1 + A = D1x; + elseif dim == 2 + Iy = speye(u(2)); + A = kron(Iy,D1x) + kron(D1y,Ix); + elseif dim == 3 + Iy = speye(u(2)); + Iz = speye(u(3)); + A = kron(Iz, kron(Iy, D1x)) + kron(Iz, kron(D1y, Ix))... + + kron(kron(D1z,Iy),Ix); + end + end + + disp(' ') + if ~isempty(V) + a = whos('regep','V'); + disp(['The eigenvectors take ' num2str(a.bytes) ' bytes']) + end + if ~isempty(A) + a = whos('regexp','A'); + disp(['The Laplacian matrix takes ' num2str(a.bytes) ' bytes']) + end + disp(' ') +endfunction diff --git a/octave_packages/specfun-1.1.0/multinom.m b/octave_packages/specfun-1.1.0/multinom.m new file mode 100644 index 0000000..0080af1 --- /dev/null +++ b/octave_packages/specfun-1.1.0/multinom.m @@ -0,0 +1,67 @@ +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{y} @var{alpha}] =} multinom (@var{x}, @var{n}) +%% @deftypefnx {Function File} {[@var{y} @var{alpha}] =} multinom (@var{x}, @var{n},@var{sort}) +%% +%% Returns the terms (monomials) of the multinomial expansion of degree n. +%% @tex +%% $$ +%% (x_1 + x_2 + ... + x_m)^N +%% $$ +%% @end tex +%% @ifnottex +%% +%% @example +%% (x1 + x2 + ... + xm)^@var{n} +%% @end example +%% +%% @end ifnottex +%% +%% @var{x} is a nT-by-m matrix where each column represents a different variable, the +%% output @var{y} has the same format. +%% The order of the terms is inherited from multinom_exp and can be controlled +%% through the optional argument @var{sort} and is passed to the function @code{sort}. +%% The exponents are returned in @var{alpha}. +%% +%% @seealso{multinom_exp, multinom_coeff, sort} +%% @end deftypefn + +function [y, alpha] = multinom(x,n,sortmethod) + + [nT, m] = size(x); + if nargin > 2 + alpha = multinom_exp(m,n,sortmethod); + else + alpha = multinom_exp(m,n); + end + na = size(alpha,1); + + y = prod(repmat(x,na,1).^kron(alpha,ones(nT,1)),2); + y = reshape(y,nT,na); + +end + +%!demo +%! n = 3; +%! t = linspace(-1,1,10).'; +%! x = [t-1/2, t]; +%! y = multinom(x,n,'descend'); +%! y_shouldbe = [x(:,1).^3 x(:,2).^3 x(:,1).^2.*x(:,2) x(:,1).*x(:,2).^2 ]; +%! plot(t,y_shouldbe); hold on; plot(t,y,'s'); hold off; +%! legend('x_1^3','x_2^3','x_1^2x_2','x_1x_2^2','location','southoutside',... +%! 'orientation','horizontal'); +%! title('Terms of the expansion of (x_1 + x_2)^3 (colors should match)'); diff --git a/octave_packages/specfun-1.1.0/multinom_coeff.m b/octave_packages/specfun-1.1.0/multinom_coeff.m new file mode 100644 index 0000000..c19e956 --- /dev/null +++ b/octave_packages/specfun-1.1.0/multinom_coeff.m @@ -0,0 +1,104 @@ +%% Copyright (c) 2011 Jordi Gutiérrez Hermoso +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{c} @var{alpha}] =} multinom_coeff (@var{m}, @var{n}) +%% @deftypefnx {Function File} {[@var{c} @var{alpha}] =} multinom_coeff (@var{m}, @var{n},@var{order}) +%% Produces the coefficients of the multinomial expansion +%% @tex +%% $$ +%% (x1 + x2 + ... + xm).^n +%% $$ +%% @end tex +%% @ifnottex +%% +%% @example +%% (x1 + x2 + ... + xm).^n +%% @end example +%% +%% @end ifnottex +%% +%% For example, for m=3, n=3 the expansion is +%% @tex +%% $$ +%% (x1+x2+x3)^3 = +%% = x1^3 + x2^3 + x3^3 + 3 x1^2 x2 + 3 x1^2 x3 + 3 x2^2 x1 + 3 x2^2 x3 + +%% + 3 x3^2 x1 + 3 x3^2 x2 + 6 x1 x2 x3 +%% $$ +%% @end tex +%% @ifnottex +%% +%% @example +%% @group +%% (x1+x2+x3)^3 = +%% = x1^3 + x2^3 + x3^3 + +%% + 3 x1^2 x2 + 3 x1^2 x3 + 3 x2^2 x1 + 3 x2^2 x3 + +%% + 3 x3^2 x1 + 3 x3^2 x2 + 6 x1 x2 x3 +%% @end group +%% @end example +%% +%% @end ifnottex +%% +%% and the coefficients are [6 3 3 3 3 3 3 1 1 1]. +%% +%% The order of the coefficients is defined by the optinal argument @var{order}. +%% It is passed to the function @code{multion_exp}. See the help of that +%% function for explanation. +%% The multinomial coefficients are generated using +%% @tex +%% $$ +%% {n \choose k} = \frac{n!}{k(1)!k(2)! \cdots k(\text{end})!} +%% $$ +%% @end tex +%% @ifnottex +%% +%% @example +%% @group +%% / \ +%% | n | n! +%% | | = ------------------------ +%% | k | k(1)!k(2)! @dots{} k(end)! +%% \ / +%% @end group +%% @end example +%% +%% @end ifnottex +%% +%% @seealso{multinom,multinom_exp} +%% +%% @end deftypefn + +function [c, alpha] = multinom_coeff(m,n,sortmethod) + + if nargin > 2 + alpha = multinom_exp(m,n,sortmethod); + else + alpha = multinom_exp(m,n); + end + + %% Multinomial coefficients + %% number of ways of depositing n distinct objects into m distinct bins, + %% with k1 objects in the first bin, k2 objects in the second bin, and so on + %% JPi: I guess it can be improved + %% Simplification thanks to Jordi G. H. + c = factorial(n)./prod(factorial(alpha),2); + +end + +%!demo +%! multinom_coeff(3,3) +%! multinom_coeff(3,3,'ascend') +%! multinom_coeff(3,3,'descend') diff --git a/octave_packages/specfun-1.1.0/multinom_exp.m b/octave_packages/specfun-1.1.0/multinom_exp.m new file mode 100644 index 0000000..2334759 --- /dev/null +++ b/octave_packages/specfun-1.1.0/multinom_exp.m @@ -0,0 +1,92 @@ +%% Copyright (c) 2011 Jordi Gutiérrez Hermoso +%% Copyright (c) 2011 Juan Pablo Carbajal +%% +%% This program is free software: you can redistribute it and/or modify +%% it under the terms of the GNU General Public License as published by +%% the Free Software Foundation, either version 3 of the License, or +%% 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{alpha} =} multinom_exp (@var{m}, @var{n}) +%% @deftypefnx {Function File} {@var{alpha} =} multinom_exp (@var{m}, @var{n},@var{sort}) +%% Returns the exponents of the terms in the multinomial expansion +%% @tex +%% $$ +%% (x_1 + x_2 + ... + x_m).^n +%% $$ +%% @end tex +%% @ifnottex +%% +%% @example +%% (x1 + x2 + ... + xm).^@var{n} +%% @end example +%% +%% @end ifnottex +%% +%% For example, for m=2, n=3 the expansion has the terms +%% @tex +%% $$ +%% x1^3, x2^3, x1^2*x2, x1*x2^2 +%% $$ +%% @end tex +%% @ifnottex +%% +%% @example +%% x1^3, x2^3, x1^2*x2, x1*x2^2 +%% @end example +%% +%% @end ifnottex +%% +%% then @code{alpha = [3 0; 2 1; 1 2; 0 3]}; +%% +%% The optional argument @var{sort} is passed to function @code{sort} to +%% sort the exponents by the maximum degree. +%% The example above calling @code{ multinom(m,n,"ascend")} produces +%% +%% @code{alpha = [2 1; 1 2; 3 0; 0 3]}; +%% +%% calling @code{ multinom(m,n,"descend")} produces +%% +%% @code{alpha = [3 0; 0 3; 2 1; 1 2]}; +%% +%% @seealso{multinom, multinom_coeff, sort} +%% @end deftypefn + +function alpha = multinom_exp(m, n, sortmethod) + + %% This is standard stars and bars. + numsymbols = m+n-1; + stars = nchoosek (1:numsymbols, n); + + %% Star labels minus their consecutive position becomes their index + %% position! + idx = bsxfun (@minus, stars, [0:n-1]); + + %% Manipulate indices into the proper shape for accumarray. + nr = size (idx, 1); + a = repmat ([1:nr], n, 1); + b = idx'; + idx = [a(:), b(:)]; + + alpha = accumarray (idx, 1); + + if nargin > 2 + [~, idx] = sort (max (alpha, [], 2), 1, sortmethod); + alpha = alpha(idx, :); + end +end + +%!demo +%! m=2; +%! n=3; +%! alpha = multinom_exp(m,n) +%! alpha_asc = multinom_exp(m,n,'ascend') +%! alpha_dec = multinom_exp(m,n,'descend') diff --git a/octave_packages/specfun-1.1.0/packinfo/.autoload b/octave_packages/specfun-1.1.0/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/specfun-1.1.0/packinfo/DESCRIPTION b/octave_packages/specfun-1.1.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..68c0ffb --- /dev/null +++ b/octave_packages/specfun-1.1.0/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: Specfun +Version: 1.1.0 +Date: 2011-12-15 +Author: Various Authors +Maintainer: The Octave Community +Title: Specfun +Description: Special functions including ellipitic functions, etc +Categories: Specfun +Depends: octave (>= 3.4.0) +Autoload: yes +License: GPL version 3 or later and Modified BSD (see individual files) +Url: http://octave.sf.net diff --git a/octave_packages/specfun-1.1.0/packinfo/INDEX b/octave_packages/specfun-1.1.0/packinfo/INDEX new file mode 100644 index 0000000..82f330d --- /dev/null +++ b/octave_packages/specfun-1.1.0/packinfo/INDEX @@ -0,0 +1,22 @@ +specfun >> Specfun +Specfun + Ci + Si + cosint + dirac + ellipke + erfcinv + expint + expint_E1 + expint_Ei + heaviside + laguerre + lambertw + laplacian + multinom + multinom_coeff + multinom_exp + psi + sinint + zeta + ellipj diff --git a/octave_packages/specfun-1.1.0/packinfo/NEWS b/octave_packages/specfun-1.1.0/packinfo/NEWS new file mode 100644 index 0000000..4879b27 --- /dev/null +++ b/octave_packages/specfun-1.1.0/packinfo/NEWS @@ -0,0 +1,16 @@ +Summary of important user-visible changes for specfun 1.1.0: +------------------------------------------------------------------- + + ** The following functions are new: + + laplacian multinom multinom_coeff multinom_exp + + ** The following function was removed since it is now part of + GNU octave core: + + erfcx + + ** Help text of most functions has been improved + + ** The function `ellipj' was replaced by a C++ implementation that + should perform faster. diff --git a/octave_packages/specfun-1.1.0/psi.m b/octave_packages/specfun-1.1.0/psi.m new file mode 100644 index 0000000..80e69be --- /dev/null +++ b/octave_packages/specfun-1.1.0/psi.m @@ -0,0 +1,43 @@ +# Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} = } psi (@var{x}) +## Compute the psi function, for each value of @var{x}. +## +## @verbatim +## d +## psi(x) = __ log(gamma(x)) +## dx +## @end verbatim +## +## @seealso{gamma, gammainc, gammaln} +## @end deftypefn + +function [y] = psi (x) + + if (nargin != 1) + print_usage; + elseif (imag(x) != zeros(size(x))) + error("unable to handle complex arguments"); + endif + + h = 1e-9; + y = x; + y(x == 0) = -Inf; + y(x>0) = (gammaln(y(x>0)+h)-gammaln(y(x>0)-h))./(2.*h); + y(x<0) = (gammaln((1-y(x<0))+h)-gammaln((1-y(x<0))-h))./(2.*h) + pi.*cot(pi.*(1-y(x<0))); + +endfunction diff --git a/octave_packages/specfun-1.1.0/sinint.m b/octave_packages/specfun-1.1.0/sinint.m new file mode 100644 index 0000000..ffbf43b --- /dev/null +++ b/octave_packages/specfun-1.1.0/sinint.m @@ -0,0 +1,24 @@ +## Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} sinint (@var{x}) +## Compute the sine integral function. +## @seealso{Si} +## @end deftypefn + +function y = sinint (x) + y = Si (x); +endfunction diff --git a/octave_packages/specfun-1.1.0/zeta.m b/octave_packages/specfun-1.1.0/zeta.m new file mode 100644 index 0000000..d93f6ca --- /dev/null +++ b/octave_packages/specfun-1.1.0/zeta.m @@ -0,0 +1,46 @@ +## Copyright (C) 2006 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{z} =} zeta (@var{t}) +## Compute the Riemann's Zeta function. +## @seealso{Si} +## @end deftypefn + +function z = zeta(t) + if (nargin != 1) + print_usage; + endif + z = zeros(size(t)); + for j = 1:prod(size(t)) + if(real(t(j)) >= 0) + if(imag(t(j)) == 0 && real(t(j)) > 1) + F= @(x) 1./(gamma(t(j))).*x.^(t(j)-1)./(exp(x)-1); + z(j) = quad(F,0,Inf); + elseif(t(j) == 0) + z(j) = -0.5; + elseif(t(j) == 1) + z(j) = Inf; + else + for k = 1:100 + z(j) += (-1).^(k-1)./(k.^t(j)); + endfor + z(j) = 1./(1-2.^(1-t(j))).*z(j); + endif + else + z(j) = 2.^t(j).*pi.^(t(j)-1).*sin(pi.*t(j)./2).*gamma(1-t(j)).*zeta(1-t(j)); + endif + endfor +endfunction diff --git a/octave_packages/splines-1.0.7/catmullrom.m b/octave_packages/splines-1.0.7/catmullrom.m new file mode 100644 index 0000000..c31693a --- /dev/null +++ b/octave_packages/splines-1.0.7/catmullrom.m @@ -0,0 +1,61 @@ +## Copyright (C) 2008 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{pp}} = catmullrom( @var{x},@ +## @var{f}, @var{v}) +## +## Returns the piecewise polynomial form of the Catmull-Rom cubic +## spline interpolating @var{f} at the points @var{x}. +## If the input @var{v} is supplied it will be interpreted as the +## values of the tangents at the extremals, if it is +## missing, the values will be computed from the data via one-sided +## finite difference formulas. See the wikipedia page for "Cubic +## Hermite spline" for a description of the algorithm. +## +## @seealso{ppval} +## @end deftypefn + +function pp = catmullrom(x,f,v) + + if ( nargin < 2 ) + print_usage(); + endif + + h00 = [2 -3 0 1]; + h10 = [1 -2 1 0]; + h01 = [-2 3 0 0]; + h11 = [1 -1 0 0]; + + h = diff(x(:)'); + p0 = f(:)'(1:end-1); + p1 = f(:)'(2:end); + + if (nargin < 3) + v(1) = (p1(1)-p0(1))./h(1); + v(2) = (p1(end)-p0(end))./h(end); + endif + m = (p1(2:end)-p0(1:end-1))./(h(2:end)+h(1:end-1)); + m0 = [v(1) m]; + m1 = [m v(2)]; + + for ii = 1:4 + coeff(:,ii) = ((h00(ii)*p0 + h10(ii)*h.*m0 +... + h01(ii)*p1 + h11(ii)*h.*m1 )./h.^(4-ii))' ; + end + + pp = mkpp (x, coeff); + +endfunction \ No newline at end of file diff --git a/octave_packages/splines-1.0.7/csape.m b/octave_packages/splines-1.0.7/csape.m new file mode 100644 index 0000000..ecc6501 --- /dev/null +++ b/octave_packages/splines-1.0.7/csape.m @@ -0,0 +1,275 @@ +## Copyright (C) 2000,2001 Kai Habel +## +## 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{pp} = } csape (@var{x}, @var{y}, @var{cond}, @var{valc}) +## cubic spline interpolation with various end conditions. +## creates the pp-form of the cubic spline. +## +## the following end conditions as given in @var{cond} are possible. +## @table @asis +## @item 'complete' +## match slopes at first and last point as given in @var{valc} +## @item 'not-a-knot' +## third derivatives are continuous at the second and second last point +## @item 'periodic' +## match first and second derivative of first and last point +## @item 'second' +## match second derivative at first and last point as given in @var{valc} +## @item 'variational' +## set second derivative at first and last point to zero (natural cubic spline) +## @end table +## +## @seealso{ppval, spline} +## @end deftypefn + +## Author: Kai Habel +## Date: 23. nov 2000 +## Algorithms taken from G. Engeln-Muellges, F. Uhlig: +## "Numerical Algorithms with C", Springer, 1996 + +## Paul Kienzle, 19. feb 2001, csape supports now matrix y value + +function pp = csape (x, y, cond, valc) + + x = x(:); + n = length(x); + if (n < 3) + error("csape requires at least 3 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 + + + b = c = zeros (size (a)); + h = diff (x); + idx = ones (columns(a),1); + + if (nargin < 3 || strcmp(cond,"complete")) + # specified first derivative at end point + if (nargin < 4) + valc = [0, 0]; + endif + + 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) - valc(1)); + g(n - 2,:) = 3 / 2 * (3 * (a(n,:) - a(n - 1,:)) / h(n - 1) - valc(2))\ + - 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; + + end + + c(1,:) = (3 / h(1) * (a(2,:) - a(1,:)) - 3 * valc(1) + - c(2,:) * h(1)) / (2 * h(1)); + c(n,:) = - (3 / h(n - 1) * (a(n,:) - a(n - 1,:)) - 3 * valc(2) + + + 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)); + + elseif (strcmp(cond,"variational") || strcmp(cond,"second")) + + if ((nargin < 4) || strcmp(cond,"variational")) + ## set second derivatives at end points to zero + valc = [0, 0]; + endif + + c(1,:) = valc(1) / 2; + c(n,:) = valc(2) / 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,:) = g(1,:) - h(1) * c(1,:); + g(n - 2,:) = g(n-2,:) - h(n - 1) * c(n,:); + + if( n == 3) + dg = 2 * h(1); + c(2:n - 1,:) = g / dg; + else + dg = 2 * (h(1:n - 2) .+ h(2:n - 1)); + e = h(2:n - 2); + c(2:n - 1,:) = spdiags([[e(:);0],dg,[0;e(:)]],[-1,0,1],n-2,n-2) \ g; + end + + 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)); + + elseif (strcmp(cond,"periodic")) + + h = [h; h(1)]; + + ## XXX FIXME XXX --- the following gives a smoother periodic transition: + ## a(n,:) = a(1,:) = ( a(n,:) + a(1,:) ) / 2; + a(n,:) = a(1,:); + + tmp = diff (shift ([a; a(2,:)], -1)); + g = 3 * tmp(1:n - 1,:) ./ h(2:n,idx)\ + - 3 * diff (a) ./ h(1:n - 1,idx); + + if (n > 3) + dg = 2 * (h(1:n - 1) .+ h(2:n)); + e = h(2:n - 1); + + ## Use Sherman-Morrison formula to extend the solution + ## to the cyclic system. See Numerical Recipes in C, pp 73-75 + gamma = - dg(1); + dg(1) -= gamma; + dg(end) -= h(1) * h(1) / gamma; + z = spdiags([[e(:);0],dg,[0;e(:)]],[-1,0,1],n-1,n-1) \ ... + [[gamma; zeros(n-3,1); h(1)],g]; + fact = (z(1,2:end) + h(1) * z(end,2:end) / gamma) / ... + (1.0 + z(1,1) + h(1) * z(end,1) / gamma); + + c(2:n,idx) = z(:,2:end) - z(:,1) * fact; + endif + + c(1,:) = c(n,:); + b = diff (a) ./ h(1:n - 1,idx)\ + - h(1:n - 1,idx) / 3 .* (c(2:n,:) + 2 * c(1:n - 1,:)); + b(n,:) = b(1,:); + d = diff (c) ./ (3 * h(1:n - 1, idx)); + d(n,:) = d(1,:); + + elseif (strcmp(cond,"not-a-knot")) + + 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; + + else # n == 3 + + dg= [h(1) + 2 * h(2)]; + c(2:n - 1,:) = g/dg(1); + + 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)); + + else + msg = sprintf("unknown end condition: %s",cond); + error (msg); + endif + + d = d(1:n-1,:); c=c(1:n-1,:); b=b(1:n-1,:); a=a(1:n-1,:); + pp = mkpp (x, cat (2, d'(:), c'(:), b'(:), a'(:)), szy(1:end-1)); + +endfunction + + +%!shared x,y,cond +%! x = linspace(0,2*pi,15); y = sin(x); + +%!assert (ppval(csape(x,y),x), y, 10*eps); +%!assert (ppval(csape(x,y),x'), y', 10*eps); +%!assert (ppval(csape(x',y'),x'), y', 10*eps); +%!assert (ppval(csape(x',y'),x), y, 10*eps); +%!assert (ppval(csape(x,[y;y]),x), \ +%! [ppval(csape(x,y),x);ppval(csape(x,y),x)], 10*eps) + +%!test cond='complete'; +%!assert (ppval(csape(x,y,cond),x), y, 10*eps); +%!assert (ppval(csape(x,y,cond),x'), y', 10*eps); +%!assert (ppval(csape(x',y',cond),x'), y', 10*eps); +%!assert (ppval(csape(x',y',cond),x), y, 10*eps); +%!assert (ppval(csape(x,[y;y],cond),x), \ +%! [ppval(csape(x,y,cond),x);ppval(csape(x,y,cond),x)], 10*eps) + +%!test cond='variational'; +%!assert (ppval(csape(x,y,cond),x), y, 10*eps); +%!assert (ppval(csape(x,y,cond),x'), y', 10*eps); +%!assert (ppval(csape(x',y',cond),x'), y', 10*eps); +%!assert (ppval(csape(x',y',cond),x), y, 10*eps); +%!assert (ppval(csape(x,[y;y],cond),x), \ +%! [ppval(csape(x,y,cond),x);ppval(csape(x,y,cond),x)], 10*eps) + +%!test cond='second'; +%!assert (ppval(csape(x,y,cond),x), y, 10*eps); +%!assert (ppval(csape(x,y,cond),x'), y', 10*eps); +%!assert (ppval(csape(x',y',cond),x'), y', 10*eps); +%!assert (ppval(csape(x',y',cond),x), y, 10*eps); +%!assert (ppval(csape(x,[y;y],cond),x), \ +%! [ppval(csape(x,y,cond),x);ppval(csape(x,y,cond),x)], 10*eps) + +%!test cond='periodic'; +%!assert (ppval(csape(x,y,cond),x), y, 10*eps); +%!assert (ppval(csape(x,y,cond),x'), y', 10*eps); +%!assert (ppval(csape(x',y',cond),x'), y', 10*eps); +%!assert (ppval(csape(x',y',cond),x), y, 10*eps); +%!assert (ppval(csape(x,[y;y],cond),x), \ +%! [ppval(csape(x,y,cond),x);ppval(csape(x,y,cond),x)], 10*eps) + +%!test cond='not-a-knot'; +%!assert (ppval(csape(x,y,cond),x), y, 10*eps); +%!assert (ppval(csape(x,y,cond),x'), y', 10*eps); +%!assert (ppval(csape(x',y',cond),x'), y', 10*eps); +%!assert (ppval(csape(x',y',cond),x), y, 10*eps); +%!assert (ppval(csape(x,[y;y],cond),x), \ +%! [ppval(csape(x,y,cond),x);ppval(csape(x,y,cond),x)], 10*eps) diff --git a/octave_packages/splines-1.0.7/csapi.m b/octave_packages/splines-1.0.7/csapi.m new file mode 100644 index 0000000..3e47b73 --- /dev/null +++ b/octave_packages/splines-1.0.7/csapi.m @@ -0,0 +1,35 @@ +## Copyright (C) 2000 Kai Habel +## +## 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{pp} = } csapi (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{yi} = } csapi (@var{x}, @var{y}, @var{xi}) +## cubic spline interpolation +## +## @seealso{ppval, spline, csape} +## @end deftypefn + +## Author: Kai Habel +## Date: 3. dec 2000 + +function ret = csapi (x, y, xi) + + ret = csape(x,y,'not-a-knot'); + + if (nargin == 3) + ret = ppval(ret,xi); + endif + +endfunction diff --git a/octave_packages/splines-1.0.7/doc-cache b/octave_packages/splines-1.0.7/doc-cache new file mode 100644 index 0000000..39a76ad --- /dev/null +++ b/octave_packages/splines-1.0.7/doc-cache @@ -0,0 +1,203 @@ +# Created by Octave 3.6.1, Fri Mar 30 13:10:46 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 6 +# name: +# type: sq_string +# elements: 1 +# length: 10 +catmullrom + + +# name: +# type: sq_string +# elements: 1 +# length: 494 + -- Function File: PP = catmullrom( X, F, V) + Returns the piecewise polynomial form of the Catmull-Rom cubic + spline interpolating F at the points X. If the input V is + supplied it will be interpreted as the values of the tangents at + the extremals, if it is missing, the values will be computed from + the data via one-sided finite difference formulas. See the + wikipedia page for "Cubic Hermite spline" for a description of the + algorithm. + + See also: ppval + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Returns the piecewise polynomial form of the Catmull-Rom cubic spline +interpolat + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +csape + + +# name: +# type: sq_string +# elements: 1 +# length: 741 + -- Function File: PP = csape (X, Y, COND, VALC) + cubic spline interpolation with various end conditions. creates + the pp-form of the cubic spline. + + the following end conditions as given in COND are possible. + 'complete' + match slopes at first and last point as given in VALC + + 'not-a-knot' + third derivatives are continuous at the second and second + last point + + 'periodic' + match first and second derivative of first and last point + + 'second' + match second derivative at first and last point as given in + VALC + + 'variational' + set second derivative at first and last point to zero + (natural cubic spline) + + See also: ppval, spline + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +cubic spline interpolation with various end conditions. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +csapi + + +# name: +# type: sq_string +# elements: 1 +# length: 151 + -- Function File: PP = csapi (X, Y) + -- Function File: YI = csapi (X, Y, XI) + cubic spline interpolation + + See also: ppval, spline, csape + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 +cubic spline interpolation + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +fnder + + +# name: +# type: sq_string +# elements: 1 +# length: 104 + -- Function File: fnder (PP, ORDER) + differentiate the spline in pp-form + + See also: ppval + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +differentiate the spline in pp-form + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +fnplt + + +# name: +# type: sq_string +# elements: 1 +# length: 96 + -- Function File: fnplt (PP, 'PLT') + plots spline + + See also: ppval, spline, csape + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +plots spline + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +fnval + + +# name: +# type: sq_string +# elements: 1 +# length: 100 + r = fnval(pp,x) or r = fnval(x,pp) + Compute the value of the piece-wise polynomial pp at points x. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + r = fnval(pp,x) or r = fnval(x,pp) + Compute the value of the piece-wise polynom + + + + + diff --git a/octave_packages/splines-1.0.7/fnder.m b/octave_packages/splines-1.0.7/fnder.m new file mode 100644 index 0000000..f5094f4 --- /dev/null +++ b/octave_packages/splines-1.0.7/fnder.m @@ -0,0 +1,46 @@ +## Copyright (C) 2000 Kai Habel +## +## 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} { } fnder (@var{pp}, @var{order}) +## differentiate the spline in pp-form +## +## @seealso{ppval} +## @end deftypefn + +## Author: Kai Habel +## Date: 20. feb 2001 + +function dpp = fnder (pp, o) + + if (nargin < 1 || nargin > 2) + usage ("fnder (pp [, order])"); + endif + if (nargin < 2) + o = 1; + endif + + [X, P, N, K, D] = unmkpp (pp); + c = columns (P); + r = rows (P); + + for i = 1:o + #pp.P = polyder (pp.P); matrix capable polyder is needed. + P = P(:, 1:c - 1) .* kron ((c - 1):- 1:1, ones (r,1)); + endfor + + dpp = mkpp (X, P); + +endfunction diff --git a/octave_packages/splines-1.0.7/fnplt.m b/octave_packages/splines-1.0.7/fnplt.m new file mode 100644 index 0000000..441770b --- /dev/null +++ b/octave_packages/splines-1.0.7/fnplt.m @@ -0,0 +1,60 @@ +## Copyright (C) 2000 Kai Habel +## +## 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} { } fnplt (@var{pp}, '@var{plt}') +## plots spline +## +## @seealso{ppval, spline, csape} +## @end deftypefn + +## Author: Kai Habel +## Date: 3. dec 2000 +## 2001-02-19 Paul Kienzle +## * use pp.x rather than just x in linspace; add plt parameter +## * return points instead of plotting them if desired +## * also plot control points +## * added demo + +function [x, y] = fnplt (pp, plt) + + if (nargin < 1 || nargin > 2) + usage ("[x, y] = fnplt (pp [, plotstring])"); + endif + if (nargin < 2) + plt = "r;;"; + endif + xi = linspace(min(pp.x),max(pp.x),256)'; + pts = ppval(pp,xi); + if nargout == 2 + x = xi; + y = pts; + elseif nargout == 1 + x = [xi, pts]; + else + plot(xi,pts,plt,pp.x,ppval(pp,pp.x),"bx;;"); + endif + +endfunction + +%!demo +%! x = [ 0; sort(rand(25,1)); 1 ]; +%! pp = csape (x, sin (2*pi*3*x), 'periodic'); +%! axis([0,1,-2,2]); +%! title('Periodic spline reconstruction of randomly sampled sine'); +%! fnplt (pp,'r;reconstruction;'); +%! t=linspace(0,1,100); y=sin(2*pi*3*t); +%! hold on; plot(t,y,'g;ideal;'); hold off; +%! axis; title(""); diff --git a/octave_packages/splines-1.0.7/fnval.m b/octave_packages/splines-1.0.7/fnval.m new file mode 100644 index 0000000..4dc9887 --- /dev/null +++ b/octave_packages/splines-1.0.7/fnval.m @@ -0,0 +1,14 @@ +## r = fnval(pp,x) or r = fnval(x,pp) +## Compute the value of the piece-wise polynomial pp at points x. + +## This program is public domain. +## Paul Kienzle, 2004-02-22 +function r = fnval(a,b,left) + if nargin == 2 || (nargin == 3 && left == 'l' && left == 'r') + # XXX FIXME XXX ignoring left continuous vs. right continuous option + if isstruct(a), r=ppval(a,b); else r=ppval(b,a); end + else + usage("r=fnval(pp,x) || r=fnval(x,pp)"); + end +end + diff --git a/octave_packages/splines-1.0.7/packinfo/.autoload b/octave_packages/splines-1.0.7/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/splines-1.0.7/packinfo/DESCRIPTION b/octave_packages/splines-1.0.7/packinfo/DESCRIPTION new file mode 100644 index 0000000..58aa75d --- /dev/null +++ b/octave_packages/splines-1.0.7/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: splines +Version: 1.0.7 +Date: 2009-05-06 +Author: Kai Habel and Paul Kienzle +Maintainer: Kai Habel and Paul Kienzle +Title: Splines. +Description: Additional Cubic spline functions. +Categories: Splines +Depends: octave (>= 2.9.7) +Autoload: yes +License: GPL v2 or later, and Public Domain +Url: http://octave.sf.net diff --git a/octave_packages/splines-1.0.7/packinfo/INDEX b/octave_packages/splines-1.0.7/packinfo/INDEX new file mode 100644 index 0000000..fde6f5b --- /dev/null +++ b/octave_packages/splines-1.0.7/packinfo/INDEX @@ -0,0 +1,9 @@ +analysis >> Data analysis +Spline functions + csapi + csape + fnplt + fnder + fnval + catmullrom + diff --git a/octave_packages/statistics-1.1.3/anderson_darling_cdf.m b/octave_packages/statistics-1.1.3/anderson_darling_cdf.m new file mode 100644 index 0000000..67c602e --- /dev/null +++ b/octave_packages/statistics-1.1.3/anderson_darling_cdf.m @@ -0,0 +1,131 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} @var{p} = anderson_darling_cdf (@var{A}, @var{n}) +## +## Return the CDF for the given Anderson-Darling coefficient @var{A} +## computed from @var{n} values sampled from a distribution. For a +## vector of random variables @var{x} of length @var{n}, compute the CDF +## of the values from the distribution from which they are drawn. +## You can uses these values to compute @var{A} as follows: +## +## @example +## @var{A} = -@var{n} - sum( (2*i-1) .* (log(@var{x}) + log(1 - @var{x}(@var{n}:-1:1,:))) )/@var{n}; +## @end example +## +## From the value @var{A}, @code{anderson_darling_cdf} returns the probability +## that @var{A} could be returned from a set of samples. +## +## The algorithm given in [1] claims to be an approximation for the +## Anderson-Darling CDF accurate to 6 decimal points. +## +## Demonstrate using: +## +## @example +## n = 300; reps = 10000; +## z = randn(n, reps); +## x = sort ((1 + erf (z/sqrt (2)))/2); +## i = [1:n]' * ones (1, size (x, 2)); +## A = -n - sum ((2*i-1) .* (log (x) + log (1 - x (n:-1:1, :))))/n; +## p = anderson_darling_cdf (A, n); +## hist (100 * p, [1:100] - 0.5); +## @end example +## +## You will see that the histogram is basically flat, which is to +## say that the probabilities returned by the Anderson-Darling CDF +## are distributed uniformly. +## +## You can easily determine the extreme values of @var{p}: +## +## @example +## [junk, idx] = sort (p); +## @end example +## +## The histograms of various @var{p} aren't very informative: +## +## @example +## histfit (z (:, idx (1)), linspace (-3, 3, 15)); +## histfit (z (:, idx (end/2)), linspace (-3, 3, 15)); +## histfit (z (:, idx (end)), linspace (-3, 3, 15)); +## @end example +## +## More telling is the qqplot: +## +## @example +## qqplot (z (:, idx (1))); hold on; plot ([-3, 3], [-3, 3], ';;'); hold off; +## qqplot (z (:, idx (end/2))); hold on; plot ([-3, 3], [-3, 3], ';;'); hold off; +## qqplot (z (:, idx (end))); hold on; plot ([-3, 3], [-3, 3], ';;'); hold off; +## @end example +## +## Try a similarly analysis for @var{z} uniform: +## +## @example +## z = rand (n, reps); x = sort(z); +## @end example +## +## and for @var{z} exponential: +## +## @example +## z = rande (n, reps); x = sort (1 - exp (-z)); +## @end example +## +## [1] Marsaglia, G; Marsaglia JCW; (2004) "Evaluating the Anderson Darling +## distribution", Journal of Statistical Software, 9(2). +## +## @seealso{anderson_darling_test} +## @end deftypefn + +function y = anderson_darling_cdf(z,n) + y = ADinf(z); + y += ADerrfix(y,n); +end + +function y = ADinf(z) + y = zeros(size(z)); + + idx = (z < 2); + if any(idx(:)) + p = [.00168691, -.0116720, .0347962, -.0649821, .247105, 2.00012]; + z1 = z(idx); + y(idx) = exp(-1.2337141./z1)./sqrt(z1).*polyval(p,z1); + end + + idx = (z >= 2); + if any(idx(:)) + p = [-.0003146, +.008056, -.082433, +.43424, -2.30695, 1.0776]; + y(idx) = exp(-exp(polyval(p,z(idx)))); + end +end + +function y = ADerrfix(x,n) + if isscalar(n), n = n*ones(size(x)); + elseif isscalar(x), x = x*ones(size(n)); + end + y = zeros(size(x)); + c = .01265 + .1757./n; + + idx = (x >= 0.8); + if any(idx(:)) + p = [255.7844, -1116.360, 1950.646, -1705.091, 745.2337, -130.2137]; + g3 = polyval(p,x(idx)); + y(idx) = g3./n(idx); + end + + idx = (x < 0.8 & x > c); + if any(idx(:)) + p = [1.91864, -8.259, 14.458, -14.6538, 6.54034, -.00022633]; + n1 = 1./n(idx); + c1 = c(idx); + g2 = polyval(p,(x(idx)-c1)./(.8-c1)); + y(idx) = (.04213 + .01365*n1).*n1 .* g2; + end + + idx = (x <= c); + if any(idx(:)) + x1 = x(idx)./c(idx); + n1 = 1./n(idx); + g1 = sqrt(x1).*(1-x1).*(49*x1-102); + y(idx) = ((.0037*n1+.00078).*n1+.00006).*n1 .* g1; + end +end diff --git a/octave_packages/statistics-1.1.3/anderson_darling_test.m b/octave_packages/statistics-1.1.3/anderson_darling_test.m new file mode 100644 index 0000000..802d0d0 --- /dev/null +++ b/octave_packages/statistics-1.1.3/anderson_darling_test.m @@ -0,0 +1,153 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{q}, @var{Asq}, @var{info}] = } = @ +## anderson_darling_test (@var{x}, @var{distribution}) +## +## Test the hypothesis that @var{x} is selected from the given distribution +## using the Anderson-Darling test. If the returned @var{q} is small, reject +## the hypothesis at the @var{q}*100% level. +## +## The Anderson-Darling @math{@var{A}^2} statistic is calculated as follows: +## +## @example +## @iftex +## A^2_n = -n - \sum_{i=1}^n (2i-1)/n log(z_i (1-z_{n-i+1})) +## @end iftex +## @ifnottex +## n +## A^2_n = -n - SUM (2i-1)/n log(@math{z_i} (1 - @math{z_@{n-i+1@}})) +## i=1 +## @end ifnottex +## @end example +## +## where @math{z_i} is the ordered position of the @var{x}'s in the CDF of the +## distribution. Unlike the Kolmogorov-Smirnov statistic, the +## Anderson-Darling statistic is sensitive to the tails of the +## distribution. +## +## The @var{distribution} argument must be a either @t{"uniform"}, @t{"normal"}, +## or @t{"exponential"}. +## +## For @t{"normal"}' and @t{"exponential"} distributions, estimate the +## distribution parameters from the data, convert the values +## to CDF values, and compare the result to tabluated critical +## values. This includes an correction for small @var{n} which +## works well enough for @var{n} >= 8, but less so from smaller @var{n}. The +## returned @code{info.Asq_corrected} contains the adjusted statistic. +## +## For @t{"uniform"}, assume the values are uniformly distributed +## in (0,1), compute @math{@var{A}^2} and return the corresponding @math{p}-value from +## @code{1-anderson_darling_cdf(A^2,n)}. +## +## If you are selecting from a known distribution, convert your +## values into CDF values for the distribution and use @t{"uniform"}. +## Do not use @t{"uniform"} if the distribution parameters are estimated +## from the data itself, as this sharply biases the @math{A^2} statistic +## toward smaller values. +## +## [1] Stephens, MA; (1986), "Tests based on EDF statistics", in +## D'Agostino, RB; Stephens, MA; (eds.) Goodness-of-fit Techinques. +## New York: Dekker. +## +## @seealso{anderson_darling_cdf} +## @end deftypefn + +function [q,Asq,info] = anderson_darling_test(x,dist) + + if size(x,1) == 1, x=x(:); end + x = sort(x); + n = size(x,1); + use_cdf = 0; + + # Compute adjustment and critical values to use for stats. + switch dist + case 'normal', + # This expression for adj is used in R. + # Note that the values from NIST dataplot don't work nearly as well. + adj = 1 + (.75 + 2.25/n)/n; + qvals = [ 0.1, 0.05, 0.025, 0.01 ]; + Acrit = [ 0.631, 0.752, 0.873, 1.035]; + x = stdnormal_cdf(zscore(x)); + + case 'uniform', + ## Put invalid data at the limits of the distribution + ## This will drive the statistic to infinity. + x(x<0) = 0; + x(x>1) = 1; + adj = 1.; + qvals = [ 0.1, 0.05, 0.025, 0.01 ]; + Acrit = [ 1.933, 2.492, 3.070, 3.857 ]; + use_cdf = 1; + + case 'XXXweibull', + adj = 1 + 0.2/sqrt(n); + qvals = [ 0.1, 0.05, 0.025, 0.01 ]; + Acrit = [ 0.637, 0.757, 0.877, 1.038]; + ## XXX FIXME XXX how to fit alpha and sigma? + x = wblcdf (x, ones(n,1)*sigma, ones(n,1)*alpha); + + case 'exponential', + adj = 1 + 0.6/n; + qvals = [ 0.1, 0.05, 0.025, 0.01 ]; + # Critical values depend on n. Choose the appropriate critical set. + # These values come from NIST dataplot/src/dp8.f. + Acritn = [ + 0, 1.022, 1.265, 1.515, 1.888 + 11, 1.045, 1.300, 1.556, 1.927; + 21, 1.062, 1.323, 1.582, 1.945; + 51, 1.070, 1.330, 1.595, 1.951; + 101, 1.078, 1.341, 1.606, 1.957; + ]; + # FIXME: consider interpolating in the critical value table. + Acrit = Acritn(lookup(Acritn(:,1),n),2:5); + + lambda = 1./mean(x); # exponential parameter estimation + x = expcdf(x, 1./(ones(n,1)*lambda)); + + otherwise + # FIXME consider implementing more of distributions; a number + # of them are defined in NIST dataplot/src/dp8.f. + error("Anderson-Darling test for %s not implemented", dist); + endswitch + + if any(x<0 | x>1) + error('Anderson-Darling test requires data in CDF form'); + endif + + i = [1:n]'*ones(1,size(x,2)); + Asq = -n - sum( (2*i-1) .* (log(x) + log(1-x(n:-1:1,:))) )/n; + + # Lookup adjusted critical value in the cdf (if uniform) or in the + # the critical table. + if use_cdf + q = 1-anderson_darling_cdf(Asq*adj, n); + else + idx = lookup([-Inf,Acrit],Asq*adj); + q = [1,qvals](idx); + endif + + if nargout > 2, + info.Asq = Asq; + info.Asq_corrected = Asq*adj; + info.Asq_critical = [100*(1-qvals); Acrit]'; + info.p = 1-q; + info.p_is_precise = use_cdf; + endif +endfunction + +%!demo +%! c = anderson_darling_test(10*rande(12,10000),'exponential'); +%! tabulate(100*c,100*[unique(c),1]); +%! % The Fc column should report 100, 250, 500, 1000, 10000 more or less. + +%!demo +%! c = anderson_darling_test(randn(12,10000),'normal'); +%! tabulate(100*c,100*[unique(c),1]); +%! % The Fc column should report 100, 250, 500, 1000, 10000 more or less. + +%!demo +%! c = anderson_darling_test(rand(12,10000),'uniform'); +%! hist(100*c,1:2:99); +%! % The histogram should be flat more or less. diff --git a/octave_packages/statistics-1.1.3/anovan.m b/octave_packages/statistics-1.1.3/anovan.m new file mode 100644 index 0000000..4c936b9 --- /dev/null +++ b/octave_packages/statistics-1.1.3/anovan.m @@ -0,0 +1,359 @@ +## Copyright (C) 2003-2005 Andy Adler +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{f}, @var{df_b}, @var{df_e}] =} anovan (@var{data}, @var{grps}) +## @deftypefnx {Function File} {[@var{pval}, @var{f}, @var{df_b}, @var{df_e}] =} anovan (@var{data}, @var{grps}, 'param1', @var{value1}) +## Perform a multi-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 is a single vector @var{data} with groups specified by +## a corresponding matrix of group labels @var{grps}, where @var{grps} +## has the same number of rows as @var{data}. For example, if +## @var{data} = [1.1;1.2]; @var{grps}= [1,2,1; 1,5,2]; +## then data point 1.1 was measured under conditions 1,2,1 and +## data point 1.2 was measured under conditions 1,5,2. +## Note that groups do not need to be sequentially numbered. +## +## By default, a 'linear' model is used, computing the N main effects +## with no interactions. this may be modified by param 'model' +## +## p= anovan(data,groups, 'model', modeltype) +## - modeltype = 'linear': compute N main effects +## - modeltype = 'interaction': compute N effects and +## N*(N-1) two-factor interactions +## - modeltype = 'full': compute interactions at all levels +## +## Under the null of constant means, the statistic @var{f} follows an F +## distribution with @var{df_b} and @var{df_e} 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. +## +## BUG: DFE is incorrect for modeltypes != full +## @end deftypefn + +## Author: Andy Adler +## Based on code by: KH +## $Id: anovan.m 10203 2012-04-12 13:47:32Z carandraug $ +## +## TESTING RESULTS: +## 1. ANOVA ACCURACY: www.itl.nist.gov/div898/strd/anova/anova.html +## Passes 'easy' test. Comes close on 'Average'. Fails 'Higher'. +## This could be fixed with higher precision arithmetic +## 2. Matlab anova2 test +## www.mathworks.com/access/helpdesk/help/toolbox/stats/anova2.html +## % From web site: +## popcorn= [ 5.5 4.5 3.5; 5.5 4.5 4.0; 6.0 4.0 3.0; +## 6.5 5.0 4.0; 7.0 5.5 5.0; 7.0 5.0 4.5]; +## % Define groups so reps = 3 +## groups = [ 1 1;1 2;1 3;1 1;1 2;1 3;1 1;1 2;1 3; +## 2 1;2 2;2 3;2 1;2 2;2 3;2 1;2 2;2 3 ]; +## anovan( vec(popcorn'), groups, 'model', 'full') +## % Results same as Matlab output +## 3. Matlab anovan test +## www.mathworks.com/access/helpdesk/help/toolbox/stats/anovan.html +## % From web site +## y = [52.7 57.5 45.9 44.5 53.0 57.0 45.9 44.0]'; +## g1 = [1 2 1 2 1 2 1 2]; +## g2 = {'hi';'hi';'lo';'lo';'hi';'hi';'lo';'lo'}; +## g3 = {'may'; 'may'; 'may'; 'may'; 'june'; 'june'; 'june'; 'june'}; +## anovan( y', [g1',g2',g3']) +## % Fails because we always do interactions + +function [PVAL, FSTAT, DF_B, DFE] = anovan (data, grps, varargin) + + if nargin <= 1 + usage ("anovan (data, grps)"); + end + + # test supplied parameters + modeltype= 'linear'; + for idx= 3:2:nargin + param= varargin{idx-2}; + value= varargin{idx-1}; + + if strcmp(param, 'model') + modeltype= value; +# elseif strcmp(param # add other parameters here + else + error(sprintf('parameter %s is not supported', param)); + end + end + + if ~isvector (data) + error ("anova: for `anova (data, grps)', data must be a vector"); + endif + + nd = size (grps,1); # number of data points + nw = size (grps,2); # number of anova "ways" + if (~ isvector (data) || (length(data) ~= nd)) + error ("anova: grps must be a matrix of the same number of rows as data"); + endif + + [g,grp_map] = relabel_groups (grps); + if strcmp(modeltype, 'linear') + max_interact = 1; + elseif strcmp(modeltype,'interaction') + max_interact = 2; + elseif strcmp(modeltype,'full') + max_interact = rows(grps); + else + error(sprintf('modeltype %s is not supported', modeltype)); + end + ng = length(grp_map); + int_tbl = interact_tbl (nw, ng, max_interact ); + [gn, gs, gss] = raw_sums(data, g, ng, int_tbl); + + stats_tbl = int_tbl(2:size(int_tbl,1),:)>0; + nstats= size(stats_tbl,1); + stats= zeros( nstats+1, 5); # SS, DF, MS, F, p + for i= 1:nstats + [SS, DF, MS]= factor_sums( gn, gs, gss, stats_tbl(i,:), ng, nw); + stats(i,1:3)= [SS, DF, MS]; + end + + # The Mean squared error is the data - avg for each possible measurement + # This calculation doesn't work unless there is replication for all grps +# SSE= sum( gss(sel) ) - sum( gs(sel).^2 ./ gn(sel) ); + SST= gss(1) - gs(1)^2/gn(1); + SSE= SST - sum(stats(:,1)); + sel = select_pat( ones(1,nw), ng, nw); %incorrect for modeltypes != full + DFE= sum( (gn(sel)-1).*(gn(sel)>0) ); + MSE= SSE/DFE; + stats(nstats+1,1:3)= [SSE, DFE, MSE]; + + for i= 1:nstats + MS= stats(i,3); + DF= stats(i,2); + F= MS/MSE; + pval = 1 - fcdf (F, DF, DFE); + stats(i,4:5)= [F, pval]; + end + + if nargout==0; + printout( stats, stats_tbl ); + else + PVAL= stats(1:nstats,5); + FSTAT=stats(1:nstats,4); + DF_B= stats(1:nstats,2); + DF_E= DFE; + end +endfunction + + +# relabel groups to a mapping from 1 to ng +# Input +# grps input grouping +# Output +# g relabelled grouping +# grp_map map from output to input grouping +function [g,grp_map] = relabel_groups(grps) + grp_vec= vec(grps); + s= sort (grp_vec); + uniq = 1+[0;find(diff(s))]; + # mapping from new grps to old groups + grp_map = s(uniq); + # create new group g + ngroups= length(uniq); + g= zeros(size(grp_vec)); + for i = 1:ngroups + g( find( grp_vec== grp_map(i) ) ) = i; + end + g= reshape(g, size(grps)); +endfunction + +# Create interaction table +# +# Input: +# nw number of "ways" +# ng number of ANOVA groups +# max_interact maximum number of interactions to consider +# default is nw +function int_tbl =interact_tbl(nw, ng, max_interact) + combin= 2^nw; + inter_tbl= zeros( combin, nw); + idx= (0:combin-1)'; + for i=1:nw; + inter_tbl(:,i) = ( rem(idx,2^i) >= 2^(i-1) ); + end + + # find elements with more than max_interact 1's + idx = ( sum(inter_tbl',1) > max_interact ); + inter_tbl(idx,:) =[]; + combin= size(inter_tbl,1); # update value + + #scale inter_tbl + # use ng+1 to map combinations of groups to integers + # this would be lots easier with a hash data structure + int_tbl = inter_tbl .* (ones(combin,1) * (ng+1).^(0:nw-1) ); +endfunction + +# Calculate sums for each combination +# +# Input: +# g relabelled grouping matrix +# ng number of ANOVA groups +# max_interact +# +# Output (virtual (ng+1)x(nw) matrices): +# gn number of data sums in each group +# gs sum of data in each group +# gss sumsqr of data in each group +function [gn, gs, gss] = raw_sums(data, g, ng, int_tbl); + nw= size(g,2); + ndata= size(g,1); + gn= gs= gss= zeros((ng+1)^nw, 1); + for i=1:ndata + # need offset by one for indexing + datapt= data(i); + idx = 1+ int_tbl*g(i,:)'; + gn(idx) +=1; + gs(idx) +=datapt; + gss(idx) +=datapt^2; + end +endfunction + +# Calcualte the various factor sums +# Input: +# gn number of data sums in each group +# gs sum of data in each group +# gss sumsqr of data in each group +# select binary vector of factor for this "way"? +# ng number of ANOVA groups +# nw number of ways + +function [SS,DF]= raw_factor_sums( gn, gs, gss, select, ng, nw); + sel= select_pat( select, ng, nw); + ss_raw= gs(sel).^2 ./ gn(sel); + SS= sum( ss_raw( ~isnan(ss_raw) )); + if length(find(select>0))==1 + DF= sum(gn(sel)>0)-1; + else + DF= 1; #this isn't the real DF, but needed to multiply + end +endfunction + +function [SS, DF, MS]= factor_sums( gn, gs, gss, select, ng, nw); + SS=0; + DF=1; + + ff = find(select); + lff= length(ff); + # zero terms added, one term subtracted, two added, etc + for i= 0:2^lff-1 + remove= find( rem( floor( i * 2.^(-lff+1:0) ), 2) ); + sel1= select; + if ~isempty(remove) + sel1( ff( remove ) )=0; + end + [raw_sum,raw_df]= raw_factor_sums(gn,gs,gss,sel1,ng,nw); + + add_sub= (-1)^length(remove); + SS+= add_sub*raw_sum; + DF*= raw_df; + end + + MS= SS/DF; +endfunction + +# Calcualte the various factor sums +# Input: +# select binary vector of factor for this "way"? +# ng number of ANOVA groups +# nw number of ways +function sel= select_pat( select, ng, nw); + # if select(i) is zero, remove nonzeros + # if select(i) is zero, remove zero terms for i + field=[]; + + if length(select) ~= nw; + error("length of select must be = nw"); + end + ng1= ng+1; + + if isempty(field) + # expand 0:(ng+1)^nw in base ng+1 + field= (0:(ng1)^nw-1)'* ng1.^(-nw+1:0); + field= rem( floor( field), ng1); + # select zero or non-zero elements + field= field>0; + end + sel= find( all( field == ones(ng1^nw,1)*select(:)', 2) ); +endfunction + + +function printout( stats, stats_tbl ); + nw= size( stats_tbl,2); + [jnk,order]= sort( sum(stats_tbl,2) ); + + printf('\n%d-way ANOVA Table (Factors A%s):\n\n', nw, ... + sprintf(',%c',toascii('A')+(1:nw-1)) ); + printf('Source of Variation Sum Sqr df MeanSS Fval p-value\n'); + printf('*********************************************************************\n'); + printf('Error %10.2f %4d %10.2f\n', stats( size(stats,1),1:3)); + + for i= order(:)' + str= sprintf(' %c x',toascii('A')+find(stats_tbl(i,:)>0)-1 ); + str= str(1:length(str)-2); # remove x + printf('Factor %15s %10.2f %4d %10.2f %7.3f %7.6f\n', ... + str, stats(i,:) ); + end + printf('\n'); +endfunction + +#{ +# Test Data from http://maths.sci.shu.ac.uk/distance/stats/14.shtml +data=[7 9 9 8 12 10 ... + 9 8 10 11 13 13 ... + 9 10 10 12 10 12]'; +grp = [1,1; 1,1; 1,2; 1,2; 1,3; 1,3; + 2,1; 2,1; 2,2; 2,2; 2,3; 2,3; + 3,1; 3,1; 3,2; 3,2; 3,3; 3,3]; +data=[7 9 9 8 12 10 9 8 ... + 9 8 10 11 13 13 10 11 ... + 9 10 10 12 10 12 10 12]'; +grp = [1,4; 1,4; 1,5; 1,5; 1,6; 1,6; 1,7; 1,7; + 2,4; 2,4; 2,5; 2,5; 2,6; 2,6; 2,7; 2,7; + 3,4; 3,4; 3,5; 3,5; 3,6; 3,6; 3,7; 3,7]; +# Test Data from http://maths.sci.shu.ac.uk/distance/stats/9.shtml +data=[9.5 11.1 11.9 12.8 ... + 10.9 10.0 11.0 11.9 ... + 11.2 10.4 10.8 13.4]'; +grp= [1:4,1:4,1:4]'; +# Test Data from http://maths.sci.shu.ac.uk/distance/stats/13.shtml +data=[7.56 9.68 11.65 ... + 9.98 9.69 10.69 ... + 7.23 10.49 11.77 ... + 8.22 8.55 10.72 ... + 7.59 8.30 12.36]'; +grp = [1,1;1,2;1,3; + 2,1;2,2;2,3; + 3,1;3,2;3,3; + 4,1;4,2;4,3; + 5,1;5,2;5,3]; +# Test Data from www.mathworks.com/ +# access/helpdesk/help/toolbox/stats/linear10.shtml +data=[23 27 43 41 15 17 3 9 20 63 55 90]; +grp= [ 1 1 1 1 2 2 2 2 3 3 3 3; + 1 1 2 2 1 1 2 2 1 1 2 2]'; +#} + + + diff --git a/octave_packages/statistics-1.1.3/betastat.m b/octave_packages/statistics-1.1.3/betastat.m new file mode 100644 index 0000000..394ab8e --- /dev/null +++ b/octave_packages/statistics-1.1.3/betastat.m @@ -0,0 +1,123 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} betastat (@var{a}, @var{b}) +## Compute mean and variance of the beta distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{a} is the first parameter of the beta distribution. @var{a} must be +## positive +## +## @item +## @var{b} is the second parameter of the beta distribution. @var{b} must be +## positive +## @end itemize +## @var{a} and @var{b} must be of common size or one of them must be scalar +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the beta distribution +## +## @item +## @var{v} is the variance of the beta distribution +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## a = 1:6; +## b = 1:0.2:2; +## [m, v] = betastat (a, b) +## @end group +## +## @group +## [m, v] = betastat (a, 1.5) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the beta distribution + +function [m, v] = betastat (a, b) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! isempty (a) && ! ismatrix (a)) + error ("betastat: a must be a numeric matrix"); + endif + if (! isempty (b) && ! ismatrix (b)) + error ("betastat: b must be a numeric matrix"); + endif + + if (! isscalar (a) || ! isscalar (b)) + [retval, a, b] = common_size (a, b); + if (retval > 0) + error ("betastat: a and b must be of common size or scalar"); + endif + endif + + # Calculate moments + m = a ./ (a + b); + v = (a .* b) ./ (((a + b) .^ 2) .* (a + b + 1)); + + # Continue argument check + k = find (! (a > 0) | ! (a < Inf) | ! (b > 0) | ! (b < Inf)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! a = 1:6; +%! b = 1:0.2:2; +%! [m, v] = betastat (a, b); +%! expected_m = [0.5000, 0.6250, 0.6818, 0.7143, 0.7353, 0.7500]; +%! expected_v = [0.0833, 0.0558, 0.0402, 0.0309, 0.0250, 0.0208]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); + +%!test +%! a = 1:6; +%! [m, v] = betastat (a, 1.5); +%! expected_m = [0.4000, 0.5714, 0.6667, 0.7273, 0.7692, 0.8000]; +%! expected_v = [0.0686, 0.0544, 0.0404, 0.0305, 0.0237, 0.0188]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/statistics-1.1.3/binostat.m b/octave_packages/statistics-1.1.3/binostat.m new file mode 100644 index 0000000..44a0e83 --- /dev/null +++ b/octave_packages/statistics-1.1.3/binostat.m @@ -0,0 +1,123 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} binostat (@var{n}, @var{p}) +## Compute mean and variance of the binomial distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{n} is the first parameter of the binomial distribution. The elements +## of @var{n} must be natural numbers +## +## @item +## @var{p} is the second parameter of the binomial distribution. The +## elements of @var{p} must be probabilities +## @end itemize +## @var{n} and @var{p} must be of common size or one of them must be scalar +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the binomial distribution +## +## @item +## @var{v} is the variance of the binomial distribution +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## n = 1:6; +## p = 0:0.2:1; +## [m, v] = binostat (n, p) +## @end group +## +## @group +## [m, v] = binostat (n, 0.5) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the binomial distribution + +function [m, v] = binostat (n, p) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! isempty (n) && ! ismatrix (n)) + error ("binostat: n must be a numeric matrix"); + endif + if (! isempty (p) && ! ismatrix (p)) + error ("binostat: p must be a numeric matrix"); + endif + + if (! isscalar (n) || ! isscalar (p)) + [retval, n, p] = common_size (n, p); + if (retval > 0) + error ("binostat: n and p must be of common size or scalar"); + endif + endif + + # Calculate moments + m = n .* p; + v = n .* p .* (1 - p); + + # Continue argument check + k = find (! (n > 0) | ! (n < Inf) | ! (n == round (n)) | ! (p >= 0) | ! (p <= 1)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! n = 1:6; +%! p = 0:0.2:1; +%! [m, v] = binostat (n, p); +%! expected_m = [0.00, 0.40, 1.20, 2.40, 4.00, 6.00]; +%! expected_v = [0.00, 0.32, 0.72, 0.96, 0.80, 0.00]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); + +%!test +%! n = 1:6; +%! [m, v] = binostat (n, 0.5); +%! expected_m = [0.50, 1.00, 1.50, 2.00, 2.50, 3.00]; +%! expected_v = [0.25, 0.50, 0.75, 1.00, 1.25, 1.50]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/statistics-1.1.3/boxplot.m b/octave_packages/statistics-1.1.3/boxplot.m new file mode 100644 index 0000000..7bd3515 --- /dev/null +++ b/octave_packages/statistics-1.1.3/boxplot.m @@ -0,0 +1,325 @@ +## Copyright (C) 2002 Alberto Terruzzi +## Copyright (C) 2006 Alberto Pose +## Copyright (C) 2011 Pascal Dupuis +## Copyright (C) 2012 Juan Pablo Carbajal +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR 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{s} =} boxplot (@var{data}, @var{notched}, @ +## @var{symbol}, @var{vertical}, @var{maxwhisker}, @dots{}) +## @deftypefnx {Function File} {[@dots{} @var{h}]=} boxplot (@dots{}) +## +## Produce a box plot. +## +## The box plot is a graphical display that simultaneously describes several +## important features of a data set, such as center, spread, departure from +## symmetry, and identification of observations that lie unusually far from +## the bulk of the data. +## +## @var{data} is a matrix with one column for each data set, or data is a cell +## vector with one cell for each data set. +## +## @var{notched} = 1 produces a notched-box plot. Notches represent a robust +## estimate of the uncertainty about the median. +## +## @var{notched} = 0 (default) produces a rectangular box plot. +## +## @var{notched} in (0,1) produces a notch of the specified depth. +## notched values outside (0,1) are amusing if not exactly practical. +## +## @var{symbol} sets the symbol for the outlier values, default symbol for +## points that lie outside 3 times the interquartile range is 'o', +## default symbol for points between 1.5 and 3 times the interquartile +## range is '+'. +## +## @var{symbol} = '.' points between 1.5 and 3 times the IQR is marked with +## '.' and points outside 3 times IQR with 'o'. +## +## @var{symbol} = ['x','*'] points between 1.5 and 3 times the IQR is marked with +## 'x' and points outside 3 times IQR with '*'. +## +## @var{vertical} = 0 makes the boxes horizontal, by default @var{vertical} = 1. +## +## @var{maxwhisker} defines the length of the whiskers as a function of the IQR +## (default = 1.5). If @var{maxwhisker} = 0 then @code{boxplot} displays all data +## values outside the box using the plotting symbol for points that lie +## outside 3 times the IQR. +## +## Supplemental arguments are concatenated and passed to plot. +## +## The returned matrix @var{s} has one column for each data set as follows: +## +## @multitable @columnfractions .1 .8 +## @item 1 @tab Minimum +## @item 2 @tab 1st quartile +## @item 3 @tab 2nd quartile (median) +## @item 4 @tab 3rd quartile +## @item 5 @tab Maximum +## @item 6 @tab Lower confidence limit for median +## @item 7 @tab Upper confidence limit for median +## @end multitable +## +## The returned structure @var{h} has hanldes to the plot elements, allowing +## customization of the visualization using set/get functions. +## +## Example +## +## @example +## title ("Grade 3 heights"); +## axis ([0,3]); +## tics ("x", 1:2, @{"girls"; "boys"@}); +## boxplot (@{randn(10,1)*5+140, randn(13,1)*8+135@}); +## @end example +## +## @end deftypefn + +## Author: Alberto Terruzzi +## Version: 1.4 +## Created: 6 January 2002 + +## Version: 1.4.1 +## Author: Alberto Pose +## Updated: 3 September 2006 +## - Replaced deprecated is_nan_or_na(X) with (isnan(X) | isna(X)) +## (now works with this software 2.9.7 and foward) + +## Version: 1.4.2 +## Author: Pascal Dupuis +## Updated: 14 October 2011 +## - Added support for named arguments + +## Version: 1.4.2 +## Author: Juan Pablo Carbajal +## Updated: 01 March 2012 +## - Returns structure with handles to plot elements +## - Added example as demo + +%# function s = boxplot (data,notched,symbol,vertical,maxwhisker) +function [s hs] = boxplot (data, varargin) + + ## assign parameter defaults + if (nargin < 1) + print_usage; + endif + + %# default values + maxwhisker = 1.5; + vertical = 1; + symbol = ['+', 'o']; + notched = 0; + plot_opts = {}; + + %# Optional arguments analysis + numarg = nargin - 1; + option_args = ['Notch'; 'Symbol'; 'Vertical'; 'Maxwhisker']; + indopt = 1; + while (numarg) + dummy = varargin{indopt++}; + if (!ischar (dummy)) + %# old way: positional argument + switch indopt + case 2 + notched = dummy; + case 4 + vertical = dummy; + case 5 + maxwhisker = dummy; + otherwise + error("No positional argument allowed at position %d", --indopt); + endswitch + numarg--; continue; + else + if (3 == indopt && length (dummy) <= 2) + symbol = dummy; numarg--; continue; + else + tt = strmatch(dummy, option_args); + switch (tt) + case 1 + notched = varargin{indopt}; + case 2 + symbol = varargin{indopt}; + case 3 + vertical = varargin{indopt}; + case 4 + maxwhisker = varargin{indopt}; + otherwise + %# take two args and append them to plot_opts + plot_opts(1, end+1:end+2) = {dummy, varargin{indopt}}; + endswitch + endif + indopt++; numarg -= 2; + endif + endwhile + + if (1 == length (symbol)) symbol(2) = symbol(1); endif + + if (1 == notched) notched = 0.25; endif + a = 1-notched; + + ## figure out how many data sets we have + if (iscell (data)) + nc = length (data); + else + if (isvector (data)) data = data(:); endif + nc = columns (data); + endif + + ## compute statistics + ## s will contain + ## 1,5 min and max + ## 2,3,4 1st, 2nd and 3rd quartile + ## 6,7 lower and upper confidence intervals for median + s = zeros (7,nc); + box = zeros (1,nc); + whisker_x = ones (2,1)*[1:nc,1:nc]; + whisker_y = zeros (2,2*nc); + outliers_x = []; + outliers_y = []; + outliers2_x = []; + outliers2_y = []; + + for indi = (1:nc) + ## Get the next data set from the array or cell array + if (iscell (data)) + col = data{indi}(:); + else + col = data(:, indi); + endif + ## Skip missing data + col(isnan (col) | isna (col)) = []; + ## Remember the data length + nd = length (col); + box(indi) = nd; + if (nd > 1) + ## min,max and quartiles + s(1:5, indi) = statistics (col)(1:5); + ## confidence interval for the median + est = 1.57*(s(4, indi)-s(2, indi))/sqrt (nd); + s(6, indi) = max ([s(3, indi)-est, s(2, indi)]); + s(7, indi) = min ([s(3, indi)+est, s(4, indi)]); + ## whiskers out to the last point within the desired inter-quartile range + IQR = maxwhisker*(s(4, indi)-s(2, indi)); + whisker_y(:, indi) = [min(col(col >= s(2, indi)-IQR)); s(2, indi)]; + whisker_y(:,nc+indi) = [max(col(col <= s(4, indi)+IQR)); s(4, indi)]; + ## outliers beyond 1 and 2 inter-quartile ranges + outliers = col((col < s(2, indi)-IQR & col >= s(2, indi)-2*IQR) | (col > s(4, indi)+IQR & col <= s(4, indi)+2*IQR)); + outliers2 = col(col < s(2, indi)-2*IQR | col > s(4, indi)+2*IQR); + outliers_x = [outliers_x; indi*ones(size(outliers))]; + outliers_y = [outliers_y; outliers]; + outliers2_x = [outliers2_x; indi*ones(size(outliers2))]; + outliers2_y = [outliers2_y; outliers2]; + elseif (1 == nd) + ## all statistics collapse to the value of the point + s(:, indi) = col; + ## single point data sets are plotted as outliers. + outliers_x = [outliers_x; indi]; + outliers_y = [outliers_y; col]; + else + ## no statistics if no points + s(:, indi) = NaN; + end + end + + ## Note which boxes don't have enough stats + chop = find (box <= 1); + + ## Draw a box around the quartiles, with width proportional to the number of + ## items in the box. Draw notches if desired. + box *= 0.4/max (box); + quartile_x = ones (11,1)*[1:nc] + [-a;-1;-1;1;1;a;1;1;-1;-1;-a]*box; + quartile_y = s([3,7,4,4,7,3,6,2,2,6,3],:); + + ## Draw a line through the median + median_x = ones (2,1)*[1:nc] + [-a;+a]*box; + median_y = s([3,3],:); + + ## Chop all boxes which don't have enough stats + quartile_x(:, chop) = []; + quartile_y(:, chop) = []; + whisker_x(:,[chop, chop+nc]) = []; + whisker_y(:,[chop, chop+nc]) = []; + median_x(:, chop) = []; + median_y(:, chop) = []; + + ## Add caps to the remaining whiskers + cap_x = whisker_x; + cap_x(1, :) -= 0.05; + cap_x(2, :) += 0.05; + cap_y = whisker_y([1, 1], :); + + #quartile_x,quartile_y + #whisker_x,whisker_y + #median_x,median_y + #cap_x,cap_y + + ## Do the plot + if (vertical) + if (isempty (plot_opts)) + h = plot (quartile_x, quartile_y, "b;;", + whisker_x, whisker_y, "b;;", + cap_x, cap_y, "b;;", + median_x, median_y, "r;;", + outliers_x, outliers_y, [symbol(1), "r;;"], + outliers2_x, outliers2_y, [symbol(2), "r;;"]); + else + h = plot (quartile_x, quartile_y, "b;;", + whisker_x, whisker_y, "b;;", + cap_x, cap_y, "b;;", + median_x, median_y, "r;;", + outliers_x, outliers_y, [symbol(1), "r;;"], + outliers2_x, outliers2_y, [symbol(2), "r;;"], plot_opts{:}); + endif + else + if (isempty (plot_opts)) + h = plot (quartile_y, quartile_x, "b;;", + whisker_y, whisker_x, "b;;", + cap_y, cap_x, "b;;", + median_y, median_x, "r;;", + outliers_y, outliers_x, [symbol(1), "r;;"], + outliers2_y, outliers2_x, [symbol(2), "r;;"]); + else + h = plot (quartile_y, quartile_x, "b;;", + whisker_y, whisker_x, "b;;", + cap_y, cap_x, "b;;", + median_y, median_x, "r;;", + outliers_y, outliers_x, [symbol(1), "r;;"], + outliers2_y, outliers2_x, [symbol(2), "r;;"], plot_opts{:}); + endif + endif + + % Distribute handles + nq = 1:size(quartile_x,2); + hs.box = h(nq); + nw = nq(end) + [1:2*size(whisker_x,2)]; + hs.whisker = h(nw); + nm = nw(end)+ [1:size(median_x,2)]; + hs.median = h(nm); + + if ~isempty (outliers_y) + no = nm(end) + [1:size(outliers_y,2)]; + hs.outliers = h(no); + end + if ~isempty (outliers2_y) + no2 = no(end) + [1:size(outliers2_y,2)]; + hs.outliers2 = h(no2); + end + +endfunction + +%!demo +%! title ("Grade 3 heights"); +%! axis ([0,3]); +%! tics ("x", 1:2, {"girls"; "boys"}); +%! boxplot ({randn(10,1)*5+140, randn(13,1)*8+135}); diff --git a/octave_packages/statistics-1.1.3/caseread.m b/octave_packages/statistics-1.1.3/caseread.m new file mode 100644 index 0000000..71f5b7b --- /dev/null +++ b/octave_packages/statistics-1.1.3/caseread.m @@ -0,0 +1,61 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{names} =} caseread (@var{filename}) +## Read case names from an ascii file. +## +## Essentially, this reads all lines from a file as text and returns +## them in a string matrix. +## @seealso{casewrite, tblread, tblwrite, csv2cell, cell2csv, fopen} +## @end deftypefn + +## Author: Bill Denney +## Description: Read strings from a file + +function names = caseread (f="") + + ## Check arguments + if nargin != 1 + print_usage (); + endif + if isempty (f) + ## FIXME: open a file dialog box in this case when a file dialog box + ## becomes available + error ("caseread: filename must be given") + endif + + [fid msg] = fopen (f, "rt"); + if fid < 0 || (! isempty (msg)) + error ("caseread: cannot open %s: %s", f, msg); + endif + + names = {}; + t = fgetl (fid); + while ischar (t) + names{end+1} = t; + t = fgetl (fid); + endwhile + if (fclose (fid) < 0) + error ("caseread: error closing f") + endif + names = strvcat (names); + +endfunction + +## Tests +%!shared n +%! n = ["a ";"bcd";"ef "]; +%!assert (caseread ("caseread.dat"), n); diff --git a/octave_packages/statistics-1.1.3/casewrite.m b/octave_packages/statistics-1.1.3/casewrite.m new file mode 100644 index 0000000..6219670 --- /dev/null +++ b/octave_packages/statistics-1.1.3/casewrite.m @@ -0,0 +1,66 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} casewrite (@var{strmat}, @var{filename}) +## Write case names to an ascii file. +## +## Essentially, this writes all lines from @var{strmat} to +## @var{filename} (after deblanking them). +## @seealso{caseread, tblread, tblwrite, csv2cell, cell2csv, fopen} +## @end deftypefn + +## Author: Bill Denney +## Description: Write strings from a file + +function names = casewrite (s="", f="") + + ## Check arguments + if nargin != 2 + print_usage (); + endif + if isempty (f) + ## FIXME: open a file dialog box in this case when a file dialog box + ## becomes available + error ("casewrite: filename must be given") + endif + if isempty (s) + error ("casewrite: strmat must be given") + elseif ! ischar (s) + error ("casewrite: strmat must be a character matrix") + elseif ndims (s) != 2 + error ("casewrite: strmat must be two dimensional") + endif + + [fid msg] = fopen (f, "wt"); + if fid < 0 || (! isempty (msg)) + error ("casewrite: cannot open %s for writing: %s", f, msg); + endif + + for i = 1:rows (s) + status = fputs (fid, sprintf ("%s\n", deblank (s(i,:)))); + endfor + if (fclose (fid) < 0) + error ("casewrite: error closing f") + endif + +endfunction + +## Tests +%!shared s +%! s = ["a ";"bcd";"ef "]; +%!test +%! casewrite (s, "casewrite.dat") +%! assert(caseread ("casewrite.dat"), s); diff --git a/octave_packages/statistics-1.1.3/chi2stat.m b/octave_packages/statistics-1.1.3/chi2stat.m new file mode 100644 index 0000000..2648dfc --- /dev/null +++ b/octave_packages/statistics-1.1.3/chi2stat.m @@ -0,0 +1,92 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} chi2stat (@var{n}) +## Compute mean and variance of the chi-square distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{n} is the parameter of the chi-square distribution. The elements +## of @var{n} must be positive +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the chi-square distribution +## +## @item +## @var{v} is the variance of the chi-square distribution +## @end itemize +## +## @subheading Example +## +## @example +## @group +## n = 1:6; +## [m, v] = chi2stat (n) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the chi-square distribution + +function [m, v] = chi2stat (n) + + # Check arguments + if (nargin != 1) + print_usage (); + endif + + if (! isempty (n) && ! ismatrix (n)) + error ("chi2stat: n must be a numeric matrix"); + endif + + # Calculate moments + m = n; + v = 2 .* n; + + # Continue argument check + k = find (! (n > 0) | ! (n < Inf)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! n = 1:6; +%! [m, v] = chi2stat (n); +%! assert (m, n); +%! assert (v, [2, 4, 6, 8, 10, 12], 0.001); diff --git a/octave_packages/statistics-1.1.3/cl_multinom.m b/octave_packages/statistics-1.1.3/cl_multinom.m new file mode 100644 index 0000000..bf55c56 --- /dev/null +++ b/octave_packages/statistics-1.1.3/cl_multinom.m @@ -0,0 +1,124 @@ +## Copyright (C) 2009 Levente Torok +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## +## @deftypefn {Function File} {@var{CL} =} cl_multinom (@var{x}, @var{N}, @var{b}, @var{calculation_type} ) - Confidence level of multinomial portions +## Returns confidence level of multinomial parameters estimated @math{ p = x / sum(x) } with predefined confidence interval @var{b}. +## Finite population is also considered. +## +## This function calculates the level of confidence at which the samples represent the true distribution +## given that there is a predefined tolerance (confidence interval). +## This is the upside down case of the typical excercises at which we want to get the confidence interval +## given the confidence level (and the estimated parameters of the underlying distribution). +## But once we accept (lets say at elections) that we have a standard predefined +## maximal acceptable error rate (e.g. @var{b}=0.02 ) in the estimation and we just want to know that how sure we +## can be that the measured proportions are the same as in the +## entire population (ie. the expected value and mean of the samples are roghly the same) we need to use this function. +## +## @subheading Arguments +## @itemize @bullet +## @item @var{x} : int vector : sample frequencies bins +## @item @var{N} : int : Population size that was sampled by x. If N 4) + print_usage; + elseif (!ischar (calculation_type)) + error ("Argument calculation_type must be a string"); + endif + + k = rows(x); + nn = sum(x); + p = x / nn; + + if (isscalar( b )) + if (b==0) b=0.02; endif + b = ones( rows(x), 1 ) * b; + + if (b<0) b=1 ./ max( x, 1 ); endif + endif + bb = b .* b; + + if (N==nn) + CL = 1; + return; + endif + + if (N +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{c} =} combnk (@var{data}, @var{k}) +## Return all combinations of @var{k} elements in @var{data}. +## @end deftypefn + +function retval = combnk (data, k) + ## Check input + if (nargin != 2) + print_usage; + elseif (! isvector (data)) + error ("combnk: first input argument must be a vector"); + elseif (!isreal (k) || k != round (k) || k < 0) + error ("combnk: second input argument must be a non-negative integer"); + endif + + ## Simple checks + n = numel (data); + if (k == 0 || k > n) + retval = resize (data, 0, k); + elseif (k == n) + retval = data (:).'; + else + retval = __combnk__ (data, k); + endif + + ## For some odd reason Matlab seems to treat strings differently compared to other data-types... + if (ischar (data)) + retval = flipud (retval); + endif +endfunction + +function retval = __combnk__ (data, k) + ## Recursion stopping criteria + if (k == 1) + retval = data (:); + else + ## Process data + n = numel (data); + if iscell (data) + retval = {}; + else + retval = []; + endif + for j = 1:n + C = __combnk__ (data ((j+1):end), k-1); + C = cat (2, repmat (data (j), rows (C), 1), C); + if (!isempty (C)) + retval = [retval; C]; + endif + endfor + endif +endfunction + +%!demo +%! c = combnk (1:5, 2); +%! disp ("All pairs of integers between 1 and 5:"); +%! disp (c); + +%!test +%! c = combnk (1:3, 2); +%! assert (c, [1, 2; 1, 3; 2, 3]); + +%!test +%! c = combnk (1:3, 6); +%! assert (isempty (c)); + +%!test +%! c = combnk ({1, 2, 3}, 2); +%! assert (c, {1, 2; 1, 3; 2, 3}); + +%!test +%! c = combnk ("hello", 2); +%! assert (c, ["lo"; "lo"; "ll"; "eo"; "el"; "el"; "ho"; "hl"; "hl"; "he"]); diff --git a/octave_packages/statistics-1.1.3/copulacdf.m b/octave_packages/statistics-1.1.3/copulacdf.m new file mode 100644 index 0000000..32d05a4 --- /dev/null +++ b/octave_packages/statistics-1.1.3/copulacdf.m @@ -0,0 +1,288 @@ +## Copyright (C) 2008 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{p} =} copulacdf (@var{family}, @var{x}, @var{theta}) +## @deftypefnx {Function File} {} copulacdf ('t', @var{x}, @var{theta}, @var{nu}) +## Compute the cumulative distribution function of a copula family. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{family} is the copula family name. Currently, @var{family} can +## be @code{'Gaussian'} for the Gaussian family, @code{'t'} for the +## Student's t family, @code{'Clayton'} for the Clayton family, +## @code{'Gumbel'} for the Gumbel-Hougaard family, @code{'Frank'} for +## the Frank family, @code{'AMH'} for the Ali-Mikhail-Haq family, or +## @code{'FGM'} for the Farlie-Gumbel-Morgenstern family. +## +## @item +## @var{x} is the support where each row corresponds to an observation. +## +## @item +## @var{theta} is the parameter of the copula. For the Gaussian and +## Student's t copula, @var{theta} must be a correlation matrix. For +## bivariate copulas @var{theta} can also be a correlation coefficient. +## For the Clayton family, the Gumbel-Hougaard family, the Frank family, +## and the Ali-Mikhail-Haq family, @var{theta} must be a vector with the +## same number of elements as observations in @var{x} or be scalar. For +## the Farlie-Gumbel-Morgenstern family, @var{theta} must be a matrix of +## coefficients for the Farlie-Gumbel-Morgenstern polynomial where each +## row corresponds to one set of coefficients for an observation in +## @var{x}. A single row is expanded. The coefficients are in binary +## order. +## +## @item +## @var{nu} is the degrees of freedom for the Student's t family. +## @var{nu} must be a vector with the same number of elements as +## observations in @var{x} or be scalar. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{p} is the cumulative distribution of the copula at each row of +## @var{x} and corresponding parameter @var{theta}. +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## x = [0.2:0.2:0.6; 0.2:0.2:0.6]; +## theta = [1; 2]; +## p = copulacdf ("Clayton", x, theta) +## @end group +## +## @group +## x = [0.2:0.2:0.6; 0.2:0.1:0.4]; +## theta = [0.2, 0.1, 0.1, 0.05]; +## p = copulacdf ("FGM", x, theta) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Roger B. Nelsen. @cite{An Introduction to Copulas}. Springer, +## New York, second edition, 2006. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: CDF of a copula family + +function p = copulacdf (family, x, theta, nu) + + # Check arguments + if (nargin != 3 && (nargin != 4 || ! strcmpi (family, "t"))) + print_usage (); + endif + + if (! ischar (family)) + error ("copulacdf: family must be one of 'Gaussian', 't', 'Clayton', 'Gumbel', 'Frank', 'AMH', and 'FGM'"); + endif + + if (! isempty (x) && ! ismatrix (x)) + error ("copulacdf: x must be a numeric matrix"); + endif + + [n, d] = size (x); + + lower_family = lower (family); + + # Check family and copula parameters + switch (lower_family) + + case {"gaussian", "t"} + # Family with a covariance matrix + if (d == 2 && isscalar (theta)) + # Expand a scalar to a correlation matrix + theta = [1, theta; theta, 1]; + endif + if (any (size (theta) != [d, d]) || any (diag (theta) != 1) || any (any (theta != theta')) || min (eig (theta)) <= 0) + error ("copulacdf: theta must be a correlation matrix"); + endif + if (nargin == 4) + # Student's t family + if (! isscalar (nu) && (! isvector (nu) || length (nu) != n)) + error ("copulacdf: nu must be a vector with the same number of rows as x or be scalar"); + endif + nu = nu(:); + endif + + case {"clayton", "gumbel", "frank", "amh"} + # Archimedian one parameter family + if (! isvector (theta) || (! isscalar (theta) && length (theta) != n)) + error ("copulacdf: theta must be a vector with the same number of rows as x or be scalar"); + endif + theta = theta(:); + if (n > 1 && isscalar (theta)) + theta = repmat (theta, n, 1); + endif + + case {"fgm"} + # Exponential number of parameters + if (! ismatrix (theta) || size (theta, 2) != (2 .^ d - d - 1) || (size (theta, 1) != 1 && size (theta, 1) != n)) + error ("copulacdf: theta must be a row vector of length 2^d-d-1 or a matrix of size n x (2^d-d-1)"); + endif + if (n > 1 && size (theta, 1) == 1) + theta = repmat (theta, n, 1); + endif + + otherwise + error ("copulacdf: unknown copula family '%s'", family); + + endswitch + + if (n == 0) + # Input is empty + p = zeros (0, 1); + else + # Truncate input to unit hypercube + x(x < 0) = 0; + x(x > 1) = 1; + + # Compute the cumulative distribution function according to family + switch (lower_family) + + case {"gaussian"} + # The Gaussian family + p = mvncdf (norminv (x), zeros (1, d), theta); + # No parameter bounds check + k = []; + + case {"t"} + # The Student's t family + p = mvtcdf (tinv (x, nu), theta, nu); + # No parameter bounds check + k = []; + + case {"clayton"} + # The Clayton family + p = exp (-log (max (sum (x .^ (repmat (-theta, 1, d)), 2) - d + 1, 0)) ./ theta); + # Product copula at columns where theta == 0 + k = find (theta == 0); + if (any (k)) + p(k) = prod (x(k, :), 2); + endif + # Check bounds + if (d > 2) + k = find (! (theta >= 0) | ! (theta < inf)); + else + k = find (! (theta >= -1) | ! (theta < inf)); + endif + + case {"gumbel"} + # The Gumbel-Hougaard family + p = exp (-(sum ((-log (x)) .^ repmat (theta, 1, d), 2)) .^ (1 ./ theta)); + # Check bounds + k = find (! (theta >= 1) | ! (theta < inf)); + + case {"frank"} + # The Frank family + p = -log (1 + (prod (expm1 (repmat (-theta, 1, d) .* x), 2)) ./ (expm1 (-theta) .^ (d - 1))) ./ theta; + # Product copula at columns where theta == 0 + k = find (theta == 0); + if (any (k)) + p(k) = prod (x(k, :), 2); + endif + # Check bounds + if (d > 2) + k = find (! (theta > 0) | ! (theta < inf)); + else + k = find (! (theta > -inf) | ! (theta < inf)); + endif + + case {"amh"} + # The Ali-Mikhail-Haq family + p = (theta - 1) ./ (theta - prod ((1 + repmat (theta, 1, d) .* (x - 1)) ./ x, 2)); + # Check bounds + if (d > 2) + k = find (! (theta >= 0) | ! (theta < 1)); + else + k = find (! (theta >= -1) | ! (theta < 1)); + endif + + case {"fgm"} + # The Farlie-Gumbel-Morgenstern family + # All binary combinations + bcomb = logical (floor (mod (((0:(2 .^ d - 1))' * 2 .^ ((1 - d):0)), 2))); + ecomb = ones (size (bcomb)); + ecomb(bcomb) = -1; + # Summation over all combinations of order >= 2 + bcomb = bcomb(sum (bcomb, 2) >= 2, end:-1:1); + # Linear constraints matrix + ac = zeros (size (ecomb, 1), size (bcomb, 1)); + # Matrix to compute p + ap = zeros (size (x, 1), size (bcomb, 1)); + for i = 1:size (bcomb, 1) + ac(:, i) = -prod (ecomb(:, bcomb(i, :)), 2); + ap(:, i) = prod (1 - x(:, bcomb(i, :)), 2); + endfor + p = prod (x, 2) .* (1 + sum (ap .* theta, 2)); + # Check linear constraints + k = false (n, 1); + for i = 1:n + k(i) = any (ac * theta(i, :)' > 1); + endfor + + endswitch + + # Out of bounds parameters + if (any (k)) + p(k) = NaN; + endif + + endif + +endfunction + +%!test +%! x = [0.2:0.2:0.6; 0.2:0.2:0.6]; +%! theta = [1; 2]; +%! p = copulacdf ("Clayton", x, theta); +%! expected_p = [0.1395; 0.1767]; +%! assert (p, expected_p, 0.001); + +%!test +%! x = [0.2:0.2:0.6; 0.2:0.2:0.6]; +%! p = copulacdf ("Gumbel", x, 2); +%! expected_p = [0.1464; 0.1464]; +%! assert (p, expected_p, 0.001); + +%!test +%! x = [0.2:0.2:0.6; 0.2:0.2:0.6]; +%! theta = [1; 2]; +%! p = copulacdf ("Frank", x, theta); +%! expected_p = [0.0699; 0.0930]; +%! assert (p, expected_p, 0.001); + +%!test +%! x = [0.2:0.2:0.6; 0.2:0.2:0.6]; +%! theta = [0.3; 0.7]; +%! p = copulacdf ("AMH", x, theta); +%! expected_p = [0.0629; 0.0959]; +%! assert (p, expected_p, 0.001); + +%!test +%! x = [0.2:0.2:0.6; 0.2:0.1:0.4]; +%! theta = [0.2, 0.1, 0.1, 0.05]; +%! p = copulacdf ("FGM", x, theta); +%! expected_p = [0.0558; 0.0293]; +%! assert (p, expected_p, 0.001); diff --git a/octave_packages/statistics-1.1.3/copulapdf.m b/octave_packages/statistics-1.1.3/copulapdf.m new file mode 100644 index 0000000..a23841a --- /dev/null +++ b/octave_packages/statistics-1.1.3/copulapdf.m @@ -0,0 +1,194 @@ +## Copyright (C) 2008 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{p} =} copulapdf (@var{family}, @var{x}, @var{theta}) +## Compute the probability density function of a copula family. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{family} is the copula family name. Currently, @var{family} can +## be @code{'Clayton'} for the Clayton family, @code{'Gumbel'} for the +## Gumbel-Hougaard family, @code{'Frank'} for the Frank family, or +## @code{'AMH'} for the Ali-Mikhail-Haq family. +## +## @item +## @var{x} is the support where each row corresponds to an observation. +## +## @item +## @var{theta} is the parameter of the copula. The elements of +## @var{theta} must be greater than or equal to @code{-1} for the +## Clayton family, greater than or equal to @code{1} for the +## Gumbel-Hougaard family, arbitrary for the Frank family, and greater +## than or equal to @code{-1} and lower than @code{1} for the +## Ali-Mikhail-Haq family. Moreover, @var{theta} must be non-negative +## for dimensions greater than @code{2}. @var{theta} must be a column +## vector with the same number of rows as @var{x} or be scalar. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{p} is the probability density of the copula at each row of +## @var{x} and corresponding parameter @var{theta}. +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## x = [0.2:0.2:0.6; 0.2:0.2:0.6]; +## theta = [1; 2]; +## p = copulapdf ("Clayton", x, theta) +## @end group +## +## @group +## p = copulapdf ("Gumbel", x, 2) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Roger B. Nelsen. @cite{An Introduction to Copulas}. Springer, +## New York, second edition, 2006. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: PDF of a copula family + +function p = copulapdf (family, x, theta) + + # Check arguments + if (nargin != 3) + print_usage (); + endif + + if (! ischar (family)) + error ("copulapdf: family must be one of 'Clayton', 'Gumbel', 'Frank', and 'AMH'"); + endif + + if (! isempty (x) && ! ismatrix (x)) + error ("copulapdf: x must be a numeric matrix"); + endif + + [n, d] = size (x); + + if (! isvector (theta) || (! isscalar (theta) && size (theta, 1) != n)) + error ("copulapdf: theta must be a column vector with the same number of rows as x or be scalar"); + endif + + if (n == 0) + # Input is empty + p = zeros (0, 1); + else + if (n > 1 && isscalar (theta)) + theta = repmat (theta, n, 1); + endif + + # Truncate input to unit hypercube + x(x < 0) = 0; + x(x > 1) = 1; + + # Compute the cumulative distribution function according to family + lowerarg = lower (family); + + if (strcmp (lowerarg, "clayton")) + # The Clayton family + log_cdf = -log (max (sum (x .^ (repmat (-theta, 1, d)), 2) - d + 1, 0)) ./ theta; + p = prod (repmat (theta, 1, d) .* repmat (0:(d - 1), n, 1) + 1, 2) .* exp ((1 + theta .* d) .* log_cdf - (theta + 1) .* sum (log (x), 2)); + # Product copula at columns where theta == 0 + k = find (theta == 0); + if (any (k)) + p(k) = 1; + endif + # Check theta + if (d > 2) + k = find (! (theta >= 0) | ! (theta < inf)); + else + k = find (! (theta >= -1) | ! (theta < inf)); + endif + elseif (strcmp (lowerarg, "gumbel")) + # The Gumbel-Hougaard family + g = sum ((-log (x)) .^ repmat (theta, 1, d), 2); + c = exp (-g .^ (1 ./ theta)); + p = ((prod (-log (x), 2)) .^ (theta - 1)) ./ prod (x, 2) .* c .* (g .^ (2 ./ theta - 2) + (theta - 1) .* g .^ (1 ./ theta - 2)); + # Check theta + k = find (! (theta >= 1) | ! (theta < inf)); + elseif (strcmp (lowerarg, "frank")) + # The Frank family + if (d != 2) + error ("copulapdf: Frank copula PDF implemented as bivariate only"); + endif + p = (theta .* exp (theta .* (1 + sum (x, 2))) .* (exp (theta) - 1))./ (exp (theta) - exp (theta + theta .* x(:, 1)) + exp (theta .* sum (x, 2)) - exp (theta + theta .* x(:, 2))) .^ 2; + # Product copula at columns where theta == 0 + k = find (theta == 0); + if (any (k)) + p(k) = 1; + endif + # Check theta + k = find (! (theta > -inf) | ! (theta < inf)); + elseif (strcmp (lowerarg, "amh")) + # The Ali-Mikhail-Haq family + if (d != 2) + error ("copulapdf: Ali-Mikhail-Haq copula PDF implemented as bivariate only"); + endif + z = theta .* prod (x - 1, 2) - 1; + p = (theta .* (1 - sum (x, 2) - prod (x, 2) - z) - 1) ./ (z .^ 3); + # Check theta + k = find (! (theta >= -1) | ! (theta < 1)); + else + error ("copulapdf: unknown copula family '%s'", family); + endif + + if (any (k)) + p(k) = NaN; + endif + + endif + +endfunction + +%!test +%! x = [0.2:0.2:0.6; 0.2:0.2:0.6]; +%! theta = [1; 2]; +%! p = copulapdf ("Clayton", x, theta); +%! expected_p = [0.9872; 0.7295]; +%! assert (p, expected_p, 0.001); + +%!test +%! x = [0.2:0.2:0.6; 0.2:0.2:0.6]; +%! p = copulapdf ("Gumbel", x, 2); +%! expected_p = [0.9468; 0.9468]; +%! assert (p, expected_p, 0.001); + +%!test +%! x = [0.2, 0.6; 0.2, 0.6]; +%! theta = [1; 2]; +%! p = copulapdf ("Frank", x, theta); +%! expected_p = [0.9378; 0.8678]; +%! assert (p, expected_p, 0.001); + +%!test +%! x = [0.2, 0.6; 0.2, 0.6]; +%! theta = [0.3; 0.7]; +%! p = copulapdf ("AMH", x, theta); +%! expected_p = [0.9540; 0.8577]; +%! assert (p, expected_p, 0.001); diff --git a/octave_packages/statistics-1.1.3/copularnd.m b/octave_packages/statistics-1.1.3/copularnd.m new file mode 100644 index 0000000..10033e0 --- /dev/null +++ b/octave_packages/statistics-1.1.3/copularnd.m @@ -0,0 +1,281 @@ +## Copyright (C) 2012 Arno Onken +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} copularnd (@var{family}, @var{theta}, @var{n}) +## @deftypefnx {Function File} {} copularnd (@var{family}, @var{theta}, @var{n}, @var{d}) +## @deftypefnx {Function File} {} copularnd ('t', @var{theta}, @var{nu}, @var{n}) +## Generate random samples from a copula family. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{family} is the copula family name. Currently, @var{family} can be +## @code{'Gaussian'} for the Gaussian family, @code{'t'} for the Student's t +## family, or @code{'Clayton'} for the Clayton family. +## +## @item +## @var{theta} is the parameter of the copula. For the Gaussian and Student's t +## copula, @var{theta} must be a correlation matrix. For bivariate copulas +## @var{theta} can also be a correlation coefficient. For the Clayton family, +## @var{theta} must be a vector with the same number of elements as samples to +## be generated or be scalar. +## +## @item +## @var{nu} is the degrees of freedom for the Student's t family. @var{nu} must +## be a vector with the same number of elements as samples to be generated or +## be scalar. +## +## @item +## @var{n} is the number of rows of the matrix to be generated. @var{n} must be +## a non-negative integer and corresponds to the number of samples to be +## generated. +## +## @item +## @var{d} is the number of columns of the matrix to be generated. @var{d} must +## be a positive integer and corresponds to the dimension of the copula. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{x} is a matrix of random samples from the copula with @var{n} samples +## of distribution dimension @var{d}. +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## theta = 0.5; +## x = copularnd ("Gaussian", theta); +## @end group +## +## @group +## theta = 0.5; +## nu = 2; +## x = copularnd ("t", theta, nu); +## @end group +## +## @group +## theta = 0.5; +## n = 2; +## x = copularnd ("Clayton", theta, n); +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Roger B. Nelsen. @cite{An Introduction to Copulas}. Springer, New York, +## second edition, 2006. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Random samples from a copula family + +function x = copularnd (family, theta, nu, n) + + # Check arguments + if (nargin < 2) + print_usage (); + endif + + if (! ischar (family)) + error ("copularnd: family must be one of 'Gaussian', 't', and 'Clayton'"); + endif + + lower_family = lower (family); + + # Check family and copula parameters + switch (lower_family) + + case {"gaussian"} + # Gaussian family + if (isscalar (theta)) + # Expand a scalar to a correlation matrix + theta = [1, theta; theta, 1]; + endif + if (! ismatrix (theta) || any (diag (theta) != 1) || any (any (theta != theta')) || min (eig (theta)) <= 0) + error ("copularnd: theta must be a correlation matrix"); + endif + if (nargin > 3) + d = n; + if (! isscalar (d) || d != size (theta, 1)) + error ("copularnd: d must correspond to dimension of theta"); + endif + else + d = size (theta, 1); + endif + if (nargin < 3) + n = 1; + else + n = nu; + if (! isscalar (n) || (n < 0) || round (n) != n) + error ("copularnd: n must be a non-negative integer"); + endif + endif + + case {"t"} + # Student's t family + if (nargin < 3) + print_usage (); + endif + if (isscalar (theta)) + # Expand a scalar to a correlation matrix + theta = [1, theta; theta, 1]; + endif + if (! ismatrix (theta) || any (diag (theta) != 1) || any (any (theta != theta')) || min (eig (theta)) <= 0) + error ("copularnd: theta must be a correlation matrix"); + endif + if (! isscalar (nu) && (! isvector (nu) || length (nu) != n)) + error ("copularnd: nu must be a vector with the same number of rows as x or be scalar"); + endif + nu = nu(:); + if (nargin < 4) + n = 1; + else + if (! isscalar (n) || (n < 0) || round (n) != n) + error ("copularnd: n must be a non-negative integer"); + endif + endif + + case {"clayton"} + # Archimedian one parameter family + if (nargin < 4) + # Default is bivariate + d = 2; + else + d = n; + if (! isscalar (d) || (d < 2) || round (d) != d) + error ("copularnd: d must be an integer greater than 1"); + endif + endif + if (nargin < 3) + # Default is one sample + n = 1; + else + n = nu; + if (! isscalar (n) || (n < 0) || round (n) != n) + error ("copularnd: n must be a non-negative integer"); + endif + endif + if (! isvector (theta) || (! isscalar (theta) && size (theta, 1) != n)) + error ("copularnd: theta must be a column vector with the number of rows equal to n or be scalar"); + endif + if (n > 1 && isscalar (theta)) + theta = repmat (theta, n, 1); + endif + + otherwise + error ("copularnd: unknown copula family '%s'", family); + + endswitch + + if (n == 0) + # Input is empty + x = zeros (0, d); + else + + # Draw random samples according to family + switch (lower_family) + + case {"gaussian"} + # The Gaussian family + x = normcdf (mvnrnd (zeros (1, d), theta, n), 0, 1); + # No parameter bounds check + k = []; + + case {"t"} + # The Student's t family + x = tcdf (mvtrnd (theta, nu, n), nu); + # No parameter bounds check + k = []; + + case {"clayton"} + # The Clayton family + u = rand (n, d); + if (d == 2) + x = zeros (n, 2); + # Conditional distribution method for the bivariate case which also + # works for theta < 0 + x(:, 1) = u(:, 1); + x(:, 2) = (1 + u(:, 1) .^ (-theta) .* (u(:, 2) .^ (-theta ./ (1 + theta)) - 1)) .^ (-1 ./ theta); + else + # Apply the algorithm by Marshall and Olkin: + # Frailty distribution for Clayton copula is gamma + y = randg (1 ./ theta, n, 1); + x = (1 - log (u) ./ repmat (y, 1, d)) .^ (-1 ./ repmat (theta, 1, d)); + endif + k = find (theta == 0); + if (any (k)) + # Produkt copula at columns k + x(k, :) = u(k, :); + endif + # Continue argument check + if (d == 2) + k = find (! (theta >= -1) | ! (theta < inf)); + else + k = find (! (theta >= 0) | ! (theta < inf)); + endif + + endswitch + + # Out of bounds parameters + if (any (k)) + x(k, :) = NaN; + endif + + endif + +endfunction + +%!test +%! theta = 0.5; +%! x = copularnd ("Gaussian", theta); +%! assert (size (x), [1, 2]); +%! assert (all ((x >= 0) & (x <= 1))); + +%!test +%! theta = 0.5; +%! nu = 2; +%! x = copularnd ("t", theta, nu); +%! assert (size (x), [1, 2]); +%! assert (all ((x >= 0) & (x <= 1))); + +%!test +%! theta = 0.5; +%! x = copularnd ("Clayton", theta); +%! assert (size (x), [1, 2]); +%! assert (all ((x >= 0) & (x <= 1))); + +%!test +%! theta = 0.5; +%! n = 2; +%! x = copularnd ("Clayton", theta, n); +%! assert (size (x), [n, 2]); +%! assert (all ((x >= 0) & (x <= 1))); + +%!test +%! theta = [1; 2]; +%! n = 2; +%! d = 3; +%! x = copularnd ("Clayton", theta, n, d); +%! assert (size (x), [n, d]); +%! assert (all ((x >= 0) & (x <= 1))); diff --git a/octave_packages/statistics-1.1.3/doc-cache b/octave_packages/statistics-1.1.3/doc-cache new file mode 100644 index 0000000..468a61b --- /dev/null +++ b/octave_packages/statistics-1.1.3/doc-cache @@ -0,0 +1,4344 @@ +# Created by Octave 3.6.1, Sun May 13 12:55:35 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 77 +# name: +# type: sq_string +# elements: 1 +# length: 20 +anderson_darling_cdf + + +# name: +# type: sq_string +# elements: 1 +# length: 2184 + -- Function File: P = anderson_darling_cdf (A, N) + Return the CDF for the given Anderson-Darling coefficient A + computed from N values sampled from a distribution. For a vector + of random variables X of length N, compute the CDF of the values + from the distribution from which they are drawn. You can uses + these values to compute A as follows: + + A = -N - sum( (2*i-1) .* (log(X) + log(1 - X(N:-1:1,:))) )/N; + + From the value A, `anderson_darling_cdf' returns the probability + that A could be returned from a set of samples. + + The algorithm given in [1] claims to be an approximation for the + Anderson-Darling CDF accurate to 6 decimal points. + + Demonstrate using: + + n = 300; reps = 10000; + z = randn(n, reps); + x = sort ((1 + erf (z/sqrt (2)))/2); + i = [1:n]' * ones (1, size (x, 2)); + A = -n - sum ((2*i-1) .* (log (x) + log (1 - x (n:-1:1, :))))/n; + p = anderson_darling_cdf (A, n); + hist (100 * p, [1:100] - 0.5); + + You will see that the histogram is basically flat, which is to say + that the probabilities returned by the Anderson-Darling CDF are + distributed uniformly. + + You can easily determine the extreme values of P: + + [junk, idx] = sort (p); + + The histograms of various P aren't very informative: + + histfit (z (:, idx (1)), linspace (-3, 3, 15)); + histfit (z (:, idx (end/2)), linspace (-3, 3, 15)); + histfit (z (:, idx (end)), linspace (-3, 3, 15)); + + More telling is the qqplot: + + qqplot (z (:, idx (1))); hold on; plot ([-3, 3], [-3, 3], ';;'); hold off; + qqplot (z (:, idx (end/2))); hold on; plot ([-3, 3], [-3, 3], ';;'); hold off; + qqplot (z (:, idx (end))); hold on; plot ([-3, 3], [-3, 3], ';;'); hold off; + + Try a similarly analysis for Z uniform: + + z = rand (n, reps); x = sort(z); + + and for Z exponential: + + z = rande (n, reps); x = sort (1 - exp (-z)); + + [1] Marsaglia, G; Marsaglia JCW; (2004) "Evaluating the Anderson + Darling distribution", Journal of Statistical Software, 9(2). + + See also: anderson_darling_test + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Return the CDF for the given Anderson-Darling coefficient A computed +from N valu + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +anderson_darling_test + + +# name: +# type: sq_string +# elements: 1 +# length: 1834 + -- Function File: [Q, ASQ, INFO] = = anderson_darling_test (X, + DISTRIBUTION) + Test the hypothesis that X is selected from the given distribution + using the Anderson-Darling test. If the returned Q is small, + reject the hypothesis at the Q*100% level. + + The Anderson-Darling A^2 statistic is calculated as follows: + + n + A^2_n = -n - SUM (2i-1)/n log(z_i (1 - z_{n-i+1})) + i=1 + + where z_i is the ordered position of the X's in the CDF of the + distribution. Unlike the Kolmogorov-Smirnov statistic, the + Anderson-Darling statistic is sensitive to the tails of the + distribution. + + The DISTRIBUTION argument must be a either "uniform", "normal", or + "exponential". + + For "normal"' and "exponential" distributions, estimate the + distribution parameters from the data, convert the values to CDF + values, and compare the result to tabluated critical values. This + includes an correction for small N which works well enough for N + >= 8, but less so from smaller N. The returned + `info.Asq_corrected' contains the adjusted statistic. + + For "uniform", assume the values are uniformly distributed in + (0,1), compute A^2 and return the corresponding p-value from + `1-anderson_darling_cdf(A^2,n)'. + + If you are selecting from a known distribution, convert your + values into CDF values for the distribution and use "uniform". Do + not use "uniform" if the distribution parameters are estimated + from the data itself, as this sharply biases the A^2 statistic + toward smaller values. + + [1] Stephens, MA; (1986), "Tests based on EDF statistics", in + D'Agostino, RB; Stephens, MA; (eds.) Goodness-of-fit Techinques. + New York: Dekker. + + See also: anderson_darling_cdf + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Test the hypothesis that X is selected from the given distribution +using the And + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +anovan + + +# name: +# type: sq_string +# elements: 1 +# length: 1504 + -- Function File: [PVAL, F, DF_B, DF_E] = anovan (DATA, GRPS) + -- Function File: [PVAL, F, DF_B, DF_E] = anovan (DATA, GRPS, + 'param1', VALUE1) + Perform a multi-way analysis of variance (ANOVA). The goal is to + test whether the population means of data taken from K different + groups are all equal. + + Data is a single vector DATA with groups specified by a + corresponding matrix of group labels GRPS, where GRPS has the same + number of rows as DATA. For example, if DATA = [1.1;1.2]; GRPS= + [1,2,1; 1,5,2]; then data point 1.1 was measured under conditions + 1,2,1 and data point 1.2 was measured under conditions 1,5,2. + Note that groups do not need to be sequentially numbered. + + By default, a 'linear' model is used, computing the N main effects + with no interactions. this may be modified by param 'model' + + p= anovan(data,groups, 'model', modeltype) - modeltype = 'linear': + compute N main effects - modeltype = 'interaction': compute N + effects and N*(N-1) two-factor + interactions - modeltype = 'full': compute interactions at all + levels + + Under the null of constant means, the statistic F follows an F + distribution with DF_B and DF_E degrees of freedom. + + The p-value (1 minus the CDF of this distribution at F) is + returned in PVAL. + + If no output argument is given, the standard one-way ANOVA table is + printed. + + BUG: DFE is incorrect for modeltypes != full + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Perform a multi-way analysis of variance (ANOVA). + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +betastat + + +# name: +# type: sq_string +# elements: 1 +# length: 993 + -- Function File: [M, V] = betastat (A, B) + Compute mean and variance of the beta distribution. + +Arguments +--------- + + * A is the first parameter of the beta distribution. A must be + positive + + * B is the second parameter of the beta distribution. B must be + positive + A and B must be of common size or one of them must be scalar + +Return values +------------- + + * M is the mean of the beta distribution + + * V is the variance of the beta distribution + +Examples +-------- + + a = 1:6; + b = 1:0.2:2; + [m, v] = betastat (a, b) + + [m, v] = betastat (a, 1.5) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Compute mean and variance of the beta distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +binostat + + +# name: +# type: sq_string +# elements: 1 +# length: 1057 + -- Function File: [M, V] = binostat (N, P) + Compute mean and variance of the binomial distribution. + +Arguments +--------- + + * N is the first parameter of the binomial distribution. The + elements of N must be natural numbers + + * P is the second parameter of the binomial distribution. The + elements of P must be probabilities + N and P must be of common size or one of them must be scalar + +Return values +------------- + + * M is the mean of the binomial distribution + + * V is the variance of the binomial distribution + +Examples +-------- + + n = 1:6; + p = 0:0.2:1; + [m, v] = binostat (n, p) + + [m, v] = binostat (n, 0.5) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Compute mean and variance of the binomial distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +boxplot + + +# name: +# type: sq_string +# elements: 1 +# length: 2363 + -- Function File: S = boxplot (DATA, NOTCHED, SYMBOL, VERTICAL, + MAXWHISKER, ...) + -- Function File: [... H]= boxplot (...) + Produce a box plot. + + The box plot is a graphical display that simultaneously describes + several important features of a data set, such as center, spread, + departure from symmetry, and identification of observations that + lie unusually far from the bulk of the data. + + DATA is a matrix with one column for each data set, or data is a + cell vector with one cell for each data set. + + NOTCHED = 1 produces a notched-box plot. Notches represent a robust + estimate of the uncertainty about the median. + + NOTCHED = 0 (default) produces a rectangular box plot. + + NOTCHED in (0,1) produces a notch of the specified depth. notched + values outside (0,1) are amusing if not exactly practical. + + SYMBOL sets the symbol for the outlier values, default symbol for + points that lie outside 3 times the interquartile range is 'o', + default symbol for points between 1.5 and 3 times the interquartile + range is '+'. + + SYMBOL = '.' points between 1.5 and 3 times the IQR is marked with + '.' and points outside 3 times IQR with 'o'. + + SYMBOL = ['x','*'] points between 1.5 and 3 times the IQR is + marked with 'x' and points outside 3 times IQR with '*'. + + VERTICAL = 0 makes the boxes horizontal, by default VERTICAL = 1. + + MAXWHISKER defines the length of the whiskers as a function of the + IQR (default = 1.5). If MAXWHISKER = 0 then `boxplot' displays all + data values outside the box using the plotting symbol for points + that lie outside 3 times the IQR. + + Supplemental arguments are concatenated and passed to plot. + + The returned matrix S has one column for each data set as follows: + + 1 Minimum + 2 1st quartile + 3 2nd quartile (median) + 4 3rd quartile + 5 Maximum + 6 Lower confidence limit for median + 7 Upper confidence limit for median + + The returned structure H has hanldes to the plot elements, allowing + customization of the visualization using set/get functions. + + Example + + title ("Grade 3 heights"); + axis ([0,3]); + tics ("x", 1:2, {"girls"; "boys"}); + boxplot ({randn(10,1)*5+140, randn(13,1)*8+135}); + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +Produce a box plot. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +caseread + + +# name: +# type: sq_string +# elements: 1 +# length: 264 + -- Function File: NAMES = caseread (FILENAME) + Read case names from an ascii file. + + Essentially, this reads all lines from a file as text and returns + them in a string matrix. + + See also: casewrite, tblread, tblwrite, csv2cell, cell2csv, fopen + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 35 +Read case names from an ascii file. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +casewrite + + +# name: +# type: sq_string +# elements: 1 +# length: 257 + -- Function File: casewrite (STRMAT, FILENAME) + Write case names to an ascii file. + + Essentially, this writes all lines from STRMAT to FILENAME (after + deblanking them). + + See also: caseread, tblread, tblwrite, csv2cell, cell2csv, fopen + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Write case names to an ascii file. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +chi2stat + + +# name: +# type: sq_string +# elements: 1 +# length: 800 + -- Function File: [M, V] = chi2stat (N) + Compute mean and variance of the chi-square distribution. + +Arguments +--------- + + * N is the parameter of the chi-square distribution. The + elements of N must be positive + +Return values +------------- + + * M is the mean of the chi-square distribution + + * V is the variance of the chi-square distribution + +Example +------- + + n = 1:6; + [m, v] = chi2stat (n) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 +Compute mean and variance of the chi-square distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +cl_multinom + + +# name: +# type: sq_string +# elements: 1 +# length: 2978 + -- Function File: CL = cl_multinom (X, N, B, CALCULATION_TYPE ) - + Confidence level of multinomial portions + Returns confidence level of multinomial parameters estimated p = + x / sum(x) with predefined confidence interval B. Finite + population is also considered. + + This function calculates the level of confidence at which the + samples represent the true distribution given that there is a + predefined tolerance (confidence interval). This is the upside + down case of the typical excercises at which we want to get the + confidence interval given the confidence level (and the estimated + parameters of the underlying distribution). But once we accept + (lets say at elections) that we have a standard predefined maximal + acceptable error rate (e.g. B=0.02 ) in the estimation and we just + want to know that how sure we can be that the measured proportions + are the same as in the entire population (ie. the expected value + and mean of the samples are roghly the same) we need to use this + function. + +Arguments +--------- + + * X : int vector : sample frequencies bins + + * N : int : Population size that was sampled by x. If + N +# type: sq_string +# elements: 1 +# length: 80 +Returns confidence level of multinomial parameters estimated p = x / +sum(x) wi + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +combnk + + +# name: +# type: sq_string +# elements: 1 +# length: 93 + -- Function File: C = combnk (DATA, K) + Return all combinations of K elements in DATA. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Return all combinations of K elements in DATA. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +copulacdf + + +# name: +# type: sq_string +# elements: 1 +# length: 2148 + -- Function File: P = copulacdf (FAMILY, X, THETA) + -- Function File: copulacdf ('t', X, THETA, NU) + Compute the cumulative distribution function of a copula family. + +Arguments +--------- + + * FAMILY is the copula family name. Currently, FAMILY can be + `'Gaussian'' for the Gaussian family, `'t'' for the Student's + t family, `'Clayton'' for the Clayton family, `'Gumbel'' for + the Gumbel-Hougaard family, `'Frank'' for the Frank family, + `'AMH'' for the Ali-Mikhail-Haq family, or `'FGM'' for the + Farlie-Gumbel-Morgenstern family. + + * X is the support where each row corresponds to an observation. + + * THETA is the parameter of the copula. For the Gaussian and + Student's t copula, THETA must be a correlation matrix. For + bivariate copulas THETA can also be a correlation coefficient. + For the Clayton family, the Gumbel-Hougaard family, the Frank + family, and the Ali-Mikhail-Haq family, THETA must be a + vector with the same number of elements as observations in X + or be scalar. For the Farlie-Gumbel-Morgenstern family, THETA + must be a matrix of coefficients for the + Farlie-Gumbel-Morgenstern polynomial where each row + corresponds to one set of coefficients for an observation in + X. A single row is expanded. The coefficients are in binary + order. + + * NU is the degrees of freedom for the Student's t family. NU + must be a vector with the same number of elements as + observations in X or be scalar. + +Return values +------------- + + * P is the cumulative distribution of the copula at each row of + X and corresponding parameter THETA. + +Examples +-------- + + x = [0.2:0.2:0.6; 0.2:0.2:0.6]; + theta = [1; 2]; + p = copulacdf ("Clayton", x, theta) + + x = [0.2:0.2:0.6; 0.2:0.1:0.4]; + theta = [0.2, 0.1, 0.1, 0.05]; + p = copulacdf ("FGM", x, theta) + +References +---------- + + 1. Roger B. Nelsen. `An Introduction to Copulas'. Springer, New + York, second edition, 2006. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 +Compute the cumulative distribution function of a copula family. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +copulapdf + + +# name: +# type: sq_string +# elements: 1 +# length: 1451 + -- Function File: P = copulapdf (FAMILY, X, THETA) + Compute the probability density function of a copula family. + +Arguments +--------- + + * FAMILY is the copula family name. Currently, FAMILY can be + `'Clayton'' for the Clayton family, `'Gumbel'' for the + Gumbel-Hougaard family, `'Frank'' for the Frank family, or + `'AMH'' for the Ali-Mikhail-Haq family. + + * X is the support where each row corresponds to an observation. + + * THETA is the parameter of the copula. The elements of THETA + must be greater than or equal to `-1' for the Clayton family, + greater than or equal to `1' for the Gumbel-Hougaard family, + arbitrary for the Frank family, and greater than or equal to + `-1' and lower than `1' for the Ali-Mikhail-Haq family. + Moreover, THETA must be non-negative for dimensions greater + than `2'. THETA must be a column vector with the same number + of rows as X or be scalar. + +Return values +------------- + + * P is the probability density of the copula at each row of X + and corresponding parameter THETA. + +Examples +-------- + + x = [0.2:0.2:0.6; 0.2:0.2:0.6]; + theta = [1; 2]; + p = copulapdf ("Clayton", x, theta) + + p = copulapdf ("Gumbel", x, 2) + +References +---------- + + 1. Roger B. Nelsen. `An Introduction to Copulas'. Springer, New + York, second edition, 2006. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 60 +Compute the probability density function of a copula family. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +copularnd + + +# name: +# type: sq_string +# elements: 1 +# length: 1852 + -- Function File: X = copularnd (FAMILY, THETA, N) + -- Function File: copularnd (FAMILY, THETA, N, D) + -- Function File: copularnd ('t', THETA, NU, N) + Generate random samples from a copula family. + +Arguments +--------- + + * FAMILY is the copula family name. Currently, FAMILY can be + `'Gaussian'' for the Gaussian family, `'t'' for the Student's + t family, or `'Clayton'' for the Clayton family. + + * THETA is the parameter of the copula. For the Gaussian and + Student's t copula, THETA must be a correlation matrix. For + bivariate copulas THETA can also be a correlation + coefficient. For the Clayton family, THETA must be a vector + with the same number of elements as samples to be generated + or be scalar. + + * NU is the degrees of freedom for the Student's t family. NU + must be a vector with the same number of elements as samples + to be generated or be scalar. + + * N is the number of rows of the matrix to be generated. N must + be a non-negative integer and corresponds to the number of + samples to be generated. + + * D is the number of columns of the matrix to be generated. D + must be a positive integer and corresponds to the dimension + of the copula. + +Return values +------------- + + * X is a matrix of random samples from the copula with N samples + of distribution dimension D. + +Examples +-------- + + theta = 0.5; + x = copularnd ("Gaussian", theta); + + theta = 0.5; + nu = 2; + x = copularnd ("t", theta, nu); + + theta = 0.5; + n = 2; + x = copularnd ("Clayton", theta, n); + +References +---------- + + 1. Roger B. Nelsen. `An Introduction to Copulas'. Springer, New + York, second edition, 2006. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Generate random samples from a copula family. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +expstat + + +# name: +# type: sq_string +# elements: 1 +# length: 802 + -- Function File: [M, V] = expstat (L) + Compute mean and variance of the exponential distribution. + +Arguments +--------- + + * L is the parameter of the exponential distribution. The + elements of L must be positive + +Return values +------------- + + * M is the mean of the exponential distribution + + * V is the variance of the exponential distribution + +Example +------- + + l = 1:6; + [m, v] = expstat (l) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Compute mean and variance of the exponential distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +ff2n + + +# name: +# type: sq_string +# elements: 1 +# length: 100 + -- Function File: ff2n (N) + Full-factor design with n binary terms. + + See also: fullfact + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 39 +Full-factor design with n binary terms. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +fstat + + +# name: +# type: sq_string +# elements: 1 +# length: 1120 + -- Function File: [MN, V] = fstat (M, N) + Compute mean and variance of the F distribution. + +Arguments +--------- + + * M is the first parameter of the F distribution. The elements + of M must be positive + + * N is the second parameter of the F distribution. The elements + of N must be positive + M and N must be of common size or one of them must be scalar + +Return values +------------- + + * MN is the mean of the F distribution. The mean is undefined + for N not greater than 2 + + * V is the variance of the F distribution. The variance is + undefined for N not greater than 4 + +Examples +-------- + + m = 1:6; + n = 5:10; + [mn, v] = fstat (m, n) + + [mn, v] = fstat (m, 5) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Compute mean and variance of the F distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +fullfact + + +# name: +# type: sq_string +# elements: 1 +# length: 264 + -- Function File: fullfact (N) + Full factorial design. + + If N is a scalar, return the full factorial design with N binary + choices, 0 and 1. + + If N is a vector, return the full factorial design with choices 1 + through N_I for each factor I. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +Full factorial design. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +gamfit + + +# name: +# type: sq_string +# elements: 1 +# length: 170 + -- Function File: [A B] = gamfit (R) + Finds the maximumlikelihood estimator for the Gamma distribution + for R + + See also: gampdf, gaminv, gamrnd, gamlike + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +Finds the maximumlikelihood estimator for the Gamma distribution for R + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +gamlike + + +# name: +# type: sq_string +# elements: 1 +# length: 226 + -- Function File: X = gamlike ([A B], R) + Calculates the negative log-likelihood function for the Gamma + distribution over vector R, with the given parameters A and B. + + See also: gampdf, gaminv, gamrnd, gamfit + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Calculates the negative log-likelihood function for the Gamma +distribution over + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +gamstat + + +# name: +# type: sq_string +# elements: 1 +# length: 995 + -- Function File: [M, V] = gamstat (A, B) + Compute mean and variance of the gamma distribution. + +Arguments +--------- + + * A is the first parameter of the gamma distribution. A must be + positive + + * B is the second parameter of the gamma distribution. B must be + positive + A and B must be of common size or one of them must be scalar + +Return values +------------- + + * M is the mean of the gamma distribution + + * V is the variance of the gamma distribution + +Examples +-------- + + a = 1:6; + b = 1:0.2:2; + [m, v] = gamstat (a, b) + + [m, v] = gamstat (a, 1.5) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 +Compute mean and variance of the gamma distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +geomean + + +# name: +# type: sq_string +# elements: 1 +# length: 177 + -- Function File: geomean (X) + -- Function File: geomean (X, DIM) + Compute the geometric mean. + + This function does the same as `mean (x, "g")'. + + See also: mean + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 27 +Compute the geometric mean. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +geostat + + +# name: +# type: sq_string +# elements: 1 +# length: 811 + -- Function File: [M, V] = geostat (P) + Compute mean and variance of the geometric distribution. + +Arguments +--------- + + * P is the rate parameter of the geometric distribution. The + elements of P must be probabilities + +Return values +------------- + + * M is the mean of the geometric distribution + + * V is the variance of the geometric distribution + +Example +------- + + p = 1 ./ (1:6); + [m, v] = geostat (p) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 +Compute mean and variance of the geometric distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +harmmean + + +# name: +# type: sq_string +# elements: 1 +# length: 178 + -- Function File: harmmean (X) + -- Function File: harmmean (X, DIM) + Compute the harmonic mean. + + This function does the same as `mean (x, "h")'. + + See also: mean + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 +Compute the harmonic mean. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +histfit + + +# name: +# type: sq_string +# elements: 1 +# length: 412 + -- Function File: histfit (DATA, NBINS) + Plot histogram with superimposed fitted normal density. + + `histfit (DATA, NBINS)' plots a histogram of the values in the + vector DATA using NBINS bars in the histogram. With one input + argument, NBINS is set to the square root of the number of + elements in data. + + Example + + histfit (randn (100, 1)) + + See also: bar, hist, pareto + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Plot histogram with superimposed fitted normal density. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +hmmestimate + + +# name: +# type: sq_string +# elements: 1 +# length: 4098 + -- Function File: [TRANSPROBEST, OUTPROBEST] = hmmestimate (SEQUENCE, + STATES) + -- Function File: hmmestimate (..., 'statenames', STATENAMES) + -- Function File: hmmestimate (..., 'symbols', SYMBOLS) + -- Function File: hmmestimate (..., 'pseudotransitions', + PSEUDOTRANSITIONS) + -- Function File: hmmestimate (..., 'pseudoemissions', + PSEUDOEMISSIONS) + Estimate the matrix of transition probabilities and the matrix of + output probabilities of a given sequence of outputs and states + generated by a hidden Markov model. The model assumes that the + generation starts in state `1' at step `0' but does not include + step `0' in the generated states and sequence. + +Arguments +--------- + + * SEQUENCE is a vector of a sequence of given outputs. The + outputs must be integers ranging from `1' to the number of + outputs of the hidden Markov model. + + * STATES is a vector of the same length as SEQUENCE of given + states. The states must be integers ranging from `1' to the + number of states of the hidden Markov model. + +Return values +------------- + + * TRANSPROBEST is the matrix of the estimated transition + probabilities of the states. `transprobest(i, j)' is the + estimated probability of a transition to state `j' given + state `i'. + + * OUTPROBEST is the matrix of the estimated output + probabilities. `outprobest(i, j)' is the estimated + probability of generating output `j' given state `i'. + + If `'symbols'' is specified, then SEQUENCE is expected to be a +sequence of the elements of SYMBOLS instead of integers. SYMBOLS can +be a cell array. + + If `'statenames'' is specified, then STATES is expected to be a +sequence of the elements of STATENAMES instead of integers. STATENAMES +can be a cell array. + + If `'pseudotransitions'' is specified then the integer matrix +PSEUDOTRANSITIONS is used as an initial number of counted transitions. +`pseudotransitions(i, j)' is the initial number of counted transitions +from state `i' to state `j'. TRANSPROBEST will have the same size as +PSEUDOTRANSITIONS. Use this if you have transitions that are very +unlikely to occur. + + If `'pseudoemissions'' is specified then the integer matrix +PSEUDOEMISSIONS is used as an initial number of counted outputs. +`pseudoemissions(i, j)' is the initial number of counted outputs `j' +given state `i'. If `'pseudoemissions'' is also specified then the +number of rows of PSEUDOEMISSIONS must be the same as the number of +rows of PSEUDOTRANSITIONS. OUTPROBEST will have the same size as +PSEUDOEMISSIONS. Use this if you have outputs or states that are very +unlikely to occur. + +Examples +-------- + + transprob = [0.8, 0.2; 0.4, 0.6]; + outprob = [0.2, 0.4, 0.4; 0.7, 0.2, 0.1]; + [sequence, states] = hmmgenerate (25, transprob, outprob); + [transprobest, outprobest] = hmmestimate (sequence, states) + + symbols = {'A', 'B', 'C'}; + statenames = {'One', 'Two'}; + [sequence, states] = hmmgenerate (25, transprob, outprob, + 'symbols', symbols, 'statenames', statenames); + [transprobest, outprobest] = hmmestimate (sequence, states, + 'symbols', symbols, + 'statenames', statenames) + + pseudotransitions = [8, 2; 4, 6]; + pseudoemissions = [2, 4, 4; 7, 2, 1]; + [sequence, states] = hmmgenerate (25, transprob, outprob); + [transprobest, outprobest] = hmmestimate (sequence, states, 'pseudotransitions', pseudotransitions, 'pseudoemissions', pseudoemissions) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Lawrence R. Rabiner. A Tutorial on Hidden Markov Models and + Selected Applications in Speech Recognition. `Proceedings of + the IEEE', 77(2), pages 257-286, February 1989. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Estimate the matrix of transition probabilities and the matrix of output +probabi + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +hmmgenerate + + +# name: +# type: sq_string +# elements: 1 +# length: 2406 + -- Function File: [SEQUENCE, STATES] = hmmgenerate (LEN, TRANSPROB, + OUTPROB) + -- Function File: hmmgenerate (..., 'symbols', SYMBOLS) + -- Function File: hmmgenerate (..., 'statenames', STATENAMES) + Generate an output sequence and hidden states of a hidden Markov + model. The model starts in state `1' at step `0' but will not + include step `0' in the generated states and sequence. + +Arguments +--------- + + * LEN is the number of steps to generate. SEQUENCE and STATES + will have LEN entries each. + + * TRANSPROB is the matrix of transition probabilities of the + states. `transprob(i, j)' is the probability of a transition + to state `j' given state `i'. + + * OUTPROB is the matrix of output probabilities. `outprob(i, + j)' is the probability of generating output `j' given state + `i'. + +Return values +------------- + + * SEQUENCE is a vector of length LEN of the generated outputs. + The outputs are integers ranging from `1' to `columns + (outprob)'. + + * STATES is a vector of length LEN of the generated hidden + states. The states are integers ranging from `1' to `columns + (transprob)'. + + If `'symbols'' is specified, then the elements of SYMBOLS are used +for the output sequence instead of integers ranging from `1' to +`columns (outprob)'. SYMBOLS can be a cell array. + + If `'statenames'' is specified, then the elements of STATENAMES +are used for the states instead of integers ranging from `1' to +`columns (transprob)'. STATENAMES can be a cell array. + +Examples +-------- + + transprob = [0.8, 0.2; 0.4, 0.6]; + outprob = [0.2, 0.4, 0.4; 0.7, 0.2, 0.1]; + [sequence, states] = hmmgenerate (25, transprob, outprob) + + symbols = {'A', 'B', 'C'}; + statenames = {'One', 'Two'}; + [sequence, states] = hmmgenerate (25, transprob, outprob, + 'symbols', symbols, 'statenames', statenames) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Lawrence R. Rabiner. A Tutorial on Hidden Markov Models and + Selected Applications in Speech Recognition. `Proceedings of + the IEEE', 77(2), pages 257-286, February 1989. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 71 +Generate an output sequence and hidden states of a hidden Markov model. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +hmmviterbi + + +# name: +# type: sq_string +# elements: 1 +# length: 2559 + -- Function File: VPATH = hmmviterbi (SEQUENCE, TRANSPROB, OUTPROB) + -- Function File: hmmviterbi (..., 'symbols', SYMBOLS) + -- Function File: hmmviterbi (..., 'statenames', STATENAMES) + Use the Viterbi algorithm to find the Viterbi path of a hidden + Markov model given a sequence of outputs. The model assumes that + the generation starts in state `1' at step `0' but does not + include step `0' in the generated states and sequence. + +Arguments +--------- + + * SEQUENCE is the vector of length LEN of given outputs. The + outputs must be integers ranging from `1' to `columns + (outprob)'. + + * TRANSPROB is the matrix of transition probabilities of the + states. `transprob(i, j)' is the probability of a transition + to state `j' given state `i'. + + * OUTPROB is the matrix of output probabilities. `outprob(i, + j)' is the probability of generating output `j' given state + `i'. + +Return values +------------- + + * VPATH is the vector of the same length as SEQUENCE of the + estimated hidden states. The states are integers ranging from + `1' to `columns (transprob)'. + + If `'symbols'' is specified, then SEQUENCE is expected to be a +sequence of the elements of SYMBOLS instead of integers ranging from +`1' to `columns (outprob)'. SYMBOLS can be a cell array. + + If `'statenames'' is specified, then the elements of STATENAMES +are used for the states in VPATH instead of integers ranging from `1' +to `columns (transprob)'. STATENAMES can be a cell array. + +Examples +-------- + + transprob = [0.8, 0.2; 0.4, 0.6]; + outprob = [0.2, 0.4, 0.4; 0.7, 0.2, 0.1]; + [sequence, states] = hmmgenerate (25, transprob, outprob) + vpath = hmmviterbi (sequence, transprob, outprob) + + symbols = {'A', 'B', 'C'}; + statenames = {'One', 'Two'}; + [sequence, states] = hmmgenerate (25, transprob, outprob, + 'symbols', symbols, 'statenames', statenames) + vpath = hmmviterbi (sequence, transprob, outprob, + 'symbols', symbols, 'statenames', statenames) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Lawrence R. Rabiner. A Tutorial on Hidden Markov Models and + Selected Applications in Speech Recognition. `Proceedings of + the IEEE', 77(2), pages 257-286, February 1989. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Use the Viterbi algorithm to find the Viterbi path of a hidden Markov +model give + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +hygestat + + +# name: +# type: sq_string +# elements: 1 +# length: 1290 + -- Function File: [MN, V] = hygestat (T, M, N) + Compute mean and variance of the hypergeometric distribution. + +Arguments +--------- + + * T is the total size of the population of the hypergeometric + distribution. The elements of T must be positive natural + numbers + + * M is the number of marked items of the hypergeometric + distribution. The elements of M must be natural numbers + + * N is the size of the drawn sample of the hypergeometric + distribution. The elements of N must be positive natural + numbers + T, M, and N must be of common size or scalar + +Return values +------------- + + * MN is the mean of the hypergeometric distribution + + * V is the variance of the hypergeometric distribution + +Examples +-------- + + t = 4:9; + m = 0:5; + n = 1:6; + [mn, v] = hygestat (t, m, n) + + [mn, v] = hygestat (t, m, 2) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +Compute mean and variance of the hypergeometric distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +jackknife + + +# name: +# type: sq_string +# elements: 1 +# length: 2008 + -- Function File: JACKSTAT = jackknife (E, X, ...) + Compute jackknife estimates of a parameter taking one or more + given samples as parameters. In particular, E is the estimator to + be jackknifed as a function name, handle, or inline function, and + X is the sample for which the estimate is to be taken. The I-th + entry of JACKSTAT will contain the value of the estimator on the + sample X with its I-th row omitted. + + jackstat(I) = E(X(1 : I - 1, I + 1 : length(X))) + + Depending on the number of samples to be used, the estimator must + have the appropriate form: If only one sample is used, then the + estimator need not be concerned with cell arrays, for example + jackknifing the standard deviation of a sample can be performed + with `JACKSTAT = jackknife (@std, rand (100, 1))'. If, however, + more than one sample is to be used, the samples must all be of + equal size, and the estimator must address them as elements of a + cell-array, in which they are aggregated in their order of + appearance: + + JACKSTAT = jackknife(@(x) std(x{1})/var(x{2}), rand (100, 1), randn (100, 1) + + If all goes well, a theoretical value P for the parameter is + already known, N is the sample size, `T = N * E(X) - (N - 1) * + mean(JACKSTAT)', and `V = sumsq(N * E(X) - (N - 1) * JACKSTAT - T) + / (N * (N - 1))', then `(T-P)/sqrt(V)' should follow a + t-distribution with N-1 degrees of freedom. + + Jackknifing is a well known method to reduce bias; further details + can be found in: + * Rupert G. Miller: The jackknife-a review; Biometrika (1974) + 61(1): 1-15; doi:10.1093/biomet/61.1.1 + + * Rupert G. Miller: Jackknifing Variances; Ann. Math. Statist. + Volume 39, Number 2 (1968), 567-582; + doi:10.1214/aoms/1177698418 + + * M. H. Quenouille: Notes on Bias in Estimation; Biometrika + Vol. 43, No. 3/4 (Dec., 1956), pp. 353-360; + doi:10.1093/biomet/43.3-4.353 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute jackknife estimates of a parameter taking one or more given +samples as p + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +jsucdf + + +# name: +# type: sq_string +# elements: 1 +# length: 263 + -- Function File: jsucdf (X, ALPHA1, ALPHA2) + For each element of X, compute the cumulative distribution + function (CDF) at X of the Johnson SU distribution with shape + parameters ALPHA1 and ALPHA2. + + Default values are ALPHA1 = 1, ALPHA2 = 1. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +For each element of X, compute the cumulative distribution function +(CDF) at X o + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +jsupdf + + +# name: +# type: sq_string +# elements: 1 +# length: 259 + -- Function File: jsupdf (X, ALPHA1, ALPHA2) + For each element of X, compute the probability density function + (PDF) at X of the Johnson SU distribution with shape parameters + ALPHA1 and ALPHA2. + + Default values are ALPHA1 = 1, ALPHA2 = 1. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +For each element of X, compute the probability density function (PDF) +at X of th + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +kmeans + + +# name: +# type: sq_string +# elements: 1 +# length: 135 + -- Function File: [IDX, CENTERS] = kmeans (DATA, K, PARAM1, VALUE1, + ...) + K-means clustering. + + See also: linkage + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +K-means clustering. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +linkage + + +# name: +# type: sq_string +# elements: 1 +# length: 2933 + -- Function File: Y = linkage (D) + -- Function File: Y = linkage (D, METHOD) + -- Function File: Y = linkage (X, METHOD, METRIC) + -- Function File: Y = linkage (X, METHOD, ARGLIST) + Produce a hierarchical clustering dendrogram + + D is the dissimilarity matrix relative to N observations, + formatted as a (n-1)*n/2x1 vector as produced by `pdist'. + Alternatively, X contains data formatted for input to `pdist', + METRIC is a metric for `pdist' and ARGLIST is a cell array + containing arguments that are passed to `pdist'. + + `linkage' starts by putting each observation into a singleton + cluster and numbering those from 1 to N. Then it merges two + clusters, chosen according to METHOD, to create a new cluster + numbered N+1, and so on until all observations are grouped into a + single cluster numbered 2*N-1. Row M of the m-1x3 output matrix + relates to cluster n+m: the first two columns are the numbers of + the two component clusters and column 3 contains their distance. + + METHOD defines the way the distance between two clusters is + computed and how they are recomputed when two clusters are merged: + + `"single" (default)' + Distance between two clusters is the minimum distance between + two elements belonging each to one cluster. Produces a + cluster tree known as minimum spanning tree. + + `"complete"' + Furthest distance between two elements belonging each to one + cluster. + + `"average"' + Unweighted pair group method with averaging (UPGMA). The + mean distance between all pair of elements each belonging to + one cluster. + + `"weighted"' + Weighted pair group method with averaging (WPGMA). When two + clusters A and B are joined together, the new distance to a + cluster C is the mean between distances A-C and B-C. + + `"centroid"' + Unweighted Pair-Group Method using Centroids (UPGMC). + Assumes Euclidean metric. The distance between cluster + centroids, each centroid being the center of mass of a + cluster. + + `"median"' + Weighted pair-group method using centroids (WPGMC). Assumes + Euclidean metric. Distance between cluster centroids. When + two clusters are joined together, the new centroid is the + midpoint between the joined centroids. + + `"ward"' + Ward's sum of squared deviations about the group mean (ESS). + Also known as minimum variance or inner squared distance. + Assumes Euclidean metric. How much the moment of inertia of + the merged cluster exceeds the sum of those of the individual + clusters. + + *Reference* Ward, J. H. Hierarchical Grouping to Optimize an + Objective Function J. Am. Statist. Assoc. 1963, 58, 236-244, + `http://iv.slis.indiana.edu/sw/data/ward.pdf'. + + See also: pdist, squareform + + + + +# name: +# type: sq_string +# elements: 1 +# length: 45 +Produce a hierarchical clustering dendrogram + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +lognstat + + +# name: +# type: sq_string +# elements: 1 +# length: 1035 + -- Function File: [M, V] = lognstat (MU, SIGMA) + Compute mean and variance of the lognormal distribution. + +Arguments +--------- + + * MU is the first parameter of the lognormal distribution + + * SIGMA is the second parameter of the lognormal distribution. + SIGMA must be positive or zero + MU and SIGMA must be of common size or one of them must be scalar + +Return values +------------- + + * M is the mean of the lognormal distribution + + * V is the variance of the lognormal distribution + +Examples +-------- + + mu = 0:0.2:1; + sigma = 0.2:0.2:1.2; + [m, v] = lognstat (mu, sigma) + + [m, v] = lognstat (0, sigma) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 56 +Compute mean and variance of the lognormal distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +mad + + +# name: +# type: sq_string +# elements: 1 +# length: 767 + -- Function File: mad (X) + -- Function File: mad (X, FLAG) + -- Function File: mad (X, FLAG, DIM) + Compute the mean/median absolute deviation of X. + + The mean absolute deviation is computed as + + mean (abs (X - mean (X))) + + and the median absolute deviation is computed as + + median (abs (X - median (X))) + + Elements of X containing NaN or NA values are ignored during + computations. + + If FLAG is 0, the absolute mean deviation is computed, and if FLAG + is 1, the absolute median deviation is computed. By default FLAG + is 0. + + This is done along the dimension DIM of X. If this variable is not + given, the mean/median absolute deviation s computed along the + smallest dimension of X. + + See also: std + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 48 +Compute the mean/median absolute deviation of X. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +mnpdf + + +# name: +# type: sq_string +# elements: 1 +# length: 1643 + -- Function File: Y = mnpdf (X, P) + Compute the probability density function of the multinomial + distribution. + +Arguments +--------- + + * X is vector with a single sample of a multinomial + distribution with parameter P or a matrix of random samples + from multinomial distributions. In the latter case, each row + of X is a sample from a multinomial distribution with the + corresponding row of P being its parameter. + + * P is a vector with the probabilities of the categories or a + matrix with each row containing the probabilities of a + multinomial sample. + +Return values +------------- + + * Y is a vector of probabilites of the random samples X from the + multinomial distribution with corresponding parameter P. The + parameter N of the multinomial distribution is the sum of the + elements of each row of X. The length of Y is the number of + columns of X. If a row of P does not sum to `1', then the + corresponding element of Y will be `NaN'. + +Examples +-------- + + x = [1, 4, 2]; + p = [0.2, 0.5, 0.3]; + y = mnpdf (x, p); + + x = [1, 4, 2; 1, 0, 9]; + p = [0.2, 0.5, 0.3; 0.1, 0.1, 0.8]; + y = mnpdf (x, p); + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Merran Evans, Nicholas Hastings and Brian Peacock. + `Statistical Distributions'. pages 134-136, Wiley, New York, + third edition, 2000. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 +Compute the probability density function of the multinomial +distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +mnrnd + + +# name: +# type: sq_string +# elements: 1 +# length: 2172 + -- Function File: X = mnrnd (N, P) + -- Function File: X = mnrnd (N, P, S) + Generate random samples from the multinomial distribution. + +Arguments +--------- + + * N is the first parameter of the multinomial distribution. N + can be scalar or a vector containing the number of trials of + each multinomial sample. The elements of N must be + non-negative integers. + + * P is the second parameter of the multinomial distribution. P + can be a vector with the probabilities of the categories or a + matrix with each row containing the probabilities of a + multinomial sample. If P has more than one row and N is + non-scalar, then the number of rows of P must match the + number of elements of N. + + * S is the number of multinomial samples to be generated. S must + be a non-negative integer. If S is specified, then N must be + scalar and P must be a vector. + +Return values +------------- + + * X is a matrix of random samples from the multinomial + distribution with corresponding parameters N and P. Each row + corresponds to one multinomial sample. The number of columns, + therefore, corresponds to the number of columns of P. If S is + not specified, then the number of rows of X is the maximum of + the number of elements of N and the number of rows of P. If a + row of P does not sum to `1', then the corresponding row of X + will contain only `NaN' values. + +Examples +-------- + + n = 10; + p = [0.2, 0.5, 0.3]; + x = mnrnd (n, p); + + n = 10 * ones (3, 1); + p = [0.2, 0.5, 0.3]; + x = mnrnd (n, p); + + n = (1:2)'; + p = [0.2, 0.5, 0.3; 0.1, 0.1, 0.8]; + x = mnrnd (n, p); + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Merran Evans, Nicholas Hastings and Brian Peacock. + `Statistical Distributions'. pages 134-136, Wiley, New York, + third edition, 2000. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Generate random samples from the multinomial distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +monotone_smooth + + +# name: +# type: sq_string +# elements: 1 +# length: 1745 + -- Function File: YY = monotone_smooth (X, Y, H) + Produce a smooth monotone increasing approximation to a sampled + functional dependence y(x) using a kernel method (an Epanechnikov + smoothing kernel is applied to y(x); this is integrated to yield + the monotone increasing form. See Reference 1 for details.) + +Arguments +--------- + + * X is a vector of values of the independent variable. + + * Y is a vector of values of the dependent variable, of the + same size as X. For best performance, it is recommended that + the Y already be fairly smooth, e.g. by applying a kernel + smoothing to the original values if they are noisy. + + * H is the kernel bandwidth to use. If H is not given, a + "reasonable" value is computed. + + +Return values +------------- + + * YY is the vector of smooth monotone increasing function + values at X. + + +Examples +-------- + + x = 0:0.1:10; + y = (x .^ 2) + 3 * randn(size(x)); %typically non-monotonic from the added noise + ys = ([y(1) y(1:(end-1))] + y + [y(2:end) y(end)])/3; %crudely smoothed via + moving average, but still typically non-monotonic + yy = monotone_smooth(x, ys); %yy is monotone increasing in x + plot(x, y, '+', x, ys, x, yy) + +References +---------- + + 1. Holger Dette, Natalie Neumeyer and Kay F. Pilz (2006), A + simple nonparametric estimator of a strictly monotone + regression function, `Bernoulli', 12:469-490 + + 2. Regine Scheder (2007), R Package 'monoProc', Version 1.0-6, + `http://cran.r-project.org/web/packages/monoProc/monoProc.pdf' + (The implementation here is based on the monoProc function + mono.1d) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Produce a smooth monotone increasing approximation to a sampled +functional depen + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +mvncdf + + +# name: +# type: sq_string +# elements: 1 +# length: 1188 + -- Function File: P = mvncdf (X, MU, SIGMA) + -- Function File: mvncdf (A, X, MU, SIGMA) + -- Function File: [P, ERR] = mvncdf (...) + Compute the cumulative distribution function of the multivariate + normal distribution. + +Arguments +--------- + + * X is the upper limit for integration where each row + corresponds to an observation. + + * MU is the mean. + + * SIGMA is the correlation matrix. + + * A is the lower limit for integration where each row + corresponds to an observation. A must have the same size as X. + +Return values +------------- + + * P is the cumulative distribution at each row of X and A. + + * ERR is the estimated error. + +Examples +-------- + + x = [1 2]; + mu = [0.5 1.5]; + sigma = [1.0 0.5; 0.5 1.0]; + p = mvncdf (x, mu, sigma) + + a = [-inf 0]; + p = mvncdf (a, x, mu, sigma) + +References +---------- + + 1. Alan Genz and Frank Bretz. Numerical Computation of + Multivariate t-Probabilities with Application to Power + Calculation of Multiple Constrasts. `Journal of Statistical + Computation and Simulation', 63, pages 361-378, 1999. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the cumulative distribution function of the multivariate normal +distribu + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +mvnpdf + + +# name: +# type: sq_string +# elements: 1 +# length: 1600 + -- Function File: Y = mvnpdf (X) + -- Function File: Y = mvnpdf (X, MU) + -- Function File: Y = mvnpdf (X, MU, SIGMA) + Compute multivariate normal pdf for X given mean MU and covariance + matrix SIGMA. The dimension of X is D x P, MU is 1 x P and SIGMA + is P x P. The normal pdf is defined as + + 1/Y^2 = (2 pi)^P |SIGMA| exp { (X-MU)' inv(SIGMA) (X-MU) } + + *References* + + NIST Engineering Statistics Handbook 6.5.4.2 + http://www.itl.nist.gov/div898/handbook/pmc/section5/pmc542.htm + + *Algorithm* + + Using Cholesky factorization on the positive definite covariance + matrix: + + R = chol (SIGMA); + + where R'*R = SIGMA. Being upper triangular, the determinant of R + is trivially the product of the diagonal, and the determinant of + SIGMA is the square of this: + + DET = prod (diag (R))^2; + + The formula asks for the square root of the determinant, so no + need to square it. + + The exponential argument A = X' * inv (SIGMA) * X + + A = X' * inv (SIGMA) * X + = X' * inv (R' * R) * X + = X' * inv (R) * inv(R') * X + + Given that inv (R') == inv(R)', at least in theory if not + numerically, + + A = (X' / R) * (X'/R)' = sumsq (X'/R) + + The interface takes the parameters to the multivariate normal in + columns rather than rows, so we are actually dealing with the + transpose: + + A = sumsq (X/r) + + and the final result is: + + R = chol (SIGMA) + Y = (2*pi)^(-P/2) * exp (-sumsq ((X-MU)/R, 2)/2) / prod (diag (R)) + + See also: mvncdf, mvnrnd + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute multivariate normal pdf for X given mean MU and covariance +matrix SIGMA. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +mvnrnd + + +# name: +# type: sq_string +# elements: 1 +# length: 228 + -- Function File: S = mvnrnd (MU, SIGMA) + -- Function File: S = mvnrnd (MU, SIGMA, N) + Draw N random D-dimensional vectors from a multivariate Gaussian + distribution with mean MU(NxD) and covariance matrix SIGMA(DxD). + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Draw N random D-dimensional vectors from a multivariate Gaussian +distribution wi + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +mvtcdf + + +# name: +# type: sq_string +# elements: 1 +# length: 1199 + -- Function File: P = mvtcdf (X, SIGMA, NU) + -- Function File: mvtcdf (A, X, SIGMA, NU) + -- Function File: [P, ERR] = mvtcdf (...) + Compute the cumulative distribution function of the multivariate + Student's t distribution. + +Arguments +--------- + + * X is the upper limit for integration where each row + corresponds to an observation. + + * SIGMA is the correlation matrix. + + * NU is the degrees of freedom. + + * A is the lower limit for integration where each row + corresponds to an observation. A must have the same size as X. + +Return values +------------- + + * P is the cumulative distribution at each row of X and A. + + * ERR is the estimated error. + +Examples +-------- + + x = [1 2]; + sigma = [1.0 0.5; 0.5 1.0]; + nu = 4; + p = mvtcdf (x, sigma, nu) + + a = [-inf 0]; + p = mvtcdf (a, x, sigma, nu) + +References +---------- + + 1. Alan Genz and Frank Bretz. Numerical Computation of + Multivariate t-Probabilities with Application to Power + Calculation of Multiple Constrasts. `Journal of Statistical + Computation and Simulation', 63, pages 361-378, 1999. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Compute the cumulative distribution function of the multivariate +Student's t dis + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +mvtrnd + + +# name: +# type: sq_string +# elements: 1 +# length: 1436 + -- Function File: X = mvtrnd (SIGMA, NU) + -- Function File: X = mvtrnd (SIGMA, NU, N) + Generate random samples from the multivariate t-distribution. + +Arguments +--------- + + * SIGMA is the matrix of correlation coefficients. If there are + any non-unit diagonal elements then SIGMA will be normalized. + + * NU is the degrees of freedom for the multivariate + t-distribution. NU must be a vector with the same number of + elements as samples to be generated or be scalar. + + * N is the number of rows of the matrix to be generated. N must + be a non-negative integer and corresponds to the number of + samples to be generated. + +Return values +------------- + + * X is a matrix of random samples from the multivariate + t-distribution with N row samples. + +Examples +-------- + + sigma = [1, 0.5; 0.5, 1]; + nu = 3; + n = 10; + x = mvtrnd (sigma, nu, n); + + sigma = [1, 0.5; 0.5, 1]; + nu = [2; 3]; + n = 2; + x = mvtrnd (sigma, nu, 2); + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Samuel Kotz and Saralees Nadarajah. `Multivariate t + Distributions and Their Applications'. Cambridge University + Press, Cambridge, 2004. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 61 +Generate random samples from the multivariate t-distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nanmax + + +# name: +# type: sq_string +# elements: 1 +# length: 379 + -- Function File: [V, IDX] = nanmax (X) + -- Function File: [V, IDX] = nanmax (X, Y) + Find the maximal element while ignoring NaN values. + + `nanmax' is identical to the `max' function except that NaN values + are ignored. If all values in a column are NaN, the maximum is + returned as NaN rather than []. + + See also: max, nansum, nanmin, nanmean, nanmedian + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Find the maximal element while ignoring NaN values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +nanmean + + +# name: +# type: sq_string +# elements: 1 +# length: 339 + -- Function File: V = nanmean (X) + -- Function File: V = nanmean (X, DIM) + Compute the mean value while ignoring NaN values. + + `nanmean' is identical to the `mean' function except that NaN + values are ignored. If all values are NaN, the mean is returned + as NaN. + + See also: mean, nanmin, nanmax, nansum, nanmedian + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Compute the mean value while ignoring NaN values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +nanmedian + + +# name: +# type: sq_string +# elements: 1 +# length: 355 + -- Function File: V = nanmedian (X) + -- Function File: V = nanmedian (X, DIM) + Compute the median of data while ignoring NaN values. + + This function is identical to the `median' function except that + NaN values are ignored. If all values are NaN, the median is + returned as NaN. + + See also: median, nanmin, nanmax, nansum, nanmean + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Compute the median of data while ignoring NaN values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nanmin + + +# name: +# type: sq_string +# elements: 1 +# length: 379 + -- Function File: [V, IDX] = nanmin (X) + -- Function File: [V, IDX] = nanmin (X, Y) + Find the minimal element while ignoring NaN values. + + `nanmin' is identical to the `min' function except that NaN values + are ignored. If all values in a column are NaN, the minimum is + returned as NaN rather than []. + + See also: min, nansum, nanmax, nanmean, nanmedian + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 51 +Find the minimal element while ignoring NaN values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nanstd + + +# name: +# type: sq_string +# elements: 1 +# length: 932 + -- Function File: V = nanstd (X) + -- Function File: V = nanstd (X, OPT) + -- Function File: V = nanstd (X, OPT, DIM) + Compute the standard deviation while ignoring NaN values. + + `nanstd' is identical to the `std' function except that NaN values + are ignored. If all values are NaN, the standard deviation is + returned as NaN. If there is only a single non-NaN value, the + deviation is returned as 0. + + The argument OPT determines the type of normalization to use. + Valid values are + + 0: + normalizes with N-1, provides the square root of best + unbiased estimator of the variance [default] + + 1: + normalizes with N, this provides the square root of the + second moment around the mean + + The third argument DIM determines the dimension along which the + standard deviation is calculated. + + See also: std, nanmin, nanmax, nansum, nanmedian, nanmean + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 +Compute the standard deviation while ignoring NaN values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nansum + + +# name: +# type: sq_string +# elements: 1 +# length: 345 + -- Function File: V = nansum (X) + -- Function File: V = nansum (X, DIM) + Compute the sum while ignoring NaN values. + + `nansum' is identical to the `sum' function except that NaN values + are treated as 0 and so ignored. If all values are NaN, the sum is + returned as 0. + + See also: sum, nanmin, nanmax, nanmean, nanmedian + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 +Compute the sum while ignoring NaN values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +nanvar + + +# name: +# type: sq_string +# elements: 1 +# length: 783 + -- Function File: nanvar (X) + -- Function File: V = nanvar (X, OPT) + -- Function File: V = nanvar (X, OPT, DIM) + Compute the variance while ignoring NaN values. + + For vector arguments, return the (real) variance of the values. + For matrix arguments, return a row vector containing the variance + for each column. + + The argument OPT determines the type of normalization to use. + Valid values are + + 0: + Normalizes with N-1, provides the best unbiased estimator of + the variance [default]. + + 1: + Normalizes with N, this provides the second moment around the + mean. + + The third argument DIM determines the dimension along which the + variance is calculated. + + See also: var, nanmean, nanstd, nanmax, nanmin + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 47 +Compute the variance while ignoring NaN values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +nbinstat + + +# name: +# type: sq_string +# elements: 1 +# length: 1106 + -- Function File: [M, V] = nbinstat (N, P) + Compute mean and variance of the negative binomial distribution. + +Arguments +--------- + + * N is the first parameter of the negative binomial + distribution. The elements of N must be natural numbers + + * P is the second parameter of the negative binomial + distribution. The elements of P must be probabilities + N and P must be of common size or one of them must be scalar + +Return values +------------- + + * M is the mean of the negative binomial distribution + + * V is the variance of the negative binomial distribution + +Examples +-------- + + n = 1:4; + p = 0.2:0.2:0.8; + [m, v] = nbinstat (n, p) + + [m, v] = nbinstat (n, 0.5) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 +Compute mean and variance of the negative binomial distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +normalise_distribution + + +# name: +# type: sq_string +# elements: 1 +# length: 2097 + -- Function File: NORMALISED = normalise_distribution (DATA) + -- Function File: NORMALISED = normalise_distribution (DATA, + DISTRIBUTION) + -- Function File: NORMALISED = normalise_distribution (DATA, + DISTRIBUTION, DIMENSION) + Transform a set of data so as to be N(0,1) distributed according + to an idea by van Albada and Robinson. This is achieved by first + passing it through its own cumulative distribution function (CDF) + in order to get a uniform distribution, and then mapping the + uniform to a normal distribution. The data must be passed as a + vector or matrix in DATA. If the CDF is unknown, then [] can be + passed in DISTRIBUTION, and in this case the empirical CDF will be + used. Otherwise, if the CDFs for all data are known, they can be + passed in DISTRIBUTION, either in the form of a single function + name as a string, or a single function handle, or a cell array + consisting of either all function names as strings, or all + function handles. In the latter case, the number of CDFs passed + must match the number of rows, or columns respectively, to + normalise. If the data are passed as a matrix, then the + transformation will operate either along the first non-singleton + dimension, or along DIMENSION if present. + + Notes: The empirical CDF will map any two sets of data having the + same size and their ties in the same places after sorting to some + permutation of the same normalised data: + `normalise_distribution([1 2 2 3 4])' + => -1.28 0.00 0.00 0.52 1.28 + + `normalise_distribution([1 10 100 10 1000])' + => -1.28 0.00 0.52 0.00 1.28 + + Original source: S.J. van Albada, P.A. Robinson "Transformation of + arbitrary distributions to the normal distribution with + application to EEG test-retest reliability" Journal of + Neuroscience Methods, Volume 161, Issue 2, 15 April 2007, Pages + 205-211 ISSN 0165-0270, 10.1016/j.jneumeth.2006.11.004. + (http://www.sciencedirect.com/science/article/pii/S0165027006005668) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Transform a set of data so as to be N(0,1) distributed according to an +idea by v + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +normplot + + +# name: +# type: sq_string +# elements: 1 +# length: 445 + -- Function File: normplot (X) + Produce a normal probability plot for each column of X. + + The line joing the 1st and 3rd quantile is drawn on the graph. If + the underlying distribution is normal, the points will cluster + around this line. + + Note that this function sets the title, xlabel, ylabel, axis, + grid, tics and hold properties of the graph. These need to be + cleared before subsequent graphs using 'clf'. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Produce a normal probability plot for each column of X. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +normstat + + +# name: +# type: sq_string +# elements: 1 +# length: 967 + -- Function File: [MN, V] = normstat (M, S) + Compute mean and variance of the normal distribution. + +Arguments +--------- + + * M is the mean of the normal distribution + + * S is the standard deviation of the normal distribution. S + must be positive + M and S must be of common size or one of them must be scalar + +Return values +------------- + + * MN is the mean of the normal distribution + + * V is the variance of the normal distribution + +Examples +-------- + + m = 1:6; + s = 0:0.2:1; + [mn, v] = normstat (m, s) + + [mn, v] = normstat (0, s) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Compute mean and variance of the normal distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +pdist + + +# name: +# type: sq_string +# elements: 1 +# length: 2477 + -- Function File: Y = pdist (X) + -- Function File: Y = pdist (X, METRIC) + -- Function File: Y = pdist (X, METRIC, METRICARG, ...) + Return the distance between any two rows in X. + + X is the NxD matrix representing Q row vectors of size D. + + The output is a dissimilarity matrix formatted as a row vector Y, + (n-1)*n/2 long, where the distances are in the order [(1, 2) (1, + 3) ... (2, 3) ... (n-1, n)]. You can use the `squareform' + function to display the distances between the vectors arranged + into an NxN matrix. + + `metric' is an optional argument specifying how the distance is + computed. It can be any of the following ones, defaulting to + "euclidean", or a user defined function that takes two arguments X + and Y plus any number of optional arguments, where X is a row + vector and and Y is a matrix having the same number of columns as + X. `metric' returns a column vector where row I is the distance + between X and row I of Y. Any additional arguments after the + `metric' are passed as metric (X, Y, METRICARG1, METRICARG2 ...). + + Predefined distance functions are: + + `"euclidean"' + Euclidean distance (default). + + `"seuclidean"' + Standardized Euclidean distance. Each coordinate in the sum of + squares is inverse weighted by the sample variance of that + coordinate. + + `"mahalanobis"' + Mahalanobis distance: see the function mahalanobis. + + `"cityblock"' + City Block metric, aka Manhattan distance. + + `"minkowski"' + Minkowski metric. Accepts a numeric parameter P: for P=1 + this is the same as the cityblock metric, with P=2 (default) + it is equal to the euclidean metric. + + `"cosine"' + One minus the cosine of the included angle between rows, seen + as vectors. + + `"correlation"' + One minus the sample correlation between points (treated as + sequences of values). + + `"spearman"' + One minus the sample Spearman's rank correlation between + observations, treated as sequences of values. + + `"hamming"' + Hamming distance: the quote of the number of coordinates that + differ. + + `"jaccard"' + One minus the Jaccard coefficient, the quote of nonzero + coordinates that differ. + + `"chebychev"' + Chebychev distance: the maximum coordinate difference. + + See also: linkage, mahalanobis, squareform + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Return the distance between any two rows in X. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +poisstat + + +# name: +# type: sq_string +# elements: 1 +# length: 820 + -- Function File: [M, V] = poisstat (LAMBDA) + Compute mean and variance of the Poisson distribution. + +Arguments +--------- + + * LAMBDA is the parameter of the Poisson distribution. The + elements of LAMBDA must be positive + +Return values +------------- + + * M is the mean of the Poisson distribution + + * V is the variance of the Poisson distribution + +Example +------- + + lambda = 1 ./ (1:6); + [m, v] = poisstat (lambda) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Compute mean and variance of the Poisson distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +princomp + + +# name: +# type: sq_string +# elements: 1 +# length: 332 + -- Function File: [PC, Z, W, TSQ] = princomp (X) + Compute principal components of X. + + The first output argument PC is the principal components of X. + The second Z is the transformed data, and W is the eigenvalues of + the covariance matrix of X. TSQ is the Hotelling's T^2 statistic + for the transformed data. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Compute principal components of X. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +random + + +# name: +# type: sq_string +# elements: 1 +# length: 3107 + -- Function File: R = random(NAME, ARG1) + -- Function File: R = random(NAME, ARG1, ARG2) + -- Function File: R = random(NAME, ARG1, ARG2, ARG3) + -- Function File: R = random(NAME, ..., S1, ...) + Generates pseudo-random numbers from a given one-, two-, or + three-parameter distribution. + + The variable NAME must be a string that names the distribution from + which to sample. If this distribution is a one-parameter + distribution ARG1 should be supplied, if it is a two-paramter + distribution ARG2 must also be supplied, and if it is a + three-parameter distribution ARG3 must also be present. Any + arguments following the distribution paramters will determine the + size of the result. + + As an example, the following code generates a 10 by 20 matrix + containing random numbers from a normal distribution with mean 5 + and standard deviation 2. + R = random("normal", 5, 2, [10, 20]); + + The variable NAME can be one of the following strings + + "beta" + "beta distribution" + Samples are drawn from the Beta distribution. + + "bino" + "binomial" + "binomial distribution" + Samples are drawn from the Binomial distribution. + + "chi2" + "chi-square" + "chi-square distribution" + Samples are drawn from the Chi-Square distribution. + + "exp" + "exponential" + "exponential distribution" + Samples are drawn from the Exponential distribution. + + "f" + "f distribution" + Samples are drawn from the F distribution. + + "gam" + "gamma" + "gamma distribution" + Samples are drawn from the Gamma distribution. + + "geo" + "geometric" + "geometric distribution" + Samples are drawn from the Geometric distribution. + + "hyge" + "hypergeometric" + "hypergeometric distribution" + Samples are drawn from the Hypergeometric distribution. + + "logn" + "lognormal" + "lognormal distribution" + Samples are drawn from the Log-Normal distribution. + + "nbin" + "negative binomial" + "negative binomial distribution" + Samples are drawn from the Negative Binomial distribution. + + "norm" + "normal" + "normal distribution" + Samples are drawn from the Normal distribution. + + "poiss" + "poisson" + "poisson distribution" + Samples are drawn from the Poisson distribution. + + "rayl" + "rayleigh" + "rayleigh distribution" + Samples are drawn from the Rayleigh distribution. + + "t" + "t distribution" + Samples are drawn from the T distribution. + + "unif" + "uniform" + "uniform distribution" + Samples are drawn from the Uniform distribution. + + "unid" + "discrete uniform" + "discrete uniform distribution" + Samples are drawn from the Uniform Discrete distribution. + + "wbl" + "weibull" + "weibull distribution" + Samples are drawn from the Weibull distribution. + + See also: rand, betarnd, binornd, chi2rnd, exprnd, frnd, gamrnd, + geornd, hygernd, lognrnd, nbinrnd, normrnd, poissrnd, raylrnd, + trnd, unifrnd, unidrnd, wblrnd + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Generates pseudo-random numbers from a given one-, two-, or +three-parameter dist + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +raylcdf + + +# name: +# type: sq_string +# elements: 1 +# length: 1076 + -- Function File: P = raylcdf (X, SIGMA) + Compute the cumulative distribution function of the Rayleigh + distribution. + +Arguments +--------- + + * X is the support. The elements of X must be non-negative. + + * SIGMA is the parameter of the Rayleigh distribution. The + elements of SIGMA must be positive. + X and SIGMA must be of common size or one of them must be scalar. + +Return values +------------- + + * P is the cumulative distribution of the Rayleigh distribution + at each element of X and corresponding parameter SIGMA. + +Examples +-------- + + x = 0:0.5:2.5; + sigma = 1:6; + p = raylcdf (x, sigma) + + p = raylcdf (x, 0.5) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. pages 104 and 148, McGraw-Hill, New + York, second edition, 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 74 +Compute the cumulative distribution function of the Rayleigh +distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +raylinv + + +# name: +# type: sq_string +# elements: 1 +# length: 1133 + -- Function File: X = raylinv (P, SIGMA) + Compute the quantile of the Rayleigh distribution. The quantile is + the inverse of the cumulative distribution function. + +Arguments +--------- + + * P is the cumulative distribution. The elements of P must be + probabilities. + + * SIGMA is the parameter of the Rayleigh distribution. The + elements of SIGMA must be positive. + P and SIGMA must be of common size or one of them must be scalar. + +Return values +------------- + + * X is the quantile of the Rayleigh distribution at each + element of P and corresponding parameter SIGMA. + +Examples +-------- + + p = 0:0.1:0.5; + sigma = 1:6; + x = raylinv (p, sigma) + + x = raylinv (p, 0.5) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. pages 104 and 148, McGraw-Hill, New + York, second edition, 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Compute the quantile of the Rayleigh distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +raylpdf + + +# name: +# type: sq_string +# elements: 1 +# length: 1068 + -- Function File: Y = raylpdf (X, SIGMA) + Compute the probability density function of the Rayleigh + distribution. + +Arguments +--------- + + * X is the support. The elements of X must be non-negative. + + * SIGMA is the parameter of the Rayleigh distribution. The + elements of SIGMA must be positive. + X and SIGMA must be of common size or one of them must be scalar. + +Return values +------------- + + * Y is the probability density of the Rayleigh distribution at + each element of X and corresponding parameter SIGMA. + +Examples +-------- + + x = 0:0.5:2.5; + sigma = 1:6; + y = raylpdf (x, sigma) + + y = raylpdf (x, 0.5) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. pages 104 and 148, McGraw-Hill, New + York, second edition, 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 +Compute the probability density function of the Rayleigh distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +raylrnd + + +# name: +# type: sq_string +# elements: 1 +# length: 1489 + -- Function File: X = raylrnd (SIGMA) + -- Function File: X = raylrnd (SIGMA, SZ) + -- Function File: X = raylrnd (SIGMA, R, C) + Generate a matrix of random samples from the Rayleigh distribution. + +Arguments +--------- + + * SIGMA is the parameter of the Rayleigh distribution. The + elements of SIGMA must be positive. + + * SZ is the size of the matrix to be generated. SZ must be a + vector of non-negative integers. + + * R is the number of rows of the matrix to be generated. R must + be a non-negative integer. + + * C is the number of columns of the matrix to be generated. C + must be a non-negative integer. + +Return values +------------- + + * X is a matrix of random samples from the Rayleigh + distribution with corresponding parameter SIGMA. If neither + SZ nor R and C are specified, then X is of the same size as + SIGMA. + +Examples +-------- + + sigma = 1:6; + x = raylrnd (sigma) + + sz = [2, 3]; + x = raylrnd (0.5, sz) + + r = 2; + c = 3; + x = raylrnd (0.5, r, c) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. pages 104 and 148, McGraw-Hill, New + York, second edition, 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 67 +Generate a matrix of random samples from the Rayleigh distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +raylstat + + +# name: +# type: sq_string +# elements: 1 +# length: 815 + -- Function File: [M, V] = raylstat (SIGMA) + Compute mean and variance of the Rayleigh distribution. + +Arguments +--------- + + * SIGMA is the parameter of the Rayleigh distribution. The + elements of SIGMA must be positive. + +Return values +------------- + + * M is the mean of the Rayleigh distribution. + + * V is the variance of the Rayleigh distribution. + +Example +------- + + sigma = 1:6; + [m, v] = raylstat (sigma) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 +Compute mean and variance of the Rayleigh distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +regress + + +# name: +# type: sq_string +# elements: 1 +# length: 1333 + -- Function File: [B, BINT, R, RINT, STATS] = regress (Y, X, [ALPHA]) + Multiple Linear Regression using Least Squares Fit of Y on X with + the model `y = X * beta + e'. + + Here, + + * `y' is a column vector of observed values + + * `X' is a matrix of regressors, with the first column filled + with the constant value 1 + + * `beta' is a column vector of regression parameters + + * `e' is a column vector of random errors + + Arguments are + + * Y is the `y' in the model + + * X is the `X' in the model + + * ALPHA is the significance level used to calculate the + confidence intervals BINT and RINT (see `Return values' + below). If not specified, ALPHA defaults to 0.05 + + Return values are + + * B is the `beta' in the model + + * BINT is the confidence interval for B + + * R is a column vector of residuals + + * RINT is the confidence interval for R + + * STATS is a row vector containing: + + * The R^2 statistic + + * The F statistic + + * The p value for the full model + + * The estimated error variance + + R and RINT can be passed to `rcoplot' to visualize the residual + intervals and identify outliers. + + NaN values in Y and X are removed before calculation begins. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Multiple Linear Regression using Least Squares Fit of Y on X with the +model `y = + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +repanova + + +# name: +# type: sq_string +# elements: 1 +# length: 696 + -- Function File: [PVAL, TABLE, ST] = repanova (X, COND) + -- Function File: [PVAL, TABLE, ST] = repanova (X, COND, ['string' | + 'cell']) + Perform a repeated measures analysis of variance (Repeated ANOVA). + X is formated such that each row is a subject and each column is a + condition. + + condition is typically a point in time, say t=1 then t=2, etc + condition can also be thought of as groups. + + The optional flag can be either 'cell' or 'string' and reflects + the format of the table returned. Cell is the default. + + NaNs are ignored using nanmean and nanstd. + + This fuction does not currently support multiple columns of the + same condition! + + + + +# name: +# type: sq_string +# elements: 1 +# length: 66 +Perform a repeated measures analysis of variance (Repeated ANOVA). + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +squareform + + +# name: +# type: sq_string +# elements: 1 +# length: 384 + -- Function File: Y = squareform (X) + -- Function File: Y = squareform (X, "tovector") + -- Function File: Y = squareform (X, "tomatrix") + Convert a vector from the pdist function into a square matrix or + from a square matrix back to the vector form. + + The second argument is used to specify the output type in case + there is a single element. + + See also: pdist + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Convert a vector from the pdist function into a square matrix or from a +square m + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +tabulate + + +# name: +# type: sq_string +# elements: 1 +# length: 1886 + -- Function File: TABLE = tabulate (DATA, EDGES) + Compute a frequency table. + + For vector data, the function counts the number of values in data + that fall between the elements in the edges vector (which must + contain monotonically non-decreasing values). TABLE is a matrix. + The first column of TABLE is the number of bin, the second is the + number of instances in each class (absolute frequency). The third + column contains the percentage of each value (relative frequency) + and the fourth column contains the cumulative frequency. + + If EDGES is missed the width of each class is unitary, if EDGES is + a scalar then represent the number of classes, or you can define + the width of each bin. TABLE(K, 2) will count the value DATA (I) + if EDGES (K) <= DATA (I) < EDGES (K+1). The last bin will count + the value of DATA (I) if EDGES(K) <= DATA (I) <= EDGES (K+1). + Values outside the values in EDGES are not counted. Use -inf and + inf in EDGES to include all values. Tabulate with no output + arguments returns a formatted table in the command window. + + Example + + sphere_radius = [1:0.05:2.5]; + tabulate (sphere_radius) + + Tabulate returns 2 bins, the first contains the sphere with radius + between 1 and 2 mm excluded, and the second one contains the + sphere with radius between 2 and 3 mm. + + tabulate (sphere_radius, 10) + + Tabulate returns ten bins. + + tabulate (sphere_radius, [1, 1.5, 2, 2.5]) + + Tabulate returns three bins, the first contains the sphere with + radius between 1 and 1.5 mm excluded, the second one contains the + sphere with radius between 1.5 and 2 mm excluded, and the third + contains the sphere with radius between 2 and 2.5 mm. + + bar (table (:, 1), table (:, 2)) + + draw histogram. + + See also: bar, pareto + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 +Compute a frequency table. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +tblread + + +# name: +# type: sq_string +# elements: 1 +# length: 776 + -- Function File: [DATA, VARNAMES, CASENAMES] = tblread (FILENAME) + -- Function File: [DATA, VARNAMES, CASENAMES] = tblread (FILENAME, + DELIMETER) + Read tabular data from an ascii file. + + DATA is read from an ascii data file named FILENAME with an + optional DELIMETER. The delimeter may be any single character or + * "space" " " (default) + + * "tab" "\t" + + * "comma" "," + + * "semi" ";" + + * "bar" "|" + + The DATA is read starting at cell (2,2) where the VARNAMES form a + char matrix from the first row (starting at (1,2)) vertically + concatenated, and the CASENAMES form a char matrix read from the + first column (starting at (2,1)) vertically concatenated. + + See also: tblwrite, csv2cell, cell2csv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 37 +Read tabular data from an ascii file. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +tblwrite + + +# name: +# type: sq_string +# elements: 1 +# length: 765 + -- Function File: tblwrite (DATA, VARNAMES, CASENAMES, FILENAME) + -- Function File: tblwrite (DATA, VARNAMES, CASENAMES, FILENAME, + DELIMETER) + Write tabular data to an ascii file. + + DATA is written to an ascii data file named FILENAME with an + optional DELIMETER. The delimeter may be any single character or + * "space" " " (default) + + * "tab" "\t" + + * "comma" "," + + * "semi" ";" + + * "bar" "|" + + The DATA is written starting at cell (2,2) where the VARNAMES are + a char matrix or cell vector written to the first row (starting at + (1,2)), and the CASENAMES are a char matrix (or cell vector) + written to the first column (starting at (2,1)). + + See also: tblread, csv2cell, cell2csv + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Write tabular data to an ascii file. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +trimmean + + +# name: +# type: sq_string +# elements: 1 +# length: 387 + -- Function File: A = trimmean (X, P) + Compute the trimmed mean. + + The trimmed mean of X is defined as the mean of X excluding the + highest and lowest P percent of the data. + + For example + + mean ([-inf, 1:9, inf]) + + is NaN, while + + trimmean ([-inf, 1:9, inf], 10) + + excludes the infinite values, which make the result 5. + + See also: mean + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 +Compute the trimmed mean. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +tstat + + +# name: +# type: sq_string +# elements: 1 +# length: 798 + -- Function File: [M, V] = tstat (N) + Compute mean and variance of the t (Student) distribution. + +Arguments +--------- + + * N is the parameter of the t (Student) distribution. The + elements of N must be positive + +Return values +------------- + + * M is the mean of the t (Student) distribution + + * V is the variance of the t (Student) distribution + +Example +------- + + n = 3:8; + [m, v] = tstat (n) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 58 +Compute mean and variance of the t (Student) distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +unidstat + + +# name: +# type: sq_string +# elements: 1 +# length: 840 + -- Function File: [M, V] = unidstat (N) + Compute mean and variance of the discrete uniform distribution. + +Arguments +--------- + + * N is the parameter of the discrete uniform distribution. The + elements of N must be positive natural numbers + +Return values +------------- + + * M is the mean of the discrete uniform distribution + + * V is the variance of the discrete uniform distribution + +Example +------- + + n = 1:6; + [m, v] = unidstat (n) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Compute mean and variance of the discrete uniform distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +unifstat + + +# name: +# type: sq_string +# elements: 1 +# length: 1047 + -- Function File: [M, V] = unifstat (A, B) + Compute mean and variance of the continuous uniform distribution. + +Arguments +--------- + + * A is the first parameter of the continuous uniform + distribution + + * B is the second parameter of the continuous uniform + distribution + A and B must be of common size or one of them must be scalar and A +must be less than B + +Return values +------------- + + * M is the mean of the continuous uniform distribution + + * V is the variance of the continuous uniform distribution + +Examples +-------- + + a = 1:6; + b = 2:2:12; + [m, v] = unifstat (a, b) + + [m, v] = unifstat (a, 10) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 65 +Compute mean and variance of the continuous uniform distribution. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +vmpdf + + +# name: +# type: sq_string +# elements: 1 +# length: 319 + -- Function File: THETA = vmpdf (X, MU, K) + Evaluates the Von Mises probability density function. + + The Von Mises distribution has probability density function + f (X) = exp (K * cos (X - MU)) / Z , + where Z is a normalisation constant. By default, MU is 0 and K is + 1. + + See also: vmrnd + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 +Evaluates the Von Mises probability density function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +vmrnd + + +# name: +# type: sq_string +# elements: 1 +# length: 518 + -- Function File: THETA = vmrnd (MU, K) + -- Function File: THETA = vmrnd (MU, K, SZ) + Draw random angles from a Von Mises distribution with mean MU and + concentration K. + + The Von Mises distribution has probability density function + f (X) = exp (K * cos (X - MU)) / Z , + where Z is a normalisation constant. + + The output, THETA, is a matrix of size SZ containing random angles + drawn from the given Von Mises distribution. By default, MU is 0 + and K is 1. + + See also: vmpdf + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Draw random angles from a Von Mises distribution with mean MU and +concentration + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +wblstat + + +# name: +# type: sq_string +# elements: 1 +# length: 1050 + -- Function File: [M, V] = wblstat (SCALE, SHAPE) + Compute mean and variance of the Weibull distribution. + +Arguments +--------- + + * SCALE is the scale parameter of the Weibull distribution. + SCALE must be positive + + * SHAPE is the shape parameter of the Weibull distribution. + SHAPE must be positive + SCALE and SHAPE must be of common size or one of them must be +scalar + +Return values +------------- + + * M is the mean of the Weibull distribution + + * V is the variance of the Weibull distribution + +Examples +-------- + + scale = 3:8; + shape = 1:6; + [m, v] = wblstat (scale, shape) + + [m, v] = wblstat (6, shape) + +References +---------- + + 1. Wendy L. Martinez and Angel R. Martinez. `Computational + Statistics Handbook with MATLAB'. Appendix E, pages 547-557, + Chapman & Hall/CRC, 2001. + + 2. Athanasios Papoulis. `Probability, Random Variables, and + Stochastic Processes'. McGraw-Hill, New York, second edition, + 1984. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Compute mean and variance of the Weibull distribution. + + + + + diff --git a/octave_packages/statistics-1.1.3/expstat.m b/octave_packages/statistics-1.1.3/expstat.m new file mode 100644 index 0000000..0cab1bc --- /dev/null +++ b/octave_packages/statistics-1.1.3/expstat.m @@ -0,0 +1,92 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} expstat (@var{l}) +## Compute mean and variance of the exponential distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{l} is the parameter of the exponential distribution. The +## elements of @var{l} must be positive +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the exponential distribution +## +## @item +## @var{v} is the variance of the exponential distribution +## @end itemize +## +## @subheading Example +## +## @example +## @group +## l = 1:6; +## [m, v] = expstat (l) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the exponential distribution + +function [m, v] = expstat (l) + + # Check arguments + if (nargin != 1) + print_usage (); + endif + + if (! isempty (l) && ! ismatrix (l)) + error ("expstat: l must be a numeric matrix"); + endif + + # Calculate moments + m = l; + v = m .^ 2; + + # Continue argument check + k = find (! (l > 0) | ! (l < Inf)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! l = 1:6; +%! [m, v] = expstat (l); +%! assert (m, [1, 2, 3, 4, 5, 6], 0.001); +%! assert (v, [1, 4, 9, 16, 25, 36], 0.001); diff --git a/octave_packages/statistics-1.1.3/ff2n.m b/octave_packages/statistics-1.1.3/ff2n.m new file mode 100644 index 0000000..f152a0c --- /dev/null +++ b/octave_packages/statistics-1.1.3/ff2n.m @@ -0,0 +1,13 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} ff2n (@var{n}) +## Full-factor design with n binary terms. +## +## @seealso {fullfact} +## @end deftypefn + +function A=ff2n(n) + A = fullfact (2 * ones (1,n)) - 1; +endfunction diff --git a/octave_packages/statistics-1.1.3/fstat.m b/octave_packages/statistics-1.1.3/fstat.m new file mode 100644 index 0000000..cd30a13 --- /dev/null +++ b/octave_packages/statistics-1.1.3/fstat.m @@ -0,0 +1,130 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{mn}, @var{v}] =} fstat (@var{m}, @var{n}) +## Compute mean and variance of the F distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{m} is the first parameter of the F distribution. The elements +## of @var{m} must be positive +## +## @item +## @var{n} is the second parameter of the F distribution. The +## elements of @var{n} must be positive +## @end itemize +## @var{m} and @var{n} must be of common size or one of them must be scalar +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{mn} is the mean of the F distribution. The mean is undefined for +## @var{n} not greater than 2 +## +## @item +## @var{v} is the variance of the F distribution. The variance is undefined +## for @var{n} not greater than 4 +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## m = 1:6; +## n = 5:10; +## [mn, v] = fstat (m, n) +## @end group +## +## @group +## [mn, v] = fstat (m, 5) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the F distribution + +function [mn, v] = fstat (m, n) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! isempty (m) && ! ismatrix (m)) + error ("fstat: m must be a numeric matrix"); + endif + if (! isempty (n) && ! ismatrix (n)) + error ("fstat: n must be a numeric matrix"); + endif + + if (! isscalar (m) || ! isscalar (n)) + [retval, m, n] = common_size (m, n); + if (retval > 0) + error ("fstat: m and n must be of common size or scalar"); + endif + endif + + # Calculate moments + mn = n ./ (n - 2); + v = (2 .* (n .^ 2) .* (m + n - 2)) ./ (m .* ((n - 2) .^ 2) .* (n - 4)); + + # Continue argument check + k = find (! (m > 0) | ! (m < Inf) | ! (n > 2) | ! (n < Inf)); + if (any (k)) + mn(k) = NaN; + v(k) = NaN; + endif + + k = find (! (n > 4)); + if (any (k)) + v(k) = NaN; + endif + +endfunction + +%!test +%! m = 1:6; +%! n = 5:10; +%! [mn, v] = fstat (m, n); +%! expected_mn = [1.6667, 1.5000, 1.4000, 1.3333, 1.2857, 1.2500]; +%! expected_v = [22.2222, 6.7500, 3.4844, 2.2222, 1.5869, 1.2153]; +%! assert (mn, expected_mn, 0.001); +%! assert (v, expected_v, 0.001); + +%!test +%! m = 1:6; +%! [mn, v] = fstat (m, 5); +%! expected_mn = [1.6667, 1.6667, 1.6667, 1.6667, 1.6667, 1.6667]; +%! expected_v = [22.2222, 13.8889, 11.1111, 9.7222, 8.8889, 8.3333]; +%! assert (mn, expected_mn, 0.001); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/statistics-1.1.3/fullfact.m b/octave_packages/statistics-1.1.3/fullfact.m new file mode 100644 index 0000000..31ed007 --- /dev/null +++ b/octave_packages/statistics-1.1.3/fullfact.m @@ -0,0 +1,27 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} fullfact (@var{N}) +## Full factorial design. +## +## If @var{N} is a scalar, return the full factorial design with @var{N} binary +## choices, 0 and 1. +## +## If @var{N} is a vector, return the full factorial design with choices 1 +## through @var{n_i} for each factor @var{i}. +## +## @end deftypefn + +function A = fullfact(n) + if length(n) == 1 + % combinatorial design with n either/or choices + A = fullfact(2*ones(1,n))-1; + else + % combinatorial design with n(i) choices per level + A = [1:n(end)]'; + for i=length(n)-1:-1:1 + A = [kron([1:n(i)]',ones(rows(A),1)), repmat(A,n(i),1)]; + end + end +endfunction diff --git a/octave_packages/statistics-1.1.3/gamfit.m b/octave_packages/statistics-1.1.3/gamfit.m new file mode 100644 index 0000000..ae3c458 --- /dev/null +++ b/octave_packages/statistics-1.1.3/gamfit.m @@ -0,0 +1,44 @@ +## Author: Martijn van Oosterhout +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {} [A B] = gamfit (@var{R}) +## Finds the maximumlikelihood estimator for the Gamma distribution for R +## @seealso{gampdf, gaminv, gamrnd, gamlike} +## @end deftypefn + +## This function works by minimizing the value of gamlike for the vector R. +## Just about any minimization function will work, all it has to do a +## minimize for one variable. Although the gamma distribution has two +## parameters, their product is the mean of the data. so a helper function +## for the search takes one parameter, calculates the other and then returns +## the value of gamlike. + +## Note: Octave uses the inverse scale parameter, which is the opposite of +## Matlab. To work for Matlab, value of b needs to be inverted in a few +## places (marked with **) + +function res = gamfit(R) + + if (nargin != 1) + print_usage; + endif + + avg = mean(R); + + # This can be just about any search function. I choose this because it + # seemed to be the only one that might work in this situaition... + a=nmsmax( @gamfit_search, 1, [], [], avg, R ); + + b=a/avg; # ** + + res=[a 1/b]; +endfunction + +# Helper function so we only have to minimize for one variable. Also to +# inverting the output of gamlike, incase the optimisation function wants to +# maximize rather than minimize. +function res = gamfit_search( a, avg, R ) + b=a/avg; # ** + res = -gamlike([a 1/b], R); +endfunction diff --git a/octave_packages/statistics-1.1.3/gamlike.m b/octave_packages/statistics-1.1.3/gamlike.m new file mode 100644 index 0000000..7085896 --- /dev/null +++ b/octave_packages/statistics-1.1.3/gamlike.m @@ -0,0 +1,21 @@ +## Author: Martijn van Oosterhout +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{X} =} gamlike ([@var{A} @var{B}], @var{R}) +## Calculates the negative log-likelihood function for the Gamma +## distribution over vector @var{R}, with the given parameters @var{A} and @var{B}. +## @seealso{gampdf, gaminv, gamrnd, gamfit} +## @end deftypefn + +function res = gamlike(P,K) + + if (nargin != 2) + print_usage; + endif + + a=P(1); + b=P(2); + + res = -sum( log( gampdf(K, a, b) ) ); +endfunction diff --git a/octave_packages/statistics-1.1.3/gamstat.m b/octave_packages/statistics-1.1.3/gamstat.m new file mode 100644 index 0000000..1f95226 --- /dev/null +++ b/octave_packages/statistics-1.1.3/gamstat.m @@ -0,0 +1,123 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} gamstat (@var{a}, @var{b}) +## Compute mean and variance of the gamma distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{a} is the first parameter of the gamma distribution. @var{a} must be +## positive +## +## @item +## @var{b} is the second parameter of the gamma distribution. @var{b} must be +## positive +## @end itemize +## @var{a} and @var{b} must be of common size or one of them must be scalar +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the gamma distribution +## +## @item +## @var{v} is the variance of the gamma distribution +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## a = 1:6; +## b = 1:0.2:2; +## [m, v] = gamstat (a, b) +## @end group +## +## @group +## [m, v] = gamstat (a, 1.5) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the gamma distribution + +function [m, v] = gamstat (a, b) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! isempty (a) && ! ismatrix (a)) + error ("gamstat: a must be a numeric matrix"); + endif + if (! isempty (b) && ! ismatrix (b)) + error ("gamstat: b must be a numeric matrix"); + endif + + if (! isscalar (a) || ! isscalar (b)) + [retval, a, b] = common_size (a, b); + if (retval > 0) + error ("gamstat: a and b must be of common size or scalar"); + endif + endif + + # Calculate moments + m = a .* b; + v = a .* (b .^ 2); + + # Continue argument check + k = find (! (a > 0) | ! (a < Inf) | ! (b > 0) | ! (b < Inf)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! a = 1:6; +%! b = 1:0.2:2; +%! [m, v] = gamstat (a, b); +%! expected_m = [1.00, 2.40, 4.20, 6.40, 9.00, 12.00]; +%! expected_v = [1.00, 2.88, 5.88, 10.24, 16.20, 24.00]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); + +%!test +%! a = 1:6; +%! [m, v] = gamstat (a, 1.5); +%! expected_m = [1.50, 3.00, 4.50, 6.00, 7.50, 9.00]; +%! expected_v = [2.25, 4.50, 6.75, 9.00, 11.25, 13.50]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/statistics-1.1.3/geomean.m b/octave_packages/statistics-1.1.3/geomean.m new file mode 100644 index 0000000..7ed85fc --- /dev/null +++ b/octave_packages/statistics-1.1.3/geomean.m @@ -0,0 +1,34 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} geomean (@var{x}) +## @deftypefnx{Function File} geomean (@var{x}, @var{dim}) +## Compute the geometric mean. +## +## This function does the same as @code{mean (x, "g")}. +## +## @seealso{mean} +## @end deftypefn + +function a = geomean(x, dim) + if (nargin == 1) + a = mean(x, "g"); + elseif (nargin == 2) + a = mean(x, "g", dim); + else + print_usage; + endif +endfunction diff --git a/octave_packages/statistics-1.1.3/geostat.m b/octave_packages/statistics-1.1.3/geostat.m new file mode 100644 index 0000000..a6c94a2 --- /dev/null +++ b/octave_packages/statistics-1.1.3/geostat.m @@ -0,0 +1,93 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} geostat (@var{p}) +## Compute mean and variance of the geometric distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{p} is the rate parameter of the geometric distribution. The +## elements of @var{p} must be probabilities +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the geometric distribution +## +## @item +## @var{v} is the variance of the geometric distribution +## @end itemize +## +## @subheading Example +## +## @example +## @group +## p = 1 ./ (1:6); +## [m, v] = geostat (p) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the geometric distribution + +function [m, v] = geostat (p) + + # Check arguments + if (nargin != 1) + print_usage (); + endif + + if (! isempty (p) && ! ismatrix (p)) + error ("geostat: p must be a numeric matrix"); + endif + + # Calculate moments + q = 1 - p; + m = q ./ p; + v = q ./ (p .^ 2); + + # Continue argument check + k = find (! (p >= 0) | ! (p <= 1)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! p = 1 ./ (1:6); +%! [m, v] = geostat (p); +%! assert (m, [0, 1, 2, 3, 4, 5], 0.001); +%! assert (v, [0, 2, 6, 12, 20, 30], 0.001); diff --git a/octave_packages/statistics-1.1.3/harmmean.m b/octave_packages/statistics-1.1.3/harmmean.m new file mode 100644 index 0000000..fcbd45b --- /dev/null +++ b/octave_packages/statistics-1.1.3/harmmean.m @@ -0,0 +1,34 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} harmmean (@var{x}) +## @deftypefnx{Function File} harmmean (@var{x}, @var{dim}) +## Compute the harmonic mean. +## +## This function does the same as @code{mean (x, "h")}. +## +## @seealso{mean} +## @end deftypefn + +function a = harmmean(x, dim) + if (nargin == 1) + a = mean(x, "h"); + elseif (nargin == 2) + a = mean(x, "h", dim); + else + print_usage; + endif +endfunction diff --git a/octave_packages/statistics-1.1.3/histfit.m b/octave_packages/statistics-1.1.3/histfit.m new file mode 100644 index 0000000..ff71668 --- /dev/null +++ b/octave_packages/statistics-1.1.3/histfit.m @@ -0,0 +1,70 @@ +## Copyright (C) 2003 Alberto Terruzzi +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} histfit (@var{data}, @var{nbins}) +## +## Plot histogram with superimposed fitted normal density. +## +## @code{histfit (@var{data}, @var{nbins})} plots a histogram of the values in +## the vector @var{data} using @var{nbins} bars in the histogram. With one input +## argument, @var{nbins} is set to the square root of the number of elements in +## data. +## +## Example +## +## @example +## histfit (randn (100, 1)) +## @end example +## +## @seealso{bar,hist, pareto} +## @end deftypefn + +## Author: Alberto Terruzzi +## Version: 1.0 +## Created: 3 March 2004 + +function histfit (data,nbins) + + if nargin < 1 || nargin > 2 + print_usage; + endif + + if isvector (data) != 1 + error ("data must be a vector."); + endif + + row = sum(~isnan(data)); + + if nargin < 2 + nbins = ceil(sqrt(row)); + endif + + [n,xbin]=hist(data,nbins); + if any(abs(diff(xbin,2)) > 10*max(abs(xbin))*eps) + error("histfit bins must be uniform width"); + endif + + mr = nanmean(data); ## Estimates the parameter, MU, of the normal distribution. + sr = nanstd(data); ## Estimates the parameter, SIGMA, of the normal distribution. + x=(-3*sr+mr:0.1*sr:3*sr+mr)';## Evenly spaced samples of the expected data range. + [xb,yb] = bar(xbin,n); + y = normal_pdf(x,mr,sr.^2); + binwidth = xbin(2)-xbin(1); + y = row*y*binwidth; ## Normalization necessary to overplot the histogram. + plot(xb,yb,";;b",x,y,";;r-"); ## Plots density line over histogram. + +endfunction + diff --git a/octave_packages/statistics-1.1.3/hmmestimate.m b/octave_packages/statistics-1.1.3/hmmestimate.m new file mode 100644 index 0000000..dbbff5b --- /dev/null +++ b/octave_packages/statistics-1.1.3/hmmestimate.m @@ -0,0 +1,338 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{transprobest}, @var{outprobest}] =} hmmestimate (@var{sequence}, @var{states}) +## @deftypefnx {Function File} {} hmmestimate (@dots{}, 'statenames', @var{statenames}) +## @deftypefnx {Function File} {} hmmestimate (@dots{}, 'symbols', @var{symbols}) +## @deftypefnx {Function File} {} hmmestimate (@dots{}, 'pseudotransitions', @var{pseudotransitions}) +## @deftypefnx {Function File} {} hmmestimate (@dots{}, 'pseudoemissions', @var{pseudoemissions}) +## Estimate the matrix of transition probabilities and the matrix of output +## probabilities of a given sequence of outputs and states generated by a +## hidden Markov model. The model assumes that the generation starts in +## state @code{1} at step @code{0} but does not include step @code{0} in the +## generated states and sequence. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{sequence} is a vector of a sequence of given outputs. The outputs +## must be integers ranging from @code{1} to the number of outputs of the +## hidden Markov model. +## +## @item +## @var{states} is a vector of the same length as @var{sequence} of given +## states. The states must be integers ranging from @code{1} to the number +## of states of the hidden Markov model. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{transprobest} is the matrix of the estimated transition +## probabilities of the states. @code{transprobest(i, j)} is the estimated +## probability of a transition to state @code{j} given state @code{i}. +## +## @item +## @var{outprobest} is the matrix of the estimated output probabilities. +## @code{outprobest(i, j)} is the estimated probability of generating +## output @code{j} given state @code{i}. +## @end itemize +## +## If @code{'symbols'} is specified, then @var{sequence} is expected to be a +## sequence of the elements of @var{symbols} instead of integers. +## @var{symbols} can be a cell array. +## +## If @code{'statenames'} is specified, then @var{states} is expected to be +## a sequence of the elements of @var{statenames} instead of integers. +## @var{statenames} can be a cell array. +## +## If @code{'pseudotransitions'} is specified then the integer matrix +## @var{pseudotransitions} is used as an initial number of counted +## transitions. @code{pseudotransitions(i, j)} is the initial number of +## counted transitions from state @code{i} to state @code{j}. +## @var{transprobest} will have the same size as @var{pseudotransitions}. +## Use this if you have transitions that are very unlikely to occur. +## +## If @code{'pseudoemissions'} is specified then the integer matrix +## @var{pseudoemissions} is used as an initial number of counted outputs. +## @code{pseudoemissions(i, j)} is the initial number of counted outputs +## @code{j} given state @code{i}. If @code{'pseudoemissions'} is also +## specified then the number of rows of @var{pseudoemissions} must be the +## same as the number of rows of @var{pseudotransitions}. @var{outprobest} +## will have the same size as @var{pseudoemissions}. Use this if you have +## outputs or states that are very unlikely to occur. +## +## @subheading Examples +## +## @example +## @group +## transprob = [0.8, 0.2; 0.4, 0.6]; +## outprob = [0.2, 0.4, 0.4; 0.7, 0.2, 0.1]; +## [sequence, states] = hmmgenerate (25, transprob, outprob); +## [transprobest, outprobest] = hmmestimate (sequence, states) +## @end group +## +## @group +## symbols = @{'A', 'B', 'C'@}; +## statenames = @{'One', 'Two'@}; +## [sequence, states] = hmmgenerate (25, transprob, outprob, +## 'symbols', symbols, 'statenames', statenames); +## [transprobest, outprobest] = hmmestimate (sequence, states, +## 'symbols', symbols, +## 'statenames', statenames) +## @end group +## +## @group +## pseudotransitions = [8, 2; 4, 6]; +## pseudoemissions = [2, 4, 4; 7, 2, 1]; +## [sequence, states] = hmmgenerate (25, transprob, outprob); +## [transprobest, outprobest] = hmmestimate (sequence, states, 'pseudotransitions', pseudotransitions, 'pseudoemissions', pseudoemissions) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Lawrence R. Rabiner. A Tutorial on Hidden Markov Models and Selected +## Applications in Speech Recognition. @cite{Proceedings of the IEEE}, +## 77(2), pages 257-286, February 1989. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Estimation of a hidden Markov model for a given sequence + +function [transprobest, outprobest] = hmmestimate (sequence, states, varargin) + + # Check arguments + if (nargin < 2 || mod (length (varargin), 2) != 0) + print_usage (); + endif + + len = length (sequence); + if (length (states) != len) + error ("hmmestimate: sequence and states must have equal length"); + endif + + # Flag for symbols + usesym = false; + # Flag for statenames + usesn = false; + + # Variables for return values + transprobest = []; + outprobest = []; + + # Process varargin + for i = 1:2:length (varargin) + # There must be an identifier: 'symbols', 'statenames', + # 'pseudotransitions' or 'pseudoemissions' + if (! ischar (varargin{i})) + print_usage (); + endif + # Upper case is also fine + lowerarg = lower (varargin{i}); + if (strcmp (lowerarg, 'symbols')) + usesym = true; + # Use the following argument as symbols + symbols = varargin{i + 1}; + # The same for statenames + elseif (strcmp (lowerarg, 'statenames')) + usesn = true; + # Use the following argument as statenames + statenames = varargin{i + 1}; + elseif (strcmp (lowerarg, 'pseudotransitions')) + # Use the following argument as an initial count for transitions + transprobest = varargin{i + 1}; + if (! ismatrix (transprobest)) + error ("hmmestimate: pseudotransitions must be a non-empty numeric matrix"); + endif + if (rows (transprobest) != columns (transprobest)) + error ("hmmestimate: pseudotransitions must be a square matrix"); + endif + elseif (strcmp (lowerarg, 'pseudoemissions')) + # Use the following argument as an initial count for outputs + outprobest = varargin{i + 1}; + if (! ismatrix (outprobest)) + error ("hmmestimate: pseudoemissions must be a non-empty numeric matrix"); + endif + else + error ("hmmestimate: expected 'symbols', 'statenames', 'pseudotransitions' or 'pseudoemissions' but found '%s'", varargin{i}); + endif + endfor + + # Transform sequence from symbols to integers if necessary + if (usesym) + # sequenceint is used to build the transformed sequence + sequenceint = zeros (1, len); + for i = 1:length (symbols) + # Search for symbols(i) in the sequence, isequal will have 1 at + # corresponding indices; i is the right integer for that symbol + isequal = ismember (sequence, symbols(i)); + # We do not want to change sequenceint if the symbol appears a second + # time in symbols + if (any ((sequenceint == 0) & (isequal == 1))) + isequal *= i; + sequenceint += isequal; + endif + endfor + if (! all (sequenceint)) + index = max ((sequenceint == 0) .* (1:len)); + error (["hmmestimate: sequence(" int2str (index) ") not in symbols"]); + endif + sequence = sequenceint; + else + if (! isvector (sequence)) + error ("hmmestimate: sequence must be a non-empty vector"); + endif + if (! all (ismember (sequence, 1:max (sequence)))) + index = max ((ismember (sequence, 1:max (sequence)) == 0) .* (1:len)); + error (["hmmestimate: sequence(" int2str (index) ") not feasible"]); + endif + endif + + # Transform states from statenames to integers if necessary + if (usesn) + # statesint is used to build the transformed states + statesint = zeros (1, len); + for i = 1:length (statenames) + # Search for statenames(i) in states, isequal will have 1 at + # corresponding indices; i is the right integer for that statename + isequal = ismember (states, statenames(i)); + # We do not want to change statesint if the statename appears a second + # time in statenames + if (any ((statesint == 0) & (isequal == 1))) + isequal *= i; + statesint += isequal; + endif + endfor + if (! all (statesint)) + index = max ((statesint == 0) .* (1:len)); + error (["hmmestimate: states(" int2str (index) ") not in statenames"]); + endif + states = statesint; + else + if (! isvector (states)) + error ("hmmestimate: states must be a non-empty vector"); + endif + if (! all (ismember (states, 1:max (states)))) + index = max ((ismember (states, 1:max (states)) == 0) .* (1:len)); + error (["hmmestimate: states(" int2str (index) ") not feasible"]); + endif + endif + + # Estimate the number of different states as the max of states + nstate = max (states); + # Estimate the number of different outputs as the max of sequence + noutput = max (sequence); + + # transprobest is empty if pseudotransitions is not specified + if (isempty (transprobest)) + # outprobest is not empty if pseudoemissions is specified + if (! isempty (outprobest)) + if (nstate > rows (outprobest)) + error ("hmmestimate: not enough rows in pseudoemissions"); + endif + # The number of states is specified by pseudoemissions + nstate = rows (outprobest); + endif + transprobest = zeros (nstate, nstate); + else + if (nstate > rows (transprobest)) + error ("hmmestimate: not enough rows in pseudotransitions"); + endif + # The number of states is given by pseudotransitions + nstate = rows (transprobest); + endif + + # outprobest is empty if pseudoemissions is not specified + if (isempty (outprobest)) + outprobest = zeros (nstate, noutput); + else + if (noutput > columns (outprobest)) + error ("hmmestimate: not enough columns in pseudoemissions"); + endif + # Number of outputs is specified by pseudoemissions + noutput = columns (outprobest); + if (rows (outprobest) != nstate) + error ("hmmestimate: pseudoemissions must have the same number of rows as pseudotransitions"); + endif + endif + + # Assume that the model started in state 1 + cstate = 1; + for i = 1:len + # Count the number of transitions for each state pair + transprobest(cstate, states(i)) ++; + cstate = states (i); + # Count the number of outputs for each state output pair + outprobest(cstate, sequence(i)) ++; + endfor + + # transprobest and outprobest contain counted numbers + # Each row in transprobest and outprobest should contain estimated + # probabilities + # => scale so that the sum is 1 + # A zero row remains zero + # - for transprobest + s = sum (transprobest, 2); + s(s == 0) = 1; + transprobest = transprobest ./ (s * ones (1, nstate)); + # - for outprobest + s = sum (outprobest, 2); + s(s == 0) = 1; + outprobest = outprobest ./ (s * ones (1, noutput)); + +endfunction + +%!test +%! sequence = [1, 2, 1, 1, 1, 2, 2, 1, 2, 3, 3, 3, 3, 2, 3, 1, 1, 1, 1, 3, 3, 2, 3, 1, 3]; +%! states = [1, 1, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1]; +%! [transprobest, outprobest] = hmmestimate (sequence, states); +%! expectedtransprob = [0.88889, 0.11111; 0.28571, 0.71429]; +%! expectedoutprob = [0.16667, 0.33333, 0.50000; 1.00000, 0.00000, 0.00000]; +%! assert (transprobest, expectedtransprob, 0.001); +%! assert (outprobest, expectedoutprob, 0.001); + +%!test +%! sequence = {'A', 'B', 'A', 'A', 'A', 'B', 'B', 'A', 'B', 'C', 'C', 'C', 'C', 'B', 'C', 'A', 'A', 'A', 'A', 'C', 'C', 'B', 'C', 'A', 'C'}; +%! states = {'One', 'One', 'Two', 'Two', 'Two', 'One', 'One', 'One', 'One', 'One', 'One', 'One', 'One', 'One', 'One', 'Two', 'Two', 'Two', 'Two', 'One', 'One', 'One', 'One', 'One', 'One'}; +%! symbols = {'A', 'B', 'C'}; +%! statenames = {'One', 'Two'}; +%! [transprobest, outprobest] = hmmestimate (sequence, states, 'symbols', symbols, 'statenames', statenames); +%! expectedtransprob = [0.88889, 0.11111; 0.28571, 0.71429]; +%! expectedoutprob = [0.16667, 0.33333, 0.50000; 1.00000, 0.00000, 0.00000]; +%! assert (transprobest, expectedtransprob, 0.001); +%! assert (outprobest, expectedoutprob, 0.001); + +%!test +%! sequence = [1, 2, 1, 1, 1, 2, 2, 1, 2, 3, 3, 3, 3, 2, 3, 1, 1, 1, 1, 3, 3, 2, 3, 1, 3]; +%! states = [1, 1, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1]; +%! pseudotransitions = [8, 2; 4, 6]; +%! pseudoemissions = [2, 4, 4; 7, 2, 1]; +%! [transprobest, outprobest] = hmmestimate (sequence, states, 'pseudotransitions', pseudotransitions, 'pseudoemissions', pseudoemissions); +%! expectedtransprob = [0.85714, 0.14286; 0.35294, 0.64706]; +%! expectedoutprob = [0.178571, 0.357143, 0.464286; 0.823529, 0.117647, 0.058824]; +%! assert (transprobest, expectedtransprob, 0.001); +%! assert (outprobest, expectedoutprob, 0.001); diff --git a/octave_packages/statistics-1.1.3/hmmgenerate.m b/octave_packages/statistics-1.1.3/hmmgenerate.m new file mode 100644 index 0000000..0af82b0 --- /dev/null +++ b/octave_packages/statistics-1.1.3/hmmgenerate.m @@ -0,0 +1,251 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{sequence}, @var{states}] =} hmmgenerate (@var{len}, @var{transprob}, @var{outprob}) +## @deftypefnx {Function File} {} hmmgenerate (@dots{}, 'symbols', @var{symbols}) +## @deftypefnx {Function File} {} hmmgenerate (@dots{}, 'statenames', @var{statenames}) +## Generate an output sequence and hidden states of a hidden Markov model. +## The model starts in state @code{1} at step @code{0} but will not include +## step @code{0} in the generated states and sequence. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{len} is the number of steps to generate. @var{sequence} and +## @var{states} will have @var{len} entries each. +## +## @item +## @var{transprob} is the matrix of transition probabilities of the states. +## @code{transprob(i, j)} is the probability of a transition to state +## @code{j} given state @code{i}. +## +## @item +## @var{outprob} is the matrix of output probabilities. +## @code{outprob(i, j)} is the probability of generating output @code{j} +## given state @code{i}. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{sequence} is a vector of length @var{len} of the generated +## outputs. The outputs are integers ranging from @code{1} to +## @code{columns (outprob)}. +## +## @item +## @var{states} is a vector of length @var{len} of the generated hidden +## states. The states are integers ranging from @code{1} to +## @code{columns (transprob)}. +## @end itemize +## +## If @code{'symbols'} is specified, then the elements of @var{symbols} are +## used for the output sequence instead of integers ranging from @code{1} to +## @code{columns (outprob)}. @var{symbols} can be a cell array. +## +## If @code{'statenames'} is specified, then the elements of +## @var{statenames} are used for the states instead of integers ranging from +## @code{1} to @code{columns (transprob)}. @var{statenames} can be a cell +## array. +## +## @subheading Examples +## +## @example +## @group +## transprob = [0.8, 0.2; 0.4, 0.6]; +## outprob = [0.2, 0.4, 0.4; 0.7, 0.2, 0.1]; +## [sequence, states] = hmmgenerate (25, transprob, outprob) +## @end group +## +## @group +## symbols = @{'A', 'B', 'C'@}; +## statenames = @{'One', 'Two'@}; +## [sequence, states] = hmmgenerate (25, transprob, outprob, +## 'symbols', symbols, 'statenames', statenames) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Lawrence R. Rabiner. A Tutorial on Hidden Markov Models and Selected +## Applications in Speech Recognition. @cite{Proceedings of the IEEE}, +## 77(2), pages 257-286, February 1989. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Output sequence and hidden states of a hidden Markov model + +function [sequence, states] = hmmgenerate (len, transprob, outprob, varargin) + + # Check arguments + if (nargin < 3 || mod (length (varargin), 2) != 0) + print_usage (); + endif + + if (! isscalar (len) || len < 0 || round (len) != len) + error ("hmmgenerate: len must be a non-negative scalar integer") + endif + + if (! ismatrix (transprob)) + error ("hmmgenerate: transprob must be a non-empty numeric matrix"); + endif + if (! ismatrix (outprob)) + error ("hmmgenerate: outprob must be a non-empty numeric matrix"); + endif + + # nstate is the number of states of the hidden Markov model + nstate = rows (transprob); + # noutput is the number of different outputs that the hidden Markov model + # can generate + noutput = columns (outprob); + + # Check whether transprob and outprob are feasible for a hidden Markov + # model + if (columns (transprob) != nstate) + error ("hmmgenerate: transprob must be a square matrix"); + endif + if (rows (outprob) != nstate) + error ("hmmgenerate: outprob must have the same number of rows as transprob"); + endif + + # Flag for symbols + usesym = false; + # Flag for statenames + usesn = false; + + # Process varargin + for i = 1:2:length (varargin) + # There must be an identifier: 'symbols' or 'statenames' + if (! ischar (varargin{i})) + print_usage (); + endif + # Upper case is also fine + lowerarg = lower (varargin{i}); + if (strcmp (lowerarg, 'symbols')) + if (length (varargin{i + 1}) != noutput) + error ("hmmgenerate: number of symbols does not match number of possible outputs"); + endif + usesym = true; + # Use the following argument as symbols + symbols = varargin{i + 1}; + # The same for statenames + elseif (strcmp (lowerarg, 'statenames')) + if (length (varargin{i + 1}) != nstate) + error ("hmmgenerate: number of statenames does not match number of states"); + endif + usesn = true; + # Use the following argument as statenames + statenames = varargin{i + 1}; + else + error ("hmmgenerate: expected 'symbols' or 'statenames' but found '%s'", varargin{i}); + endif + endfor + + # Each row in transprob and outprob should contain probabilities + # => scale so that the sum is 1 + # A zero row remains zero + # - for transprob + s = sum (transprob, 2); + s(s == 0) = 1; + transprob = transprob ./ repmat (s, 1, nstate); + # - for outprob + s = sum (outprob, 2); + s(s == 0) = 1; + outprob = outprob ./ repmat (s, 1, noutput); + + # Generate sequences of uniformly distributed random numbers between 0 and + # 1 + # - for the state transitions + transdraw = rand (1, len); + # - for the outputs + outdraw = rand (1, len); + + # Generate the return vectors + # They remain unchanged if the according probability row of transprob + # and outprob contain, respectively, only zeros + sequence = ones (1, len); + states = ones (1, len); + + if (len > 0) + # Calculate cumulated probabilities backwards for easy comparison with + # the generated random numbers + # Cumulated probability in first column must always be 1 + # We might have a zero row + # - for transprob + transprob(:, end:-1:1) = cumsum (transprob(:, end:-1:1), 2); + transprob(:, 1) = 1; + # - for outprob + outprob(:, end:-1:1) = cumsum (outprob(:, end:-1:1), 2); + outprob(:, 1) = 1; + + # cstate is the current state + # Start in state 1 but do not include it in the states vector + cstate = 1; + for i = 1:len + # Compare the randon number i of transdraw to the cumulated + # probability of the state transition and set the transition + # accordingly + states(i) = sum (transdraw(i) <= transprob(cstate, :)); + cstate = states(i); + endfor + + # Compare the random numbers of outdraw to the cumulated probabilities + # of the outputs and set the sequence vector accordingly + sequence = sum (repmat (outdraw, noutput, 1) <= outprob(states, :)', 1); + + # Transform default matrices into symbols/statenames if requested + if (usesym) + sequence = reshape (symbols(sequence), 1, len); + endif + if (usesn) + states = reshape (statenames(states), 1, len); + endif + endif + +endfunction + +%!test +%! len = 25; +%! transprob = [0.8, 0.2; 0.4, 0.6]; +%! outprob = [0.2, 0.4, 0.4; 0.7, 0.2, 0.1]; +%! [sequence, states] = hmmgenerate (len, transprob, outprob); +%! assert (length (sequence), len); +%! assert (length (states), len); +%! assert (min (sequence) >= 1); +%! assert (max (sequence) <= columns (outprob)); +%! assert (min (states) >= 1); +%! assert (max (states) <= rows (transprob)); + +%!test +%! len = 25; +%! transprob = [0.8, 0.2; 0.4, 0.6]; +%! outprob = [0.2, 0.4, 0.4; 0.7, 0.2, 0.1]; +%! symbols = {'A', 'B', 'C'}; +%! statenames = {'One', 'Two'}; +%! [sequence, states] = hmmgenerate (len, transprob, outprob, 'symbols', symbols, 'statenames', statenames); +%! assert (length (sequence), len); +%! assert (length (states), len); +%! assert (strcmp (sequence, 'A') + strcmp (sequence, 'B') + strcmp (sequence, 'C') == ones (1, len)); +%! assert (strcmp (states, 'One') + strcmp (states, 'Two') == ones (1, len)); diff --git a/octave_packages/statistics-1.1.3/hmmviterbi.m b/octave_packages/statistics-1.1.3/hmmviterbi.m new file mode 100644 index 0000000..0b7f4e1 --- /dev/null +++ b/octave_packages/statistics-1.1.3/hmmviterbi.m @@ -0,0 +1,250 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{vpath} =} hmmviterbi (@var{sequence}, @var{transprob}, @var{outprob}) +## @deftypefnx {Function File} {} hmmviterbi (@dots{}, 'symbols', @var{symbols}) +## @deftypefnx {Function File} {} hmmviterbi (@dots{}, 'statenames', @var{statenames}) +## Use the Viterbi algorithm to find the Viterbi path of a hidden Markov +## model given a sequence of outputs. The model assumes that the generation +## starts in state @code{1} at step @code{0} but does not include step +## @code{0} in the generated states and sequence. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{sequence} is the vector of length @var{len} of given outputs. The +## outputs must be integers ranging from @code{1} to +## @code{columns (outprob)}. +## +## @item +## @var{transprob} is the matrix of transition probabilities of the states. +## @code{transprob(i, j)} is the probability of a transition to state +## @code{j} given state @code{i}. +## +## @item +## @var{outprob} is the matrix of output probabilities. +## @code{outprob(i, j)} is the probability of generating output @code{j} +## given state @code{i}. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{vpath} is the vector of the same length as @var{sequence} of the +## estimated hidden states. The states are integers ranging from @code{1} to +## @code{columns (transprob)}. +## @end itemize +## +## If @code{'symbols'} is specified, then @var{sequence} is expected to be a +## sequence of the elements of @var{symbols} instead of integers ranging +## from @code{1} to @code{columns (outprob)}. @var{symbols} can be a cell array. +## +## If @code{'statenames'} is specified, then the elements of +## @var{statenames} are used for the states in @var{vpath} instead of +## integers ranging from @code{1} to @code{columns (transprob)}. +## @var{statenames} can be a cell array. +## +## @subheading Examples +## +## @example +## @group +## transprob = [0.8, 0.2; 0.4, 0.6]; +## outprob = [0.2, 0.4, 0.4; 0.7, 0.2, 0.1]; +## [sequence, states] = hmmgenerate (25, transprob, outprob) +## vpath = hmmviterbi (sequence, transprob, outprob) +## @end group +## +## @group +## symbols = @{'A', 'B', 'C'@}; +## statenames = @{'One', 'Two'@}; +## [sequence, states] = hmmgenerate (25, transprob, outprob, +## 'symbols', symbols, 'statenames', statenames) +## vpath = hmmviterbi (sequence, transprob, outprob, +## 'symbols', symbols, 'statenames', statenames) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Lawrence R. Rabiner. A Tutorial on Hidden Markov Models and Selected +## Applications in Speech Recognition. @cite{Proceedings of the IEEE}, +## 77(2), pages 257-286, February 1989. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Viterbi path of a hidden Markov model + +function vpath = hmmviterbi (sequence, transprob, outprob, varargin) + + # Check arguments + if (nargin < 3 || mod (length (varargin), 2) != 0) + print_usage (); + endif + + if (! ismatrix (transprob)) + error ("hmmviterbi: transprob must be a non-empty numeric matrix"); + endif + if (! ismatrix (outprob)) + error ("hmmviterbi: outprob must be a non-empty numeric matrix"); + endif + + len = length (sequence); + # nstate is the number of states of the hidden Markov model + nstate = rows (transprob); + # noutput is the number of different outputs that the hidden Markov model + # can generate + noutput = columns (outprob); + + # Check whether transprob and outprob are feasible for a hidden Markov model + if (columns (transprob) != nstate) + error ("hmmviterbi: transprob must be a square matrix"); + endif + if (rows (outprob) != nstate) + error ("hmmviterbi: outprob must have the same number of rows as transprob"); + endif + + # Flag for symbols + usesym = false; + # Flag for statenames + usesn = false; + + # Process varargin + for i = 1:2:length (varargin) + # There must be an identifier: 'symbols' or 'statenames' + if (! ischar (varargin{i})) + print_usage (); + endif + # Upper case is also fine + lowerarg = lower (varargin{i}); + if (strcmp (lowerarg, 'symbols')) + if (length (varargin{i + 1}) != noutput) + error ("hmmviterbi: number of symbols does not match number of possible outputs"); + endif + usesym = true; + # Use the following argument as symbols + symbols = varargin{i + 1}; + # The same for statenames + elseif (strcmp (lowerarg, 'statenames')) + if (length (varargin{i + 1}) != nstate) + error ("hmmviterbi: number of statenames does not match number of states"); + endif + usesn = true; + # Use the following argument as statenames + statenames = varargin{i + 1}; + else + error ("hmmviterbi: expected 'symbols' or 'statenames' but found '%s'", varargin{i}); + endif + endfor + + # Transform sequence from symbols to integers if necessary + if (usesym) + # sequenceint is used to build the transformed sequence + sequenceint = zeros (1, len); + for i = 1:noutput + # Search for symbols(i) in the sequence, isequal will have 1 at + # corresponding indices; i is the right integer for that symbol + isequal = ismember (sequence, symbols(i)); + # We do not want to change sequenceint if the symbol appears a second + # time in symbols + if (any ((sequenceint == 0) & (isequal == 1))) + isequal *= i; + sequenceint += isequal; + endif + endfor + if (! all (sequenceint)) + index = max ((sequenceint == 0) .* (1:len)); + error (["hmmviterbi: sequence(" int2str (index) ") not in symbols"]); + endif + sequence = sequenceint; + else + if (! isvector (sequence) && ! isempty (sequence)) + error ("hmmviterbi: sequence must be a vector"); + endif + if (! all (ismember (sequence, 1:noutput))) + index = max ((ismember (sequence, 1:noutput) == 0) .* (1:len)); + error (["hmmviterbi: sequence(" int2str (index) ") out of range"]); + endif + endif + + # Each row in transprob and outprob should contain probabilities + # => scale so that the sum is 1 + # A zero row remains zero + # - for transprob + s = sum (transprob, 2); + s(s == 0) = 1; + transprob = transprob ./ (s * ones (1, columns (transprob))); + # - for outprob + s = sum (outprob, 2); + s(s == 0) = 1; + outsprob = outprob ./ (s * ones (1, columns (outprob))); + + # Store the path starting from i in spath(i, :) + spath = ones (nstate, len + 1); + # Set the first state for each path + spath(:, 1) = (1:nstate)'; + # Store the probability of path i in spathprob(i) + spathprob = transprob(1, :); + + # Find the most likely paths for the given output sequence + for i = 1:len + # Calculate the new probabilities of the continuation with each state + nextpathprob = ((spathprob' .* outprob(:, sequence(i))) * ones (1, nstate)) .* transprob; + # Find the paths with the highest probabilities + [spathprob, mindex] = max (nextpathprob); + # Update spath and spathprob with the new paths + spath = spath(mindex, :); + spath(:, i + 1) = (1:nstate)'; + endfor + + # Set vpath to the most likely path + # We do not want the last state because we do not have an output for it + [m, mindex] = max (spathprob); + vpath = spath(mindex, 1:len); + + # Transform vpath into statenames if requested + if (usesn) + vpath = reshape (statenames(vpath), 1, len); + endif + +endfunction + +%!test +%! sequence = [1, 2, 1, 1, 1, 2, 2, 1, 2, 3, 3, 3, 3, 2, 3, 1, 1, 1, 1, 3, 3, 2, 3, 1, 3]; +%! transprob = [0.8, 0.2; 0.4, 0.6]; +%! outprob = [0.2, 0.4, 0.4; 0.7, 0.2, 0.1]; +%! vpath = hmmviterbi (sequence, transprob, outprob); +%! expected = [1, 1, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1]; +%! assert (vpath, expected); + +%!test +%! sequence = {'A', 'B', 'A', 'A', 'A', 'B', 'B', 'A', 'B', 'C', 'C', 'C', 'C', 'B', 'C', 'A', 'A', 'A', 'A', 'C', 'C', 'B', 'C', 'A', 'C'}; +%! transprob = [0.8, 0.2; 0.4, 0.6]; +%! outprob = [0.2, 0.4, 0.4; 0.7, 0.2, 0.1]; +%! symbols = {'A', 'B', 'C'}; +%! statenames = {'One', 'Two'}; +%! vpath = hmmviterbi (sequence, transprob, outprob, 'symbols', symbols, 'statenames', statenames); +%! expected = {'One', 'One', 'Two', 'Two', 'Two', 'One', 'One', 'One', 'One', 'One', 'One', 'One', 'One', 'One', 'One', 'Two', 'Two', 'Two', 'Two', 'One', 'One', 'One', 'One', 'One', 'One'}; +%! assert (vpath, expected); diff --git a/octave_packages/statistics-1.1.3/hygestat.m b/octave_packages/statistics-1.1.3/hygestat.m new file mode 100644 index 0000000..54d3caa --- /dev/null +++ b/octave_packages/statistics-1.1.3/hygestat.m @@ -0,0 +1,133 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{mn}, @var{v}] =} hygestat (@var{t}, @var{m}, @var{n}) +## Compute mean and variance of the hypergeometric distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{t} is the total size of the population of the hypergeometric +## distribution. The elements of @var{t} must be positive natural numbers +## +## @item +## @var{m} is the number of marked items of the hypergeometric distribution. +## The elements of @var{m} must be natural numbers +## +## @item +## @var{n} is the size of the drawn sample of the hypergeometric +## distribution. The elements of @var{n} must be positive natural numbers +## @end itemize +## @var{t}, @var{m}, and @var{n} must be of common size or scalar +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{mn} is the mean of the hypergeometric distribution +## +## @item +## @var{v} is the variance of the hypergeometric distribution +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## t = 4:9; +## m = 0:5; +## n = 1:6; +## [mn, v] = hygestat (t, m, n) +## @end group +## +## @group +## [mn, v] = hygestat (t, m, 2) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the hypergeometric distribution + +function [mn, v] = hygestat (t, m, n) + + # Check arguments + if (nargin != 3) + print_usage (); + endif + + if (! isempty (t) && ! ismatrix (t)) + error ("hygestat: t must be a numeric matrix"); + endif + if (! isempty (m) && ! ismatrix (m)) + error ("hygestat: m must be a numeric matrix"); + endif + if (! isempty (n) && ! ismatrix (n)) + error ("hygestat: n must be a numeric matrix"); + endif + + if (! isscalar (t) || ! isscalar (m) || ! isscalar (n)) + [retval, t, m, n] = common_size (t, m, n); + if (retval > 0) + error ("hygestat: t, m and n must be of common size or scalar"); + endif + endif + + # Calculate moments + mn = (n .* m) ./ t; + v = (n .* (m ./ t) .* (1 - m ./ t) .* (t - n)) ./ (t - 1); + + # Continue argument check + k = find (! (t >= 0) | ! (m >= 0) | ! (n > 0) | ! (t == round (t)) | ! (m == round (m)) | ! (n == round (n)) | ! (m <= t) | ! (n <= t)); + if (any (k)) + mn(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! t = 4:9; +%! m = 0:5; +%! n = 1:6; +%! [mn, v] = hygestat (t, m, n); +%! expected_mn = [0.0000, 0.4000, 1.0000, 1.7143, 2.5000, 3.3333]; +%! expected_v = [0.0000, 0.2400, 0.4000, 0.4898, 0.5357, 0.5556]; +%! assert (mn, expected_mn, 0.001); +%! assert (v, expected_v, 0.001); + +%!test +%! t = 4:9; +%! m = 0:5; +%! [mn, v] = hygestat (t, m, 2); +%! expected_mn = [0.0000, 0.4000, 0.6667, 0.8571, 1.0000, 1.1111]; +%! expected_v = [0.0000, 0.2400, 0.3556, 0.4082, 0.4286, 0.4321]; +%! assert (mn, expected_mn, 0.001); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/statistics-1.1.3/jackknife.m b/octave_packages/statistics-1.1.3/jackknife.m new file mode 100644 index 0000000..1870239 --- /dev/null +++ b/octave_packages/statistics-1.1.3/jackknife.m @@ -0,0 +1,141 @@ +## Copyright (C) 2011 Alexander Klein +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{jackstat} =} jackknife (@var{E}, @var{x}, @dots{}) +## Compute jackknife estimates of a parameter taking one or more given samples as parameters. +## In particular, @var{E} is the estimator to be jackknifed as a function name, handle, +## or inline function, and @var{x} is the sample for which the estimate is to be taken. +## The @var{i}-th entry of @var{jackstat} will contain the value of the estimator +## on the sample @var{x} with its @var{i}-th row omitted. +## +## @example +## @group +## jackstat(@var{i}) = @var{E}(@var{x}(1 : @var{i} - 1, @var{i} + 1 : length(@var{x}))) +## @end group +## @end example +## +## Depending on the number of samples to be used, the estimator must have the appropriate form: +## If only one sample is used, then the estimator need not be concerned with cell arrays, +## for example jackknifing the standard deviation of a sample can be performed with +## @code{@var{jackstat} = jackknife (@@std, rand (100, 1))}. +## If, however, more than one sample is to be used, the samples must all be of equal size, +## and the estimator must address them as elements of a cell-array, +## in which they are aggregated in their order of appearance: +## +## @example +## @group +## @var{jackstat} = jackknife(@@(x) std(x@{1@})/var(x@{2@}), rand (100, 1), randn (100, 1) +## @end group +## @end example +## +## If all goes well, a theoretical value @var{P} for the parameter is already known, +## @var{n} is the sample size, +## @code{@var{t} = @var{n} * @var{E}(@var{x}) - (@var{n} - 1) * mean(@var{jackstat})}, and +## @code{@var{v} = sumsq(@var{n} * @var{E}(@var{x}) - (@var{n} - 1) * @var{jackstat} - @var{t}) / (@var{n} * (@var{n} - 1))}, then +## @code{(@var{t}-@var{P})/sqrt(@var{v})} should follow a t-distribution with @var{n}-1 degrees of freedom. +## +## Jackknifing is a well known method to reduce bias; further details can be found in: +## @itemize @bullet +## @item Rupert G. Miller: The jackknife-a review; Biometrika (1974) 61(1): 1-15; doi:10.1093/biomet/61.1.1 +## @item Rupert G. Miller: Jackknifing Variances; Ann. Math. Statist. Volume 39, Number 2 (1968), 567-582; doi:10.1214/aoms/1177698418 +## @item M. H. Quenouille: Notes on Bias in Estimation; Biometrika Vol. 43, No. 3/4 (Dec., 1956), pp. 353-360; doi:10.1093/biomet/43.3-4.353 +## @end itemize +## @end deftypefn + +## Author: Alexander Klein +## Created: 2011-11-25 + +function jackstat = jackknife ( anEstimator, varargin ) + + + ## Convert function name to handle if necessary, or throw + ## an error. + if ( !strcmp ( typeinfo ( anEstimator ), "function handle" ) ) + + if ( isascii ( anEstimator ) ) + + anEstimator = str2func ( anEstimator ); + + else + + error ( "Estimators must be passed as function names or handles!" ); + end + end + + + ## Simple jackknifing can be done with a single vector argument, and + ## first and foremost with a function that does not care about + ## cell-arrays. + if ( length ( varargin ) == 1 && isnumeric ( varargin { 1 } ) ) + + aSample = varargin { 1 }; + + g = length ( aSample ); + + jackstat = zeros ( 1, g ); + + for k = 1 : g + jackstat ( k ) = anEstimator ( aSample ( [ 1 : k - 1, k + 1 : g ] ) ); + end + + ## More complicated input requires more work, however. + else + + g = cellfun ( @(x) length ( x ), varargin ); + + if ( any ( g - g ( 1 ) ) ) + + error ( "All passed data must be of equal length!" ); + end + + g = g ( 1 ); + + jackstat = zeros ( 1, g ); + + for k = 1 : g + + jackstat ( k ) = anEstimator ( cellfun ( @(x) x( [ 1 : k - 1, k + 1 : g ] ), varargin, "UniformOutput", false ) ); + end + + end +endfunction + + +%!test +%! ##Example from Quenouille, Table 1 +%! d=[0.18 4.00 1.04 0.85 2.14 1.01 3.01 2.33 1.57 2.19]; +%! jackstat = jackknife ( @(x) 1/mean(x), d ); +%! assert ( 10 / mean(d) - 9 * mean(jackstat), 0.5240, 1e-5 ); + +%!demo +%! for k = 1:1000 +%! x=rand(10,1); +%! s(k)=std(x); +%! jackstat=jackknife(@std,x); +%! j(k)=10*std(x) - 9*mean(jackstat); +%! end +%! figure();hist([s',j'], 0:sqrt(1/12)/10:2*sqrt(1/12)) + +%!demo +%! for k = 1:1000 +%! x=randn(1,50); +%! y=rand(1,50); +%! jackstat=jackknife(@(x) std(x{1})/std(x{2}),y,x); +%! j(k)=50*std(y)/std(x) - 49*mean(jackstat); +%! v(k)=sumsq((50*std(y)/std(x) - 49*jackstat) - j(k)) / (50 * 49); +%! end +%! t=(j-sqrt(1/12))./sqrt(v); +%! figure();plot(sort(tcdf(t,49)),"-;Almost linear mapping indicates good fit with t-distribution.;") diff --git a/octave_packages/statistics-1.1.3/jsucdf.m b/octave_packages/statistics-1.1.3/jsucdf.m new file mode 100644 index 0000000..59ffaf0 --- /dev/null +++ b/octave_packages/statistics-1.1.3/jsucdf.m @@ -0,0 +1,61 @@ +## Copyright (C) 2006 Frederick (Rick) A Niles +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} jsucdf (@var{x}, @var{alpha1}, @var{alpha2}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the Johnson SU distribution with shape parameters +## @var{alpha1} and @var{alpha2}. +## +## Default values are @var{alpha1} = 1, @var{alpha2} = 1. +## @end deftypefn + +## Author: Frederick (Rick) A Niles +## Description: CDF of the Johnson SU distribution + +## This function is derived from normcdf.m + +## This is the TeX equation of this function: +## +## \[ F(x) = \Phi\left(\alpha_1 + \alpha_2 +## \log\left(x + \sqrt{x^2 + 1} \right)\right) \] +## +## where \[ -\infty < x < \infty ; \alpha_2 > 0 \] and $\Phi$ is the +## standard normal cumulative distribution function. $\alpha_1$ and +## $\alpha_2$ are shape parameters. + + +function cdf = jsucdf (x, alpha1, alpha2) + + if (! ((nargin == 1) || (nargin == 3))) + print_usage; + endif + + if (nargin == 1) + m = 0; + v = 1; + endif + + if (!isscalar (alpha1) || !isscalar(alpha2)) + [retval, x, alpha1, alpha2] = common_size (x, alpha1, alpha2); + if (retval > 0) + error ("normcdf: x, alpha1 and alpha2 must be of common size or scalar"); + endif + endif + + one = ones (size (x)); + cdf = stdnormal_cdf (alpha1 .* one + alpha2 .* log (x + sqrt(x.*x + one))); + +endfunction diff --git a/octave_packages/statistics-1.1.3/jsupdf.m b/octave_packages/statistics-1.1.3/jsupdf.m new file mode 100644 index 0000000..c4ec1af --- /dev/null +++ b/octave_packages/statistics-1.1.3/jsupdf.m @@ -0,0 +1,62 @@ +## Copyright (C) 2006 Frederick (Rick) A Niles +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} jsupdf (@var{x}, @var{alpha1}, @var{alpha2}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the Johnson SU distribution with shape parameters @var{alpha1} +## and @var{alpha2}. +## +## Default values are @var{alpha1} = 1, @var{alpha2} = 1. +## @end deftypefn + +## Author: Frederick (Rick) A Niles +## Description: PDF of Johnson SU distribution + +## This function is derived from normpdf.m + +## This is the TeX equation of this function: +## +## \[ f(x) = \frac{\alpha_2}{\sqrt{x^2+1}} \phi\left(\alpha_1+\alpha_2 +## \log{\left(x+\sqrt{x^2+1}\right)}\right) \] +## +## where \[ -\infty < x < \infty ; \alpha_2 > 0 \] and $\phi$ is the +## standard normal probability distribution function. $\alpha_1$ and +## $\alpha_2$ are shape parameters. + +function pdf = jsupdf (x, alpha1, alpha2) + + if (nargin != 1 && nargin != 3) + print_usage; + endif + + if (nargin == 1) + alpha1 = 1; + alpha2 = 1; + endif + + if (!isscalar (alpha1) || !isscalar(alpha2)) + [retval, x, alpha1, alpha2] = common_size (x, alpha1, alpha2); + if (retval > 0) + error ("normpdf: x, alpha1 and alpha2 must be of common size or scalars"); + endif + endif + + one = ones(size(x)); + sr = sqrt(x.*x + one); + pdf = (alpha2 ./ sr) .* stdnormal_pdf (alpha1 .* one + + alpha2 .* log (x + sr)); + +endfunction diff --git a/octave_packages/statistics-1.1.3/kmeans.m b/octave_packages/statistics-1.1.3/kmeans.m new file mode 100644 index 0000000..5ac5ee4 --- /dev/null +++ b/octave_packages/statistics-1.1.3/kmeans.m @@ -0,0 +1,139 @@ +## Copyright (C) 2011 Soren Hauberg +## Copyright (C) 2012 Daniel Ward +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{idx}, @var{centers}] =} kmeans (@var{data}, @var{k}, @var{param1}, @var{value1}, @dots{}) +## K-means clustering. +## +## @seealso{linkage} +## @end deftypefn + +function [classes, centers, sumd, D] = kmeans (data, k, varargin) + [reg, prop] = parseparams (varargin); + + ## defaults for options + emptyaction = "error"; + start = "sample"; + + #used for getting the number of samples + nRows = rows (data); + + ## used to hold the distances from each sample to each class + D = zeros (nRows, k); + + #used for convergence of the centroids + err = 1; + + #initial sum of distances + sumd = Inf; + + ## Input checking, validate the matrix and k + if (!isnumeric (data) || !ismatrix (data) || !isreal (data)) + error ("kmeans: first input argument must be a DxN real data matrix"); + elseif (!isscalar (k)) + error ("kmeans: second input argument must be a scalar"); + endif + + if (length (varargin) > 0) + ## check for the 'emptyaction' property + found = find (strcmpi (prop, "emptyaction") == 1); + switch (lower (prop{found+1})) + case "singleton" + emptyaction = "singleton"; + otherwise + error ("kmeans: unsupported empty cluster action parameter"); + endswitch + endif + + ## check for the 'start' property + switch (lower (start)) + case "sample" + idx = randperm (nRows) (1:k); + centers = data (idx, :); + otherwise + error ("kmeans: unsupported initial clustering parameter"); + endswitch + + ## Run the algorithm + while err > .001 + ## Compute distances + for i = 1:k + D (:, i) = sumsq (data - repmat (centers(i, :), nRows, 1), 2); + endfor + + ## Classify + [tmp, classes] = min (D, [], 2); + + ## Calcualte new centroids + for i = 1:k + ## Check for empty clusters + if (sum (classes == i) ==0 || length (mean (data(classes == i, :))) == 0) + + switch emptyaction + ## if 'singleton', then find the point that is the + ## farthest and add it to the empty cluster + case 'singleton' + classes(maxCostSampleIndex (data, centers(i,:))) = i; + ## if 'error' then throw the error + otherwise + error ("kmeans: empty cluster created"); + endswitch + endif ## end check for empty clusters + + ## update the centroids + centers(i, :) = mean (data(classes == i, :)); + endfor + + ## calculate the differnece in the sum of distances + err = sumd - objCost (data, classes, centers); + ## update the current sum of distances + sumd = objCost (data, classes, centers); + endwhile +endfunction + +## calculate the sum of distances +function obj = objCost (data, classes, centers) + obj = 0; + for i=1:rows (data) + obj = obj + sumsq (data(i,:) - centers(classes(i),:)); + endfor +endfunction + +function index = maxCostSampleIndex (data, centers) + cost = 0; + for index = 1:rows (data) + if cost < sumsq (data(index,:) - centers) + cost = sumsq (data(index,:) - centers); + endif + endfor +endfunction + +%!demo +%! ## Generate a two-cluster problem +%! C1 = randn (100, 2) + 1; +%! C2 = randn (100, 2) - 1; +%! data = [C1; C2]; +%! +%! ## Perform clustering +%! [idx, centers] = kmeans (data, 2); +%! +%! ## Plot the result +%! figure +%! plot (data (idx==1, 1), data (idx==1, 2), 'ro'); +%! hold on +%! plot (data (idx==2, 1), data (idx==2, 2), 'bs'); +%! plot (centers (:, 1), centers (:, 2), 'kv', 'markersize', 10); +%! hold off diff --git a/octave_packages/statistics-1.1.3/linkage.m b/octave_packages/statistics-1.1.3/linkage.m new file mode 100644 index 0000000..84dadb6 --- /dev/null +++ b/octave_packages/statistics-1.1.3/linkage.m @@ -0,0 +1,231 @@ +## Copyright (C) 2008 Francesco Potortì +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} linkage (@var{d}) +## @deftypefnx {Function File} {@var{y} =} linkage (@var{d}, @var{method}) +## @deftypefnx {Function File} @ +## {@var{y} =} linkage (@var{x}, @var{method}, @var{metric}) +## @deftypefnx {Function File} @ +## {@var{y} =} linkage (@var{x}, @var{method}, @var{arglist}) +## +## Produce a hierarchical clustering dendrogram +## +## @var{d} is the dissimilarity matrix relative to @var{n} observations, +## formatted as a @math{(n-1)*n/2}x1 vector as produced by @code{pdist}. +## Alternatively, @var{x} contains data formatted for input to +## @code{pdist}, @var{metric} is a metric for @code{pdist} and +## @var{arglist} is a cell array containing arguments that are passed to +## @code{pdist}. +## +## @code{linkage} starts by putting each observation into a singleton +## cluster and numbering those from 1 to @var{n}. Then it merges two +## clusters, chosen according to @var{method}, to create a new cluster +## numbered @var{n+1}, and so on until all observations are grouped into +## a single cluster numbered @var{2*n-1}. Row @var{m} of the +## @math{m-1}x3 output matrix relates to cluster @math{n+m}: the first +## two columns are the numbers of the two component clusters and column +## 3 contains their distance. +## +## @var{method} defines the way the distance between two clusters is +## computed and how they are recomputed when two clusters are merged: +## +## @table @samp +## @item "single" (default) +## Distance between two clusters is the minimum distance between two +## elements belonging each to one cluster. Produces a cluster tree +## known as minimum spanning tree. +## +## @item "complete" +## Furthest distance between two elements belonging each to one cluster. +## +## @item "average" +## Unweighted pair group method with averaging (UPGMA). +## The mean distance between all pair of elements each belonging to one +## cluster. +## +## @item "weighted" +## Weighted pair group method with averaging (WPGMA). +## When two clusters A and B are joined together, the new distance to a +## cluster C is the mean between distances A-C and B-C. +## +## @item "centroid" +## Unweighted Pair-Group Method using Centroids (UPGMC). +## Assumes Euclidean metric. The distance between cluster centroids, +## each centroid being the center of mass of a cluster. +## +## @item "median" +## Weighted pair-group method using centroids (WPGMC). +## Assumes Euclidean metric. Distance between cluster centroids. When +## two clusters are joined together, the new centroid is the midpoint +## between the joined centroids. +## +## @item "ward" +## Ward's sum of squared deviations about the group mean (ESS). +## Also known as minimum variance or inner squared distance. +## Assumes Euclidean metric. How much the moment of inertia of the +## merged cluster exceeds the sum of those of the individual clusters. +## @end table +## +## @strong{Reference} +## Ward, J. H. Hierarchical Grouping to Optimize an Objective Function +## J. Am. Statist. Assoc. 1963, 58, 236-244, +## @url{http://iv.slis.indiana.edu/sw/data/ward.pdf}. +## @end deftypefn +## +## @seealso{pdist,squareform} + +## Author: Francesco Potortì + +function dgram = linkage (d, method = "single", distarg) + + ## check the input + if (nargin < 1) || (nargin > 3) + print_usage (); + endif + + if (isempty (d)) + error ("linkage: d cannot be empty"); + elseif ( nargin < 3 && ~ isvector (d)) + error ("linkage: d must be a vector"); + endif + + methods = struct ... + ("name", { "single"; "complete"; "average"; "weighted"; + "centroid"; "median"; "ward" }, + "distfunc", {(@(x) min(x)) # single + (@(x) max(x)) # complete + (@(x,i,j,w) sum(diag(q=w([i,j]))*x)/sum(q)) # average + (@(x) mean(x)) # weighted + (@massdist) # centroid + (@(x,i) massdist(x,i)) # median + (@inertialdist) # ward + }); + mask = strcmp (lower (method), {methods.name}); + if (! any (mask)) + error ("linkage: %s: unknown method", method); + endif + dist = {methods.distfunc}{mask}; + + if (nargin == 3) + if (ischar (distarg)) + d = pdist (d, distarg); + elseif (iscell (distarg)) + d = pdist (d, distarg{:}); + else + print_usage (); + endif + endif + + d = squareform (d, "tomatrix"); # dissimilarity NxN matrix + n = rows (d); # the number of observations + diagidx = sub2ind ([n,n], 1:n, 1:n); # indices of diagonal elements + d(diagidx) = Inf; # consider a cluster as far from itself + ## For equal-distance nodes, the order in which clusters are + ## merged is arbitrary. Rotating the initial matrix produces an + ## ordering similar to Matlab's. + cname = n:-1:1; # cluster names in d + d = rot90 (d, 2); # exchange low and high cluster numbers + weight = ones (1, n); # cluster weights + dgram = zeros (n-1, 3); # clusters from n+1 to 2*n-1 + for cluster = n+1:2*n-1 + ## Find the two nearest clusters + [m midx] = min (d(:)); + [r, c] = ind2sub (size (d), midx); + ## Here is the new cluster + dgram(cluster-n, :) = [cname(r) cname(c) d(r, c)]; + ## Put it in place of the first one and remove the second + cname(r) = cluster; + cname(c) = []; + ## Compute the new distances + newd = dist (d([r c], :), r, c, weight); + newd(r) = Inf; # take care of the diagonal element + ## Put distances in place of the first ones, remove the second ones + d(r,:) = newd; + d(:,r) = newd'; + d(c,:) = []; + d(:,c) = []; + ## The new weight is the sum of the components' weights + weight(r) += weight(c); + weight(c) = []; + endfor + ## Sort the cluster numbers, as Matlab does + dgram(:,1:2) = sort (dgram(:,1:2), 2); + + ## Check that distances are monotonically increasing + if (any (diff (dgram(:,3)) < 0)) + warning ("clustering", + "linkage: cluster distances do not monotonically increase\n\ + you should probably use a method different from \"%s\"", method); + endif + +endfunction + +## Take two row vectors, which are the Euclidean distances of clusters I +## and J from the others. Column I of second row contains the distance +## between clusters I and J. The centre of gravity of the new cluster +## is on the segment joining the old ones. W are the weights of all +## clusters. Use the law of cosines to find the distances of the new +## cluster from all the others. +function y = massdist (x, i, j, w) + x .^= 2; # squared Euclidean distances + if (nargin == 2) # median distance + qi = 0.5; # equal weights ("weighted") + else # centroid distance + qi = 1 / (1 + w(j) / w(i)); # proportional weights ("unweighted") + endif + y = sqrt (qi*x(1,:) + (1-qi)*(x(2,:) - qi*x(2,i))); +endfunction + +## Take two row vectors, which are the inertial distances of clusters I +## and J from the others. Column I of second row contains the inertial +## distance between clusters I and J. The centre of gravity of the new +## cluster K is on the segment joining I and J. W are the weights of +## all clusters. Convert inertial to Euclidean distances, then use the +## law of cosines to find the Euclidean distances of K from all the +## other clusters, convert them back to inertial distances and return +## them. +function y = inertialdist (x, i, j, w) + wi = w(i); wj = w(j); # the cluster weights + s = [wi + w; wj + w]; # sum of weights for all cluster pairs + p = [wi * w; wj * w]; # product of weights for all cluster pairs + x = x.^2 .* s ./ p; # convert inertial dist. to squared Eucl. + sij = wi + wj; # sum of weights of I and J + qi = wi/sij; # normalise the weight of I + ## Squared Euclidean distances between all clusters and new cluster K + x = qi*x(1,:) + (1-qi)*(x(2,:) - qi*x(2,i)); + y = sqrt (x * sij .* w ./ (sij + w)); # convert Eucl. dist. to inertial +endfunction + +%!shared x, t +%! x = reshape(mod(magic(6),5),[],3); +%! t = 1e-6; +%!assert (cond (linkage (pdist (x))), 34.119045,t); +%!assert (cond (linkage (pdist (x), "complete")), 21.793345,t); +%!assert (cond (linkage (pdist (x), "average")), 27.045012,t); +%!assert (cond (linkage (pdist (x), "weighted")), 27.412889,t); +%! lastwarn(); # Clear last warning before the test +%!warning linkage (pdist (x), "centroid"); +%!test warning off clustering +%! assert (cond (linkage (pdist (x), "centroid")), 27.457477,t); +%! warning on clustering +%!warning linkage (pdist (x), "median"); +%!test warning off clustering +%! assert (cond (linkage (pdist (x), "median")), 27.683325,t); +%! warning on clustering +%!assert (cond (linkage (pdist (x), "ward")), 17.195198,t); +%!assert (cond (linkage(x,"ward","euclidean")), 17.195198,t); +%!assert (cond (linkage(x,"ward",{"euclidean"})), 17.195198,t); +%!assert (cond (linkage(x,"ward",{"minkowski",2})),17.195198,t); diff --git a/octave_packages/statistics-1.1.3/lognstat.m b/octave_packages/statistics-1.1.3/lognstat.m new file mode 100644 index 0000000..6f17fa2 --- /dev/null +++ b/octave_packages/statistics-1.1.3/lognstat.m @@ -0,0 +1,123 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} lognstat (@var{mu}, @var{sigma}) +## Compute mean and variance of the lognormal distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{mu} is the first parameter of the lognormal distribution +## +## @item +## @var{sigma} is the second parameter of the lognormal distribution. +## @var{sigma} must be positive or zero +## @end itemize +## @var{mu} and @var{sigma} must be of common size or one of them must be +## scalar +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the lognormal distribution +## +## @item +## @var{v} is the variance of the lognormal distribution +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## mu = 0:0.2:1; +## sigma = 0.2:0.2:1.2; +## [m, v] = lognstat (mu, sigma) +## @end group +## +## @group +## [m, v] = lognstat (0, sigma) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the lognormal distribution + +function [m, v] = lognstat (mu, sigma) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! isempty (mu) && ! ismatrix (mu)) + error ("lognstat: mu must be a numeric matrix"); + endif + if (! isempty (sigma) && ! ismatrix (sigma)) + error ("lognstat: sigma must be a numeric matrix"); + endif + + if (! isscalar (mu) || ! isscalar (sigma)) + [retval, mu, sigma] = common_size (mu, sigma); + if (retval > 0) + error ("lognstat: mu and sigma must be of common size or scalar"); + endif + endif + + # Calculate moments + m = exp (mu + (sigma .^ 2) ./ 2); + v = (exp (sigma .^ 2) - 1) .* exp (2 .* mu + sigma .^ 2); + + # Continue argument check + k = find (! (sigma >= 0) | ! (sigma < Inf)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! mu = 0:0.2:1; +%! sigma = 0.2:0.2:1.2; +%! [m, v] = lognstat (mu, sigma); +%! expected_m = [1.0202, 1.3231, 1.7860, 2.5093, 3.6693, 5.5845]; +%! expected_v = [0.0425, 0.3038, 1.3823, 5.6447, 23.1345, 100.4437]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); + +%!test +%! sigma = 0.2:0.2:1.2; +%! [m, v] = lognstat (0, sigma); +%! expected_m = [1.0202, 1.0833, 1.1972, 1.3771, 1.6487, 2.0544]; +%! expected_v = [0.0425, 0.2036, 0.6211, 1.7002, 4.6708, 13.5936]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/statistics-1.1.3/mad.m b/octave_packages/statistics-1.1.3/mad.m new file mode 100644 index 0000000..eb9d667 --- /dev/null +++ b/octave_packages/statistics-1.1.3/mad.m @@ -0,0 +1,98 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} mad (@var{x}) +## @deftypefnx{Function File} mad (@var{x}, @var{flag}) +## @deftypefnx{Function File} mad (@var{x}, @var{flag}, @var{dim}) +## Compute the mean/median absolute deviation of @var{x}. +## +## The mean absolute deviation is computed as +## +## @example +## mean (abs (@var{x} - mean (@var{x}))) +## @end example +## +## and the median absolute deviation is computed as +## +## @example +## median (abs (@var{x} - median (@var{x}))) +## @end example +## +## Elements of @var{x} containing NaN or NA values are ignored during computations. +## +## If @var{flag} is 0, the absolute mean deviation is computed, and if @var{flag} +## is 1, the absolute median deviation is computed. By default @var{flag} is 0. +## +## This is done along the dimension @var{dim} of @var{x}. If this variable is not +## given, the mean/median absolute deviation s computed along the smallest dimension of +## @var{x}. +## +## @seealso{std} +## @end deftypefn + +function a = mad (X, flag = 0, dim = []) + ## Check input + if (nargin < 1) + print_usage (); + endif + if (nargin > 3) + error ("mad: too many input arguments"); + endif + + if (!isnumeric (X)) + error ("mad: first input must be numeric"); + endif + + if (isempty (dim)) + dim = min (find (size (X) > 1)); + if (isempty(dim)) + dim = 1; + endif + endif + + if (!isscalar (flag)) + error ("mad: second input argument must be a scalar"); + endif + if (!isscalar (dim)) + error ("mad: dimension argument must be a scalar"); + endif + + if (flag == 0) + f = @nanmean; + else + f = @nanmedian; + endif + + ## Compute the mad + if (prod(size(X)) != size(X,dim)) + sz = ones (1, length (size (X))); + sz (dim) = size (X,dim); + a = f (abs (X - repmat (f (X, dim), sz)), dim); + elseif (all (size (X) > 1)) + a = f (abs (X - ones (size(X, 1), 1) * f (X, dim)), dim); + else + a = f (abs (X - f(X, dim)), dim); + endif +endfunction + +## Tests + +%!assert (mad(1), 0); +%!test +%! X = eye(3); abs_mean = [4/9, 4/9, 4/9]; abs_median=[0,0,0]; +%! assert(mad(X), abs_mean, eps); +%! assert(mad(X, 0), abs_mean, eps); +%! assert(mad(X,1), abs_median); diff --git a/octave_packages/statistics-1.1.3/mnpdf.m b/octave_packages/statistics-1.1.3/mnpdf.m new file mode 100644 index 0000000..fb1920e --- /dev/null +++ b/octave_packages/statistics-1.1.3/mnpdf.m @@ -0,0 +1,134 @@ +## Copyright (C) 2012 Arno Onken +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} mnpdf (@var{x}, @var{p}) +## Compute the probability density function of the multinomial distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{x} is vector with a single sample of a multinomial distribution with +## parameter @var{p} or a matrix of random samples from multinomial +## distributions. In the latter case, each row of @var{x} is a sample from a +## multinomial distribution with the corresponding row of @var{p} being its +## parameter. +## +## @item +## @var{p} is a vector with the probabilities of the categories or a matrix +## with each row containing the probabilities of a multinomial sample. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{y} is a vector of probabilites of the random samples @var{x} from the +## multinomial distribution with corresponding parameter @var{p}. The parameter +## @var{n} of the multinomial distribution is the sum of the elements of each +## row of @var{x}. The length of @var{y} is the number of columns of @var{x}. +## If a row of @var{p} does not sum to @code{1}, then the corresponding element +## of @var{y} will be @code{NaN}. +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## x = [1, 4, 2]; +## p = [0.2, 0.5, 0.3]; +## y = mnpdf (x, p); +## @end group +## +## @group +## x = [1, 4, 2; 1, 0, 9]; +## p = [0.2, 0.5, 0.3; 0.1, 0.1, 0.8]; +## y = mnpdf (x, p); +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, 2001. +## +## @item +## Merran Evans, Nicholas Hastings and Brian Peacock. @cite{Statistical +## Distributions}. pages 134-136, Wiley, New York, third edition, 2000. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: PDF of the multinomial distribution + +function y = mnpdf (x, p) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! ismatrix (x) || any (x(:) < 0 | round (x(:) != x(:)))) + error ("mnpdf: x must be a matrix of non-negative integer values"); + endif + if (! ismatrix (p) || any (p(:) < 0)) + error ("mnpdf: p must be a non-empty matrix with rows of probabilities"); + endif + + # Adjust input sizes + if (! isvector (x) || ! isvector (p)) + if (isvector (x)) + x = x(:)'; + endif + if (isvector (p)) + p = p(:)'; + endif + if (size (x, 1) == 1 && size (p, 1) > 1) + x = repmat (x, size (p, 1), 1); + elseif (size (x, 1) > 1 && size (p, 1) == 1) + p = repmat (p, size (x, 1), 1); + endif + endif + # Continue argument check + if (any (size (x) != size (p))) + error ("mnpdf: x and p must have compatible sizes"); + endif + + # Count total number of elements of each multinomial sample + n = sum (x, 2); + # Compute probability density function of the multinomial distribution + t = x .* log (p); + t(x == 0) = 0; + y = exp (gammaln (n+1) - sum (gammaln (x+1), 2) + sum (t, 2)); + # Set invalid rows to NaN + k = (abs (sum (p, 2) - 1) > 1e-6); + y(k) = NaN; + +endfunction + +%!test +%! x = [1, 4, 2]; +%! p = [0.2, 0.5, 0.3]; +%! y = mnpdf (x, p); +%! assert (y, 0.11812, 0.001); + +%!test +%! x = [1, 4, 2; 1, 0, 9]; +%! p = [0.2, 0.5, 0.3; 0.1, 0.1, 0.8]; +%! y = mnpdf (x, p); +%! assert (y, [0.11812; 0.13422], 0.001); diff --git a/octave_packages/statistics-1.1.3/mnrnd.m b/octave_packages/statistics-1.1.3/mnrnd.m new file mode 100644 index 0000000..1332faf --- /dev/null +++ b/octave_packages/statistics-1.1.3/mnrnd.m @@ -0,0 +1,184 @@ +## Copyright (C) 2012 Arno Onken +## +## This program is free software: you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation, either version 3 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program. If not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} mnrnd (@var{n}, @var{p}) +## @deftypefnx {Function File} {@var{x} =} mnrnd (@var{n}, @var{p}, @var{s}) +## Generate random samples from the multinomial distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{n} is the first parameter of the multinomial distribution. @var{n} can +## be scalar or a vector containing the number of trials of each multinomial +## sample. The elements of @var{n} must be non-negative integers. +## +## @item +## @var{p} is the second parameter of the multinomial distribution. @var{p} can +## be a vector with the probabilities of the categories or a matrix with each +## row containing the probabilities of a multinomial sample. If @var{p} has +## more than one row and @var{n} is non-scalar, then the number of rows of +## @var{p} must match the number of elements of @var{n}. +## +## @item +## @var{s} is the number of multinomial samples to be generated. @var{s} must +## be a non-negative integer. If @var{s} is specified, then @var{n} must be +## scalar and @var{p} must be a vector. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{x} is a matrix of random samples from the multinomial distribution with +## corresponding parameters @var{n} and @var{p}. Each row corresponds to one +## multinomial sample. The number of columns, therefore, corresponds to the +## number of columns of @var{p}. If @var{s} is not specified, then the number +## of rows of @var{x} is the maximum of the number of elements of @var{n} and +## the number of rows of @var{p}. If a row of @var{p} does not sum to @code{1}, +## then the corresponding row of @var{x} will contain only @code{NaN} values. +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## n = 10; +## p = [0.2, 0.5, 0.3]; +## x = mnrnd (n, p); +## @end group +## +## @group +## n = 10 * ones (3, 1); +## p = [0.2, 0.5, 0.3]; +## x = mnrnd (n, p); +## @end group +## +## @group +## n = (1:2)'; +## p = [0.2, 0.5, 0.3; 0.1, 0.1, 0.8]; +## x = mnrnd (n, p); +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, 2001. +## +## @item +## Merran Evans, Nicholas Hastings and Brian Peacock. @cite{Statistical +## Distributions}. pages 134-136, Wiley, New York, third edition, 2000. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Random samples from the multinomial distribution + +function x = mnrnd (n, p, s) + + # Check arguments + if (nargin == 3) + if (! isscalar (n) || n < 0 || round (n) != n) + error ("mnrnd: n must be a non-negative integer"); + endif + if (! isvector (p) || any (p < 0 | p > 1)) + error ("mnrnd: p must be a vector of probabilities"); + endif + if (! isscalar (s) || s < 0 || round (s) != s) + error ("mnrnd: s must be a non-negative integer"); + endif + elseif (nargin == 2) + if (isvector (p) && size (p, 1) > 1) + p = p'; + endif + if (! isvector (n) || any (n < 0 | round (n) != n) || size (n, 2) > 1) + error ("mnrnd: n must be a non-negative integer column vector"); + endif + if (! ismatrix (p) || isempty (p) || any (p < 0 | p > 1)) + error ("mnrnd: p must be a non-empty matrix with rows of probabilities"); + endif + if (! isscalar (n) && size (p, 1) > 1 && length (n) != size (p, 1)) + error ("mnrnd: the length of n must match the number of rows of p"); + endif + else + print_usage (); + endif + + # Adjust input sizes + if (nargin == 3) + n = n * ones (s, 1); + p = repmat (p(:)', s, 1); + elseif (nargin == 2) + if (isscalar (n) && size (p, 1) > 1) + n = n * ones (size (p, 1), 1); + elseif (size (p, 1) == 1) + p = repmat (p, length (n), 1); + endif + endif + sz = size (p); + + # Upper bounds of categories + ub = cumsum (p, 2); + # Make sure that the greatest upper bound is 1 + gub = ub(:, end); + ub(:, end) = 1; + # Lower bounds of categories + lb = [zeros(sz(1), 1) ub(:, 1:(end-1))]; + + # Draw multinomial samples + x = zeros (sz); + for i = 1:sz(1) + # Draw uniform random numbers + r = repmat (rand (n(i), 1), 1, sz(2)); + # Compare the random numbers of r to the cumulated probabilities of p and + # count the number of samples for each category + x(i, :) = sum (r <= repmat (ub(i, :), n(i), 1) & r > repmat (lb(i, :), n(i), 1), 1); + endfor + # Set invalid rows to NaN + k = (abs (gub - 1) > 1e-6); + x(k, :) = NaN; + +endfunction + +%!test +%! n = 10; +%! p = [0.2, 0.5, 0.3]; +%! x = mnrnd (n, p); +%! assert (size (x), size (p)); +%! assert (all (x >= 0)); +%! assert (all (round (x) == x)); +%! assert (sum (x) == n); + +%!test +%! n = 10 * ones (3, 1); +%! p = [0.2, 0.5, 0.3]; +%! x = mnrnd (n, p); +%! assert (size (x), [length(n), length(p)]); +%! assert (all (x >= 0)); +%! assert (all (round (x) == x)); +%! assert (all (sum (x, 2) == n)); + +%!test +%! n = (1:2)'; +%! p = [0.2, 0.5, 0.3; 0.1, 0.1, 0.8]; +%! x = mnrnd (n, p); +%! assert (size (x), size (p)); +%! assert (all (x >= 0)); +%! assert (all (round (x) == x)); +%! assert (all (sum (x, 2) == n)); diff --git a/octave_packages/statistics-1.1.3/monotone_smooth.m b/octave_packages/statistics-1.1.3/monotone_smooth.m new file mode 100644 index 0000000..15d5951 --- /dev/null +++ b/octave_packages/statistics-1.1.3/monotone_smooth.m @@ -0,0 +1,160 @@ +## Copyright (C) 2011 Nir Krakauer +## Copyright (C) 2011 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{yy} =} monotone_smooth (@var{x}, @var{y}, @var{h}) +## Produce a smooth monotone increasing approximation to a sampled functional +## dependence y(x) using a kernel method (an Epanechnikov smoothing kernel is +## applied to y(x); this is integrated to yield the monotone increasing form. +## See Reference 1 for details.) +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{x} is a vector of values of the independent variable. +## +## @item +## @var{y} is a vector of values of the dependent variable, of the same size as +## @var{x}. For best performance, it is recommended that the @var{y} already be +## fairly smooth, e.g. by applying a kernel smoothing to the original values if +## they are noisy. +## +## @item +## @var{h} is the kernel bandwidth to use. If @var{h} is not given, a "reasonable" +## value is computed. +## +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{yy} is the vector of smooth monotone increasing function values at @var{x}. +## +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## x = 0:0.1:10; +## y = (x .^ 2) + 3 * randn(size(x)); %typically non-monotonic from the added noise +## ys = ([y(1) y(1:(end-1))] + y + [y(2:end) y(end)])/3; %crudely smoothed via +## moving average, but still typically non-monotonic +## yy = monotone_smooth(x, ys); %yy is monotone increasing in x +## plot(x, y, '+', x, ys, x, yy) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Holger Dette, Natalie Neumeyer and Kay F. Pilz (2006), A simple nonparametric +## estimator of a strictly monotone regression function, @cite{Bernoulli}, 12:469-490 +## @item +## Regine Scheder (2007), R Package 'monoProc', Version 1.0-6, +## @url{http://cran.r-project.org/web/packages/monoProc/monoProc.pdf} (The +## implementation here is based on the monoProc function mono.1d) +## @end enumerate +## @end deftypefn + +## Author: Nir Krakauer +## Description: Nonparametric monotone increasing regression + +function yy = monotone_smooth (x, y, h) + + if (nargin < 2 || nargin > 3) + print_usage (); + elseif (!isnumeric (x) || !isvector (x)) + error ("first argument x must be a numeric vector") + elseif (!isnumeric (y) || !isvector (y)) + error ("second argument y must be a numeric vector") + elseif (numel (x) != numel (y)) + error ("x and y must have the same number of elements") + elseif (nargin == 3 && (!isscalar (h) || !isnumeric (h))) + error ("third argument 'h' (kernel bandwith) must a numeric scalar") + endif + + n = numel(x); + + %set filter bandwidth at a reasonable default value, if not specified + if (nargin != 3) + s = std(x); + h = s / (n^0.2); + end + + x_min = min(x); + x_max = max(x); + + y_min = min(y); + y_max = max(y); + + %transform range of x to [0, 1] + xl = (x - x_min) / (x_max - x_min); + + yy = ones(size(y)); + + %Epanechnikov smoothing kernel (with finite support) + %K_epanech_kernel = @(z) (3/4) * ((1 - z).^2) .* (abs(z) < 1); + + K_epanech_int = @(z) mean(((abs(z) < 1)/2) - (3/4) * (z .* (abs(z) < 1) - (1/3) * (z.^3) .* (abs(z) < 1)) + (z < -1)); + + %integral of kernels up to t + monotone_inverse = @(t) K_epanech_int((y - t) / h); + + %find the value of the monotone smooth function at each point in x + niter_max = 150; %maximum number of iterations for estimating each value (should not be reached in most cases) + for l = 1:n + + tmax = y_max; + tmin = y_min; + wmin = monotone_inverse(tmin); + wmax = monotone_inverse(tmax); + if (wmax == wmin) + yy(l) = tmin; + else + wt = xl(l); + iter_max_reached = 1; + for i = 1:niter_max + wt_scaled = (wt - wmin) / (wmax - wmin); + tn = tmin + wt_scaled * (tmax - tmin) ; + wn = monotone_inverse(tn); + wn_scaled = (wn - wmin) / (wmax - wmin); + + %if (abs(wt-wn) < 1E-4) || (tn < (y_min-0.1)) || (tn > (y_max+0.1)) + %% criterion for break in the R code -- replaced by the following line to + %% hopefully be less dependent on the scale of y + if (abs(wt_scaled-wn_scaled) < 1E-4) || (wt_scaled < -0.1) || (wt_scaled > 1.1) + iter_max_reached = 0; + break + endif + if wn > wt + tmax = tn; + wmax = wn; + else + tmin = tn; + wmin = wn; + endif + endfor + if iter_max_reached + warning("at x = %g, maximum number of iterations %d reached without convergence; approximation may not be optimal", x(l), niter_max) + endif + yy(l) = tmin + (wt - wmin) * (tmax - tmin) / (wmax - wmin); + endif + endfor +endfunction diff --git a/octave_packages/statistics-1.1.3/mvncdf.m b/octave_packages/statistics-1.1.3/mvncdf.m new file mode 100644 index 0000000..864badc --- /dev/null +++ b/octave_packages/statistics-1.1.3/mvncdf.m @@ -0,0 +1,173 @@ +## Copyright (C) 2008 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{p} =} mvncdf (@var{x}, @var{mu}, @var{sigma}) +## @deftypefnx {Function File} {} mvncdf (@var{a}, @var{x}, @var{mu}, @var{sigma}) +## @deftypefnx {Function File} {[@var{p}, @var{err}] =} mvncdf (@dots{}) +## Compute the cumulative distribution function of the multivariate +## normal distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{x} is the upper limit for integration where each row corresponds +## to an observation. +## +## @item +## @var{mu} is the mean. +## +## @item +## @var{sigma} is the correlation matrix. +## +## @item +## @var{a} is the lower limit for integration where each row corresponds +## to an observation. @var{a} must have the same size as @var{x}. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{p} is the cumulative distribution at each row of @var{x} and +## @var{a}. +## +## @item +## @var{err} is the estimated error. +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## x = [1 2]; +## mu = [0.5 1.5]; +## sigma = [1.0 0.5; 0.5 1.0]; +## p = mvncdf (x, mu, sigma) +## @end group +## +## @group +## a = [-inf 0]; +## p = mvncdf (a, x, mu, sigma) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Alan Genz and Frank Bretz. Numerical Computation of Multivariate +## t-Probabilities with Application to Power Calculation of Multiple +## Constrasts. @cite{Journal of Statistical Computation and Simulation}, +## 63, pages 361-378, 1999. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: CDF of the multivariate normal distribution + +function [p, err] = mvncdf (varargin) + + # Monte-Carlo confidence factor for the standard error: 99 % + gamma = 2.5; + # Tolerance + err_eps = 1e-3; + + if (length (varargin) == 1) + x = varargin{1}; + mu = []; + sigma = eye (size (x, 2)); + a = -Inf .* ones (size (x)); + elseif (length (varargin) == 3) + x = varargin{1}; + mu = varargin{2}; + sigma = varargin{3}; + a = -Inf .* ones (size (x)); + elseif (length (varargin) == 4) + a = varargin{1}; + x = varargin{2}; + mu = varargin{3}; + sigma = varargin{4}; + else + print_usage (); + endif + + # Dimension + q = size (sigma, 1); + cases = size (x, 1); + + # Default value for mu + if (isempty (mu)) + mu = zeros (1, q); + endif + + # Check parameters + if (size (x, 2) != q) + error ("mvncdf: x must have the same number of columns as sigma"); + endif + + if (any (size (x) != size (a))) + error ("mvncdf: a must have the same size as x"); + endif + + if (isscalar (mu)) + mu = ones (1, q) .* mu; + elseif (! isvector (mu) || size (mu, 2) != q) + error ("mvncdf: mu must be a scalar or a vector with the same number of columns as x"); + endif + + x = x - repmat (mu, cases, 1); + + if (q < 1 || size (sigma, 2) != q || any (any (sigma != sigma')) || min (eig (sigma)) <= 0) + error ("mvncdf: sigma must be nonempty symmetric positive definite"); + endif + + c = chol (sigma)'; + + # Number of integral transformations + n = 1; + + p = zeros (cases, 1); + varsum = zeros (cases, 1); + + err = ones (cases, 1) .* err_eps; + # Apply crude Monte-Carlo estimation + while any (err >= err_eps) + # Sample from q-1 dimensional unit hypercube + w = rand (cases, q - 1); + + # Transformation of the multivariate normal integral + dvev = normcdf ([a(:, 1) / c(1, 1), x(:, 1) / c(1, 1)]); + dv = dvev(:, 1); + ev = dvev(:, 2); + fv = ev - dv; + y = zeros (cases, q - 1); + for i = 1:(q - 1) + y(:, i) = norminv (dv + w(:, i) .* (ev - dv)); + dvev = normcdf ([(a(:, i + 1) - c(i + 1, 1:i) .* y(:, 1:i)) ./ c(i + 1, i + 1), (x(:, i + 1) - c(i + 1, 1:i) .* y(:, 1:i)) ./ c(i + 1, i + 1)]); + dv = dvev(:, 1); + ev = dvev(:, 2); + fv = (ev - dv) .* fv; + endfor + + n++; + # Estimate standard error + varsum += (n - 1) .* ((fv - p) .^ 2) ./ n; + err = gamma .* sqrt (varsum ./ (n .* (n - 1))); + p += (fv - p) ./ n; + endwhile + +endfunction diff --git a/octave_packages/statistics-1.1.3/mvnpdf.m b/octave_packages/statistics-1.1.3/mvnpdf.m new file mode 100644 index 0000000..2d8b2e2 --- /dev/null +++ b/octave_packages/statistics-1.1.3/mvnpdf.m @@ -0,0 +1,132 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} mvnpdf (@var{x}) +## @deftypefnx{Function File} {@var{y} =} mvnpdf (@var{x}, @var{mu}) +## @deftypefnx{Function File} {@var{y} =} mvnpdf (@var{x}, @var{mu}, @var{sigma}) +## Compute multivariate normal pdf for @var{x} given mean @var{mu} and covariance matrix +## @var{sigma}. The dimension of @var{x} is @var{d} x @var{p}, @var{mu} is +## @var{1} x @var{p} and @var{sigma} is @var{p} x @var{p}. The normal pdf is +## defined as +## +## @example +## @iftex +## @tex +## $$ 1/y^2 = (2 pi)^p |\Sigma| \exp \{ (x-\mu)^T \Sigma^{-1} (x-\mu) \} $$ +## @end tex +## @end iftex +## @ifnottex +## 1/@var{y}^2 = (2 pi)^@var{p} |@var{Sigma}| exp @{ (@var{x}-@var{mu})' inv(@var{Sigma})@ +## (@var{x}-@var{mu}) @} +## @end ifnottex +## @end example +## +## @strong{References} +## +## NIST Engineering Statistics Handbook 6.5.4.2 +## http://www.itl.nist.gov/div898/handbook/pmc/section5/pmc542.htm +## +## @strong{Algorithm} +## +## Using Cholesky factorization on the positive definite covariance matrix: +## +## @example +## @var{r} = chol (@var{sigma}); +## @end example +## +## where @var{r}'*@var{r} = @var{sigma}. Being upper triangular, the determinant +## of @var{r} is trivially the product of the diagonal, and the determinant of +## @var{sigma} is the square of this: +## +## @example +## @var{det} = prod (diag (@var{r}))^2; +## @end example +## +## The formula asks for the square root of the determinant, so no need to +## square it. +## +## The exponential argument @var{A} = @var{x}' * inv (@var{sigma}) * @var{x} +## +## @example +## @var{A} = @var{x}' * inv (@var{sigma}) * @var{x} +## = @var{x}' * inv (@var{r}' * @var{r}) * @var{x} +## = @var{x}' * inv (@var{r}) * inv(@var{r}') * @var{x} +## @end example +## +## Given that inv (@var{r}') == inv(@var{r})', at least in theory if not numerically, +## +## @example +## @var{A} = (@var{x}' / @var{r}) * (@var{x}'/@var{r})' = sumsq (@var{x}'/@var{r}) +## @end example +## +## The interface takes the parameters to the multivariate normal in columns rather than +## rows, so we are actually dealing with the transpose: +## +## @example +## @var{A} = sumsq (@var{x}/r) +## @end example +## +## and the final result is: +## +## @example +## @var{r} = chol (@var{sigma}) +## @var{y} = (2*pi)^(-@var{p}/2) * exp (-sumsq ((@var{x}-@var{mu})/@var{r}, 2)/2) / prod (diag (@var{r})) +## @end example +## +## @seealso{mvncdf, mvnrnd} +## @end deftypefn + +function pdf = mvnpdf (x, mu = 0, sigma = 1) + ## Check input + if (!ismatrix (x)) + error ("mvnpdf: first input must be a matrix"); + endif + + if (!isvector (mu) && !isscalar (mu)) + error ("mvnpdf: second input must be a real scalar or vector"); + endif + + if (!ismatrix (sigma) || !issquare (sigma)) + error ("mvnpdf: third input must be a square matrix"); + endif + + [ps, ps] = size (sigma); + [d, p] = size (x); + if (p != ps) + error ("mvnpdf: dimensions of data and covariance matrix does not match"); + endif + + if (numel (mu) != p && numel (mu) != 1) + error ("mvnpdf: dimensions of data does not match dimensions of mean value"); + endif + + mu = mu (:).'; + if (all (size (mu) == [1, p])) + mu = repmat (mu, [d, 1]); + endif + + if (nargin < 3) + pdf = (2*pi)^(-p/2) * exp (-sumsq (x-mu, 2)/2); + else + r = chol (sigma); + pdf = (2*pi)^(-p/2) * exp (-sumsq ((x-mu)/r, 2)/2) / prod (diag (r)); + endif +endfunction + +%!demo +%! mu = [0, 0]; +%! sigma = [1, 0.1; 0.1, 0.5]; +%! [X, Y] = meshgrid (linspace (-3, 3, 25)); +%! XY = [X(:), Y(:)]; +%! Z = mvnpdf (XY, mu, sigma); +%! mesh (X, Y, reshape (Z, size (X))); +%! colormap jet + +%!test +%! mu = [1,-1]; +%! sigma = [.9 .4; .4 .3]; +%! x = [ 0.5 -1.2; -0.5 -1.4; 0 -1.5]; +%! p = [ 0.41680003660313; 0.10278162359708; 0.27187267524566 ]; +%! q = mvnpdf (x, mu, sigma); +%! assert (p, q, 10*eps); diff --git a/octave_packages/statistics-1.1.3/mvnrnd.m b/octave_packages/statistics-1.1.3/mvnrnd.m new file mode 100644 index 0000000..5746c7f --- /dev/null +++ b/octave_packages/statistics-1.1.3/mvnrnd.m @@ -0,0 +1,105 @@ +## Copyright (C) 2003 Iain Murray +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{s} = mvnrnd (@var{mu}, @var{Sigma}) +## @deftypefnx{Function File} @var{s} = mvnrnd (@var{mu}, @var{Sigma}, @var{n}) +## Draw @var{n} random @var{d}-dimensional vectors from a multivariate Gaussian +## distribution with mean @var{mu}(@var{n}x@var{d}) and covariance matrix +## @var{Sigma}(@var{d}x@var{d}). +## @end deftypefn + +function s = mvnrnd(mu,Sigma,K) + + % Iain Murray 2003 -- I got sick of this simple thing not being in Octave and + % locking up a stats-toolbox license in Matlab for no good + % reason. + % May 2004 take a third arg, cases. Makes it more compatible with Matlab's. + + % Paul Kienzle + % * Add GPL notice. + % * Add docs for argument K + + % If mu is column vector and Sigma not a scalar then assume user didn't read + % help but let them off and flip mu. Don't be more liberal than this or it will + % encourage errors (eg what should you do if mu is square?). + if ((size(mu,2)==1)&&(size(Sigma)~=[1,1])) + mu=mu'; + end + + if nargin==3 + mu=repmat(mu,K,1); + end + + [n,d]=size(mu); + + if (size(Sigma)~=[d,d]) + error('Sigma must have dimensions dxd where mu is nxd.'); + end + + try + U=chol(Sigma); + catch + [E,Lambda]=eig(Sigma); + if (min(diag(Lambda))<0),error('Sigma must be positive semi-definite.'),end + U = sqrt(Lambda)*E'; + end + + s = randn(n,d)*U + mu; +endfunction + +% {{{ END OF CODE --- Guess I should provide an explanation: +% +% We can draw from axis aligned unit Gaussians with randn(d) +% x ~ A*exp(-0.5*x'*x) +% We can then rotate this distribution using +% y = U'*x +% Note that +% x = inv(U')*y +% Our new variable y is distributed according to: +% y ~ B*exp(-0.5*y'*inv(U'*U)*y) +% or +% y ~ N(0,Sigma) +% where +% Sigma = U'*U +% For a given Sigma we can use the chol function to find the corresponding U, +% draw x and find y. We can adjust for a non-zero mean by just adding it on. +% +% But the Cholsky decomposition function doesn't always work... +% Consider Sigma=[1 1;1 1]. Now inv(Sigma) doesn't actually exist, but Matlab's +% mvnrnd provides samples with this covariance st x(1)~N(0,1) x(2)=x(1). The +% fast way to deal with this would do something similar to chol but be clever +% when the rows aren't linearly independent. However, I can't be bothered, so +% another way of doing the decomposition is by diagonalising Sigma (which is +% slower but works). +% if +% [E,Lambda]=eig(Sigma) +% then +% Sigma = E*Lambda*E' +% so +% U = sqrt(Lambda)*E' +% If any Lambdas are negative then Sigma just isn't even positive semi-definite +% so we can give up. +% +% Paul Kienzle adds: +% Where it exists, chol(Sigma) is numerically well behaved. chol(hilb(12)) +% for doubles and for 100 digit floating point differ in the last digit. +% Where chol(Sigma) doesn't exist, X*sqrt(Lambda)*E' will be somewhat +% accurate. For example, the elements of sqrt(Lambda)*E' for hilb(12), +% hilb(55) and hilb(120) are accurate to around 1e-8 or better. This was +% tested using the TNT+JAMA for eig and chol templates, and qlib for +% 100 digit precision. +% }}} + diff --git a/octave_packages/statistics-1.1.3/mvtcdf.m b/octave_packages/statistics-1.1.3/mvtcdf.m new file mode 100644 index 0000000..8a271a1 --- /dev/null +++ b/octave_packages/statistics-1.1.3/mvtcdf.m @@ -0,0 +1,166 @@ +## Copyright (C) 2008 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{p} =} mvtcdf (@var{x}, @var{sigma}, @var{nu}) +## @deftypefnx {Function File} {} mvtcdf (@var{a}, @var{x}, @var{sigma}, @var{nu}) +## @deftypefnx {Function File} {[@var{p}, @var{err}] =} mvtcdf (@dots{}) +## Compute the cumulative distribution function of the multivariate +## Student's t distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{x} is the upper limit for integration where each row corresponds +## to an observation. +## +## @item +## @var{sigma} is the correlation matrix. +## +## @item +## @var{nu} is the degrees of freedom. +## +## @item +## @var{a} is the lower limit for integration where each row corresponds +## to an observation. @var{a} must have the same size as @var{x}. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{p} is the cumulative distribution at each row of @var{x} and +## @var{a}. +## +## @item +## @var{err} is the estimated error. +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## x = [1 2]; +## sigma = [1.0 0.5; 0.5 1.0]; +## nu = 4; +## p = mvtcdf (x, sigma, nu) +## @end group +## +## @group +## a = [-inf 0]; +## p = mvtcdf (a, x, sigma, nu) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Alan Genz and Frank Bretz. Numerical Computation of Multivariate +## t-Probabilities with Application to Power Calculation of Multiple +## Constrasts. @cite{Journal of Statistical Computation and Simulation}, +## 63, pages 361-378, 1999. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: CDF of the multivariate Student's t distribution + +function [p, err] = mvtcdf (varargin) + + # Monte-Carlo confidence factor for the standard error: 99 % + gamma = 2.5; + # Tolerance + err_eps = 1e-3; + + if (length (varargin) == 3) + x = varargin{1}; + sigma = varargin{2}; + nu = varargin{3}; + a = -Inf .* ones (size (x)); + elseif (length (varargin) == 4) + a = varargin{1}; + x = varargin{2}; + sigma = varargin{3}; + nu = varargin{4}; + else + print_usage (); + endif + + # Dimension + q = size (sigma, 1); + cases = size (x, 1); + + # Check parameters + if (size (x, 2) != q) + error ("mvtcdf: x must have the same number of columns as sigma"); + endif + + if (any (size (x) != size (a))) + error ("mvtcdf: a must have the same size as x"); + endif + + if (! isscalar (nu) && (! isvector (nu) || length (nu) != cases)) + error ("mvtcdf: nu must be a scalar or a vector with the same number of rows as x"); + endif + + # Convert to correlation matrix if necessary + if (any (diag (sigma) != 1)) + svar = repmat (diag (sigma), 1, q); + sigma = sigma ./ sqrt (svar .* svar'); + endif + if (q < 1 || size (sigma, 2) != q || any (any (sigma != sigma')) || min (eig (sigma)) <= 0) + error ("mvtcdf: sigma must be nonempty symmetric positive definite"); + endif + + nu = nu(:); + c = chol (sigma)'; + + # Number of integral transformations + n = 1; + + p = zeros (cases, 1); + varsum = zeros (cases, 1); + + err = ones (cases, 1) .* err_eps; + # Apply crude Monte-Carlo estimation + while any (err >= err_eps) + # Sample from q-1 dimensional unit hypercube + w = rand (cases, q - 1); + + # Transformation of the multivariate t-integral + dvev = tcdf ([a(:, 1) / c(1, 1), x(:, 1) / c(1, 1)], nu); + dv = dvev(:, 1); + ev = dvev(:, 2); + fv = ev - dv; + y = zeros (cases, q - 1); + for i = 1:(q - 1) + y(:, i) = tinv (dv + w(:, i) .* (ev - dv), nu + i - 1) .* sqrt ((nu + sum (y(:, 1:(i-1)) .^ 2, 2)) ./ (nu + i - 1)); + tf = (sqrt ((nu + i) ./ (nu + sum (y(:, 1:i) .^ 2, 2)))) ./ c(i + 1, i + 1); + dvev = tcdf ([(a(:, i + 1) - c(i + 1, 1:i) .* y(:, 1:i)) .* tf, (x(:, i + 1) - c(i + 1, 1:i) .* y(:, 1:i)) .* tf], nu + i); + dv = dvev(:, 1); + ev = dvev(:, 2); + fv = (ev - dv) .* fv; + endfor + + n++; + # Estimate standard error + varsum += (n - 1) .* ((fv - p) .^ 2) ./ n; + err = gamma .* sqrt (varsum ./ (n .* (n - 1))); + p += (fv - p) ./ n; + endwhile + +endfunction diff --git a/octave_packages/statistics-1.1.3/mvtrnd.m b/octave_packages/statistics-1.1.3/mvtrnd.m new file mode 100644 index 0000000..c5d1bde --- /dev/null +++ b/octave_packages/statistics-1.1.3/mvtrnd.m @@ -0,0 +1,137 @@ +## Copyright (C) 2012 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} mvtrnd (@var{sigma}, @var{nu}) +## @deftypefnx {Function File} {@var{x} =} mvtrnd (@var{sigma}, @var{nu}, @var{n}) +## Generate random samples from the multivariate t-distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{sigma} is the matrix of correlation coefficients. If there are any +## non-unit diagonal elements then @var{sigma} will be normalized. +## +## @item +## @var{nu} is the degrees of freedom for the multivariate t-distribution. +## @var{nu} must be a vector with the same number of elements as samples to be +## generated or be scalar. +## +## @item +## @var{n} is the number of rows of the matrix to be generated. @var{n} must be +## a non-negative integer and corresponds to the number of samples to be +## generated. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{x} is a matrix of random samples from the multivariate t-distribution +## with @var{n} row samples. +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## sigma = [1, 0.5; 0.5, 1]; +## nu = 3; +## n = 10; +## x = mvtrnd (sigma, nu, n); +## @end group +## +## @group +## sigma = [1, 0.5; 0.5, 1]; +## nu = [2; 3]; +## n = 2; +## x = mvtrnd (sigma, nu, 2); +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, 2001. +## +## @item +## Samuel Kotz and Saralees Nadarajah. @cite{Multivariate t Distributions and +## Their Applications}. Cambridge University Press, Cambridge, 2004. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Random samples from the multivariate t-distribution + +function x = mvtrnd (sigma, nu, n) + + # Check arguments + if (nargin < 2) + print_usage (); + endif + + if (! ismatrix (sigma) || any (any (sigma != sigma')) || min (eig (sigma)) <= 0) + error ("mvtrnd: sigma must be a positive definite matrix"); + endif + + if (!isvector (nu) || any (nu <= 0)) + error ("mvtrnd: nu must be a positive scalar or vector"); + endif + nu = nu(:); + + if (nargin > 2) + if (! isscalar (n) || n < 0 | round (n) != n) + error ("mvtrnd: n must be a non-negative integer") + endif + if (isscalar (nu)) + nu = nu * ones (n, 1); + else + if (length (nu) != n) + error ("mvtrnd: n must match the length of nu") + endif + endif + else + n = length (nu); + endif + + # Normalize sigma + if (any (diag (sigma) != 1)) + sigma = sigma ./ sqrt (diag (sigma) * diag (sigma)'); + endif + + # Dimension + d = size (sigma, 1); + # Draw samples + y = mvnrnd (zeros (1, d), sigma, n); + u = repmat (chi2rnd (nu), 1, d); + x = y .* sqrt (repmat (nu, 1, d) ./ u); +endfunction + +%!test +%! sigma = [1, 0.5; 0.5, 1]; +%! nu = 3; +%! n = 10; +%! x = mvtrnd (sigma, nu, n); +%! assert (size (x), [10, 2]); + +%!test +%! sigma = [1, 0.5; 0.5, 1]; +%! nu = [2; 3]; +%! n = 2; +%! x = mvtrnd (sigma, nu, 2); +%! assert (size (x), [2, 2]); diff --git a/octave_packages/statistics-1.1.3/nanmax.m b/octave_packages/statistics-1.1.3/nanmax.m new file mode 100644 index 0000000..c8c48f5 --- /dev/null +++ b/octave_packages/statistics-1.1.3/nanmax.m @@ -0,0 +1,53 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{v}, @var{idx}] =} nanmax (@var{X}) +## @deftypefnx{Function File} {[@var{v}, @var{idx}] =} nanmax (@var{X}, @var{Y}) +## Find the maximal element while ignoring NaN values. +## +## @code{nanmax} is identical to the @code{max} function except that NaN values +## are ignored. If all values in a column are NaN, the maximum is +## returned as NaN rather than []. +## +## @seealso{max, nansum, nanmin, nanmean, nanmedian} +## @end deftypefn + +function [v, idx] = nanmax (X, Y, DIM) + if nargin < 1 || nargin > 3 + print_usage; + elseif nargin == 1 || (nargin == 2 && isempty(Y)) + nanvals = isnan(X); + X(nanvals) = -Inf; + v = max (X); + v(all(nanvals)) = NaN; + elseif (nargin == 3 && isempty(Y)) + nanvals = isnan(X); + X(nanvals) = -Inf; + v = max (X,[],DIM); + v(all(nanvals,DIM)) = NaN; + else + Xnan = isnan(X); + Ynan = isnan(Y); + X(Xnan) = -Inf; + Y(Ynan) = -Inf; + if (nargin == 3) + v = max(X,Y,DIM); + else + v = max(X,Y); + endif + v(Xnan & Ynan) = NaN; + endif +endfunction diff --git a/octave_packages/statistics-1.1.3/nanmean.m b/octave_packages/statistics-1.1.3/nanmean.m new file mode 100644 index 0000000..9b3c224 --- /dev/null +++ b/octave_packages/statistics-1.1.3/nanmean.m @@ -0,0 +1,36 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{v} =} nanmean (@var{X}) +## @deftypefnx{Function File} {@var{v} =} nanmean (@var{X}, @var{dim}) +## Compute the mean value while ignoring NaN values. +## +## @code{nanmean} is identical to the @code{mean} function except that NaN values +## are ignored. If all values are NaN, the mean is returned as NaN. +## +## @seealso{mean, nanmin, nanmax, nansum, nanmedian} +## @end deftypefn + +function v = nanmean (X, varargin) + if nargin < 1 + print_usage; + else + n = sum (!isnan(X), varargin{:}); + n(n == 0) = NaN; + X(isnan(X)) = 0; + v = sum (X, varargin{:}) ./ n; + endif +endfunction diff --git a/octave_packages/statistics-1.1.3/nanmedian.m b/octave_packages/statistics-1.1.3/nanmedian.m new file mode 100644 index 0000000..5df58a4 --- /dev/null +++ b/octave_packages/statistics-1.1.3/nanmedian.m @@ -0,0 +1,69 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{v} = nanmedian (@var{x}) +## @deftypefnx{Function File} @var{v} = nanmedian (@var{x}, @var{dim}) +## Compute the median of data while ignoring NaN values. +## +## This function is identical to the @code{median} function except that NaN values +## are ignored. If all values are NaN, the median is returned as NaN. +## +## @seealso{median, nanmin, nanmax, nansum, nanmean} +## @end deftypefn + +function v = nanmedian (X, varargin) + if nargin < 1 || nargin > 2 + print_usage; + endif + if nargin < 2 + dim = min(find(size(X)>1)); + if isempty(dim), dim=1; endif; + else + dim = varargin{:}; + endif + + sz = size (X); + if (prod (sz) > 1) + ## Find lengths of datasets after excluding NaNs; valid datasets + ## are those that are not empty after you remove all the NaNs + n = sz(dim) - sum (isnan(X),varargin{:}); + + ## When n is equal to zero, force it to one, so that median + ## picks up a NaN value below + n (n==0) = 1; + + ## Sort the datasets, with the NaN going to the end of the data + X = sort (X, varargin{:}); + + ## Determine the offset for each column in single index mode + colidx = reshape((0:(prod(sz) / sz(dim) - 1)), size(n)); + colidx = floor(colidx / prod(sz(1:dim-1))) * prod(sz(1:dim)) + ... + mod(colidx,prod(sz(1:dim-1))); + stride = prod(sz(1:dim-1)); + + ## Average the two central values of the sorted list to compute + ## the median, but only do so for valid rows. If the dataset + ## is odd length, the single central value will be used twice. + ## E.g., + ## for n==5, ceil(2.5+0.5) is 3 and floor(2.5+0.5) is also 3 + ## for n==6, ceil(3.0+0.5) is 4 and floor(3.0+0.5) is 3 + ## correction made for stride of data "stride*ceil(2.5-0.5)+1" + v = (X(colidx + stride*ceil(n./2-0.5) + 1) + ... + X(colidx + stride*floor(n./2-0.5) + 1)) ./ 2; + else + error ("nanmedian: invalid matrix argument"); + endif +endfunction diff --git a/octave_packages/statistics-1.1.3/nanmin.m b/octave_packages/statistics-1.1.3/nanmin.m new file mode 100644 index 0000000..db1ce3c --- /dev/null +++ b/octave_packages/statistics-1.1.3/nanmin.m @@ -0,0 +1,54 @@ +## Copyright (C) 2001 Paul Kienzle +## Copyright (C) 2003 Alois Schloegl +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{v}, @var{idx}] =} nanmin (@var{X}) +## @deftypefnx{Function File} {[@var{v}, @var{idx}] =} nanmin (@var{X}, @var{Y}) +## Find the minimal element while ignoring NaN values. +## +## @code{nanmin} is identical to the @code{min} function except that NaN values +## are ignored. If all values in a column are NaN, the minimum is +## returned as NaN rather than []. +## +## @seealso{min, nansum, nanmax, nanmean, nanmedian} +## @end deftypefn + +function [v, idx] = nanmin (X, Y, DIM) + if nargin < 1 || nargin > 3 + print_usage; + elseif nargin == 1 || (nargin == 2 && isempty(Y)) + nanvals = isnan(X); + X(nanvals) = Inf; + v = min (X); + v(all(nanvals)) = NaN; + elseif (nargin == 3 && isempty(Y)) + nanvals = isnan(X); + X(nanvals) = Inf; + v = min (X,[],DIM); + v(all(nanvals,DIM)) = NaN; + else + Xnan = isnan(X); + Ynan = isnan(Y); + X(Xnan) = Inf; + Y(Ynan) = Inf; + if (nargin == 3) + v = min(X,Y,DIM); + else + v = min(X,Y); + endif + v(Xnan & Ynan) = NaN; + endif +endfunction diff --git a/octave_packages/statistics-1.1.3/nanstd.m b/octave_packages/statistics-1.1.3/nanstd.m new file mode 100644 index 0000000..dc5f3e2 --- /dev/null +++ b/octave_packages/statistics-1.1.3/nanstd.m @@ -0,0 +1,86 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{v} =} nanstd (@var{X}) +## @deftypefnx{Function File} {@var{v} =} nanstd (@var{X}, @var{opt}) +## @deftypefnx{Function File} {@var{v} =} nanstd (@var{X}, @var{opt}, @var{dim}) +## Compute the standard deviation while ignoring NaN values. +## +## @code{nanstd} is identical to the @code{std} function except that NaN values are +## ignored. If all values are NaN, the standard deviation is returned as NaN. +## If there is only a single non-NaN value, the deviation is returned as 0. +## +## The argument @var{opt} determines the type of normalization to use. Valid values +## are +## +## @table @asis +## @item 0: +## normalizes with @math{N-1}, provides the square root of best unbiased estimator of +## the variance [default] +## @item 1: +## normalizes with @math{N}, this provides the square root of the second moment around +## the mean +## @end table +## +## The third argument @var{dim} determines the dimension along which the standard +## deviation is calculated. +## +## @seealso{std, nanmin, nanmax, nansum, nanmedian, nanmean} +## @end deftypefn + +function v = nanstd (X, opt, varargin) + if nargin < 1 + print_usage; + else + if nargin < 3 + dim = min(find(size(X)>1)); + if isempty(dim), dim=1; endif; + else + dim = varargin{1}; + endif + if ((nargin < 2) || isempty(opt)) + opt = 0; + endif + + ## determine the number of non-missing points in each data set + n = sum (!isnan(X), varargin{:}); + + ## replace missing data with zero and compute the mean + X(isnan(X)) = 0; + meanX = sum (X, varargin{:}) ./ n; + + ## subtract the mean from the data and compute the sum squared + sz = ones(1,length(size(X))); + sz(dim) = size(X,dim); + v = sumsq (X - repmat(meanX,sz), varargin{:}); + + ## because the missing data was set to zero each missing data + ## point will contribute (-meanX)^2 to sumsq, so remove these + v = v - (meanX .^ 2) .* (size(X,dim) - n); + + if (opt == 0) + ## compute the standard deviation from the corrected sumsq using + ## max(n-1,1) in the denominator so that the std for a single point is 0 + v = sqrt ( v ./ max(n - 1, 1) ); + elseif (opt == 1) + ## compute the standard deviation from the corrected sumsq + v = sqrt ( v ./ n ); + else + error ("std: unrecognized normalization type"); + endif + + endif +endfunction diff --git a/octave_packages/statistics-1.1.3/nansum.m b/octave_packages/statistics-1.1.3/nansum.m new file mode 100644 index 0000000..bb9075d --- /dev/null +++ b/octave_packages/statistics-1.1.3/nansum.m @@ -0,0 +1,35 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{v} =} nansum (@var{X}) +## @deftypefnx{Function File} {@var{v} =} nansum (@var{X}, @var{dim}) +## Compute the sum while ignoring NaN values. +## +## @code{nansum} is identical to the @code{sum} function except that NaN values are +## treated as 0 and so ignored. If all values are NaN, the sum is +## returned as 0. +## +## @seealso{sum, nanmin, nanmax, nanmean, nanmedian} +## @end deftypefn + +function v = nansum (X, varargin) + if nargin < 1 + print_usage; + else + X(isnan(X)) = 0; + v = sum (X, varargin{:}); + endif +endfunction diff --git a/octave_packages/statistics-1.1.3/nanvar.m b/octave_packages/statistics-1.1.3/nanvar.m new file mode 100644 index 0000000..e8e15aa --- /dev/null +++ b/octave_packages/statistics-1.1.3/nanvar.m @@ -0,0 +1,65 @@ +# Copyright (C) 2008 Sylvain Pelissier +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} nanvar (@var{x}) +## @deftypefnx{Function File} {@var{v} =} nanvar (@var{X}, @var{opt}) +## @deftypefnx{Function File} {@var{v} =} nanvar (@var{X}, @var{opt}, @var{dim}) +## Compute the variance while ignoring NaN values. +## +## For vector arguments, return the (real) variance of the values. +## For matrix arguments, return a row vector containing the variance for +## each column. +## +## The argument @var{opt} determines the type of normalization to use. +## Valid values are +## +## @table @asis +## @item 0: +## Normalizes 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 +## +## The third argument @var{dim} determines the dimension along which the +## variance is calculated. +## +## @seealso{var, nanmean, nanstd, nanmax, nanmin} +## @end deftypefn + +function y = nanvar(x,w,dim) + if nargin < 1 + print_usage (); + else + if ((nargin < 2) || isempty(w)) + w = 0; + endif + + if nargin < 3 + dim = min(find(size(x)>1)); + if isempty(dim) + dim=1; + endif + endif + + y = nanstd(x,w,dim).^2; + endif +endfunction + +## Tests +%!shared x +%! x = [1 2 nan 3 4 5]; +%!assert (nanvar (x), var (x(! isnan (x))), 10*eps) diff --git a/octave_packages/statistics-1.1.3/nbinstat.m b/octave_packages/statistics-1.1.3/nbinstat.m new file mode 100644 index 0000000..3908421 --- /dev/null +++ b/octave_packages/statistics-1.1.3/nbinstat.m @@ -0,0 +1,124 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} nbinstat (@var{n}, @var{p}) +## Compute mean and variance of the negative binomial distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{n} is the first parameter of the negative binomial distribution. The elements +## of @var{n} must be natural numbers +## +## @item +## @var{p} is the second parameter of the negative binomial distribution. The +## elements of @var{p} must be probabilities +## @end itemize +## @var{n} and @var{p} must be of common size or one of them must be scalar +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the negative binomial distribution +## +## @item +## @var{v} is the variance of the negative binomial distribution +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## n = 1:4; +## p = 0.2:0.2:0.8; +## [m, v] = nbinstat (n, p) +## @end group +## +## @group +## [m, v] = nbinstat (n, 0.5) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the negative binomial distribution + +function [m, v] = nbinstat (n, p) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! isempty (n) && ! ismatrix (n)) + error ("nbinstat: n must be a numeric matrix"); + endif + if (! isempty (p) && ! ismatrix (p)) + error ("nbinstat: p must be a numeric matrix"); + endif + + if (! isscalar (n) || ! isscalar (p)) + [retval, n, p] = common_size (n, p); + if (retval > 0) + error ("nbinstat: n and p must be of common size or scalar"); + endif + endif + + # Calculate moments + q = 1 - p; + m = n .* q ./ p; + v = n .* q ./ (p .^ 2); + + # Continue argument check + k = find (! (n > 0) | ! (n < Inf) | ! (p > 0) | ! (p < 1)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! n = 1:4; +%! p = 0.2:0.2:0.8; +%! [m, v] = nbinstat (n, p); +%! expected_m = [ 4.0000, 3.0000, 2.0000, 1.0000]; +%! expected_v = [20.0000, 7.5000, 3.3333, 1.2500]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); + +%!test +%! n = 1:4; +%! [m, v] = nbinstat (n, 0.5); +%! expected_m = [1, 2, 3, 4]; +%! expected_v = [2, 4, 6, 8]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/statistics-1.1.3/normalise_distribution.m b/octave_packages/statistics-1.1.3/normalise_distribution.m new file mode 100644 index 0000000..60a50c2 --- /dev/null +++ b/octave_packages/statistics-1.1.3/normalise_distribution.m @@ -0,0 +1,299 @@ +## Copyright (C) 2011 Alexander Klein +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn{Function File} {@var{NORMALISED} =} normalise_distribution (@var{DATA}) +## @deftypefnx{Function File} {@var{NORMALISED} =} normalise_distribution (@var{DATA}, @var{DISTRIBUTION}) +## @deftypefnx{Function File} {@var{NORMALISED} =} normalise_distribution (@var{DATA}, @var{DISTRIBUTION}, @var{DIMENSION}) +## +## Transform a set of data so as to be N(0,1) distributed according to an idea +## by van Albada and Robinson. +## This is achieved by first passing it through its own cumulative distribution +## function (CDF) in order to get a uniform distribution, and then mapping +## the uniform to a normal distribution. +## The data must be passed as a vector or matrix in @var{DATA}. +## If the CDF is unknown, then [] can be passed in @var{DISTRIBUTION}, and in +## this case the empirical CDF will be used. +## Otherwise, if the CDFs for all data are known, they can be passed in +## @var{DISTRIBUTION}, +## either in the form of a single function name as a string, +## or a single function handle, +## or a cell array consisting of either all function names as strings, +## or all function handles. +## In the latter case, the number of CDFs passed must match the number +## of rows, or columns respectively, to normalise. +## If the data are passed as a matrix, then the transformation will +## operate either along the first non-singleton dimension, +## or along @var{DIMENSION} if present. +## +## Notes: +## The empirical CDF will map any two sets of data +## having the same size and their ties in the same places after sorting +## to some permutation of the same normalised data: +## @example +## @code{normalise_distribution([1 2 2 3 4])} +## @result{} -1.28 0.00 0.00 0.52 1.28 +## +## @code{normalise_distribution([1 10 100 10 1000])} +## @result{} -1.28 0.00 0.52 0.00 1.28 +## @end example +## +## Original source: +## S.J. van Albada, P.A. Robinson +## "Transformation of arbitrary distributions to the +## normal distribution with application to EEG +## test-retest reliability" +## Journal of Neuroscience Methods, Volume 161, Issue 2, +## 15 April 2007, Pages 205-211 +## ISSN 0165-0270, 10.1016/j.jneumeth.2006.11.004. +## (http://www.sciencedirect.com/science/article/pii/S0165027006005668) +## @end deftypefn + +function [ normalised ] = normalise_distribution ( data, distribution, dimension ) + + if ( nargin < 1 || nargin > 3 ) + print_usage; + elseif ( !ismatrix ( data ) || length ( size ( data ) ) > 2 ) + error ( "First argument must be a vector or matrix" ); + end + + + if ( nargin >= 2 ) + + if ( !isempty ( distribution ) ) + + #Wrap a single handle in a cell array. + if ( strcmp ( typeinfo ( distribution ), typeinfo ( @(x)(x) ) ) ) + + distribution = { distribution }; + + #Do we have a string argument instead? + elseif ( ischar ( distribution ) ) + + ##Is it a single string? + if ( rows ( distribution ) == 1 ) + + distribution = { str2func( distribution ) }; + else + error ( ["Second argument cannot contain more than one string" ... + " unless in a cell array"] ); + end + + + ##Do we have a cell array of distributions instead? + elseif ( iscell ( distribution ) ) + + ##Does it consist of strings only? + if ( all ( cellfun ( @ischar, distribution ) ) ) + + distribution = cellfun ( @str2func, distribution, "UniformOutput", false ); + end + + ##Does it eventually consist of function handles only + if ( !all ( cellfun ( @ ( h ) ( strcmp ( typeinfo ( h ), typeinfo ( @(x)(x) ) ) ), distribution ) ) ) + + error ( ["Second argument must contain either" ... + " a single function name or handle or " ... + " a cell array of either all function names or handles!"] ); + end + + else + error ( "Illegal second argument: ", typeinfo ( distribution ) ); + end + + end + + else + + distribution = []; + end + + + if ( nargin == 3 ) + + if ( !isscalar ( dimension ) || ( dimension != 1 && dimension != 2 ) ) + error ( "Third argument must be either 1 or 2" ); + end + + else + if ( isvector ( data ) && rows ( data ) == 1 ) + + dimension = 2; + + else + + dimension = 1; + end + end + + trp = ( dimension == 2 ); + + if ( trp ) + data = data'; + end + + r = rows ( data ); + c = columns ( data ); + normalised = NA ( r, c ); + + ##Do we know the distribution of the sample? + if ( isempty ( distribution ) ) + + precomputed_normalisation = []; + + + for k = 1 : columns ( data ) + + ##Note that this line is in accordance with equation (16) in the + ##original text. The author's original program, however, produces + ##different values in the presence of ties, namely those you'd + ##get replacing "last" by "first". + [ uniq, indices ] = unique ( sort ( data ( :, k ) ), "last" ); + + + ##Does the sample have ties? + if ( rows ( uniq ) != r ) + + ##Transform to uniform, then normal distribution. + uniform = ( indices - 1/2 ) / r; + normal = norminv ( uniform ); + + else + ## Without ties everything is pretty much straightforward as + ## stated in the text. + if ( isempty ( precomputed_normalisation ) ) + + precomputed_normalisation = norminv ( 1 / (2*r) : 1/r : 1 - 1 / (2*r) ); + end + + normal = precomputed_normalisation; + end + + #Find the original indices in the unsorted sample. + #This somewhat quirky way of doing it is still faster than + #using a for-loop. + [ ignore, ignore, target_indices ] = unique ( data (:, k ) ); + + #Put normalised values in the places where they belong. + + ## A regression in the 3.4 series made this no longer work so we behave + ## differently depending on octave version. This applies the fix for all + ## 3.4 releases but it may have appeared on 3.2.4 (can someone check?) + ## See https://savannah.gnu.org/bugs/index.php?34765 + ## FIXME Once package dependency increases beyond an octave version that + ## has this fixed, remove this + if (compare_versions (OCTAVE_VERSION, "3.4", "<") || compare_versions (OCTAVE_VERSION, "3.6.2", ">=")) + ## this is how it should work + f_remap = @( k ) ( normal ( k ) ); + normalised ( :, k ) = arrayfun ( f_remap, target_indices ); + else + ## this is the workaround because of bug in 3.4.?? + for index = 1:numel(target_indices) + normalised ( index, k ) = normal(target_indices(index)); + endfor + endif + + end + + else + ##With known distributions, everything boils down to a few lines of code + + ##The same distribution for all data? + if ( all ( size ( distribution ) == 1 ) ) + + normalised = norminv ( distribution {1,1} ( data ) ); + + elseif ( length ( vec ( distribution ) ) == c ) + + for k = 1 : c + + normalised ( :, k ) = norminv ( distribution { k } ( data ) ( :, k ) ); + end + + else + error ( "Number of distributions does not match data size! ") + + end + end + + if ( trp ) + + normalised = normalised'; + end + +endfunction + +%!test +%! v = normalise_distribution ( [ 1 2 3 ], [], 1 ); +%! assert ( v, [ 0 0 0 ] ) + +%!test +%! v = normalise_distribution ( [ 1 2 3 ], [], 2 ); +%! assert ( v, norminv ( [ 1 3 5 ] / 6 ), 3 * eps ) + +%!test +%! v = normalise_distribution ( [ 1 2 3 ]', [], 2 ); +%! assert ( v, [ 0 0 0 ]' ) + +%!test +%! v = normalise_distribution ( [ 1 2 3 ]' , [], 1 ); +%! assert ( v, norminv ( [ 1 3 5 ]' / 6 ), 3 * eps ) + +%!test +%! v = normalise_distribution ( [ 1 1 2 2 3 3 ], [], 2 ); +%! assert ( v, norminv ( [ 3 3 7 7 11 11 ] / 12 ), 3 * eps ) + +%!test +%! v = normalise_distribution ( [ 1 1 2 2 3 3 ]', [], 1 ); +%! assert ( v, norminv ( [ 3 3 7 7 11 11 ]' / 12 ), 3 * eps ) + +%!test +%! A = randn ( 10 ); +%! N = normalise_distribution ( A, @normcdf ); +%! assert ( A, N, 1000 * eps ) + +%!xtest +%! A = exprnd ( 1, 100 ); +%! N = normalise_distribution ( A, @ ( x ) ( expcdf ( x, 1 ) ) ); +%! assert ( mean ( vec ( N ) ), 0, 0.1 ) +%! assert ( std ( vec ( N ) ), 1, 0.1 ) + +%!xtest +%! A = rand (1000,1); +%! N = normalise_distribution ( A, "unifcdf" ); +%! assert ( mean ( vec ( N ) ), 0, 0.1 ) +%! assert ( std ( vec ( N ) ), 1, 0.1 ) + +%!xtest +%! A = [rand(1000,1), randn( 1000, 1)]; +%! N = normalise_distribution ( A, { "unifcdf", "normcdf" } ); +%! assert ( mean ( N ), [ 0, 0 ], 0.1 ) +%! assert ( std ( N ), [ 1, 1 ], 0.1 ) + +%!xtest +%! A = [rand(1000,1), randn( 1000, 1), exprnd( 1, 1000, 1 )]'; +%! N = normalise_distribution ( A, { @unifcdf; @normcdf; @( x )( expcdf ( x, 1 ) ) }, 2 ); +%! assert ( mean ( N, 2 ), [ 0, 0, 0 ]', 0.1 ) +%! assert ( std ( N, [], 2 ), [ 1, 1, 1 ]', 0.1 ) + +%!xtest +%! A = exprnd ( 1, 1000, 9 ); A ( 300 : 500, 4:6 ) = 17; +%! N = normalise_distribution ( A ); +%! assert ( mean ( N ), [ 0 0 0 0.38 0.38 0.38 0 0 0 ], 0.1 ); +%! assert ( var ( N ), [ 1 1 1 2.59 2.59 2.59 1 1 1 ], 0.1 ); + +%!test +%! fail ("normalise_distribution( zeros ( 3, 4 ), { @unifcdf; @normcdf; @( x )( expcdf ( x, 1 ) ) } )", ... +%! "Number of distributions does not match data size!"); diff --git a/octave_packages/statistics-1.1.3/normplot.m b/octave_packages/statistics-1.1.3/normplot.m new file mode 100644 index 0000000..9dbfde7 --- /dev/null +++ b/octave_packages/statistics-1.1.3/normplot.m @@ -0,0 +1,75 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} normplot (@var{X}) +## +## Produce a normal probability plot for each column of @var{X}. +## +## The line joing the 1st and 3rd quantile is drawn on the +## graph. If the underlying distribution is normal, the +## points will cluster around this line. +## +## Note that this function sets the title, xlabel, ylabel, +## axis, grid, tics and hold properties of the graph. These +## need to be cleared before subsequent graphs using 'clf'. +## @end deftypefn + +function normplot(X) + if nargin!=1, print_usage; end + if (rows(X) == 1), X=X(:); end + + # plot labels + title "Normal Probability Plot" + ylabel "% Probability" + xlabel "Data" + + # plot grid + t = [0.00001;0.0001;0.001;0.01;0.1;0.3;1;2;5;10;25;50; + 75;90;95;98;99;99.7;99.9;99.99;99.999;99.9999;99.99999]; + tics ('y',normal_inv(t/100),num2str(t)); + grid on + + # Transform data + n = rows(X); + if n<2, error("normplot requires a vector"); end + q = normal_inv([1:n]'/(n+1)); + Y = sort(X); + + # Set view range with a bit of space around data + miny = min(Y(:)); minq = min(q(1),normal_inv(0.05)); + maxy = max(Y(:)); maxq = max(q(end),normal_inv(0.95)); + yspace = (maxy-miny)*0.05; qspace = (q(end)-q(1))*0.05; + axis ([miny-yspace, maxy+yspace, minq-qspace, maxq+qspace]); + + # Find the line joining the first to the third quartile for each column + q1 = ceil(n/4); + q3 = n-q1+1; + m = (q(q3)-q(q1))./(Y(q3,:)-Y(q1,:)); + p = [ m; q(q1)-m.*Y(q1,:) ]; + + # Plot the lines one at a time. Plot the lines before overlaying the + # normals so that the default label is 'line n'. + if columns(Y)==1, + leg = "+;;"; + else + leg = "%d+;Column %d;"; + endif + + for i=1:columns(Y) + plot(Y(:,i),q,sprintf(leg,i,i)); hold on; + + # estimate the mean and standard deviation by linear regression + # [v,dv] = wpolyfit(q,Y(:,i),1) + end + + # Overlay the estimated normal lines. + for i=1:columns(Y) + # Use the end points and one point guaranteed to be in the view since + # gnuplot skips any lines whose points are all outside the view. + pts = [Y(1,i);Y(q1,i);Y(end,i)]; + plot(pts, polyval(p(:,i),pts), [num2str(i),";;"]); + end + hold off; +end + diff --git a/octave_packages/statistics-1.1.3/normstat.m b/octave_packages/statistics-1.1.3/normstat.m new file mode 100644 index 0000000..3e590fe --- /dev/null +++ b/octave_packages/statistics-1.1.3/normstat.m @@ -0,0 +1,122 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{mn}, @var{v}] =} normstat (@var{m}, @var{s}) +## Compute mean and variance of the normal distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{m} is the mean of the normal distribution +## +## @item +## @var{s} is the standard deviation of the normal distribution. +## @var{s} must be positive +## @end itemize +## @var{m} and @var{s} must be of common size or one of them must be +## scalar +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{mn} is the mean of the normal distribution +## +## @item +## @var{v} is the variance of the normal distribution +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## m = 1:6; +## s = 0:0.2:1; +## [mn, v] = normstat (m, s) +## @end group +## +## @group +## [mn, v] = normstat (0, s) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the normal distribution + +function [mn, v] = normstat (m, s) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! isempty (m) && ! ismatrix (m)) + error ("normstat: m must be a numeric matrix"); + endif + if (! isempty (s) && ! ismatrix (s)) + error ("normstat: s must be a numeric matrix"); + endif + + if (! isscalar (m) || ! isscalar (s)) + [retval, m, s] = common_size (m, s); + if (retval > 0) + error ("normstat: m and s must be of common size or scalar"); + endif + endif + + # Set moments + mn = m; + v = s .* s; + + # Continue argument check + k = find (! (s > 0) | ! (s < Inf)); + if (any (k)) + mn(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! m = 1:6; +%! s = 0.2:0.2:1.2; +%! [mn, v] = normstat (m, s); +%! expected_v = [0.0400, 0.1600, 0.3600, 0.6400, 1.0000, 1.4400]; +%! assert (mn, m); +%! assert (v, expected_v, 0.001); + +%!test +%! s = 0.2:0.2:1.2; +%! [mn, v] = normstat (0, s); +%! expected_mn = [0, 0, 0, 0, 0, 0]; +%! expected_v = [0.0400, 0.1600, 0.3600, 0.6400, 1.0000, 1.4400]; +%! assert (mn, expected_mn, 0.001); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/statistics-1.1.3/packinfo/.autoload b/octave_packages/statistics-1.1.3/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/statistics-1.1.3/packinfo/DESCRIPTION b/octave_packages/statistics-1.1.3/packinfo/DESCRIPTION new file mode 100644 index 0000000..940c2db --- /dev/null +++ b/octave_packages/statistics-1.1.3/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: Statistics +Version: 1.1.3 +Date: 2012-05-09 +Author: various authors +Maintainer: Arno Onken +Title: Statistics +Description: Additional statistics functions for Octave. +Categories: Statistics +Depends: octave (>= 2.9.7), io (>= 1.0.18) +Autoload: yes +License: GPLv3+, public domain +Url: http://octave.sf.net diff --git a/octave_packages/statistics-1.1.3/packinfo/INDEX b/octave_packages/statistics-1.1.3/packinfo/INDEX new file mode 100644 index 0000000..3ad09bc --- /dev/null +++ b/octave_packages/statistics-1.1.3/packinfo/INDEX @@ -0,0 +1,74 @@ +statistics >> Statistics +Distributions + anderson_darling_cdf + betastat + binostat + chi2stat + cl_multinom + copulacdf copulapdf copularnd + expstat + fstat + gamlike + gamstat + geostat + hygestat + jsucdf + jsupdf + lognstat + mvnpdf mvnrnd mvncdf + mnpdf mnrnd + mvtcdf mvtrnd + nbinstat + normalise_distribution + normstat + poisstat + random + raylcdf raylinv raylpdf raylrnd raylstat + tstat + unidstat + unifstat + vmpdf vmrnd + wblstat +Descriptive statistics + nansum + nanmax + nanmean + nanmedian + nanmin + nanstd + nanvar + geomean + harmmean + mad + trimmean + tabulate + combnk + jackknife +Experimental design + fullfact ff2n +Regression + anovan + monotone_smooth + princomp + regress +Plots + boxplot + normplot + histfit + repanova +Models + hmmestimate hmmgenerate hmmviterbi +Hypothesis testing + anderson_darling_test +Fitting + gamfit +Clustering + kmeans + linkage + pdist + squareform +Reading and Writing + caseread + casewrite + tblread + tblwrite diff --git a/octave_packages/statistics-1.1.3/packinfo/NEWS b/octave_packages/statistics-1.1.3/packinfo/NEWS new file mode 100644 index 0000000..f1541d8 --- /dev/null +++ b/octave_packages/statistics-1.1.3/packinfo/NEWS @@ -0,0 +1,77 @@ +Summary of important user-visible changes for statistics 1.1.3: +------------------------------------------------------------------- + + ** The following functions are new in 1.1.3: + + copularnd mvtrnd + + ** The functions mnpdf and mnrnd are now also usable for greater numbers + of categories for which the rows do not exactly sum to 1. + +Summary of important user-visible changes for statistics 1.1.2: +------------------------------------------------------------------- + + ** The following functions are new in 1.1.2: + + mnpdf mnrnd + + ** The package is now dependent on the io package (version 1.0.18 or + later) since the functions that it depended of from miscellaneous + package have been moved to io. + + ** The function `kmeans' now accepts the 'emptyaction' property with + the 'singleton' value. This allows for the kmeans algorithm to handle + empty cluster better. It also throws an error if the user does not + request an empty cluster handling, and there is an empty cluster. + Plus, the returned items are now a closer match to Matlab. + +Summary of important user-visible changes for statistics 1.1.1: +------------------------------------------------------------------- + + ** The following functions are new in 1.1.1: + + monotone_smooth kmeans jackknife + + ** Bug fixes on the functions: + + normalise_distribution combnk + repanova + + ** The following functions were removed since equivalents are now + part of GNU octave core: + + zscore + + ** boxplot.m now returns a structure with handles to the plot elemenets. + +Summary of important user-visible changes for statistics 1.1.0: +------------------------------------------------------------------- + + ** IMPORTANT note about `fstat' shadowing core library function: + + GNU octave's 3.2 release added a new function `fstat' to return + information of a file. Statistics' `fstat' computes F mean and + variance. Since MatLab's `fstat' is the equivalent to statistics' + `fstat' (not to core's `fstat'), and to avoid problems with the + statistics package, `fstat' has been deprecated in octave 3.4 + and will be removed in Octave 3.8. In the mean time, please + ignore this warning when installing the package. + + ** The following functions are new in 1.1.0: + + normalise_distribution repanova combnk + + ** The following functions were removed since equivalents are now + part of GNU octave core: + + prctile + + ** The __tbl_delim__ function is now private. + + ** The function `boxplot' now accepts named arguments. + + ** Bug fixes on the functions: + + harmmean nanmax nanmin regress + + ** Small improvements on help text. diff --git a/octave_packages/statistics-1.1.3/pdist.m b/octave_packages/statistics-1.1.3/pdist.m new file mode 100644 index 0000000..b53daf8 --- /dev/null +++ b/octave_packages/statistics-1.1.3/pdist.m @@ -0,0 +1,233 @@ +## Copyright (C) 2008 Francesco Potortì +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} pdist (@var{x}) +## @deftypefnx {Function File} {@var{y} =} pdist (@var{x}, @var{metric}) +## @deftypefnx {Function File} {@var{y} =} pdist (@var{x}, @var{metric}, @var{metricarg}, @dots{}) +## +## Return the distance between any two rows in @var{x}. +## +## @var{x} is the @var{n}x@var{d} matrix representing @var{q} row +## vectors of size @var{d}. +## +## The output is a dissimilarity matrix formatted as a row vector +## @var{y}, @math{(n-1)*n/2} long, where the distances are in +## the order [(1, 2) (1, 3) @dots{} (2, 3) @dots{} (n-1, n)]. You can +## use the @code{squareform} function to display the distances between +## the vectors arranged into an @var{n}x@var{n} matrix. +## +## @code{metric} is an optional argument specifying how the distance is +## computed. It can be any of the following ones, defaulting to +## "euclidean", or a user defined function that takes two arguments +## @var{x} and @var{y} plus any number of optional arguments, +## where @var{x} is a row vector and and @var{y} is a matrix having the +## same number of columns as @var{x}. @code{metric} returns a column +## vector where row @var{i} is the distance between @var{x} and row +## @var{i} of @var{y}. Any additional arguments after the @code{metric} +## are passed as metric (@var{x}, @var{y}, @var{metricarg1}, +## @var{metricarg2} @dots{}). +## +## Predefined distance functions are: +## +## @table @samp +## @item "euclidean" +## Euclidean distance (default). +## +## @item "seuclidean" +## Standardized Euclidean distance. Each coordinate in the sum of +## squares is inverse weighted by the sample variance of that +## coordinate. +## +## @item "mahalanobis" +## Mahalanobis distance: see the function mahalanobis. +## +## @item "cityblock" +## City Block metric, aka Manhattan distance. +## +## @item "minkowski" +## Minkowski metric. Accepts a numeric parameter @var{p}: for @var{p}=1 +## this is the same as the cityblock metric, with @var{p}=2 (default) it +## is equal to the euclidean metric. +## +## @item "cosine" +## One minus the cosine of the included angle between rows, seen as +## vectors. +## +## @item "correlation" +## One minus the sample correlation between points (treated as +## sequences of values). +## +## @item "spearman" +## One minus the sample Spearman's rank correlation between +## observations, treated as sequences of values. +## +## @item "hamming" +## Hamming distance: the quote of the number of coordinates that differ. +## +## @item "jaccard" +## One minus the Jaccard coefficient, the quote of nonzero +## coordinates that differ. +## +## @item "chebychev" +## Chebychev distance: the maximum coordinate difference. +## @end table +## @seealso{linkage, mahalanobis, squareform} +## @end deftypefn + +## Author: Francesco Potortì + +function y = pdist (x, metric, varargin) + + if (nargin < 1) + print_usage (); + elseif ((nargin > 1) + && ! ischar (metric) + && ! isa (metric, "function_handle")) + error (["pdist: the distance function must be either a string or a " + "function handle."]); + endif + + if (nargin < 2) + metric = "euclidean"; + endif + + if (! ismatrix (x) || isempty (x)) + error ("pdist: x must be a nonempty matrix"); + elseif (length (size (x)) > 2) + error ("pdist: x must be 1 or 2 dimensional"); + endif + + y = []; + if (rows(x) == 1) + return; + endif + + if (ischar (metric)) + order = nchoosek(1:rows(x),2); + Xi = order(:,1); + Yi = order(:,2); + X = x'; + metric = lower (metric); + switch (metric) + case "euclidean" + d = X(:,Xi) - X(:,Yi); + if (str2num(version()(1:3)) > 3.1) + y = norm (d, "cols"); + else + y = sqrt (sumsq (d, 1)); + endif + + case "seuclidean" + d = X(:,Xi) - X(:,Yi); + weights = inv (diag (var (x, 0, 1))); + y = sqrt (sum ((weights * d) .* d, 1)); + + case "mahalanobis" + d = X(:,Xi) - X(:,Yi); + weights = inv (cov (x)); + y = sqrt (sum ((weights * d) .* d, 1)); + + case "cityblock" + d = X(:,Xi) - X(:,Yi); + if (str2num(version()(1:3)) > 3.1) + y = norm (d, 1, "cols"); + else + y = sum (abs (d), 1); + endif + + case "minkowski" + d = X(:,Xi) - X(:,Yi); + p = 2; # default + if (nargin > 2) + p = varargin{1}; # explicitly assigned + endif; + if (str2num(version()(1:3)) > 3.1) + y = norm (d, p, "cols"); + else + y = (sum ((abs (d)).^p, 1)).^(1/p); + endif + + case "cosine" + prod = X(:,Xi) .* X(:,Yi); + weights = sumsq (X(:,Xi), 1) .* sumsq (X(:,Yi), 1); + y = 1 - sum (prod, 1) ./ sqrt (weights); + + case "correlation" + if (rows(X) == 1) + error ("pdist: correlation distance between scalars not defined") + endif + corr = cor (X); + y = 1 - corr (sub2ind (size (corr), Xi, Yi))'; + + case "spearman" + if (rows(X) == 1) + error ("pdist: spearman distance between scalars not defined") + endif + corr = spearman (X); + y = 1 - corr (sub2ind (size (corr), Xi, Yi))'; + + case "hamming" + d = logical (X(:,Xi) - X(:,Yi)); + y = sum (d, 1) / rows (X); + + case "jaccard" + d = logical (X(:,Xi) - X(:,Yi)); + weights = X(:,Xi) | X(:,Yi); + y = sum (d & weights, 1) ./ sum (weights, 1); + + case "chebychev" + d = X(:,Xi) - X(:,Yi); + if (str2num(version()(1:3)) > 3.1) + y = norm (d, Inf, "cols"); + else + y = max (abs (d), [], 1); + endif + + endswitch + endif + + if (isempty (y)) + ## Metric is a function handle or the name of an external function + l = rows (x); + y = zeros (1, nchoosek (l, 2)); + idx = 1; + for ii = 1:l-1 + for jj = ii+1:l + y(idx++) = feval (metric, x(ii,:), x, varargin{:})(jj); + endfor + endfor + endif + +endfunction + +%!shared xy, t, eucl +%! xy = [0 1; 0 2; 7 6; 5 6]; +%! t = 1e-3; +%! eucl = @(v,m) sqrt(sumsq(repmat(v,rows(m),1)-m,2)); +%!assert(pdist(xy), [1.000 8.602 7.071 8.062 6.403 2.000],t); +%!assert(pdist(xy,eucl), [1.000 8.602 7.071 8.062 6.403 2.000],t); +%!assert(pdist(xy,"euclidean"), [1.000 8.602 7.071 8.062 6.403 2.000],t); +%!assert(pdist(xy,"seuclidean"), [0.380 2.735 2.363 2.486 2.070 0.561],t); +%!assert(pdist(xy,"mahalanobis"),[1.384 1.967 2.446 2.384 1.535 2.045],t); +%!assert(pdist(xy,"cityblock"), [1.000 12.00 10.00 11.00 9.000 2.000],t); +%!assert(pdist(xy,"minkowski"), [1.000 8.602 7.071 8.062 6.403 2.000],t); +%!assert(pdist(xy,"minkowski",3),[1.000 7.763 6.299 7.410 5.738 2.000],t); +%!assert(pdist(xy,"cosine"), [0.000 0.349 0.231 0.349 0.231 0.013],t); +%!assert(pdist(xy,"correlation"),[0.000 2.000 0.000 2.000 0.000 2.000],t); +%!assert(pdist(xy,"spearman"), [0.000 2.000 0.000 2.000 0.000 2.000],t); +%!assert(pdist(xy,"hamming"), [0.500 1.000 1.000 1.000 1.000 0.500],t); +%!assert(pdist(xy,"jaccard"), [1.000 1.000 1.000 1.000 1.000 0.500],t); +%!assert(pdist(xy,"chebychev"), [1.000 7.000 5.000 7.000 5.000 2.000],t); diff --git a/octave_packages/statistics-1.1.3/poisstat.m b/octave_packages/statistics-1.1.3/poisstat.m new file mode 100644 index 0000000..707e405 --- /dev/null +++ b/octave_packages/statistics-1.1.3/poisstat.m @@ -0,0 +1,92 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} poisstat (@var{lambda}) +## Compute mean and variance of the Poisson distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{lambda} is the parameter of the Poisson distribution. The +## elements of @var{lambda} must be positive +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the Poisson distribution +## +## @item +## @var{v} is the variance of the Poisson distribution +## @end itemize +## +## @subheading Example +## +## @example +## @group +## lambda = 1 ./ (1:6); +## [m, v] = poisstat (lambda) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the Poisson distribution + +function [m, v] = poisstat (lambda) + + # Check arguments + if (nargin != 1) + print_usage (); + endif + + if (! isempty (lambda) && ! ismatrix (lambda)) + error ("poisstat: lambda must be a numeric matrix"); + endif + + # Set moments + m = lambda; + v = lambda; + + # Continue argument check + k = find (! (lambda > 0) | ! (lambda < Inf)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! lambda = 1 ./ (1:6); +%! [m, v] = poisstat (lambda); +%! assert (m, lambda); +%! assert (v, lambda); diff --git a/octave_packages/statistics-1.1.3/princomp.m b/octave_packages/statistics-1.1.3/princomp.m new file mode 100644 index 0000000..1542d0b --- /dev/null +++ b/octave_packages/statistics-1.1.3/princomp.m @@ -0,0 +1,51 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pc}, @var{z}, @var{w}, @var{Tsq}] =} princomp (@var{X}) +## +## Compute principal components of @var{X}. +## +## The first output argument @var{pc} is the principal components of @var{X}. +## The second @var{z} is the transformed data, and @var{w} is the eigenvalues of +## the covariance matrix of @var{X}. @var{Tsq} is the Hotelling's @math{T^2} +## statistic for the transformed data. +## @end deftypefn + +function [pc,z,w,Tsq] = princomp(X) + C = cov(X); + [U,D,pc] = svd(C,1); + if nargout>1, z = center(X)*pc; end + if nargout>2, w = diag(D); end + if nargout>3, Tsq = sumsq(zscore(z),2); + warning('XXX FIXME XXX Tsq return from princomp fails some tests'); + end +endfunction +%!shared pc,z,w,Tsq,m,x + +%!test +%! x=[1,2,3;2,1,3]'; +%! [pc,z,w,Tsq]=princomp(x); +%! m=[sqrt(2),sqrt(2);sqrt(2),-sqrt(2);-2*sqrt(2),0]/2; +%! m(:,1) = m(:,1)*sign(pc(1,1)); +%! m(:,2) = m(:,2)*sign(pc(1,2)); + +%!assert(pc,m(1:2,:),10*eps); +%!assert(z,-m,10*eps); +%!assert(w,[1.5;.5],10*eps); +%!assert(Tsq,[4;4;4]/3,10*eps); + +%!test +%! x=x'; +%! [pc,z,w,Tsq]=princomp(x); +%! m=[sqrt(2),sqrt(2),0;-sqrt(2),sqrt(2),0;0,0,2]/2; +%! m(:,1) = m(:,1)*sign(pc(1,1)); +%! m(:,2) = m(:,2)*sign(pc(1,2)); +%! m(:,3) = m(:,3)*sign(pc(3,3)); + +%!assert(pc,m,10*eps); +%!assert(z(:,1),-m(1:2,1),10*eps); +%!assert(z(:,2:3),zeros(2),10*eps); +%!assert(w,[1;0;0],10*eps); +%!xtest +%! assert(Tsq,1,10*eps); diff --git a/octave_packages/statistics-1.1.3/private/tbl_delim.m b/octave_packages/statistics-1.1.3/private/tbl_delim.m new file mode 100644 index 0000000..ce77a92 --- /dev/null +++ b/octave_packages/statistics-1.1.3/private/tbl_delim.m @@ -0,0 +1,126 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{d}, @var{err}] = } tbl_delim (@var{d}) +## Return the delimiter for tblread or tblwrite. +## +## The delimeter, @var{d} may be any single character or +## @itemize +## @item "space" " " (default) +## @item "tab" "\t" +## @item "comma" "," +## @item "semi" ";" +## @item "bar" "|" +## @end itemize +## +## @var{err} will be empty if there is no error, and @var{d} will be NaN +## if there is an error. You MUST check the value of @var{err}. +## @seealso{tblread, tblwrite} +## @end deftypefn + +function [d, err] = tbl_delim (d) + + ## Check arguments + if nargin != 1 + print_usage (); + endif + + err = ""; + ## Format the delimiter + if ischar (d) + ## allow for escape characters + d = sprintf (d); + if numel (d) > 1 + ## allow the word forms + s.space = " "; + s.tab = "\t"; + s.comma = ","; + s.semi = ";"; + s.bar = "|"; + if ! ismember (d, fieldnames (s)) + err = ["tblread: delimiter must be either a single " ... + "character or one of\n" ... + sprintf("%s, ", fieldnames (s){:})(1:end-2)]; + d = NaN; + else + d = s.(d); + endif + endif + else + err = "delimiter must be a character"; + d = NaN; + endif + if isempty (d) + err = "the delimiter may not be empty"; + d = NaN; + endif + +endfunction + +## Tests +## The defaults +%!test +%! [d err] = tbl_delim (" "); +%! assert (d, " "); +%! assert (err, ""); +## Named delimiters +%!test +%! [d err] = tbl_delim ("space"); +%! assert (d, " "); +%! assert (err, ""); +%!test +%! [d err] = tbl_delim ("tab"); +%! assert (d, sprintf ("\t")); +%! assert (err, ""); +%!test +%! [d err] = tbl_delim ("comma"); +%! assert (d, ","); +%! assert (err, ""); +%!test +%! [d err] = tbl_delim ("semi"); +%! assert (d, ";"); +%! assert (err, ""); +%!test +%! [d err] = tbl_delim ("bar"); +%! assert (d, "|"); +%! assert (err, ""); +## An arbitrary character +%!test +%! [d err] = tbl_delim ("x"); +%! assert (d, "x"); +%! assert (err, ""); +## An arbitrary escape string +%!test +%! [d err] = tbl_delim ('\r'); +%! assert (d, sprintf ('\r')) +%! assert (err, ""); +## Errors +%!test +%! [d err] = tbl_delim ("bars"); +%! assert (isnan (d)); +%! assert (! isempty (err)); +%!test +%! [d err] = tbl_delim (""); +%! assert (isnan (d)); +%! assert (! isempty (err)); +%!test +%! [d err] = tbl_delim (5); +%! assert (isnan (d)); +%! assert (! isempty (err)); +%!test +%! [d err] = tbl_delim ({"."}); +%! assert (isnan (d)); +%! assert (! isempty (err)); diff --git a/octave_packages/statistics-1.1.3/random.m b/octave_packages/statistics-1.1.3/random.m new file mode 100644 index 0000000..14074f8 --- /dev/null +++ b/octave_packages/statistics-1.1.3/random.m @@ -0,0 +1,171 @@ +## Copyright (C) 2007 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{r} = random(@var{name}, @var{arg1}) +## @deftypefnx{Function File} @var{r} = random(@var{name}, @var{arg1}, @var{arg2}) +## @deftypefnx{Function File} @var{r} = random(@var{name}, @var{arg1}, @var{arg2}, @var{arg3}) +## @deftypefnx{Function File} @var{r} = random(@var{name}, ..., @var{s1}, ...) +## Generates pseudo-random numbers from a given one-, two-, or three-parameter +## distribution. +## +## The variable @var{name} must be a string that names the distribution from +## which to sample. If this distribution is a one-parameter distribution @var{arg1} +## should be supplied, if it is a two-paramter distribution @var{arg2} must also +## be supplied, and if it is a three-parameter distribution @var{arg3} must also +## be present. Any arguments following the distribution paramters will determine +## the size of the result. +## +## As an example, the following code generates a 10 by 20 matrix containing +## random numbers from a normal distribution with mean 5 and standard deviation +## 2. +## @example +## R = random("normal", 5, 2, [10, 20]); +## @end example +## +## The variable @var{name} can be one of the following strings +## +## @table @asis +## @item "beta" +## @itemx "beta distribution" +## Samples are drawn from the Beta distribution. +## @item "bino" +## @itemx "binomial" +## @itemx "binomial distribution" +## Samples are drawn from the Binomial distribution. +## @item "chi2" +## @itemx "chi-square" +## @itemx "chi-square distribution" +## Samples are drawn from the Chi-Square distribution. +## @item "exp" +## @itemx "exponential" +## @itemx "exponential distribution" +## Samples are drawn from the Exponential distribution. +## @item "f" +## @itemx "f distribution" +## Samples are drawn from the F distribution. +## @item "gam" +## @itemx "gamma" +## @itemx "gamma distribution" +## Samples are drawn from the Gamma distribution. +## @item "geo" +## @itemx "geometric" +## @itemx "geometric distribution" +## Samples are drawn from the Geometric distribution. +## @item "hyge" +## @itemx "hypergeometric" +## @itemx "hypergeometric distribution" +## Samples are drawn from the Hypergeometric distribution. +## @item "logn" +## @itemx "lognormal" +## @itemx "lognormal distribution" +## Samples are drawn from the Log-Normal distribution. +## @item "nbin" +## @itemx "negative binomial" +## @itemx "negative binomial distribution" +## Samples are drawn from the Negative Binomial distribution. +## @item "norm" +## @itemx "normal" +## @itemx "normal distribution" +## Samples are drawn from the Normal distribution. +## @item "poiss" +## @itemx "poisson" +## @itemx "poisson distribution" +## Samples are drawn from the Poisson distribution. +## @item "rayl" +## @itemx "rayleigh" +## @itemx "rayleigh distribution" +## Samples are drawn from the Rayleigh distribution. +## @item "t" +## @itemx "t distribution" +## Samples are drawn from the T distribution. +## @item "unif" +## @itemx "uniform" +## @itemx "uniform distribution" +## Samples are drawn from the Uniform distribution. +## @item "unid" +## @itemx "discrete uniform" +## @itemx "discrete uniform distribution" +## Samples are drawn from the Uniform Discrete distribution. +## @item "wbl" +## @itemx "weibull" +## @itemx "weibull distribution" +## Samples are drawn from the Weibull distribution. +## @end table +## @seealso{rand, betarnd, binornd, chi2rnd, exprnd, frnd, gamrnd, geornd, hygernd, +## lognrnd, nbinrnd, normrnd, poissrnd, raylrnd, trnd, unifrnd, unidrnd, wblrnd} +## @end deftypefn + +function retval = random(name, varargin) + ## General input checking + if (nargin < 2) + print_usage(); + endif + if (!ischar(name)) + error("random: first input argument must be a string"); + endif + + ## Select distribution + switch (lower(name)) + case {"beta", "beta distribution"} + retval = betarnd(varargin{:}); + case {"bino", "binomial", "binomial distribution"} + retval = binornd(varargin{:}); + case {"chi2", "chi-square", "chi-square distribution"} + retval = chi2rnd(varargin{:}); + case {"exp", "exponential", "exponential distribution"} + retval = exprnd(varargin{:}); + case {"ev", "extreme value", "extreme value distribution"} + error("random: distribution type '%s' is not yet implemented", name); + case {"f", "f distribution"} + retval = frnd(varargin{:}); + case {"gam", "gamma", "gamma distribution"} + retval = gamrnd(varargin{:}); + case {"gev", "generalized extreme value", "generalized extreme value distribution"} + error("random: distribution type '%s' is not yet implemented", name); + case {"gp", "generalized pareto", "generalized pareto distribution"} + error("random: distribution type '%s' is not yet implemented", name); + case {"geo", "geometric", "geometric distribution"} + retval = geornd(varargin{:}); + case {"hyge", "hypergeometric", "hypergeometric distribution"} + retval = hygernd(varargin{:}); + case {"logn", "lognormal", "lognormal distribution"} + retval = lognrnd(varargin{:}); + case {"nbin", "negative binomial", "negative binomial distribution"} + retval = nbinrnd(varargin{:}); + case {"ncf", "noncentral f", "noncentral f distribution"} + error("random: distribution type '%s' is not yet implemented", name); + case {"nct", "noncentral t", "noncentral t distribution"} + error("random: distribution type '%s' is not yet implemented", name); + case {"ncx2", "noncentral chi-square", "noncentral chi-square distribution"} + error("random: distribution type '%s' is not yet implemented", name); + case {"norm", "normal", "normal distribution"} + retval = normrnd(varargin{:}); + case {"poiss", "poisson", "poisson distribution"} + retval = poissrnd(varargin{:}); + case {"rayl", "rayleigh", "rayleigh distribution"} + retval = raylrnd(varargin{:}); + case {"t", "t distribution"} + retval = trnd(varargin{:}); + case {"unif", "uniform", "uniform distribution"} + retval = unifrnd(varargin{:}); + case {"unid", "discrete uniform", "discrete uniform distribution"} + retval = unidrnd(varargin{:}); + case {"wbl", "weibull", "weibull distribution"} + retval = wblrnd(varargin{:}); + otherwise + error("random: unsupported distribution type '%s'", name); + endswitch +endfunction diff --git a/octave_packages/statistics-1.1.3/raylcdf.m b/octave_packages/statistics-1.1.3/raylcdf.m new file mode 100644 index 0000000..8e57d1f --- /dev/null +++ b/octave_packages/statistics-1.1.3/raylcdf.m @@ -0,0 +1,117 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{p} =} raylcdf (@var{x}, @var{sigma}) +## Compute the cumulative distribution function of the Rayleigh +## distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{x} is the support. The elements of @var{x} must be non-negative. +## +## @item +## @var{sigma} is the parameter of the Rayleigh distribution. The elements +## of @var{sigma} must be positive. +## @end itemize +## @var{x} and @var{sigma} must be of common size or one of them must be +## scalar. +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{p} is the cumulative distribution of the Rayleigh distribution at +## each element of @var{x} and corresponding parameter @var{sigma}. +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## x = 0:0.5:2.5; +## sigma = 1:6; +## p = raylcdf (x, sigma) +## @end group +## +## @group +## p = raylcdf (x, 0.5) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. pages 104 and 148, McGraw-Hill, New York, second edition, +## 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: CDF of the Rayleigh distribution + +function p = raylcdf (x, sigma) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! isempty (x) && ! ismatrix (x)) + error ("raylcdf: x must be a numeric matrix"); + endif + if (! isempty (sigma) && ! ismatrix (sigma)) + error ("raylcdf: sigma must be a numeric matrix"); + endif + + if (! isscalar (x) || ! isscalar (sigma)) + [retval, x, sigma] = common_size (x, sigma); + if (retval > 0) + error ("raylcdf: x and sigma must be of common size or scalar"); + endif + endif + + # Calculate cdf + p = 1 - exp ((-x .^ 2) ./ (2 * sigma .^ 2)); + + # Continue argument check + k = find (! (x >= 0) | ! (x < Inf) | ! (sigma > 0)); + if (any (k)) + p(k) = NaN; + endif + +endfunction + +%!test +%! x = 0:0.5:2.5; +%! sigma = 1:6; +%! p = raylcdf (x, sigma); +%! expected_p = [0.0000, 0.0308, 0.0540, 0.0679, 0.0769, 0.0831]; +%! assert (p, expected_p, 0.001); + +%!test +%! x = 0:0.5:2.5; +%! p = raylcdf (x, 0.5); +%! expected_p = [0.0000, 0.3935, 0.8647, 0.9889, 0.9997, 1.0000]; +%! assert (p, expected_p, 0.001); diff --git a/octave_packages/statistics-1.1.3/raylinv.m b/octave_packages/statistics-1.1.3/raylinv.m new file mode 100644 index 0000000..8e332f9 --- /dev/null +++ b/octave_packages/statistics-1.1.3/raylinv.m @@ -0,0 +1,123 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} raylinv (@var{p}, @var{sigma}) +## Compute the quantile of the Rayleigh distribution. The quantile is the +## inverse of the cumulative distribution function. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{p} is the cumulative distribution. The elements of @var{p} must be +## probabilities. +## +## @item +## @var{sigma} is the parameter of the Rayleigh distribution. The elements +## of @var{sigma} must be positive. +## @end itemize +## @var{p} and @var{sigma} must be of common size or one of them must be +## scalar. +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{x} is the quantile of the Rayleigh distribution at each element of +## @var{p} and corresponding parameter @var{sigma}. +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## p = 0:0.1:0.5; +## sigma = 1:6; +## x = raylinv (p, sigma) +## @end group +## +## @group +## x = raylinv (p, 0.5) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. pages 104 and 148, McGraw-Hill, New York, second edition, +## 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Quantile of the Rayleigh distribution + +function x = raylinv (p, sigma) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! isempty (p) && ! ismatrix (p)) + error ("raylinv: p must be a numeric matrix"); + endif + if (! isempty (sigma) && ! ismatrix (sigma)) + error ("raylinv: sigma must be a numeric matrix"); + endif + + if (! isscalar (p) || ! isscalar (sigma)) + [retval, p, sigma] = common_size (p, sigma); + if (retval > 0) + error ("raylinv: p and sigma must be of common size or scalar"); + endif + endif + + # Calculate quantile + x = sqrt (-2 .* log (1 - p) .* sigma .^ 2); + + k = find (p == 1); + if (any (k)) + x(k) = Inf; + endif + + # Continue argument check + k = find (! (p >= 0) | ! (p <= 1) | ! (sigma > 0)); + if (any (k)) + x(k) = NaN; + endif + +endfunction + +%!test +%! p = 0:0.1:0.5; +%! sigma = 1:6; +%! x = raylinv (p, sigma); +%! expected_x = [0.0000, 0.9181, 2.0041, 3.3784, 5.0538, 7.0645]; +%! assert (x, expected_x, 0.001); + +%!test +%! p = 0:0.1:0.5; +%! x = raylinv (p, 0.5); +%! expected_x = [0.0000, 0.2295, 0.3340, 0.4223, 0.5054, 0.5887]; +%! assert (x, expected_x, 0.001); diff --git a/octave_packages/statistics-1.1.3/raylpdf.m b/octave_packages/statistics-1.1.3/raylpdf.m new file mode 100644 index 0000000..744dc10 --- /dev/null +++ b/octave_packages/statistics-1.1.3/raylpdf.m @@ -0,0 +1,116 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} raylpdf (@var{x}, @var{sigma}) +## Compute the probability density function of the Rayleigh distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{x} is the support. The elements of @var{x} must be non-negative. +## +## @item +## @var{sigma} is the parameter of the Rayleigh distribution. The elements +## of @var{sigma} must be positive. +## @end itemize +## @var{x} and @var{sigma} must be of common size or one of them must be +## scalar. +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{y} is the probability density of the Rayleigh distribution at each +## element of @var{x} and corresponding parameter @var{sigma}. +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## x = 0:0.5:2.5; +## sigma = 1:6; +## y = raylpdf (x, sigma) +## @end group +## +## @group +## y = raylpdf (x, 0.5) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. pages 104 and 148, McGraw-Hill, New York, second edition, +## 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: PDF of the Rayleigh distribution + +function y = raylpdf (x, sigma) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! isempty (x) && ! ismatrix (x)) + error ("raylpdf: x must be a numeric matrix"); + endif + if (! isempty (sigma) && ! ismatrix (sigma)) + error ("raylpdf: sigma must be a numeric matrix"); + endif + + if (! isscalar (x) || ! isscalar (sigma)) + [retval, x, sigma] = common_size (x, sigma); + if (retval > 0) + error ("raylpdf: x and sigma must be of common size or scalar"); + endif + endif + + # Calculate pdf + y = x .* exp ((-x .^ 2) ./ (2 .* sigma .^ 2)) ./ (sigma .^ 2); + + # Continue argument check + k = find (! (x >= 0) | ! (x < Inf) | ! (sigma > 0)); + if (any (k)) + y(k) = NaN; + endif + +endfunction + +%!test +%! x = 0:0.5:2.5; +%! sigma = 1:6; +%! y = raylpdf (x, sigma); +%! expected_y = [0.0000, 0.1212, 0.1051, 0.0874, 0.0738, 0.0637]; +%! assert (y, expected_y, 0.001); + +%!test +%! x = 0:0.5:2.5; +%! y = raylpdf (x, 0.5); +%! expected_y = [0.0000, 1.2131, 0.5413, 0.0667, 0.0027, 0.0000]; +%! assert (y, expected_y, 0.001); diff --git a/octave_packages/statistics-1.1.3/raylrnd.m b/octave_packages/statistics-1.1.3/raylrnd.m new file mode 100644 index 0000000..950270c --- /dev/null +++ b/octave_packages/statistics-1.1.3/raylrnd.m @@ -0,0 +1,157 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} raylrnd (@var{sigma}) +## @deftypefnx {Function File} {@var{x} =} raylrnd (@var{sigma}, @var{sz}) +## @deftypefnx {Function File} {@var{x} =} raylrnd (@var{sigma}, @var{r}, @var{c}) +## Generate a matrix of random samples from the Rayleigh distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{sigma} is the parameter of the Rayleigh distribution. The elements +## of @var{sigma} must be positive. +## +## @item +## @var{sz} is the size of the matrix to be generated. @var{sz} must be a +## vector of non-negative integers. +## +## @item +## @var{r} is the number of rows of the matrix to be generated. @var{r} must +## be a non-negative integer. +## +## @item +## @var{c} is the number of columns of the matrix to be generated. @var{c} +## must be a non-negative integer. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{x} is a matrix of random samples from the Rayleigh distribution with +## corresponding parameter @var{sigma}. If neither @var{sz} nor @var{r} and +## @var{c} are specified, then @var{x} is of the same size as @var{sigma}. +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## sigma = 1:6; +## x = raylrnd (sigma) +## @end group +## +## @group +## sz = [2, 3]; +## x = raylrnd (0.5, sz) +## @end group +## +## @group +## r = 2; +## c = 3; +## x = raylrnd (0.5, r, c) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. pages 104 and 148, McGraw-Hill, New York, second edition, +## 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Random samples from the Rayleigh distribution + +function x = raylrnd (sigma, r, c) + + # Check arguments + if (nargin == 1) + sz = size (sigma); + elseif (nargin == 2) + if (! isvector (r) || any ((r < 0) | round (r) != r)) + error ("raylrnd: sz must be a vector of non-negative integers") + endif + sz = r(:)'; + if (! isscalar (sigma) && ! isempty (sigma) && (length (size (sigma)) != length (sz) || any (size (sigma) != sz))) + error ("raylrnd: sigma must be scalar or of size sz"); + endif + elseif (nargin == 3) + if (! isscalar (r) || any ((r < 0) | round (r) != r)) + error ("raylrnd: r must be a non-negative integer") + endif + if (! isscalar (c) || any ((c < 0) | round (c) != c)) + error ("raylrnd: c must be a non-negative integer") + endif + sz = [r, c]; + if (! isscalar (sigma) && ! isempty (sigma) && (length (size (sigma)) != length (sz) || any (size (sigma) != sz))) + error ("raylrnd: sigma must be scalar or of size [r, c]"); + endif + else + print_usage (); + endif + + if (! isempty (sigma) && ! ismatrix (sigma)) + error ("raylrnd: sigma must be a numeric matrix"); + endif + + if (isempty (sigma)) + x = []; + elseif (isscalar (sigma) && ! (sigma > 0)) + x = NaN .* ones (sz); + else + # Draw random samples + x = sqrt (-2 .* log (1 - rand (sz)) .* sigma .^ 2); + + # Continue argument check + k = find (! (sigma > 0)); + if (any (k)) + x(k) = NaN; + endif + endif + +endfunction + +%!test +%! sigma = 1:6; +%! x = raylrnd (sigma); +%! assert (size (x), size (sigma)); +%! assert (all (x >= 0)); + +%!test +%! sigma = 0.5; +%! sz = [2, 3]; +%! x = raylrnd (sigma, sz); +%! assert (size (x), sz); +%! assert (all (x >= 0)); + +%!test +%! sigma = 0.5; +%! r = 2; +%! c = 3; +%! x = raylrnd (sigma, r, c); +%! assert (size (x), [r, c]); +%! assert (all (x >= 0)); diff --git a/octave_packages/statistics-1.1.3/raylstat.m b/octave_packages/statistics-1.1.3/raylstat.m new file mode 100644 index 0000000..96f4d8b --- /dev/null +++ b/octave_packages/statistics-1.1.3/raylstat.m @@ -0,0 +1,94 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} raylstat (@var{sigma}) +## Compute mean and variance of the Rayleigh distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{sigma} is the parameter of the Rayleigh distribution. The elements +## of @var{sigma} must be positive. +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the Rayleigh distribution. +## +## @item +## @var{v} is the variance of the Rayleigh distribution. +## @end itemize +## +## @subheading Example +## +## @example +## @group +## sigma = 1:6; +## [m, v] = raylstat (sigma) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the Rayleigh distribution + +function [m, v] = raylstat (sigma) + + # Check arguments + if (nargin != 1) + print_usage (); + endif + + if (! isempty (sigma) && ! ismatrix (sigma)) + error ("raylstat: sigma must be a numeric matrix"); + endif + + # Calculate moments + m = sigma .* sqrt (pi ./ 2); + v = (2 - pi ./ 2) .* sigma .^ 2; + + # Continue argument check + k = find (! (sigma > 0)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! sigma = 1:6; +%! [m, v] = raylstat (sigma); +%! expected_m = [1.2533, 2.5066, 3.7599, 5.0133, 6.2666, 7.5199]; +%! expected_v = [0.4292, 1.7168, 3.8628, 6.8673, 10.7301, 15.4513]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/statistics-1.1.3/regress.m b/octave_packages/statistics-1.1.3/regress.m new file mode 100644 index 0000000..bff793e --- /dev/null +++ b/octave_packages/statistics-1.1.3/regress.m @@ -0,0 +1,214 @@ +## Copyright (C) 2005, 2006 William Poetra Yoga Hadisoeseno +## Copyright (C) 2011 Nir Krakauer +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{b}, @var{bint}, @var{r}, @var{rint}, @var{stats}] =} regress (@var{y}, @var{X}, [@var{alpha}]) +## Multiple Linear Regression using Least Squares Fit of @var{y} on @var{X} +## with the model @code{y = X * beta + e}. +## +## Here, +## +## @itemize +## @item +## @code{y} is a column vector of observed values +## @item +## @code{X} is a matrix of regressors, with the first column filled with +## the constant value 1 +## @item +## @code{beta} is a column vector of regression parameters +## @item +## @code{e} is a column vector of random errors +## @end itemize +## +## Arguments are +## +## @itemize +## @item +## @var{y} is the @code{y} in the model +## @item +## @var{X} is the @code{X} in the model +## @item +## @var{alpha} is the significance level used to calculate the confidence +## intervals @var{bint} and @var{rint} (see `Return values' below). If not +## specified, ALPHA defaults to 0.05 +## @end itemize +## +## Return values are +## +## @itemize +## @item +## @var{b} is the @code{beta} in the model +## @item +## @var{bint} is the confidence interval for @var{b} +## @item +## @var{r} is a column vector of residuals +## @item +## @var{rint} is the confidence interval for @var{r} +## @item +## @var{stats} is a row vector containing: +## +## @itemize +## @item The R^2 statistic +## @item The F statistic +## @item The p value for the full model +## @item The estimated error variance +## @end itemize +## @end itemize +## +## @var{r} and @var{rint} can be passed to @code{rcoplot} to visualize +## the residual intervals and identify outliers. +## +## NaN values in @var{y} and @var{X} are removed before calculation begins. +## +## @end deftypefn + +## References: +## - Matlab 7.0 documentation (pdf) +## - ¡¶´óѧÊýѧʵÑé¡· ½ªÆôÔ´ µÈ (textbook) +## - http://www.netnam.vn/unescocourse/statistics/12_5.htm +## - wsolve.m in octave-forge +## - http://www.stanford.edu/class/ee263/ls_ln_matlab.pdf + +function [b, bint, r, rint, stats] = regress (y, X, alpha) + + if (nargin < 2 || nargin > 3) + print_usage; + endif + + if (! ismatrix (y)) + error ("regress: y must be a numeric matrix"); + endif + if (! ismatrix (X)) + error ("regress: X must be a numeric matrix"); + endif + + if (columns (y) != 1) + error ("regress: y must be a column vector"); + endif + + if (rows (y) != rows (X)) + error ("regress: y and X must contain the same number of rows"); + endif + + if (nargin < 3) + alpha = 0.05; + elseif (! isscalar (alpha)) + error ("regress: alpha must be a scalar value") + endif + + notnans = ! logical (sum (isnan ([y X]), 2)); + y = y(notnans); + X = X(notnans,:); + + [Xq Xr] = qr (X, 0); + pinv_X = Xr \ Xq'; + + b = pinv_X * y; + + if (nargout > 1) + + n = rows (X); + p = columns (X); + dof = n - p; + t_alpha_2 = tinv (alpha / 2, dof); + + r = y - X * b; # added -- Nir + SSE = sum (r .^ 2); + v = SSE / dof; + + # c = diag(inv (X' * X)) using (economy) QR decomposition + # which means that we only have to use Xr + c = diag (inv (Xr' * Xr)); + + db = t_alpha_2 * sqrt (v * c); + + bint = [b + db, b - db]; + + endif + + if (nargout > 3) + + dof1 = n - p - 1; + h = sum(X.*pinv_X', 2); #added -- Nir (same as diag(X*pinv_X), without doing the matrix multiply) + + # From Matlab's documentation on Multiple Linear Regression, + # sigmaihat2 = norm (r) ^ 2 / dof1 - r .^ 2 / (dof1 * (1 - h)); + # dr = -tinv (1 - alpha / 2, dof) * sqrt (sigmaihat2 .* (1 - h)); + # Substitute + # norm (r) ^ 2 == sum (r .^ 2) == SSE + # -tinv (1 - alpha / 2, dof) == tinv (alpha / 2, dof) == t_alpha_2 + # We get + # sigmaihat2 = (SSE - r .^ 2 / (1 - h)) / dof1; + # dr = t_alpha_2 * sqrt (sigmaihat2 .* (1 - h)); + # Combine, we get + # dr = t_alpha_2 * sqrt ((SSE * (1 - h) - (r .^ 2)) / dof1); + + dr = t_alpha_2 * sqrt ((SSE * (1 - h) - (r .^ 2)) / dof1); + + rint = [r + dr, r - dr]; + + endif + + if (nargout > 4) + + R2 = 1 - SSE / sum ((y - mean (y)) .^ 2); +# F = (R2 / (p - 1)) / ((1 - R2) / dof); + F = dof / (p - 1) / (1 / R2 - 1); + pval = 1 - fcdf (F, p - 1, dof); + + stats = [R2 F pval v]; + + endif + +endfunction + + +%!test +%! % Longley data from the NIST Statistical Reference Dataset +%! Z = [ 60323 83.0 234289 2356 1590 107608 1947 +%! 61122 88.5 259426 2325 1456 108632 1948 +%! 60171 88.2 258054 3682 1616 109773 1949 +%! 61187 89.5 284599 3351 1650 110929 1950 +%! 63221 96.2 328975 2099 3099 112075 1951 +%! 63639 98.1 346999 1932 3594 113270 1952 +%! 64989 99.0 365385 1870 3547 115094 1953 +%! 63761 100.0 363112 3578 3350 116219 1954 +%! 66019 101.2 397469 2904 3048 117388 1955 +%! 67857 104.6 419180 2822 2857 118734 1956 +%! 68169 108.4 442769 2936 2798 120445 1957 +%! 66513 110.8 444546 4681 2637 121950 1958 +%! 68655 112.6 482704 3813 2552 123366 1959 +%! 69564 114.2 502601 3931 2514 125368 1960 +%! 69331 115.7 518173 4806 2572 127852 1961 +%! 70551 116.9 554894 4007 2827 130081 1962 ]; +%! % Results certified by NIST using 500 digit arithmetic +%! % b and standard error in b +%! V = [ -3482258.63459582 890420.383607373 +%! 15.0618722713733 84.9149257747669 +%! -0.358191792925910E-01 0.334910077722432E-01 +%! -2.02022980381683 0.488399681651699 +%! -1.03322686717359 0.214274163161675 +%! -0.511041056535807E-01 0.226073200069370 +%! 1829.15146461355 455.478499142212 ]; +%! Rsq = 0.995479004577296; +%! F = 330.285339234588; +%! y = Z(:,1); X = [ones(rows(Z),1), Z(:,2:end)]; +%! alpha = 0.05; +%! [b, bint, r, rint, stats] = regress (y, X, alpha); +%! assert(b,V(:,1),3e-6); +%! assert(stats(1),Rsq,1e-12); +%! assert(stats(2),F,3e-8); +%! assert(((bint(:,1)-bint(:,2))/2)/tinv(alpha/2,9),V(:,2),-1.e-5); diff --git a/octave_packages/statistics-1.1.3/repanova.m b/octave_packages/statistics-1.1.3/repanova.m new file mode 100644 index 0000000..e9d525c --- /dev/null +++ b/octave_packages/statistics-1.1.3/repanova.m @@ -0,0 +1,100 @@ +## Copyright (C) 2011 Kyle Winfree +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{table}, @var{st}] =} repanova (@var{X}, @var{cond}) +## @deftypefnx {Function File} {[@var{pval}, @var{table}, @var{st}] =} repanova (@var{X}, @var{cond}, ['string' | 'cell']) +## Perform a repeated measures analysis of variance (Repeated ANOVA). +## X is formated such that each row is a subject and each column is a condition. +## +## condition is typically a point in time, say t=1 then t=2, etc +## condition can also be thought of as groups. +## +## The optional flag can be either 'cell' or 'string' and reflects +## the format of the table returned. Cell is the default. +## +## NaNs are ignored using nanmean and nanstd. +## +## This fuction does not currently support multiple columns of the same +## condition! +## @end deftypefn + +function [p, table, st] = repanova(varargin) + +switch nargin + case 0 + error('Too few inputs.'); + case 1 + X = varargin{1}; + for c = 1:size(X, 2) + condition{c} = ['time', num2str(c)]; + end + option = 'cell'; + case 2 + X = varargin{1}; + condition = varargin{2}; + option = 'cell'; + case 3 + X = varargin{1}; + condition = varargin{2}; + option = varargin{3}; + otherwise + error('Too many inputs.'); +end + % Find the means of the subjects and measures, ignoring any NaNs + u_subjects = nanmean(X,2); + u_measures = nanmean(X,1); + u_grand = nansum(nansum(X)) / (size(X,1) * size(X,2)); + % Differences between rows will be reflected in SS subjects, differences + % between columns will be reflected in SS_within subjects. + N = size(X,1); % number of subjects + J = size(X,2); % number of samples per subject + SS_measures = N * nansum((u_measures - u_grand).^2); + SS_subjects = J * nansum((u_subjects - u_grand).^2); + SS_total = nansum(nansum((X - u_grand).^2)); + SS_error = SS_total - SS_measures - SS_subjects; + df_measures = J - 1; + df_subjects = N - 1; + df_grand = (N*J) - 1; + df_error = df_grand - df_measures - df_subjects; + MS_measures = SS_measures / df_measures; + MS_subjects = SS_subjects / df_subjects; + MS_error = SS_error / df_error; % variation expected as a result of sampling error alone + F = MS_measures / MS_error; + p = 1 - fcdf(F, df_measures, df_error); % Probability of F given equal means. + + if strcmp(option, 'string') + table = [sprintf('\nSource\tSS\tdf\tMS\tF\tProb > F'), ... + sprintf('\nSubject\t%g\t%i\t%g', SS_subjects, df_subjects, MS_subjects), ... + sprintf('\nMeasure\t%g\t%i\t%g\t%g\t%g', SS_measures, df_measures, MS_measures, F, p), ... + sprintf('\nError\t%g\t%i\t%g', SS_error, df_error, MS_error), ... + sprintf('\n')]; + else + table = {'Source', 'Partial SS', 'df', 'MS', 'F', 'Prob > F'; ... + 'Subject', SS_subjects, df_subjects, MS_subjects, '', ''; ... + 'Measure', SS_measures, df_measures, MS_measures, F, p}; + end + + st.gnames = condition'; % this is the same struct format used in anova1 + st.n = repmat(N, 1, J); + st.source = 'anova1'; % it cannot be assumed that 'repanova' is a supported source for multcompare + st.means = u_measures; + st.df = df_error; + st.s = sqrt(MS_error); +end + +% This function was created with guidance from the following websites: +% http://courses.washington.edu/stat217/rmANOVA.html +% http://grants.hhp.coe.uh.edu/doconnor/PEP6305/Topic%20010%20Repeated%20Measures.htm diff --git a/octave_packages/statistics-1.1.3/squareform.m b/octave_packages/statistics-1.1.3/squareform.m new file mode 100644 index 0000000..0a1e2f5 --- /dev/null +++ b/octave_packages/statistics-1.1.3/squareform.m @@ -0,0 +1,94 @@ +## Copyright (C) 2006, 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} squareform (@var{x}) +## @deftypefnx {Function File} {@var{y} =} squareform (@var{x}, @ +## "tovector") +## @deftypefnx {Function File} {@var{y} =} squareform (@var{x}, @ +## "tomatrix") +## Convert a vector from the pdist function into a square matrix or from +## a square matrix back to the vector form. +## +## The second argument is used to specify the output type in case there +## is a single element. +## @seealso{pdist} +## @end deftypefn + +## Author: Bill Denney + +function y = squareform (x, method) + + if nargin < 1 + print_usage (); + elseif nargin < 2 + if isscalar (x) || isvector (x) + method = "tomatrix"; + elseif issquare (x) + method = "tovector"; + else + error ("squareform: cannot deal with a nonsquare, nonvector \ + input"); + endif + endif + method = lower (method); + + if ! strcmp ({"tovector" "tomatrix"}, method) + error ("squareform: method must be either \"tovector\" or \ + \"tomatrix\""); + endif + + if strcmp ("tovector", method) + if ! issquare (x) + error ("squareform: x is not a square matrix"); + endif + + sx = size (x, 1); + y = zeros ((sx-1)*sx/2, 1); + idx = 1; + for i = 2:sx + newidx = idx + sx - i; + y(idx:newidx) = x(i:sx,i-1); + idx = newidx + 1; + endfor + else + ## we're converting to a matrix + + ## make sure that x is a column + x = x(:); + + ## the dimensions of y are the solution to the quadratic formula + ## for: + ## length(x) = (sy-1)*(sy/2) + sy = (1 + sqrt (1+ 8*length (x)))/2; + y = zeros (sy); + for i = 1:sy-1 + step = sy - i; + y((sy-step+1):sy,i) = x(1:step); + x(1:step) = []; + endfor + y = y + y'; + endif + +endfunction + +## make sure that it can go both directions automatically +%!assert(squareform(1:6), [0 1 2 3;1 0 4 5;2 4 0 6;3 5 6 0]) +%!assert(squareform([0 1 2 3;1 0 4 5;2 4 0 6;3 5 6 0]), [1:6]') + +## make sure that the command arguments force the correct behavior +%!assert(squareform(1), [0 1;1 0]) +%!assert(squareform(1, "tomatrix"), [0 1;1 0]) +%!assert(squareform(1, "tovector"), zeros(0,1)) diff --git a/octave_packages/statistics-1.1.3/tabulate.m b/octave_packages/statistics-1.1.3/tabulate.m new file mode 100644 index 0000000..e9015c6 --- /dev/null +++ b/octave_packages/statistics-1.1.3/tabulate.m @@ -0,0 +1,129 @@ +## Copyright (C) 2003 Alberto Terruzzi +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{table} =} tabulate (@var{data}, @var{edges}) +## +## Compute a frequency table. +## +## For vector data, the function counts the number of +## values in data that fall between the elements in the edges vector +## (which must contain monotonically non-decreasing values). @var{table} is a +## matrix. +## The first column of @var{table} is the number of bin, the second +## is the number of instances in each class (absolute frequency). The +## third column contains the percentage of each value (relative +## frequency) and the fourth column contains the cumulative frequency. +## +## If @var{edges} is missed the width of each class is unitary, if @var{edges} +## is a scalar then represent the number of classes, or you can define the +## width of each bin. +## @var{table}(@var{k}, 2) will count the value @var{data} (@var{i}) if +## @var{edges} (@var{k}) <= @var{data} (@var{i}) < @var{edges} (@var{k}+1). +## The last bin will count the value of @var{data} (@var{i}) if +## @var{edges}(@var{k}) <= @var{data} (@var{i}) <= @var{edges} (@var{k}+1). +## Values outside the values in @var{edges} are not counted. Use -inf and inf +## in @var{edges} to include all values. +## Tabulate with no output arguments returns a formatted table in the +## command window. +## +## Example +## +## @example +## sphere_radius = [1:0.05:2.5]; +## tabulate (sphere_radius) +## @end example +## +## Tabulate returns 2 bins, the first contains the sphere with radius +## between 1 and 2 mm excluded, and the second one contains the sphere with +## radius between 2 and 3 mm. +## +## @example +## tabulate (sphere_radius, 10) +## @end example +## +## Tabulate returns ten bins. +## +## @example +## tabulate (sphere_radius, [1, 1.5, 2, 2.5]) +## @end example +## +## Tabulate returns three bins, the first contains the sphere with radius +## between 1 and 1.5 mm excluded, the second one contains the sphere with +## radius between 1.5 and 2 mm excluded, and the third contains the sphere with +## radius between 2 and 2.5 mm. +## +## @example +## bar (table (:, 1), table (:, 2)) +## @end example +## +## draw histogram. +## +## @seealso{bar, pareto} +## @end deftypefn + +## Author: Alberto Terruzzi +## Version: 1.0 +## Created: 13 February 2003 + +function table = tabulate (varargin) + + if nargin < 1 || nargin > 2 + print_usage; + endif + + data = varargin{1}; + if isvector (data) != 1 + error ("data must be a vector."); + endif + n = length(data); + m = min(data); + M = max(data); + + if nargin == 1 edges = 1:1:max(data)+1; + else edges = varargin{2}; + end + + if isscalar(edges) + h=(M-m)/edges; + edges = [m:h:M]; + end + + # number of classes + bins=length(edges)-1; + # initialize freqency table + freqtable = zeros(bins,4); + + for k=1:1:bins; + if k != bins + freqtable(k,2)=length(find (data >= edges(k) & data < edges(k+1))); + else + freqtable(k,2)=length(find (data >= edges(k) & data <= edges(k+1))); + end + if k == 1 freqtable (k,4) = freqtable(k,2); + else freqtable(k,4) = freqtable(k-1,4) + freqtable(k,2); + end + end + + freqtable(:,1) = edges(1:end-1)(:); + freqtable(:,3) = 100*freqtable(:,2)/n; + + if nargout == 0 + disp(" bin Fa Fr% Fc"); + printf("%8g %5d %6.2f%% %5d\n",freqtable'); + else table = freqtable; + end + +endfunction diff --git a/octave_packages/statistics-1.1.3/tblread.m b/octave_packages/statistics-1.1.3/tblread.m new file mode 100644 index 0000000..01ea43b --- /dev/null +++ b/octave_packages/statistics-1.1.3/tblread.m @@ -0,0 +1,97 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{data}, @var{varnames}, @var{casenames}] =} tblread (@var{filename}) +## @deftypefnx {Function File} {[@var{data}, @var{varnames}, @var{casenames}] =} tblread (@var{filename}, @var{delimeter}) +## Read tabular data from an ascii file. +## +## @var{data} is read from an ascii data file named @var{filename} with +## an optional @var{delimeter}. The delimeter may be any single +## character or +## @itemize +## @item "space" " " (default) +## @item "tab" "\t" +## @item "comma" "," +## @item "semi" ";" +## @item "bar" "|" +## @end itemize +## +## The @var{data} is read starting at cell (2,2) where the +## @var{varnames} form a char matrix from the first row (starting at +## (1,2)) vertically concatenated, and the @var{casenames} form a char +## matrix read from the first column (starting at (2,1)) vertically +## concatenated. +## @seealso{tblwrite, csv2cell, cell2csv} +## @end deftypefn + +function [data, varnames, casenames] = tblread (f="", d=" ") + + ## Check arguments + if nargin < 1 || nargin > 2 + print_usage (); + endif + if isempty (f) + ## FIXME: open a file dialog box in this case when a file dialog box + ## becomes available + error ("tblread: filename must be given") + endif + [d err] = tbl_delim (d); + if ! isempty (err) + error ("tblread: %s", err) + endif + + d = csv2cell (f, d); + data = cell2mat (d(2:end, 2:end)); + varnames = strvcat (d(1,2:end)); + casenames = strvcat (d(2:end,1)); + +endfunction + +## Tests +%!shared d, v, c +%! d = [1 2;3 4]; +%! v = ["a ";"bc"]; +%! c = ["de";"f "]; +%!test +%! [dt vt ct] = tblread ("tblread-space.dat"); +%! assert (dt, d); +%! assert (vt, v); +%! assert (ct, c); +%!test +%! [dt vt ct] = tblread ("tblread-space.dat", " "); +%! assert (dt, d); +%! assert (vt, v); +%! assert (ct, c); +%!test +%! [dt vt ct] = tblread ("tblread-space.dat", "space"); +%! assert (dt, d); +%! assert (vt, v); +%! assert (ct, c); +%!test +%! [dt vt ct] = tblread ("tblread-tab.dat", "tab"); +%! assert (dt, d); +%! assert (vt, v); +%! assert (ct, c); +%!test +%! [dt vt ct] = tblread ("tblread-tab.dat", "\t"); +%! assert (dt, d); +%! assert (vt, v); +%! assert (ct, c); +%!test +%! [dt vt ct] = tblread ("tblread-tab.dat", '\t'); +%! assert (dt, d); +%! assert (vt, v); +%! assert (ct, c); diff --git a/octave_packages/statistics-1.1.3/tblwrite.m b/octave_packages/statistics-1.1.3/tblwrite.m new file mode 100644 index 0000000..058cdf0 --- /dev/null +++ b/octave_packages/statistics-1.1.3/tblwrite.m @@ -0,0 +1,126 @@ +## Copyright (C) 2008 Bill Denney +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} tblwrite (@var{data}, @var{varnames}, @var{casenames}, @var{filename}) +## @deftypefnx {Function File} {} tblwrite (@var{data}, @var{varnames}, @var{casenames}, @var{filename}, @var{delimeter}) +## Write tabular data to an ascii file. +## +## @var{data} is written to an ascii data file named @var{filename} with +## an optional @var{delimeter}. The delimeter may be any single +## character or +## @itemize +## @item "space" " " (default) +## @item "tab" "\t" +## @item "comma" "," +## @item "semi" ";" +## @item "bar" "|" +## @end itemize +## +## The @var{data} is written starting at cell (2,2) where the +## @var{varnames} are a char matrix or cell vector written to the first +## row (starting at (1,2)), and the @var{casenames} are a char matrix +## (or cell vector) written to the first column (starting at (2,1)). +## @seealso{tblread, csv2cell, cell2csv} +## @end deftypefn + +function tblwrite (data, varnames, casenames, f="", d=" ") + + ## Check arguments + if nargin < 4 || nargin > 5 + print_usage (); + endif + varnames = __makecell__ (varnames, "varnames"); + casenames = __makecell__ (casenames, "varnames"); + if numel (varnames) != columns (data) + error ("tblwrite: the number of rows (or cells) in varnames must equal the number of columns in data") + endif + if numel (varnames) != rows (data) + error ("tblwrite: the number of rows (or cells) in casenames must equal the number of rows in data") + endif + + if isempty (f) + ## FIXME: open a file dialog box in this case when a file dialog box + ## becomes available + error ("tblread: filename must be given") + endif + [d err] = tbl_delim (d); + if ! isempty (err) + error ("tblwrite: %s", err) + endif + + dat = cell (size (data) + 1); + dat(1,2:end) = varnames; + dat(2:end,1) = casenames; + dat(2:end,2:end) = mat2cell (data, + ones (rows (data), 1), + ones (columns (data), 1));; + cell2csv (f, dat, d); + +endfunction + +function x = __makecell__ (x, name) + ## force x into a cell matrix + if ! iscell (x) + if ischar (x) + ## convert varnames into a cell + x = mat2cell (x, ones (rows (x), 1)); + else + error ("tblwrite: %s must be either a char or a cell", name) + endif + endif +endfunction + +## Tests +%!shared d, v, c +%! d = [1 2;3 4]; +%! v = ["a ";"bc"]; +%! c = ["de";"f "]; +%!test +%! tblwrite (d, v, c, "tblwrite-space.dat"); +%! [dt vt ct] = tblread ("tblwrite-space.dat", " "); +%! assert (dt, d); +%! assert (vt, v); +%! assert (ct, c); +%!test +%! tblwrite (d, v, c, "tblwrite-space.dat", " "); +%! [dt vt ct] = tblread ("tblwrite-space.dat", " "); +%! assert (dt, d); +%! assert (vt, v); +%! assert (ct, c); +%!test +%! tblwrite (d, v, c, "tblwrite-space.dat", "space"); +%! [dt vt ct] = tblread ("tblwrite-space.dat"); +%! assert (dt, d); +%! assert (vt, v); +%! assert (ct, c); +%!test +%! tblwrite (d, v, c, "tblwrite-tab.dat", "tab"); +%! [dt vt ct] = tblread ("tblwrite-tab.dat", "tab"); +%! assert (dt, d); +%! assert (vt, v); +%! assert (ct, c); +%!test +%! tblwrite (d, v, c, "tblwrite-tab.dat", "\t"); +%! [dt vt ct] = tblread ("tblwrite-tab.dat", "\t"); +%! assert (dt, d); +%! assert (vt, v); +%! assert (ct, c); +%!test +%! tblwrite (d, v, c, "tblwrite-tab.dat", '\t'); +%! [dt vt ct] = tblread ("tblwrite-tab.dat", '\t'); +%! assert (dt, d); +%! assert (vt, v); +%! assert (ct, c); diff --git a/octave_packages/statistics-1.1.3/trimmean.m b/octave_packages/statistics-1.1.3/trimmean.m new file mode 100644 index 0000000..901b00f --- /dev/null +++ b/octave_packages/statistics-1.1.3/trimmean.m @@ -0,0 +1,58 @@ +## Copyright (C) 2001 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{a} =} trimmean (@var{x}, @var{p}) +## +## Compute the trimmed mean. +## +## The trimmed mean of @var{x} is defined as the mean of @var{x} excluding the +## highest and lowest @var{p} percent of the data. +## +## For example +## +## @example +## mean ([-inf, 1:9, inf]) +## @end example +## +## is NaN, while +## +## @example +## trimmean ([-inf, 1:9, inf], 10) +## @end example +## +## excludes the infinite values, which make the result 5. +## +## @seealso{mean} +## @end deftypefn + +function a = trimmean(x, p, varargin) + if (nargin != 2 && nargin != 3) + print_usage; + endif + y = sort(x, varargin{:}); + sz = size(x); + if nargin < 3 + dim = min(find(sz>1)); + if isempty(dim), dim=1; endif; + else + dim = varargin{1}; + endif + idx = cell (0); + for i=1:length(sz), idx{i} = 1:sz(i); end; + trim = round(sz(dim)*p*0.01); + idx{dim} = 1+trim : sz(dim)-trim; + a = mean (y (idx{:}), varargin{:}); +endfunction diff --git a/octave_packages/statistics-1.1.3/tstat.m b/octave_packages/statistics-1.1.3/tstat.m new file mode 100644 index 0000000..b5d7ac6 --- /dev/null +++ b/octave_packages/statistics-1.1.3/tstat.m @@ -0,0 +1,98 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} tstat (@var{n}) +## Compute mean and variance of the t (Student) distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{n} is the parameter of the t (Student) distribution. The elements +## of @var{n} must be positive +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the t (Student) distribution +## +## @item +## @var{v} is the variance of the t (Student) distribution +## @end itemize +## +## @subheading Example +## +## @example +## @group +## n = 3:8; +## [m, v] = tstat (n) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the t (Student) distribution + +function [m, v] = tstat (n) + + # Check arguments + if (nargin != 1) + print_usage (); + endif + + if (! isempty (n) && ! ismatrix (n)) + error ("tstat: n must be a numeric matrix"); + endif + + # Calculate moments + m = zeros (size (n)); + v = n ./ (n - 2); + + # Continue argument check + k = find (! (n > 1) | ! (n < Inf)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + k = find (! (n > 2) & (n < Inf)); + if (any (k)) + v(k) = Inf; + endif + +endfunction + +%!test +%! n = 3:8; +%! [m, v] = tstat (n); +%! expected_m = [0, 0, 0, 0, 0, 0]; +%! expected_v = [3.0000, 2.0000, 1.6667, 1.5000, 1.4000, 1.3333]; +%! assert (m, expected_m); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/statistics-1.1.3/unidstat.m b/octave_packages/statistics-1.1.3/unidstat.m new file mode 100644 index 0000000..beb17fe --- /dev/null +++ b/octave_packages/statistics-1.1.3/unidstat.m @@ -0,0 +1,94 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} unidstat (@var{n}) +## Compute mean and variance of the discrete uniform distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{n} is the parameter of the discrete uniform distribution. The elements +## of @var{n} must be positive natural numbers +## @end itemize +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the discrete uniform distribution +## +## @item +## @var{v} is the variance of the discrete uniform distribution +## @end itemize +## +## @subheading Example +## +## @example +## @group +## n = 1:6; +## [m, v] = unidstat (n) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the discrete uniform distribution + +function [m, v] = unidstat (n) + + # Check arguments + if (nargin != 1) + print_usage (); + endif + + if (! isempty (n) && ! ismatrix (n)) + error ("unidstat: n must be a numeric matrix"); + endif + + # Calculate moments + m = (n + 1) ./ 2; + v = ((n .^ 2) - 1) ./ 12; + + # Continue argument check + k = find (! (n > 0) | ! (n < Inf) | ! (n == round (n))); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! n = 1:6; +%! [m, v] = unidstat (n); +%! expected_m = [1.0000, 1.5000, 2.0000, 2.5000, 3.0000, 3.5000]; +%! expected_v = [0.0000, 0.2500, 0.6667, 1.2500, 2.0000, 2.9167]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/statistics-1.1.3/unifstat.m b/octave_packages/statistics-1.1.3/unifstat.m new file mode 100644 index 0000000..6023d87 --- /dev/null +++ b/octave_packages/statistics-1.1.3/unifstat.m @@ -0,0 +1,122 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} unifstat (@var{a}, @var{b}) +## Compute mean and variance of the continuous uniform distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{a} is the first parameter of the continuous uniform distribution +## +## @item +## @var{b} is the second parameter of the continuous uniform distribution +## @end itemize +## @var{a} and @var{b} must be of common size or one of them must be scalar +## and @var{a} must be less than @var{b} +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the continuous uniform distribution +## +## @item +## @var{v} is the variance of the continuous uniform distribution +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## a = 1:6; +## b = 2:2:12; +## [m, v] = unifstat (a, b) +## @end group +## +## @group +## [m, v] = unifstat (a, 10) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the continuous uniform distribution + +function [m, v] = unifstat (a, b) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! isempty (a) && ! ismatrix (a)) + error ("unifstat: a must be a numeric matrix"); + endif + if (! isempty (b) && ! ismatrix (b)) + error ("unifstat: b must be a numeric matrix"); + endif + + if (! isscalar (a) || ! isscalar (b)) + [retval, a, b] = common_size (a, b); + if (retval > 0) + error ("unifstat: a and b must be of common size or scalar"); + endif + endif + + # Calculate moments + m = (a + b) ./ 2; + v = ((b - a) .^ 2) ./ 12; + + # Continue argument check + k = find (! (-Inf < a) | ! (a < b) | ! (b < Inf)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! a = 1:6; +%! b = 2:2:12; +%! [m, v] = unifstat (a, b); +%! expected_m = [1.5000, 3.0000, 4.5000, 6.0000, 7.5000, 9.0000]; +%! expected_v = [0.0833, 0.3333, 0.7500, 1.3333, 2.0833, 3.0000]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); + +%!test +%! a = 1:6; +%! [m, v] = unifstat (a, 10); +%! expected_m = [5.5000, 6.0000, 6.5000, 7.0000, 7.5000, 8.0000]; +%! expected_v = [6.7500, 5.3333, 4.0833, 3.0000, 2.0833, 1.3333]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/statistics-1.1.3/vmpdf.m b/octave_packages/statistics-1.1.3/vmpdf.m new file mode 100644 index 0000000..ef42f70 --- /dev/null +++ b/octave_packages/statistics-1.1.3/vmpdf.m @@ -0,0 +1,46 @@ +## Copyright (C) 2009 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{theta} = vmpdf (@var{x}, @var{mu}, @var{k}) +## Evaluates the Von Mises probability density function. +## +## The Von Mises distribution has probability density function +## @example +## f (@var{x}) = exp (@var{k} * cos (@var{x} - @var{mu})) / @var{Z} , +## @end example +## where @var{Z} is a normalisation constant. By default, @var{mu} is 0 and +## @var{k} is 1. +## @seealso{vmrnd} +## @end deftypefn + +function p = vmpdf (x, mu = 0, k = 1) + ## Check input + if (!isreal (x)) + error ("vmpdf: first input must be real"); + endif + + if (!isreal (mu)) + error ("vmpdf: second input must be a scalar"); + endif + + if (!isreal (k) || k <= 0) + error ("vmpdf: third input must be a real positive scalar"); + endif + + ## Evaluate PDF + Z = 2 * pi * besseli (0, k); + p = exp (k * cos (x-mu)) / Z; +endfunction diff --git a/octave_packages/statistics-1.1.3/vmrnd.m b/octave_packages/statistics-1.1.3/vmrnd.m new file mode 100644 index 0000000..94d68b2 --- /dev/null +++ b/octave_packages/statistics-1.1.3/vmrnd.m @@ -0,0 +1,76 @@ +## Copyright (C) 2009 Soren Hauberg +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} @var{theta} = vmrnd (@var{mu}, @var{k}) +## @deftypefnx{Function File} @var{theta} = vmrnd (@var{mu}, @var{k}, @var{sz}) +## Draw random angles from a Von Mises distribution with mean @var{mu} and +## concentration @var{k}. +## +## The Von Mises distribution has probability density function +## @example +## f (@var{x}) = exp (@var{k} * cos (@var{x} - @var{mu})) / @var{Z} , +## @end example +## where @var{Z} is a normalisation constant. +## +## The output, @var{theta}, is a matrix of size @var{sz} containing random angles +## drawn from the given Von Mises distribution. By default, @var{mu} is 0 +## and @var{k} is 1. +## @seealso{vmpdf} +## @end deftypefn + +function theta = vmrnd (mu = 0, k = 1, sz = 1) + ## Check input + if (!isreal (mu)) + error ("vmrnd: first input must be a scalar"); + endif + + if (!isreal (k) || k <= 0) + error ("vmrnd: second input must be a real positive scalar"); + endif + + if (isscalar (sz)) + sz = [sz, sz]; + elseif (!isvector (sz)) + error ("vmrnd: third input must be a scalar or a vector"); + endif + + ## Simulate! + if (k < 1e-6) + ## k is small: sample uniformly on circle + theta = 2 * pi * rand (sz) - pi; + + else + a = 1 + sqrt (1 + 4 * k.^2); + b = (a - sqrt (2 * a)) / (2 * k); + r = (1 + b^2) / (2 * b); + + N = prod (sz); + notdone = true (N, 1); + while (any (notdone)) + u (:, notdone) = rand (3, N); + + z (notdone) = cos (pi * u (1, notdone)); + f (notdone) = (1 + r * z (notdone)) ./ (r + z (notdone)); + c (notdone) = k * (r - f (notdone)); + + notdone = (u (2, :) >= c .* (2 - c)) & (log (c) - log (u (2, :)) + 1 - c < 0); + N = sum (notdone); + endwhile + + theta = mu + sign (u (3, :) - 0.5) .* acos (f); + theta = reshape (theta, sz); + endif +endfunction diff --git a/octave_packages/statistics-1.1.3/wblstat.m b/octave_packages/statistics-1.1.3/wblstat.m new file mode 100644 index 0000000..d8ac426 --- /dev/null +++ b/octave_packages/statistics-1.1.3/wblstat.m @@ -0,0 +1,124 @@ +## Copyright (C) 2006, 2007 Arno Onken +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{m}, @var{v}] =} wblstat (@var{scale}, @var{shape}) +## Compute mean and variance of the Weibull distribution. +## +## @subheading Arguments +## +## @itemize @bullet +## @item +## @var{scale} is the scale parameter of the Weibull distribution. +## @var{scale} must be positive +## +## @item +## @var{shape} is the shape parameter of the Weibull distribution. +## @var{shape} must be positive +## @end itemize +## @var{scale} and @var{shape} must be of common size or one of them must be +## scalar +## +## @subheading Return values +## +## @itemize @bullet +## @item +## @var{m} is the mean of the Weibull distribution +## +## @item +## @var{v} is the variance of the Weibull distribution +## @end itemize +## +## @subheading Examples +## +## @example +## @group +## scale = 3:8; +## shape = 1:6; +## [m, v] = wblstat (scale, shape) +## @end group +## +## @group +## [m, v] = wblstat (6, shape) +## @end group +## @end example +## +## @subheading References +## +## @enumerate +## @item +## Wendy L. Martinez and Angel R. Martinez. @cite{Computational Statistics +## Handbook with MATLAB}. Appendix E, pages 547-557, Chapman & Hall/CRC, +## 2001. +## +## @item +## Athanasios Papoulis. @cite{Probability, Random Variables, and Stochastic +## Processes}. McGraw-Hill, New York, second edition, 1984. +## @end enumerate +## @end deftypefn + +## Author: Arno Onken +## Description: Moments of the Weibull distribution + +function [m, v] = wblstat (scale, shape) + + # Check arguments + if (nargin != 2) + print_usage (); + endif + + if (! isempty (scale) && ! ismatrix (scale)) + error ("wblstat: scale must be a numeric matrix"); + endif + if (! isempty (shape) && ! ismatrix (shape)) + error ("wblstat: shape must be a numeric matrix"); + endif + + if (! isscalar (scale) || ! isscalar (shape)) + [retval, scale, shape] = common_size (scale, shape); + if (retval > 0) + error ("wblstat: scale and shape must be of common size or scalar"); + endif + endif + + # Calculate moments + m = scale .* gamma (1 + 1 ./ shape); + v = (scale .^ 2) .* gamma (1 + 2 ./ shape) - m .^ 2; + + # Continue argument check + k = find (! (scale > 0) | ! (scale < Inf) | ! (shape > 0) | ! (shape < Inf)); + if (any (k)) + m(k) = NaN; + v(k) = NaN; + endif + +endfunction + +%!test +%! scale = 3:8; +%! shape = 1:6; +%! [m, v] = wblstat (scale, shape); +%! expected_m = [3.0000, 3.5449, 4.4649, 5.4384, 6.4272, 7.4218]; +%! expected_v = [9.0000, 3.4336, 2.6333, 2.3278, 2.1673, 2.0682]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); + +%!test +%! shape = 1:6; +%! [m, v] = wblstat (6, shape); +%! expected_m = [ 6.0000, 5.3174, 5.3579, 5.4384, 5.5090, 5.5663]; +%! expected_v = [36.0000, 7.7257, 3.7920, 2.3278, 1.5923, 1.1634]; +%! assert (m, expected_m, 0.001); +%! assert (v, expected_v, 0.001); diff --git a/octave_packages/strings-1.1.0/base64decode.m b/octave_packages/strings-1.1.0/base64decode.m new file mode 100644 index 0000000..a961ba1 --- /dev/null +++ b/octave_packages/strings-1.1.0/base64decode.m @@ -0,0 +1,157 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{rval} =} base64decode (@var{code}) +## @deftypefnx {Function File} {@var{rval} =} base64decode (@var{code}, @var{as_string}) +## Convert a base64 @var{code} (a string of printable characters according to RFC 2045) +## into the original ASCII data set of range 0-255. If option @var{as_string} is +## passed, the return value is converted into a string. +## +## @example +## @group +## ##base64decode(base64encode('Hakuna Matata'),true) +## base64decode('SGFrdW5hIE1hdGF0YQ==',true) +## ##returns 'Hakuna Matata' +## @end group +## @end example +## +## See: http://www.ietf.org/rfc/rfc2045.txt +## +## @seealso {base64encode} +## @end deftypefn + +function z = base64decode (X, as_string) + if (nargin < 1 ) + print_usage; + elseif nargin == 1 + as_string=false; + endif + + if ( any(X(:) < 0) || any(X(:) > 255)) + error("base64decode is expecting integers in the range 0 .. 255"); + endif + + ## decompose strings into the 4xN matrices + ## formatting issues. + if( rows(X) == 1 ) + Y=[]; + L=length(X); + for z=4:4:L + Y=[Y X(z-3:z)']; #keep adding columns + end + if min(size(Y))==1 + Y=reshape(Y,[L, 1]); + else + Y=reshape(Y,[4,L/4]); + end + X=Y; + Y=[]; + end + + X = toascii(X); + Xa= X; + + ## Work backwards. Starting at step in table, + ## lookup the index of the element in the table. + + ## 6-bit encoding table, plus 1 for padding + ## 26*2 + 10 + 2 + 1 = 64 + 1, '=' is EOF stop mark. + table = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="; + + S=size(X); + SRows=S(1); + SCols=S(2); + Y=zeros(S); + + ## decode the incoming matrix & + ## write the values into Va matrix. + Va = -1*ones(size(Xa)); + + iAZ = (Xa >= 'A').*(Xa <= 'Z') > 0; + Va(iAZ)=Xa(iAZ)-'A'; + + iaz = (Xa >= 'a').*(Xa <= 'z') > 0; + Va(iaz)=Xa(iaz)-'a'+26; + + i09 = (Xa >= '0').*(Xa <= '9') > 0; + Va(i09)=Xa(i09)-'0'+52; + + is = (Xa == '/') ; Va(is) = 63; + ip = (Xa == '+') ; Va(ip) = 62; + ieq = (Xa == '=') ; Va(ieq) = 0; + clear is; clear ieq; clear ip; clear i09; + clear iaz; clear iAZ; clear Xa; clear X; + + Y=Va; clear Va; + Y1=Y(1,:); + if (SRows > 1) + Y2=Y(2,:); + else + Y2=zeros(1,SCols); + end; + + if (SRows > 2) + Y3=Y(3,:); + else + Y3=zeros(1,SCols); + end; + + if (SRows > 3) + Y4=Y(4,:); + else + Y4=zeros(1,SCols); + end; + + ## +1 not required due to ASCII subtraction + ## actual decoding work + b1 = Y1*4 + fix(Y2/16); + b2 = mod(Y2,16)*16+fix(Y3/4); + b3 = mod(Y3,4)*64 + Y4; + + ZEROS=sum(sum(Y==0)); + L=length(b1)*3; + z=zeros(1,L); + z(1:3:end)=b1; + if (SRows > 1) + z(2:3:end)=b2; + else + z(2:3:end)=[]; + end; + + if (SRows > 2) + z(3:3:end)=b3; + else + z(3:3:end)=[]; + end + + ## FIXME + ## is this expected behaviour? + if ( as_string ) + L=length(z); + while ( ( L > 0) && ( z(L)==0 ) ) + L=L-1; + end + z=char(z(1:L)); + end + +endfunction + +%!assert(base64decode(base64encode('Hakuna Matata'),true),'Hakuna Matata') +%!assert(base64decode(base64encode([1:255])),[1:255]) +%!assert(base64decode(base64encode('taken'),true),'taken') +%!assert(base64decode(base64encode('sax'),true),'sax') +%!assert(base64decode(base64encode('H'),true),'H') +%!assert(base64decode(base64encode('Ta'),true),'Ta') diff --git a/octave_packages/strings-1.1.0/base64encode.m b/octave_packages/strings-1.1.0/base64encode.m new file mode 100644 index 0000000..28ac4dc --- /dev/null +++ b/octave_packages/strings-1.1.0/base64encode.m @@ -0,0 +1,77 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{Y} =} base64encode (@var{X}) +## @deftypefnx {Function File} {@var{Y} =} base64encode (@var{X}, @var{do_reshape}) +## Convert X into string of printable characters according to RFC 2045. +## The input may be a string or a matrix of integers in the range 0..255. +## If want the output in the 1-row of strings format, pass the +## @var{do_reshape} argument as true. +## +## Example: +## @example +## @group +## base64encode('Hakuna Matata',true) +## ##returns 'SGFrdW5hIE1hdGF0YQ==' +## +## @end group +## @end example +## @seealso{base64decode} +## @end deftypefn + +function Y = base64encode (X, do_reshape) + + if (nargin < 1) + print_usage; + elseif nargin != 2 + do_reshape=false; + endif + if (ischar(X)) + X = toascii(X); + elseif (any(X(:)) != fix(X(:)) || any(X(:) < 0) || any(X(:) > 255)) + error("base64encode is expecting integers in the range 0 .. 255"); + endif + + n = length(X(:)); + X = X(:); + + ## split the input into three pieces, zero padding to the same length + in1 = X(1:3:n); + in2 = zeros(size(in1)); + in3 = zeros(size(in1)); + in2(1:length(2:3:n)) = X(2:3:n); + in3(1:length(3:3:n)) = X(3:3:n); + + ## put the top bits of the inputs into the bottom bits of the + ## corresponding outputs + out1 = fix(in1/4); + out2 = fix(in2/16); + out3 = fix(in3/64); + + ## add the bottom bits of the inputs as the top bits of the corresponding + ## outputs + out4 = in3 - 64*out3; + out3 = out3 + 4*(in2 - 16*out2); + out2 = out2 + 16*(in1 - 4*out1); + + ## correct the output for padding + if (length(2:3:n) < length(1:3:n)) out3(length(out3)) = 64; endif + if (length(3:3:n) < length(1:3:n)) out4(length(out4)) = 64; endif + + ## 6-bit encoding table, plus 1 for padding + table = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="; + + table([ out1']+ 1); + table([ out2']+ 1); + table([ out3']+ 1); + table([ out4']+ 1); + + Y = table([ out1'; out2'; out3'; out4' ] + 1); + + if ( do_reshape ) + Y = reshape(Y,[1, prod(size(Y))]); + end +endfunction + +%!assert(base64encode('Hakuna Matata',true),'SGFrdW5hIE1hdGF0YQ==') diff --git a/octave_packages/strings-1.1.0/cstrcmp.m b/octave_packages/strings-1.1.0/cstrcmp.m new file mode 100644 index 0000000..df2f3b0 --- /dev/null +++ b/octave_packages/strings-1.1.0/cstrcmp.m @@ -0,0 +1,111 @@ +## Copyright (C) 2007 Muthiah Annamalai +## Copyright (C) 2012 Carnë Draug +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{rval} =} cstrcmp (@var{s1}, @var{s2}) +## Compare strings @var{s1} and @var{s2} like the C function. +## +## Aside the difference to the return values, this function API is exactly the +## same as Octave's @code{strcmp} and will accept cell arrays as well. +## +## @var{rval} indicates the relationship between the strings: +## @itemize @bullet +## @item +## A value of 0 indicates that both strings are equal; +## @item +## A value of +1 indicates that the first character that does not match has a +## greater value in @var{s1} than in @var{s2}. +## @item +## A value of -1 indicates that the first character that does not match has a +## match has a smaller value in @var{s1} than in @var{s2}. +## @end itemize +## +## @example +## @group +## cstrcmp("marry","marry") +## @result{} 0 +## cstrcmp("marry","marri") +## @result{} +1 +## cstrcmp("marri","marry") +## @result{} -1 +## @end group +## @end example +## +## @seealso {strcmp, strcmpi} +## @end deftypefn + +function rval = cstrcmp (s1, s2) + + if (nargin != 2) + print_usage(); + endif + + ## this function is just like Octave's strcmp but the 0 and 1 need to be + ## inverted. Once is done, if there are 1, we need to decide if they will + ## be positive or negative. Also, since it's possible that the value needs + ## to be negative, class must be double (strcmp returns logical) + rval = double(!strcmp (s1, s2)); + + if (!any (rval)) + ## all zeros, no need to do anything else + return + endif + + ## get index of the ones we have to "fix" + idx = find (rval == 1); + ## if any is not a cell, this simplifies the code that follows + if (!iscell (s1)), s1 = {s1}; endif + if (!iscell (s2)), s2 = {s2}; endif + ## there's 2 hypothesis: + ## - arrays have same length (even if it's only one cell) + ## - arrays have different lengths (in which case, one will have a single cell) + if (numel (s1) == numel (s2)) + rval(idx) = cellfun (@get_sign, s1(idx), s2(idx)); + elseif (numel (s1) > 1) + rval(idx) = cellfun (@get_sign, s1(idx), s2(1)); + elseif (numel (s2) > 1) + rval(idx) = cellfun (@get_sign, s1(1), s2(idx)); + endif +endfunction + +function r = get_sign (s1, s2) + ## strings may have different lengths which kinda complicates things + ## in case the strings are of different size, we need to make them equal + ## If once "trimmed", the strings are equal, the "shortest" string is + ## considered smaller since the comparison is made by filling it with null + + ns1 = numel (s1); + ns2 = numel (s2); + nmin = min (ns1, ns2); + + ## if one of the strings is empty, we are already done + if (nmin == 0), r = sign (ns1 - ns2); return endif + + s = sign (s1(1:nmin) - s2(1:nmin)); + if (any (s)) + ## if there's any difference between this part of the two strings, get the + ## index of the first occurence and return its value + r = s(find (s != 0, 1)); + else + r = sign (ns1 - ns2); + endif +endfunction + +%!assert(cstrcmp("hello","hello"),0); +%!assert(cstrcmp("marry","marie"),+1); +%!assert(cstrcmp("Matlab","Octave"),-1); +%!assert(cstrcmp("Matlab",{"Octave","Scilab","Lush"}), [-1 -1 +1]); +%!assert(cstrcmp({"Octave","Scilab","Lush"},"Matlab"), [+1 +1 -1]); diff --git a/octave_packages/strings-1.1.0/doc-cache b/octave_packages/strings-1.1.0/doc-cache new file mode 100644 index 0000000..9b3becf --- /dev/null +++ b/octave_packages/strings-1.1.0/doc-cache @@ -0,0 +1,240 @@ +# Created by Octave 3.6.1, Sat Mar 17 00:02:04 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 6 +# name: +# type: sq_string +# elements: 1 +# length: 12 +base64decode + + +# name: +# type: sq_string +# elements: 1 +# length: 586 + -- Function File: RVAL = base64decode (CODE) + -- Function File: RVAL = base64decode (CODE, AS_STRING) + Convert a base64 CODE (a string of printable characters according + to RFC 2045) into the original ASCII data set of range 0-255. If + option AS_STRING is passed, the return value is converted into a + string. + + ##base64decode(base64encode('Hakuna Matata'),true) + base64decode('SGFrdW5hIE1hdGF0YQ==',true) + ##returns 'Hakuna Matata' + + See: http://www.ietf.org/rfc/rfc2045.txt + + See also: base64encode + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Convert a base64 CODE (a string of printable characters according to +RFC 2045) + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +base64encode + + +# name: +# type: sq_string +# elements: 1 +# length: 477 + -- Function File: Y = base64encode (X) + -- Function File: Y = base64encode (X, DO_RESHAPE) + Convert X into string of printable characters according to RFC + 2045. The input may be a string or a matrix of integers in the + range 0..255. If want the output in the 1-row of strings format, + pass the DO_RESHAPE argument as true. + + Example: + base64encode('Hakuna Matata',true) + ##returns 'SGFrdW5hIE1hdGF0YQ==' + + See also: base64decode + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 68 +Convert X into string of printable characters according to RFC 2045. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +cstrcmp + + +# name: +# type: sq_string +# elements: 1 +# length: 845 + -- Function File: RVAL = cstrcmp (S1, S2) + Compare strings S1 and S2 like the C function. + + Aside the difference to the return values, this function API is + exactly the same as Octave's `strcmp' and will accept cell arrays + as well. + + RVAL indicates the relationship between the strings: + * A value of 0 indicates that both strings are equal; + + * A value of +1 indicates that the first character that does + not match has a greater value in S1 than in S2. + + * A value of -1 indicates that the first character that does + not match has a match has a smaller value in S1 than in S2. + + cstrcmp("marry","marry") + => 0 + cstrcmp("marry","marri") + => +1 + cstrcmp("marri","marry") + => -1 + + See also: strcmp, strcmpi + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 +Compare strings S1 and S2 like the C function. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +editdistance + + +# name: +# type: sq_string +# elements: 1 +# length: 882 + -- Function File: [DIST,L] = editdistance (STRING1, STRING2, WEIGHTS) + Compute the Levenshtein edit distance between the strings STRING1 + and STRING2. This operation is symmetrical. + + The optional argument WEIGHTS specifies weights for the deletion, + matched, and insertion operations; by default it is set to +1, 0, + +1 respectively, so that a least editdistance means a closer match + between the two strings. This function implements the Levenshtein + edit distance as presented in Wikipedia article, accessed Nov + 2006. Also the levenshtein edit distance of a string with an empty + string is defined to be its length. + + The default return value is DIST the edit distance, and the other + return value L is the distance matrix. + + editdistance('marry','marie') + ##returns value +2 for the distance. + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 78 +Compute the Levenshtein edit distance between the strings STRING1 and +STRING2. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +strjoin + + +# name: +# type: sq_string +# elements: 1 +# length: 741 + -- Function File: RVAL = strjoin (PREFIXSTR, STRINGCELL) + -- Function File: RVAL = strjoin (PREFIXSTR, VARARGS) + Joins the strings in STRINGCELL with the PREFIXSTR like the + list-join function in Python; the second version allows usage with + variable number of arguments. Note that, if using cell-array as a + second argument, only 2 arguments are accepted. Also note that, + both the arguments are strings or containers of strings (cells). + + strjoin(' loves-> ','marie','amy','beth') + ##returns 'marie loves-> amy loves-> beth' + + strjoin('*',{'Octave','Scilab','Lush','Yorick'}) + ##returns 'Octave*Scilab*Lush*Yorick' + + See also: strcmp + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +Joins the strings in STRINGCELL with the PREFIXSTR like the list-join +function i + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +strsort + + +# name: +# type: sq_string +# elements: 1 +# length: 120 + -- Function File: [...] = strsort (...) + Overloads the sort function to operate on strings. + + See also: sort + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 50 +Overloads the sort function to operate on strings. + + + + + diff --git a/octave_packages/strings-1.1.0/editdistance.m b/octave_packages/strings-1.1.0/editdistance.m new file mode 100644 index 0000000..45269d8 --- /dev/null +++ b/octave_packages/strings-1.1.0/editdistance.m @@ -0,0 +1,79 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{dist},@var{L}] =} editdistance (@var{string1}, @var{string2}, @var{weights}) +## Compute the Levenshtein edit distance between the strings @var{string1} and +## @var{string2}. This operation is symmetrical. +## +## The optional argument @var{weights} specifies weights for the +## deletion, matched, and insertion operations; by default it is set to +## +1, 0, +1 respectively, so that a least editdistance means a +## closer match between the two strings. This function implements +## the Levenshtein edit distance as presented in Wikipedia article, +## accessed Nov 2006. Also the levenshtein edit distance of a string +## with an empty string is defined to be its length. +## +## The default return value is @var{dist} the edit distance, and +## the other return value @var{L} is the distance matrix. +## +## @example +## @group +## editdistance('marry','marie') +## ##returns value +2 for the distance. +## @end group +## @end example +## +## @end deftypefn + +function [dist, L] = editdistance (str1, str2, weights) + if(nargin < 2 || (nargin == 3 && length(weights) < 3) ) + print_usage(); + end + + L1=length(str1)+1; + L2=length(str2)+1; + L=zeros(L1,L2); + + if(nargin < 3) + g=+1;%insertion + m=+0;%match + d=+1;%deletion + else + g=weights(1); + m=weights(2); + d=weights(3); + end + + L(:,1)=[0:L1-1]'*g; + L(1,:)=[0:L2-1]*g; + + m4=0; + for idx=2:L1; + for idy=2:L2 + if(str1(idx-1)==str2(idy-1)) + score=m; + else + score=d; + end + m1=L(idx-1,idy-1) + score; + m2=L(idx-1,idy) + g; + m3=L(idx,idy-1) + g; + L(idx,idy)=min(m1,min(m2,m3)); + end + end + + dist=L(L1,L2); +endfunction diff --git a/octave_packages/strings-1.1.0/packinfo/.autoload b/octave_packages/strings-1.1.0/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/strings-1.1.0/packinfo/DESCRIPTION b/octave_packages/strings-1.1.0/packinfo/DESCRIPTION new file mode 100644 index 0000000..fc8891a --- /dev/null +++ b/octave_packages/strings-1.1.0/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: strings +Version: 1.1.0 +Date: 2012-03-16 +Author: various authors +Maintainer: Octave-Forge community +Title: String Handling. +Description: Additional manipulation functions +Depends: octave (>= 3.6.0) +Autoload: yes +BuildRequires: pcre-devel [Debian] libpcre3-dev +License: GPLv3+, modified BSD, public domain +Url: http://octave.sf.net diff --git a/octave_packages/strings-1.1.0/packinfo/INDEX b/octave_packages/strings-1.1.0/packinfo/INDEX new file mode 100644 index 0000000..cead476 --- /dev/null +++ b/octave_packages/strings-1.1.0/packinfo/INDEX @@ -0,0 +1,11 @@ +strings >> Strings +Search and replace + pcregexp +Operations + strsort + editdistance + cstrcmp + strjoin +Conversion + base64encode + base64decode diff --git a/octave_packages/strings-1.1.0/packinfo/NEWS b/octave_packages/strings-1.1.0/packinfo/NEWS new file mode 100644 index 0000000..58b51b9 --- /dev/null +++ b/octave_packages/strings-1.1.0/packinfo/NEWS @@ -0,0 +1,13 @@ +Summary of important user-visible changes for string 1.1.0: +------------------------------------------------------------------- + + ** The following functions have been removed since they are part + of Octave core since 3.6.0: + + strtrim + + ** Package is no longer automatically loaded. + + ** The function `cstrcmp' has been completely rewritten. It should + perform faster and will accept arguments exactly the same way as + Octave's core `strcmp'. diff --git a/octave_packages/strings-1.1.0/strjoin.m b/octave_packages/strings-1.1.0/strjoin.m new file mode 100644 index 0000000..aaf6a42 --- /dev/null +++ b/octave_packages/strings-1.1.0/strjoin.m @@ -0,0 +1,54 @@ +## Copyright (C) 2007 Muthiah Annamalai +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{rval} =} strjoin (@var{prefixstr}, @var{stringcell}) +## @deftypefnx {Function File} {@var{rval} =} strjoin (@var{prefixstr}, @var{varargs}) +## Joins the strings in @var{stringcell} with the @var{prefixstr} like the list-join +## function in Python; the second version allows usage with variable number of arguments. +## Note that, if using cell-array as a second argument, only 2 arguments are accepted. +## Also note that, both the arguments are strings or containers of strings (cells). +## +## @example +## @group +## strjoin(' loves-> ','marie','amy','beth') +## ##returns 'marie loves-> amy loves-> beth' +## +## strjoin('*',@{'Octave','Scilab','Lush','Yorick'@}) +## ##returns 'Octave*Scilab*Lush*Yorick' +## @end group +## @end example +## @seealso {strcmp} +## @end deftypefn + +function rval = strjoin (spacer, varargin) + if (nargin < 2) || (nargin > 2 && iscell(varargin{1}) ) + print_usage(); + end + + if iscell(varargin{1}) + varargin=varargin{1}; + end + + rval=""; + L=length(varargin); + for idx=1:(L-1) + rval=strcat(rval,sprintf('%s%s',varargin{idx},spacer)); + end + rval=strcat(rval,varargin{L}); +endfunction + +%!assert(strjoin("-","hello"),"hello") +%!assert(strjoin('*',{'Octave','Scilab','Lush','Yorick'}),'Octave*Scilab*Lush*Yorick') diff --git a/octave_packages/strings-1.1.0/strsort.m b/octave_packages/strings-1.1.0/strsort.m new file mode 100644 index 0000000..450f2ba --- /dev/null +++ b/octave_packages/strings-1.1.0/strsort.m @@ -0,0 +1,19 @@ +## Author: Paul Kienzle +## This program is granted to the public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@dots{}] =} strsort (@dots{}) +## Overloads the sort function to operate on strings. +## +## @seealso {sort} +## @end deftypefn + +# PKG_ADD dispatch ("sort", "strsort", "string") +function [sorted,idx] = strsort(string,varargin) + if nargout == 2 + [s,idx] = sort(toascii(string),varargin{:}); + else + s = sort(toascii(string),varargin{:}); + endif + sorted = char(s); +endfunction diff --git a/octave_packages/struct-1.0.10/doc-cache b/octave_packages/struct-1.0.10/doc-cache new file mode 100644 index 0000000..6382000 --- /dev/null +++ b/octave_packages/struct-1.0.10/doc-cache @@ -0,0 +1,117 @@ +# Created by Octave 3.6.1, Sat May 26 20:16:56 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 4 +# name: +# type: sq_string +# elements: 1 +# length: 9 +getfields + + +# name: +# type: sq_string +# elements: 1 +# length: 239 + -- Built-in Function: [V1,...] = + getfields (S, 'k1',...) = [S.k1,...] Return selected values from + a scalar struct. Provides some compatibility and some flexibility. + + See also: setfields, rmfield, isfield, isstruct, struct + + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +getfields (S, 'k1',. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +setfields + + +# name: +# type: sq_string +# elements: 1 +# length: 255 + -- Function File: S = setfields(S,KEY,VALUE,...) + Sets S.KEY1 = VALUE1, S.KEY2 = VALUE2, etc, finally returning s. + For some compatibility and flexibility. + + See also: cmpstruct, fields, rmfield, isstruct, getfields, + isfield, struct + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +Sets S. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +tars + + +# name: +# type: sq_string +# elements: 1 +# length: 200 + s = tars (foo,bar, ... ) == struct ("foo",foo,"bar",bar,...) + + Groups foo, bar, ... into a struct whose fields are "foo", "bar" ... + and such that s.foo == foo, s.bar == bar ... + + See also : untar + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 + s = tars (foo,bar, . + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +test_struct + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + EOF my test function ############### + + + +# name: +# type: sq_string +# elements: 1 +# length: 38 + EOF my test function ############### + + + + + + diff --git a/octave_packages/struct-1.0.10/getfields.m b/octave_packages/struct-1.0.10/getfields.m new file mode 100644 index 0000000..705f3fd --- /dev/null +++ b/octave_packages/struct-1.0.10/getfields.m @@ -0,0 +1,39 @@ +## Copyright (C) 2000 Etienne Grossmann +## Copyright (C) 2012 Olaf Till +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Built-in Function} {} [@var{v1},...] = +## getfields (@var{s}, 'k1',...) = [@var{s}.k1,...] +## Return selected values from a scalar struct. Provides some +## compatibility and some flexibility. +## @end deftypefn +## @seealso{setfields,rmfield,isfield,isstruct,struct} + +function [varargout] = getfields (s, varargin) + + if (! all (isfield (s, varargin))) + error ("some fields not present"); + endif + + if (all (size (s) <= 1)) + varargout = fields2cell (s, varargin); + else + error ("structure must be scalar or empty"); + endif + +endfunction + +%!assert (getfields (struct ('key', 'value'), 'key'), 'value'); diff --git a/octave_packages/struct-1.0.10/packinfo/.autoload b/octave_packages/struct-1.0.10/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/struct-1.0.10/packinfo/DESCRIPTION b/octave_packages/struct-1.0.10/packinfo/DESCRIPTION new file mode 100644 index 0000000..a3e8f52 --- /dev/null +++ b/octave_packages/struct-1.0.10/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: Struct +Version: 1.0.10 +Date: 2012-05-24 +Author: Etienne Grossmann , Olaf Till +Maintainer: Olaf Till +Title: Structure Handling. +Description: Additional Structure manipulations functions. +Categories: Structs +Depends: octave (>= 2.9.7) +Autoload: yes +License: GPLv3+ +Url: http://octave.sf.net diff --git a/octave_packages/struct-1.0.10/packinfo/INDEX b/octave_packages/struct-1.0.10/packinfo/INDEX new file mode 100644 index 0000000..82a4922 --- /dev/null +++ b/octave_packages/struct-1.0.10/packinfo/INDEX @@ -0,0 +1,11 @@ +struct >> Structure Handling +Structure handling + getfields + setfields + tars + fields2cell + cell2fields + fieldempty + structcat +Tests + test_struct \ No newline at end of file diff --git a/octave_packages/struct-1.0.10/packinfo/NEWS b/octave_packages/struct-1.0.10/packinfo/NEWS new file mode 100644 index 0000000..a8243e7 --- /dev/null +++ b/octave_packages/struct-1.0.10/packinfo/NEWS @@ -0,0 +1,7 @@ +Summary of important user-visible changes for struct 1.0.10: +------------------------------------------------------------------- + + ** The function `arefields' has been removed in favour of the octave + core function `isfield'. + + ** Package is no longer automatically loaded. diff --git a/octave_packages/struct-1.0.10/setfields.m b/octave_packages/struct-1.0.10/setfields.m new file mode 100644 index 0000000..a6d90a2 --- /dev/null +++ b/octave_packages/struct-1.0.10/setfields.m @@ -0,0 +1,47 @@ +## Copyright (C) 2000 Etienne Grossmann +## Copyright (C) 2000 Paul Kienzle +## Copyright (C) 2012 Olaf Till +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## -*- texinfo -*- +## @deftypefn {Function File} {} @var{s} = setfields(@var{s},@var{key},@var{value},...) +## Sets @var{s}.@var{key1} = @var{value1}, @var{s}.@var{key2} = @var{value2}, etc, finally +## returning s. +## For some compatibility and flexibility. +## @seealso{cmpstruct, fields, rmfield, isstruct, getfields, isfield,struct} +## @end deftypefn + +function s = setfields (s, varargin) + + if ((nargs = nargin ()) == 0) + s = struct (); + elseif (all (size (s) <= 1)) + if (rem (nargs, 2)) + pairs = reshape (varargin, 2, []); + if (! iscellstr (pairs(1, :))) + error ("setfields: called with non-string key"); + endif + if (isempty (s)) + s = struct (); # might have been an empty array + endif + s = cell2fields (pairs(2, :), pairs(1, :), 2, s); + else + error ("setfields: expected struct, key1, val1, key2, val2, ..."); + endif + else + error ("structure must be scalar or empty"); + endif + +%!assert (setfields ({}, 'key', 'value'), struct ('key', 'value')); diff --git a/octave_packages/struct-1.0.10/tars.m b/octave_packages/struct-1.0.10/tars.m new file mode 100644 index 0000000..32b12a8 --- /dev/null +++ b/octave_packages/struct-1.0.10/tars.m @@ -0,0 +1,28 @@ +## Copyright (C) 2000 Etienne Grossmann +## Copyright (C) 2012 Olaf Till +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = tars (foo,bar, ... ) == struct ("foo",foo,"bar",bar,...) +## +## Groups foo, bar, ... into a struct whose fields are "foo", "bar" ... +## and such that s.foo == foo, s.bar == bar ... +## +## See also : untar + +function s = tars (varargin) + + s = cell2struct (varargin, deblank (cellstr (argn)), 2); + +endfunction diff --git a/octave_packages/struct-1.0.10/test_struct.m b/octave_packages/struct-1.0.10/test_struct.m new file mode 100644 index 0000000..6a147ff --- /dev/null +++ b/octave_packages/struct-1.0.10/test_struct.m @@ -0,0 +1,133 @@ +## Copyright (C) 2000 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## errors = test_struct +## +## Test whether struct functions behave, and returns the number of errors. +## +## Sets the global variables test_struct_errors (number of errors) +## and test_struct_cnt (number of tests) +## +## If a workspace variable 'verbose' is set to -1 the output is verbose. +## If it is set to 1, output is minimal (error and test counts). +## Otherwise, each error is reported with a short message and the error and ... +## test counts are displayed at the end of the script (if it is reached). +## + +1 ; +global test_struct_errors ; +global test_struct_cnt ; +test_struct_verbose = test_struct_errors = test_struct_cnt = 0 ; + +if ! exist ("verbose"), verbose = 0; end +if exist ("verbose") && ! isglobal ("verbose") + tmp = verbose; + global verbose = tmp; +end + +function mytest( val, tag ) # My test function ################### + +global test_struct_cnt ; +global test_struct_errors ; +global verbose ; + +% if ! exist("test_struct_verbose"), test_struct_verbose = 0 ; end + +if val , + if verbose + printf("OK %i\n",test_struct_cnt) ; + end +else + if verbose + printf("NOT OK %-4i : %s\n",test_struct_cnt,tag) ; + end + test_struct_errors++ ; +end +test_struct_cnt++ ; +endfunction # EOF my test function ############### + + + + +s.hello = 1 ; +s.world = 2 ; +mytest( isstruct(s) , "isstruct" ) ; +mytest( s.hello == getfields(s,"hello"), "getfields 1" ) ; +mytest( s.world == getfields(s,"world"), "getfields 2" ) ; + +t = struct ("hello",1,"world",2) ; +mytest( t.hello == s.hello , "struct 1" ) ; +mytest( t.world == s.world , "struct 2" ) ; + +s.foo = "bar" ; +s.bye = "ciao" ; +t = setfields (t,"foo","bar","bye","ciao") ; +mytest( t.foo == s.foo , "setfields 1" ) ; +mytest( t.bye == s.bye , "setfields 2" ) ; + +% s = struct() ; +% t = rmfield (t,"foo","bye","hello") ; % no longer works with octave func +t = rmfield( t, "foo"); +t = rmfield( t, "bye"); +t = rmfield( t, "hello"); +mytest( ! isfield(t,"foo") , "rmfield 1" ) ; +mytest( ! isfield(t,"bye") , "rmfield 2" ) ; +mytest( ! isfield(t,"hello") , "rmfield 3" ) ; +mytest( t.world == s.world , "rmfield 4" ) ; + + + # Test tars, getfield +x = 2 ; y = 3 ; z = "foo" ; +s = tars (x,y,z); + +mytest( x == s.x , "tars 1" ); +mytest( y == s.y , "tars 2" ); +mytest( z == s.z , "tars 3" ); + +a = "x" ; b = "y" ; +[xx,yy,zz] = getfields (s,a,b,"z") ; + +mytest( x == xx , "getfields 1" ); +mytest( y == yy , "getfields 2" ); +mytest( z == zz , "getfields 3" ); + +[x3,z3,z4] = getfields (s,"x","z","z") ; +mytest( x == x3 , "getfields 4" ); +mytest( z == z3 , "getfields 5" ); +mytest( z == z4 , "getfields 6" ); + +## Broken +##oo(1,1).f0= 1; +##oo= setfield(oo,{1,2},'fd',{3},'b', 6); +##mytest( getfield(oo,{1,2},'fd',{3},'b') == 6, "getfield 6" ); + +try # Should not return inexistent fields + [nothing] = getfields (s,"foo"); + found_nothing = 0; +catch + found_nothing = 1; +end +mytest( found_nothing , "getfields 4" ); + + +ok = test_struct_errors == 0; +if verbose + if ok + printf ("All %d tests ok\n", test_struct_cnt); + else + printf("There were %d errors in of %d tests\n",... + test_struct_errors,test_struct_cnt) ; + end +end diff --git a/octave_packages/symbolic-1.1.0/doc-cache b/octave_packages/symbolic-1.1.0/doc-cache new file mode 100644 index 0000000..b731b26 --- /dev/null +++ b/octave_packages/symbolic-1.1.0/doc-cache @@ -0,0 +1,214 @@ +# Created by Octave 3.6.1, Tue Mar 20 21:13:35 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 5 +# name: +# type: sq_string +# elements: 1 +# length: 7 +findsym + + +# name: +# type: sq_string +# elements: 1 +# length: 527 + -- Function File: VARS = findsym (F, N) + Find symbols in expression F and return them comma-separated in + string VARS. The symbols are sorted in alphabetic order. If N is + specified, the N symbols closest to "x" are returned. + + Example: + symbols + x = sym ("x"); + y = sym ("y"); + f = x^2+3*x*y-y^2; + vars = findsym (f); + vars2 = findsym (f,1); + + This is intended for m****b compatibility, calls findsymbols(). + + See also: findsymbols + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 76 +Find symbols in expression F and return them comma-separated in string +VARS. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +poly2sym + + +# name: +# type: sq_string +# elements: 1 +# length: 601 + -- Function File: P = poly2sym (C, X) + Creates a symbolic polynomial expression P with coefficients C. + If P is not specified, the free variable is set to sym("x"). C may + be a vector or a cell-array of symbols. X may be a symbolic + expression or a string. The coefficients correspond to decreasing + exponent of the free variable. + + Example: + symbols + x = sym("x"); + y = sym("y"); + p = poly2sym ([2,5,-3]); # p = 2*x^2+5*x-3 + c = poly2sym ({2*y,5,-3},x); # p = 2*y*x^2+5*x-3 + + See also: sym2poly, polyval, roots + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 +Creates a symbolic polynomial expression P with coefficients C. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +splot + + +# name: +# type: sq_string +# elements: 1 +# length: 85 + -- Function File: splot (F,X,RANGE) + Plot a symbolic function f(x) over range. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 +Plot a symbolic function f(x) over range. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +sym2poly + + +# name: +# type: sq_string +# elements: 1 +# length: 766 + -- Function File: C = sym2poly (P, X) + Returns the coefficients of the symbolic polynomial expression P + as a vector. If there is only one free variable in P the + coefficient vector C is a plain numeric vector. If there is more + than one free variable in P, a second argument X specifies the + free variable and the function returns a cell vector of symbolic + expressions. The coefficients correspond to decreasing exponent + of the free variable. + + Example: + symbols + x = sym("x"); + y = sym("y"); + c = sym2poly (x^2+3*x-4); # c = [1,3,-4] + c = sym2poly (x^2+y*x,x); # c = {2,y,0} + + If P is not a polynomial the result has no warranty. + + See also: poly2sym, polyval, roots + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 77 +Returns the coefficients of the symbolic polynomial expression P as a +vector. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +symfsolve + + +# name: +# type: sq_string +# elements: 1 +# length: 1284 + -- Function File: [X, INF, MSG] = symfsolve (...) + Solve a set of symbolic equations using `fsolve'. There are a + number of ways in which this function can be called. + + This solves for all free variables, initial values set to 0: + + symbols + x=sym("x"); y=sym("y"); + f=x^2+3*x-1; g=x*y-y^2+3; + a = symfsolve(f,g); + + This solves for x and y and sets the initial values to 1 and 5 + respectively: + + a = symfsolve(f,g,x,1,y,5); + a = symfsolve(f,g,{x==1,y==5}); + a = symfsolve(f,g,[1 5]); + + In all the previous examples vector a holds the results: x=a(1), + y=a(2). If initial conditions are specified with variables, the + latter determine output order: + + a = symfsolve(f,g,{y==1,x==2}); # here y=a(1), x=a(2) + + The system of equations to solve for can be given as separate + arguments or as a single cell-array: + + a = symfsolve({f,g},{y==1,x==2}); # here y=a(1), x=a(2) + + If the variables are not specified explicitly with the initial + conditions, they are placed in alphabetic order. The system of + equations can be comma- separated or given in a cell-array. The + return-values are those of fsolve; X holds the found roots. + + See also: fsolve + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Solve a set of symbolic equations using `fsolve'. + + + + + diff --git a/octave_packages/symbolic-1.1.0/findsym.m b/octave_packages/symbolic-1.1.0/findsym.m new file mode 100644 index 0000000..8347262 --- /dev/null +++ b/octave_packages/symbolic-1.1.0/findsym.m @@ -0,0 +1,92 @@ +## Copyright (C) 2003 Willem J. Atsma +## +## 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, or (at your option) any later version. +## +## This software is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied +## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +## PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public +## License along with this software; see the file COPYING. If not, +## see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{vars} =} findsym (@var{f}, @var{n}) +## Find symbols in expression @var{f} and return them comma-separated in +## string @var{vars}. The symbols are sorted in alphabetic order. If @var{n} +## is specified, the @var{n} symbols closest to "x" are returned. +## +## Example: +## @example +## symbols +## x = sym ("x"); +## y = sym ("y"); +## f = x^2+3*x*y-y^2; +## vars = findsym (f); +## vars2 = findsym (f,1); +## @end example +## +## This is intended for m****b compatibility, calls findsymbols(). +## @seealso{findsymbols} +## @end deftypefn + +function VARS = findsym(F,Nout) + + symlist = findsymbols(F); + Nlist = length(symlist); + if Nlist==0 + warning("No symbols were found.") + VARS = ""; + return + endif + + if exist("Nout")!=1 + VARS = disp(symlist{1}); + for i=2:Nlist + VARS = [VARS "," disp(symlist{i})]; + endfor + return + else + ## If Nout is specified, sort anew from x. + symstrings = disp(symlist{1}); + for i=2:Nlist + symstrings = [symstrings ; disp(symlist{i})]; + endfor + + symasc = toascii(symstrings); + + if Nlist= 3.1.55) +Autoload: yes +License: GPL version 2 or later +Url: http://octave.sf.net diff --git a/octave_packages/symbolic-1.1.0/packinfo/INDEX b/octave_packages/symbolic-1.1.0/packinfo/INDEX new file mode 100644 index 0000000..6a62d4e --- /dev/null +++ b/octave_packages/symbolic-1.1.0/packinfo/INDEX @@ -0,0 +1,28 @@ +symbolic >> Symbolic algebra +Symbols + symbols sym + ex_matrix Pi +Extended precision arithmetic + digits + vpa to_double +Properties + is_ex is_ex_matrix is_sym is_vpa syminfo +Expression manipulation + subs collect expand lcoeff numden findsymbols findsym +Special Functions + Abs Cos Cosh Exp Gcd Log Sin Sinh Tan Tanh aCos aCosh aSin aSinh + aTan aTanh Sqrt +Polynomials + tcoeff coeff degree ldegree sym2poly poly2sym sumterms +Calculus + differentiate +Solving Equations + symlsolve + symfsolve +Number theory + probably_prime + quotient remainder premainder +Plot + splot +Conversion + to_char diff --git a/octave_packages/symbolic-1.1.0/poly2sym.m b/octave_packages/symbolic-1.1.0/poly2sym.m new file mode 100644 index 0000000..ccf07fa --- /dev/null +++ b/octave_packages/symbolic-1.1.0/poly2sym.m @@ -0,0 +1,63 @@ +## Copyright (C) 2003 Willem J. Atsma +## +## 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, or (at your option) any later version. +## +## This software is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied +## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +## PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public +## License along with this software; see the file COPYING. If not, +## see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{p} =} poly2sym (@var{c}, @var{x}) +## Creates a symbolic polynomial expression @var{p} with coefficients @var{c}. +## If @var{p} is not specified, the free variable is set to sym("x"). @var{c} +## may be a vector or a cell-array of symbols. @var{x} may be a symbolic +## expression or a string. +## The coefficients correspond to decreasing exponent of the free variable. +## +## Example: +## @example +## symbols +## x = sym("x"); +## y = sym("y"); +## p = poly2sym ([2,5,-3]); # p = 2*x^2+5*x-3 +## c = poly2sym (@{2*y,5,-3@},x); # p = 2*y*x^2+5*x-3 +## @end example +## +## @seealso{sym2poly,polyval,roots} +## @end deftypefn + +function p = poly2sym(c,x) + + if exist("x")!=1 + x = sym("x"); + endif + + N = length(c); + + if !iscell(c) + tmp = c; + c = cell; + for i=1:N + c(i) = tmp(i); + endfor + endif + + p = vpa(0); + for i=1:N + if isnumeric(c{i}) + p = p*x+vpa(c{i}); + else + p = p*x+c{i}; + endif + endfor + +endfunction diff --git a/octave_packages/symbolic-1.1.0/splot.m b/octave_packages/symbolic-1.1.0/splot.m new file mode 100644 index 0000000..2a63f2c --- /dev/null +++ b/octave_packages/symbolic-1.1.0/splot.m @@ -0,0 +1,32 @@ +## Copyright (C) 2002 Ben Sapp +## +## 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} splot(@var{f},@var{x},@var{range}) +## Plot a symbolic function f(x) over range. +## @end deftypefn + +function splot(expression,symbol,range) + ## we should be a little smarter about this + t = linspace(min(range),max(range),400); + x = zeros(size(t)); + j = 1; + for i = t + x(j) = to_double(subs(expression,symbol,vpa(t(j)))); + j++; + endfor + + plot(t,x); +endfunction diff --git a/octave_packages/symbolic-1.1.0/sym2poly.m b/octave_packages/symbolic-1.1.0/sym2poly.m new file mode 100644 index 0000000..276026e --- /dev/null +++ b/octave_packages/symbolic-1.1.0/sym2poly.m @@ -0,0 +1,157 @@ +## Copyright (C) 2003 Willem J. Atsma +## +## 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, or (at your option) any later version. +## +## This software is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied +## warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +## PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public +## License along with this software; see the file COPYING. If not, +## see . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{c} =} sym2poly (@var{p}, @var{x}) +## Returns the coefficients of the symbolic polynomial expression @var{p} +## as a vector. If there is only one free variable in @var{p} the +## coefficient vector @var{c} is a plain numeric vector. If there is more +## than one free variable in @var{p}, a second argument @var{x} specifies the +## free variable and the function returns a cell vector of symbolic expressions. +## The coefficients correspond to decreasing exponent of the free variable. +## +## Example: +## @example +## symbols +## x = sym("x"); +## y = sym("y"); +## c = sym2poly (x^2+3*x-4); # c = [1,3,-4] +## c = sym2poly (x^2+y*x,x); # c = @{2,y,0@} +## @end example +## +## If @var{p} is not a polynomial the result has no warranty. +## +## @seealso{poly2sym,polyval,roots} +## @end deftypefn + +## Created: 18 April 2003 +## Changed: 25 April 2003 +## Removed the use of differentiate to get to coefficients - round-off +## errors cause problems. Now using newly created sumterms(). +## Changed: 6 May 2003 +## Removed the attempt to use ldegree(), degree() and coeff() - results +## with these are inconsistent. + +function c = sym2poly(p,x) + + BADPOLY_COEFF_LIMIT = 500; + + if is_vpa(p) + ## polynomial is one vpa number + c = to_double(p); + if length(c)!=1 + error("Argument is not a polynomial."); + endif + return + endif + + if !is_ex(p) + error("Argument has to be a symbolic expression.") + endif + + pvars = findsymbols(p); + if isempty(pvars) + ## It is possible that we get an expression without any symbols. + c = to_double(p); + return; + endif + nvars = length(pvars); + + if nvars>1 && exist("x")!=1 + error("Symbolic expression has more than 1 free variable; no variable specified.") + elseif exist("x")!=1 + x = pvars{1}; + endif + + p = expand(p); + + ## GiNaC has commands to access coefficients directly, but in octave this often + ## does not work, because for example x^2 typed in octave results in a + ## non-integer power in GiNaC: x^2.0 . + + [num,den] = numden(p); + tmp = findsymbols(den); + for i=1:length(tmp) + if tmp{i}==x + error("Symbolic expression is a ratio of polynomials.") + endif + endfor + + p = expand(p); + p_terms = sumterms(p); + ## if this is well behaved, I can find the coefficients by dividing with x + c_ex = cell; + for i=1:length(p_terms) + tmp = p_terms{i}; + for j=1:BADPOLY_COEFF_LIMIT + if disp(differentiate(tmp,x))=="0" + break; + endif + tmp = tmp/x; + endfor + if j==BADPOLY_COEFF_LIMIT + printf("Please examine your code or adjust this function.\n"); + printf("This error may occur because the passed expression is not a polynomial.\n"); + error("Reached the set limit (%d) for the number of coefficients.",BADPOLY_COEFF_LIMIT) + endif + if (length(c_ex) +## +## 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}, @var{inf}, @var{msg}] =} symfsolve (@dots{}) +## Solve a set of symbolic equations using @command{fsolve}. There are a number of +## ways in which this function can be called. +## +## This solves for all free variables, initial values set to 0: +## +## @example +## symbols +## x=sym("x"); y=sym("y"); +## f=x^2+3*x-1; g=x*y-y^2+3; +## a = symfsolve(f,g); +## @end example +## +## This solves for x and y and sets the initial values to 1 and 5 respectively: +## +## @example +## a = symfsolve(f,g,x,1,y,5); +## a = symfsolve(f,g,@{x==1,y==5@}); +## a = symfsolve(f,g,[1 5]); +## @end example +## +## In all the previous examples vector a holds the results: x=a(1), y=a(2). +## If initial conditions are specified with variables, the latter determine +## output order: +## +## @example +## a = symfsolve(f,g,@{y==1,x==2@}); # here y=a(1), x=a(2) +## @end example +## +## The system of equations to solve for can be given as separate arguments or +## as a single cell-array: +## +## @example +## a = symfsolve(@{f,g@},@{y==1,x==2@}); # here y=a(1), x=a(2) +## @end example +## +## If the variables are not specified explicitly with the initial conditions, +## they are placed in alphabetic order. The system of equations can be comma- +## separated or given in a cell-array. The return-values are those of +## fsolve; @var{x} holds the found roots. +## @end deftypefn +## @seealso{fsolve} + +function [ x,inf,msg ] = symfsolve (varargin) + + ## separate variables and equations + eqns = cell(); + vars = cell(); + + if iscell(varargin{1}) + if !strcmp(typeinfo(varargin{1}{1}),"ex") + error("First argument must be (a cell-array of) symbolic expressions.") + endif + eqns = varargin{1}; + arg_count = 1; + else + arg_count = 0; + for i=1:nargin + tmp = disp(varargin{i}); + if( iscell(varargin{i}) || ... + all(isalnum(tmp) || tmp=="_" || tmp==",") || ... + !strcmp(typeinfo(varargin{i}),"ex") ) + break; + endif + eqns{end+1} = varargin{i}; + arg_count = arg_count+1; + endfor + endif + neqns = length(eqns); + if neqns==0 + error("No equations specified.") + endif + + ## make a list with all variables from equations + tmp=eqns{1}; + for i=2:neqns + tmp = tmp+eqns{i}; + endfor + evars = findsymbols(tmp); + nevars=length(evars); + + ## After the equations may follow initial values. The formats are: + ## [0 0.3 -3 ...] + ## x,0,y,0.3,z,-3,... + ## {x==0, y==0.3, z==-3 ...} + ## none - default of al zero initial values + + if arg_count==nargin + vars = evars; + nvars = nevars; + X0 = zeros(nvars,1); + elseif (nargin-arg_count)>1 + if mod(nargin-arg_count,2) + error("Initial value symbol-value pairs don't match up.") + endif + for i=(arg_count+1):2:nargin + tmp = disp(varargin{i}); + if all(isalnum(tmp) | tmp=="_" | tmp==",") + vars{end+1} = varargin{i}; + X0((i-arg_count+1)/2)=varargin{i+1}; + else + error("Error in symbol-value pair arguments.") + endif + endfor + nvars = length(vars); + else + nvars = length(varargin{arg_count+1}); + if nvars!=nevars + error("The number of initial conditions does not match the number of free variables.") + endif + if iscell(varargin{arg_count+1}) + ## cell-array of relations - this should work for a list of strings ("x==3") too. + for i=1:nvars + tmp = disp(varargin{arg_count+1}{i}); + vars{end+1} = {sym(strtok(tmp,"=="))}; + X0(i) = str2num(tmp((findstr(tmp,"==")+2):length(tmp))); + endfor + else + ## straight numbers, match up with symbols in alphabetic order + vars = evars; + X0 = varargin{arg_count+1}; + endif + endif + + ## X0 is now a vector, vars a list of variables. + ## create temporary function: + symfn = sprintf("function Y=symfn(X) "); + for i=1:nvars + symfn = [symfn sprintf("%s=X(%d); ",disp(vars{i}),i)]; + endfor + for i=1:neqns + symfn = [symfn sprintf("Y(%d)=%s; ",i,disp(eqns{i}))]; + endfor + symfn = [symfn sprintf("endfunction")]; + + eval(symfn); + [x,inf,msg] = fsolve("symfn",X0); + +endfunction + +%!shared +% x = sym ("x"); +% y = sym ("y"); +% f = x ^ 2 + 3 * x - 1; +% g = x * y - y ^ 2 + 3; +%!test +% assert (symfsolve (f, g), [0.30278; -1.58727]', 1e-5); +%!test +% assert (symfsolve (f, g, x, 1, y, 5), [0.30278; 1.89004]', 1e-5); +%!test +% assert (symfsolve (f, g, {x==1,y==5}), [0.30278; 1.89004]', 1e-5); +%!test +% assert (symfsolve (f, g, [1 5]), [0.30278; 1.89004]', 1e-5); +%!test +% assert (symfsolve ({f, g}, {y==1,x==2}), [1.89004; 0.30278]', 1e-5); diff --git a/octave_packages/tsa-4.2.4/aar.m b/octave_packages/tsa-4.2.4/aar.m new file mode 100644 index 0000000..8f5d2a2 --- /dev/null +++ b/octave_packages/tsa-4.2.4/aar.m @@ -0,0 +1,292 @@ +function [a,e,REV,TOC,CPUTIME,ESU] = aar(y, Mode, arg3, arg4, arg5, arg6, arg7, arg8, arg9); +% Calculates adaptive autoregressive (AAR) and adaptive autoregressive moving average estimates (AARMA) +% of real-valued data series using Kalman filter algorithm. +% [a,e,REV] = aar(y, mode, MOP, UC, a0, A, W, V); +% +% The AAR process is described as following +% y(k) - a(k,1)*y(t-1) -...- a(k,p)*y(t-p) = e(k); +% The AARMA process is described as following +% y(k) - a(k,1)*y(t-1) -...- a(k,p)*y(t-p) = e(k) + b(k,1)*e(t-1) + ... + b(k,q)*e(t-q); +% +% Input: +% y Signal (AR-Process) +% Mode is a two-element vector [aMode, vMode], +% aMode determines 1 (out of 12) methods for updating the co-variance matrix (see also [1]) +% vMode determines 1 (out of 7) methods for estimating the innovation variance (see also [1]) +% aMode=1, vmode=2 is the RLS algorithm as used in [2] +% aMode=-1, LMS algorithm (signal normalized) +% aMode=-2, LMS algorithm with adaptive normalization +% +% MOP model order, default [10,0] +% MOP=[p] AAR(p) model. p AR parameters +% MOP=[p,q] AARMA(p,q) model, p AR parameters and q MA coefficients +% UC Update Coefficient, default 0 +% a0 Initial AAR parameters [a(0,1), a(0,2), ..., a(0,p),b(0,1),b(0,2), ..., b(0,q)] +% (row vector with p+q elements, default zeros(1,p) ) +% A Initial Covariance matrix (positive definite pxp-matrix, default eye(p)) +% W system noise (required for aMode==0) +% V observation noise (required for vMode==0) +% +% Output: +% a AAR(MA) estimates [a(k,1), a(k,2), ..., a(k,p),b(k,1),b(k,2), ..., b(k,q] +% e error process (Adaptively filtered process) +% REV relative error variance MSE/MSY +% +% +% Hint: +% The mean square (prediction) error of different variants is useful for determining the free parameters (Mode, MOP, UC) +% +% REFERENCE(S): +% [1] A. Schloegl (2000), The electroencephalogram and the adaptive autoregressive model: theory and applications. +% ISBN 3-8265-7640-3 Shaker Verlag, Aachen, Germany. +% +% More references can be found at +% http://www.dpmi.tu-graz.ac.at/~schloegl/publications/ + +% +% $Id: aar.m 8383 2011-07-16 20:06:59Z schloegl $ +% Copyright (C) 1998-2003 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +[nc,nr]=size(y); +%if nc=2 p=MOP(1); q=MOP(2); MOP=p+q; +end; + +if nargin<4 UC=0; else UC= arg4; end; + +a0=zeros(1,MOP); +A0=eye(MOP); +if nargin>4, + if all(size(arg5)==([1,1]*(MOP+1))); % extended covariance matrix of AAR parameters + a0 = arg5(1,2:size(arg5,2)); + A0 = arg5(2:size(arg5,1),2:size(arg5,2)) - a0'*a0; + else + a0 = arg5; + if nargin>5 + A0 = arg6; + end; + end; +end; + +if nargin<7, W = []; else W = arg7; end; + +if all(size(W)==MOP), + if aMode ~= 0, + fprintf(1,'aMode should be 0, because W is given.\n'); + end; +elseif isempty(W), + if aMode == 0, + fprintf(1,'aMode must be non-zero, because W is not given.\n'); + end; +elseif any(size(W)~=MOP), + fprintf(1,'size of W does not fit. It must be %i x %i.\n',MOP,MOP); + return; +end; + +if nargin<8, V0 = []; else V0 = arg8; end; +if all(size(V0)==nr), + if vMode ~= 0, + fprintf(1,'vMode should be 0, because V is given.\n'); + end; +elseif isempty(V0), + if aMode == 0, + fprintf(1,'vMode must be non-zero, because V is not given.\n'); + end; +else + fprintf(1,'size of V does not fit. It must be 1x1.\n'); + return; +end; + +% if nargin<7 TH=3; else TH = arg7; end; +% TH=TH*var(y); +% TH=TH*mean(detrend(y,0).^2); +MSY=mean(detrend(y,0).^2); + +e=zeros(nc,1); +Q=zeros(nc,1); +V=zeros(nc,1); +T=zeros(nc,1); +%DET=zeros(nc,1); +SPUR=zeros(nc,1); +ESU=zeros(nc,1); +a=a0(ones(nc,1),:); +%a=zeros(nc,MOP); +%b=zeros(nc,q); + +mu=1-UC; % Patomaeki 1995 +lambda=(1-UC); % Schloegl 1996 +arc=poly((1-UC*2)*[1;1]);b0=sum(arc); % Whale forgettting factor for Mode=258,(Bianci et al. 1997) + +dW=UC/MOP*eye(MOP); % Schloegl + + +%------------------------------------------------ +% First Iteration +%------------------------------------------------ +Y=zeros(MOP,1); +C=zeros(MOP); +%X=zeros(q,1); +at=a0; +A=A0; +E=y(1); +e(1)=E; +if ~isempty(V0) + V(1) = V0; +else + V(1) = (1-UC) + UC*E*E; +end; +ESU(1) = 1; %Y'*A*Y; + +A1=zeros(MOP);A2=A1; +tic;CPUTIME=cputime; +%------------------------------------------------ +% Update Equations +%------------------------------------------------ +T0=2; + +for t=T0:nc, + + %Y=[y(t-1); Y(1:p-1); E ; Y(p+1:MOP-1)] + + if t<=p Y(1:t-1)=y(t-1:-1:1); % Autoregressive + else Y(1:p)=y(t-1:-1:t-p); + end; + + if t<=q Y(p+(1:t-1))=e(t-1:-1:1); % Moving Average + else Y(p+1:MOP)=e(t-1:-1:t-q); + end; + + % Prediction Error + E = y(t) - a(t-1,:)*Y; + e(t) = E; + E2=E*E; + + AY=A*Y; + esu=Y'*AY; + ESU(t)=esu; + + if isnan(E), + a(t,:)=a(t-1,:); + else + V(t) = V(t-1)*(1-UC)+UC*E2; + if aMode == -1, % LMS + % V(t) = V(t-1)*(1-UC)+UC*E2; + a(t,:)=a(t-1,:) + (UC/MSY)*E*Y'; + elseif aMode == -2, % LMS with adaptive estimation of the variance + a(t,:)=a(t-1,:) + UC/V(t)*E*Y'; + + else % Kalman filtering (including RLS) + if vMode==0, %eMode==4 + Q(t) = (esu + V0); + elseif vMode==1, %eMode==4 + Q(t) = (esu + V(t)); + elseif vMode==2, %eMode==2 + Q(t) = (esu + 1); + elseif vMode==3, %eMode==3 + Q(t) = (esu + lambda); + elseif vMode==4, %eMode==1 + Q(t) = (esu + V(t-1)); + elseif vMode==5, %eMode==6 + if E2>esu + V(t)=(1-UC)*V(t-1)+UC*(E2-esu); + else + V(t)=V(t-1); + end; + Q(t) = (esu + V(t)); + elseif vMode==6, %eMode==7 + if E2>esu + V(t)=(1-UC)*V(t-1)+UC*(E2-esu); + else + V(t)=V(t-1); + end; + Q(t) = (esu + V(t-1)); + elseif vMode==7, %eMode==8 + Q(t) = esu; + end; + + k = AY / Q(t); % Kalman Gain + a(t,:) = a(t-1,:) + k'*E; + + if aMode==0, %AMode=0 + A = A - k*AY' + W; % Schloegl et al. 2003 + elseif aMode==1, %AMode=1 + A = (1+UC)*(A - k*AY'); % Schloegl et al. 1997 + elseif aMode==2, %AMode=11 + A = A - k*AY'; + A = A + sum(diag(A))*dW; + elseif aMode==3, %AMode=5 + A = A - k*AY' + sum(diag(A))*dW; + elseif aMode==4, %AMode=6 + A = A - k*AY' + UC*eye(MOP); % Schloegl 1998 + elseif aMode==5, %AMode=2 + A = A - k*AY' + UC*UC*eye(MOP); + elseif aMode==6, %AMode=2 + T(t)=(1-UC)*T(t-1)+UC*(E2-Q(t))/(Y'*Y); + A=A*V(t-1)/Q(t); + if T(t)>0 A=A+T(t)*eye(MOP); end; + elseif aMode==7, %AMode=6 + T(t)=(1-UC)*T(t-1)+UC*(E2-Q(t))/(Y'*Y); + A=A*V(t)/Q(t); + if T(t)>0 A=A+T(t)*eye(MOP); end; + elseif aMode==8, %AMode=5 + Q_wo = (Y'*C*Y + V(t-1)); + C=A-k*AY'; + T(t)=(1-UC)*T(t-1)+UC*(E2-Q_wo)/(Y'*Y); + if T(t)>0 A=C+T(t)*eye(MOP); else A=C; end; + elseif aMode==9, %AMode=3 + A = A - (1+UC)*k*AY'; + A = A + sum(diag(A))*dW; + elseif aMode==10, %AMode=7 + A = A - (1+UC)*k*AY' + sum(diag(A))*dW; + elseif aMode==11, %AMode=8 + + A = A - (1+UC)*k*AY' + UC*eye(MOP); % Schloegl 1998 + elseif aMode==12, %AMode=4 + A = A - (1+UC)*k*AY' + UC*UC*eye(MOP); + elseif aMode==13 + A = A - k*AY' + UC*diag(diag(A)); + elseif aMode==14 + A = A - k*AY' + (UC*UC)*diag(diag(A)); + end; + end; + end; +end; + +%a=a(end,:); +TOC = toc; +CPUTIME = cputime - CPUTIME; +%REV = (e'*e)/(y'*y); + +REV = mean(e.*e)./mean(y.*y); diff --git a/octave_packages/tsa-4.2.4/aarmam.m b/octave_packages/tsa-4.2.4/aarmam.m new file mode 100644 index 0000000..a137ea8 --- /dev/null +++ b/octave_packages/tsa-4.2.4/aarmam.m @@ -0,0 +1,240 @@ +function [z,e,REV,ESU,V,Z,SPUR] = aarmam(y, Mode, MOP, UC, z0, Z0, V0, W); +% Estimating Adaptive AutoRegressive-Moving-Average-and-mean model (includes mean term) +% +% !! This function is obsolete and is replaced by AMARMA +% +% [z,E,REV,ESU,V,Z,SPUR] = aarmam(y, mode, MOP, UC, z0, Z0, V0, W); +% Estimates AAR parameters with Kalman filter algorithm +% y(t) = sum_i(a_i(t)*y(t-i)) + m(t) + e(t) + sum_i(b_i(t)*e(t-i)) +% +% State space model +% z(t) = G*z(t-1) + w(t) w(t)=N(0,W) +% y(t) = H*z(t) + v(t) v(t)=N(0,V) +% +% G = I, +% z = [m(t),a_1(t-1),..,a_p(t-p),b_1(t-1),...,b_q(t-q)]; +% H = [1,y(t-1),..,y(t-p),e(t-1),...,e(t-q)]; +% W = E{(z(t)-G*z(t-1))*(z(t)-G*z(t-1))'} +% V = E{(y(t)-H*z(t-1))*(y(t)-H*z(t-1))'} +% +% +% Input: +% y Signal (AR-Process) +% Mode determines the type of algorithm +% +% MOP Model order [m,p,q], default [0,10,0] +% m=1 includes the mean term, m=0 does not. +% p and q must be positive integers +% it is recommended to set q=0. +% UC Update Coefficient, default 0 +% z0 Initial state vector +% Z0 Initial Covariance matrix +% +% Output: +% z AR-Parameter +% E error process (Adaptively filtered process) +% REV relative error variance MSE/MSY +% +% REFERENCE(S): +% [1] A. Schloegl (2000), The electroencephalogram and the adaptive autoregressive model: theory and applications. +% ISBN 3-8265-7640-3 Shaker Verlag, Aachen, Germany. +% +% More references can be found at +% http://pub.ist.ac.at/~schloegl/publications/ + +% $Id: aarmam.m 9609 2012-02-10 10:18:00Z schloegl $ +% Copyright (C) 1998-2002,2008,2012 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://pub.ist.ac.at/~schloegl/matlab/tsa/ +% http://octave.sourceforge.net/ +% http://biosig.sourceforge.net/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +%#realonly +%#inbounds + +warning('AARMAM is obsolete. Use AMARMA instead!') + +[nc,nr]=size(y); + +if nargin<2 Mode=0; +elseif ischar(Mode) Mode=bin2dec(Mode); +elseif isnan(Mode) return; end; +if nargin<3 MOP=[0,10,0]; end; +if length(MOP)==0, m=0;p=10; q=0; MOP=p; +elseif length(MOP)==1, m=0;p=MOP(1); q=0; MOP=p; +elseif length(MOP)==2, fprintf(1,'Error AMARMA: MOP is ambiguos\n'); +elseif length(MOP)>2, m=MOP(1); p=MOP(2); q=MOP(3);MOP=m+p+q; +end; + +if prod(size(Mode))>1 + aMode=Mode(1); + eMode=Mode(2); +end; +%fprintf(1,['a' int2str(aMode) 'e' int2str(eMode) ' ']); + + +e=zeros(nc,1); +V=zeros(nc,1);V(1)=V0; +T=zeros(nc,1); +ESU=zeros(nc,1)+nan; +SPUR=zeros(nc,1)+nan; +z=z0(ones(nc,1),:); + +arc=poly((1-UC*2)*[1;1]);b0=sum(arc); % Whale forgetting factor for Mode=258,(Bianci et al. 1997) + +dW=UC/MOP*eye(MOP); % Schloegl + + +%------------------------------------------------ +% First Iteration +%------------------------------------------------ + +H = zeros(MOP,1); +if m, + H(1) = 1;%M0; + if m~=1, + fprintf(2,'Warning AARMAM: m must be 0 or 1\n'); + return; + end; +end; +if (p<0) || (q<0) || (round(p)~=p) || (round(q)~=q), + fprintf(2,'Error AARMAM: p and q must be positive integers\n'); + return; +end; + +E = 0; +Z = Z0; +zt= z0; + +A1 = zeros(MOP); A2 = A1; + +y_1=0; + +%------------------------------------------------ +% Update Equations +%------------------------------------------------ + +for t=1:nc, + + % make measurement matrix + if 0, + if t>1, + y_1 = y(t-1); + end; + H=[1; y_1; H(m+(1:p-1)'); E(1:min(1,q-1)) ; H(p+m+(1:q-1)')]; % shift y and e + + else % this seem to be slightly faster + if t<=p, H(m+(1:t-1)) = y(t-1:-1:1); % Autoregressive + else H(m+(1:p)) = y(t-1:-1:t-p); + end; + + if t<=q, H(m+p+(1:t-1)) = e(t-1:-1:1); % Moving Average + else H(m+p+(1:q)) = e(t-1:-1:t-q); + end; + end; + + % Prediction Error + E = y(t) - zt*H; + e(t) = E; + + if ~isnan(E), + E2 = E*E; + AY = Z*H; + + ESU(t) = H'*AY; + + if eMode==1 + V0 = V(t-1); + V(t) = V0*(1-UC)+UC*E2; + elseif eMode==2 + V0 = 1; + V(t) = V0; %V(t-1)*(1-UC)+UC*E2; + elseif eMode==3 + V0 = 1-UC; + V(t) = V0; %(t-1)*(1-UC)+UC*E2; + elseif eMode==4 + V0 = V0*(1-UC)+UC*E2; + V(t) = V0; + elseif eMode==5 + V(t)=V0; + %V0 = V0; + elseif eMode==6 + if E2>ESU(t), + V0=(1-UC)*V0+UC*(E2-ESU(t)); + end; + V(t)=V0; + elseif eMode==7 + V0=V(t); + if E2>ESU(t) + V(t) = (1-UC)*V0+UC*(E2-ESU(t)); + else + V(t) = V0; + end; + elseif eMode==8 + V0=0; + V(t) = V0; % (t-1)*(1-UC)+UC*E2; + end; + + k = AY / (ESU(t) + V0); % Kalman Gain + zt = zt + k'*E; + %z(t,:) = zt; + + if aMode==2 + T(t)=(1-UC)*T(t-1)+UC*(E2-Q(t))/(H'*H); % Roberts I 1998 + Z=Z*V(t-1)/Q(t); + if T(t)>0 W=T(t)*eye(MOP); else W=zeros(MOP);end; + elseif aMode==5 + Q_wo = (H'*C*H + V(t-1)); % Roberts II 1998 + T(t)=(1-UC)*T(t-1)+UC*(E2-Q_wo)/(H'*H); + if T(t)>0 W=T(t)*eye(MOP); else W=zeros(MOP); end; + elseif aMode==6 + T(t)=(1-UC)*T(t-1)+UC*(E2-Q(t))/(H'*H); + Z=Z*V(t)/Q(t); + if T(t)>0 W=T(t)*eye(MOP); else W=zeros(MOP); end; + elseif aMode==11 + %Z = Z - k*AY'; + W = sum(diag(Z))*dW; + elseif aMode==12 + W = UC*UC*eye(MOP); + elseif aMode==13 + W = UC*diag(diag(Z)); + elseif aMode==14 + W = (UC*UC)*diag(diag(Z)); + elseif aMode==15 + W = sum(diag(Z))*dW; + elseif aMode==16 + W = UC*eye(MOP); % Schloegl 1998 + %elseif aMode==17 + %W=W; + end; + + Z = Z - k*AY'; % Schloegl 1998 + else + + V(t) = V0; + + end; + + if any(any(isnan(W))), W=UC*Z;end; + + z(t,:) = zt; + Z = Z + W; % Schloegl 1998 + SPUR(t) = trace(Z); +end; + +REV = mean(e.*e)/mean(y.*y); +if any(~isfinite(Z(:))), REV=inf; end; + diff --git a/octave_packages/tsa-4.2.4/ac2poly.m b/octave_packages/tsa-4.2.4/ac2poly.m new file mode 100644 index 0000000..41ac9af --- /dev/null +++ b/octave_packages/tsa-4.2.4/ac2poly.m @@ -0,0 +1,40 @@ +function [A,E] = ac2poly(acf); +% converts the autocorrelation sequence into an AR polynomial +% [A,Efinal] = ac2poly(r) +% +% see also ACOVF ACORF AR2RC RC2AR DURLEV AC2POLY, POLY2RC, RC2POLY, RC2AC, AC2RC, POLY2AC +% + +% $Id: ac2poly.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +if all(size(acf))>1, + fprintf(2,'Error AC2POLY: "r" must be a vector\n'); + return; +end; + + +mfilename='AC2POLY'; +if ~exist('durlev','file') + fprintf(2,'Error %s: DURLEV.M not found. \n Download TSA toolbox from http://www.dpmi.tu-graz.ac.at/~schloegl/matlab/tsa/\n',mfilename); + return; +end; + +[AR,RC,PE] = durlev(acf); + +A = [ones(size(AR,1),1),-AR]; +E = PE(:,size(PE,2)); diff --git a/octave_packages/tsa-4.2.4/ac2rc.m b/octave_packages/tsa-4.2.4/ac2rc.m new file mode 100644 index 0000000..c62bbb6 --- /dev/null +++ b/octave_packages/tsa-4.2.4/ac2rc.m @@ -0,0 +1,39 @@ +function [RC,efinal] = ac2rc(AC); +% converts the autocorrelation function into reflection coefficients +% [RC,r0] = ac2rc(r) +% +% see also ACOVF ACORF AR2RC RC2AR DURLEV AC2POLY, POLY2RC, RC2POLY, RC2AC, AC2RC, POLY2AC +% + +% $Id: ac2rc.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + + +if all(size(AC))>1, + fprintf(2,'Error AC2RC: "r" must be a vector\n'); + return; +end; + +mfilename='AC2RC'; +if ~exist('durlev','file') + fprintf(2,'Error %s: DURLEV.M not found. \n Download TSA toolbox from http://www.dpmi.tu-graz.ac.at/~schloegl/matlab/tsa/\n',mfilename); + return; +end; + +[AR,RC,PE] = durlev(AC(:).'); +RC=-RC; +efinal=AC(1); diff --git a/octave_packages/tsa-4.2.4/acorf.m b/octave_packages/tsa-4.2.4/acorf.m new file mode 100644 index 0000000..7a11ca8 --- /dev/null +++ b/octave_packages/tsa-4.2.4/acorf.m @@ -0,0 +1,70 @@ +function [AUTOCOV,stderr,lpq,qpval] = acorf(Z,N); +% Calculates autocorrelations for multiple data series. +% Missing values in Z (NaN) are considered. +% Also calculates Ljung-Box Q stats and p-values. +% +% [AutoCorr,stderr,lpq,qpval] = acorf(Z,N); +% If mean should be removed use +% [AutoCorr,stderr,lpq,qpval] = acorf(detrend(Z',0)',N); +% If trend should be removed use +% [AutoCorr,stderr,lpq,qpval] = acorf(detrend(Z')',N); +% +% INPUT +% Z is data series for which autocorrelations are required +% each in a row +% N maximum lag +% +% OUTPUT +% AutoCorr nr x N matrix of autocorrelations +% stderr nr x N matrix of (approx) std errors +% lpq nr x M matrix of Ljung-Box Q stats +% qpval nr x N matrix of p-values on Q stats +% +% All input and output parameters are organized in rows, one row +% corresponds to one series +% +% REFERENCES: +% S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. +% J.S. Bendat and A.G.Persol "Random Data: Analysis and Measurement procedures", Wiley, 1986. + +% calculating lpq, stderr, qpval from +% suggested by Philip Gray, University of New South Wales, + +% $Id: acorf.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +[nr,nc] = size(Z); +NC = sum(~isnan(Z),2); % missing values + +AUTOCOV = acovf(Z,N); +AUTOCOV = AUTOCOV(:,2:N+1) ./ AUTOCOV(:,ones(1,N)); + +if nargout > 1 + stderr = sqrt(1./NC)*ones(1,N); + lpq = zeros(nr,N); + qpval = zeros(nr,N); + + cum=zeros(nr,1); + for k=1:N, + cum = cum+AUTOCOV(:,k).*conj(AUTOCOV(:,k))./(NC-k); + lpq(:,k) = NC.*(NC+2).*cum; % Ljung box Q for k lags + %qpval(:,k) = 1 - chi2cdf(lpq(:,k),k); % p-value of Q stat + qpval(:,k) = 1 - gammainc(lpq(:,k)/2,k/2); % replace chi2cdf by gammainc + end; +end; diff --git a/octave_packages/tsa-4.2.4/acovf.m b/octave_packages/tsa-4.2.4/acovf.m new file mode 100644 index 0000000..d89902d --- /dev/null +++ b/octave_packages/tsa-4.2.4/acovf.m @@ -0,0 +1,147 @@ +function [ACF,NN] = acovf(Z,KMAX,Mode,Mode2); +% ACOVF estimates autocovariance function (not normalized) +% NaN's are interpreted as missing values. +% +% [ACF,NN] = acovf(Z,MAXLAG,Mode); +% +% Input: +% Z Signal (one channel per row); +% MAXLAG maximum lag +% Mode 'biased' : normalizes with N [default] +% 'unbiased': normalizes with N-lag +% 'coeff' : normalizes such that lag 0 is 1 +% others : no normalization +% +% Output: +% ACF autocovariance function +% NN number of valid elements +% +% REFERENCES: +% A.V. Oppenheim and R.W. Schafer, Digital Signal Processing, Prentice-Hall, 1975. +% S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. +% J.S. Bendat and A.G.Persol "Random Data: Analysis and Measurement procedures", Wiley, 1986. + +% $Id: acovf.m 7687 2010-09-08 18:39:23Z schloegl $ +% Copyright (C) 1998-2003,2008,2010 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://biosig-consulting.com/matlab/tsa/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + + +if nargin<3, Mode='biased'; end; + +[lr,lc] = size(Z); + +MISSES = sum(isnan(Z)')'; +if any(MISSES); % missing values + M = real(~isnan(Z)); + Z(isnan(Z))=0; +end; + +if (nargin == 1) + KMAX = lc-1; +elseif (KMAX >= lc-1) + KMAX = lc-1; +end; + +ACF = zeros(lr,KMAX+1); + +if nargin>3, % for testing, use arg4 for comparing the methods, + +elseif (KMAX*KMAX > lc*log2(lc)) % & isempty(MISSES); + Mode2 = 1; +elseif (10*KMAX > lc); + Mode2 = 3; +else + Mode2 = 4; +end; + + +%%%%% ESTIMATION of non-normalized ACF %%%%% + +% the following algorithms gve equivalent results, however, the computational effort is different, +% depending on lr,lc and KMAX, a different algorithm is most efficient. +if Mode2==1; % KMAX*KMAX > lc*log(lc); % O(n.logn)+O(K²) + tmp = fft(Z',2^nextpow2(size(Z,2))*2); + tmp = ifft(tmp.*conj(tmp)); + ACF = tmp(1:KMAX+1,:)'; + if ~any(any(imag(Z))), ACF=real(ACF); end; % should not be neccessary, unfortunately it is. +elseif Mode2==3; % (10*KMAX > lc) % O(n*K) % use fast Built-in filter function + for L = 1:lr, + acf = filter(Z(L,lc:-1:1),1,Z(L,:)); + ACF(L,:)= acf(lc:-1:lc-KMAX); + end; +else Mode2==4; % O(n*K) + for L = 1:lr, + for K = 0:KMAX, + ACF(L,K+1) = Z(L,1:lc-K) * Z(L,1+K:lc)'; + end; + end; +end; + + +%%%%% GET number of elements used for estimating ACF - is needed for normalizing ACF %%%%% + +if any(MISSES), + % the following algorithms gve equivalent results, however, the computational effort is different, + % depending on lr,lc and KMAX, a different algorithm is most efficient. + if Mode2==1; % KMAX*KMAX > lc*log(lc); % O(n.logn)+O(K²) + tmp = fft(M',2^nextpow2(size(M,2))*2); + tmp = ifft(tmp.*conj(tmp)); + NN = tmp(1:KMAX+1,:)'; + if ~any(any(imag(M))), NN=real(NN); end; % should not be neccessary, unfortunately it is. + elseif Mode2==3; % (10*KMAX > lc) % O(n*K) % use fast Built-in filter function + for L = 1:lr, + acf = filter(M(L,lc:-1:1),1,M(L,:)); + NN(L,:)= acf(lc:-1:lc-KMAX); + end; + else Mode2==4; % O(n*K) + for L = 1:lr, + for K = 0:KMAX, + NN(L,K+1) = M(L,1:lc-K) * M(L,1+K:lc)'; + end; + end; + end; +else + NN = (ones(lr,1)*(lc:-1:lc-KMAX)); +end; + + +if strcmp(Mode,'biased') + if ~any(MISSES), + ACF=ACF/lc; + else + %ACF=ACF./((lc-MISSES)*ones(1,KMAX+1)); + ACF=ACF./max(NN + ones(lr,1)*(0:KMAX),0); + end; + +elseif strcmp(Mode,'unbiased') + ACF=ACF./NN; + %if ~any(MISSES), + % ACF=ACF./(ones(lr,1)*(lc:-1:lc-KMAX)); + %else + % ACF=ACF./((lc-MISSES)*ones(1,KMAX+1) - ones(lr,1)*(0:KMAX)); + %end; + +elseif strcmp(Mode,'coeff') + %ACF = ACF ./ ACF(:,ones(1,KMAX+1)) .* ((lc-MISSES)*ones(1,KMAX+1)); + ACF = ACF./NN; + ACF = ACF./(ACF(:,1)*ones(1,size(ACF,2))); +else + +end; diff --git a/octave_packages/tsa-4.2.4/adim.m b/octave_packages/tsa-4.2.4/adim.m new file mode 100644 index 0000000..c59599a --- /dev/null +++ b/octave_packages/tsa-4.2.4/adim.m @@ -0,0 +1,131 @@ +function [IR, CC, D] = adim(U, UC, IR, CC, arg5); +% ADIM adaptive information matrix. Estimates the inverse +% correlation matrix in an adaptive way. +% +% [IR, CC] = adim(U, UC [, IR0 [, CC0]]); +% U input data +% UC update coefficient 0 < UC << 1 +% IR0 initial information matrix +% CC0 initial correlation matrix +% IR information matrix (inverse correlation matrix) +% CC correlation matrix +% +% The algorithm uses the Matrix Inversion Lemma, also known as +% "Woodbury's identity", to obtain a recursive algorithm. +% IR*CC - UC*I should be approx. zero. +% +% Reference(s): +% [1] S. Haykin. Adaptive Filter Theory, Prentice Hall, Upper Saddle River, NJ, USA +% pp. 565-567, Equ. (13.16), 1996. + + +% $Id: adim.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2003 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + + +[ur,p] = size(U); + +Mode_E = 1; +%if nargin < 4, +% m = zeros(size(U)+[0,Mode_E]); +%end; + +if nargin<2, + fprintf(2,'Error ADIM: missing update coefficient\n'); + return; +else + if ~((UC > 0) & (UC <1)), + fprintf(2,'Error ADIM: update coefficient not within range [0,1]\n'); + return; + end; + if UC > 1/p, + fprintf(2,'Warning ADIM: update coefficient should be smaller than 1/number_of_dimensions\n'); + end; +end; + +if nargin<3, + IR = []; +end; +if nargin<4, + CC = []; +end; +if nargin<5, + arg5 = 6; +end; +if isempty(IR), + IR = eye(p+Mode_E); +end; +if isempty(CC), + CC = eye(p+Mode_E); +end; + +D = zeros(ur,(p+Mode_E)^2); +%D = zeros(ur,1); +W = eye(p+Mode_E)*UC/(p+Mode_E); +W2 = eye(p+Mode_E)*UC*UC/(p+Mode_E); + +for k = 1:ur, + if ~Mode_E, + % w/o mean term + d = U(k,:); + else + % w/ mean term + d = [1,U(k,:)]; + end; + + if ~any(isnan(d)), + CC = (1-UC)*CC + UC*(d'*d); + + %K = (1+UC)*IR*d'/(1+(1+UC)*d*IR*d'); + v = IR*d'; + %K = v/(1-UC+d*v); + + if arg5==0; % original version according to [1], can become unstable + IR = (1+UC)*IR - (1+UC)/(1-UC+d*v)*v*v'; + + elseif arg5==1; % this provides IR*CC == I, this seems to be stable + IR = IR - (1+UC)/(1-UC+d*v)*v*v' + sum(diag(IR))*W; + + elseif arg5==6; % DEFAULT: + IR = ((1+UC)/2)*(IR+IR') - ((1+UC)/(1-UC+d*v))*v*v'; + + % more variants just for testing, do not use them. + elseif arg5==2; + IR = IR - (1+UC)/(1-UC+d*v)*v*v' + sum(diag(IR))*W2; + + elseif arg5==3; + IR = IR - (1+UC)/(1-UC+d*v)*v*v' + eps*eye(p+Mode_E); + + elseif arg5==4; + IR = (1+UC)*IR - (1+UC)/(1-UC+d*v)*v*v' + eps*eye(p+Mode_E); + + elseif arg5==5; + IR = IR - (1+UC)/(1-UC+d*v)*v*v' + eps*eye(p+Mode_E); + + end; + end; + + %D(k) = det(IR); + D(k,:) = IR(:)'; +end; + +IR = IR / UC; +if Mode_E, + IR(1,1) = IR(1,1) - 1; +end; + + diff --git a/octave_packages/tsa-4.2.4/amarma.m b/octave_packages/tsa-4.2.4/amarma.m new file mode 100644 index 0000000..8cf9f65 --- /dev/null +++ b/octave_packages/tsa-4.2.4/amarma.m @@ -0,0 +1,233 @@ +function [z,e,REV,ESU,V,Z,SPUR] = amarma(y, Mode, MOP, UC, z0, Z0, V0, W); +% Adaptive Mean-AutoRegressive-Moving-Average model estimation +% [z,E,ESU,REV,V,Z,SPUR] = amarma(y, mode, MOP, UC, z0, Z0, V0, W); +% Estimates AAR parameters with Kalman filter algorithm +% y(t) = sum_i(a(i,t)*y(t-i)) + mu(t) + E(t) +% +% State space model: +% z(t)=G*z(t-1) + w(t) w(t)=N(0,W) +% y(t)=H*z(t) + v(t) v(t)=N(0,V) +% +% G = I, +% z = [µ(t)/(1-sum_i(a(i,t))),a_1(t-1),..,a_p(t-p),b_1(t-1),...,b_q(t-q)]; +% H = [1,y(t-1),..,y(t-p),e(t-1),...,e(t-q)]; +% W = E{(z(t)-G*z(t-1))*(z(t)-G*z(t-1))'} +% V = E{(y(t)-H*z(t-1))*(y(t)-H*z(t-1))'} +% +% Input: +% y Signal (AR-Process) +% Mode +% [0,0] uses V0 and W +% +% MOP Model order [m,p,q], default [0,10,0] +% m=1 includes the mean term, m=0 does not. +% p and q must be positive integers +% it is recommended to set q=0. +% UC Update Coefficient, default 0 +% z0 Initial state vector +% Z0 Initial Covariance matrix +% +% Output: +% z AR-Parameter +% E error process (Adaptively filtered process) +% REV relative error variance MSE/MSY +% +% +% see also: AAR +% +% REFERENCE(S): +% [1] A. Schloegl (2000), The electroencephalogram and the adaptive autoregressive model: theory and applications. +% ISBN 3-8265-7640-3 Shaker Verlag, Aachen, Germany. +% [2] Schlögl A, Lee FY, Bischof H, Pfurtscheller G +% Characterization of Four-Class Motor Imagery EEG Data for the BCI-Competition 2005. +% Journal of neural engineering 2 (2005) 4, S. L14-L22 +% +% More references can be found at +% http://www.dpmi.tu-graz.ac.at/~schloegl/publications/ + +% $Id: amarma.m 5376 2008-10-13 15:53:47Z schloegl $ +% Copyright (C) 1998-2002,2005,2006,2007,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +[nc,nr]=size(y); + +if nargin<2 Mode=0; +elseif isnan(Mode) return; end; +if nargin<3, MOP=[0,10,0]; end; +if nargin<8, W = nan ; end; +if length(MOP)==0, m=0;p=10; q=0; MOP=p; +elseif length(MOP)==1, m=0;p=MOP(1); q=0; MOP=p; +elseif length(MOP)==2, fprintf(1,'Error AMARMA: MOP is ambiguos\n'); +elseif length(MOP)>2, m=MOP(1); p=MOP(2); q=MOP(3);MOP=m+p+q; +end; + +if prod(size(Mode))>1 + aMode=Mode(1); + eMode=Mode(2); +end; +%fprintf(1,['a' int2str(aMode) 'e' int2str(eMode) ' ']); + + +e = zeros(nc,1); +V = zeros(nc,1);V(1)=V0; +T = zeros(nc,1); +ESU = zeros(nc,1)+nan; +SPUR = zeros(nc,1)+nan; +z = z0(ones(nc,1),:); + +dW = UC/MOP*eye(MOP); % Schloegl + +%------------------------------------------------ +% First Iteration +%------------------------------------------------ + +H = zeros(MOP,1); +if m, + %M0 = z0(1)/(1-sum(z0(2:p+1))); %transformierter Mittelwert + H(1) = 1;%M0; + %z0(1)= 1; +end; + +Z = Z0; +zt= z0; + +A1 = zeros(MOP); A2 = A1; + +%------------------------------------------------ +% Update Equations +%------------------------------------------------ + +for t=1:nc, + %H=[y(t-1); H(1:p-1); E ; H(p+1:MOP-1)] + + + if t<=p, H(m+(1:t-1)) = y(t-1:-1:1); %H(p)=mu0; % Autoregressive + else H(m+(1:p)) = y(t-1:-1:t-p); %mu0]; + end; + + if t<=q, H(m+p+(1:t-1)) = e(t-1:-1:1); % Moving Average + else H(m+p+(1:q)) = e(t-1:-1:t-q); + end; + + % Prediction Error + E = y(t) - zt*H; + + e(t) = E; + + if ~isnan(E), + E2 = E*E; + AY = Z*H; + +% [zt, t, y(t), E,ESU(t),V(t),H,Z],pause, + + ESU(t) = H'*AY; + + if eMode==0 + V(t) = V0; + elseif eMode==1 + V0 = V(t-1); + V(t) = V0*(1-UC)+UC*E2; + elseif eMode==2 + V0 = 1; + V(t) = V0; %V(t-1)*(1-UC)+UC*E2; + elseif eMode==3 + V0 = 1-UC; + V(t) = V0; %(t-1)*(1-UC)+UC*E2; + elseif eMode==4 + V0 = V0*(1-UC)+UC*E2; + V(t) = V0; + elseif eMode==5 + V(t)=V0; + %V0 = V0; + elseif eMode==6 + if E2>ESU(t) + V0=(1-UC)*V0+UC*(E2-ESU(t)); + end; + V(t)=V0; + elseif eMode==7 + V0=V(t); + if E2>ESU(t) + V(t) = (1-UC)*V0+UC*(E2-ESU(t)); + else + V(t) = V0; + end; + elseif eMode==8 + V0=0; + V(t) = V0; % (t-1)*(1-UC)+UC*E2; + end; + +%[t,size(H),size(Z)] + + k = AY / (ESU(t) + V0); % Kalman Gain + zt = zt + k'*E; + %z(t,:) = zt; + + if aMode==0 + %W = W; %nop % Schloegl et al. 2003 + elseif aMode==2 + T(t)=(1-UC)*T(t-1)+UC*(E2-Q(t))/(H'*H); % Roberts I 1998 + Z=Z*V(t-1)/Q(t); + if T(t)>0 W=T(t)*eye(MOP); else W=zeros(MOP);end; + elseif aMode==5 + Q_wo = (H'*C*H + V(t-1)); % Roberts II 1998 + T(t)=(1-UC)*T(t-1)+UC*(E2-Q_wo)/(H'*H); + if T(t)>0 W=T(t)*eye(MOP); else W=zeros(MOP); end; + elseif aMode==6 + T(t)=(1-UC)*T(t-1)+UC*(E2-Q(t))/(H'*H); + Z=Z*V(t)/Q(t); + if T(t)>0 W=T(t)*eye(MOP); else W=zeros(MOP); end; + elseif aMode==11 + %Z = Z - k*AY'; + W = sum(diag(Z))*dW; + elseif aMode==12 + W = UC*UC*eye(MOP); + elseif aMode==13 + W = UC*diag(diag(Z)); + elseif aMode==14 + W = (UC*UC)*diag(diag(Z)); + elseif aMode==15 + W = sum(diag(Z))*dW; + elseif aMode==16 + W = UC*eye(MOP); % Schloegl 1998 + elseif aMode==17 + Z = 0.5*(Z+Z'); + W = UC*Z; + elseif aMode==18 + W = 0.5*UC*(Z+Z'); + %W=W; + end; + + Z = Z - k*AY'; % Schloegl 1998 + else + + V(t) = V0; + + end; + if any(any(isnan(W))), W=UC*Z; end; + + z(t,:) = zt; + Z = Z + W; % Schloegl 1998 + SPUR(t)=trace(Z); +end; + + +if 0,m, + z(:,1)=M0*z(:,1)./(1-sum(z(:,2:p),2)); +end; + +REV = mean(e.*e)/mean(y.*y); +if any(~isfinite(Z(:))), REV=inf; end; + diff --git a/octave_packages/tsa-4.2.4/ar2poly.m b/octave_packages/tsa-4.2.4/ar2poly.m new file mode 100644 index 0000000..08416e8 --- /dev/null +++ b/octave_packages/tsa-4.2.4/ar2poly.m @@ -0,0 +1,40 @@ +function [A] = ar2poly(A); +% converts autoregressive parameters into AR polymials +% Multiple polynomials can be converted. +% function [A] = ar2poly(AR); +% +% INPUT: +% AR AR parameters, each row represents one set of AR parameters +% +% OUTPUT +% A denominator polynom +% +% +% see also ACOVF ACORF DURLEV RC2AR FILTER FREQZ ZPLANE +% +% REFERENCES: +% P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. +% S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + +% $Id: ar2poly.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +% Inititialization +[lr,lc]=size(A); + +A = [ones(size(A,1),1),-A]; diff --git a/octave_packages/tsa-4.2.4/ar2rc.m b/octave_packages/tsa-4.2.4/ar2rc.m new file mode 100644 index 0000000..671f226 --- /dev/null +++ b/octave_packages/tsa-4.2.4/ar2rc.m @@ -0,0 +1,89 @@ +function [MX,res,arg3] = ar2rc(ar); +% converts autoregressive parameters into reflection coefficients +% with the Durbin-Levinson recursion for multiple channels +% function [AR,RC,PE] = ar2rc(AR); +% function [MX,PE] = ar2rc(AR); +% +% INPUT: +% AR autoregressive model parameter +% +% OUTPUT +% AR autoregressive model parameter +% RC reflection coefficients (= -PARCOR coefficients) +% PE remaining error variance (relative to PE(1)=1) +% MX transformation matrix between ARP and RC (Attention: needs O(p^2) memory) +% AR = MX(:,K*(K-1)/2+(1:K)); +% RC = MX(:,(1:K).*(2:K+1)/2); +% +% All input and output parameters are organized in rows, one row +% corresponds to the parameters of one channel +% +% see also ACOVF ACORF DURLEV RC2AR +% +% REFERENCES: +% P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. +% S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + +% $Id: ar2rc.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +% Inititialization +[lr,lc]=size(ar); +res=[ones(lr,1) zeros(lr,lc)]; + +if nargout<3 % needs O(p^2) memory + MX=zeros(lr,lc*(lc+1)/2); + MX(:,lc*(lc-1)/2+(1:lc))=ar; + + % Durbin-Levinson Algorithm + idx=lc*(lc-1)/2; + for K=lc:-1:2; + %idx=K*(K-1)/2; %see below + MX(:,(K-2)*(K-1)/2+(1:K-1)) = (MX(:,idx+(1:K-1)) + MX(:,(idx+K)*ones(K-1,1)).*MX(:,idx+(K-1:-1:1)))./((ones(lr,1)-abs(MX(:,idx+K)).^2)*ones(1,K-1)); + idx=idx-K+1; + end; + for K=1:lc + idx=K*(K-1)/2; %see below + res(:,K+1) = res(:,K).*(1-abs(MX(:,idx+K)).^2); + end; + + %arp=MX(:,K*(K-1)/2+(1:K)); + %rc =MX(:,(1:K).*(2:K+1)/2); + +else % needs O(p) memory + + %ar=zeros(lr,lc); + rc=zeros(lr,lc); + rc(:,lc)=ar(:,lc); + MX=ar; % assign output + + % Durbin-Levinson Algorithm + for K=lc-1:-1:1, + ar(:,1:K)=(ar(:,1:K)+ar(:,(K+1)*ones(K,1)).*ar(:,K:-1:1))./((ones(lr,1)-abs(ar(:,K+1)).^2)*ones(1,K)); + rc(:,K)=ar(:,K); + end; + + for K=1:lc, + res(:,K+1) = res(:,K) .* (1-abs(ar(:,K)).^2); + end; + + % assign output arguments + arg3=res; + res=rc; + %MX=ar; +end; %if diff --git a/octave_packages/tsa-4.2.4/ar_spa.m b/octave_packages/tsa-4.2.4/ar_spa.m new file mode 100644 index 0000000..8756b61 --- /dev/null +++ b/octave_packages/tsa-4.2.4/ar_spa.m @@ -0,0 +1,104 @@ +function [w,A,B,R,P,F,ip] = ar_spa(ARP,nhz,E); +% AR_SPA decomposes an AR-spectrum into its compontents +% [w,A,B,R,P,F,ip] = ar_spa(AR,fs,E); +% +% INPUT: +% AR autoregressive parameters +% fs sampling rate, provide w and B in [Hz], if not given the result is in radians +% E noise level (mean square), gives A and F in units of E, if not given as relative amplitude +% +% OUTPUT +% w center frequency +% A Amplitude +% B bandwidth +% - less important output parameters - +% R residual +% P poles +% ip number of complex conjugate poles +% real(F) power, absolute values are obtained by multiplying with noise variance E(p+1) +% imag(F) assymetry, - " - +% +% All input and output parameters are organized in rows, one row +% corresponds to the parameters of one channel +% +% see also ACOVF ACORF DURLEV IDURLEV PARCOR YUWA +% +% REFERENCES: +% [1] Zetterberg L.H. (1969) Estimation of parameter for linear difference equation with application to EEG analysis. Math. Biosci., 5, 227-275. +% [2] Isaksson A. and Wennberg, A. (1975) Visual evaluation and computer analysis of the EEG - A comparison. Electroenceph. clin. Neurophysiol., 38: 79-86. +% [3] G. Florian and G. Pfurtscheller (1994) Autoregressive model based spectral analysis with application to EEG. IIG - Report Series, University of Technolgy Graz, Austria. + +% $Id: ar_spa.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1996-2003 by Alois Schloegl +% This is part of the TSA-toolbox see also: +% http://hci.tugraz.at/schloegl/matlab/tsa/ +% http://octave.sf.net/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +[NTR,pp]=size(ARP); + +R=zeros(size(ARP)); +P=zeros(size(ARP)); +w=zeros(size(ARP)); +A=zeros(size(ARP)); +B=zeros(size(ARP)); +F=zeros(size(ARP)); +F1 = F; +for k = 1:NTR, %if ~mod(k,100),k, end; + [r,p,tmp] = residue(1,[1 -ARP(k,:)]); + [tmp,idx] = sort(-abs(r)); + R(k,:) = r(idx)'; % Residual, + P(k,:) = p(idx)'; % Poles + %r(k,:)=roots([1 -ARP(k,:)])'; + w(k,:) = angle(p(idx)'); % center frequency (in [radians]) + A(k,:) = 1./abs(polyval([1 -ARP(k,:)],exp(i*w(k,:)))); % Amplitude + %A(k,:) = freqz(1,[1 -ARP(k,:)],w(k,:)); % Amplitude + %A2(k,:) = abs(r)'./abs(exp(i*w(k,:))-r'); % Amplitude + B(k,:) = -log(abs(p(idx)')); % Bandwidth + + if nargout < 6, + + elseif 0, + F(k,:) = (1+sign(imag(r(idx)')))./(polyval([-ARP(k,pp-1:-1:1).*(1:pp-1) pp],1./p(idx).').*polyval([-ARP(k,pp:-1:1) 1],p(idx).')); + + elseif 1; + a3 = polyval([-ARP(k,pp-1:-1:1).*(1:pp-1), pp],1./p(idx).'); + a = polyval([-ARP(k,pp:-1:1) 1],p(idx).'); + %F(k,:) = (1+(imag(P(k,:))~=0))./(a.*a3); + F(k,:) = (1+sign(imag(P(k,:))))./(a.*a3); + end; +end; + +A = A.*sqrt(E(:,ones(1,pp))/(2*pi*nhz)); +if nargin>1, + if size(nhz,1)==1, + nhz = nhz(ones(NTR,1),:); + end; + w = w.*nhz(:,ones(1,pp))/(2*pi); + B = B.*nhz(:,ones(1,pp))/(2*pi); +end; +if nargin>2, + F = F.*E(:,ones(1,pp)); + F1 = F1.*E(:,ones(1,pp)); +end; + +ip = sum(imag(P)~=0,2)/2; +return; + +np(:,1) = sum(imag(P')==0)'; % number of real poles +np(:,2) = pp-np(:,1); % number of imaginary poles + + diff --git a/octave_packages/tsa-4.2.4/arcext.m b/octave_packages/tsa-4.2.4/arcext.m new file mode 100644 index 0000000..3831d29 --- /dev/null +++ b/octave_packages/tsa-4.2.4/arcext.m @@ -0,0 +1,60 @@ +function [AR,RC] = arcext(MX,P); +% ARCEXT extracts AR and RC of order P from Matrix MX +% function [AR,RC] = arcext(MX,P); +% +% INPUT: +% MX AR and RC matrix calculated by durlev +% P model order (default maximum possible) +% +% OUTPUT +% AR autoregressive model parameter +% RC reflection coefficients (= -PARCOR coefficients) +% +% All input and output parameters are organized in rows, one row +% corresponds to the parameters of one channel +% +% see also ACOVF ACORF DURLEV +% +% REFERENCES: +% P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. +% S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + +% $Id: arcext.m 9609 2012-02-10 10:18:00Z schloegl $ +% Copyright (C) 1998-2003,2008,2012 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://pub.ist.ac.at/~schloegl/matlab/tsa/ +% http://octave.sourceforge.net/ +% http://biosig.sourceforge.net/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +[lr,lc]=size(MX); + +if ~mod(sqrt(8*lc+1)-1,2) % full number of elements + K = (sqrt(8*lc+1)-1)/2; +elseif ~mod(lc,2), % compressed form of MX + K = lc/2; +else % invalid number of elements + fprintf(2,'Warning ARCEXT: Number of elements is different than a triangular matrix\n'); +end; + +if (K~=P) && (lc~=K*(K+1)/2), + [AR,RC,PE]=rc2ar(MX(:,(1:P).*(2:P+1)/2)); +else + AR = MX(:,P*(P-1)/2+(1:P)); + RC = MX(:,(1:P).*(2:P+1)/2); +end; diff --git a/octave_packages/tsa-4.2.4/arfit2.m b/octave_packages/tsa-4.2.4/arfit2.m new file mode 100644 index 0000000..9e9efa3 --- /dev/null +++ b/octave_packages/tsa-4.2.4/arfit2.m @@ -0,0 +1,143 @@ +function [w, MAR, C, sbc, fpe, th] = arfit2(Y, pmin, pmax, selector, no_const) +% ARFIT2 estimates multivariate autoregressive parameters +% of the MVAR process Y +% +% Y(t,:)' = w' + A1*Y(t-1,:)' + ... + Ap*Y(t-p,:)' + x(t,:)' +% +% ARFIT2 uses the Nutall-Strand method (multivariate Burg algorithm) +% which provides better estimates the ARFIT [1], and uses the +% same arguments. Moreover, ARFIT2 is faster and can deal with +% missing values encoded as NaNs. +% +% [w, A, C, sbc, fpe] = arfit2(v, pmin, pmax, selector, no_const) +% +% INPUT: +% v data - each channel in a column +% pmin, pmax minimum and maximum model order +% selector 'fpe' or 'sbc' [default] +% no_const 'zero' indicates no bias/offset need to be estimated +% in this case is w = [0, 0, ..., 0]'; +% +% OUTPUT: +% w mean of innovation noise +% A [A1,A2,...,Ap] MVAR estimates +% C covariance matrix of innovation noise +% sbc, fpe criteria for model order selection +% +% see also: ARFIT, MVAR +% +% REFERENCES: +% [1] A. Schloegl, 2006, Comparison of Multivariate Autoregressive Estimators. +% Signal processing, p. 2426-9. +% [2] T. Schneider and A. Neumaier, 2001. +% Algorithm 808: ARFIT-a Matlab package for the estimation of parameters and eigenmodes +% of multivariate autoregressive models. ACM-Transactions on Mathematical Software. 27, (Mar.), 58-65. + +% $Id: arfit2.m 9609 2012-02-10 10:18:00Z schloegl $ +% Copyright (C) 1996-2005,2008,2012 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://pub.ist.ac.at/~schloegl/matlab/tsa/ +% http://octave.sourceforge.net/ +% http://biosig.sourceforge.net/ + +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +%%%%% checking of the input arguments was done the same way as ARFIT +if (pmin ~= round(pmin) || pmax ~= round(pmax)) + error('Order must be integer.'); +end +if (pmax < pmin) + error('PMAX must be greater than or equal to PMIN.') +end + +% set defaults and check for optional arguments +if (nargin == 3) % no optional arguments => set default values + mcor = 1; % fit intercept vector + selector = 'sbc'; % use SBC as order selection criterion +elseif (nargin == 4) % one optional argument + if strcmp(selector, 'zero') + mcor = 0; % no intercept vector to be fitted + selector = 'sbc'; % default order selection + else + mcor = 1; % fit intercept vector + end +elseif (nargin == 5) % two optional arguments + if strcmp(no_const, 'zero') + mcor = 0; % no intercept vector to be fitted + else + error(['Bad argument. Usage: ', '[w,A,C,SBC,FPE,th]=AR(v,pmin,pmax,SELECTOR,''zero'')']) + end +end + + + +%%%%% Implementation of the MVAR estimation +[N,M]=size(Y); + +if mcor, + [m,N] = sumskipnan(Y,1); % calculate mean + m = m./N; + Y = Y - repmat(m,size(Y)./size(m)); % remove mean +end; + +[MAR,RCF,PE] = mvar(Y, pmax, 2); % estimate MVAR(pmax) model + +N = min(N); + +%if 1;nargout>3; +ne = N-mcor-(pmin:pmax); +for p=pmin:pmax, + % Get downdated logarithm of determinant + logdp(p-pmin+1) = log(det(PE(:,p*M+(1:M))*(N-p-mcor))); +end; + +% Schwarz's Bayesian Criterion +sbc = logdp/M - log(ne) .* (1-(M*(pmin:pmax)+mcor)./ne); + +% logarithm of Akaike's Final Prediction Error +fpe = logdp/M - log(ne.*(ne-M*(pmin:pmax)-mcor)./(ne+M*(pmin:pmax)+mcor)); + +% Modified Schwarz criterion (MSC): +% msc(i) = logdp(i)/m - (log(ne) - 2.5) * (1 - 2.5*np(i)/(ne-np(i))); + +% get index iopt of order that minimizes the order selection +% criterion specified by the variable selector +if strcmpi(selector,'fpe'); + [val, iopt] = min(fpe); +else %if strcmpi(selector,'sbc'); + [val, iopt] = min(sbc); +end; + +% select order of model +popt = pmin + iopt-1; % estimated optimum order + +if popt5, th=[]; fprintf(2,'Warning ARFIT2: output TH not defined\n'); end; diff --git a/octave_packages/tsa-4.2.4/biacovf.m b/octave_packages/tsa-4.2.4/biacovf.m new file mode 100644 index 0000000..99eea69 --- /dev/null +++ b/octave_packages/tsa-4.2.4/biacovf.m @@ -0,0 +1,43 @@ +function [BIACF,ACF,M1] = biacovf(Z,N); +% BiAutoCovariance function +% [BiACF] = biacovf(Z,N); +% +% Input: Z Signal +% N # of coefficients +% Output: BIACF bi-autocorrelation function (joint cumulant 3rd order +% Output: ACF covariance function (joint cumulant 2nd order) + +% $Id: biacovf.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1997, 1998, 2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +ACF=zeros(1,N+1); +BIACF=zeros(N+1,N+1); + +Z=Z(:); +M=size(Z,1); + +M1=sum(Z)/M; +Z=Z-M1*ones(size(Z)); + +for K=0:N, + tmp=Z(1:M-K).*Z(1+K:M); + ACF(K+1)=sum(tmp)/M; + for L = K:N, + BIACF(K+1,L+1) = sum(tmp(1:M-L).*Z(1+L:M))/M; + end; +end; + +BIACF=BIACF+BIACF'-diag(diag(BIACF)); diff --git a/octave_packages/tsa-4.2.4/bisdemo.m b/octave_packages/tsa-4.2.4/bisdemo.m new file mode 100644 index 0000000..d8613e1 --- /dev/null +++ b/octave_packages/tsa-4.2.4/bisdemo.m @@ -0,0 +1,34 @@ +% BISDEMO (script) Shows BISPECTRUM of eeg8s.mat + +% $Id: bisdemo.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1997, 1998,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +load eeg8s.mat; +[BISPEC,BICOV,ACF]=bispec(eeg8s,30); +[s1,s2]=size(BISPEC); +t1=(1:s1)/max(s1); +t2=(1:s2)/max(s2); +subplot(211); +mesh(t1,t2,abs(BISPEC)); +title('Bispectrum - mesh plot'); + +subplot(212); +if exist('OCTAVE_VERSION')>5 + contour(abs(BISPEC),10,t1,t2); +else + contour(t1,t2,abs(BISPEC),10); +end; +title('Bispectrum - contour plot'); diff --git a/octave_packages/tsa-4.2.4/bispec.m b/octave_packages/tsa-4.2.4/bispec.m new file mode 100644 index 0000000..d50804c --- /dev/null +++ b/octave_packages/tsa-4.2.4/bispec.m @@ -0,0 +1,54 @@ +function [BISPEC,BIACF,ACF] = bispec(Z,N); +% Calculates Bispectrum +% [BISPEC] = bispec(Z,N); +% +% Input: Z Signal +% N # of coefficients +% Output: BiACF bi-autocorrelation function = 3rd order cumulant +% BISPEC Bi-spectrum +% +% Reference(s): +% C.L. Nikias and A.P. Petropulu "Higher-Order Spectra Analysis" Prentice Hall, 1993. +% M.B. Priestley, "Non-linear and Non-stationary Time series Analysis", Academic Press, London, 1988. + +% $Id: bispec.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1997-2003,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +P=N+1; +ACF=zeros(1,N+1); +BIACF=zeros(2*N+1,2*N+1); + +Z=Z(:); +M=size(Z,1); +M1=sum(Z)/M; +Z=Z-M1*ones(size(Z)); + +for K=0:N, + jc2=Z(1:M-K).*Z(1+K:M); + ACF(K+1)=sum(jc2)/M; + for L = K:N, + jc3 = sum(jc2(1:M-L).*Z(1+L:M))/M; + BIACF(K+P, L+P) =jc3; + BIACF(L+P, K+P) =jc3; + BIACF(L-K+P, -K+P)=jc3; + BIACF(-K+P, L-K+P)=jc3; + BIACF(K-L+P, -L+P)=jc3; + BIACF(-L+P, K-L+P)=jc3; + end; +end; + +BISPEC=fft2(BIACF,128,128); diff --git a/octave_packages/tsa-4.2.4/content.m b/octave_packages/tsa-4.2.4/content.m new file mode 100644 index 0000000..899df58 --- /dev/null +++ b/octave_packages/tsa-4.2.4/content.m @@ -0,0 +1,94 @@ +% Time Series Analysis (Ver 3.10) +% Schloegl A. (1996-2003,2008) Time Series Analysis - A Toolbox for the use with Matlab. +% WWW: http://hci.tugraz.at/~schloegl/matlab/tsa/ +% +% $Id: content.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1996-2003,2008 by Alois Schloegl +% +% Time Series Analysis - a toolbox for the use with Matlab +% aar adaptive autoregressive estimator +% acovf (*) Autocovariance function +% acorf (acf) (*) autocorrelation function +% pacf (*) partial autocorrelation function, includes signifcance test and confidence interval +% parcor (*) partial autocorrelation function +% biacovf biautocovariance function (3rd order cumulant) +% bispec Bi-spectrum +% durlev (*) solves Yule-Walker equation - converts ACOVF into AR parameters +% lattice (*) calcultes AR parameters with lattice method +% lpc (*) calculates the prediction coefficients form a given time series +% invest0 (*) a prior investigation (used by invest1) +% invest1 (*) investigates signal (useful for 1st evaluation of the data) +% selmo (*) Select Order of Autoregressive model using different criteria +% histo (*) histogram +% hup (*) test Hurwitz polynomials +% ucp (*) test Unit Circle Polynomials +% y2res (*) computes mean, variance, skewness, kurtosis, entropy, etc. from data series +% ar_spa (*) spectral analysis based on the autoregressive model +% detrend (*) removes trend, can handle missing values, non-equidistant sampled data +% flix floating index, interpolates data for non-interger indices +% quantiles calculates quantiles +% +% Multivariate analysis (planned in future) +% mvar multivariate (vector) autoregressive estimation +% mvfilter multivariate filter +% arfit2 provides compatibility to ARFIT [Schneider and Neumaier, 2001] + +% Conversions between Autocorrelation (AC), Autoregressive parameters (AR), +% prediction polynom (POLY) and Reflection coefficient (RC) +% ac2poly (*) transforms autocorrelation into prediction polynom +% ac2rc (*) transforms autocorrelation into reflexion coefficients +% ar2rc (*) transforms autoregressive parameters into reflection coefficients +% rc2ar (*) transforms reflection coefficients into autoregressive parameters +% poly2ac (*) transforms polynom to autocorrelation +% poly2ar (*) transforms polynom to AR +% poly2rc (*) +% rc2ac (*) +% rc2poly (*) +% ar2poly (*) +% +% Utility functions +% sinvest1 shows the parameter calculated by INVEST1 +% +% Test suites +% tsademo demonstrates INVEST1 on EEG data +% invfdemo demonstration of matched, inverse filtering +% bisdemo demonstrates bispectral estimation +% +% (*) indicates univariate analysis of multiple data series (each in a row) can be processed. +% (-) indicates that these functions will be removed in future +% +% REFERENCES (sources): +% http://www.itl.nist.gov/ +% http://mathworld.wolfram.com/ +% P.J. Brockwell and R.A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. +% O. Foellinger "Lineare Abtastsysteme", Oldenburg Verlag, Muenchen, 1986. +% F. Gausch "Systemtechnik", Textbook, University of Technology Graz, 1993. +% M.S. Grewal and A.P. Andrews "Kalman Filtering" Prentice Hall, 1993. +% S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. +% E.I. Jury "Theory and Application of the z-Transform Method", Robert E. Krieger Publishing Co., 1973. +% M.S. Kay "Modern Spectal Estimation" Prentice Hall, 1988. +% Ch. Langraf and G. Schneider "Elemente der Regeltechnik", Springer Verlag, 1970. +% S.L. Marple "Digital Spetral Analysis with Applications" Prentice Hall, 1987. +% C.L. Nikias and A.P. Petropulu "Higher-Order Spectra Analysis" Prentice Hall, 1993. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% T. Schneider and A. Neumaier "Algorithm 808: ARFIT - a matlab package for the estimation of parameters and eigenmodes of multivariate autoregressive models" +% ACM Transactions on Mathematical software, 27(Mar), 58-65. +% C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. +% +% +% REFERENCES (applications): +% [1] A. Schlögl, B. Kemp, T. Penzel, D. Kunz, S.-L. Himanen,A. Värri, G. Dorffner, G. Pfurtscheller. +% Quality Control of polysomnographic Sleep Data by Histogram and Entropy Analysis. +% Clin. Neurophysiol. 1999, Dec; 110(12): 2165 - 2170. +% [2] Penzel T, Kemp B, Klösch G, Schlögl A, Hasan J, Varri A, Korhonen I. +% Acquisition of biomedical signals databases +% IEEE Engineering in Medicine and Biology Magazine 2001, 20(3): 25-32 +% +% Features: +% - Multiple Signal Processing +% - Efficient algorithms +% - Model order selection tools +% - higher (3rd) order analysis +% - Maximum entropy spectral estimation +% - can deal with missing values (NaN's) diff --git a/octave_packages/tsa-4.2.4/contents.m b/octave_packages/tsa-4.2.4/contents.m new file mode 100644 index 0000000..a79bb90 --- /dev/null +++ b/octave_packages/tsa-4.2.4/contents.m @@ -0,0 +1,114 @@ +% Time Series Analysis - A toolbox for the use with Matlab and Octave. +% +% $Id: contents.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1996-2004,2008 by Alois Schloegl % WWW: http://hci.tugraz.at/~schloegl/matlab/tsa/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . +% +% +% Time Series Analysis - a toolbox for the use with Matlab +% aar adaptive autoregressive estimator +% acovf (*) Autocovariance function +% acorf (acf) (*) autocorrelation function +% pacf (*) partial autocorrelation function, includes signifcance test and confidence interval +% parcor (*) partial autocorrelation function +% biacovf biautocovariance function (3rd order cumulant) +% bispec Bi-spectrum +% durlev (*) solves Yule-Walker equation - converts ACOVF into AR parameters +% lattice (*) calcultes AR parameters with lattice method +% lpc (*) calculates the prediction coefficients form a given time series +% invest0 (*) a prior investigation (used by invest1) +% invest1 (*) investigates signal (useful for 1st evaluation of the data) +% rmle AR estimation using recursive maximum likelihood function +% selmo (*) Select Order of Autoregressive model using different criteria +% histo (*) histogram +% hup (*) test Hurwitz polynomials +% ucp (*) test Unit Circle Polynomials +% y2res (*) computes mean, variance, skewness, kurtosis, entropy, etc. from data series +% ar_spa (*) spectral analysis based on the autoregressive model +% detrend (*) removes trend, can handle missing values, non-equidistant sampled data +% flix floating index, interpolates data for non-interger indices +% +% +% Multivariate analysis +% adim adaptive information matrix (inverse correlation matrix) +% mvar multivariate (vector) autoregressive estimation +% mvaar multivariate adaptvie autoregressive estimation using Kalman filtering +% mvfilter multivariate filter +% mvfreqz multivariate spectra +% arfit2 provides compatibility to ARFIT [Schneider and Neumaier, 2001] +% +% +% Conversions between Autocorrelation (AC), Autoregressive parameters (AR), +% prediction polynom (POLY) and Reflection coefficient (RC) +% ac2poly (*) transforms autocorrelation into prediction polynom +% ac2rc (*) transforms autocorrelation into reflexion coefficients +% ar2rc (*) transforms autoregressive parameters into reflection coefficients +% rc2ar (*) transforms reflection coefficients into autoregressive parameters +% poly2ac (*) transforms polynom to autocorrelation +% poly2ar (*) transforms polynom to AR +% poly2rc (*) +% rc2ac (*) +% rc2poly (*) +% ar2poly (*) +% +% Utility functions +% sinvest1 shows the parameter calculated by INVEST1 +% +% Test suites +% tsademo demonstrates INVEST1 on EEG data +% invfdemo demonstration of matched, inverse filtering +% bisdemo demonstrates bispectral estimation +% +% (*) indicates univariate analysis of multiple data series (each in a row) can be processed. +% (-) indicates that these functions will be removed in future +% +% REFERENCES (sources): +% http://www.itl.nist.gov/ +% http://mathworld.wolfram.com/ +% P.J. Brockwell and R.A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. +% O. Foellinger "Lineare Abtastsysteme", Oldenburg Verlag, Muenchen, 1986. +% F. Gausch "Systemtechnik", Textbook, University of Technology Graz, 1993. +% M.S. Grewal and A.P. Andrews "Kalman Filtering" Prentice Hall, 1993. +% S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. +% E.I. Jury "Theory and Application of the z-Transform Method", Robert E. Krieger Publishing Co., 1973. +% M.S. Kay "Modern Spectal Estimation" Prentice Hall, 1988. +% Ch. Langraf and G. Schneider "Elemente der Regeltechnik", Springer Verlag, 1970. +% S.L. Marple "Digital Spetral Analysis with Applications" Prentice Hall, 1987. +% C.L. Nikias and A.P. Petropulu "Higher-Order Spectra Analysis" Prentice Hall, 1993. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% T. Schneider and A. Neumaier "Algorithm 808: ARFIT - a matlab package for the estimation of parameters and eigenmodes of multivariate autoregressive models" +% ACM Transactions on Mathematical software, 27(Mar), 58-65. +% C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. +% +% +% REFERENCES (applications): +% [1] A. Schlögl, B. Kemp, T. Penzel, D. Kunz, S.-L. Himanen,A. Värri, G. Dorffner, G. Pfurtscheller. +% Quality Control of polysomnographic Sleep Data by Histogram and Entropy Analysis. +% Clin. Neurophysiol. 1999, Dec; 110(12): 2165 - 2170. +% [2] Penzel T, Kemp B, Klösch G, Schlögl A, Hasan J, Varri A, Korhonen I. +% Acquisition of biomedical signals databases +% IEEE Engineering in Medicine and Biology Magazine 2001, 20(3): 25-32 +% [3] Alois Schlögl (2000) +% The electroencephalogram and the adaptive autoregressive model: theory and applications +% Shaker Verlag, Aachen, Germany,(ISBN3-8265-7640-3). +% +% Features: +% - Multiple Signal Processing +% - Efficient algorithms +% - Model order selection tools +% - higher (3rd) order analysis +% - Maximum entropy spectral estimation +% - can deal with missing values (NaN's) diff --git a/octave_packages/tsa-4.2.4/covm.m b/octave_packages/tsa-4.2.4/covm.m new file mode 100644 index 0000000..91602bf --- /dev/null +++ b/octave_packages/tsa-4.2.4/covm.m @@ -0,0 +1,248 @@ +function [CC,NN] = covm(X,Y,Mode,W) +% COVM generates covariance matrix +% X and Y can contain missing values encoded with NaN. +% NaN's are skipped, NaN do not result in a NaN output. +% The output gives NaN only if there are insufficient input data +% +% COVM(X,Mode); +% calculates the (auto-)correlation matrix of X +% COVM(X,Y,Mode); +% calculates the crosscorrelation between X and Y +% COVM(...,W); +% weighted crosscorrelation +% +% Mode = 'M' minimum or standard mode [default] +% C = X'*X; or X'*Y correlation matrix +% +% Mode = 'E' extended mode +% C = [1 X]'*[1 X]; % l is a matching column of 1's +% C is additive, i.e. it can be applied to subsequent blocks and summed up afterwards +% the mean (or sum) is stored on the 1st row and column of C +% +% Mode = 'D' or 'D0' detrended mode +% the mean of X (and Y) is removed. If combined with extended mode (Mode='DE'), +% the mean (or sum) is stored in the 1st row and column of C. +% The default scaling is factor (N-1). +% Mode = 'D1' is the same as 'D' but uses N for scaling. +% +% C = covm(...); +% C is the scaled by N in Mode M and by (N-1) in mode D. +% [C,N] = covm(...); +% C is not scaled, provides the scaling factor N +% C./N gives the scaled version. +% +% see also: DECOVM, XCOVF + +% $Id: covm.m 9032 2011-11-08 20:25:36Z schloegl $ +% Copyright (C) 2000-2005,2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + + +global FLAG_NANS_OCCURED; + +if nargin<3, + W = []; + if nargin==2, + if isnumeric(Y), + Mode='M'; + else + Mode=Y; + Y=[]; + end; + elseif nargin==1, + Mode = 'M'; + Y = []; + elseif nargin==0, + error('Missing argument(s)'); + end; + +elseif (nargin==3) && isnumeric(Y) && ~isnumeric(Mode); + W = []; + +elseif (nargin==3) && ~isnumeric(Y) && isnumeric(Mode); + W = Mode; + Mode = Y; + Y = []; + +elseif (nargin==4) && ~isnumeric(Mode) && isnumeric(Y); + ; %% ok +else + error('invalid input arguments'); +end; + +Mode = upper(Mode); + +[r1,c1]=size(X); +if ~isempty(Y) + [r2,c2]=size(Y); + if r1~=r2, + error('X and Y must have the same number of observations (rows).'); + end; +else + [r2,c2]=size(X); +end; + +persistent mexFLAG2; +persistent mexFLAG; +if isempty(mexFLAG2) + mexFLAG2 = exist('covm_mex','file'); +end; +if isempty(mexFLAG) + mexFLAG = exist('sumskipnan_mex','file'); +end; + + +if ~isempty(W) + W = W(:); + if (r1~=numel(W)) + error('Error COVM: size of weight vector does not fit number of rows'); + end; + %w = spdiags(W(:),0,numel(W),numel(W)); + %nn = sum(W(:)); + nn = sum(W); +else + nn = r1; +end; + + +if mexFLAG2 && mexFLAG && ~isempty(W), + %% the mex-functions here are much slower than the m-scripts below + %% however, the mex-functions support weighting of samples. + if isempty(FLAG_NANS_OCCURED), + %% mex-files require that FLAG_NANS_OCCURED is not empty, + %% otherwise, the status of NAN occurence can not be returned. + FLAG_NANS_OCCURED = logical(0); % default value + end; + + if any(Mode=='D') || any(Mode=='E'), + [S1,N1] = sumskipnan(X,1,W); + if ~isempty(Y) + [S2,N2] = sumskipnan(Y,1,W); + else + S2 = S1; N2 = N1; + end; + if any(Mode=='D'), % detrending mode + X = X - ones(r1,1)*(S1./N1); + if ~isempty(Y) + Y = Y - ones(r1,1)*(S2./N2); + end; + end; + end; + + [CC,NN] = covm_mex(real(X), real(Y), FLAG_NANS_OCCURED, W); + %% complex matrices + if ~isreal(X) && ~isreal(Y) + [iCC,inn] = covm_mex(imag(X), imag(Y), FLAG_NANS_OCCURED, W); + CC = CC + iCC; + end; + if isempty(Y) Y = X; end; + if ~isreal(X) + [iCC,inn] = covm_mex(imag(X), real(Y), FLAG_NANS_OCCURED, W); + CC = CC - i*iCC; + end; + if ~isreal(Y) + [iCC,inn] = covm_mex(real(X), imag(Y), FLAG_NANS_OCCURED, W); + CC = CC + i*iCC; + end; + + if any(Mode=='D') && ~any(Mode=='1'), % 'D1' + NN = max(NN-1,0); + end; + if any(Mode=='E'), % extended mode + NN = [nn, N2; N1', NN]; + CC = [nn, S2; S1', CC]; + end; + + +elseif ~isempty(W), + + error('Error COVM: weighted COVM requires sumskipnan_mex and covm_mex but it is not available'); + + %% weighted covm without mex-file support + %% this part is not working. + +elseif ~isempty(Y), + if (~any(Mode=='D') && ~any(Mode=='E')), % if Mode == M + NN = real(X==X)'*real(Y==Y); + FLAG_NANS_OCCURED = any(NN(:) +% $Id: detrend.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 2001,2007 by Alois Schloegl +% This function is part of the TSA-toolbox +% http://www.dpmi.tu-graz.ac.at/~schloegl/matlab/tsa/ +% Copyright (C) 1997, 1998, 2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +if (nargin == 1) + p = 1; + X = t; + t = []; +elseif (nargin == 2) + if strcmpi(X,'constant'), + p = 0; + X = t; + t = []; + elseif strcmpi(X,'linear'), + p = 1; + X = t; + t = []; + elseif ischar(X) + error('unknown 2nd input argument'); + elseif all(size(X)==1), + p = X; + X = t; + t = []; + else + p = 1; + end; +elseif (nargin == 3) + if ischar(X), + warning('input arguments are not supported'); + end; + +elseif (nargin > 3) + fprintf (1,'usage: detrend (x [, p])\n'); +end; + +% check data, must be in culomn order +[m, n] = size (X); +if (m == 1) + X = X'; + r=n; +else + r=m; +end +% check time scale +if isempty(t), + t = (1:r).'; % make time scale +elseif ~all(size(t)==size(X)) + t = t(:); +end; +% check dimension of t and X +if ~all(size(X,1)==size(t,1)) + fprintf (2,'detrend: size(t,1) must same as size(x,1) \n'); +end; +% check the order of the polynomial +if (~(all(size(p)==1) & (p == round (p)) & (p >= 0))) + fprintf (2,'detrend: p must be a nonnegative integer\n'); +end + +if (nargout>1) , % needs more memory + T = zeros(size(X))+nan; + %T=repmat(nan,size(X)); % not supported by Octave 2.0.16 + + + if (size(t,2)>1), % for multiple time scales + for k=1:size(X,2), + idx=find(~isnan(X(:,k))); + b = (t(idx,k) * ones (1, p + 1)) .^ (ones (length(idx),1) * (0 : p)); + T(idx,k) = b * (b \ X(idx,k)); + end; + + else % if only one time scale is used + b = (t * ones (1, p + 1)) .^ (ones (length(t),1) * (0 : p)); + for k=1:size(X,2), + idx=find(~isnan(X(:,k))); + T(idx,k) = b(idx,:) * (b(idx,:) \ X(idx,k)); + %X(idx,k) = X(idx,k) - T(idx,k); % 1st alternative implementation + %X(:,k) = X(:,k) - T(:,k); % 2nd alternative + end; + end; + X = X-T; % 3nd alternative + + if (m == 1) + X = X'; + T = T'; + end +else % needs less memory + if (size(t,2)>1), % for multiple time scales + for k = 1:size(X,2), + idx = find(~isnan(X(:,k))); + b = (t(idx,k) * ones (1, p + 1)) .^ (ones (length(idx),1) * (0 : p)); + X(idx,k) = X(idx,k) - b * (b \ X(idx,k)); + end; + else % if only one time scale is used + b = (t * ones (1, p + 1)) .^ (ones (length(t),1) * (0 : p)); + for k = 1:size(X,2), + idx = find(~isnan(X(:,k))); + X(idx,k) = X(idx,k) - b(idx,:) * (b(idx,:) \ X(idx,k)); + end; + end; + + if (m == 1) + X = X'; + end +end; + + + diff --git a/octave_packages/tsa-4.2.4/doc-cache b/octave_packages/tsa-4.2.4/doc-cache new file mode 100644 index 0000000..d2f4f6d --- /dev/null +++ b/octave_packages/tsa-4.2.4/doc-cache @@ -0,0 +1,2575 @@ +# Created by Octave 3.6.1, Thu Apr 05 12:32:56 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 55 +# name: +# type: sq_string +# elements: 1 +# length: 3 +aar + + +# name: +# type: sq_string +# elements: 1 +# length: 2198 + Calculates adaptive autoregressive (AAR) and adaptive autoregressive moving average estimates (AARMA) + of real-valued data series using Kalman filter algorithm. + [a,e,REV] = aar(y, mode, MOP, UC, a0, A, W, V); + + The AAR process is described as following + y(k) - a(k,1)*y(t-1) -...- a(k,p)*y(t-p) = e(k); + The AARMA process is described as following + y(k) - a(k,1)*y(t-1) -...- a(k,p)*y(t-p) = e(k) + b(k,1)*e(t-1) + ... + b(k,q)*e(t-q); + + Input: + y Signal (AR-Process) + Mode is a two-element vector [aMode, vMode], + aMode determines 1 (out of 12) methods for updating the co-variance matrix (see also [1]) + vMode determines 1 (out of 7) methods for estimating the innovation variance (see also [1]) + aMode=1, vmode=2 is the RLS algorithm as used in [2] + aMode=-1, LMS algorithm (signal normalized) + aMode=-2, LMS algorithm with adaptive normalization + + MOP model order, default [10,0] + MOP=[p] AAR(p) model. p AR parameters + MOP=[p,q] AARMA(p,q) model, p AR parameters and q MA coefficients + UC Update Coefficient, default 0 + a0 Initial AAR parameters [a(0,1), a(0,2), ..., a(0,p),b(0,1),b(0,2), ..., b(0,q)] + (row vector with p+q elements, default zeros(1,p) ) + A Initial Covariance matrix (positive definite pxp-matrix, default eye(p)) + W system noise (required for aMode==0) + V observation noise (required for vMode==0) + + Output: + a AAR(MA) estimates [a(k,1), a(k,2), ..., a(k,p),b(k,1),b(k,2), ..., b(k,q] + e error process (Adaptively filtered process) + REV relative error variance MSE/MSY + + + Hint: + The mean square (prediction) error of different variants is useful for determining the free parameters (Mode, MOP, UC) + + REFERENCE(S): + [1] A. Schloegl (2000), The electroencephalogram and the adaptive autoregressive model: theory and applications. + ISBN 3-8265-7640-3 Shaker Verlag, Aachen, Germany. + + More references can be found at + http://www.dpmi.tu-graz.ac.at/~schloegl/publications/ + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Calculates adaptive autoregressive (AAR) and adaptive autoregressive moving ave + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +aarmam + + +# name: +# type: sq_string +# elements: 1 +# length: 1372 + Estimating Adaptive AutoRegressive-Moving-Average-and-mean model (includes mean term) + + !! This function is obsolete and is replaced by AMARMA + + [z,E,REV,ESU,V,Z,SPUR] = aarmam(y, mode, MOP, UC, z0, Z0, V0, W); + Estimates AAR parameters with Kalman filter algorithm + y(t) = sum_i(a_i(t)*y(t-i)) + m(t) + e(t) + sum_i(b_i(t)*e(t-i)) + + State space model + z(t) = G*z(t-1) + w(t) w(t)=N(0,W) + y(t) = H*z(t) + v(t) v(t)=N(0,V) + + G = I, + z = [m(t),a_1(t-1),..,a_p(t-p),b_1(t-1),...,b_q(t-q)]; + H = [1,y(t-1),..,y(t-p),e(t-1),...,e(t-q)]; + W = E{(z(t)-G*z(t-1))*(z(t)-G*z(t-1))'} + V = E{(y(t)-H*z(t-1))*(y(t)-H*z(t-1))'} + + + Input: + y Signal (AR-Process) + Mode determines the type of algorithm + + MOP Model order [m,p,q], default [0,10,0] + m=1 includes the mean term, m=0 does not. + p and q must be positive integers + it is recommended to set q=0. + UC Update Coefficient, default 0 + z0 Initial state vector + Z0 Initial Covariance matrix + + Output: + z AR-Parameter + E error process (Adaptively filtered process) + REV relative error variance MSE/MSY + + REFERENCE(S): + [1] A. Schloegl (2000), The electroencephalogram and the adaptive autoregressive model: theory and applications. + ISBN 3-8265-7640-3 Shaker Verlag, Aachen, Germany. + + More references can be found at + http://pub.ist.ac.at/~schloegl/publications/ + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Estimating Adaptive AutoRegressive-Moving-Average-and-mean model (includes mean + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +ac2poly + + +# name: +# type: sq_string +# elements: 1 +# length: 179 + converts the autocorrelation sequence into an AR polynomial + [A,Efinal] = ac2poly(r) + + see also ACOVF ACORF AR2RC RC2AR DURLEV AC2POLY, POLY2RC, RC2POLY, RC2AC, AC2RC, POLY2AC + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + converts the autocorrelation sequence into an AR polynomial + [A,Efinal] = ac2po + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ac2rc + + +# name: +# type: sq_string +# elements: 1 +# length: 182 + converts the autocorrelation function into reflection coefficients + [RC,r0] = ac2rc(r) + + see also ACOVF ACORF AR2RC RC2AR DURLEV AC2POLY, POLY2RC, RC2POLY, RC2AC, AC2RC, POLY2AC + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + converts the autocorrelation function into reflection coefficients + [RC,r0] = + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +acorf + + +# name: +# type: sq_string +# elements: 1 +# length: 1078 + Calculates autocorrelations for multiple data series. + Missing values in Z (NaN) are considered. + Also calculates Ljung-Box Q stats and p-values. + + [AutoCorr,stderr,lpq,qpval] = acorf(Z,N); + If mean should be removed use + [AutoCorr,stderr,lpq,qpval] = acorf(detrend(Z',0)',N); + If trend should be removed use + [AutoCorr,stderr,lpq,qpval] = acorf(detrend(Z')',N); + + INPUT + Z is data series for which autocorrelations are required + each in a row + N maximum lag + + OUTPUT + AutoCorr nr x N matrix of autocorrelations + stderr nr x N matrix of (approx) std errors + lpq nr x M matrix of Ljung-Box Q stats + qpval nr x N matrix of p-values on Q stats + + All input and output parameters are organized in rows, one row + corresponds to one series + + REFERENCES: + S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + J.S. Bendat and A.G.Persol "Random Data: Analysis and Measurement procedures", Wiley, 1986. + + + +# name: +# type: sq_string +# elements: 1 +# length: 55 + Calculates autocorrelations for multiple data series. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +acovf + + +# name: +# type: sq_string +# elements: 1 +# length: 826 + ACOVF estimates autocovariance function (not normalized) + NaN's are interpreted as missing values. + + [ACF,NN] = acovf(Z,MAXLAG,Mode); + + Input: + Z Signal (one channel per row); + MAXLAG maximum lag + Mode 'biased' : normalizes with N [default] + 'unbiased': normalizes with N-lag + 'coeff' : normalizes such that lag 0 is 1 + others : no normalization + + Output: + ACF autocovariance function + NN number of valid elements + + REFERENCES: + A.V. Oppenheim and R.W. Schafer, Digital Signal Processing, Prentice-Hall, 1975. + S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + J.S. Bendat and A.G.Persol "Random Data: Analysis and Measurement procedures", Wiley, 1986. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + ACOVF estimates autocovariance function (not normalized) + NaN's are interpreted + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +adim + + +# name: +# type: sq_string +# elements: 1 +# length: 659 + ADIM adaptive information matrix. Estimates the inverse + correlation matrix in an adaptive way. + + [IR, CC] = adim(U, UC [, IR0 [, CC0]]); + U input data + UC update coefficient 0 < UC << 1 + IR0 initial information matrix + CC0 initial correlation matrix + IR information matrix (inverse correlation matrix) + CC correlation matrix + + The algorithm uses the Matrix Inversion Lemma, also known as + "Woodbury's identity", to obtain a recursive algorithm. + IR*CC - UC*I should be approx. zero. + + Reference(s): + [1] S. Haykin. Adaptive Filter Theory, Prentice Hall, Upper Saddle River, NJ, USA + pp. 565-567, Equ. (13.16), 1996. + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 + ADIM adaptive information matrix. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +amarma + + +# name: +# type: sq_string +# elements: 1 +# length: 1501 + Adaptive Mean-AutoRegressive-Moving-Average model estimation + [z,E,ESU,REV,V,Z,SPUR] = amarma(y, mode, MOP, UC, z0, Z0, V0, W); + Estimates AAR parameters with Kalman filter algorithm + y(t) = sum_i(a(i,t)*y(t-i)) + mu(t) + E(t) + + State space model: + z(t)=G*z(t-1) + w(t) w(t)=N(0,W) + y(t)=H*z(t) + v(t) v(t)=N(0,V) + + G = I, + z = [µ(t)/(1-sum_i(a(i,t))),a_1(t-1),..,a_p(t-p),b_1(t-1),...,b_q(t-q)]; + H = [1,y(t-1),..,y(t-p),e(t-1),...,e(t-q)]; + W = E{(z(t)-G*z(t-1))*(z(t)-G*z(t-1))'} + V = E{(y(t)-H*z(t-1))*(y(t)-H*z(t-1))'} + + Input: + y Signal (AR-Process) + Mode + [0,0] uses V0 and W + + MOP Model order [m,p,q], default [0,10,0] + m=1 includes the mean term, m=0 does not. + p and q must be positive integers + it is recommended to set q=0. + UC Update Coefficient, default 0 + z0 Initial state vector + Z0 Initial Covariance matrix + + Output: + z AR-Parameter + E error process (Adaptively filtered process) + REV relative error variance MSE/MSY + + + see also: AAR + + REFERENCE(S): + [1] A. Schloegl (2000), The electroencephalogram and the adaptive autoregressive model: theory and applications. + ISBN 3-8265-7640-3 Shaker Verlag, Aachen, Germany. + [2] Schlögl A, Lee FY, Bischof H, Pfurtscheller G + Characterization of Four-Class Motor Imagery EEG Data for the BCI-Competition 2005. + Journal of neural engineering 2 (2005) 4, S. L14-L22 + + More references can be found at + http://www.dpmi.tu-graz.ac.at/~schloegl/publications/ + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Adaptive Mean-AutoRegressive-Moving-Average model estimation + [z,E,ESU,REV,V,Z, + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +ar2poly + + +# name: +# type: sq_string +# elements: 1 +# length: 603 + converts autoregressive parameters into AR polymials + Multiple polynomials can be converted. + function [A] = ar2poly(AR); + + INPUT: + AR AR parameters, each row represents one set of AR parameters + + OUTPUT + A denominator polynom + + + see also ACOVF ACORF DURLEV RC2AR FILTER FREQZ ZPLANE + + REFERENCES: + P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. + S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + converts autoregressive parameters into AR polymials + Multiple polynomials can + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +ar2rc + + +# name: +# type: sq_string +# elements: 1 +# length: 1007 + converts autoregressive parameters into reflection coefficients + with the Durbin-Levinson recursion for multiple channels + function [AR,RC,PE] = ar2rc(AR); + function [MX,PE] = ar2rc(AR); + + INPUT: + AR autoregressive model parameter + + OUTPUT + AR autoregressive model parameter + RC reflection coefficients (= -PARCOR coefficients) + PE remaining error variance (relative to PE(1)=1) + MX transformation matrix between ARP and RC (Attention: needs O(p^2) memory) + AR = MX(:,K*(K-1)/2+(1:K)); + RC = MX(:,(1:K).*(2:K+1)/2); + + All input and output parameters are organized in rows, one row + corresponds to the parameters of one channel + + see also ACOVF ACORF DURLEV RC2AR + + REFERENCES: + P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. + S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + converts autoregressive parameters into reflection coefficients + with the Durb + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +ar_spa + + +# name: +# type: sq_string +# elements: 1 +# length: 1259 + AR_SPA decomposes an AR-spectrum into its compontents + [w,A,B,R,P,F,ip] = ar_spa(AR,fs,E); + + INPUT: + AR autoregressive parameters + fs sampling rate, provide w and B in [Hz], if not given the result is in radians + E noise level (mean square), gives A and F in units of E, if not given as relative amplitude + + OUTPUT + w center frequency + A Amplitude + B bandwidth + - less important output parameters - + R residual + P poles + ip number of complex conjugate poles + real(F) power, absolute values are obtained by multiplying with noise variance E(p+1) + imag(F) assymetry, - " - + + All input and output parameters are organized in rows, one row + corresponds to the parameters of one channel + + see also ACOVF ACORF DURLEV IDURLEV PARCOR YUWA + + REFERENCES: + [1] Zetterberg L.H. (1969) Estimation of parameter for linear difference equation with application to EEG analysis. Math. Biosci., 5, 227-275. + [2] Isaksson A. and Wennberg, A. (1975) Visual evaluation and computer analysis of the EEG - A comparison. Electroenceph. clin. Neurophysiol., 38: 79-86. + [3] G. Florian and G. Pfurtscheller (1994) Autoregressive model based spectral analysis with application to EEG. IIG - Report Series, University of Technolgy Graz, Austria. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + AR_SPA decomposes an AR-spectrum into its compontents + [w,A,B,R,P,F,ip] = ar_s + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +arcext + + +# name: +# type: sq_string +# elements: 1 +# length: 738 + ARCEXT extracts AR and RC of order P from Matrix MX + function [AR,RC] = arcext(MX,P); + + INPUT: + MX AR and RC matrix calculated by durlev + P model order (default maximum possible) + + OUTPUT + AR autoregressive model parameter + RC reflection coefficients (= -PARCOR coefficients) + + All input and output parameters are organized in rows, one row + corresponds to the parameters of one channel + + see also ACOVF ACORF DURLEV + + REFERENCES: + P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. + S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + ARCEXT extracts AR and RC of order P from Matrix MX + function [AR,RC] = arcext + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +arfit2 + + +# name: +# type: sq_string +# elements: 1 +# length: 1227 + ARFIT2 estimates multivariate autoregressive parameters + of the MVAR process Y + + Y(t,:)' = w' + A1*Y(t-1,:)' + ... + Ap*Y(t-p,:)' + x(t,:)' + + ARFIT2 uses the Nutall-Strand method (multivariate Burg algorithm) + which provides better estimates the ARFIT [1], and uses the + same arguments. Moreover, ARFIT2 is faster and can deal with + missing values encoded as NaNs. + + [w, A, C, sbc, fpe] = arfit2(v, pmin, pmax, selector, no_const) + + INPUT: + v data - each channel in a column + pmin, pmax minimum and maximum model order + selector 'fpe' or 'sbc' [default] + no_const 'zero' indicates no bias/offset need to be estimated + in this case is w = [0, 0, ..., 0]'; + + OUTPUT: + w mean of innovation noise + A [A1,A2,...,Ap] MVAR estimates + C covariance matrix of innovation noise + sbc, fpe criteria for model order selection + + see also: ARFIT, MVAR + + REFERENCES: + [1] A. Schloegl, 2006, Comparison of Multivariate Autoregressive Estimators. + Signal processing, p. 2426-9. + [2] T. Schneider and A. Neumaier, 2001. + Algorithm 808: ARFIT-a Matlab package for the estimation of parameters and eigenmodes + of multivariate autoregressive models. ACM-Transactions on Mathematical Software. 27, (Mar.), 58-65. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + ARFIT2 estimates multivariate autoregressive parameters + of the MVAR process Y + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +biacovf + + +# name: +# type: sq_string +# elements: 1 +# length: 228 + BiAutoCovariance function + [BiACF] = biacovf(Z,N); + + Input: Z Signal + N # of coefficients + Output: BIACF bi-autocorrelation function (joint cumulant 3rd order + Output: ACF covariance function (joint cumulant 2nd order) + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 + BiAutoCovariance function + [BiACF] = biacovf(Z,N); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +bisdemo + + +# name: +# type: sq_string +# elements: 1 +# length: 48 + BISDEMO (script) Shows BISPECTRUM of eeg8s.mat + + + +# name: +# type: sq_string +# elements: 1 +# length: 44 + BISDEMO (script) Shows BISPECTRUM of eeg8s. + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +bispec + + +# name: +# type: sq_string +# elements: 1 +# length: 382 + Calculates Bispectrum + [BISPEC] = bispec(Z,N); + + Input: Z Signal + N # of coefficients + Output: BiACF bi-autocorrelation function = 3rd order cumulant + BISPEC Bi-spectrum + + Reference(s): + C.L. Nikias and A.P. Petropulu "Higher-Order Spectra Analysis" Prentice Hall, 1993. + M.B. Priestley, "Non-linear and Non-stationary Time series Analysis", Academic Press, London, 1988. + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 + Calculates Bispectrum + [BISPEC] = bispec(Z,N); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +content + + +# name: +# type: sq_string +# elements: 1 +# length: 1809 + Time Series Analysis (Ver 3.10) + Schloegl A. (1996-2003,2008) Time Series Analysis - A Toolbox for the use with Matlab. + WWW: http://hci.tugraz.at/~schloegl/matlab/tsa/ + + $Id: content.m 5090 2008-06-05 08:12:04Z schloegl $ + Copyright (C) 1996-2003,2008 by Alois Schloegl + + Time Series Analysis - a toolbox for the use with Matlab + aar adaptive autoregressive estimator + acovf (*) Autocovariance function + acorf (acf) (*) autocorrelation function + pacf (*) partial autocorrelation function, includes signifcance test and confidence interval + parcor (*) partial autocorrelation function + biacovf biautocovariance function (3rd order cumulant) + bispec Bi-spectrum + durlev (*) solves Yule-Walker equation - converts ACOVF into AR parameters + lattice (*) calcultes AR parameters with lattice method + lpc (*) calculates the prediction coefficients form a given time series + invest0 (*) a prior investigation (used by invest1) + invest1 (*) investigates signal (useful for 1st evaluation of the data) + selmo (*) Select Order of Autoregressive model using different criteria + histo (*) histogram + hup (*) test Hurwitz polynomials + ucp (*) test Unit Circle Polynomials + y2res (*) computes mean, variance, skewness, kurtosis, entropy, etc. from data series + ar_spa (*) spectral analysis based on the autoregressive model + detrend (*) removes trend, can handle missing values, non-equidistant sampled data + flix floating index, interpolates data for non-interger indices + quantiles calculates quantiles + + Multivariate analysis (planned in future) + mvar multivariate (vector) autoregressive estimation + mvfilter multivariate filter + arfit2 provides compatibility to ARFIT [Schneider and Neumaier, 2001] + + + +# name: +# type: sq_string +# elements: 1 +# length: 29 + Time Series Analysis (Ver 3. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +contents + + +# name: +# type: sq_string +# elements: 1 +# length: 5874 + Time Series Analysis - A toolbox for the use with Matlab and Octave. + + $Id: contents.m 5090 2008-06-05 08:12:04Z schloegl $ + Copyright (C) 1996-2004,2008 by Alois Schloegl + WWW: http://hci.tugraz.at/~schloegl/matlab/tsa/ + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + + + Time Series Analysis - a toolbox for the use with Matlab + aar adaptive autoregressive estimator + acovf (*) Autocovariance function + acorf (acf) (*) autocorrelation function + pacf (*) partial autocorrelation function, includes signifcance test and confidence interval + parcor (*) partial autocorrelation function + biacovf biautocovariance function (3rd order cumulant) + bispec Bi-spectrum + durlev (*) solves Yule-Walker equation - converts ACOVF into AR parameters + lattice (*) calcultes AR parameters with lattice method + lpc (*) calculates the prediction coefficients form a given time series + invest0 (*) a prior investigation (used by invest1) + invest1 (*) investigates signal (useful for 1st evaluation of the data) + rmle AR estimation using recursive maximum likelihood function + selmo (*) Select Order of Autoregressive model using different criteria + histo (*) histogram + hup (*) test Hurwitz polynomials + ucp (*) test Unit Circle Polynomials + y2res (*) computes mean, variance, skewness, kurtosis, entropy, etc. from data series + ar_spa (*) spectral analysis based on the autoregressive model + detrend (*) removes trend, can handle missing values, non-equidistant sampled data + flix floating index, interpolates data for non-interger indices + + + Multivariate analysis + adim adaptive information matrix (inverse correlation matrix) + mvar multivariate (vector) autoregressive estimation + mvaar multivariate adaptvie autoregressive estimation using Kalman filtering + mvfilter multivariate filter + mvfreqz multivariate spectra + arfit2 provides compatibility to ARFIT [Schneider and Neumaier, 2001] + + + Conversions between Autocorrelation (AC), Autoregressive parameters (AR), + prediction polynom (POLY) and Reflection coefficient (RC) + ac2poly (*) transforms autocorrelation into prediction polynom + ac2rc (*) transforms autocorrelation into reflexion coefficients + ar2rc (*) transforms autoregressive parameters into reflection coefficients + rc2ar (*) transforms reflection coefficients into autoregressive parameters + poly2ac (*) transforms polynom to autocorrelation + poly2ar (*) transforms polynom to AR + poly2rc (*) + rc2ac (*) + rc2poly (*) + ar2poly (*) + + Utility functions + sinvest1 shows the parameter calculated by INVEST1 + + Test suites + tsademo demonstrates INVEST1 on EEG data + invfdemo demonstration of matched, inverse filtering + bisdemo demonstrates bispectral estimation + + (*) indicates univariate analysis of multiple data series (each in a row) can be processed. + (-) indicates that these functions will be removed in future + + REFERENCES (sources): + http://www.itl.nist.gov/ + http://mathworld.wolfram.com/ + P.J. Brockwell and R.A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. + O. Foellinger "Lineare Abtastsysteme", Oldenburg Verlag, Muenchen, 1986. + F. Gausch "Systemtechnik", Textbook, University of Technology Graz, 1993. + M.S. Grewal and A.P. Andrews "Kalman Filtering" Prentice Hall, 1993. + S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. + E.I. Jury "Theory and Application of the z-Transform Method", Robert E. Krieger Publishing Co., 1973. + M.S. Kay "Modern Spectal Estimation" Prentice Hall, 1988. + Ch. Langraf and G. Schneider "Elemente der Regeltechnik", Springer Verlag, 1970. + S.L. Marple "Digital Spetral Analysis with Applications" Prentice Hall, 1987. + C.L. Nikias and A.P. Petropulu "Higher-Order Spectra Analysis" Prentice Hall, 1993. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + T. Schneider and A. Neumaier "Algorithm 808: ARFIT - a matlab package for the estimation of parameters and eigenmodes of multivariate autoregressive models" + ACM Transactions on Mathematical software, 27(Mar), 58-65. + C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + + + REFERENCES (applications): + [1] A. Schlögl, B. Kemp, T. Penzel, D. Kunz, S.-L. Himanen,A. Värri, G. Dorffner, G. Pfurtscheller. + Quality Control of polysomnographic Sleep Data by Histogram and Entropy Analysis. + Clin. Neurophysiol. 1999, Dec; 110(12): 2165 - 2170. + [2] Penzel T, Kemp B, Klösch G, Schlögl A, Hasan J, Varri A, Korhonen I. + Acquisition of biomedical signals databases + IEEE Engineering in Medicine and Biology Magazine 2001, 20(3): 25-32 + [3] Alois Schlögl (2000) + The electroencephalogram and the adaptive autoregressive model: theory and applications + Shaker Verlag, Aachen, Germany,(ISBN3-8265-7640-3). + + Features: + - Multiple Signal Processing + - Efficient algorithms + - Model order selection tools + - higher (3rd) order analysis + - Maximum entropy spectral estimation + - can deal with missing values (NaN's) + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 + Time Series Analysis - A toolbox for the use with Matlab and Octave. + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +covm + + +# name: +# type: sq_string +# elements: 1 +# length: 1182 + COVM generates covariance matrix + X and Y can contain missing values encoded with NaN. + NaN's are skipped, NaN do not result in a NaN output. + The output gives NaN only if there are insufficient input data + + COVM(X,Mode); + calculates the (auto-)correlation matrix of X + COVM(X,Y,Mode); + calculates the crosscorrelation between X and Y + COVM(...,W); + weighted crosscorrelation + + Mode = 'M' minimum or standard mode [default] + C = X'*X; or X'*Y correlation matrix + + Mode = 'E' extended mode + C = [1 X]'*[1 X]; % l is a matching column of 1's + C is additive, i.e. it can be applied to subsequent blocks and summed up afterwards + the mean (or sum) is stored on the 1st row and column of C + + Mode = 'D' or 'D0' detrended mode + the mean of X (and Y) is removed. If combined with extended mode (Mode='DE'), + the mean (or sum) is stored in the 1st row and column of C. + The default scaling is factor (N-1). + Mode = 'D1' is the same as 'D' but uses N for scaling. + + C = covm(...); + C is the scaled by N in Mode M and by (N-1) in mode D. + [C,N] = covm(...); + C is not scaled, provides the scaling factor N + C./N gives the scaled version. + + see also: DECOVM, XCOVF + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + COVM generates covariance matrix + X and Y can contain missing values encoded wi + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +detrend + + +# name: +# type: sq_string +# elements: 1 +# length: 837 + DETREND removes the trend from data, NaN's are considered as missing values + + DETREND is fully compatible to previous Matlab and Octave DETREND with the following features added: + - handles NaN's by assuming that these are missing values + - handles unequally spaced data + - second output parameter gives the trend of the data + - compatible to Matlab and Octave + + [...]=detrend([t,] X [,p]) + removes trend for unequally spaced data + t represents the time points + X(i) is the value at time t(i) + p must be a scalar + + [...]=detrend(X,0) + [...]=detrend(X,'constant') + removes the mean + + [...]=detrend(X,p) + removes polynomial of order p (default p=1) + + [...]=detrend(X,1) - default + [...]=detrend(X,'linear') + removes linear trend + + [X,T]=detrend(...) + + X is the detrended data + T is the removed trend + + see also: SUMSKIPNAN, ZSCORE + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + DETREND removes the trend from data, NaN's are considered as missing values + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +durlev + + +# name: +# type: sq_string +# elements: 1 +# length: 1241 + function [AR,RC,PE] = durlev(ACF); + function [MX,PE] = durlev(ACF); + estimates AR(p) model parameter by solving the + Yule-Walker with the Durbin-Levinson recursion + for multiple channels + INPUT: + ACF Autocorrelation function from lag=[0:p] + + OUTPUT + AR autoregressive model parameter + RC reflection coefficients (= -PARCOR coefficients) + PE remaining error variance + MX transformation matrix between ARP and RC (Attention: needs O(p^2) memory) + AR(:,K) = MX(:,K*(K-1)/2+(1:K)); + RC(:,K) = MX(:,(1:K).*(2:K+1)/2); + + All input and output parameters are organized in rows, one row + corresponds to the parameters of one channel + + see also ACOVF ACORF AR2RC RC2AR LATTICE + + REFERENCES: + Levinson N. (1947) "The Wiener RMS(root-mean-square) error criterion in filter design and prediction." J. Math. Phys., 25, pp.261-278. + Durbin J. (1960) "The fitting of time series models." Rev. Int. Stat. Inst. vol 28., pp 233-244. + P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. + S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + function [AR,RC,PE] = durlev(ACF); + function [MX,PE] = durlev(ACF); + estimate + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 +flag_implicit_samplerate + + +# name: +# type: sq_string +# elements: 1 +# length: 135 + The use of FLAG_IMPLICIT_SAMPLERATE is in experimental state. + FLAG_IMPLICIT_SAMPLERATE might even become obsolete. + Do not use it. + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 + The use of FLAG_IMPLICIT_SAMPLERATE is in experimental state. + + + +# name: +# type: sq_string +# elements: 1 +# length: 22 +flag_implicit_skip_nan + + +# name: +# type: sq_string +# elements: 1 +# length: 934 + FLAG_IMPLICIT_SKIP_NAN sets and gets default mode for handling NaNs + 1 skips NaN's (the default mode if no mode is set) + 0 NaNs are propagated; input NaN's give NaN's at the output + + FLAG = flag_implicit_skip_nan() + gets current mode + + flag_implicit_skip_nan(FLAG) + sets mode + + prevFLAG = flag_implicit_skip_nan(nextFLAG) + gets previous set FLAG and sets FLAG for the future + flag_implicit_skip_nan(prevFLAG) + resets FLAG to previous mode + + It is used in: + SUMSKIPNAN, MEDIAN, QUANTILES, TRIMEAN + and affects many other functions like: + CENTER, KURTOSIS, MAD, MEAN, MOMENT, RMS, SEM, SKEWNESS, + STATISTIC, STD, VAR, ZSCORE etc. + + The mode is stored in the global variable FLAG_implicit_skip_nan + It is recommended to use flag_implicit_skip_nan(1) as default and + flag_implicit_skip_nan(0) should be used for exceptional cases only. + This feature might disappear without further notice, so you should really not + rely on it. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + FLAG_IMPLICIT_SKIP_NAN sets and gets default mode for handling NaNs + 1 skips Na + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +flix + + +# name: +# type: sq_string +# elements: 1 +# length: 603 + floating point index - interpolates data in case of non-integer indices + + Y=flix(D,x) + FLIX returns Y=D(x) if x is an integer + otherwise D(x) is interpolated from the neighbors D(ceil(x)) and D(floor(x)) + + Applications: + (1) discrete Dataseries can be upsampled to higher sampling rate + (2) transformation of non-equidistant samples to equidistant samples + (3) [Q]=flix(sort(D),q*(length(D)+1)) calculates the q-quantile of data series D + + FLIX(D,x) is the same as INTERP1(D,X,'linear'); Therefore, FLIX might + become obsolete in future. + + see also: HIST2RES, Y2RES, PLOTCDF, INTERP1 + + + +# name: +# type: sq_string +# elements: 1 +# length: 73 + floating point index - interpolates data in case of non-integer indices + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +histo + + +# name: +# type: sq_string +# elements: 1 +# length: 581 + HISTO calculates histogram for each column + [H,X] = HISTO(Y,Mode) + + Mode + 'rows' : frequency of each row + '1x' : single bin-values + 'nx' : separate bin-values for each column + X are the bin-values + H is the frequency of occurence of value X + + HISTO(Y) with no output arguments: + plots the histogram bar(X,H) + + more histogram-based results can be obtained by HIST2RES2 + + see also: HISTO, HISTO2, HISTO3, HISTO4 + + REFERENCE(S): + C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + HISTO calculates histogram for each column + [H,X] = HISTO(Y,Mode) + + Mode + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +histo2 + + +# name: +# type: sq_string +# elements: 1 +# length: 1009 + HISTO2 calculates histogram for multiple columns with separate bin values + for each data column. + + R = HISTO2(Y) + R = HISTO2(Y, W) + Y data + W weight vector containing weights of each sample, + number of rows of Y and W must match. + default W=[] indicates that each sample is weighted with 1. + + R = HISTO(...) + R is a struct with th fields + R.X the bin-values, bin-values are computed separately for each + data column, thus R.X is a matrix, each column contains the + the bin values of for each data column, unused elements are indicated with NaN. + In order to have common bin values, use HISTO3. + R.H is the frequency of occurence of value X + R.N are the number of valid (not NaN) samples (i.e. sum of weights) + + more histogram-based results can be obtained by HIST2RES2 + + see also: HISTO, HISTO2, HISTO3, HISTO4 + + REFERENCE(S): + C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + HISTO2 calculates histogram for multiple columns with separate bin values + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +histo3 + + +# name: +# type: sq_string +# elements: 1 +# length: 1266 + HISTO3 calculates histogram for multiple columns with common bin values + among all data columns, and can be useful for data compression. + + R = HISTO3(Y) + R = HISTO3(Y, W) + Y data + W weight vector containing weights of each sample, + number of rows of Y and W must match. + default W=[] indicates that each sample is weighted with 1. + R struct with these fields + R.X the bin-values, bin-values are equal for each channel + thus R.X is a column vector. If bin values should + be computed separately for each data column, use HISTO2 + R.H is the frequency of occurence of value X + R.N are the number of valid (not NaN) samples + + Data compression can be performed in this way + [R,tix] = histo3(Y) + is the compression step + + R.tix provides a compressed data representation. + R.compressionratio estimates the compression ratio + + R.X(tix) and R.X(R.tix) + reconstruct the orginal signal (decompression) + + The effort (in memory and speed) for compression is O(n*log(n)). + The effort (in memory and speed) for decompression is O(n) only. + + see also: HISTO, HISTO2, HISTO3, HISTO4 + + REFERENCE(S): + C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + HISTO3 calculates histogram for multiple columns with common bin values + am + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +histo4 + + +# name: +# type: sq_string +# elements: 1 +# length: 965 + HISTO4 calculates histogram of multidimensional data samples + and supports data compression + + R = HISTO4(Y) + R = HISTO4(Y, W) + Y data: on sample per row, each sample has with size(Y,2) elements + W weights of each sample (default: []) + W = [] indicates that each sample has equal weight + R is a struct with these fields: + R.X are the bin-values + R.H is the frequency of occurence of value X (weighted with W) + R.N are the total number of samples (or sum of W) + + HISTO4 might be useful for data compression, because + [R,tix] = histo4(Y) + is the compression step + R.X(tix,:) + is the decompression step + + The effort (in memory and speed) for compression is O(n*log(n)) + The effort (in memory and speed) for decompression is only O(n) + + see also: HISTO, HISTO2, HISTO3, HISTO4 + + REFERENCE(S): + C.E. Shannon and W. Weaver 'The mathematical theory of communication' University of Illinois Press, Urbana 1949 (reprint 1963). + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + HISTO4 calculates histogram of multidimensional data samples + and supports d + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +hup + + +# name: +# type: sq_string +# elements: 1 +# length: 588 +HUP(C) tests if the polynomial C is a Hurwitz-Polynomial. + It tests if all roots lie in the left half of the complex + plane + B=hup(C) is the same as + B=all(real(roots(c))<0) but much faster. + The Algorithm is based on the Routh-Scheme. + C are the elements of the Polynomial + C(1)*X^N + ... + C(N)*X + C(N+1). + + HUP2 works also for multiple polynomials, + each row a poly - Yet not tested + + REFERENCES: + F. Gausch "Systemtechnik", Textbook, University of Technology Graz, 1993. + Ch. Langraf and G. Schneider "Elemente der Regeltechnik", Springer Verlag, 1970. + + + +# name: +# type: sq_string +# elements: 1 +# length: 57 +HUP(C) tests if the polynomial C is a Hurwitz-Polynomial. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +invest0 + + +# name: +# type: sq_string +# elements: 1 +# length: 842 + First Investigation of a signal (time series) - automated part + [AutoCov,AutoCorr,ARPMX,E,ACFsd,NC]=invest0(Y,Pmax); + + [AutoCov,AutoCorr,ARPMX,E,ACFsd,NC]=invest0(AutoCov,Pmax,Mode); + + + Y time series + Pmax maximal order (optional) + + AutoCov Autocorrelation + AutoCorr normalized Autocorrelation + PartACF Partial Autocorrelation + ARPMX Autoregressive Parameter for order Pmax-1 + E Error function E(p) + NC Number of values (length-missing values) + + REFERENCES: + P.J. Brockwell and R.A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. + M.S. Grewal and A.P. Andrews "Kalman Filtering" Prentice Hall, 1993. + S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + First Investigation of a signal (time series) - automated part + [AutoCov,AutoCo + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +invest1 + + +# name: +# type: sq_string +# elements: 1 +# length: 1306 + First Investigation of a signal (time series) - interactive + [AutoCov,AutoCorr,ARPMX,E,CRITERIA,MOPS]=invest1(Y,Pmax,show); + + Y time series + Pmax maximal order (optional) + show optional; if given the parameters are shown + + AutoCov Autocorrelation + AutoCorr normalized Autocorrelation + PartACF Partial Autocorrelation + E Error function E(p) + CRITERIA curves of the various (see below) criteria, + MOPS=[optFPE optAIC optBIC optSBC optMDL optCAT optPHI]; + optimal model order according to various criteria + + FPE Final Prediction Error (Kay, 1987) + AIC Akaike Information Criterion (Marple, 1987) + BIC Bayesian Akaike Information Criterion (Wei, 1994) + SBC Schwartz's Bayesian Criterion (Wei, 1994) + MDL Minimal Description length Criterion (Marple, 1987) + CAT Parzen's CAT Criterion (Wei, 1994) + PHI Phi criterion (Pukkila et al. 1988) + minE order where E is minimal + + REFERENCES: + P.J. Brockwell and R.A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. + S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + First Investigation of a signal (time series) - interactive + [AutoCov,AutoCorr, + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +invfdemo + + +# name: +# type: sq_string +# elements: 1 +# length: 41 + invfdemo demonstrates Inverse Filtering + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 + invfdemo demonstrates Inverse Filtering + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +lattice + + +# name: +# type: sq_string +# elements: 1 +# length: 1531 + Estimates AR(p) model parameter with lattice algorithm (Burg 1968) + for multiple channels. + If you have the NaN-tools, LATTICE.M can handle missing values (NaN), + + [...] = lattice(y [,Pmax [,Mode]]); + + [AR,RC,PE] = lattice(...); + [MX,PE] = lattice(...); + + INPUT: + y signal (one per row), can contain missing values (encoded as NaN) + Pmax max. model order (default size(y,2)-1)) + Mode 'BURG' (default) Burg algorithm + 'GEOL' geometric lattice + + OUTPUT + AR autoregressive model parameter + RC reflection coefficients (= -PARCOR coefficients) + PE remaining error variance + MX transformation matrix between ARP and RC (Attention: needs O(p^2) memory) + AR(:,K) = MX(:, K*(K-1)/2+(1:K)); = MX(:,sum(1:K-1)+(1:K)); + RC(:,K) = MX(:,cumsum(1:K)); = MX(:,(1:K).*(2:K+1)/2); + + All input and output parameters are organized in rows, one row + corresponds to the parameters of one channel + + see also ACOVF ACORF AR2RC RC2AR DURLEV SUMSKIPNAN + + REFERENCE(S): + J.P. Burg, "Maximum Entropy Spectral Analysis" Proc. 37th Meeting of the Society of Exp. Geophysiscists, Oklahoma City, OK 1967 + J.P. Burg, "Maximum Entropy Spectral Analysis" PhD-thesis, Dept. of Geophysics, Stanford University, Stanford, CA. 1975. + P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. + S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Estimates AR(p) model parameter with lattice algorithm (Burg 1968) + for multip + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +lpc + + +# name: +# type: sq_string +# elements: 1 +# length: 759 + LPC Linear prediction coefficients + The Burg-method is used to estimate the prediction coefficients + + A = lpc(Y [,P]) finds the coefficients A=[ 1 A(2) ... A(N+1) ], + of an Pth order forward linear predictor + + Xp(n) = -A(2)*X(n-1) - A(3)*X(n-2) - ... - A(N+1)*X(n-P) + + such that the sum of the squares of the errors + + err(n) = X(n) - Xp(n) + + is minimized. X can be a vector or a matrix. If X is a matrix + containing a separate signal in each column, LPC returns a model + estimate for each column in the rows of A. N specifies the order + of the polynomial A(z). + + If you do not specify a value for P, LPC uses a default P = length(X)-1. + + + see also ACOVF ACORF AR2POLY RC2AR DURLEV SUMSKIPNAN LATTICE + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + LPC Linear prediction coefficients + The Burg-method is used to estimate the pr + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +mvaar + + +# name: +# type: sq_string +# elements: 1 +# length: 784 + Multivariate (Vector) adaptive AR estimation base on a multidimensional + Kalman filer algorithm. A standard VAR model (A0=I) is implemented. The + state vector is defined as X=(A1|A2...|Ap) and x=vec(X') + + [x,e,Kalman,Q2] = mvaar(y,p,UC,mode,Kalman) + + The standard MVAR model is defined as: + + y(n)-A1(n)*y(n-1)-...-Ap(n)*y(n-p)=e(n) + + The dimension of y(n) equals s + + Input Parameters: + + y Observed data or signal + p prescribed maximum model order (default 1) + UC update coefficient (default 0.001) + mode update method of the process noise covariance matrix 0...4 ^ + correspond to S0...S4 (default 0) + + Output Parameters + + e prediction error of dimension s + x state vector of dimension s*s*p + Q2 measurement noise covariance matrix of dimension s x s + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Multivariate (Vector) adaptive AR estimation base on a multidimensional + Kalman + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +mvar + + +# name: +# type: sq_string +# elements: 1 +# length: 3018 + MVAR estimates parameters of the Multi-Variate AutoRegressive model + + Y(t) = Y(t-1) * A1 + ... + Y(t-p) * Ap + X(t); + whereas + Y(t) is a row vecter with M elements Y(t) = y(t,1:M) + + Several estimation algorithms are implemented, all estimators + can handle data with missing values encoded as NaNs. + + [AR,RC,PE] = mvar(Y, p); + [AR,RC,PE] = mvar(Y, p, Mode); + + with + AR = [A1, ..., Ap]; + + INPUT: + Y Multivariate data series + p Model order + Mode determines estimation algorithm + + OUTPUT: + AR multivariate autoregressive model parameter + RC reflection coefficients (= -PARCOR coefficients) + PE remaining error variances for increasing model order + PE(:,p*M+[1:M]) is the residual variance for model order p + + All input and output parameters are organized in columns, one column + corresponds to the parameters of one channel. + + Mode determines estimation algorithm. + 1: Correlation Function Estimation method using biased correlation function estimation method + also called the 'multichannel Yule-Walker' [1,2] + 6: Correlation Function Estimation method using unbiased correlation function estimation method + + 2: Partial Correlation Estimation: Vieira-Morf [2] using unbiased covariance estimates. + In [1] this mode was used and (incorrectly) denominated as Nutall-Strand. + Its the DEFAULT mode; according to [1] it provides the most accurate estimates. + 5: Partial Correlation Estimation: Vieira-Morf [2] using biased covariance estimates. + Yields similar results than Mode=2; + + 3: buggy: Partial Correlation Estimation: Nutall-Strand [2] (biased correlation function) + 9: Partial Correlation Estimation: Nutall-Strand [2] (biased correlation function) + 7: Partial Correlation Estimation: Nutall-Strand [2] (unbiased correlation function) + 8: Least Squares w/o nans in Y(t):Y(t-p) + 10: ARFIT [3] + 11: BURGV [4] + 13: modified BURGV - + 14: modified BURGV [4] + 15: Least Squares based on correlation matrix + 22: Modified Partial Correlation Estimation: Vieira-Morf [2,5] using unbiased covariance estimates. + 25: Modified Partial Correlation Estimation: Vieira-Morf [2,5] using biased covariance estimates. + + 90,91,96: Experimental versions + + Imputation methods: + 100+Mode: + 200+Mode: forward, past missing values are assumed zero + 300+Mode: backward, past missing values are assumed zero + 400+Mode: forward+backward, past missing values are assumed zero + 1200+Mode: forward, past missing values are replaced with predicted value + 1300+Mode: backward, 'past' missing values are replaced with predicted value + 1400+Mode: forward+backward, 'past' missing values are replaced with predicted value + 2200+Mode: forward, past missing values are replaced with predicted value + noise to prevent decaying + 2300+Mode: backward, past missing values are replaced with predicted value + noise to prevent decaying + 2400+Mode: forward+backward, past missing values are replaced with predicted value + noise to prevent decaying + + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 70 + MVAR estimates parameters of the Multi-Variate AutoRegressive model + + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +mvfilter + + +# name: +# type: sq_string +# elements: 1 +# length: 1028 + Multi-variate filter function + + Y = MVFILTER(B,A,X) + [Y,Z] = MVFILTER(B,A,X,Z) + + Y = MVFILTER(B,A,X) filters the data in matrix X with the + filter described by cell arrays A and B to create the filtered + data Y. The filter is a 'Direct Form II Transposed' + implementation of the standard difference equation: + + a0*Y(n) = b0*X(:,n) + b1*X(:,n-1) + ... + bq*X(:,n-q) + - a1*Y(:,n-1) - ... - ap*Y(:,n-p) + + A=[a0,a1,a2,...,ap] and B=[b0,b1,b2,...,bq] must be matrices of + size Mx((p+1)*M) and Mx((q+1)*M), respectively. + a0,a1,...,ap, b0,b1,...,bq are matrices of size MxM + a0 is usually the identity matrix I or must be invertible + X should be of size MxN, if X has size NxM a warning + is raised, and the output Y is also transposed. + + A simulated MV-AR process can be generiated with + Y = mvfilter(eye(M), [eye(M),-AR],randn(M,N)); + + A multivariate inverse filter can be realized with + [AR,RC,PE] = mvar(Y,P); + E = mvfilter([eye(M),-AR],eye(M),Y); + + see also: MVAR, FILTER + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 + Multi-variate filter function + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +mvfreqz + + +# name: +# type: sq_string +# elements: 1 +# length: 3844 + MVFREQZ multivariate frequency response + [S,h,PDC,COH,DTF,DC,pCOH,dDTF,ffDTF,pCOH2,PDCF,coh,GGC,Af,GPDC] = mvfreqz(B,A,C,f,Fs) + [...] = mvfreqz(B,A,C,N,Fs) + + INPUT: + ======= + A, B multivariate polynomials defining the transfer function + + a0*Y(n) = b0*X(n) + b1*X(n-1) + ... + bq*X(n-q) + - a1*Y(n-1) - ... - ap*Y(:,n-p) + + A=[a0,a1,a2,...,ap] and B=[b0,b1,b2,...,bq] must be matrices of + size Mx((p+1)*M) and Mx((q+1)*M), respectively. + + C is the covariance of the input noise X (i.e. D'*D if D is the mixing matrix) + N if scalar, N is the number of frequencies + if N is a vector, N are the designated frequencies. + Fs sampling rate [default 2*pi] + + A,B,C and D can by obtained from a multivariate time series + through the following commands: + [AR,RC,PE] = mvar(Y,P); + M = size(AR,1); % number of channels + A = [eye(M),-AR]; + B = eye(M); + C = PE(:,M*P+1:M*(P+1)); + + Fs sampling rate in [Hz] + (N number of frequencies for computing the spectrum, this will become OBSOLETE), + f vector of frequencies (in [Hz]) + + + OUTPUT: + ======= + S power spectrum + h transfer functions, abs(h.^2) is the non-normalized DTF [11] + PDC partial directed coherence [2] + DC directed coupling + COH coherency (complex coherence) [5] + DTF directed transfer function + pCOH partial coherence + dDTF direct Directed Transfer function + ffDTF full frequency Directed Transfer Function + pCOH2 partial coherence - alternative method + GGC a modified version of Geweke's Granger Causality [Geweke 1982] + !!! it uses a Multivariate AR model, and computes the bivariate GGC as in [Bressler et al 2007]. + This is not the same as using bivariate AR models and GGC as in [Bressler et al 2007] + Af Frequency transform of A(z), abs(Af.^2) is the non-normalized PDC [11] + PDCF Partial Directed Coherence Factor [2] + GPDC Generalized Partial Directed Coherence [9,10] + + see also: FREQZ, MVFILTER, MVAR + + REFERENCE(S): + [1] H. Liang et al. Neurocomputing, 32-33, pp.891-896, 2000. + [2] L.A. Baccala and K. Samashima, Biol. Cybern. 84,463-474, 2001. + [3] A. Korzeniewska, et al. Journal of Neuroscience Methods, 125, 195-207, 2003. + [4] Piotr J. Franaszczuk, Ph.D. and Gregory K. Bergey, M.D. + Fast Algorithm for Computation of Partial Coherences From Vector Autoregressive Model Coefficients + World Congress 2000, Chicago. + [5] Nolte G, Bai O, Wheaton L, Mari Z, Vorbach S, Hallett M. + Identifying true brain interaction from EEG data using the imaginary part of coherency. + Clin Neurophysiol. 2004 Oct;115(10):2292-307. + [6] Schlogl A., Supp G. + Analyzing event-related EEG data with multivariate autoregressive parameters. + (Eds.) C. Neuper and W. Klimesch, + Progress in Brain Research: Event-related Dynamics of Brain Oscillations. + Analysis of dynamics of brain oscillations: methodological advances. Elsevier. + Progress in Brain Research 159, 2006, p. 135 - 147 + [7] Bressler S.L., Richter C.G., Chen Y., Ding M. (2007) + Cortical fuctional network organization from autoregressive modelling of loal field potential oscillations. + Statistics in Medicine, doi: 10.1002/sim.2935 + [8] Geweke J., 1982 + J.Am.Stat.Assoc., 77, 304-313. + [9] L.A. Baccala, D.Y. Takahashi, K. Sameshima. (2006) + Generalized Partial Directed Coherence. + Submitted to XVI Congresso Brasileiro de Automatica, Salvador, Bahia. + [10] L.A. Baccala, D.Y. Takahashi, K. Sameshima. + Computer Intensive Testing for the Influence Between Time Series, + Eds. B. Schelter, M. Winterhalder, J. Timmer: + Handbook of Time Series Analysis - Recent Theoretical Developments and Applications + Wiley, p.413, 2006. + [11] M. Eichler + On the evaluation of informatino flow in multivariate systems by the directed transfer function + Biol. Cybern. 94: 469-482, 2006. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + MVFREQZ multivariate frequency response + [S,h,PDC,COH,DTF,DC,pCOH,dDTF,ffDTF,pC + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +pacf + + +# name: +# type: sq_string +# elements: 1 +# length: 137 + Partial Autocorrelation function + [parcor,sig,cil,ciu] = pacf(Z,N); + + Input: + Z Signal, each row is analysed + N # of coefficients + + + +# name: +# type: sq_string +# elements: 1 +# length: 69 + Partial Autocorrelation function + [parcor,sig,cil,ciu] = pacf(Z,N); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +parcor + + +# name: +# type: sq_string +# elements: 1 +# length: 1160 + estimates partial autocorrelation coefficients + Multiple channels can be used (one per row). + + [PARCOR, AR, PE] = parcor(AutoCov); % calculates Partial autocorrelation, autoregressive coefficients and residual error variance from the Autocorrelation function. + + [PARCOR] = parcor(acovf(x,p)); % calculates the Partial Autocorrelation coefficients of the data series x up to order p + + INPUT: + AutoCov Autocorrelation function for lag=0:P + + OUTPUT + AR autoregressive model parameter + PARCOR partial correlation coefficients (= -reflection coefficients) + PE remaining error variance + + All input and output parameters are organized in rows, one row + corresponds to the parameters of one channel. + The PARCOR coefficients are the negative reflection coefficients. + A significance test is implemented in PACF. + + see also: PACF ACOVF ACORF DURLEV AC2RC + + REFERENCES: + P.J. Brockwell and R.A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. + S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + estimates partial autocorrelation coefficients + Multiple channels can be used + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +poly2ac + + +# name: +# type: sq_string +# elements: 1 +# length: 183 + converts an AR polynomial into an autocorrelation sequence + [R] = poly2ac(a [,efinal] ); + + see also ACOVF ACORF AR2RC RC2AR DURLEV AC2POLY, POLY2RC, RC2POLY, RC2AC, AC2RC, POLY2AC + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + converts an AR polynomial into an autocorrelation sequence + [R] = poly2ac(a [,e + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +poly2ar + + +# name: +# type: sq_string +# elements: 1 +# length: 288 + Converts AR polymials into autoregressive parameters. + Multiple polynomials can be converted. + + function [AR] = poly2ar(A); + + INPUT: + A AR polynomial, each row represents one polynomial + + OUTPUT + AR autoregressive model parameter + + see also ACOVF ACORF DURLEV RC2AR AR2POLY + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 + Converts AR polymials into autoregressive parameters. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +poly2rc + + +# name: +# type: sq_string +# elements: 1 +# length: 434 + converts AR-polynomial into reflection coefficients + [RC,R0] = poly2rc(A [,Efinal]) + + INPUT: + A AR polynomial, each row represents one polynomial + Efinal is the final prediction error variance (default value 1) + + OUTPUT + RC reflection coefficients + R0 is the variance (autocovariance at lag=0) based on the + prediction error + + + see also ACOVF ACORF AR2RC RC2AR DURLEV AC2POLY, POLY2RC, RC2POLY, RC2AC, AC2RC, POLY2AC + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + converts AR-polynomial into reflection coefficients + [RC,R0] = poly2rc(A [,Efin + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +rc2ac + + +# name: +# type: sq_string +# elements: 1 +# length: 176 + converts reflection coefficients to autocorrelation sequence + [R] = rc2ac(RC,R0); + + see also ACOVF ACORF AR2RC RC2AR DURLEV AC2POLY, POLY2RC, RC2POLY, RC2AC, AC2RC, POLY2AC + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + converts reflection coefficients to autocorrelation sequence + [R] = rc2ac(RC,R0 + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +rc2ar + + +# name: +# type: sq_string +# elements: 1 +# length: 1000 + converts reflection coefficients into autoregressive parameters + uses the Durbin-Levinson recursion for multiple channels + function [AR,RC,PE,ACF] = rc2ar(RC); + function [MX,PE] = rc2ar(RC); + + INPUT: + RC reflection coefficients + + OUTPUT + AR autoregressive model parameter + RC reflection coefficients (= -PARCOR coefficients) + PE remaining error variance (relative to PE(1)=1) + MX transformation matrix between ARP and RC (Attention: needs O(p^2) memory) + arp=MX(:,K*(K-1)/2+(1:K)); + rc =MX(:,(1:K).*(2:K+1)/2); + + All input and output parameters are organized in rows, one row + corresponds to the parameters of one channel + + see also ACOVF ACORF DURLEV AR2RC + + REFERENCES: + P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. + S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + converts reflection coefficients into autoregressive parameters + uses the Durbi + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +rc2poly + + +# name: +# type: sq_string +# elements: 1 +# length: 174 + converts reflection coefficients into an AR-polynomial + [a,efinal] = rc2poly(K) + + see also ACOVF ACORF AR2RC RC2AR DURLEV AC2POLY, POLY2RC, RC2POLY, RC2AC, AC2RC, POLY2AC + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + converts reflection coefficients into an AR-polynomial + [a,efinal] = rc2poly(K) + + + +# name: +# type: sq_string +# elements: 1 +# length: 4 +rmle + + +# name: +# type: sq_string +# elements: 1 +# length: 432 + RMLE estimates AR Parameters using the Recursive Maximum Likelihood + Estimator according to [1] + + Use: [a,VAR]=rmle(x,p) + Input: + x is a column vector of data + p is the model order + Output: + a is a vector with the AR parameters of the recursive MLE + VAR is the excitation white noise variance estimate + + Reference(s): + [1] Kay S.M., Modern Spectral Analysis - Theory and Applications. + Prentice Hall, p. 232-233, 1988. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + RMLE estimates AR Parameters using the Recursive Maximum Likelihood + Estimator + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +sbispec + + +# name: +# type: sq_string +# elements: 1 +# length: 26 + SBISPEC show BISPECTRUM + + + +# name: +# type: sq_string +# elements: 1 +# length: 26 + SBISPEC show BISPECTRUM + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +selmo + + +# name: +# type: sq_string +# elements: 1 +# length: 2179 + Model order selection of an autoregrssive model + [FPE,AIC,BIC,SBC,MDL,CAT,PHI,optFPE,optAIC,optBIC,optSBC,optMDL,optCAT,optPHI]=selmo(E,N); + + E Error function E(p) + N length of the data set, that was used for calculating E(p) + show optional; if given the parameters are shown + + FPE Final Prediction Error (Kay 1987, Wei 1990, Priestley 1981 -> Akaike 1969) + AIC Akaike Information Criterion (Marple 1987, Wei 1990, Priestley 1981 -> Akaike 1974) + BIC Bayesian Akaike Information Criterion (Wei 1990, Priestley 1981 -> Akaike 1978,1979) + CAT Parzen's CAT Criterion (Wei 1994 -> Parzen 1974) + MDL Minimal Description length Criterion (Marple 1987 -> Rissanen 1978,83) + SBC Schwartz's Bayesian Criterion (Wei 1994; Schwartz 1978) + PHI Phi criterion (Pukkila et al. 1988, Hannan 1980 -> Hannan & Quinn, 1979) + HAR Haring G. (1975) + JEW Jenkins and Watts (1968) + + optFPE order where FPE is minimal + optAIC order where AIC is minimal + optBIC order where BIC is minimal + optSBC order where SBC is minimal + optMDL order where MDL is minimal + optCAT order where CAT is minimal + optPHI order where PHI is minimal + + usually is + AIC > FPE > *MDL* > PHI > SBC > CAT ~ BIC + + REFERENCES: + P.J. Brockwell and R.A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. + S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. + M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. + C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). + W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + Jenkins G.M. Watts D.G "Spectral Analysis and its applications", Holden-Day, 1968. + G. Haring "Über die Wahl der optimalen Modellordnung bei der Darstellung von stationären Zeitreihen mittels Autoregressivmodell als Basis der Analyse von EEG - Biosignalen mit Hilfe eines Digitalrechners", Habilitationschrift - Technische Universität Graz, Austria, 1975. + (1)"About selecting the optimal model at the representation of stationary time series by means of an autoregressive model as basis of the analysis of EEG - biosignals by means of a digital computer)" + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Model order selection of an autoregrssive model + [FPE,AIC,BIC,SBC,MDL,CAT,PHI,o + + + +# name: +# type: sq_string +# elements: 1 +# length: 6 +selmo2 + + +# name: +# type: sq_string +# elements: 1 +# length: 271 + SELMO2 - model order selection for univariate and multivariate + autoregressive models + + X = selmo(y,Pmax); + + y data series + Pmax maximum model order + X.A, X.B, X.C parameters of AR model + X.OPT... various optimization criteria + + see also: SELMO, MVAR, + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + SELMO2 - model order selection for univariate and multivariate + autoregressi + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +sinvest1 + + +# name: +# type: sq_string +# elements: 1 +# length: 93 +SINVEST1 shows the parameters of a time series calculated by INVEST1 + only called by INVEST1 + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 +SINVEST1 shows the parameters of a time series calculated by INVEST1 + only calle + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +sumskipnan + + +# name: +# type: sq_string +# elements: 1 +# length: 1234 + SUMSKIPNAN adds all non-NaN values. + + All NaN's are skipped; NaN's are considered as missing values. + SUMSKIPNAN of NaN's only gives O; and the number of valid elements is return. + SUMSKIPNAN is also the elementary function for calculating + various statistics (e.g. MEAN, STD, VAR, RMS, MEANSQ, SKEWNESS, + KURTOSIS, MOMENT, STATISTIC etc.) from data with missing values. + SUMSKIPNAN implements the DIMENSION-argument for data with missing values. + Also the second output argument return the number of valid elements (not NaNs) + + Y = sumskipnan(x [,DIM]) + [Y,N,SSQ] = sumskipnan(x [,DIM]) + [...] = sumskipnan(x, DIM, W) + + x input data + DIM dimension (default: []) + empty DIM sets DIM to first non singleton dimension + W weight vector for weighted sum, numel(W) must fit size(x,DIM) + Y resulting sum + N number of valid (not missing) elements + SSQ sum of squares + + the function FLAG_NANS_OCCURED() returns whether any value in x + is a not-a-number (NaN) + + features: + - can deal with NaN's (missing values) + - implements dimension argument. + - computes weighted sum + - compatible with Matlab and Octave + + see also: FLAG_NANS_OCCURED, SUM, NANSUM, MEAN, STD, VAR, RMS, MEANSQ, + SSQ, MOMENT, SKEWNESS, KURTOSIS, SEM + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 + SUMSKIPNAN adds all non-NaN values. + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +tsademo + + +# name: +# type: sq_string +# elements: 1 +# length: 42 + TSADEMO demonstrates INVEST1 on EEG data + + + +# name: +# type: sq_string +# elements: 1 +# length: 42 + TSADEMO demonstrates INVEST1 on EEG data + + + + +# name: +# type: sq_string +# elements: 1 +# length: 3 +ucp + + +# name: +# type: sq_string +# elements: 1 +# length: 476 + UCP(C) tests if the polynomial C is a Unit-Circle-Polynomial. + It tests if all roots lie inside the unit circle like + B=ucp(C) does the same as + B=all(abs(roots(C))<1) but much faster. + The Algorithm is based on the Jury-Scheme. + C are the elements of the Polynomial + C(1)*X^N + ... + C(N)*X + C(N+1). + + REFERENCES: + O. Foellinger "Lineare Abtastsysteme", Oldenburg Verlag, Muenchen, 1986. + F. Gausch "Systemtechnik", Textbook, University of Technology Graz, 1993. + + + +# name: +# type: sq_string +# elements: 1 +# length: 62 + UCP(C) tests if the polynomial C is a Unit-Circle-Polynomial. + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +y2res + + +# name: +# type: sq_string +# elements: 1 +# length: 534 + Y2RES evaluates basic statistics of a data series + + R = y2res(y) + several statistics are estimated from each column of y + + OUTPUT: + R.N number of samples, NaNs are not counted + R.SUM sum of samples + R.MEAN mean + R.STD standard deviation + R.VAR variance + R.Max Maximum + R.Min Minimum + ... and many more including: + MEDIAN, Quartiles, Variance, standard error of the mean (SEM), + Coefficient of Variation, Quantization (QUANT), TRIMEAN, SKEWNESS, + KURTOSIS, Root-Mean-Square (RMS), ENTROPY + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + Y2RES evaluates basic statistics of a data series + + R = y2res(y) + several stat + + + + + diff --git a/octave_packages/tsa-4.2.4/durlev.m b/octave_packages/tsa-4.2.4/durlev.m new file mode 100644 index 0000000..07f3f48 --- /dev/null +++ b/octave_packages/tsa-4.2.4/durlev.m @@ -0,0 +1,100 @@ +function [MX,res,arg3] = durlev(AutoCov); +% function [AR,RC,PE] = durlev(ACF); +% function [MX,PE] = durlev(ACF); +% estimates AR(p) model parameter by solving the +% Yule-Walker with the Durbin-Levinson recursion +% for multiple channels +% INPUT: +% ACF Autocorrelation function from lag=[0:p] +% +% OUTPUT +% AR autoregressive model parameter +% RC reflection coefficients (= -PARCOR coefficients) +% PE remaining error variance +% MX transformation matrix between ARP and RC (Attention: needs O(p^2) memory) +% AR(:,K) = MX(:,K*(K-1)/2+(1:K)); +% RC(:,K) = MX(:,(1:K).*(2:K+1)/2); +% +% All input and output parameters are organized in rows, one row +% corresponds to the parameters of one channel +% +% see also ACOVF ACORF AR2RC RC2AR LATTICE +% +% REFERENCES: +% Levinson N. (1947) "The Wiener RMS(root-mean-square) error criterion in filter design and prediction." J. Math. Phys., 25, pp.261-278. +% Durbin J. (1960) "The fitting of time series models." Rev. Int. Stat. Inst. vol 28., pp 233-244. +% P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. +% S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + +% $Id: durlev.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +% Inititialization +[lr,lc]=size(AutoCov); + +res=[AutoCov(:,1), zeros(lr,lc-1)]; +d=zeros(lr,1); + +if nargout<3 % needs O(p^2) memory + MX=zeros(lr,lc*(lc-1)/2); + idx=0; + idx1=0; + % Durbin-Levinson Algorithm + for K=1:lc-1, + %idx=K*(K-1)/2; %see below + % for L=1:lr, d(L)=arp(L,1:K-1)*transpose(AutoCov(L,K:-1:2));end; % Matlab 4.x, Octave + % d=sum(MX(:,idx+(1:K-1)).*AutoCov(:,K:-1:2),2); % Matlab 5.x + MX(:,idx+K)=(AutoCov(:,K+1)-sum(MX(:,idx1+(1:K-1)).*AutoCov(:,K:-1:2),2))./res(:,K); + %rc(:,K)=arp(:,K); + %if K>1 %for compatibility with OCTAVE 2.0.13 + MX(:,idx+(1:K-1))=MX(:,idx1+(1:K-1))-MX(:,(idx+K)*ones(K-1,1)).*MX(:,idx1+(K-1:-1:1)); + %end; + % for L=1:lr, d(L)=MX(L,idx+(1:K))*(AutoCov(L,K+1:-1:2).');end; % Matlab 4.x, Octave + % d=sum(MX(:,idx+(1:K)).*AutoCov(:,K+1:-1:2),2); % Matlab 5.x + res(:,K+1) = res(:,K).*(1-abs(MX(:,idx+K)).^2); + idx1=idx; + idx=idx+K; + end; + %arp=MX(:,K*(K-1)/2+(1:K)); + %rc =MX(:,(1:K).*(2:K+1)/2); + +else % needs O(p) memory + + arp=zeros(lr,lc-1); + rc=zeros(lr,lc-1); + + % Durbin-Levinson Algorithm + for K=1:lc-1, + % for L=1:lr, d(L)=arp(L,1:K-1)*transpose(AutoCov(L,K:-1:2));end; % Matlab 4.x, Octave + % d=sum(arp(:,1:K-1).*AutoCov(:,K:-1:2),2); % Matlab 5.x + arp(:,K) = (AutoCov(:,K+1)-sum(arp(:,1:K-1).*AutoCov(:,K:-1:2),2))./res(:,K); % Yule-Walker + rc(:,K) = arp(:,K); + %if K>1 %for compatibility with OCTAVE 2.0.13 + arp(:,1:K-1)=arp(:,1:K-1)-arp(:,K*ones(K-1,1)).*arp(:,K-1:-1:1); + %end; + %for L=1:lr, d(L)=arp(L,1:K)*(AutoCov(L,K+1:-1:2).');end; % Matlab 4.x, Octave + % d=sum(arp(:,1:K).*AutoCov(:,K+1:-1:2),2); % Matlab 5.x + res(:,K+1) = res(:,K).*(1-abs(arp(:,K)).^2); + end; + + % assign output arguments + arg3=res; + res=rc; + MX=arp; +end; %if diff --git a/octave_packages/tsa-4.2.4/eeg8s.mat b/octave_packages/tsa-4.2.4/eeg8s.mat new file mode 100644 index 0000000000000000000000000000000000000000..23c5a167c023ed21aea0980296a52519a8581d59 GIT binary patch literal 8218 zcmX9@c~nhp)W6-*j7pRgMH0#zim2>^N=OpY8|6v}A)(Sh2qDQ>hBr5j(mZS0r!>#= ztZwssyWOVS{N3;Sp0&<8>-=%n+3VT+`AvsH;VwQ3h39|o+{MqmE?v5!dFTJ0C=@ci zrlHm$WL+=R@J3E6xQzn+rMT$HfLQcAm|bogQVX*BPfRnbI?*rHE@AWfPTZ!hd}iLQ z8~K>kqTd$=aId>F=e;Ep$g5|CbSl3?=0T;rn+N+*_T_g8{_w^iq9C@X;+Ty@<{?tTa()X{ZdH&7-R7;o&!hUO)otn$3vJN3*EnKdna_n z*Qi=MjKQ`1lVpAu3&v}eon;Pnp_=cfX9~*cSdp}Uv-sC^@XPsdd}%X@EvC!()tnp9 zsPq`^1icT3T;FDy-I|0^J;Q^l&C~Fkao0Nk(=^y;edOFwU4XCh9%XzlW+CIwIlIV# z8Awl1lJk{XLaYs0*}U`^55X65%Q)4d6JyCSLWNu?3c`kyTZ_tT%7B6LV$B&}fh}2RA_gu8yx8rxmlRhB5J)G7H`UvC;PZkBbI;xmMj zm1pXB*cC_|_%5(HCKnj-N2XpEqyxFzxMg91j<#1nZuIVDLyFjDTFvGv7?*5Yb|&5 z6Cl(nFV$yws)3RxYb46^3=}_UJhVAj4~!zlnAYhKh*|kkGt{gD20YiIxGFXSOJmk0Konw>=B)=T`8FoIhDHU*^3Porq!sJCog4;p?f*zIOt4LL(S zuk$4afpcZ&o{{eqVrkt4y>~~(K~O4jm*vd?VD!0MJ>8fFl-j*>YegH8)uGYz?EWwo zS&dY#%ILw3s`cN;!skHyjBd@X`92&ETa;H!s)iYjWH0K;K{Rluw#O<|0)h2?UL&D^-=py(~v3DWVt`6KYE(~q`5`prUV*Ewr z!l7c{XHF_l3YHqhN-*>n@kWq;)Xx9LFns6DbpG^dG*OU0Z_XOUeV5&J#LD_n`o29Y z&AJ|T&8_KmkLgF-$qn^C6}qwXkQXi7l?7@$q_5oxo&?PxNw)WwZlJgenDw?sV8e-# zz#|eB-1pyh4K}r)So5<#Qxz=Kyd1oG>8o~7b22!jx_cZ{HXqmCV%m#7akD?14wS>~ zkeB@OQ#_=ZbDj8jayv3=N_{TB?gz223b8ll8qn!N`t$`>Jr)dQL_K?70mKcDJXM

@bxST{)*AP zQB#jQh+T(d-%X<0o6j7<+hx!fvsX-Y*%-tH@*T+OnuVPBM>);M=716BSDQ>PL3&7J zXU+N+Bv-1J#}`GT{8gQ+x-=9hl`;33eC|N+x%S}q|2!w)-#)tk%n*`d> zqqKqO0`OVo-9*qEL7%2*v;QUwWTR~+@BA5rB*&E7-oF;0$5m1LnC1dVYri@ncdrBT ztnVj;D$RgcYM74vj$Tlq-4S>kHvk>)b~sP$p%Q1l)kwVDLm@nOUHGan+kgwc$yb&? z=b*BSYKFeT5|Zy{f7__XC|>^hh9XtP2IC)N?->bI;9lP$wXW|QY+JFuOCVwlv=!x+ zI>wAZmz0rn&mad1GCjs0udc!(_fc=MJm&_yI{qfL-q&`e>ylB~8#Q=)rKtr3PBd9g{WP2tuz{mOTu~W8LVDtDm zf0J)7dUo7)XjJdRl5ruG%wi^bMqOC($g~gq+%&FNZx{z6Xf<7JtPD(B3eAl&roc{U z)PAQ~Cup}v%?bDR0i7;>dpU0dC<~nR?dEGls-|YEO2-6}AB63j8rjIOTBUQvokaP! zBD-@FOMt#rM2)Y1O?QiSv|>wf=Tu8s zH`oO`URTyF24ms!c8AGUNR{M`ziP4wKDF~F9p^iN!X93A&%O|2B6?VcQZ-=fDSCD^ za2V7$)gS&CH-pFI;hNKWeRwLP@(=4lCrB4a1WA1DL}FdWv!7#8nDb*{h1>=P-nDzI ztaz;-VpL)w?Mf&3{YTRg$g05#a_d!r6|EpqX|aFe-6&8PpR5i3djTz<79XfzT>zgB zIi(o;0r0d}f9*RsfV7Kuv+mpGL$1gz{&js6GV5=6%4S_&vemdmr;0X?6$37&oR16W zd1?Oi$ips7-*%>~DV>4FKeRXNR2AYlRrkDd5euvf=Hsh$CO}NWyhh%q9NYt^#m%k4 z;hUn3$>pE{Os6^ZdnHeywN|8aL*hKnC`>l=L0Ne z!m&gyIq%u&F(7`-3W|oup>bu2qfAyia2Bt<4}97Pq;%q3wrd00X4xCwcsT;*RD~Kv zFAfHYuJBAaFom4tJ(rBnGVzATz(H#X3hB4BT%I9ViOSEnN{uRvq4BAycg0p?81tQH zW9OO?@Elj|ZFFmfB601rF7<5CUU>EE1~Cqb-t5KEzr#R@5v!ysi;EWHspv+y;>~$Zj-@1a0p8^cGzZIE4 zM&*7B!n>cV2ew;YTipU4tp5(rjIzK$@2M#BOD9wuvAuHEt`%6v?J#w95pXK+M9!?~ zg@S?JmJgMaupnj~d#Pm%TyI+b4f#F}y65gW6+fK^`pxMLos-Sz-Zpdmhwu+LW!Swt zsJI<-9RDe+d(?@6ez$vna&b<6xs&Q1%PvTjU9VUDnwMbdEBd?m3KOEvl)~KWJcN^1 zL{LU~Eru;F2}owvBdzq&8B3KEbV@Wi$#ba}Yjilj@|C(UYB)nb@ZLPeJWH${eBO)( z*+EiD5zU|&`>R)DxEl;BhOPFVm_lhw+OO__0c2#pyhVCeBcr#vhW0!i*9N*%r_PQd zb93lDXU!R8+7863zMzm|w)1Is_SGSA$#X1JG68%Xzg>Ki-465&p3W~PxaYl3>rMcz z9cqryJok7HqWkLDRNFE?EO72lU!m5Gmuz%GQtT<@7p2XG-6ms5FL`jfi&=||Z_bhG z*SoRe+0&-F)onoJmlYNm$APr5XR*|)e(1VyZwS|!@NKKQ+oR93=$WAQS>j9uR9wDz zO8QwdTvL!4^*%a*36#4(=KKe+C=|4IOY@RH;`8shyK?8y;h*3D>JZk7G*O3B_()?3 zhnIna-Kfqsm2F5GMCa26(HpWxk=4@llOs`v%8cvh-)hw&M`m1M)9PAGB6J?T(i%m< zQ@OQPf*oKv+fRxcO`-g&qD%C-0El7STJ_u_6HHddIEf$Zz$eR9%M{;J2(Q4i)_b3{ zqOyfNC(V(|zv;{MBa+5INi}0Tlo0tc|?R6m5T+roCT9j zE$F3xzAQ_82Gt%X@9Cm-BO@Zn?yww{+;gSo=XB&KnlQR2mu#buH1||lf6o-y%h_;R zu5Jp>Es}5V2>0TToh42tGQ+^RbMPk5s{tSbv)zwz`|q$zfoR!13g!-V|8k#I7Q1?N8B z&eH!h26J<9(31{m`0z*O*xA2GJ8!FCGaZgJ zKhNOazwLO^H9K3$as=5m1=@Zo-Po>dWZq8pq5aXXo+6joNH_el_F`QmQg$CUy4L>z z4bm?DyW)8_&K2ifum3m>uihHEHNPB!s9zhl4th7iNZjZ`)W@=( zK`e}8a!MHrEL^XAcOZ&j;6>Wvg)2h?kh96G&-PUVif=Mo*xoY%K6k_97C%OU-HjQi z#gr_3dAHbpm^lP#nwfGPvMdN|>S;Uan29O&!FN?>Mq#yc$f%$65D@n1qPqOKkmouY z-6EI+y&W6#Jb$u4d)N1D$!i_(E!)@c_#}x#iKUOPJgfn0lP#4^dbKG3qgrJDkz7>& z;WKP8Tn9yGS!)lvF+kT}LArdd6VhY)ncv1{K~v8lUYni=HP@=1HOa6c==+5eGsoF5 zIqrNe;8zFCUey_qVY8uYeP6fche|kOcP*ztpM$TfBHVv$CA#_pDC- zLm@PtCF%y88H5K}d=<%UY+S5(pSmSx6qf{7ZXDb+jYdh07ZqNLl9a8~&rfMoQrUJ= ze#K)!GRf6lK}f0(H<%{HpL*2^o(WBdHYCY3OndAn>5OYQPSbu(e0vjm>X-C z@%sA|Q0Ib7o%8sJl(NO-JOK_=d@K)83Frk{h<;G490`~C_)PT-dC7@St|MFMqgdAD zVt4!QAo5)4IPO|Mi$QCI%`dN=!E0A1-en3ipv&`QB#UnXBBV4-y;P{5=NsE+_a zUlH)3pHGw!4ZDB!W8v`Gl_E@~p(T^vk#s0lR zW8-BfE%Pm2Gw9Bkb2pRyf)vrH%3}t0*piqTvDKppOse8U{N-*`z>*~)-N0B@! zv{q(y3KvJVT7>e}!pXY^!M-?-FO@Vx#@BR0h>O$1ZM^MhtZ#-I77VPiiI51B9D|OY z<_b#=h4gLt;9%0j)%&)^H-{^k=&r(dv9;72#G=Z*4HCI|iuA<@`kGcGcAd_(wu=SM zyY?61WpjADrt3I&2$1qr#Mo7biJX;z1_=fOxNuh4#L~Rb!P>5ouud)?XijKAiwS(-T`G!L?eW-cIocV)U1*Ci9;+c6mu#(mc>b_q9 z`iACr3^g{`h%0Dw9u9!KmEMK#OVhC7$pkI<;1Ji3cpqK%H3w)LJ2dXD%|=^c@25hC zDWrRkQ^zLFY!tNJcZ@f<4v4)?`<@<1MUJ1#n1^@+&|mMg`T8aulzmR+sk_#oWWp)= z_R~DXqk&M*zqumBPazL|ndelZ%>6-^QZ|Kf_bPB)uh@*mspo_LGvg&~6L$$QRx|Lr z!OFqQg%omIZG%|ZDXz|buIA~xnS);BU#h{XcJ%S?tu65E#BV*u%8BE>K!5jaZ{h74 z=vk4lsh*3s@1zv^LtSP-@&zrwZrv2x{=A@+F~P;p0r}%0Y0F5jc}jfQydsP~qK10Ni&8l1d74)gBX2A;YU!spGw@s`siAYC*Tn}22$F0gAd zUI}ySPrbLRYBC!79{jpb+0cu2HYdh@33Kp4nn9_~F)GQqI$>`W-vWR2*R!65QHaF1 zH!n1?c!_@wOFM9isYHU>ca{IVmJoLXqkl~-a(&M-g1Jj?1l%8JdRK*HVtQF9GyWxly;_mNm%BoWeFuxXYND#jsiax|wN`Hh zHj-QFy&AWN!{g--Dbfz(sOc?!_Rg_+;5?v$S#||jSBHe!^miehR%+UvpAFg;Li_!` z_JCrU<3Pz=FXnJ|Qoqs}n3^O!^;~rUIacSlsP;3FF{v0rUsiKFz-s8a*HLvg&I$2lslORV6`@DrQkLV`XL4YN!q;x3ZI}<) zyuT9Es6`qtO!6@7*0};(yEa(A<7*k`;wU#a$aZce`q5Bn^W+3K4-+dlc;Kwl3gzLY ztg~yx$y@K&tWx}kLV8I#EdMwqL3(u^)mFCSpte%u@+D&J_*%I1ZE_Hml>WGU{Lt}E z6cpu8ejUsPclp(FHNS@;By8ukPLC;Q9Xz}U?n#OY%whA=5aD9u(Aj@FaUzA=FeYZxk2iz}?Ic+ldj{frW2d@kHiO|fr zLBEX@g1-OEU#m}p;8du)M_sfFSl`^URxcYwQuVOY!eli{>O5c{YV1QsV}^Uf)na7* zTyvxQ@&NA0ck^nw$U*nW+F(!i07kz~cq8M>ONHi>E5hw|yWFZr-li*&W4e4~gF$ADy=E`EAJT5v8rzJCt(Qv?yPufDAA0X5iMF4HX~rWQ^%YdLLruizc{z4dI=#b ztH!(cg%IH@x=ygkn~zZX61bQ7Wdh{?<+tB?X%fQP^6qIpVWQ=oe~5W5uRjpTYY==o zj`|@*>dWK>$dok-)~n8sVuR_czfn*Ld9~ozRyGEWN_qbgZ}2kP8LrxU78~eNwA6 z)W|=`kn$J_vP=Q7xbsJ}h&n9zyY6aqvLGSNc3q5?n1{8`OhnB`7U0wV^7l{38T_3f}o0=X>A^%8HYM>Z}pgBzckvp9YJcqOkg^w;F;sRD#Ol2=8 zmS@DA&hw=b!6#Qo=N(&soL_5>l>Qlkpn%{2mvI(8?Xml8`Em{{Gn3cW3U>m(#+l~g zWnI`Ov_&HBTQ1tkSm-WB79lr|YF7!R5QZ~T2P+)MfZv;ycjEaXFe{)|)ou=m%=C2H zrWT;bM=z10vw(6&)uKEn0cyohSvD>o!;|}bf6Q-SLF%>>QHj6$(PxC7Kk5??c-Eo$ z$iLHI_O{`mbW<}tlGUQ?-yFv{^$k58R`b~8EVxC_VG!@iujH3uaL-xe5yk9#eL#`X z&oyYwg1EAf;h(qKFswOmO~hnZS=iTb^bj7Jg&+f}X4KL?(7&el{%A!P%na%; zd*L>LR-?k6P7j7rH~+9m?_wJKEBHNSx@QQ9RU-Sg__RU8$dj+?QJzq`SEIvItq9US zoauN`*M%R-4$C@qjldp{AfD9@RHFTnn3JUeFKMK;#$uK4EM|IYfBe%dL@MDPKZ!4k zXy&osdbrvHvSdOf5}yy?T-&2RbMJc~?DqWrk&7cZnOVN;ZEFL_QN%poH4cHPh>EYG z8e*%(PG8AsDk15+<=hv|Au#g%Z7sNQ9FB!;G9JCeLn<994Ug*;AW!A|4P00{hxsQ> zw0r6ou^{kadGW1DG?{y=B&e~7Eqo8>6DR)$XhvmS&leV9G z{73LMJNJ55EE8`DbLNGNCoxTdvirtiKJxl0gXz5e-58YCv$a-l6eR*}nN+n-$YUoQ z)_fvDJP^9?-o@3!8s2H6&$)VZ;rW3h`UIUV>pajWDnqhVb4`{%2Ip(yZ9(y9>TABRIrHyse7EFm=a#yyJq zM}T-luF_FA5F@mn@BPQYUz{k>$ek1r6DD@ewAjq72tsqpcD|o|BRHQH;C}j4FX%*F zITLW878>PKel=8dVOrFT+t$64m~uJ!?aP=t?9Q!UJ0Ca;#O|bFpPholR|&VaOSgmx zlLLDxhWl3%!8hqbcmJgl%fR-Otkp7NNjAe>&V~)OcfHnK4jlwt;eVI5Y#9TwDp_M$ z)lqP54V1fcVjdp4q)0_E2Eg)ypVZsS{Dk~aWW~ly{9GSpHF;BH2~jt;RwZdIAHi^) zvOINS0*GBtL?4F+!dYYg&+fH@uyRL)v63|l*Tt{#R=+xj=M@Iq+yxggV&+t76r&mB h=CvK&ZjHiS69pby?M^5j{q +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +global FLAG_implicit_samplerate; + +%%% check whether FLAG was already defined +if exist('FLAG_implicit_samplerate')~=1, + FLAG_implicit_samplerate = 1; +end; +if isempty(FLAG_implicit_samplerate), + FLAG_implicit_samplerate = 1; +end; + +if nargin>0, + fprintf(2,'Warning: FLAG_IMPLICIT_SAMPLERATE is in an experimental state\n'); + fprintf(2,'It might become obsolete.\n'); + FLAG_implicit_samplerate = i; +end; + +DIM = FLAG_implicit_samplerate; diff --git a/octave_packages/tsa-4.2.4/flag_implicit_skip_nan.m b/octave_packages/tsa-4.2.4/flag_implicit_skip_nan.m new file mode 100644 index 0000000..7052e14 --- /dev/null +++ b/octave_packages/tsa-4.2.4/flag_implicit_skip_nan.m @@ -0,0 +1,65 @@ +function FLAG = flag_implicit_skip_nan(i) +% FLAG_IMPLICIT_SKIP_NAN sets and gets default mode for handling NaNs +% 1 skips NaN's (the default mode if no mode is set) +% 0 NaNs are propagated; input NaN's give NaN's at the output +% +% FLAG = flag_implicit_skip_nan() +% gets current mode +% +% flag_implicit_skip_nan(FLAG) % sets mode +% +% prevFLAG = flag_implicit_skip_nan(nextFLAG) +% gets previous set FLAG and sets FLAG for the future +% flag_implicit_skip_nan(prevFLAG) +% resets FLAG to previous mode +% +% It is used in: +% SUMSKIPNAN, MEDIAN, QUANTILES, TRIMEAN +% and affects many other functions like: +% CENTER, KURTOSIS, MAD, MEAN, MOMENT, RMS, SEM, SKEWNESS, +% STATISTIC, STD, VAR, ZSCORE etc. +% +% The mode is stored in the global variable FLAG_implicit_skip_nan +% It is recommended to use flag_implicit_skip_nan(1) as default and +% flag_implicit_skip_nan(0) should be used for exceptional cases only. +% This feature might disappear without further notice, so you should really not +% rely on it. + + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; if not, write to the Free Software +% Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +% $Id: flag_implicit_skip_nan.m 8351 2011-06-24 17:35:07Z carandraug $ +% Copyright (C) 2001-2003,2009 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +persistent FLAG_implicit_skip_nan; + +%% if strcmp(version,'3.6'), FLAG_implicit_skip_nan=(1==1); end; %% hack for the use with Freemat3.6 + +%%% set DEFAULT value of FLAG +if isempty(FLAG_implicit_skip_nan), + FLAG_implicit_skip_nan = (1==1); %logical(1); % logical.m not available on 2.0.16 +end; + +FLAG = FLAG_implicit_skip_nan; +if nargin>0, + FLAG_implicit_skip_nan = (i~=0); %logical(i); %logical.m not available in 2.0.16 + if (~i) + warning('flag_implicit_skipnan(0): You are warned!!! You have turned off skipping NaN in sumskipnan. This is not recommended. Make sure you really know what you do.') + end; +end; + diff --git a/octave_packages/tsa-4.2.4/flix.m b/octave_packages/tsa-4.2.4/flix.m new file mode 100644 index 0000000..a53dee0 --- /dev/null +++ b/octave_packages/tsa-4.2.4/flix.m @@ -0,0 +1,51 @@ +function Y=flix(D,x) +% floating point index - interpolates data in case of non-integer indices +% +% Y=flix(D,x) +% FLIX returns Y=D(x) if x is an integer +% otherwise D(x) is interpolated from the neighbors D(ceil(x)) and D(floor(x)) +% +% Applications: +% (1) discrete Dataseries can be upsampled to higher sampling rate +% (2) transformation of non-equidistant samples to equidistant samples +% (3) [Q]=flix(sort(D),q*(length(D)+1)) calculates the q-quantile of data series D +% +% FLIX(D,x) is the same as INTERP1(D,X,'linear'); Therefore, FLIX might +% become obsolete in future. +% +% see also: HIST2RES, Y2RES, PLOTCDF, INTERP1 + +% $Id: flix.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) by 2001-2005,2008 Alois Schloegl +% This is part of the TSA-toolbox see also: +% http://www.dpmi.tu-graz.ac.at/schloegl/matlab/tsa/ +% http://octave.sf.net/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +D = D(:); +Y = x; + +k1 = ((x >= 1) & (x <= size(D,1))); +Y(~k1) = NaN; + +k = x - floor(x); % distance to next sample + +ix = ~k & k1; % find integer indices +Y(ix) = D(x(ix)); % put integer indices + +ix = k & k1; % find non-integer indices + +Y(ix) = D(floor(x(ix))).*(1-k(ix)) + D(ceil(x(ix))).*k(ix); + diff --git a/octave_packages/tsa-4.2.4/histo.m b/octave_packages/tsa-4.2.4/histo.m new file mode 100644 index 0000000..26819da --- /dev/null +++ b/octave_packages/tsa-4.2.4/histo.m @@ -0,0 +1,73 @@ +function [H,X]=histo(Y,Mode) +% HISTO calculates histogram for each column +% [H,X] = HISTO(Y,Mode) +% +% Mode +% 'rows' : frequency of each row +% '1x' : single bin-values +% 'nx' : separate bin-values for each column +% X are the bin-values +% H is the frequency of occurence of value X +% +% HISTO(Y) with no output arguments: +% plots the histogram bar(X,H) +% +% more histogram-based results can be obtained by HIST2RES2 +% +% see also: HISTO, HISTO2, HISTO3, HISTO4 +% +% REFERENCE(S): +% C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). + +% $Id: histo.m 5148 2008-06-27 10:36:37Z schloegl $ +% Copyright (C) 1996-2002,2008 by Alois Schloegl +% This is part of the TSA-toolbox +% http://hci.tugraz.at/~schloegl/matlab/tsa/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +if nargin<2, + Mode='1x'; +end; +Mode=lower(Mode); + +if strcmp(Mode,'rows') + R = histo4(Y); + +elseif strcmp(Mode,'column') + R = histo4(Y'); + R.X = R.X'; + +elseif strcmp(Mode,'1x') + R = histo3(Y); + +elseif strcmp(Mode,'nx') + R = histo2(Y); + +end; + +H = R.H; +X = R.X; +if nargout == 0, + if any(size(X)==1), + if exist('OCTAVE_VERSION')<5, + bar(R.X,R.H,'stacked'); + else + bar(R.X,R.H); + end + else + warning('2-dim X-values not supported\n') + %bar3(R.X,R.H); + end; +end; diff --git a/octave_packages/tsa-4.2.4/histo2.m b/octave_packages/tsa-4.2.4/histo2.m new file mode 100644 index 0000000..158d0f9 --- /dev/null +++ b/octave_packages/tsa-4.2.4/histo2.m @@ -0,0 +1,97 @@ +function R = histo2(Y, W) +% HISTO2 calculates histogram for multiple columns with separate bin values +% for each data column. +% +% R = HISTO2(Y) +% R = HISTO2(Y, W) +% Y data +% W weight vector containing weights of each sample, +% number of rows of Y and W must match. +% default W=[] indicates that each sample is weighted with 1. +% +% R = HISTO(...) +% R is a struct with th fields +% R.X the bin-values, bin-values are computed separately for each +% data column, thus R.X is a matrix, each column contains the +% the bin values of for each data column, unused elements are indicated with NaN. +% In order to have common bin values, use HISTO3. +% R.H is the frequency of occurence of value X +% R.N are the number of valid (not NaN) samples (i.e. sum of weights) +% +% more histogram-based results can be obtained by HIST2RES2 +% +% see also: HISTO, HISTO2, HISTO3, HISTO4 +% +% REFERENCE(S): +% C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). + +% $Id: histo2.m 8383 2011-07-16 20:06:59Z schloegl $ +% Copyright (C) 1996-2002,2008,2011 by Alois Schloegl +% This is part of the TSA-toolbox +% http://hci.tugraz.at/~schloegl/matlab/tsa/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +%%%%% check input arguments %%%%% +[yr,yc] = size(Y); +if nargin < 2, + W = []; +end; +if ~isempty(W) && (yr ~= numel(W)), + error('number of rows of Y does not match number of elements in W'); +end; + +%%%%% identify all possible X's and generate overall Histogram %%%%% +N = sum(~isnan(Y), 1); +NN = N; +if isempty(W) + sY = sort(Y,1); +else + [sY, idx] = sort(Y,1); + W = cumsum(W(idx)); %% W becomes cumulative sum +end; +[ix,iy] = find( diff(sY, [], 1) > 0); +nn0 = 0; + +for k = 1:yc, + tmp = [ix(iy==k); N(k)]; + nn1 = length(tmp); + + if isempty(W) + H(1:nn1,k) = [tmp(1); diff(tmp)]; + else + %%% Note that W is the cumulative sum + H(1:nn1,k) = [W(tmp(1),k); diff(W(tmp,k))]; + NN(k) = W(N(k), k); + end; + X(1:nn1, k) = sY(tmp, k); + + if k==1; + nn0 = nn1; + elseif nn1 < nn0, + H (1+nn1:nn0, k) = NaN; + X (1+nn1:nn0, k) = NaN; + elseif nn1 > nn0, + H (1+nn0:nn1, 1:k-1) = NaN; + X (1+nn0:nn1, 1:k-1) = NaN; + nn0 = nn1; + end; +end; + +R.datatype = 'HISTOGRAM'; +R.H = H; +R.X = X; +R.N = NN; + diff --git a/octave_packages/tsa-4.2.4/histo3.m b/octave_packages/tsa-4.2.4/histo3.m new file mode 100644 index 0000000..edf5150 --- /dev/null +++ b/octave_packages/tsa-4.2.4/histo3.m @@ -0,0 +1,153 @@ +function [R, tix] = histo3(Y, W) +% HISTO3 calculates histogram for multiple columns with common bin values +% among all data columns, and can be useful for data compression. +% +% R = HISTO3(Y) +% R = HISTO3(Y, W) +% Y data +% W weight vector containing weights of each sample, +% number of rows of Y and W must match. +% default W=[] indicates that each sample is weighted with 1. +% R struct with these fields +% R.X the bin-values, bin-values are equal for each channel +% thus R.X is a column vector. If bin values should +% be computed separately for each data column, use HISTO2 +% R.H is the frequency of occurence of value X +% R.N are the number of valid (not NaN) samples +% +% Data compression can be performed in this way +% [R,tix] = histo3(Y) +% is the compression step +% +% R.tix provides a compressed data representation. +% R.compressionratio estimates the compression ratio +% +% R.X(tix) and R.X(R.tix) +% reconstruct the orginal signal (decompression) +% +% The effort (in memory and speed) for compression is O(n*log(n)). +% The effort (in memory and speed) for decompression is O(n) only. +% +% see also: HISTO, HISTO2, HISTO3, HISTO4 +% +% REFERENCE(S): +% C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). + + +% $Id: histo3.m 8383 2011-07-16 20:06:59Z schloegl $ +% Copyright (C) 1996-2002,2008,2011 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://hci.tugraz.at/schloegl/matlab/tsa/ +% http://octave.sourceforge.net/ +% http://biosig.sourceforge.net/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +%%%%% check input arguments %%%%% +[yr,yc] = size(Y); +if nargin < 2, + W = []; +end; +if ~isempty(W) && (yr ~= numel(W)), + error('number of rows of Y does not match number of elements in W'); +end; + +%%%%% identify all possible X's and generate overall Histogram %%%%% +[sY, idx] = sort(Y(:),1); +[tmp,idx1] = sort(idx); % generate inverse index + +ix = diff(sY, [], 1) > 0; +tmp = [find(ix); sum(~isnan(sY))]; + +R.datatype = 'HISTOGRAM'; +R.X = sY(tmp); +R.N = sum(~isnan(Y), 1); + +% generate inverse index +if nargout>1, + tix = cumsum([1; ix]); % rank + tix = reshape(tix(idx1), yr, yc); % inverse sort rank + cc = 1; + tmp = sum(ix) + 1; + if exist('OCTAVE_VERSION') >= 5, + ; % NOP; no support for integer datatyp + elseif tmp <= 2^8; + tix = uint8(tix); + cc = 8/1; + elseif tmp <= 2^16; + tix = uint16(tix); + cc = 8/2; + elseif tmp <= 2^32; + tix = uint32(tix); + cc = 8/4; + end; + R.compressionratio = (prod(size(R.X)) + (yr*yc)/cc) / (yr*yc); + R.tix = tix; +end; + + +if yc==1, + if isempty(W) + R.H = [tmp(1); diff(tmp)]; + else + C = cumsum(W(idx)); % cumulative weights + R.H = [C(tmp(1)); diff(C(tmp))]; + end; + return; + +elseif yc>1, + % allocate memory + H = zeros(size(R.X,1),yc); + + % scan each channel + for k = 1:yc, + if isempty(W) + sY = sort(Y(:,k)); + else + [sY,ix] = sort(Y(:,k)); + C = cumsum(W(ix)); + end + ix = find(diff(sY,[],1) > 0); + if size(ix,1) > 0, + tmp = [ix; R.N(k)]; + else + tmp = R.N(k); + end; + + t = 0; + j = 1; + if isempty(W) + for x = tmp', + acc = sY(x); + while R.X(j)~=acc, j=j+1; end; + %j = find(sY(x)==R.X); % identify position on X + H(j,k) = H(j,k) + (x-t); % add diff(tmp) + t = x; + end; + else + for x = tmp', + acc = sY(x); + while R.X(j)~=acc, j=j+1; end; + %j = find(sY(x)==R.X); % identify position on X + H(j,k) = H(j,k) + C(x)-t; % add diff(tmp) + t = C(x); + end; + end; + end; + + R.H = H; +end; + + diff --git a/octave_packages/tsa-4.2.4/histo4.m b/octave_packages/tsa-4.2.4/histo4.m new file mode 100644 index 0000000..cdf46c0 --- /dev/null +++ b/octave_packages/tsa-4.2.4/histo4.m @@ -0,0 +1,97 @@ +function [R, tix] = histo4(Y, W) +% HISTO4 calculates histogram of multidimensional data samples +% and supports data compression +% +% R = HISTO4(Y) +% R = HISTO4(Y, W) +% Y data: on sample per row, each sample has with size(Y,2) elements +% W weights of each sample (default: []) +% W = [] indicates that each sample has equal weight +% R is a struct with these fields: +% R.X are the bin-values +% R.H is the frequency of occurence of value X (weighted with W) +% R.N are the total number of samples (or sum of W) +% +% HISTO4 might be useful for data compression, because +% [R,tix] = histo4(Y) +% is the compression step +% R.X(tix,:) +% is the decompression step +% +% The effort (in memory and speed) for compression is O(n*log(n)) +% The effort (in memory and speed) for decompression is only O(n) +% +% see also: HISTO, HISTO2, HISTO3, HISTO4 +% +% REFERENCE(S): +% C.E. Shannon and W. Weaver 'The mathematical theory of communication' University of Illinois Press, Urbana 1949 (reprint 1963). + + +% $Id: histo4.m 8383 2011-07-16 20:06:59Z schloegl $ +% Copyright (C) 1996-2005,2008,2009,2011 by Alois Schloegl +% This is part of the TSA-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/tsa/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +%%%%% check input arguments %%%%% +[yr, yc] = size(Y); +if nargin<2, + W = []; +end; +if ~isempty(W) && (yr ~= numel(W)), + error('number of rows of Y does not match number of elements in W'); +end; + +%%%%% identify all possible X's and generate overall Histogram %%%%% +[Y, idx] = sortrows(Y); + +d = diff(Y,[],1); +ix = any( (~isnan(d) & (d~=0) ) | diff(isnan(Y),[],1), 2); + +tmp = [find(ix); yr]; +R.X = Y(tmp,:); +R.datatype = 'HISTOGRAM'; +if isempty(W) + R.H = [tmp(1); diff(tmp)]; + R.N = yr; +else + W = cumsum(W(idx)); + R.H = [W(tmp(1)); diff(W(tmp))]; + R.N = W(end); +end; + +%%%%% generate inverse index %%%%% +if nargout>1, + tix = cumsum([1;ix]); % rank + cc = 1; + tmp = sum(ix); + if tmp < 2^8; + tix = uint8(tix); + cc = 8/1; + elseif tmp < 2^16; + tix = uint16(tix); + cc = 8/2; + elseif tmp < 2^32; + tix = uint32(tix); + cc = 8/4; + end; + [tmp, idx] = sort(idx); % inverse index + tix = tix(idx); % inverse sort rank + + R.compressionratio = (prod(size(R.X)) + yr/cc) / (yr*yc); + R.tix = tix; +end; + diff --git a/octave_packages/tsa-4.2.4/hup.m b/octave_packages/tsa-4.2.4/hup.m new file mode 100644 index 0000000..2321d8e --- /dev/null +++ b/octave_packages/tsa-4.2.4/hup.m @@ -0,0 +1,53 @@ +function b=hup(C) +%HUP(C) tests if the polynomial C is a Hurwitz-Polynomial. +% It tests if all roots lie in the left half of the complex +% plane +% B=hup(C) is the same as +% B=all(real(roots(c))<0) but much faster. +% The Algorithm is based on the Routh-Scheme. +% C are the elements of the Polynomial +% C(1)*X^N + ... + C(N)*X + C(N+1). +% +% HUP2 works also for multiple polynomials, +% each row a poly - Yet not tested +% +% REFERENCES: +% F. Gausch "Systemtechnik", Textbook, University of Technology Graz, 1993. +% Ch. Langraf and G. Schneider "Elemente der Regeltechnik", Springer Verlag, 1970. + +% $Id: hup.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (c) 1995-1998,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +[lr,lc] = size(c); + +% Strip leading zeros and throw away. + % not considered yet +%d=(c(:,1)==0); + +% Trailing zeros mean there are roots at zero +b=(c(:,lc)~=0); +lambda=b; + +n=zeros(lc); +if lc>3 + n(4:2:lc,2:2:lc-2)=1; +end; +while lc>1 + lambda(b)=c(b,1)./c(b,2); + b = b & (lambda>=0) & (lambda +% This is part of the TSA-toolbox. See also +% http://biosig-consulting.com/matlab/tsa/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +if nargin<3 + Mode=0; +else + Mode=1; +end; + +[nr,nc]=size(Y); +NC = sumskipnan(real(~isnan(Y)),2); % number of valid components (data points) + +if Mode==0 + if nargin<2, Pmax = min([100 nc/3]); end; + M = min(Pmax,nc-1); + AutoCov = acovf(Y,M); +else + AutoCov=Y; + M = min(Pmax,nc-1); + nc = Pmax; + %M=size(AutoCov,2)-1; +end; + +AutoCorr = AutoCov(:,2:M+1)./AutoCov(:,ones(M,1)); + +if 1,Pmax<100; % this needs change of sinvest1 + K=M-1; + [MX,E]=lattice(Y,Pmax); + %[MX,E]=ulsar(Y,Pmax); + %[MX,E]=durlev(AutoCov); +% ARP=MX(:,K*(K-1)/2+(1:K)); +% PartACF =MX(:,(1:K).*(2:K+1)/2); +else %if nargout > 2 + [ARP,RC,E]=lattice(Y,Pmax); + %[ARP,PartACF,E]=durlev(AutoCov); + %MX=[ARP,RC]; +end; + + + + + + + + + diff --git a/octave_packages/tsa-4.2.4/invest1.m b/octave_packages/tsa-4.2.4/invest1.m new file mode 100644 index 0000000..06b3d8e --- /dev/null +++ b/octave_packages/tsa-4.2.4/invest1.m @@ -0,0 +1,126 @@ +function [AutoCov,AutoCorr,ARPMX,E,C,s]=invest1(Y,Pmax,D); +% First Investigation of a signal (time series) - interactive +% [AutoCov,AutoCorr,ARPMX,E,CRITERIA,MOPS]=invest1(Y,Pmax,show); +% +% Y time series +% Pmax maximal order (optional) +% show optional; if given the parameters are shown +% +% AutoCov Autocorrelation +% AutoCorr normalized Autocorrelation +% PartACF Partial Autocorrelation +% E Error function E(p) +% CRITERIA curves of the various (see below) criteria, +% MOPS=[optFPE optAIC optBIC optSBC optMDL optCAT optPHI]; +% optimal model order according to various criteria +% +% FPE Final Prediction Error (Kay, 1987) +% AIC Akaike Information Criterion (Marple, 1987) +% BIC Bayesian Akaike Information Criterion (Wei, 1994) +% SBC Schwartz's Bayesian Criterion (Wei, 1994) +% MDL Minimal Description length Criterion (Marple, 1987) +% CAT Parzen's CAT Criterion (Wei, 1994) +% PHI Phi criterion (Pukkila et al. 1988) +% minE order where E is minimal +% +% REFERENCES: +% P.J. Brockwell and R.A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. +% S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + +% optFPE order where FPE is minimal +% optAIC order where AIC is minimal +% optBIC order where BIC is minimal +% optSBC order where SBC is minimal +% optMDL order where MDL is minimal +% optCAT order where CAT is minimal +% optPHI order where PHI is minimal +% optRC2 max reflection coefficient larger than std-error + +% $Id: invest1.m 7687 2010-09-08 18:39:23Z schloegl $ +% Copyright (C) 1998-2002,2008,2010 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://biosig-consulting.com/matlab/tsa/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +N=length(Y); +[nr,nc]=size(Y); +if nc==1 Y=transpose(Y); nc=nr; nr=1; end; + +if nargin<2 Pmax=min([100 nc/3]); end; + +if exist('OCTAVE_VERSION'), + fprintf(2,'Warning INVEST1: DIFF-based optimization not possible\n'); + %%% missing DIM-argument in DIFF.M +else + %tmp=Y-mean(Y,2)*ones(1,nc); + RMS(:,1) = mean(Y.^2,2); + Dmax = min(Pmax,5); + for k = 1:Dmax, + RMS(:,k+1) = mean(diff(Y,k,2).^2,2); + end; + [tmp, orderDIFF] = min(RMS,[],2); + + % show a nice histogram + h = histo3(orderDIFF-1); + X = 0:Dmax; H = zeros(1,Dmax+1); for k=1:length(h.X), H(find(X==h.X(k)))=h.H(k); end; + %X = 0:Dmax; H = zeros(1,Dmax+1); for k=1:length(x), H(find(X==x(k)))=h(k); end; + bar(X,H); + drawnow; + + if nargin>2 + oD=0; + else + oD=input('Which order should be used for differentiating [default=0] ?: '); + end; + if oD>0 + Y=diff(Y,oD,2); + end; +end; + +[AutoCov, AutoCorr, ARPMX, E, NC] = invest0(Y,Pmax); + +[FPE,AIC,BIC,SBC,MDL,CATcrit,PHI,optFPE,optAIC,optBIC,optSBC,optMDL,optCAT,optPHI,s,C] = selmo(E,NC); + +if 0, +optRC2=zeros(nr+1,1); +for k=0:nr, + if k>0 + optRC2(k+1)=max(find(abs(ARPMX(k,(1:Pmax).*(2:Pmax+1)/2))*sqrt(size(Y,2))>1)); + else + optRC2(k+1)=max(find(mean(abs(ARPMX(:,(1:Pmax).*(2:Pmax+1)/2))*sqrt(size(Y,2)),2)>1)); + end; +end; +%GERSCH=min(find(rc.^2<(0.05/1.05))); +s=[s optRC2]; +end; + +%CRITERIA=([FPE;AIC;BIC;SBC;MDL;CATcrit;PHI])'; +MOPS = s(1:size(s,1),:); %[optFPE optAIC optBIC optSBC optMDL optCAT optPHI]; + +if nargin==3, + if size(ARPMX,2)==2*Pmax, + %invest1(eeg8s,30,'s'); + AR=ARPMX(:,1:Pmax); + RC=ARPMX(:,Pmax+1:2*Pmax); + else + AR=ARPMX(:,Pmax/2*(Pmax-1)+(1:Pmax)); + RC=ARPMX(:,(1:Pmax).*(2:Pmax+1)/2); + end; + oo=optBIC; + sinvest1; +end; diff --git a/octave_packages/tsa-4.2.4/invfdemo.m b/octave_packages/tsa-4.2.4/invfdemo.m new file mode 100644 index 0000000..2bdad84 --- /dev/null +++ b/octave_packages/tsa-4.2.4/invfdemo.m @@ -0,0 +1,51 @@ +% invfdemo demonstrates Inverse Filtering + +% $Id: invfdemo.m 5090 2008-06-05 08:12:04Z schloegl $ % Copyright (C) 1997-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +load eeg8s.mat; % load signal +ly=length(eeg8s); +Fs=128; +%a=earpyw(eeg8s',11); % Calculates AR(11) parameters with Yule-Walker method +a=lattice(eeg8s',11); % Calculates AR(11) parameters with Yule-Walker method + % The AR parameters are the weight taps of IIR Filter +isig=filter([1 -a],1,eeg8s); % Inverse filtering + + +subplot(221); +plot((1:ly)/Fs,eeg8s); +title('Signal'); +xlabel('t [sec]') + +subplot(223); +plot((1:ly)/Fs,isig); +xlabel('t [sec]') +title('Inverse filtered process'); + +subplot(222); +H=abs(fft(eeg8s,128)/ly).^2; +plot(1:Fs,H); +%plot([H mean(H)*ones(Fs,1)]); +ylabel('S(f)') +xlabel('f [Hz]') +title('Spectrum of original signal'); + +subplot(224); +H=abs(fft(isig,128)/ly).^2; +plot(1:Fs,H); +%plot([H mean(H)*ones(Fs,1)]); +ylabel('S(f)') +xlabel('f [Hz]') +title('Spectrum of inverse filtered signal'); diff --git a/octave_packages/tsa-4.2.4/lattice.m b/octave_packages/tsa-4.2.4/lattice.m new file mode 100644 index 0000000..b74d653 --- /dev/null +++ b/octave_packages/tsa-4.2.4/lattice.m @@ -0,0 +1,127 @@ + function [MX,PE,arg3] = lattice(Y,lc,Mode); +% Estimates AR(p) model parameter with lattice algorithm (Burg 1968) +% for multiple channels. +% If you have the NaN-tools, LATTICE.M can handle missing values (NaN), +% +% [...] = lattice(y [,Pmax [,Mode]]); +% +% [AR,RC,PE] = lattice(...); +% [MX,PE] = lattice(...); +% +% INPUT: +% y signal (one per row), can contain missing values (encoded as NaN) +% Pmax max. model order (default size(y,2)-1)) +% Mode 'BURG' (default) Burg algorithm +% 'GEOL' geometric lattice +% +% OUTPUT +% AR autoregressive model parameter +% RC reflection coefficients (= -PARCOR coefficients) +% PE remaining error variance +% MX transformation matrix between ARP and RC (Attention: needs O(p^2) memory) +% AR(:,K) = MX(:, K*(K-1)/2+(1:K)); = MX(:,sum(1:K-1)+(1:K)); +% RC(:,K) = MX(:,cumsum(1:K)); = MX(:,(1:K).*(2:K+1)/2); +% +% All input and output parameters are organized in rows, one row +% corresponds to the parameters of one channel +% +% see also ACOVF ACORF AR2RC RC2AR DURLEV SUMSKIPNAN +% +% REFERENCE(S): +% J.P. Burg, "Maximum Entropy Spectral Analysis" Proc. 37th Meeting of the Society of Exp. Geophysiscists, Oklahoma City, OK 1967 +% J.P. Burg, "Maximum Entropy Spectral Analysis" PhD-thesis, Dept. of Geophysics, Stanford University, Stanford, CA. 1975. +% P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. +% S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + +% $Id: lattice.m 7687 2010-09-08 18:39:23Z schloegl $ +% Copyright (C) 1996-2002,2008,2010 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://biosig-consulting.com/matlab/tsa/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +if nargin<3, Mode='BURG'; +else Mode=upper(Mode(1:4));end; +BURG=~strcmp(Mode,'GEOL'); + +% Inititialization +[lr,N]=size(Y); +if nargin<2, lc=N-1; end; +F=Y; +B=Y; +[DEN,nn] = sumskipnan((Y.*Y),2); +PE = [DEN./nn,zeros(lr,lc)]; + +if nargout<3 % needs O(p^2) memory + MX = zeros(lr,lc*(lc+1)/2); + idx= 0; + + % Durbin-Levinson Algorithm + for K=1:lc, + [TMP,nn] = sumskipnan(F(:,K+1:N).*B(:,1:N-K),2); + MX(:,idx+K) = TMP./DEN; %Burg + if K>1, %for compatibility with OCTAVE 2.0.13 + MX(:,idx+(1:K-1))=MX(:,(K-2)*(K-1)/2+(1:K-1))-MX(:,(idx+K)*ones(K-1,1)).*MX(:,(K-2)*(K-1)/2+(K-1:-1:1)); + end; + + tmp = F(:,K+1:N) - MX(:,(idx+K)*ones(1,N-K)).*B(:,1:N-K); + B(:,1:N-K) = B(:,1:N-K) - MX(:,(idx+K)*ones(1,N-K)).*F(:,K+1:N); + F(:,K+1:N) = tmp; + + [PE(:,K+1),nn] = sumskipnan([F(:,K+1:N).^2,B(:,1:N-K).^2],2); + if ~BURG, + [f,nf] = sumskipnan(F(:,K+1:N).^2,2); + [b,nb] = sumskipnan(B(:,1:N-K).^2,2); + DEN = sqrt(b.*f); + else + DEN = PE(:,K+1); + end; + idx=idx+K; + PE(:,K+1) = PE(:,K+1)./nn; % estimate of covariance + end; +else % needs O(p) memory + arp=zeros(lr,lc-1); + rc=zeros(lr,lc-1); + % Durbin-Levinson Algorithm + for K=1:lc, + [TMP,nn] = sumskipnan(F(:,K+1:N).*B(:,1:N-K),2); + arp(:,K) = TMP./DEN; %Burg + rc(:,K) = arp(:,K); + if K>1, % for compatibility with OCTAVE 2.0.13 + arp(:,1:K-1) = arp(:,1:K-1) - arp(:,K*ones(K-1,1)).*arp(:,K-1:-1:1); + end; + + tmp = F(:,K+1:N) - rc(:,K*ones(1,N-K)).*B(:,1:N-K); + B(:,1:N-K) = B(:,1:N-K) - rc(:,K*ones(1,N-K)).*F(:,K+1:N); + F(:,K+1:N) = tmp; + + [PE(:,K+1),nn] = sumskipnan([F(:,K+1:N).^2,B(:,1:N-K).^2],2); + if ~BURG, + [f,nf] = sumskipnan(F(:,K+1:N).^2,2); + [b,nb] = sumskipnan(B(:,1:N-K).^2,2); + DEN = sqrt(b.*f); + else + DEN = PE(:,K+1); + end; + PE(:,K+1) = PE(:,K+1)./nn; % estimate of covariance + end; +% assign output arguments + arg3=PE; + PE=rc; + MX=arp; +end; %if + diff --git a/octave_packages/tsa-4.2.4/lpc.m b/octave_packages/tsa-4.2.4/lpc.m new file mode 100644 index 0000000..ffd60c2 --- /dev/null +++ b/octave_packages/tsa-4.2.4/lpc.m @@ -0,0 +1,71 @@ +function [A] = lpc(Y,P,mode); +% LPC Linear prediction coefficients +% The Burg-method is used to estimate the prediction coefficients +% +% A = lpc(Y [,P]) finds the coefficients A=[ 1 A(2) ... A(N+1) ], +% of an Pth order forward linear predictor +% +% Xp(n) = -A(2)*X(n-1) - A(3)*X(n-2) - ... - A(N+1)*X(n-P) +% +% such that the sum of the squares of the errors +% +% err(n) = X(n) - Xp(n) +% +% is minimized. X can be a vector or a matrix. If X is a matrix +% containing a separate signal in each column, LPC returns a model +% estimate for each column in the rows of A. N specifies the order +% of the polynomial A(z). +% +% If you do not specify a value for P, LPC uses a default P = length(X)-1. +% +% +% see also ACOVF ACORF AR2POLY RC2AR DURLEV SUMSKIPNAN LATTICE +% + +% REFERENCE(S): +% J.P. Burg, "Maximum Entropy Spectral Analysis" Proc. 37th Meeting of the Society of Exp. Geophysiscists, Oklahoma City, OK 1967 +% J.P. Burg, "Maximum Entropy Spectral Analysis" PhD-thesis, Dept. of Geophysics, Stanford University, Stanford, CA. 1975. +% P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. +% S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + +% $Id: lpc.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1996-2002,2008 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://hci.tugraz.at/schloegl/matlab/tsa/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +[yr,yc] = size(Y); +if yr < yc, + fprintf(2,'Warning LCP: data vector Y must be a column not a row vector\n'); +end; + +if nargin < 2, + P = yr-1; +end; + +% you can use any of the following routines. +% the lattice methods are preferable for stochastic time series. +% but can fail for deterministic signals see: +% http://sourceforge.net/mailarchive/message.php?msg_name=20080516115110.GB20642%40localhost + +% [AR,RC,PE] = lattice(Y.',P); % Burg method +% [AR,RC,PE] = lattice(Y.',P,'GEOL'); % geometric lattice +[AR,RC,PE] = durlev(acovf(Y.',P)); % Yule-Walker + +A = ar2poly(AR); + diff --git a/octave_packages/tsa-4.2.4/mvaar.m b/octave_packages/tsa-4.2.4/mvaar.m new file mode 100644 index 0000000..b829bf6 --- /dev/null +++ b/octave_packages/tsa-4.2.4/mvaar.m @@ -0,0 +1,174 @@ +function [x,e,Kalman,Q2] = mvaar(y,p,UC,mode,Kalman) +% Multivariate (Vector) adaptive AR estimation base on a multidimensional +% Kalman filer algorithm. A standard VAR model (A0=I) is implemented. The +% state vector is defined as X=(A1|A2...|Ap) and x=vec(X') +% +% [x,e,Kalman,Q2] = mvaar(y,p,UC,mode,Kalman) +% +% The standard MVAR model is defined as: +% +% y(n)-A1(n)*y(n-1)-...-Ap(n)*y(n-p)=e(n) +% +% The dimension of y(n) equals s +% +% Input Parameters: +% +% y Observed data or signal +% p prescribed maximum model order (default 1) +% UC update coefficient (default 0.001) +% mode update method of the process noise covariance matrix 0...4 ^ +% correspond to S0...S4 (default 0) +% +% Output Parameters +% +% e prediction error of dimension s +% x state vector of dimension s*s*p +% Q2 measurement noise covariance matrix of dimension s x s +% + +% $Id: mvaar.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 2001-2002 Christian Kasess +% Copyright (C) 2003, 2008 Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +if nargin<4, + mode=0; +end; +if nargin<3, + UC=0.001 +end; +if nargin<2, + p=1; +end +if nargin<1, + fprintf(2,'No arguments supplied\n'); + return +end; + +if ~any(mode==(0:4)) + fprintf(2,'Invalid mode (0...4)\n'); + return +end; + + +[M,LEN] = size(y'); %number of channels, total signal length +L = M*M*p; + +if LEN<(p+1), + fprintf(2,'Not enough observed data supplied for given model order\n'); + return +end + +ye = zeros(size(y)); %prediction of y + +if nargout>1, + x=zeros(L,LEN); +end; +if nargout>3, + Q2=zeros(M,M,LEN); +end + + + +if nargin<5, + %Kalman Filter initialsiation (Kp (K predicted or a-priori) equals K(n+1,n) ) + Kalman=struct('F',eye(L),'H',zeros(M,L),'G',zeros(L,M),'x',zeros(L,1),'Kp',eye(L),'Q1',eye(L)*UC,'Q2',eye(M),'ye',zeros(M,1)); + end; + +upd = eye(L)/L*UC; %diagonal matrix containing UC + + +if(mode==3) + Block=kron(eye(M),ones(M*p)); + +elseif(mode==4) + index=[]; + Block1=[]; + Block0=[]; + for i=1:M, + index=[index ((i-1)*M*p+i:M:i*M*p)]; + mone=eye(M); + mone(i,i)=0; + mzero=eye(M)-mone; + Block1=Blkdiag(Block1,kron(eye(p),mone)); + Block0=Blkdiag(Block0,kron(eye(p),mzero)); + end; +end; + + +for n = 2:LEN, + if(n<=p) + Yr=[y(n-1:-1:1,:)' zeros(M,p-n+1)]; %vector of past observations + Yr=Yr(:)'; + else + Yr=y(n-1:-1:n-p,:)'; %vector of past observations + Yr=Yr(:)'; + end + + %Update of measurement matrix + Kalman.H=kron(eye(M),Yr); + + + %calculate prediction error + ye(n,:)=(Kalman.H*Kalman.x)'; + err=y(n,:)-ye(n,:); + + if ~any(isnan(err(:))), + %update of Q2 using the prediction error of the previous step + Kalman.Q2=(1-UC)*Kalman.Q2+UC*err'*err; + + + KpH=Kalman.Kp*Kalman.H'; + HKp=Kalman.H*Kalman.Kp; + + %Kalman gain + Kalman.G=KpH*inv(Kalman.H*KpH+Kalman.Q2); + + %calculation of the a-posteriori state error covariance matrix + %K=Kalman.Kp-Kalman.G*KpH'; Althouh PK is supposed to be symmetric, this operation makes the filter unstable + K=Kalman.Kp-Kalman.G*HKp; + + %mode==0 no update of Q1 + %update of Q1 using the predicted state error cov matrix + if(mode==1) + Kalman.Q1=diag(diag(K)).*UC; + elseif(mode==2) + Kalman.Q1=upd*trace(K); + elseif(mode==3) + Kalman.Q1=diag(sum((Block*diag(diag(K)))'))/(p*M)*UC; + elseif(mode==4) + avg=trace(K(index,index))/(p*M)*UC; + Kalman.Q1=Block1*UC+Block0*avg; + end + + %a-priori state error covariance matrix for the next time step + Kalman.Kp=K+Kalman.Q1; + + %current estimation of state x + Kalman.x=Kalman.x+Kalman.G*(err)'; + end; % isnan>(err) + + if nargout>1, + x(:,n) = Kalman.x; + end; + if nargout>3, + Q2(:,:,n)=Kalman.Q2; + end; +end; + +e = y - ye; +x = x'; + diff --git a/octave_packages/tsa-4.2.4/mvar.m b/octave_packages/tsa-4.2.4/mvar.m new file mode 100644 index 0000000..c71d865 --- /dev/null +++ b/octave_packages/tsa-4.2.4/mvar.m @@ -0,0 +1,1138 @@ +function [ARF,RCF,PE,DC,varargout] = mvar(Y, Pmax, Mode); +% MVAR estimates parameters of the Multi-Variate AutoRegressive model +% +% Y(t) = Y(t-1) * A1 + ... + Y(t-p) * Ap + X(t); +% whereas +% Y(t) is a row vecter with M elements Y(t) = y(t,1:M) +% +% Several estimation algorithms are implemented, all estimators +% can handle data with missing values encoded as NaNs. +% +% [AR,RC,PE] = mvar(Y, p); +% [AR,RC,PE] = mvar(Y, p, Mode); +% +% with +% AR = [A1, ..., Ap]; +% +% INPUT: +% Y Multivariate data series +% p Model order +% Mode determines estimation algorithm +% +% OUTPUT: +% AR multivariate autoregressive model parameter +% RC reflection coefficients (= -PARCOR coefficients) +% PE remaining error variances for increasing model order +% PE(:,p*M+[1:M]) is the residual variance for model order p +% +% All input and output parameters are organized in columns, one column +% corresponds to the parameters of one channel. +% +% Mode determines estimation algorithm. +% 1: Correlation Function Estimation method using biased correlation function estimation method +% also called the 'multichannel Yule-Walker' [1,2] +% 6: Correlation Function Estimation method using unbiased correlation function estimation method +% +% 2: Partial Correlation Estimation: Vieira-Morf [2] using unbiased covariance estimates. +% In [1] this mode was used and (incorrectly) denominated as Nutall-Strand. +% Its the DEFAULT mode; according to [1] it provides the most accurate estimates. +% 5: Partial Correlation Estimation: Vieira-Morf [2] using biased covariance estimates. +% Yields similar results than Mode=2; +% +% 3: buggy: Partial Correlation Estimation: Nutall-Strand [2] (biased correlation function) +% 9: Partial Correlation Estimation: Nutall-Strand [2] (biased correlation function) +% 7: Partial Correlation Estimation: Nutall-Strand [2] (unbiased correlation function) +% 8: Least Squares w/o nans in Y(t):Y(t-p) +% 10: ARFIT [3] +% 11: BURGV [4] +% 13: modified BURGV - +% 14: modified BURGV [4] +% 15: Least Squares based on correlation matrix +% 22: Modified Partial Correlation Estimation: Vieira-Morf [2,5] using unbiased covariance estimates. +% 25: Modified Partial Correlation Estimation: Vieira-Morf [2,5] using biased covariance estimates. +% +% 90,91,96: Experimental versions +% +% Imputation methods: +% 100+Mode: +% 200+Mode: forward, past missing values are assumed zero +% 300+Mode: backward, past missing values are assumed zero +% 400+Mode: forward+backward, past missing values are assumed zero +% 1200+Mode: forward, past missing values are replaced with predicted value +% 1300+Mode: backward, 'past' missing values are replaced with predicted value +% 1400+Mode: forward+backward, 'past' missing values are replaced with predicted value +% 2200+Mode: forward, past missing values are replaced with predicted value + noise to prevent decaying +% 2300+Mode: backward, past missing values are replaced with predicted value + noise to prevent decaying +% 2400+Mode: forward+backward, past missing values are replaced with predicted value + noise to prevent decaying +% +% +% + +% REFERENCES: +% [1] A. Schloegl, Comparison of Multivariate Autoregressive Estimators. +% Signal processing, Elsevier B.V. (in press). +% available at http://dx.doi.org/doi:10.1016/j.sigpro.2005.11.007 +% [2] S.L. Marple 'Digital Spectral Analysis with Applications' Prentice Hall, 1987. +% [3] Schneider and Neumaier) +% [4] Stijn de Waele, 2003 +% [5] M. Morf, et al. Recursive Multichannel Maximum Entropy Spectral Estimation, +% IEEE trans. GeoSci. Elec., 1978, Vol.GE-16, No.2, pp85-94. +% +% +% A multivariate inverse filter can be realized with +% [AR,RC,PE] = mvar(Y,P); +% e = mvfilter([eye(size(AR,1)),-AR],eye(size(AR,1)),Y); +% +% see also: MVFILTER, MVFREQZ, COVM, SUMSKIPNAN, ARFIT2 + +% $Id: mvar.m 9609 2012-02-10 10:18:00Z schloegl $ +% Copyright (C) 1996-2006,2011,2012 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://pub.ist.ac.at/~schloegl/matlab/tsa/ +% http://octave.sourceforge.net/ +% http://biosig.sourceforge.net/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +% Inititialization +[N,M] = size(Y); + +if nargin<2, + Pmax=max([N,M])-1; +end; + +if iscell(Y) + Pmax = min(max(N ,M ),Pmax); + C = Y; +end; +if nargin<3, + % according to [1], and other internal validations this is in many cases the best algorithm + Mode=2; +end; + +[C(:,1:M),n] = covm(Y,'M'); +PE(:,1:M) = C(:,1:M)./n; +if 0, +elseif Mode==0; % this method is broken + fprintf('Warning MVAR: Mode=0 is broken.\n') + C(:,1:M) = C(:,1:M)/N; + F = Y; + B = Y; + PEF = C(:,1:M); %?% PEF = PE(:,1:M); + PEB = C(:,1:M); + for K=1:Pmax, + [D,n] = covm(Y(K+1:N,:),Y(1:N-K,:),'M'); + D = D/N; + ARF(:,K*M+(1-M:0)) = D/PEB; + ARB(:,K*M+(1-M:0)) = D'/PEF; + + tmp = F(K+1:N,:) - B(1:N-K,:)*ARF(:,K*M+(1-M:0))'; + B(1:N-K,:) = B(1:N-K,:) - F(K+1:N,:)*ARB(:,K*M+(1-M:0))'; + F(K+1:N,:) = tmp; + + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + RCB(:,K*M+(1-M:0)) = ARB(:,K*M+(1-M:0)); + + PEF = [eye(M) - ARF(:,K*M+(1-M:0))*ARB(:,K*M+(1-M:0))]*PEF; + PEB = [eye(M) - ARB(:,K*M+(1-M:0))*ARF(:,K*M+(1-M:0))]*PEB; + PE(:,K*M+(1:M)) = PEF; + end; + + +elseif Mode==1, %%%%% Levinson-Wiggens-Robinson (LWR) algorithm using biased correlation function + % ===== In [1,2] this algorithm is denoted 'Multichannel Yule-Walker' ===== % + C(:,1:M) = C(:,1:M)/N; + PEF = C(:,1:M); + PEB = C(:,1:M); + + for K=1:Pmax, + [C(:,K*M+(1:M)),n] = covm(Y(K+1:N,:),Y(1:N-K,:),'M'); + C(:,K*M+(1:M)) = C(:,K*M+(1:M))/N; + + D = C(:,K*M+(1:M)); + for L = 1:K-1, + D = D - ARF(:,L*M+(1-M:0))*C(:,(K-L)*M+(1:M)); + end; + ARF(:,K*M+(1-M:0)) = D / PEB; + ARB(:,K*M+(1-M:0)) = D'/ PEF; + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + RCB(:,K*M+(1-M:0)) = ARB(:,K*M+(1-M:0)); + + PEF = [eye(M) - ARF(:,K*M+(1-M:0))*ARB(:,K*M+(1-M:0))]*PEF; + PEB = [eye(M) - ARB(:,K*M+(1-M:0))*ARF(:,K*M+(1-M:0))]*PEB; + PE(:,K*M+(1:M)) = PEF; + end; + + +elseif Mode==6, %%%%% Levinson-Wiggens-Robinson (LWR) algorithm using unbiased correlation function + C(:,1:M) = C(:,1:M)/N; + PEF = C(:,1:M); %?% PEF = PE(:,1:M); + PEB = C(:,1:M); + + for K = 1:Pmax, + [C(:,K*M+(1:M)),n] = covm(Y(K+1:N,:),Y(1:N-K,:),'M'); + C(:,K*M+(1:M)) = C(:,K*M+(1:M))./n; + %C{K+1} = C{K+1}/N; + + D = C(:,K*M+(1:M)); + for L = 1:K-1, + D = D - ARF(:,L*M+(1-M:0))*C(:,(K-L)*M+(1:M)); + end; + ARF(:,K*M+(1-M:0)) = D / PEB; + ARB(:,K*M+(1-M:0)) = D'/ PEF; + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + RCB(:,K*M+(1-M:0)) = ARB(:,K*M+(1-M:0)); + + PEF = [eye(M) - ARF(:,K*M+(1-M:0))*ARB(:,K*M+(1-M:0))]*PEF; + PEB = [eye(M) - ARB(:,K*M+(1-M:0))*ARF(:,K*M+(1-M:0))]*PEB; + PE(:,K*M+(1:M)) = PEF; + end; + + +elseif Mode==2 %%%%% Partial Correlation Estimation: Vieira-Morf Method [2] with unbiased covariance estimation + %===== In [1] this algorithm is denoted 'Nutall-Strand with unbiased covariance' =====% + %C(:,1:M) = C(:,1:M)/N; + F = Y; + B = Y; + %PEF = C(:,1:M); + %PEB = C(:,1:M); + PEF = PE(:,1:M); + PEB = PE(:,1:M); + for K = 1:Pmax, + [D,n] = covm(F(K+1:N,:),B(1:N-K,:),'M'); + D = D./n; + + ARF(:,K*M+(1-M:0)) = D / PEB; + ARB(:,K*M+(1-M:0)) = D'/ PEF; + + tmp = F(K+1:N,:) - B(1:N-K,:)*ARF(:,K*M+(1-M:0)).'; + B(1:N-K,:) = B(1:N-K,:) - F(K+1:N,:)*ARB(:,K*M+(1-M:0)).'; + F(K+1:N,:) = tmp; + + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + RCB(:,K*M+(1-M:0)) = ARB(:,K*M+(1-M:0)); + + [PEF,n] = covm(F(K+1:N,:),F(K+1:N,:),'M'); + PEF = PEF./n; + + [PEB,n] = covm(B(1:N-K,:),B(1:N-K,:),'M'); + PEB = PEB./n; + + PE(:,K*M+(1:M)) = PEF; + end; + + +elseif Mode==5 %%%%% Partial Correlation Estimation: Vieira-Morf Method [2] with biased covariance estimation + %===== In [1] this algorithm is denoted 'Nutall-Strand with biased covariance' ===== % + + F = Y; + B = Y; + PEF = C(:,1:M); + PEB = C(:,1:M); + for K=1:Pmax, + [D,n] = covm(F(K+1:N,:),B(1:N-K,:),'M'); + %D=D/N; + + ARF(:,K*M+(1-M:0)) = D / PEB; + ARB(:,K*M+(1-M:0)) = D'/ PEF; + + tmp = F(K+1:N,:) - B(1:N-K,:)*ARF(:,K*M+(1-M:0)).'; + B(1:N-K,:) = B(1:N-K,:) - F(K+1:N,:)*ARB(:,K*M+(1-M:0)).'; + F(K+1:N,:) = tmp; + + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + RCB(:,K*M+(1-M:0)) = ARB(:,K*M+(1-M:0)); + + [PEB,n] = covm(B(1:N-K,:),B(1:N-K,:),'M'); + %PEB = D/N; + + [PEF,n] = covm(F(K+1:N,:),F(K+1:N,:),'M'); + %PEF = D/N; + + %PE(:,K*M+(1:M)) = PEF; + PE(:,K*M+(1:M)) = PEF./n; + end; + + +elseif 0, Mode==3 %%%%% Partial Correlation Estimation: Nutall-Strand Method [2] with biased covariance estimation + %%% OBSOLETE because its buggy, use Mode=9 instead. + % C(:,1:M) = C(:,1:M)/N; + F = Y; + B = Y; + PEF = C(:,1:M); + PEB = C(:,1:M); + for K=1:Pmax, + [D, n] = covm(F(K+1:N,:),B(1:N-K,:),'M'); + D = D./N; + + ARF(:,K*M+(1-M:0)) = 2*D / (PEB+PEF); + ARB(:,K*M+(1-M:0)) = 2*D'/ (PEF+PEB); + + tmp = F(K+1:N,:) - B(1:N-K,:)*ARF(:,K*M+(1-M:0)).'; + B(1:N-K,:) = B(1:N-K,:) - F(K+1:N,:)*ARB(:,K*M+(1-M:0)).'; + F(K+1:N,:) = tmp; + + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + %RCF{K} = ARF{K}; + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + + [PEF,n] = covm(F(K+1:N,:),F(K+1:N,:),'M'); + PEF = PEF./N; + + [PEB,n] = covm(B(1:N-K,:),B(1:N-K,:),'M'); + PEB = PEB./N; + + %PE(:,K*M+(1:M)) = PEF; + PE(:,K*M+(1:M)) = PEF./n; + end; + + +elseif Mode==7 %%%%% Partial Correlation Estimation: Nutall-Strand Method [2] with unbiased covariance estimation + + F = Y; + B = Y; + PEF = PE(:,1:M); + PEB = PE(:,1:M); + for K = 1:Pmax, + [D] = covm(F(K+1:N,:),B(1:N-K,:),'M'); + %D = D./n; + + ARF(:,K*M+(1-M:0)) = 2*D / (PEB+PEF); + ARB(:,K*M+(1-M:0)) = 2*D'/ (PEF+PEB); + + tmp = F(K+1:N,:) - B(1:N-K,:)*ARF(:,K*M+(1-M:0)).'; + B(1:N-K,:) = B(1:N-K,:) - F(K+1:N,:)*ARB(:,K*M+(1-M:0)).'; + F(K+1:N,:) = tmp; + + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + %RCF{K} = ARF{K}; + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + + [PEF] = covm(F(K+1:N,:),F(K+1:N,:),'M'); + %PEF = PEF./n; + + [PEB] = covm(B(1:N-K,:),B(1:N-K,:),'M'); + %PEB = PEB./n; + + %PE{K+1} = PEF; + PE(:,K*M+(1:M)) = PEF; + end; + + +elseif any(Mode==[3,9]) %%%%% Partial Correlation Estimation: Nutall-Strand Method [2] with biased covariance estimation + %% same as 3 but with fixed normalization + F = Y; + B = Y; + PEF = C(:,1:M); + PEB = C(:,1:M); + for K=1:Pmax, + [D, n] = covm(F(K+1:N,:),B(1:N-K,:),'M'); + + ARF(:,K*M+(1-M:0)) = 2*D / (PEB+PEF); + ARB(:,K*M+(1-M:0)) = 2*D'/ (PEF+PEB); + + tmp = F(K+1:N,:) - B(1:N-K,:)*ARF(:,K*M+(1-M:0)).'; + B(1:N-K,:) = B(1:N-K,:) - F(K+1:N,:)*ARB(:,K*M+(1-M:0)).'; + F(K+1:N,:) = tmp; + + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + %RCF{K} = ARF{K}; + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + + [PEF,nf] = covm(F(K+1:N,:),F(K+1:N,:),'M'); + [PEB,nb] = covm(B(1:N-K,:),B(1:N-K,:),'M'); + + %PE(:,K*M+(1:M)) = PEF; + PE(:,K*M+(1:M)) = PEF./nf; + end; + + +elseif Mode==4, %%%%% Kay, not fixed yet. + fprintf('Warning MVAR: Mode=4 is broken.\n') + + C(:,1:M) = C(:,1:M)/N; + K = 1; + [C(:,M+(1:M)),n] = covm(Y(2:N,:),Y(1:N-1,:)); + C(:,M+(1:M)) = C(:,M+(1:M))/N; % biased estimate + + D = C(:,M+(1:M)); + ARF(:,1:M) = C(:,1:M)\D; + ARB(:,1:M) = C(:,1:M)\D'; + RCF(:,1:M) = ARF(:,1:M); + RCB(:,1:M) = ARB(:,1:M); + PEF = C(:,1:M)*[eye(M) - ARB(:,1:M)*ARF(:,1:M)]; + PEB = C(:,1:M)*[eye(M) - ARF(:,1:M)*ARB(:,1:M)]; + + for K=2:Pmax, + [C(:,K*M+(1:M)),n] = covm(Y(K+1:N,:),Y(1:N-K,:),'M'); + C(:,K*M+(1:M)) = C(:,K*M+(1:M)) / N; % biased estimate + + D = C(:,K*M+(1:M)); + for L = 1:K-1, + D = D - C(:,(K-L)*M+(1:M))*ARF(:,L*M+(1-M:0)); + end; + + ARF(:,K*M+(1-M:0)) = PEB \ D; + ARB(:,K*M+(1-M:0)) = PEF \ D'; + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)) ; + RCB(:,K*M+(1-M:0)) = ARB(:,K*M+(1-M:0)) ; + + PEF = PEF*[eye(M) - ARB(:,K*M+(1-M:0)) *ARF(:,K*M+(1-M:0)) ]; + PEB = PEB*[eye(M) - ARF(:,K*M+(1-M:0)) *ARB(:,K*M+(1-M:0)) ]; + PE(:,K*M+(1:M)) = PEF; + end; + + +elseif Mode==8, %%%%% Least Squares + ix = Pmax+1:N; + y = repmat(NaN,N-Pmax,M*Pmax); + for k = 1:Pmax, + y(:,k*M+[1-M:0]) = Y(ix-k,:); + end; + ix2 = ~any(isnan([Y(ix,:),y]),2); + ARF = Y(ix(ix2),:)'/y(ix2,:)'; + PE = covm(Y(ix,:) - y*ARF'); + RCF = zeros(M,M*Pmax); + + +elseif Mode==10, %%%%% ARFIT + try + RCF = []; + [w, ARF, PE] = arfit(Y, Pmax, Pmax, 'sbc', 'zero'); + catch + ARF = zeros(M,M*Pmax); + RCF = ARF; + end; + + +elseif Mode==11, %%%%% de Waele 2003 + %%% OBSOLETE + warning('MVAR: mode=11 is obsolete use Mode 13 or 14!'); + [pc,R0] = burgv(reshape(Y',[M,1,N]),Pmax); + try, + [ARF,ARB,Pf,Pb,RCF,RCB] = pc2parv(pc,R0); + catch + [RCF,RCB,Pf,Pb] = pc2rcv(pc,R0); + [ARF,ARB,Pf,Pb] = pc2parv(pc,R0); + end; + ARF = -reshape(ARF(:,:,2:end),[M,M*Pmax]); + RCF = -reshape(RCF(:,:,2:end),[M,M*Pmax]); + PE = reshape(Pf,[M,M*(Pmax+1)]); + + +elseif Mode==12, + %%% OBSOLETE + warning('MVAR: mode=12 is obsolete use Mode 13 or 14!'); + % this is equivalent to Mode==11 + [pc,R0] = burgv(reshape(Y',[M,1,N]),Pmax); + [rcf,rcb,Pf,Pb] = pc2rcv(pc,R0); + + %%%%% Convert reflection coefficients RC to autoregressive parameters + ARF = zeros(M,M*Pmax); + ARB = zeros(M,M*Pmax); + for K = 1:Pmax, + ARF(:,K*M+(1-M:0)) = -rcf(:,:,K+1); + ARB(:,K*M+(1-M:0)) = -rcb(:,:,K+1); + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + end; + RCF = -reshape(rcf(:,:,2:end),[M,M*Pmax]); + PE = reshape(Pf,[M,M*(Pmax+1)]); + + +elseif Mode==13, + % this is equivalent to Mode==11 but can deal with missing values + %%%%%%%%%%% [pc,R0] = burgv_nan(reshape(Y',[M,1,N]),Pmax,1); + % Copyright S. de Waele, March 2003 - modified Alois Schloegl, 2009 + I = eye(M); + + sz = [M,M,Pmax+1]; + pc= zeros(sz); pc(:,:,1) =I; + K = zeros(sz); K(:,:,1) =I; + Kb= zeros(sz); Kb(:,:,1) =I; + P = zeros(sz); + Pb= zeros(sz); + + %[P(:,:,1)]= covm(Y); + [P(:,:,1)]= PE(:,1:M); % normalized + Pb(:,:,1)= P(:,:,1); + f = Y; + b = Y; + + %the recursive algorithm + for i = 1:Pmax, + v = f(2:end,:); + w = b(1:end-1,:); + + %% normalized, unbiased + Rvv = covm(v); %Pfhat + Rww = covm(w); %Pbhat + Rvw = covm(v,w); %Pfbhat + Rwv = covm(w,v); % = Rvw', written out for symmetry + delta = lyap(Rvv*inv(P(:,:,i)),inv(Pb(:,:,i))*Rww,-2*Rvw); + + TsqrtS = chol( P(:,:,i))'; %square root M defined by: M=Tsqrt(M)*Tsqrt(M)' + TsqrtSb= chol(Pb(:,:,i))'; + pc(:,:,i+1) = inv(TsqrtS)*delta*inv(TsqrtSb)'; + + %The forward and backward reflection coefficient + K(:,:,i+1) = -TsqrtS *pc(:,:,i+1) *inv(TsqrtSb); + Kb(:,:,i+1)= -TsqrtSb*pc(:,:,i+1)'*inv(TsqrtS); + + %filtering the reflection coefficient out: + f = (v'+ K(:,:,i+1)*w')'; + b = (w'+Kb(:,:,i+1)*v')'; + + %The new R and Rb: + %residual matrices + P(:,:,i+1) = (I-TsqrtS *pc(:,:,i+1) *pc(:,:,i+1)'*inv(TsqrtS ))*P(:,:,i); + Pb(:,:,i+1) = (I-TsqrtSb*pc(:,:,i+1)'*pc(:,:,i+1) *inv(TsqrtSb))*Pb(:,:,i); + end %for i = 1:Pmax, + R0 = PE(:,1:M); + + %% [rcf,rcb,Pf,Pb] = pc2rcv(pc,R0); + rcf = zeros(sz); rcf(:,:,1) = I; + Pf = zeros(sz); Pf(:,:,1) = R0; + rcb = zeros(sz); rcb(:,:,1) = I; + Pb = zeros(sz); Pb(:,:,1) = R0; + + for p = 1:Pmax, + TsqrtPf = chol( Pf(:,:,p))'; %square root M defined by: M=Tsqrt(M)*Tsqrt(M)' + TsqrtPb= chol(Pb(:,:,p))'; + %reflection coefficients + rcf(:,:,p+1) = -TsqrtPf *pc(:,:,p+1) *inv(TsqrtPb); + rcb(:,:,p+1)= -TsqrtPb*pc(:,:,p+1)'*inv(TsqrtPf ); + %residual matrices + Pf(:,:,p+1) = (I-TsqrtPf *pc(:,:,p+1) *pc(:,:,p+1)'*inv(TsqrtPf ))*Pf(:,:,p); + Pb(:,:,p+1) = (I-TsqrtPb*pc(:,:,p+1)'*pc(:,:,p+1) *inv(TsqrtPb))*Pb(:,:,p); + end %for p = 2:order, + %%%%%%%%%%%%%% end %%%%%% + + + %%%%% Convert reflection coefficients RC to autoregressive parameters + ARF = zeros(M,M*Pmax); + ARB = zeros(M,M*Pmax); + for K = 1:Pmax, + ARF(:,K*M+(1-M:0)) = -rcf(:,:,K+1); + ARB(:,K*M+(1-M:0)) = -rcb(:,:,K+1); + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + end; + RCF = -reshape(rcf(:,:,2:end),[M,M*Pmax]); + PE = reshape(Pf,[M,M*(Pmax+1)]); + + +elseif Mode==14, + % this is equivalent to Mode==11 but can deal with missing values + %%%%%%%%%%%%%% [pc,R0] = burgv_nan(reshape(Y',[M,1,N]),Pmax,2); + % Copyright S. de Waele, March 2003 - modified Alois Schloegl, 2009 + I = eye(M); + + sz = [M,M,Pmax+1]; + pc= zeros(sz); pc(:,:,1) =I; + K = zeros(sz); K(:,:,1) =I; + Kb= zeros(sz); Kb(:,:,1) =I; + P = zeros(sz); + Pb= zeros(sz); + + %[P(:,:,1),nn]= covm(Y); + [P(:,:,1)]= C(:,1:M); %% no normalization + Pb(:,:,1)= P(:,:,1); + f = Y; + b = Y; + + %the recursive algorithm + for i = 1:Pmax, + v = f(2:end,:); + w = b(1:end-1,:); + + %% no normalization + [Rvv,nn] = covm(v); %Pfhat + [Rww,nn] = covm(w); %Pbhat + [Rvw,nn] = covm(v,w); %Pfbhat + [Rwv,nn] = covm(w,v); % = Rvw', written out for symmetry + delta = lyap(Rvv*inv(P(:,:,i)),inv(Pb(:,:,i))*Rww,-2*Rvw); + + TsqrtS = chol( P(:,:,i))'; %square root M defined by: M=Tsqrt(M)*Tsqrt(M)' + TsqrtSb= chol(Pb(:,:,i))'; + pc(:,:,i+1) = inv(TsqrtS)*delta*inv(TsqrtSb)'; + + %The forward and backward reflection coefficient + K(:,:,i+1) = -TsqrtS *pc(:,:,i+1) *inv(TsqrtSb); + Kb(:,:,i+1)= -TsqrtSb*pc(:,:,i+1)'*inv(TsqrtS); + + %filtering the reflection coefficient out: + f = (v'+ K(:,:,i+1)*w')'; + b = (w'+Kb(:,:,i+1)*v')'; + + %The new R and Rb: + %residual matrices + P(:,:,i+1) = (I-TsqrtS *pc(:,:,i+1) *pc(:,:,i+1)'*inv(TsqrtS ))*P(:,:,i); + Pb(:,:,i+1) = (I-TsqrtSb*pc(:,:,i+1)'*pc(:,:,i+1) *inv(TsqrtSb))*Pb(:,:,i); + end %for i = 1:Pmax, + R0 = PE(:,1:M); + + %%%%%%%%%% [rcf,rcb,Pf,Pb] = pc2rcv(pc,R0); + sz = [M,M,Pmax+1]; + rcf = zeros(sz); rcf(:,:,1) = I; + Pf = zeros(sz); Pf(:,:,1) = R0; + rcb = zeros(sz); rcb(:,:,1) = I; + Pb = zeros(sz); Pb(:,:,1) = R0; + for p = 1:Pmax, + TsqrtPf = chol( Pf(:,:,p))'; %square root M defined by: M=Tsqrt(M)*Tsqrt(M)' + TsqrtPb = chol(Pb(:,:,p))'; + %reflection coefficients + rcf(:,:,p+1)= -TsqrtPf *pc(:,:,p+1) *inv(TsqrtPb); + rcb(:,:,p+1)= -TsqrtPb *pc(:,:,p+1)'*inv(TsqrtPf ); + %residual matrices + Pf(:,:,p+1) = (I-TsqrtPf *pc(:,:,p+1) *pc(:,:,p+1)'*inv(TsqrtPf))*Pf(:,:,p); + Pb(:,:,p+1) = (I-TsqrtPb *pc(:,:,p+1)'*pc(:,:,p+1) *inv(TsqrtPb))*Pb(:,:,p); + end %for p = 2:order, + %%%%%%%%%%%%%% end %%%%%% + + %%%%% Convert reflection coefficients RC to autoregressive parameters + ARF = zeros(M,M*Pmax); + ARB = zeros(M,M*Pmax); + for K = 1:Pmax, + ARF(:,K*M+(1-M:0)) = -rcf(:,:,K+1); + ARB(:,K*M+(1-M:0)) = -rcb(:,:,K+1); + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + end; + RCF = -reshape(rcf(:,:,2:end),[M,M*Pmax]); + PE = reshape(Pf,[M,M*(Pmax+1)]); + + +elseif Mode==15, %%%%% Least Squares + %% FIXME + for K=1:Pmax, + [C(:,K*M+(1:M)),n] = covm(Y(K+1:N,:),Y(1:N-K,:),'M'); +% C(K*M+(1:M),:) = C(K*M+(1:M),:)/N; + end; + ARF = C(:,1:M)'/C(:,M+1:end)'; + PE = covm(C(:,1:M)' - ARF * C(:,M+1:end)'); + RCF = zeros(M, M*Pmax); + + +elseif 0, + %%%%% ARFIT and handling missing values + % compute QR factorization for model of order pmax + [R, scale] = arqr(Y, Pmax, 0); + % select order of model + popt = Pmax; % estimated optimum order + np = M*Pmax; % number of parameter vectors of length m + % decompose R for the optimal model order popt according to + % + % | R11 R12 | + % R=| | + % | 0 R22 | + % + R11 = R(1:np, 1:np); + R12 = R(1:np, Pmax+1:Pmax+M); + R22 = R(M*Pmax+1:Pmax+M, Pmax+1:Pmax+M); + A = (R11\R12)'; + % return covariance matrix + dof = N-Pmax-M*Pmax; % number of block degrees of freedom + PE = R22'*R22./dof; % bias-corrected estimate of covariance matrix + + try + RCF = []; + [w, ARF, PE] = arfit(Y, Pmax, Pmax, 'sbc', 'zero'); + catch + ARF = zeros(M,M*Pmax); + RCF = ARF; + end; + + +elseif Mode==22 %%%%% Modified Partial Correlation Estimation: Vieira-Morf [2,5] using unbiased covariance estimates. + %--------Initialization---------- + F = Y; + B = Y; + [PEF, n] = covm(Y(2:N,:),'M'); + PEF = PEF./n; + [PEB, n] = covm(Y(1:N-1,:),'M'); + PEB = PEB./n; + %--------------------------------- + for K = 1:Pmax, + %---Update the estimated error covariances(15.89) in [2]--- + [PEFhat,n] = covm(F(K+1:N,:),'M'); + PEFhat = PEFhat./n; + + [PEBhat,n] = covm(B(1:N-K,:),'M'); + PEBhat = PEBhat./n; + + [PEFBhat,n] = covm(F(K+1:N,:),B(1:N-K,:),'M'); + PEFBhat = PEFBhat./n; + + %---Compute estimated normalized partial correlation matrix(15.88)in [2]--- + Rho = inv(chol(PEFhat)')*PEFBhat*inv(chol(PEBhat)); + + %---Update forward and backward reflection coefficients (15.82) and (15.83) in [2]--- + ARF(:,K*M+(1-M:0)) = chol(PEF)'*Rho*inv(chol(PEB)'); + ARB(:,K*M+(1-M:0)) = chol(PEB)'*Rho'*inv(chol(PEF)'); + + %--------------------------------- + tmp = F(K+1:N,:) - B(1:N-K,:)*ARF(:,K*M+(1-M:0)).'; + B(1:N-K,:) = B(1:N-K,:) - F(K+1:N,:)*ARB(:,K*M+(1-M:0)).'; + F(K+1:N,:) = tmp; + + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + RCB(:,K*M+(1-M:0)) = ARB(:,K*M+(1-M:0)); + + %---Update forward and backward error covariances (15.75) and (15.76) in [2]--- + PEF = (eye(M)-ARF(:,K*M+(1-M:0))*ARB(:,K*M+(1-M:0)))*PEF; + PEB = (eye(M)-ARB(:,K*M+(1-M:0))*ARF(:,K*M+(1-M:0)))*PEB; + + PE(:,K*M+(1:M)) = PEF; + end + + +elseif Mode==25 %%%%Modified Partial Correlation Estimation: Vieira-Morf [2,5] using biased covariance estimates. + %--------Initialization---------- + F = Y; + B = Y; + [PEF, n] = covm(Y(2:N,:),'M'); + PEF = PEF./N; + [PEB, n] = covm(Y(1:N-1,:),'M'); + PEB = PEB./N; + %--------------------------------- + for K = 1:Pmax, + %---Update the estimated error covariances(15.89) in [2]--- + [PEFhat,n] = covm(F(K+1:N,:),'M'); + PEFhat = PEFhat./N; + + [PEBhat,n] = covm(B(1:N-K,:),'M'); + PEBhat = PEBhat./N; + + [PEFBhat,n] = covm(F(K+1:N,:),B(1:N-K,:),'M'); + PEFBhat = PEFBhat./N; + + %---Compute estimated normalized partial correlation matrix(15.88)in [2]--- + Rho = inv(chol(PEFhat)')*PEFBhat*inv(chol(PEBhat)); + + %---Update forward and backward reflection coefficients (15.82) and (15.83) in [2]--- + ARF(:,K*M+(1-M:0)) = chol(PEF)'*Rho*inv(chol(PEB)'); + ARB(:,K*M+(1-M:0)) = chol(PEB)'*Rho'*inv(chol(PEF)'); + + %--------------------------------- + tmp = F(K+1:N,:) - B(1:N-K,:)*ARF(:,K*M+(1-M:0)).'; + B(1:N-K,:) = B(1:N-K,:) - F(K+1:N,:)*ARB(:,K*M+(1-M:0)).'; + F(K+1:N,:) = tmp; + + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + RCB(:,K*M+(1-M:0)) = ARB(:,K*M+(1-M:0)); + + %---Update forward and backward error covariances (15.75) and (15.76) in [2]--- + PEF = (eye(M)-ARF(:,K*M+(1-M:0))*ARB(:,K*M+(1-M:0)))*PEF; + PEB = (eye(M)-ARB(:,K*M+(1-M:0))*ARF(:,K*M+(1-M:0)))*PEB; + + PE(:,K*M+(1:M)) = PEF; + end + + + + +%%%%% EXPERIMENTAL VERSIONS %%%%% + +elseif Mode==90; + % similar to MODE=0 + %% not recommended + C(:,1:M) = C(:,1:M)/N; + F = Y; + B = Y; + PEF = PE(:,1:M); %CHANGED% + PEB = PE(:,1:M); %CHANGED% + for K=1:Pmax, + [D,n] = covm(Y(K+1:N,:),Y(1:N-K,:),'M'); + D = D/N; + ARF(:,K*M+(1-M:0)) = D/PEB; + ARB(:,K*M+(1-M:0)) = D'/PEF; + + tmp = F(K+1:N,:) - B(1:N-K,:)*ARF(:,K*M+(1-M:0))'; + B(1:N-K,:) = B(1:N-K,:) - F(K+1:N,:)*ARB(:,K*M+(1-M:0))'; + F(K+1:N,:) = tmp; + + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + RCB(:,K*M+(1-M:0)) = ARB(:,K*M+(1-M:0)); + + PEF = [eye(M) - ARF(:,K*M+(1-M:0))*ARB(:,K*M+(1-M:0))]*PEF; + PEB = [eye(M) - ARB(:,K*M+(1-M:0))*ARF(:,K*M+(1-M:0))]*PEB; + PE(:,K*M+(1:M)) = PEF; + end; + + +elseif Mode==91, %%%%% Levinson-Wiggens-Robinson (LWR) algorithm using biased correlation function + % ===== In [1,2] this algorithm is denoted 'Multichannel Yule-Walker' ===== % + % similar to MODE=1 + %% not recommended + C(:,1:M) = C(:,1:M)/N; + PEF = PE(:,1:M); %CHANGED% + PEB = PE(:,1:M); %CHANGED% + + for K=1:Pmax, + [C(:,K*M+(1:M)),n] = covm(Y(K+1:N,:),Y(1:N-K,:),'M'); + C(:,K*M+(1:M)) = C(:,K*M+(1:M))/N; + + D = C(:,K*M+(1:M)); + for L = 1:K-1, + D = D - ARF(:,L*M+(1-M:0))*C(:,(K-L)*M+(1:M)); + end; + ARF(:,K*M+(1-M:0)) = D / PEB; + ARB(:,K*M+(1-M:0)) = D'/ PEF; + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + RCB(:,K*M+(1-M:0)) = ARB(:,K*M+(1-M:0)); + + PEF = [eye(M) - ARF(:,K*M+(1-M:0))*ARB(:,K*M+(1-M:0))]*PEF; + PEB = [eye(M) - ARB(:,K*M+(1-M:0))*ARF(:,K*M+(1-M:0))]*PEB; + PE(:,K*M+(1:M)) = PEF; + end; + + +elseif Mode==96, %%%%% Levinson-Wiggens-Robinson (LWR) algorithm using unbiased correlation function + % similar to MODE=6 + %% not recommended + C(:,1:M) = C(:,1:M)/N; + PEF = PE(:,1:M); %CHANGED% + PEB = PE(:,1:M); %CHANGED% + + for K = 1:Pmax, + [C(:,K*M+(1:M)),n] = covm(Y(K+1:N,:),Y(1:N-K,:),'M'); + C(:,K*M+(1:M)) = C(:,K*M+(1:M))./n; + + D = C(:,K*M+(1:M)); + for L = 1:K-1, + D = D - ARF(:,L*M+(1-M:0))*C(:,(K-L)*M+(1:M)); + end; + ARF(:,K*M+(1-M:0)) = D / PEB; + ARB(:,K*M+(1-M:0)) = D'/ PEF; + for L = 1:K-1, + tmp = ARF(:,L*M+(1-M:0)) - ARF(:,K*M+(1-M:0))*ARB(:,(K-L)*M+(1-M:0)); + ARB(:,(K-L)*M+(1-M:0)) = ARB(:,(K-L)*M+(1-M:0)) - ARB(:,K*M+(1-M:0))*ARF(:,L*M+(1-M:0)); + ARF(:,L*M+(1-M:0)) = tmp; + end; + + RCF(:,K*M+(1-M:0)) = ARF(:,K*M+(1-M:0)); + RCB(:,K*M+(1-M:0)) = ARB(:,K*M+(1-M:0)); + + PEF = [eye(M) - ARF(:,K*M+(1-M:0))*ARB(:,K*M+(1-M:0))]*PEF; + PEB = [eye(M) - ARB(:,K*M+(1-M:0))*ARF(:,K*M+(1-M:0))]*PEB; + PE(:,K*M+(1:M)) = PEF; + end; + +elseif Mode<100, + fprintf('Warning MVAR: Mode=%i not supported\n',Mode); + +%%%%% IMPUTATION METHODS %%%%% +else + + Mode0 = rem(Mode,100); + if ((Mode0 >= 10) && (Mode0 < 20)), + Mode0 = 1; + end; + +if 0, + + +elseif Mode>=2400, % forward and backward +% assuming that past missing values are already IMPUTED with the prediction value + innovation process +% no decaying + + [ARF,RCF,PE2] = mvar(Y, Pmax, Mode0); + c = chol( PE2 (:, M*Pmax+(1:M))); + + Y1 = Y; + Y1(1,isnan(Y1(1,:))) = 0; + z = []; + for k = 2:size(Y,1) + [z1,z] = mvfilter(ARF,eye(M),Y1(k-1,:)',z); + ix = isnan(Y1(k,:)); + z1 = z1 + (randn(1,M)*c)'; + Y1(k,ix) = z1(ix); + end; + + Y2 = flipud(Y); + [ARB,RCF,PE] = mvar(Y2, Pmax, Mode0); + Y2(1,isnan(Y2(1,:))) = 0; + z = []; + for k = 2:size(Y2,1) + [z2,z] = mvfilter(ARB,eye(M),Y2(k-1,:)',z); + ix = isnan(Y(size(Y,1)-k+1,:)); + z2 = z2 + (randn(1,M)*c)'; + Y2(k,ix) = (z2(ix)' + Y2(k,ix))/2; + end; + Y2 = flipud(Y2); + + Z = (Y2+Y1)/2; + Y(isnan(Y)) = Z(isnan(Y)); + + [ARF,RCF,PE] = mvar(Y, Pmax, rem(Mode,100)); + + +elseif Mode>=2300, % backward prediction +% assuming that past missing values are already IMPUTED with the prediction value + innovation process +% no decaying + + Y = flipud(Y); + [ARB,RCF,PE] = mvar(Y, Pmax, Mode0); + c = chol(PE(:,M*Pmax+(1:M))); + Y1 = Y; + Y1(1,isnan(Y1(1,:))) = 0; + z = []; + for k = 2:size(Y,1) + [z1,z] = mvfilter(ARB,eye(M),Y1(k-1,:)',z); + ix = isnan(Y1(k,:)); + z1 = z1 + (randn(1,M)*c)'; + Y1(k,ix) = z1(ix); + end; + Y1 = flipud(Y1); + [ARF,RCF,PE] = mvar(Y1, Pmax, rem(Mode,100)); + + +elseif Mode>=2200, % forward predictions, +% assuming that past missing values are already IMPUTED with the prediction value + innovation process +% no decaying + [ARF,RCF,PE] = mvar(Y, Pmax, Mode0); + c = chol(PE(:,M*Pmax+(1:M))); + Y1 = Y; + Y1(1,isnan(Y1(1,:))) = 0; + z = []; + for k = 2:size(Y,1) + [z1,z] = mvfilter(ARF,eye(M),Y1(k-1,:)',z); + ix = isnan(Y1(k,:)); + z1 = z1 + (randn(1,M)*c)'; + Y1(k,ix) = z1(ix); + end; + [ARF,RCF,PE] = mvar(Y1, Pmax, rem(Mode,100)); + + +elseif Mode>=1400, % forward and backward +%assuming that past missing values are already IMPUTED with the prediction value + [ARF,RCF,PE] = mvar(Y, Pmax, Mode0); + Y1 = Y; + Y1(1,isnan(Y1(1,:))) = 0; + z = []; + for k = 2:size(Y,1) + [z1,z] = mvfilter(ARF,eye(M),Y1(k-1,:)',z); + ix = isnan(Y1(k,:)); + Y1(k,ix) = z1(ix); + end; + + Y2 = flipud(Y); + [ARB,RCF,PE] = mvar(Y2, Pmax, Mode0); + Y2(1,isnan(Y2(1,:))) = 0; + z = []; + for k = 2:size(Y2,1) + [z2,z] = mvfilter(ARB,eye(M),Y2(k-1,:)',z); + ix = isnan(Y2(k,:)); + Y2(k,ix) = z2(ix)'; + end; + Y2 = flipud(Y2); + + Z = (Y2+Y1)/2; + Y(isnan(Y)) = Z(isnan(Y)); + + [ARF,RCF,PE] = mvar(Y, Pmax, rem(Mode,100)); + + +elseif Mode>=1300, % backward prediction + Y = flipud(Y); + [ARB,RCF,PE] = mvar(Y, Pmax, Mode0); + Y2 = Y; + Y2(1,isnan(Y2(1,:))) = 0; + z = []; + for k = 2:size(Y,1) + [z2,z] = mvfilter(ARB,eye(M),Y2(k-1,:)',z); + ix = isnan(Y2(k,:)); + Y2(k,ix) = z2(ix); + end; + Y2 = flipud(Y2); + [ARF,RCF,PE] = mvar(Y2, Pmax, rem(Mode,100)); + + +elseif Mode>=1200, % forward predictions, +%assuming that past missing values are already IMPUTED with the prediction value + [ARF,RCF,PE] = mvar(Y, Pmax, Mode0); + Y1 = Y; + Y1(1,isnan(Y1(1,:))) = 0; + z = []; + for k = 2:size(Y,1) + [z1,z] = mvfilter(ARF,eye(M),Y1(k-1,:)',z); + ix = isnan(Y1(k,:)); + Y1(k,ix) = z1(ix); + end; + [ARF,RCF,PE] = mvar(Y1, Pmax, rem(Mode,100)); + + +elseif Mode>=400, % forward and backward +% assuming that 'past' missing values are ZERO + [ARF,RCF,PE] = mvar(Y, Pmax, Mode0); + Y1 = Y; + Y1(isnan(Y)) = 0; + Z1 = mvfilter([zeros(M),ARF],eye(M),Y1')'; + Y1(isnan(Y)) = Z1(isnan(Y)); + + Y = flipud(Y); + [ARB,RCF,PE] = mvar(Y, Pmax, Mode0); + Y2 = Y; + Y2(isnan(Y)) = 0; + Z2 = mvfilter([zeros(M),ARB],eye(M),Y2')'; + Y2(isnan(Y)) = Z2(isnan(Y)); + Y2 = flipud(Y2); + + [ARF,RCF,PE] = mvar((Y1+Y2)/2, Pmax, rem(Mode,100)); + + +elseif Mode>=300, % backward prediction +% assuming that 'past' missing values are ZERO + Y = flipud(Y); + [ARB,RCF,PE] = mvar(Y, Pmax, Mode0); + Y2 = Y; + Y2(isnan(Y)) = 0; + Z2 = mvfilter([zeros(M),ARB],eye(M),Y2')'; + Y2(isnan(Y)) = Z2(isnan(Y)); + Y2 = flipud(Y2); + + [ARF,RCF,PE] = mvar(Y2, Pmax, rem(Mode,100)); + + +elseif Mode>=200, +% forward predictions, assuming that past missing values are ZERO + [ARF,RCF,PE] = mvar(Y, Pmax, Mode0); + Y1 = Y; + Y1(isnan(Y)) = 0; + Z1 = mvfilter([zeros(M),ARF],eye(M),Y1')'; + Y1(isnan(Y)) = Z1(isnan(Y)); + + [ARF,RCF,PE] = mvar(Y1, Pmax, rem(Mode,100)); + + +elseif Mode>=100, + [ARF,RCF,PE] = mvar(Y, Pmax, Mode0); + Z1 = mvfilter(ARF,eye(M),Y')'; + Z1 = [zeros(1,M); Z1(1:end-1,:)]; + Y(isnan(Y)) = Z1(isnan(Y)); + [ARF,RCF,PE] = mvar(Y, Pmax, rem(Mode,100)); + + +end; +end; + + +if any(ARF(:)==inf), +% Test for matrix division bug. +% This bug was observed in LNX86-ML5.3, 6.1 and 6.5, but not in SGI-ML6.5, LNX86-ML6.5, Octave 2.1.35-40; Other platforms unknown. +p = 3; +FLAG_MATRIX_DIVISION_ERROR = ~all(all(isnan(repmat(0,p)/repmat(0,p)))) | ~all(all(isnan(repmat(nan,p)/repmat(nan,p)))); + +if FLAG_MATRIX_DIVISION_ERROR, + %fprintf(2,'%%% Warning MVAR: Bug in Matrix-Division 0/0 and NaN/NaN yields INF instead of NAN. Workaround is applied.\n'); + warning('MVAR: bug in Matrix-Division 0/0 and NaN/NaN yields INF instead of NAN. Workaround is applied.'); + + %%%%% Workaround + ARF(ARF==inf)=NaN; + RCF(RCF==inf)=NaN; +end; +end; + +%MAR = zeros(M,M*Pmax); +DC = zeros(M); +for K = 1:Pmax, +% VAR{K+1} = -ARF(:,K*M+(1-M:0))'; + DC = DC + ARF(:,K*M+(1-M:0))'.^2; %DC meausure [3] +end; + diff --git a/octave_packages/tsa-4.2.4/mvfilter.m b/octave_packages/tsa-4.2.4/mvfilter.m new file mode 100644 index 0000000..23cb042 --- /dev/null +++ b/octave_packages/tsa-4.2.4/mvfilter.m @@ -0,0 +1,111 @@ + +function [x,z]=mvfilter(B,A,x,z) +% Multi-variate filter function +% +% Y = MVFILTER(B,A,X) +% [Y,Z] = MVFILTER(B,A,X,Z) +% +% Y = MVFILTER(B,A,X) filters the data in matrix X with the +% filter described by cell arrays A and B to create the filtered +% data Y. The filter is a 'Direct Form II Transposed' +% implementation of the standard difference equation: +% +% a0*Y(n) = b0*X(:,n) + b1*X(:,n-1) + ... + bq*X(:,n-q) +% - a1*Y(:,n-1) - ... - ap*Y(:,n-p) +% +% A=[a0,a1,a2,...,ap] and B=[b0,b1,b2,...,bq] must be matrices of +% size Mx((p+1)*M) and Mx((q+1)*M), respectively. +% a0,a1,...,ap, b0,b1,...,bq are matrices of size MxM +% a0 is usually the identity matrix I or must be invertible +% X should be of size MxN, if X has size NxM a warning +% is raised, and the output Y is also transposed. +% +% A simulated MV-AR process can be generiated with +% Y = mvfilter(eye(M), [eye(M),-AR],randn(M,N)); +% +% A multivariate inverse filter can be realized with +% [AR,RC,PE] = mvar(Y,P); +% E = mvfilter([eye(M),-AR],eye(M),Y); +% +% see also: MVAR, FILTER + +% $Id: mvfilter.m 6981 2010-03-02 23:38:34Z schloegl $ +% Copyright (C) 1996-2003 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +[ra, ca] = size(A); +[rb, cb] = size(B); +[M, N ] = size(x); + +if (ra~=rb), + fprintf(2,'ERROR MVFILTER: number of rows of A and B do not fit\n'); + return; +end; +if nargin<4, + z = []; %zeros(M,oo); +end; + +if (M~=ra), + if (N==ra), + fprintf(2,'Warning MVFILTER: dimensions fit only to transposed data. X has been transposed.\n'); + x = x.'; + %[x,z] = mvfilter(B,A,x,z); x = x.'; return; + else + fprintf(2,'ERROR MVFILTER: dimensions do not fit\n'); + return; + end; +end; + +p = ca/M-1; +q = cb/M-1; +oo = max(p,q); + +if isempty(z) + z = zeros(M,oo); +else + if any(size(z)~=[M,oo]) + fprintf('Error MVFILTER: size of z does not fit\n'); + [size(z),oo,M] + return; + end; +end; + +%%%%% normalization to A{1}=I; +if p<=q, + for k=1:p, + %A{k}=A{k}/A{1}; + A(:,k*M+(1:M)) = A(:,k*M+(1:M)) / A(:,1:M); + end; + A(:,1:M) = eye(M); +else + for k=0:q, + %B{k}=B{k}/A{1}; + B(:,k*M+(1:M)) = B(:,k*M+(1:M)) / A(:,1:M); + end; +end; + +for k = 1:N, + acc = B(:,1:M) * x(:,k) + z(:,1); % / A{1}; + z = [z(:,2:oo), zeros(M,1)]; + for l = 1:q, + z(:,l) = z(:,l) + B(:,l*M+(1:M)) * x(:,k); + end; + for l = 1:p, + z(:,l) = z(:,l) - A(:,l*M+(1:M)) * acc; + end; + x(:,k) = acc; +end; + diff --git a/octave_packages/tsa-4.2.4/mvfreqz.m b/octave_packages/tsa-4.2.4/mvfreqz.m new file mode 100644 index 0000000..53eaf14 --- /dev/null +++ b/octave_packages/tsa-4.2.4/mvfreqz.m @@ -0,0 +1,254 @@ +function [S,h,PDC,COH,DTF,DC,pCOH,dDTF,ffDTF, pCOH2, PDCF, coh,GGC,Af,GPDC,GGC2]=mvfreqz(B,A,C,N,Fs) +% MVFREQZ multivariate frequency response +% [S,h,PDC,COH,DTF,DC,pCOH,dDTF,ffDTF,pCOH2,PDCF,coh,GGC,Af,GPDC] = mvfreqz(B,A,C,f,Fs) +% [...] = mvfreqz(B,A,C,N,Fs) +% +% INPUT: +% ======= +% A, B multivariate polynomials defining the transfer function +% +% a0*Y(n) = b0*X(n) + b1*X(n-1) + ... + bq*X(n-q) +% - a1*Y(n-1) - ... - ap*Y(:,n-p) +% +% A=[a0,a1,a2,...,ap] and B=[b0,b1,b2,...,bq] must be matrices of +% size Mx((p+1)*M) and Mx((q+1)*M), respectively. +% +% C is the covariance of the input noise X (i.e. D'*D if D is the mixing matrix) +% N if scalar, N is the number of frequencies +% if N is a vector, N are the designated frequencies. +% Fs sampling rate [default 2*pi] +% +% A,B,C and D can by obtained from a multivariate time series +% through the following commands: +% [AR,RC,PE] = mvar(Y,P); +% M = size(AR,1); % number of channels +% A = [eye(M),-AR]; +% B = eye(M); +% C = PE(:,M*P+1:M*(P+1)); +% +% Fs sampling rate in [Hz] +% (N number of frequencies for computing the spectrum, this will become OBSOLETE), +% f vector of frequencies (in [Hz]) +% +% +% OUTPUT: +% ======= +% S power spectrum +% h transfer functions, abs(h.^2) is the non-normalized DTF [11] +% PDC partial directed coherence [2] +% DC directed coupling +% COH coherency (complex coherence) [5] +% DTF directed transfer function +% pCOH partial coherence +% dDTF direct Directed Transfer function +% ffDTF full frequency Directed Transfer Function +% pCOH2 partial coherence - alternative method +% GGC a modified version of Geweke's Granger Causality [Geweke 1982] +% !!! it uses a Multivariate AR model, and computes the bivariate GGC as in [Bressler et al 2007]. +% This is not the same as using bivariate AR models and GGC as in [Bressler et al 2007] +% Af Frequency transform of A(z), abs(Af.^2) is the non-normalized PDC [11] +% PDCF Partial Directed Coherence Factor [2] +% GPDC Generalized Partial Directed Coherence [9,10] +% +% see also: FREQZ, MVFILTER, MVAR +% +% REFERENCE(S): +% [1] H. Liang et al. Neurocomputing, 32-33, pp.891-896, 2000. +% [2] L.A. Baccala and K. Samashima, Biol. Cybern. 84,463-474, 2001. +% [3] A. Korzeniewska, et al. Journal of Neuroscience Methods, 125, 195-207, 2003. +% [4] Piotr J. Franaszczuk, Ph.D. and Gregory K. Bergey, M.D. +% Fast Algorithm for Computation of Partial Coherences From Vector Autoregressive Model Coefficients +% World Congress 2000, Chicago. +% [5] Nolte G, Bai O, Wheaton L, Mari Z, Vorbach S, Hallett M. +% Identifying true brain interaction from EEG data using the imaginary part of coherency. +% Clin Neurophysiol. 2004 Oct;115(10):2292-307. +% [6] Schlogl A., Supp G. +% Analyzing event-related EEG data with multivariate autoregressive parameters. +% (Eds.) C. Neuper and W. Klimesch, +% Progress in Brain Research: Event-related Dynamics of Brain Oscillations. +% Analysis of dynamics of brain oscillations: methodological advances. Elsevier. +% Progress in Brain Research 159, 2006, p. 135 - 147 +% [7] Bressler S.L., Richter C.G., Chen Y., Ding M. (2007) +% Cortical fuctional network organization from autoregressive modelling of loal field potential oscillations. +% Statistics in Medicine, doi: 10.1002/sim.2935 +% [8] Geweke J., 1982 +% J.Am.Stat.Assoc., 77, 304-313. +% [9] L.A. Baccala, D.Y. Takahashi, K. Sameshima. (2006) +% Generalized Partial Directed Coherence. +% Submitted to XVI Congresso Brasileiro de Automatica, Salvador, Bahia. +% [10] L.A. Baccala, D.Y. Takahashi, K. Sameshima. +% Computer Intensive Testing for the Influence Between Time Series, +% Eds. B. Schelter, M. Winterhalder, J. Timmer: +% Handbook of Time Series Analysis - Recent Theoretical Developments and Applications +% Wiley, p.413, 2006. +% [11] M. Eichler +% On the evaluation of informatino flow in multivariate systems by the directed transfer function +% Biol. Cybern. 94: 469-482, 2006. + +% $Id: mvfreqz.m 8141 2011-03-02 08:01:58Z schloegl $ +% Copyright (C) 1996-2008 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://hci.tugraz.at/schloegl/matlab/tsa/ +% http://octave.sourceforge.net/ +% http://biosig.sourceforge.net/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +[K1,K2] = size(A); +p = K2/K1-1; +%a=ones(1,p+1); +[K1,K2] = size(B); +q = K2/K1-1; +%b=ones(1,q+1); +if nargin<3 + C = eye(K1,K1); +end; +if nargin<5, + Fs= 1; +end; +if nargin<4, + N = 512; + f = (0:N-1)*(Fs/(2*N)); +end; +if all(size(N)==1), + fprintf(1,'Warning MVFREQZ: The forth input argument N is a scalar, this is ambigous.\n'); + fprintf(1,' In the past, N was used to indicate the number of spectral lines. This might change.\n'); + fprintf(1,' In future versions, it will indicate the spectral line.\n'); + f = (0:N-1)*(Fs/(2*N)); +else + f = N; +end; +N = length(f); +s = exp(i*2*pi*f/Fs); +z = i*2*pi/Fs; + +h=zeros(K1,K1,N); +Af=zeros(K1,K1,N); +g=zeros(K1,K1,N); +S=zeros(K1,K1,N); +S1=zeros(K1,K1,N); +DTF=zeros(K1,K1,N); +COH=zeros(K1,K1,N); +%COH2=zeros(K1,K1,N); +PDC=zeros(K1,K1,N); +%PDC3=zeros(K1,K1,N); +PDCF = zeros(K1,K1,N); +pCOH = zeros(K1,K1,N); +GGC=zeros(K1,K1,N); +GGC2=zeros(K1,K1,N); +invC=inv(C); +tmp1=zeros(1,K1); +tmp2=zeros(1,K1); + +M = zeros(K1,K1,N); +detG = zeros(N,1); + +%D = sqrtm(C); +%iD= inv(D); +ddc2 = diag(diag(C).^(-1/2)); +for n=1:N, + atmp = zeros(K1); + for k = 1:p+1, + atmp = atmp + A(:,k*K1+(1-K1:0))*exp(z*(k-1)*f(n)); + end; + + % compensation of instantaneous correlation + % atmp = iD*atmp*D; + + btmp = zeros(K1); + for k = 1:q+1, + btmp = btmp + B(:,k*K1+(1-K1:0))*exp(z*(k-1)*f(n)); + end; + h(:,:,n) = atmp\btmp; + Af(:,:,n) = atmp/btmp; + S(:,:,n) = h(:,:,n)*C*h(:,:,n)'/Fs; + S1(:,:,n) = h(:,:,n)*h(:,:,n)'; + ctmp = ddc2*atmp; %% used for GPDC + for k1 = 1:K1, + tmp = squeeze(atmp(:,k1)); + tmp1(k1) = sqrt(tmp'*tmp); + tmp2(k1) = sqrt(tmp'*invC*tmp); + + %tmp = squeeze(atmp(k1,:)'); + %tmp3(k1) = sqrt(tmp'*tmp); + + tmp = squeeze(ctmp(:,k1)); + tmp3(k1) = sqrt(tmp'*tmp); + end; + + PDCF(:,:,n) = abs(atmp)./tmp2(ones(1,K1),:); + PDC(:,:,n) = abs(atmp)./tmp1(ones(1,K1),:); + GPDC(:,:,n) = abs(ctmp)./tmp3(ones(1,K1),:); + %PDC3(:,:,n) = abs(atmp)./tmp3(:,ones(1,K1)); + + g = atmp/btmp; + G(:,:,n) = g'*invC*g; + detG(n) = det(G(:,:,n)); +end; + +if nargout<4, return; end; + +%%%%% directed transfer function +for k1=1:K1; + DEN=sum(abs(h(k1,:,:)).^2,2); + for k2=1:K2; + %COH2(k1,k2,:) = abs(S(k1,k2,:).^2)./(abs(S(k1,k1,:).*S(k2,k2,:))); + COH(k1,k2,:) = (S(k1,k2,:))./sqrt(abs(S(k1,k1,:).*S(k2,k2,:))); + coh(k1,k2,:) = (S1(k1,k2,:))./sqrt(abs(S1(k1,k1,:).*S1(k2,k2,:))); + %DTF(k1,k2,:) = sqrt(abs(h(k1,k2,:).^2))./DEN; + DTF(k1,k2,:) = abs(h(k1,k2,:))./sqrt(DEN); + ffDTF(k1,k2,:) = abs(h(k1,k2,:))./sqrt(sum(DEN,3)); + pCOH2(k1,k2,:) = abs(G(k1,k2,:).^2)./(G(k1,k1,:).*G(k2,k2,:)); + + %M(k2,k1,:) = ((-1)^(k1+k2))*squeeze(G(k1,k2,:))./detG; % oder ist M = G? + end; +end; + +dDTF = pCOH2.*ffDTF; + +if nargout<6, return; end; + +DC = zeros(K1); +for k = 1:p, + DC = DC + A(:,k*K1+(1:K1)).^2; +end; + + +if nargout<13, return; end; + +for k1=1:K1; + for k2=1:K2; + % Bivariate Granger Causality (similar to Bressler et al. 2007. ) + GGC(k1,k2,:) = ((C(k1,k1)*C(k2,k2)-C(k1,k2)^2)/C(k2,k2))*real(h(k1,k2,:).*conj(h(k1,k2,:)))./abs(S(k2,k2,:)); + %GGC2(k1,k2,:) = -log(1-((C(k1,k1)*C(k2,k2)-C(k1,k2)^2)/C(k2,k2))*real(h(k1,k2,:).*conj(h(k1,k2,:)))./S(k2,k2,:)); + end; +end; + +return; + +if nargout<7, return; end; + +for k1=1:K1; + for k2=1:K2; + M(k2,k1,:) = ((-1)^(k1+k2))*squeeze(G(k1,k2,:))./detG; % oder ist M = G? + end; +end; + + +for k1=1:K1; + for k2=1:K2; + pCOH(k1,k2,:) = abs(M(k1,k2,:).^2)./(M(k1,k1,:).*M(k2,k2,:)); + end; +end; + diff --git a/octave_packages/tsa-4.2.4/pacf.m b/octave_packages/tsa-4.2.4/pacf.m new file mode 100644 index 0000000..ca55964 --- /dev/null +++ b/octave_packages/tsa-4.2.4/pacf.m @@ -0,0 +1,69 @@ +function [PARCOR,sig,cil,ciu]= pacf(Z,KMAX); +% Partial Autocorrelation function +% [parcor,sig,cil,ciu] = pacf(Z,N); +% +% Input: +% Z Signal, each row is analysed +% N # of coefficients + +% Output: +% parcor autocorrelation function +% sig p-value for significance test +% cil lower confidence interval +% ciu upper confidence interval +% +% see also: DURLEV, LATTICE, AC2RC, AR2RC, +% FLAG_IMPLICIT_SIGNIFICANCE + +% $Id: pacf.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1997-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +[nr,nc] = size(Z); +if nc +Maintainer: Alois Schloegl +Title: The TSA-toolbox +Description: A toolbox for Time Series Analysis . +Depends: octave (> 2.9.0) +License: GPL version 3 or later +Url: http://pub.ist.ac.at/~schloegl/matlab/tsa +Autoload: no diff --git a/octave_packages/tsa-4.2.4/packinfo/INDEX b/octave_packages/tsa-4.2.4/packinfo/INDEX new file mode 100644 index 0000000..2b004de --- /dev/null +++ b/octave_packages/tsa-4.2.4/packinfo/INDEX @@ -0,0 +1,60 @@ +tsa >> Time Series Analysis +Univariate (stationary) analysis + acovf + acorf + biacovf + bispec + durlev + lattice + rmle + pacf + parcor + invest0 + invest1 + selmo + selmo2 + histo + histo2 + histo3 + hup + ucp + y2res + ar_spa + detrend + flix + +Multivariate stationary analysis + mvar + mvfilter + mvfreqz + arfit2 + histo4 + +Adaptive (time-varying) analysis + aar + aarmam + adim + amarma + mvaar + +Conversions between forms + ac2poly + ac2rc + ar2rc + rc2ar + poly2ac + poly2ar + poly2rc + rc2ac + rc2poly + ar2poly +Utility functions + arcext + sinvest1 + sbispec + flag_implicit_samplerate +Test suites + tsademo + bisdemo + invfdemo + diff --git a/octave_packages/tsa-4.2.4/parcor.m b/octave_packages/tsa-4.2.4/parcor.m new file mode 100644 index 0000000..7624657 --- /dev/null +++ b/octave_packages/tsa-4.2.4/parcor.m @@ -0,0 +1,49 @@ +function [PARCOR,ARP, PE] = parcor(AutoCov); +% estimates partial autocorrelation coefficients +% Multiple channels can be used (one per row). +% +% [PARCOR, AR, PE] = parcor(AutoCov); % calculates Partial autocorrelation, autoregressive coefficients and residual error variance from the Autocorrelation function. +% +% [PARCOR] = parcor(acovf(x,p)); % calculates the Partial Autocorrelation coefficients of the data series x up to order p +% +% INPUT: +% AutoCov Autocorrelation function for lag=0:P +% +% OUTPUT +% AR autoregressive model parameter +% PARCOR partial correlation coefficients (= -reflection coefficients) +% PE remaining error variance +% +% All input and output parameters are organized in rows, one row +% corresponds to the parameters of one channel. +% The PARCOR coefficients are the negative reflection coefficients. +% A significance test is implemented in PACF. +% +% see also: PACF ACOVF ACORF DURLEV AC2RC +% +% REFERENCES: +% P.J. Brockwell and R.A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. +% S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + + +% $Id: parcor.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1997-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +[ARP,PARCOR,PE] = durlev(AutoCov); +PARCOR=-PARCOR; diff --git a/octave_packages/tsa-4.2.4/poly2ac.m b/octave_packages/tsa-4.2.4/poly2ac.m new file mode 100644 index 0000000..dda6ce2 --- /dev/null +++ b/octave_packages/tsa-4.2.4/poly2ac.m @@ -0,0 +1,48 @@ +function ACF=poly2ac(a,efinal) +% converts an AR polynomial into an autocorrelation sequence +% [R] = poly2ac(a [,efinal] ); +% +% see also ACOVF ACORF AR2RC RC2AR DURLEV AC2POLY, POLY2RC, RC2POLY, RC2AC, AC2RC, POLY2AC +% + +% $Id: poly2ac.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +fprintf(2,'ERROR: POLY2AC does not work yet. Sorry\n'); +return; + +mfilename='POLY2AC'; +if ~exist('rc2ar','file') + fprintf(2,'Error %s: RC2AR.M not found. \n Download TSA toolbox from http://www.dpmi.tu-graz.ac.at/~schloegl/matlab/tsa/\n',mfilename); + return; +end; + +[AR,RC,PE] = ar2rc(poly2ar(a)); +%[AR,RC,PE,ACF] = rc2ar(RC); + +if nargin<2, efinal=PE(:,size(PE,2)); end; + +ACF=zeros(size(a)); +ACF(:,1) = 1; +for k=2:size(a,2), + ACF(:,k)=sum(AR(:,1:k-1).*ACF(:,k-(1:k-1)),2); +end; +R0=(sum(AR(:,1:k-1).*ACF(:,2:size(ACF,2)),2)+1).*efinal; %PE(:,size(PE,2)); + +ACF = ACF.*R0(:,ones(1,size(ACF,2))); + +%ACF=ACF*efinal*PE(1)/PE(length(PE)); diff --git a/octave_packages/tsa-4.2.4/poly2ar.m b/octave_packages/tsa-4.2.4/poly2ar.m new file mode 100644 index 0000000..a7a46b1 --- /dev/null +++ b/octave_packages/tsa-4.2.4/poly2ar.m @@ -0,0 +1,38 @@ +function [A] = poly2ar(A); +% Converts AR polymials into autoregressive parameters. +% Multiple polynomials can be converted. +% +% function [AR] = poly2ar(A); +% +% INPUT: +% A AR polynomial, each row represents one polynomial +% +% OUTPUT +% AR autoregressive model parameter +% +% see also ACOVF ACORF DURLEV RC2AR AR2POLY + +% $Id: poly2ar.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +% Inititialization +[lr,lc]=size(A); + +if ~all(A(:,1)==1) + fprintf(2,'Warning POLY2AR: input argument might not be an AR-polynom'); +end; + +A = -A(:,2:size(A,2))./A(:,ones(1,size(A,2)-1)); diff --git a/octave_packages/tsa-4.2.4/poly2rc.m b/octave_packages/tsa-4.2.4/poly2rc.m new file mode 100644 index 0000000..1f38e61 --- /dev/null +++ b/octave_packages/tsa-4.2.4/poly2rc.m @@ -0,0 +1,50 @@ +function [RC,r0] = poly2rc(a,efinal); +% converts AR-polynomial into reflection coefficients +% [RC,R0] = poly2rc(A [,Efinal]) +% +% INPUT: +% A AR polynomial, each row represents one polynomial +% Efinal is the final prediction error variance (default value 1) +% +% OUTPUT +% RC reflection coefficients +% R0 is the variance (autocovariance at lag=0) based on the +% prediction error +% +% +% see also ACOVF ACORF AR2RC RC2AR DURLEV AC2POLY, POLY2RC, RC2POLY, RC2AC, AC2RC, POLY2AC + +% $Id: poly2rc.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +if all(size(a))>1, + fprintf(2,'Error poly2rc: "a" must be a vector\n'); + return; +end; +a=a(:).'; + +mfilename='POLY2RC'; +if ~exist('ar2rc','file') + fprintf(2,'Error %s: AR2RC.M not found. \n Download TSA toolbox from http://www.dpmi.tu-graz.ac.at/~schloegl/matlab/tsa/\n',mfilename); + return; +end; + +if nargin<2, efinal=1; end; + +[AR,RC,PE] = ar2rc(poly2ar(a)); +if nargout>1, + r0=efinal.*PE(:,1)./PE(:,size(PE,2)); +end; diff --git a/octave_packages/tsa-4.2.4/rc2ac.m b/octave_packages/tsa-4.2.4/rc2ac.m new file mode 100644 index 0000000..9dbf185 --- /dev/null +++ b/octave_packages/tsa-4.2.4/rc2ac.m @@ -0,0 +1,46 @@ +function ACF=rc2ac(RC,R0) +% converts reflection coefficients to autocorrelation sequence +% [R] = rc2ac(RC,R0); +% +% see also ACOVF ACORF AR2RC RC2AR DURLEV AC2POLY, POLY2RC, RC2POLY, RC2AC, AC2RC, POLY2AC +% + +% $Id: rc2ac.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +fprintf(2,'ERROR: RC2AC does not work yet. Sorry\n'); +return; + +if all(size(RC)>1), + fprintf(2,'Error RC2AC: "K" must be a vector\n'); + return; +end; + +mfilename='RC2AC'; +if ~exist('rc2ar','file') + fprintf(2,'Error %s: RC2AR.M not found. \n Download TSA toolbox from http://www.dpmi.tu-graz.ac.at/~schloegl/matlab/tsa/\n',mfilename); + return; +end; + +[AR,RC,PE] = rc2ar(RC(:).'); + +ACF=cumprod(ones(size(RC))-RC.^2,2); +ACF = ACF./ACF(:,ones(1,size(ACF,2))); + +if nargin>1 + ACF=ACF*R0; +end; diff --git a/octave_packages/tsa-4.2.4/rc2ar.m b/octave_packages/tsa-4.2.4/rc2ar.m new file mode 100644 index 0000000..a90594b --- /dev/null +++ b/octave_packages/tsa-4.2.4/rc2ar.m @@ -0,0 +1,91 @@ +function [MX,res,arg3,acf] = rc2ar(rc); +% converts reflection coefficients into autoregressive parameters +% uses the Durbin-Levinson recursion for multiple channels +% function [AR,RC,PE,ACF] = rc2ar(RC); +% function [MX,PE] = rc2ar(RC); +% +% INPUT: +% RC reflection coefficients +% +% OUTPUT +% AR autoregressive model parameter +% RC reflection coefficients (= -PARCOR coefficients) +% PE remaining error variance (relative to PE(1)=1) +% MX transformation matrix between ARP and RC (Attention: needs O(p^2) memory) +% arp=MX(:,K*(K-1)/2+(1:K)); +% rc =MX(:,(1:K).*(2:K+1)/2); +% +% All input and output parameters are organized in rows, one row +% corresponds to the parameters of one channel +% +% see also ACOVF ACORF DURLEV AR2RC +% +% REFERENCES: +% P.J. Brockwell and R. A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. +% S. Haykin "Adaptive Filter Theory" 3rd ed. Prentice Hall, 1996. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. + +% $Id: rc2ar.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (c) 1996-2002,2007,2008 by Alois Schloegl +% This function is part of the TSA-toolbox +% http://www.dpmi.tu-graz.ac.at/~schloegl/matlab/tsa/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +% Inititialization +[lr,lc]=size(rc); +res=[ones(lr,1) zeros(lr,lc)]; +if nargout<3 % needs O(p^2) memory + MX=zeros(lr,lc*(lc+1)/2); + idx=0; + + % Durbin-Levinson Algorithm + for K=1:lc, + MX(:,idx+K)=rc(:,K);%(AutoCov(:,K+1)-d)./res(:,K); + %rc(:,K)=arp(:,K); + if K>1 %for compatibility with OCTAVE 2.0.13 + MX(:,idx+(1:K-1))=MX(:,(K-2)*(K-1)/2+(1:K-1))-MX(:,(idx+K)*ones(K-1,1)).*MX(:,(K-2)*(K-1)/2+(K-1:-1:1)); + end; + res(:,K+1) = res(:,K).*(1-abs(MX(:,idx+K)).^2); + idx=idx+K; + end; + %arp=MX(:,K*(K-1)/2+(1:K)); + %rc =MX(:,(1:K).*(2:K+1)/2); + ACF=cumprod(ones(lr,lr)-rc.^2,2); + +else % needs O(p) memory + ar=zeros(lr,lc); + acf=[ones(lr,1),zeros(lr,lc)]; + %rc=RC; %zeros(lr,lc-1); + + % Durbin-Levinson Algorithm + for K=1:lc, + acf(:,K) = -sum(acf(:,K:-1:1).*ar(:,1:K),2); + ar(:,K) = rc(:,K); + if K>1, %for compatibility with OCTAVE 2.0.13 + ar(:,1:K-1) = ar(:,1:K-1) - ar(:,K*ones(K-1,1)) .* ar(:,K-1:-1:1); + end; + res(:,K+1) = res(:,K) .* (1-abs(ar(:,K)).^2); + end; + + ACF=cumprod(ones(lr,lc)-rc.^2,2); + + % assign output arguments + arg3=res; + res=rc; + MX=ar; +end; %if + diff --git a/octave_packages/tsa-4.2.4/rc2poly.m b/octave_packages/tsa-4.2.4/rc2poly.m new file mode 100644 index 0000000..75a2b42 --- /dev/null +++ b/octave_packages/tsa-4.2.4/rc2poly.m @@ -0,0 +1,48 @@ +function [a,efinal] = rc2poly(RC,E); +% converts reflection coefficients into an AR-polynomial +% [a,efinal] = rc2poly(K) +% +% see also ACOVF ACORF AR2RC RC2AR DURLEV AC2POLY, POLY2RC, RC2POLY, RC2AC, AC2RC, POLY2AC +% + +% $Id: rc2poly.m 9609 2012-02-10 10:18:00Z schloegl $ +% Copyright (C) 1998-2002,2008,2012 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://pub.ist.ac.at/~schloegl/matlab/tsa/ +% http://octave.sourceforge.net/ +% http://biosig.sourceforge.net/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +if nargout>1 && nargin<2 + fprintf('Zero-lag autocorrelation, R0 not specified\n') + return; +end; + +mfilename='RC2POLY'; +if all(size(RC))>1, + fprintf(2,'Error %s: "K" must be a vector\n',mfilename); + return; +end; + +if ~exist('rc2ar','file') + fprintf(2,'Error %s: RC2AR.M not found. \n Download TSA toolbox from http://www.dpmi.tu-graz.ac.at/~schloegl/matlab/tsa/\n',mfilename); + return; +end; + +[AR,RC,PE] = rc2ar(RC(:).'); + +a=[1,-AR]; +efinal=PE(length(PE))/PE(1); diff --git a/octave_packages/tsa-4.2.4/rmle.m b/octave_packages/tsa-4.2.4/rmle.m new file mode 100644 index 0000000..92cfcd9 --- /dev/null +++ b/octave_packages/tsa-4.2.4/rmle.m @@ -0,0 +1,99 @@ +function [a,VAR,S,a_aux,b_aux,e_aux,MLE,pos] = rmle(arg1,arg2); +% RMLE estimates AR Parameters using the Recursive Maximum Likelihood +% Estimator according to [1] +% +% Use: [a,VAR]=rmle(x,p) + % Input: + % x is a column vector of data + % p is the model order + % Output: + % a is a vector with the AR parameters of the recursive MLE + % VAR is the excitation white noise variance estimate +% +% Reference(s): +% [1] Kay S.M., Modern Spectral Analysis - Theory and Applications. +% Prentice Hall, p. 232-233, 1988. +% + +% $Id: rmle.m 9609 2012-02-10 10:18:00Z schloegl $ +% Copyright (C) 2004 by Jose Luis Gutierrez +% Grupo GENESIS - UTN - Argentina +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +x=arg1*1e-6; +p=arg2; + +N=length(x); +S=zeros(p+1,p+1); +a_aux=zeros(p+1,p);, a_aux(1,:)=1; +b_aux=ones(p+1,p); +e_aux=zeros(p,1);, p_aux=zeros(p,1); +MLE=zeros(3,1); +pos=1; + +for i=0:p + for j=0:p + for n=0:N-1-i-j + S(i+1,j+1)=S(i+1,j+1)+x(n+1+i)*x(n+1+j); + end + end +end + +e0=S(1,1); +c1=S(1,2); +d1=S(2,2); +coef3=1; +coef2=((N-2)*c1)/((N-1)*d1); +coef1=-(e0+N*d1)/((N-1)*d1); +ti=-(N*c1)/((N-1)*d1); +raices=roots([coef3 coef2 coef1 ti]); +for o=1:3 + if raices(o)>-1 && raices(o)<1 + a_aux(2,1)=raices(o); + b_aux(p+1,1)=raices(o); + end +end +e_aux(1,1)=S(1,1)+2*a_aux(2,1)*S(1,2)+(a_aux(2,1)^2)*S(2,2); +p_aux(1,1)=e_aux(1,1)/N; + +for k=2:p + Ck=S(1:k,2:k+1); + Dk=S(2:k+1,2:k+1); + ck=a_aux(1:k,k-1)'*Ck*b_aux(p+1:-1:p+2-k,k-1); + dk=b_aux(p+1:-1:p+2-k,k-1)'*Dk*b_aux(p+1:-1:p+2-k,k-1); + coef3re=1; + coef2re=((N-2*k)*ck)/((N-k)*dk); + coef1re=-(k*e_aux(k-1,1)+N*dk)/((N-k)*dk); + tire=-(N*ck)/((N-k)*dk); + raices=roots([coef3re coef2re coef1re tire]); + for o=1:3 + if raices(o,1)>-1 && raices(o,1)<1 + MLE(o,1)=((1-raices(o)^2)^(k/2))/(((e_aux(k-1)+2*ck*raices(o)+dk*(raices(o)^2))/N)^(N/2)); + end + end + [C,I]=max(MLE); + k_max=raices(I); + for i=1:k-1 + a_aux(i+1,k)=a_aux(i+1,k-1)+k_max*a_aux(k-i+1,k-1); + end + a_aux(k+1,k)=k_max; + b_aux(p+1-k:p+1,k)=a_aux(1:k+1,k); + e_aux(k,1)=e_aux(k-1,1)+2*ck*k_max+dk*k_max^2; + p_aux(k,1)=e_aux(k,1)/N; +end + +a=a_aux(:,p)'; +VAR=p_aux(p)*1e12; diff --git a/octave_packages/tsa-4.2.4/sbispec.m b/octave_packages/tsa-4.2.4/sbispec.m new file mode 100644 index 0000000..2576e59 --- /dev/null +++ b/octave_packages/tsa-4.2.4/sbispec.m @@ -0,0 +1,35 @@ +function sbispec(BISPEC) +% SBISPEC show BISPECTRUM + +% $Id: sbispec.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1997, 1998, 2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +[s1,s2]=size(BISPEC); +t1=(0:s1-1)/max(s1); +t2=(0:s2/2-1)/max(s2); +tmp=tril(NaN*ones(s1,s2),-1); +BISPEC=BISPEC+tmp+rot90(tmp); +BISPEC=BISPEC(1:s1/2,:); + +subplot(211); +mesh(t1,t2,abs(BISPEC)); +title('Bispectrum - mesh plot'); + +subplot(212); +contour(t1,t2,abs(BISPEC)); +%contour(t1,t2,log(abs(BISPEC))); +title('Bispectrum - contour plot'); diff --git a/octave_packages/tsa-4.2.4/selmo.m b/octave_packages/tsa-4.2.4/selmo.m new file mode 100644 index 0000000..2850d4e --- /dev/null +++ b/octave_packages/tsa-4.2.4/selmo.m @@ -0,0 +1,146 @@ +function [FPE,AIC,BIC,SBC,MDL,CATcrit,PHI,optFPE,optAIC,optBIC,optSBC,optMDL,optCAT,optPHI,p,C]=selmo(e,NC); +% Model order selection of an autoregrssive model +% [FPE,AIC,BIC,SBC,MDL,CAT,PHI,optFPE,optAIC,optBIC,optSBC,optMDL,optCAT,optPHI]=selmo(E,N); +% +% E Error function E(p) +% N length of the data set, that was used for calculating E(p) +% show optional; if given the parameters are shown +% +% FPE Final Prediction Error (Kay 1987, Wei 1990, Priestley 1981 -> Akaike 1969) +% AIC Akaike Information Criterion (Marple 1987, Wei 1990, Priestley 1981 -> Akaike 1974) +% BIC Bayesian Akaike Information Criterion (Wei 1990, Priestley 1981 -> Akaike 1978,1979) +% CAT Parzen's CAT Criterion (Wei 1994 -> Parzen 1974) +% MDL Minimal Description length Criterion (Marple 1987 -> Rissanen 1978,83) +% SBC Schwartz's Bayesian Criterion (Wei 1994; Schwartz 1978) +% PHI Phi criterion (Pukkila et al. 1988, Hannan 1980 -> Hannan & Quinn, 1979) +% HAR Haring G. (1975) +% JEW Jenkins and Watts (1968) +% +% optFPE order where FPE is minimal +% optAIC order where AIC is minimal +% optBIC order where BIC is minimal +% optSBC order where SBC is minimal +% optMDL order where MDL is minimal +% optCAT order where CAT is minimal +% optPHI order where PHI is minimal +% +% usually is +% AIC > FPE > *MDL* > PHI > SBC > CAT ~ BIC +% +% REFERENCES: +% P.J. Brockwell and R.A. Davis "Time Series: Theory and Methods", 2nd ed. Springer, 1991. +% S. Haykin "Adaptive Filter Theory" 3ed. Prentice Hall, 1996. +% M.B. Priestley "Spectral Analysis and Time Series" Academic Press, 1981. +% C.E. Shannon and W. Weaver "The mathematical theory of communication" University of Illinois Press, Urbana 1949 (reprint 1963). +% W.S. Wei "Time Series Analysis" Addison Wesley, 1990. +% Jenkins G.M. Watts D.G "Spectral Analysis and its applications", Holden-Day, 1968. +% G. Haring "Über die Wahl der optimalen Modellordnung bei der Darstellung von stationären Zeitreihen mittels Autoregressivmodell als Basis der Analyse von EEG - Biosignalen mit Hilfe eines Digitalrechners", Habilitationschrift - Technische Universität Graz, Austria, 1975. +% (1)"About selecting the optimal model at the representation of stationary time series by means of an autoregressive model as basis of the analysis of EEG - biosignals by means of a digital computer)" +% + +% $Id: selmo.m 9609 2012-02-10 10:18:00Z schloegl $ +% Copyright (C) 1997-2002,2008,2012 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://pub.ist.ac.at/~schloegl/matlab/tsa/ +% http://octave.sourceforge.net/ +% http://biosig.sourceforge.net/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +[lr,lc]=size(e); +if (lr>1) && (lc>1), + p=zeros(lr+1,9)+NaN; +else + p=zeros(1,9)+NaN; +end; + +if nargin<2 + NC=lc*ones(lr,1); + NC=(lc-sum(isnan(e)')')*(NC=lc); % first part +%end;% Pmax=min([100 N/3]); end; + %if NC=lc); % first part +else + % NC=NC; +end; + +M=lc-1; +m=0:M; + +e = e./e(:,ones(1,lc)); + +for k=0:lr, + if k>0, % + E=e(k,:); + N=NC(k); + elseif lr>1 + tmp = e;%(NC>0,:); + tmp(isnan(tmp)) = 0; + E = sum(tmp.*(NC*ones(1,lc)))/sum(NC); % weighted average, weigths correspond to number of valid (not missing) values + N = sum(NC)./sum(NC>0); % corresponding number of values, + else + E = e; + N = NC; + end; +FPE = E.*(N+m)./(N-m); %OK + optFPE=find(FPE==min(FPE))-1; %optimal order + if isempty(optFPE), optFPE=NaN; end; +AIC = N*log(E)+2*m; %OK + optAIC=find(AIC==min(AIC))-1; %optimal order + if isempty(optAIC), optAIC=NaN; end; +AIC4=N*log(E)+4*m; %OK + optAIC4=find(AIC4==min(AIC4))-1; %optimal order + if isempty(optAIC4), optAIC4=NaN; end; + +m=1:M; +BIC=[ N*log(E(1)) N*log(E(m+1)) - (N-m).*log(1-m/N) + m*log(N) + m.*log(((E(1)./E(m+1))-1)./m)]; +%BIC=[ N*log(E(1)) N*log(E(m+1)) - m + m*log(N) + m.*log(((E(1)./E(m+1))-1)./m)]; +%m=0:M; BIC=N*log(E)+m*log(N); % Hannan, 1980 -> Akaike, 1977 and Rissanen 1978 + optBIC=find(BIC==min(BIC))-1; %optimal order + if isempty(optBIC), optBIC=NaN; end; + +HAR(2:lc)=-(N-m).*log((N-m).*E(m+1)./(N-m+1)./E(m)); + HAR(1)=HAR(2); + optHAR=min(find(HAR<=(min(HAR)+0.2)))-1; %optimal order +% optHAR=find(HAR==min(HAR))-1; %optimal order + if isempty(optHAR), optHAR=NaN; end; + +m=0:M; +SBC = N*log(E)+m*log(N); + optSBC=find(SBC==min(SBC))-1; %optimal order + if isempty(optSBC), optSBC=NaN; end; +MDL = N*log(E)+log(N)*m; + optMDL=find(MDL==min(MDL))-1; %optimal order + if isempty(optMDL), optMDL=NaN; end; + +m=0:M; +%CATcrit= (cumsum(1./E(m+1))/N-1./E(m+1)); +E1=N*E./(N-m); +CATcrit= (cumsum(1./E1(m+1))/N-1./E1(m+1)); + optCAT=find(CATcrit==min(CATcrit))-1; %optimal order + if isempty(optCAT), optCAT=NaN; end; + +PHI = N*log(E)+2*log(log(N))*m; + optPHI=find(PHI==min(PHI))-1; %optimal order + if isempty(optPHI), optPHI=NaN; end; + +JEW = E.*(N-m)./(N-2*m-1); % Jenkins-Watt + optJEW=find(JEW==min(JEW))-1; %optimal order + if isempty(optJEW), optJEW=NaN; end; + +% in case more than 1 minimum is found, the smaller model order is returned; +p(k+1,:) = [optFPE(1), optAIC(1), optBIC(1), optSBC(1), optCAT(1), optMDL(1), optPHI(1), optJEW(1), optHAR(1)]; + +end; +C=[FPE;AIC;BIC;SBC;MDL;CATcrit;PHI;JEW;HAR(:)']'; diff --git a/octave_packages/tsa-4.2.4/selmo2.m b/octave_packages/tsa-4.2.4/selmo2.m new file mode 100644 index 0000000..4214f83 --- /dev/null +++ b/octave_packages/tsa-4.2.4/selmo2.m @@ -0,0 +1,77 @@ +function X = selmo2(y,Pmax); +% SELMO2 - model order selection for univariate and multivariate +% autoregressive models +% +% X = selmo(y,Pmax); +% +% y data series +% Pmax maximum model order +% X.A, X.B, X.C parameters of AR model +% X.OPT... various optimization criteria +% +% see also: SELMO, MVAR, + +% $Id: selmo2.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 2007 by Alois Schloegl +% This is part of the TSA-toolbox. See also +% http://hci.tugraz.at/schloegl/matlab/tsa/ +% http://octave.sourceforge.net/ +% http://biosig.sourceforge.net/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +[M,N]=size(y); +if M>N, + y=y'; +end; +[M,N]=size(y); + +% Univariate AR +[AutoCov, AutoCorr, ARPMX, E, NC] = invest0(y,Pmax); +[FPE,AIC,BIC,SBC,MDL,CATcrit,PHI,optFPE,optAIC,optBIC,optSBC,optMDL,optCAT,optPHI,s,C] = selmo(E,NC); + + +% AIC for MVAR model +[AR,RC,PE] = mvar(y',Pmax); +E2 = repmat(NaN,1,Pmax); +for k = 0:Pmax, + S = PE(:,k*M+(1:M)); + E2(k+1) = trace(S); + + %%%% FIX ME %%%%% this does not seem right because it depends on the scaling of y + AIC_MV(k+1) = 2*log(det(S))+2*k*M*M/N; % Ding et al. 2000 refering to Akaike 1974 +end; + + +X.A = [eye(M),-AR]; +X.B = eye(M); +X.C = S; +X.datatype = 'MVAR'; +X.MV.AIC = AIC_MV; +X.UV.FPE = FPE; +X.UV.AIC = AIC; +X.UV.BIC = BIC; +X.UV.MDL = MDL; +X.UV.CAT = CATcrit; +X.UV.PHI = PHI; + +X.OPT.FPE = optFPE; +X.OPT.AIC = optAIC; +X.OPT.BIC = optBIC; +X.OPT.MDL = optMDL; +X.OPT.CAT = optCAT; +X.OPT.PHI = optPHI; + +[tmp,X.OPT.MVAIC] = min(AIC_MV); diff --git a/octave_packages/tsa-4.2.4/sinvest1.m b/octave_packages/tsa-4.2.4/sinvest1.m new file mode 100644 index 0000000..9b5a049 --- /dev/null +++ b/octave_packages/tsa-4.2.4/sinvest1.m @@ -0,0 +1,289 @@ +%SINVEST1 shows the parameters of a time series calculated by INVEST1 +% only called by INVEST1 + +% $Id: sinvest1.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +Fs=flag_implicit_samplerate; +M=size(AutoCorr,2); +oo=M-1; +while 1, + K=menu('Select','Autocovariance ACOVF','Autocorrelation ACF', ... + 'Partial ACF PACF','Coeff. of Determination R²', ... + 'Error curve',... + 'Autoregressive Parameters',... + 'Information Criteria', ... + 'Matched Filter', ... + 'Log PSD and Phase', ... + 'Poles', ... + 'Inverse Filtering', ... + 'Spectra H(f,p)', ... + 'Entropy H=ln(det(R))', ... + 'Histogram of MOPS', ... + 'end'); + subplot(111); + if K==1 + plot(0:M,AutoCov); + title('Autocovariance function ACOVF(k)'); + xlabel('Lag k'); + elseif K==2 + if exist('OCTAVE_VERSION')==5 %%%%% Fuer OCTAVE + plot(1:M,AutoCorr); + elseif strcmp(version,'MIDEVA') %%%%% fuer MatCom + plot(1:M,AutoCorr); + else %%%%% fuer Matlab + % size(AutoCorr),size(ACFsd)] + % errorbar(ones(nr,1)*(1:M),AutoCorr,ACFsd,ACFsd); + % errorbar(1:M,AutoCorr,AutoCorr-ACFsd,AutoCorr+ACFsd); + plot(1:M,AutoCorr,'b',[1,M],[-1,1;-1,1]/sqrt(min(NC)),'b:'); + if exist('OCTAVE_VERSION')<5 + legend({'ACF','1/sqrt(N)'}) + end; + end; + title('Autocorrelation function ACF(k)'); + xlabel('Lag k'); + + elseif K==3 + %rc=ARPMX(:,(1:M).*(2:M+1)/2); + %plot(1:M,PartACF); + if size(ARPMX,2)==2*Pmax, + RC=ARPMX(:,Pmax+1:2*Pmax); + else + RC=ARPMX(:,(1:M).*(2:M+1)/2); + end; + % according to http://www.itl.nist.gov/div898/handbook/pmc/section4/pmc4463.htm + % is the 95% confidence interval 2/sqrt(N) + %plot(1:M,RC,'b',[1,M],[3,3;2,2;1,1;-1,-1;-2,-2;-3,-3]*(1/sqrt(min(NC))),'b:'); + %legend({'Part. ACF','1/sqrt(N)','2/sqrt(N) = 95% confidence interval','3/sqrt(N)'}) + plot(1:M,RC,'b',[1,M],[2,2;-2,-2]'*(1/sqrt(min(NC))),'b:'); + if exist('OCTAVE_VERSION')<5 + legend({'Part. ACF','2/sqrt(N) = 95% confidence interval'}) + end; + title('Partial Autocorrelation function PACF(k)'); + xlabel('Lag k'); + elseif K==4 + plot(0:M,(E(1)-E)/E(1)); + title('Determination of Regression R²=1-var{E}/var{Y}'); + xlabel('Model order p'); + elseif K==5 + plot(0:M,E,'r'); + if exist('OCTAVE_VERSION')<5 + v=axis; v(3)=min([v(3); 0]); axis(v); + end + title('Mean Square (prediction) Error decrease with increasing model order'); + xlabel('Model order p'); + elseif K==6 + plot(1:oo,ARPMX(:,oo/2*(oo-1)+(1:oo))','o-'); + title( ['AutoRegressive Parameters with model order' int2str(oo)]) + elseif K==7 + while 1 + K=menu('Select Criterion',... + 'Final Predection Error FPE', ... + 'Akaike Information Criterion AIC', ... + 'Bayesian Akaike Information Criterion BIC', ... + 'Schwartz''s Bayesian Crit. SBC (=MDL)', ... + 'Parzen''s CAT Criterion ', ... + 'PHI Criterion', ... + 'end'); + + if K==1 + tmp=min(2*optFPE+2,M); + oo=optFPE; + plot(0:tmp-1,FPE(1:tmp),'r',optFPE,FPE(optFPE+1),'ro'); + if exist('OCTAVE_VERSION')<5 + text(optFPE,FPE(optFPE+1),sprintf('%i',optFPE)); + v=axis; v(3)=min([v(3); 0]); axis(v); + end; + title('Final Prediction Error FPE criterion'); + elseif K==2 + tmp=min(2*optAIC+2,M); + oo=optAIC; + plot(0:tmp-1,AIC(1:tmp),'r',optAIC,AIC(optAIC+1),'ro'); + if exist('OCTAVE_VERSION')<5 + text(optAIC,AIC(optAIC+1),sprintf('%i',optAIC)); + v=axis; v(3)=min([v(3); 0]); axis(v); + end; + title('Akaike''s Information Criterion AIC'); + elseif K==3 + tmp=min(2*optBIC+2,M); + oo=optBIC; + plot(0:tmp-1,BIC(1:tmp),'r',optBIC,BIC(optBIC+1),'ro'); + if exist('OCTAVE_VERSION')<5 + text(optBIC,BIC(optBIC+1),sprintf('%i',optBIC)); + v=axis; v(3)=min([v(3); 0]); axis(v); + end; + title('Bayesian Akaike Information Criterion BIC'); + elseif K==4 + tmp=min(2*optSBC+2,M); + oo=optSBC; + plot(0:tmp-1,SBC(1:tmp),'r',optSBC,SBC(optSBC+1),'ro'); + if exist('OCTAVE_VERSION')<5 + text(optSBC,SBC(optSBC+1),sprintf('%i',optSBC)); + v=axis; v(3)=min([v(3); 0]); axis(v); + end; + title('Schwartz''s Bayesian Criterion SBC'); + %elseif K==5 + % tmp=min(2*optMDL,M); + % oo=optMDL; + % plot(0:tmp-1,MDL(1:tmp),'r',optMDL,MDL(optMDL+1),'ro'); + % v=axis; v(3)=min([v(3); 0]); axis(v); + % text(optMDL,MDL(optMDL+1),sprintf('%i',optMDL)) + % title('Minimal Description length Criterion MDL'); + elseif K==5 + tmp=min(2*optCAT+2,M); + oo=optCAT; + plot(0:tmp-1,CATcrit(1:tmp),'r',optCAT,CATcrit(optCAT+1),'ro'); + if exist('OCTAVE_VERSION')<5 + text(optCAT,CATcrit(optCAT+1),sprintf('%i',optCAT)); + v=axis; v(3)=min([v(3); 0]); axis(v); + end; + title('Parzen''s CAT Criterion '); + elseif K==6 + tmp=min(2*optPHI+2,M); + oo=optPHI; + plot(0:tmp-1,PHI(1:tmp),'r',optPHI,PHI(optPHI+1),'ro'); + if exist('OCTAVE_VERSION')<5 + text(optPHI,PHI(optPHI+1),sprintf('%i',optPHI)); + v=axis; v(3)=min([v(3); 0]); axis(v); + end; + title('Phi criterion '); + elseif K==7 + %[ARP,rc,res] =durlev(sum(AutoCov(:,1:(oo+1)),1)); + ARP=ARPMX(:,oo/2*(oo-1)+(1:oo)); + break; + end; %IF + end; %WHILE + elseif K==8 + % if model order p is given then the filter parameters A are + % A=[1; -earpyw(signal,p)] + % inverse filtering is invfiltsignal=filter(A,1,signal); + + h=zeros(nr,512)'; + w=zeros(nr,512)'; + for k=1:nr, + tmp=freqz(sqrt(E(k,oo+1)),[1 -ARPMX(k,oo/2*(oo-1)+(1:oo))],512); + h(:,k)=tmp(:); + end + + plot((0:511)/512/2*Fs,abs(h)); + %plot((0:511)/512/2,abs(freqz(1,[1 -ARP]'))); + title('Matched Filter'); + xlabel('Frequency f'); + ylabel('|H(f)|'); + elseif K==9 + h=zeros(nr,512)'; + w=zeros(nr,512)'; + for k=1:nr, + tmp=freqz(sqrt(E(k,oo+1)),[1 -ARPMX(k,oo/2*(oo-1)+(1:oo))],512); + h(:,k)=tmp(:); + end; + subplot(211); + semilogy((0:511)/512/2*Fs,abs(h')) + %semilogy((0:511)/512/2,abs(freqz(1,[1 -ARP]'))) + title('Logarithmic Spectral Density Fct.'); + subplot(212); + plot((0:511)/512/2*Fs,angle(h)'); + %plot((0:511)/512/2,angle(freqz(1,[1 -ARP]'))); + ylabel('rad'); + elseif K==10 + % clf; + %r = roots([1 -ARP]); + r = roots([1 -ARPMX(:,oo/2*(oo-1)+(1:oo))]); + t = 0:1/70:2*pi; + plot(cos(t), sin(t), 'b:',real(r), imag(r), 'rx'); + + % zplane([],[1 -ARPmx(oo+1,1:oo)]); + title('Pole Diagram'); + xlabel('real(z)'); + ylabel('imag(z)'); + + MATLAB_VERSION = version; + if MATLAB_VERSION(1)=='4' + ax = gca; + tmp = get(ax,'Aspect'); + set(ax,'Aspect',[tmp(1),1]); + elseif MATLAB_VERSION(1)=='5' + ax = gca; + tmp = get(ax,'DataAspectRatio'); + set(ax,'PlotBoxAspectRatio',tmp); + end; + elseif K==11 + plot([Y(:) filter([1 -ARPMX(:,oo/2*(oo-1)+(1:oo))],1,Y(:))-max(Y)+min(Y)]); + elseif K==12 + %[tmp,ARPmx,PE]= acf2pacf(AutoCov(2:length(AutoCov))/AutoCov(1),AutoCov(1)); + %[arp,rc,PE,ARPMX] = durlev(AutoCov); + %[tmp,ARPmx]=arp2pacf(AR); + N = Pmax-1; %2*oo-1; %2^(ceil(log(oo)/log(2))); + sdf = zeros(512,N); %length(AR)); + for k = 1:N; %[k,size(sdf),N],%length(AR); + % [sdf(:,k),F] = freqz(1,[1 -ARPmx(k,1:k)],N); + [tmp,F] = freqz(1,[1 -ARPMX(1,k/2*(k+1)+(1:k))]',512); + sdf(:,k)=tmp(:); + % sdf(:,k)=sqrt(E(k+1))*sdf(:,k); + end; + mesh(F/2/pi*Fs,1:N,log10(abs(sdf)')); + zlabel('log10 |H(f,p)|');ylabel('model order p'); xlabel('frequency f [2*pi rad/s]'); + if exist('OCTAVE_VERSION')<5 + view(30,45); + end; + elseif K==13 + for k=1:M, + xxx=eig(toeplitz(AutoCov(1:k)/E(k))); + H(k) = .5*sum(log(xxx)); + H1(k)= H(k)/(k); + %xxx1=eig(toeplitz(AutoCov(1:k)/E(k)*E(1))); + %xxx1=eig(toeplitz(AutoCorr(1:k))); + %H2(k) =.5*sum(log(xxx1)); + %H3(k)=.5*sum(log(xxx1))/(k); + %if any(xxx<=0) fprintf(1,'COV positive definite for p up to %i\n',k-1); break; end; + end; + if 0 + subplot(211); + plot(0:k-1,H2'); + title('Entropy H(k) depending on number of coefficients') + subplot(212); + plot(0:k-1,H3'); + title('Entropy rate H(k) depending on number of coefficients') + else + subplot(311); + plot(0:k-1,H'); + title('Entropy H(k) depending on number of coefficients') + subplot(312); + xxx=(-diff(log(E(:))))/2; %[size(xxx)size(H) M k] + plot(0:k-1,H1','b',1:k,xxx(1:k),'g'); + %plot(0:k-1,H1','b',0:k-1,log(E(1:k))-log(E(1)),'b',1:k,xxx(1:k),'g'); + %plot(0:k-1,H1','b',1:k,xxx,'g',1:k-1,cumprod(1+xxx(1:M-1))./H(2:M)','r'); + title('Entropy rate H(k) and Entropy difference H(k)-H(k+1)') + subplot(313); + plot(1:k,log(xxx(1:k)),'g'); + title('LOG Entropy difference for p->p+1: H(k)-H(k+1)') + end; + elseif K==14, + tmp = histo3(MOPS(1:max(1,size(MOPS,1)-1),:)); + if exist('OCTAVE_VERSION')<5, + bar(tmp.X,tmp.H,'stacked'); + else + bar(tmp.X,sum(tmp.H,2)); + end; + xlabel('model order p') + if exist('OCTAVE_VERSION')<5 + %legend({'FPE','AIC','BIC','SBC','MDL','CAT','PHI','JEW','HAR'}); + legend('FPE','AIC','BIC','SBC','MDL','CAT','PHI','JEW','HAR'); + end; + elseif K==15 + break; + end; +end; diff --git a/octave_packages/tsa-4.2.4/sumskipnan.m b/octave_packages/tsa-4.2.4/sumskipnan.m new file mode 100644 index 0000000..6103269 --- /dev/null +++ b/octave_packages/tsa-4.2.4/sumskipnan.m @@ -0,0 +1,193 @@ +function [o,count,SSQ] = sumskipnan(x, DIM, W) +% SUMSKIPNAN adds all non-NaN values. +% +% All NaN's are skipped; NaN's are considered as missing values. +% SUMSKIPNAN of NaN's only gives O; and the number of valid elements is return. +% SUMSKIPNAN is also the elementary function for calculating +% various statistics (e.g. MEAN, STD, VAR, RMS, MEANSQ, SKEWNESS, +% KURTOSIS, MOMENT, STATISTIC etc.) from data with missing values. +% SUMSKIPNAN implements the DIMENSION-argument for data with missing values. +% Also the second output argument return the number of valid elements (not NaNs) +% +% Y = sumskipnan(x [,DIM]) +% [Y,N,SSQ] = sumskipnan(x [,DIM]) +% [...] = sumskipnan(x, DIM, W) +% +% x input data +% DIM dimension (default: []) +% empty DIM sets DIM to first non singleton dimension +% W weight vector for weighted sum, numel(W) must fit size(x,DIM) +% Y resulting sum +% N number of valid (not missing) elements +% SSQ sum of squares +% +% the function FLAG_NANS_OCCURED() returns whether any value in x +% is a not-a-number (NaN) +% +% features: +% - can deal with NaN's (missing values) +% - implements dimension argument. +% - computes weighted sum +% - compatible with Matlab and Octave +% +% see also: FLAG_NANS_OCCURED, SUM, NANSUM, MEAN, STD, VAR, RMS, MEANSQ, +% SSQ, MOMENT, SKEWNESS, KURTOSIS, SEM + + +% This program is free software; you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation; either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program; If not, see . + +% $Id: sumskipnan.m 9033 2011-11-08 20:58:07Z schloegl $ +% Copyright (C) 2000-2005,2009,2011 by Alois Schloegl +% This function is part of the NaN-toolbox +% http://pub.ist.ac.at/~schloegl/matlab/NaN/ + + +global FLAG_NANS_OCCURED; + +if nargin<2, + DIM = []; +end; +if nargin<3, + W = []; +end; + +% an efficient implementation in C of the following lines +% could significantly increase performance +% only one loop and only one check for isnan is needed +% An MEX-Implementation is available in sumskipnan.cpp +% +% Outline of the algorithm: +% for { k=1,o=0,count=0; k++; k1,1); + if isempty(DIM), DIM = 1; end; +end +if (DIM<1), DIM = 1; end; %% Hack, because min([])=0 for FreeMat v3.5 + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% non-float data +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if (isempty(W) && (~(isa(x,'float') || isa(x,'double')))) || ~flag_implicit_skip_nan(), %%% skip always NaN's + if ~isempty(W) + error('SUMSKIPNAN: weighted sum of integers not supported, yet'); + end; + x = double(x); + o = sum(x,DIM); + if nargout>1 + sz = size(x); + N = sz(DIM); + sz(DIM) = 1; + count = repmat(N,sz); + if nargout>2 + x = x.*x; + SSQ = sum(x,DIM); + end; + end; + return; +end; + +if (length(size(x))=3), + [o,count,SSQ] = sumskipnan_mex(real(x),DIM,FLAG_NANS_OCCURED,W); + if (~isreal(x)) + [io,icount,iSSQ] = sumskipnan_mex(imag(x),DIM,FLAG_NANS_OCCURED,W); + if any(count(:)-icount(:)) + error('Number of NaNs differ for REAL and IMAG part'); + else + o = o+i*io; + SSQ = SSQ+iSSQ; + end; + end; + return; + end; +end; + +if ~isempty(W) + error('weighted sumskipnan requires sumskipnan_mex'); +end; + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% count non-NaN's +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +if nargout>1, + count = sum(x==x,DIM); + FLAG_NANS_OCCURED = any(count(:)2, + x = real(x).^2 + imag(x).^2; + SSQ = sum(x,DIM); +end; + +%!assert(sumskipnan([1,2],1),[1,2]) +%!assert(sumskipnan([1,NaN],2),1) +%!assert(sumskipnan([1,NaN],2),1) +%!assert(sumskipnan([nan,1,4,5]),10) +%!assert(sumskipnan([nan,1,4,5]',1,[3;2;1;0]),6) + + + diff --git a/octave_packages/tsa-4.2.4/tsademo.m b/octave_packages/tsa-4.2.4/tsademo.m new file mode 100644 index 0000000..8297402 --- /dev/null +++ b/octave_packages/tsa-4.2.4/tsademo.m @@ -0,0 +1,39 @@ +% TSADEMO demonstrates INVEST1 on EEG data + +% $Id: tsademo.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1998-2002,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +if exist('OCTAVE_VERSION')>5; + load -force eeg8s.mat +elseif 1 + load eeg8s.mat +else + [FileName, PathName]=uigetfile('eeg8s.mat','load demo data EEG8S.MAT'); + load([PathName FileName],'eeg8s'); +end; +s = eeg8s'; +Pmax=100; +[AutoCov,AutoCorr,ARPMX,E,CRITERIA,MOPS]=invest1(s,Pmax,'s'); + +if size(ARPMX,2)==2*Pmax, + %invest1(eeg8s,30,'s'); + AR=ARPMX(:,1:Pmax); + RC=ARPMX(:,Pmax+1:2*Pmax); +else + AR=ARPMX(:,Pmax/2*(Pmax-1)+(1:Pmax)); + RC=ARPMX(:,(1:Pmax).*(2:Pmax+1)/2); +end; diff --git a/octave_packages/tsa-4.2.4/ucp.m b/octave_packages/tsa-4.2.4/ucp.m new file mode 100644 index 0000000..a026048 --- /dev/null +++ b/octave_packages/tsa-4.2.4/ucp.m @@ -0,0 +1,45 @@ +function b=ucp(c) +% UCP(C) tests if the polynomial C is a Unit-Circle-Polynomial. +% It tests if all roots lie inside the unit circle like +% B=ucp(C) does the same as +% B=all(abs(roots(C))<1) but much faster. +% The Algorithm is based on the Jury-Scheme. +% C are the elements of the Polynomial +% C(1)*X^N + ... + C(N)*X + C(N+1). +% +% REFERENCES: +% O. Foellinger "Lineare Abtastsysteme", Oldenburg Verlag, Muenchen, 1986. +% F. Gausch "Systemtechnik", Textbook, University of Technology Graz, 1993. + + +% $Id: ucp.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1996-1999,2008 by Alois Schloegl +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +[lr,lc] = size(c); + +% JURY-Scheme +b=ones(lr,1); +lambda=zeros(lr,1); +while (lc > 1), + lambda = c(:,lc)./c(:,1); +% disp([lc,size(lambda), sum(b),toc]); + % ratio must be less then 1 + b = b & (abs(lambda) < 1); + % and reduced polynomial must be a UCP, too. + c(:,1:lc-1) = c(:,1:lc-1) - lambda(:,ones(1,lc-1)).*c(:,lc:-1:2); + lc = lc-1; +end; + diff --git a/octave_packages/tsa-4.2.4/y2res.m b/octave_packages/tsa-4.2.4/y2res.m new file mode 100644 index 0000000..216ec61 --- /dev/null +++ b/octave_packages/tsa-4.2.4/y2res.m @@ -0,0 +1,121 @@ +function [R]=y2res(Y) +% Y2RES evaluates basic statistics of a data series +% +% R = y2res(y) +% several statistics are estimated from each column of y +% +% OUTPUT: +% R.N number of samples, NaNs are not counted +% R.SUM sum of samples +% R.MEAN mean +% R.STD standard deviation +% R.VAR variance +% R.Max Maximum +% R.Min Minimum +% ... and many more including: +% MEDIAN, Quartiles, Variance, standard error of the mean (SEM), +% Coefficient of Variation, Quantization (QUANT), TRIMEAN, SKEWNESS, +% KURTOSIS, Root-Mean-Square (RMS), ENTROPY +% + +% $Id: y2res.m 5090 2008-06-05 08:12:04Z schloegl $ +% Copyright (C) 1996-2005,2008 by Alois Schloegl +% This is part of the TSA-toolbox +% http://octave.sourceforge.net/ +% http://www.dpmi.tugraz.at/~schloegl/matlab/tsa/ +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + + +[R.SUM, R.N, R.SSQ] = sumskipnan(Y,1); +%R.S3P = sumskipnan(Y.^3,1); +R.S4P = sumskipnan(Y.^4,1); +%R.S5P = sumskipnan(Y.^5,1); + +R.MEAN = R.SUM./R.N; +R.MSQ = R.SSQ./R.N; +R.RMS = sqrt(R.MSQ); +R.SSQ0 = R.SSQ-R.SUM.*R.MEAN; % sum square of mean removed + +if 1,%flag_implicit_unbiased_estim, + n1 = max(R.N-1,0); % in case of n=0 and n=1, the (biased) variance, STD and STE are INF +else + n1 = R.N; +end; + +R.VAR = R.SSQ0./n1; % variance (unbiased) +R.STD = sqrt(R.VAR); % standard deviation +R.SEM = sqrt(R.SSQ0./(R.N.*n1)); % standard error of the mean +R.SEV = sqrt(n1.*(n1.*R.S4P./R.N+(R.N.^2-2*R.N+3).*(R.SSQ./R.N).^2)./(R.N.^3)); % standard error of the variance +R.Coefficient_of_variation = R.STD./R.MEAN; + +R.CM2 = R.SSQ0./n1; + +R.Max = max(Y,[],1); +R.Min = min(Y,[],1); + +%R.NormEntropy = log2(sqrt(2*pi*exp(1)))+log2(R.STD); + +Q0500=repmat(nan,1,size(Y,2)); +Q0250=Q0500; +Q0750=Q0500; +%MODE=Q0500; +for k = 1:size(Y,2), + tmp = sort(Y(:,k)); + Q0250(k) = flix(tmp,R.N(k)/4 + 0.75); + Q0500(k) = flix(tmp,R.N(k)/2 + 0.50); + Q0750(k) = flix(tmp,R.N(k)*3/4 + 0.25); + tmp = diff(tmp); + + pdf = diff([0; find(tmp>0); R.N(k)])/R.N(k); % empirical probability distribution + R.ENTROPY(k) = -sumskipnan(pdf.*log(pdf)); + + tmp = tmp(find(tmp)); + q = min(tmp); + qerror = 0; + if isempty(q), + q = NaN; + else + tmp = tmp/q; + qerror = max(abs(tmp-round(tmp))); + end; + R.QUANT(k) = q; + R.Qerror(k) = qerror; +end; +if any(R.Qerror*1e6>R.QUANT) + warning('(Y2RES) Quantization might not be equidistant') +end; + +R.MEDIAN = Q0500; +R.Quartiles = [Q0250; Q0750]; +% R.IQR = H_spread = [Q0750 - Q0250]; +R.TRIMEAN = [Q0250 + 2*Q0500 + Q0750]/4; + +Y = Y - repmat(R.MEAN,size(Y)./size(R.MEAN)); +R.CM3 = sumskipnan(Y.^3,1)./n1; +R.CM4 = sumskipnan(Y.^4,1)./n1; +%R.CM5 = sumskipnan(Y.^5,1)./n1; + +R.SKEWNESS = R.CM3./(R.STD.^3); +R.KURTOSIS = R.CM4./(R.VAR.^2)-3; + +%R.Skewness.Fisher = (R.CM3)./(R.STD.^3); %%% same as R.SKEWNESS + +%R.Skewness.Pearson_Mode = (R.MEAN-R.MODE)./R.STD; +%R.Skewness.Pearson_coeff1 = (3*R.MEAN-R.MODE)./R.STD; +R.Skewness.Pearson_coeff2 = (3*R.MEAN-R.MEDIAN)./R.STD; +R.Skewness.Bowley = (Q0750+Q0250 - 2*Q0500)./(Q0750-Q0250); % quartile skewness coefficient + +R.datatype = 'STAT Level 4'; + diff --git a/octave_packages/vrml-1.0.13/best_dir.m b/octave_packages/vrml-1.0.13/best_dir.m new file mode 100644 index 0000000..7e999a5 --- /dev/null +++ b/octave_packages/vrml-1.0.13/best_dir.m @@ -0,0 +1,184 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## [d,w,rx,cv,wx] = best_dir( x, [a , sx ] ) +## +## Some points x, are observed and one assumes that they belong to +## parallel planes. There is an unknown direction d s.t. for each +## point x(i,:), one has : +## +## x(i,:)*d == w(j(i)) + noise +## +## where j is known(given by the matrix a ), but w is unknown. +## +## Under the assumption that the error on x are i.i.d. gaussian, +## best_dir() returns the maximum likelihood estimate of d and w. +## +## This function is slower when cv is returned. +## +## INPUT : +## ------- +## x : D x P P points. Each one is the sum of a point that belongs +## to a plane and a noise term. +## +## a : P x W 0-1 matrix describing association of points (rows of +## x) to planes : +## +## a(p,i) == 1 iff point x(p,:) belongs to the i'th plane. +## +## Default is ones(P,1) +## +## sx : P x 1 Covariance of x(i,:) is sx(i)*eye(D). +## Default is ones(P,1) +## OUTPUT : +## -------- +## d : D x 1 All the planes have the same normal, d. d has unit +## norm. +## +## w : W x 1 The i'th plane is { y | y*d = w(i) }. +## +## rx : P x 1 Residuals of projection of points to corresponding plane. +## +## +## Assuming that the covariance of x (i.e. sx) was known +## only up to a scale factor, an estimate of the +## covariance of x and [w;d] are +## +## sx * mean(rx.^2)/mean(sx) and +## cv * mean(rx.^2)/mean(sx), respectively. +## +## cv : (D+W)x(D+W) +## Covariance of the estimator at [d,w] ( assuming that +## diag(covariance(vec(x))) == sx ). +## +## wx : (D+W)x(D*P) +## Derivatives of [w;d] wrt to x. +## +## Author : Etienne Grossmann +## Created : March 2000 +## +function [d,w,rx,cv,wx] = best_dir( x, a, sx ) + +[D,P] = size(x) ; +## Check dimension of args +if nargin<2, + a = ones(P,1) ; +elseif size(a,1) != P, + error ("best_dir : size(a,1)==%d != size(x,2)==%d\n",size(a,1),P); + ## keyboard +end +if isempty (a) + error ("best_dir : a is empty. This will not do!\n"); + ## keyboard +end + +W = size(a,2) ; +if nargin<3, + sx = ones(P,1) ; +else + if prod(size(sx)) != P, + error ("best_dir : sx has %d elements, rather than P=%d\n", + prod(size(sx)),P); + ## keyboard + end + if !all(sx)>0, + error ("best_dir : sx has non positive element\n"); + ## keyboard + end +end +sx = sx(:); + + +## If not all points belong to a plane, clean a. + +keep = 0 ; +if ! all(sum([a';a'])), # trick for single-column a + + ## if verbose, printf ("best_dir : Cleaning up useless rows of 'a'\n"); end + keep = find(sum([a';a'])) ; + ## [d,w,cv] = best_dir(x(keep,:),a(keep,:),sx(keep)) ; + ## return ; + x = x(:,keep); + a = a(keep,:); + sx = sx(keep); + P_orig = P ; + P = prod(size(keep)); +end + +## If not all planes are used, remove some rows of a. +if !all(sum(a)), + keep = find(sum(a)) ; + if nargout >= 4, + [d,ww,rx,cv2] = best_dir(x,a(:,keep),sx) ; + cv = zeros(W+D,W+D) ; + cv([1:3,3+keep],[1:3,3+keep]) = cv2 ; + else + [d,ww,rx] = best_dir(x,a(:,keep),sx) ; + end + w = zeros(W,1); + w(keep) = ww ; + return +end +## Now, a has rank W for sure. + +## tmp = diag(1./sx) ; +tmp = (1./sx)*ones(1,W) ; +tmp2 = inv(a'*(tmp.*a))*(a.*tmp)' ; ; +tmp = x*(eye(P) - tmp2'*a') ; +## tmp = tmp*diag(1./sx)*tmp' ; +tmp = (tmp.*(ones(D,1)*(1./sx)'))*tmp' ; + +[u,S,v] = svd(tmp) ; +d = v(:,D) ; +w = tmp2*x'*d ; + +rx = (x'*d - a*w) ; + +if nargout >= 4, + wd = [w;d]; + ## shuffle = ( ones(D,1)*[0:P-1]+[1:P:P*D]'*ones(1,P) )(:) ; + ## [cv,wx] = best_dir_cov(x',a,sx,wd) ; + ## ## wx = wx(:,shuffle) ; + + [cv,wx] = best_dir_cov(x,a,sx,wd) ; + + ## [cv2,wx2] = best_dir_cov2(x,a,sx,wd) ; + ## if any(abs(cv2(:)-cv(:))>eps), + ## printf("test cov : bug 1\n") ; + ## keyboard + ## end + ## if any(abs(wx2(:)-wx(:))>eps), + ## printf("test cov : bug 2\n") ; + ## keyboard + ## end + +end + + +if keep, + tmp = zeros(P_orig,1) ; + tmp(keep) = rx ; + rx = tmp ; + if nargout >= 5, + k1 = zeros(1,P_orig) ; k1(keep) = 1 ; k1 = kron(ones(1,D),k1) ; + tmp = zeros(D+W,P_orig*D) ; + tmp(:,k1) = wx ; + wx = tmp ; + end +end + +endfunction + + diff --git a/octave_packages/vrml-1.0.13/best_dir_cov.m b/octave_packages/vrml-1.0.13/best_dir_cov.m new file mode 100644 index 0000000..7a53ab2 --- /dev/null +++ b/octave_packages/vrml-1.0.13/best_dir_cov.m @@ -0,0 +1,121 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## [cv,wx] = best_dir_cov(x,a,sx,wd) +## +## x D x P : +## a P x W : Same as in best_dir, but sx is compulsory. +## sx P x 1 : +## +## wd (W+D) x 1 : ML estimate of [w;d] +## +## cv (W+D)x(W+D) : Covariance of the ML estimator at [w;d] +## +## wx (W+D)x(P*D) : derivatives of ML estimate wrt to observations +## + +## Author: Etienne Grossmann +## Last modified: Setembro 2002 + +function [cv,wx] = best_dir_cov(x,a,sx,wd) + +[D,P] = size (x); +W = columns (a); +WD = prod (size (wd)); + + # Check dimensions etc +if prod(size(sx)) != P + error ("sx has %d != %d elements", prod (size (sx)), P); +end +if WD != W+D + error ("wd has %d != %d elements", WD, W+D); +end +if rows (a) != P + error ("a has %d != %d rows", rows (a), P); +end +if any (sx <= 0) + error ("sx has some nonpositive elements"); +end + +sx = sx(:) ; +wd = wd(:) ; + +w = wd(1:W); +d = wd(W+1:WD); + +isig = diag(1./sx) ; # Inverse of covariance matrix. + + # All derivatives are 1/2 of true value. + +dsw = [zeros(W,1);d]; # Derivative of constraint |d|^2=1 + + # Inverse of Hessian with side blocks +#keyboard +if 0, # Readable code, bigger matrices + d2ww = inv([ [-a';x]*isig*[-a,x'], dsw ; dsw' , 0 ]) ; + +else # Unreadable, smaller matrices + ## tmp = (1./sx)*ones(1,WD); + d2ww = inv( [ ([-a,x'].*((1./sx)*ones(1,WD)))'*[-a,x'], dsw ; dsw', 0 ]) ; +end +## if any(abs(D2ww(:)-d2ww(:))>sqrt(eps)), +## printf("Whoa!! %g",max(abs(D2ww(:)-d2ww(:)))) ; +## end + + # 2nd Derivatives wrt. wd and x + +## d2wx = zeros(WD+1,D*P); # (padded with a row of zeros) +d2wx = zeros(WD,D*P); + # Easy : wrt. w and x +d2wx(1:W,:) = - kron(d',((1./sx)*ones(1,W))'.*a') ; + +x = x'(:) ; + +y = eye(D); # tmp +tmp = zeros(D,D*P) ; + # wrt. d and x +for i=1:D, + + ## d2wx(W+i,(i-1)*P+1:i*P) = \ + ## 2*x'*(kron(y(i,:)) + d2wx(W+i,:) = \ + 2*x'*kron(y(i,:),kron(d,isig)) - \ + w'*a'*isig*kron(y(i,:),eye(P)) ; +end + +## wx = d2ww*d2wx ; + +wx = d2ww(1:WD,1:WD)*d2wx(1:WD,:) ; +cv = ((wx.*kron(ones(WD,D),sx'))*wx') ; + +## cv = (wx*kron(eye(D),isig)*wx')(1:WD,1:WD) ; +# if 0, +# cv = (wx*kron(eye(D),diag(sx))*wx')(1:WD,1:WD) ; +# elseif 0 +# cv = ((wx.*kron(ones(WD+1,D),sx'))*wx')(1:WD,1:WD) ; +# end +# if any(abs(cv2(:)-cv(:))>sqrt(eps)), +# printf("whoa!! b_d_cov (2) : %f\n",max(abs(cv2(:)-cv(:)))); +# keyboard +# end + + + + + + + +endfunction + diff --git a/octave_packages/vrml-1.0.13/bound_convex.m b/octave_packages/vrml-1.0.13/bound_convex.m new file mode 100644 index 0000000..50759af --- /dev/null +++ b/octave_packages/vrml-1.0.13/bound_convex.m @@ -0,0 +1,111 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## y = bound_convex(d,h,x,pad=0) +## +## y : 3xQ : Corners that define the convex hull of the projection of x +## in the plane d*y == v. The corners are sorted. +## + +## Author: Etienne Grossmann + +function y = bound_convex(d,h,x,pad) + +if nargin<4, pad = 0 ; end + +d = d(:)' ; + +P = size(x,2) ; +prudent = 1; + +## I don't really care if I'm not given coplanar points +## +# if prudent && any(abs(d*x-h)>10*eps), +# printf("bound_convex : Points are not on plane (max dist=%8.4g\n",... +# max(abs(d*x-h))); +# keyboard +# end + +## Project x to plane { y | d'*y = h } +nd = norm(d); +h ./= nd; +d ./= nd; + +p = (v*d)*ones(1,P); + +x -= d'*d*(x-p) ; + +## x = proplan (x,d,h); + +c = mean(x')'*ones(1,P); +xc = x-c ; + +ext = zeros(1,P); # Extremal points + +nuld = null(d); +px = nuld'*xc; # Project on 2D +[chx,ich] = chull (px); # Find 2D convex hull +ext(ich) = 1; +## keyboard +# for i = 1:P, + +# [dum,jj] = max( xc(:,i)'*xc ) ; +# ext(jj) = 1 ; +# [dum,jj] = min( xc(:,i)'*xc ) ; +# ext(jj) = 1 ; +# end + +y = xc(:,find(ext)) ; + +norms = sqrt( sum( y.^2 ) ); + +if any(norms==0), + printf("bound_convex : Points project to line\n") ; + if sum( norms != 0 )!=2, + printf("bound_convex : Moreover the segment has more than 2 tips!!\n") ; + end + y = y(:,find(norms != 0)) ; + norms = norms(find(norms != 0)); + return +end +## Sort points so that they turn monotonously around the origin +d1 = y(:,1)'/norms(1) ; +if abs( d1*d1' - 1 )>10*eps, + error ("bound_convex : d1 ain't unit!\n"); + ## keyboard +end +norms = [1;1;1]*norms; + +[dum,id2] = min( abs( d1*y./norms(1,:) ) ) ; +## d2 = cross( d1, y(:,id2)' ) ; +d2 = cross( d1, d ) ; +d2 = d2/norm(d2) ; + +[dum,iy] = sort( atan2( d2*y./norms(1,:), d1*y./norms(1,:) ) ) ; + +y = y(:,iy) ; + + + +## foo = d2*y./norms(1,iy); +## bar = d1*y./norms(1,iy); +## plot(bar,foo) ; + +## keyboard + +## Shift back y into place +y = y+c(:,1:size(y,2)) ; +endfunction + diff --git a/octave_packages/vrml-1.0.13/checker_color.m b/octave_packages/vrml-1.0.13/checker_color.m new file mode 100644 index 0000000..8d80bc2 --- /dev/null +++ b/octave_packages/vrml-1.0.13/checker_color.m @@ -0,0 +1,41 @@ +## Copyright (C) 2010-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## col = checker_color (R,C, checker, col) + +function col = checker_color (checker, col, R,C) + +if length (checker) == 1, checker = [checker, checker]; end + +if checker(1) > 0, checker(1) = - (C-1)/checker(1); end +if checker(2) > 0, checker(2) = - (R-1)/checker(2); end + +checker *= -1; + +colx = 2 * (rem (0:C-2,2*checker(1)) < checker(1)) - 1; +coly = 2 * (rem (0:R-2,2*checker(2)) < checker(2)) - 1; +icol = 1 + ((coly'*colx) > 0); + # Keep at most 1st 2 colors of col for the + # checker +if prod (size (col)) == 2, + col = [1;1;1]*col; +elseif prod (size (col)) < 6, # Can't be < 3 because of previous code + col = col(1:3)(:); + if all (col >= 1-eps), col = [col [0;0;0]]; # Black and White + else col = [col [1;1;1]]; # X and White + end +end +col = reshape (col(:),3,2); +col = col(:,icol); diff --git a/octave_packages/vrml-1.0.13/doc-cache b/octave_packages/vrml-1.0.13/doc-cache new file mode 100644 index 0000000..1819b1b --- /dev/null +++ b/octave_packages/vrml-1.0.13/doc-cache @@ -0,0 +1,1663 @@ +# Created by Octave 3.6.2, Tue Jun 19 09:54:03 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 44 +# name: +# type: sq_string +# elements: 1 +# length: 8 +best_dir + + +# name: +# type: sq_string +# elements: 1 +# length: 1793 + [d,w,rx,cv,wx] = best_dir( x, [a , sx ] ) + + Some points x, are observed and one assumes that they belong to + parallel planes. There is an unknown direction d s.t. for each + point x(i,:), one has : + + x(i,:)*d == w(j(i)) + noise + + where j is known(given by the matrix a ), but w is unknown. + + Under the assumption that the error on x are i.i.d. gaussian, + best_dir() returns the maximum likelihood estimate of d and w. + + This function is slower when cv is returned. + + INPUT : + ------- + x : D x P P points. Each one is the sum of a point that belongs + to a plane and a noise term. + + a : P x W 0-1 matrix describing association of points (rows of + x) to planes : + + a(p,i) == 1 iff point x(p,:) belongs to the i'th plane. + + Default is ones(P,1) + + sx : P x 1 Covariance of x(i,:) is sx(i)*eye(D). + Default is ones(P,1) + OUTPUT : + -------- + d : D x 1 All the planes have the same normal, d. d has unit + norm. + + w : W x 1 The i'th plane is { y | y*d = w(i) }. + + rx : P x 1 Residuals of projection of points to corresponding plane. + + + Assuming that the covariance of x (i.e. sx) was known + only up to a scale factor, an estimate of the + covariance of x and [w;d] are + + sx * mean(rx.^2)/mean(sx) and + cv * mean(rx.^2)/mean(sx), respectively. + + cv : (D+W)x(D+W) + Covariance of the estimator at [d,w] ( assuming that + diag(covariance(vec(x))) == sx ). + + wx : (D+W)x(D*P) + Derivatives of [w;d] wrt to x. + + Author : Etienne Grossmann + Created : March 2000 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 + [d,w,rx,cv,wx] = best_dir( x, [a , sx ] ) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +best_dir_cov + + +# name: +# type: sq_string +# elements: 1 +# length: 308 + [cv,wx] = best_dir_cov(x,a,sx,wd) + + x D x P : + a P x W : Same as in best_dir, but sx is compulsory. + sx P x 1 : + + wd (W+D) x 1 : ML estimate of [w;d] + + cv (W+D)x(W+D) : Covariance of the ML estimator at [w;d] + + wx (W+D)x(P*D) : derivatives of ML estimate wrt to observations + + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + [cv,wx] = best_dir_cov(x,a,sx,wd) + + x D x P : + a P x W : + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +bound_convex + + +# name: +# type: sq_string +# elements: 1 +# length: 164 + y = bound_convex(d,h,x,pad=0) + + y : 3xQ : Corners that define the convex hull of the projection of x + in the plane d*y == v. The corners are sorted. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 + y = bound_convex(d,h,x,pad=0) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +checker_color + + +# name: +# type: sq_string +# elements: 1 +# length: 41 + col = checker_color (R,C, checker, col) + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 + col = checker_color (R,C, checker, col) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +data2vrml + + +# name: +# type: sq_string +# elements: 1 +# length: 284 + s = data2vrml (typeStr, value) - Convert 'value' to VRML code of type typeStr + + TODO: Improve this function + + If typeStr is "SFBool", then s is "TRUE" or "FALSE" + If typeStr is "MFString", then s is sprintf ("%s", value) + otherwise s is sprintf ("%f", value) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 79 + s = data2vrml (typeStr, value) - Convert 'value' to VRML code of type typeStr + + + + +# name: +# type: sq_string +# elements: 1 +# length: 7 +proplan + + +# name: +# type: sq_string +# elements: 1 +# length: 82 + x = proplan(x,d,v=1) + + orthogonally project x to the affine plane d*x == v + + + +# name: +# type: sq_string +# elements: 1 +# length: 28 + x = proplan(x,d,v=1) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +save_vrml + + +# name: +# type: sq_string +# elements: 1 +# length: 404 + save_vrml(outname,[options],s1,...) - Save vrml code + + Makes a vrml2 file from strings of vrml code. A "background" node is + added. + + Options : + "nobg" + "nolight" + + Bugs : + - "outname" should not contain the substring ".wrl" anywhere else + than as a suffix. + - "outname" should only contain the character ">" as ">>" at the + beginning , to indicate append rather than overwriting the + file. + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 + save_vrml(outname,[options],s1,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +test_moving_surf + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +key test_moving_surf + + Test vmesh.m + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +key test_moving_surf + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +test_vmesh + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +key test_vmesh + + Test vmesh.m + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +key test_vmesh + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +test_vrml_faces + + +# name: +# type: sq_string +# elements: 1 +# length: 46 + Test that vrml_faces works with "tex" option + + + +# name: +# type: sq_string +# elements: 1 +# length: 46 + Test that vrml_faces works with "tex" option + + + + +# name: +# type: sq_string +# elements: 1 +# length: 5 +vmesh + + +# name: +# type: sq_string +# elements: 1 +# length: 2329 + s = vmesh (x, y, z [, options] ) - Visualize a 3D surface + s = vmesh (z [, options] ) + + Visualizes a 3D surface. Returns the VRML code. + + x : RxC or C : X coordinates of the points on the surface + y : RxC or R : Y " " + z : RxC : Z " " + + s : string : The code + + If x and y are omitted, they are assumed to be linspace(-1,1,C or R). + Points presenting one or more 'inf' or 'nan' coordinates are ignored. + + Options : (all options of vrml_surf may be used too) + + "col" , col : 3 : RGB Color, Default = [0.3,0.4,0.9] + or 3x(R*C): Color of vertices (vrml colorPerVertex is TRUE). + or 3x((R-1)*(C-1)) + : Color of facets + or 1 : Reflectivity (equivalent to [col,col,col] in RGB) + or R x C : Reflectivity of vertices + or 1x(R*C) + or (R-1)x(C-1) + or (R-1)*(C-1) + : Reflectivity of facets. + + RGB and reflectivity values should be in the [0,1] interval. + + "checker", c : 1x2 : Color as a checker. If c(1) is positive, checker has + c(1) rows. If it is negative, each checker row is + c(1) facets high. c(2) does the same for columns. + or 1x1 : Same as [c,c]. + + "zgray" : Color varies from black for lowest point to white + for highest. + + "zrb" : Color varies from blue for lowest point to red for + highest. + + "zcol", zcol : Mx3 : Color is linearly interpolated between the RGB + values specified by the rows of zcol. + + "steps" : Represent surface as a piecewise constant Z = f(X,Y) + function + + "bars" : Represent surface as a bar plot + "bwid" : Bar width, relative to point separation. Default = 2/3 + + "level", l : 1xN : Display one or more horizontal translucent plane(s) + + z == l(i) (1 <= i <= length(l)) + + "lcol", lc : Nx3 : Color of the plane(s). Default = [.7 .7 .7] + "ltran",lt : Nx1 : Transparency of the plane(s). Default = 0.3 + "tex", texFile + + "normalize" : Normalize z to [-1,1] + + See also: vrml_surf(), vrml_faces(), demo("vmesh") + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + s = vmesh (x, y, z [, options] ) - Visualize a 3D surface + s = vmesh (z [, opti + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +vrml_Background + + +# name: +# type: sq_string +# elements: 1 +# length: 610 + s = vrml_Background (...) - Vrml Background node + + s is a string of the form : + ------------------------------------------------------------------ + Background { + skyColor [0 0 0] + skyAngle [0] + groundColor [0 0 0] + groundangle [0] + backUrl "" + bottomUrl "" + frontUrl "" + leftUrl "" + rightUrl "" + topUrl "" + } + ------------------------------------------------------------------ + + Options : + All the fields of the node + + Example : s = vrml_Background ("skyColor",[0 0 1]); + + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 + s = vrml_Background (. + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +vrml_Box + + +# name: +# type: sq_string +# elements: 1 +# length: 189 + s = vrml_Box (sz) - Box { ... } node + + If sz is not given, returns Box { } + If sz has size 1, returns Box { } + If sz has size 3, returns Box { } + + + +# name: +# type: sq_string +# elements: 1 +# length: 28 + s = vrml_Box (sz) - Box { . + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +vrml_DirectionalLight + + +# name: +# type: sq_string +# elements: 1 +# length: 617 + s = vrml_DirectionalLight (...) - Vrml DirectionalLight node + + s is a string of the form : + ------------------------------------------------------------------ + DirectionalLight { + exposedField SFFloat ambientIntensity 0 # [0,1] + exposedField SFColor color 1 1 1 # [0,1] + exposedField SFVec3f direction 0 0 -1 # (-,) + exposedField SFFloat intensity 1 # [0,1] + exposedField SFBool on TRUE + } + ------------------------------------------------------------------ + + Options : + All the fields of the node + + See also : vrml_PointLight + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 + s = vrml_DirectionalLight (. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +vrml_PointLight + + +# name: +# type: sq_string +# elements: 1 +# length: 791 + s = vrml_PointLight (...) - Vrml PointLight node + + s is a string of the form : + ------------------------------------------------------------------ + PointLight { + exposedField SFFloat ambientIntensity 0 ## [0,1] + exposedField SFVec3f attenuation 1 0 0 ## [0,inf) + exposedField SFColor color 1 1 1 ## [0,1] + exposedField SFFloat intensity 1 ## [0,1] + exposedField SFVec3f location 0 0 0 ## (-inf,inf) + exposedField SFBool on TRUE + exposedField SFFloat radius 100 ## [0,inf) + } + ------------------------------------------------------------------ + + Options : + All the fields of the node + + Example : s = vrml_PointLight ("location",[0 0 1]); + + See also : vrml_DirectionalLight + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 + s = vrml_PointLight (. + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +vrml_ROUTE + + +# name: +# type: sq_string +# elements: 1 +# length: 32 + vrml_ROUTE (eventout, eventin) + + + +# name: +# type: sq_string +# elements: 1 +# length: 32 + vrml_ROUTE (eventout, eventin) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +vrml_Sphere + + +# name: +# type: sq_string +# elements: 1 +# length: 52 + s = vrml_Sphere (radius) - VRML code for a sphere + + + +# name: +# type: sq_string +# elements: 1 +# length: 52 + s = vrml_Sphere (radius) - VRML code for a sphere + + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +vrml_TimeSensor + + +# name: +# type: sq_string +# elements: 1 +# length: 913 + s = vrml_TimeSensor (...) - Low-level vrml TimeSensor node + + s is a vrml node with possible fields : + ------------------------------------------------------------------ + TimeSensor { + exposedField SFTime cycleInterval 1 # (0,inf) + exposedField SFBool enabled TRUE + exposedField SFBool loop FALSE + exposedField SFTime startTime 0 # (-inf,inf) + exposedField SFTime stopTime 0 # (-inf,inf) + eventOut SFTime cycleTime + eventOut SFFloat fraction_changed # [0, 1] + eventOut SFBool isActive + eventOut SFTime time + } + ------------------------------------------------------------------ + + Options : + Beyond all the fields of the node, it is also possible to use the option + + "DEF", name : The created node will be preceded by 'DEF name ', so that + it is further possible to refer to it. + + See also : + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 + s = vrml_TimeSensor (. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +vrml_Viewpoint + + +# name: +# type: sq_string +# elements: 1 +# length: 765 + s = vrml_Viewpoint (...) - Vrml Viewpoint node + + s is a string of the form : + ------------------------------------------------------------------ + Viewpoint { + eventIn SFBool set_bind + exposedField SFFloat fieldOfView 0.785398 # (0,pi) + exposedField SFBool jump TRUE + exposedField SFRotation orientation 0 0 1 0 # [-1,1],(-pi,pi) + exposedField SFVec3f position 0 0 10 # (-,) + field SFString description "" + eventOut SFTime bindTime + eventOut SFBool isBound + } + ------------------------------------------------------------------ + + Options : + All the fields of the node + + Example : s = vrml_Viewpoint ("location",[0 0 1]); + + See also : vrml_DirectionalLight + + + +# name: +# type: sq_string +# elements: 1 +# length: 23 + s = vrml_Viewpoint (. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +vrml_anim + + +# name: +# type: sq_string +# elements: 1 +# length: 168 + s = vrml_anim (typ, val, eventin, time) + + Assemble + - an interpolator of type typ, with values val + - a TimeSensor with period time + and route the event to eventin + + + + +# name: +# type: sq_string +# elements: 1 +# length: 41 + s = vrml_anim (typ, val, eventin, time) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +vrml_arrow + + +# name: +# type: sq_string +# elements: 1 +# length: 827 + s = vrml_arrow (sz, col) - Arrow pointing in "y" direction + + INPUT : + ------- + Arguments are optional. NaN's are replaced by default values. + + sz = [len, alen, dc, dr] has size 1, 2, 3 or 4, where + + len : total length <1> + alen : If positive: length of cone/total length <1/4> + If negative: -(length of cone) + dc : If positive: diameter of cone base/total len <1/16> + If negative: -(diameter of cone) + dr : If positive: diameter of rod/total length + If negative: -(diameter of rod) + + col : 3 or 3x2 : Color of body and cone <[0.3 0.4 0.9]> + + OUTPUT : + -------- + s : string : vrml representation of an arrow (a rod and a cone) + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 + s = vrml_arrow (sz, col) - Arrow pointing in "y" direction + + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +vrml_browse + + +# name: +# type: sq_string +# elements: 1 +# length: 1134 + p = vrml_browse ([s]) - View vrml code s with FreeWRL + vrml_browse ("-kill") - Kill the browser + + s : string : VRML code, as returned by the vrml_XYZ functions. + If s is not specified, a sombrero is showed + + p : int : pid of the current browser. If freewrl has not been started + or has died, a new one is started. p is zero or negative in + case of failure to start freewrl. + + Some keystrokes for FreeWRL (more in the freewrl manpage) : + + 'e' : Examine : mouse 1 and drag rotates the scene + mouse 3 and drag moves closer/farther + 'w' : Walk : mouse 1 and drag moves for/backward, turns + mouse 3 and drag translates parallel to the screen + 's' : Save a snapshot in files 'octave.snapshot.NNNN.ppm' + 'q' : Quit + + WARNING : FreeWRL >0.25 (http://www.crc.ca/FreeWRL/) must be installed. + + BUG : The vrml browser is not killed when octave exits. Sometimes the + vrml browser does not get raised or gets raised improperly + (shows the contents of the topmost window above it). Use + "-kill". + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + p = vrml_browse ([s]) - View vrml code s with FreeWRL + vrml_browse + + + +# name: +# type: sq_string +# elements: 1 +# length: 8 +vrml_cyl + + +# name: +# type: sq_string +# elements: 1 +# length: 698 + s = vrml_cyl(x,...) + + Makes a cylinder that links x(:,1) to x(:,2) + + Options : + + "tran", transparency : Transparency default = 0 + "col" , col : Color default = [ 0.3 0.4 0.9 ] + "rad" , radius : Radius of segments default = 0.05 + "balls" : Add balls to extremities + "brad" : Radius of balls default = rad + "emit", bool : Use or not emissiveColor + "noemit" : Same as emit,0 + "arrow" : Last segment is an arrow + "hcol", hcol : Set color of the head of the arrow. + default = col + + + +# name: +# type: sq_string +# elements: 1 +# length: 23 + s = vrml_cyl(x,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +vrml_demo_tutorial_1 + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + Listing 1 + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + Listing 1 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +vrml_demo_tutorial_2 + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + Listing 2 + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + Listing 2 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +vrml_demo_tutorial_3 + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + Listing 3 + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + Listing 3 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 20 +vrml_demo_tutorial_4 + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + Listing 4 + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 + Listing 4 + + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +vrml_ellipsoid + + +# name: +# type: sq_string +# elements: 1 +# length: 272 + v = vrml_ellipsoid (moment, col) - Ellipsoid + + moment : 3x3 : Define elipsoid by x'*moment*x = 1 + or 3 : use diag(moment) + or 1 : use diag(moment([1,1,1])) default : eye(3) + + col : 3 : Color default : [0.3 0.4 0.9] + + + + +# name: +# type: sq_string +# elements: 1 +# length: 53 + v = vrml_ellipsoid (moment, col) - Ellipsoid + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +vrml_faces + + +# name: +# type: sq_string +# elements: 1 +# length: 2071 + s = vrml_faces(x,f,...) - VRML facet object (IndexedFaceSet node) + + x : 3xP : The 3D points + f : 3xQ : The indexes of the points forming the faces. Indexes + should have values in 1:P. + + Returns a Shape -> IndexedFaceSet vrml node. + + No check is done on anything + + Options : + + "col" , col : 3 : Color, default = [0.3,0.4,0.9] + or 3xP : Color of vertices + or 3xQ : Color of facets (use "colorPerVertex" below to + disambiguate the case P==Q). + + "emit", em : 3 : Emissive color of the surface + : 3XP : (same as color) + : 3xQ : + : 1 : Use color as emissive color too default = 0 + + "tran", tran : 1x1 : Transparency, default = 0 + + "creaseAngle", a + : 1 : vrml creaseAngle value. The browser may smoothe the + crease between facets whose angle is less than a. + default = 0 + "tex", texfile + : string : Name of file containing texture. default : none + + "imsz", sz : 2 : Size of texture image + default is determined by imginfo() + + "tcoord", tcoord + : 2x3Q : Coordinates of vertices in texture image. Each 2x3 + block contains coords of one facet's corners. The + coordinates should be in [0,1], as in a VRML + TextureCoordinate node. + default assumes faces are returned + by extex() + + "smooth" : same as "creaseAngle",pi. + "convex" + "colorPerVertex", c: If 1, col specifies color of vertices. If 0, + col specifies color of facets. Default = 1 + + "DEFcoord",n : string : DEF the coord VRML node with name n. Default = '' + "DEFcol", n : string : DEF the color VRML node with name n. Default = '' + + See also: vrml_surf(), vmesh(), test_vrml_faces() + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 + s = vrml_faces(x,f,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +vrml_flatten + + +# name: +# type: sq_string +# elements: 1 +# length: 497 + s = vrml_flatten (x [, d, w, col]) - A planar surface containing x + + If the points x are not coplanar (or not in the affine plane {y|d'*y==w}), + the surface will not contain the points, but rather their projections on + the plane {y|d'*y==w}. + + x : 3 x P : 3D points + d : 3 : normal to plane | Default : given by best_dir() + w : 1 : intercept of plane | + col : 3 : RGB color Default : [0.3,0.4,0.9] + + s : string : vrml code representing the planar surface + + + +# name: +# type: sq_string +# elements: 1 +# length: 68 + s = vrml_flatten (x [, d, w, col]) - A planar surface containing x + + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +vrml_frame + + +# name: +# type: sq_string +# elements: 1 +# length: 608 + v = vrml_frame (t, r, ...) + + t : 3 Translation Default : [0,0,0] + r : 3x3 Matrix, or Default : eye(3) + 3 Argument for rotv + OPTIONS + name : size : function : default + "scale" : 3 or 1 : Length of frame's branches (including cone) <1> + "diam" : 3 or 1 : Diameter of cone's base + "col" : 3 or 3x3 : Color of branches (may be stacked vertically) <[3 4 9]/10> + "hcol" : 3 or 3x3 : Color of head (may be stacked vertically) + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 + v = vrml_frame (t, r, . + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +vrml_group + + +# name: +# type: sq_string +# elements: 1 +# length: 71 + v = vrml_group (s1, s2 ... ) - Form a group node with children s1,... + + + +# name: +# type: sq_string +# elements: 1 +# length: 25 + v = vrml_group (s1, s2 . + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +vrml_interp + + +# name: +# type: sq_string +# elements: 1 +# length: 32 + s = vrml_interp (typ, val,...) + + + +# name: +# type: sq_string +# elements: 1 +# length: 28 + s = vrml_interp (typ, val,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +vrml_kill + + +# name: +# type: sq_string +# elements: 1 +# length: 190 + p = vrml_kill () - Kill the current vrml browser + + If a vrml browser has previously been launched with vrml_browse(), it + will be sent a KILL signal. + + See also : vrml_browse. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + p = vrml_kill () - Kill the current vrml browser + + If a vrml brows + + + +# name: +# type: sq_string +# elements: 1 +# length: 10 +vrml_lines + + +# name: +# type: sq_string +# elements: 1 +# length: 289 + s = vrml_lines(x,f,...) + + x : 3xP : The 3D points + f : 3xQ : The indexes of the points forming the lines. Indexes + should be in 1:P. + + Returns a Shape -> IndexedLineSet vrml node. + + No check is done on anything + + Options : + + "col" , col : 3x1 : Color, default = [1,0,0] + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 + s = vrml_lines(x,f,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 13 +vrml_material + + +# name: +# type: sq_string +# elements: 1 +# length: 266 + s = vrml_material (dc,ec,tr) - Returns a "material" vrml node + + dc : 3x1 : diffuseColor + ec : 3x1 : emissiveColor + or 1x1 : use dc as emissiveColor if ec is true. Default = 0 + tr : 1x1 : transparency Default = 0 + + + +# name: +# type: sq_string +# elements: 1 +# length: 64 + s = vrml_material (dc,ec,tr) - Returns a "material" vrml node + + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +vrml_newname + + +# name: +# type: sq_string +# elements: 1 +# length: 100 + n = vrml_newname (root) - A name for a vrml node, starting by root + + vrml_newname ("-clear") + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + n = vrml_newname (root) - A name for a vrml node, starting by root + + vrml + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +vrml_parallelepiped + + +# name: +# type: sq_string +# elements: 1 +# length: 321 + s = vrml_parallelogram (bnds,...) + + bnds = [xmin, ymin, zmin; xmax, ymax, zmax] + + OPTIONS : + --------- + col, c : 3x1 : Color of surface + emit, e : 1 : + tran, t : 1 : + + border,b : 1 : + bocol, c : 3 : + boemit,e : 1 : + borad, r : 1 : + + balls, b : 1 : + bcol, c : 3 : + bemit, e : 1 : + brad, r : 1 : + + + +# name: +# type: sq_string +# elements: 1 +# length: 31 + s = vrml_parallelogram (bnds,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 18 +vrml_parallelogram + + +# name: +# type: sq_string +# elements: 1 +# length: 371 + s = vrml_parallelogram (x,...) + + x : 3 x 3 : Each column is a 3D point. The fourth corner is + x(:,1)-x(:,2)+x(:,3) + + OPTIONS : + --------- + col, c : 3x1 : Color of surface + emit, e : 1 : + tran, t : 1 : + + border,b : 1 : + bocol, c : 3 : + boemit,e : 1 : + borad, r : 1 : + + balls, b : 1 : + bcol, c : 3 : + bemit, e : 1 : + brad, r : 1 : + + + +# name: +# type: sq_string +# elements: 1 +# length: 28 + s = vrml_parallelogram (x,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +vrml_points + + +# name: +# type: sq_string +# elements: 1 +# length: 1462 + s = vrml_points(x,options) + + x : 3xP : 3D points + + Makes a vrml2 "point [ ... ]" node from a 3xP matrix x. + + OPTIONS (name and size/type, if applicable): + --------------------------------------- + "balls" : Displays spheres rather than points. Overrides the + "hide" options and no Coordinate node is defined;makes + "name" ineffective. + + "boxes" or + "cubes" : Displays cubes rather than points. Overrides the "hide" + options and no Coordinate node is defined;makes "name" + ineffective. + + "rad", 1 or P: Radius of balls/size of cubes. default = 0.1 + + "nums" : Displays numbers rather than points. Overrides the + "hide" options and no Coordinate node is defined; + makes "name" ineffective. + + WARNING : This option seems to make freewrl 0.34 hang, so that it + is necessary to kill it (do vrml_browse ("-kill")). Other + browsers can can view the code produced by this option. + + "col", 3x1 : Points will have RGB col. default = [0.3,0.4,0.9] + or 3xP : The color of each point. + "tran", 1x1 : Transparency default = 0 + "emit", e : Use or not emissiveColor default = 1 + + "name", str : The Coordinate node will be called name + (default="allpoints"). + "hide" : The points will be defined, but not showed. + + + +# name: +# type: sq_string +# elements: 1 +# length: 59 + s = vrml_points(x,options) + + x : 3xP : 3D points + + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +vrml_surf + + +# name: +# type: sq_string +# elements: 1 +# length: 2206 + s = vrml_surf (x, y, z [, options] ) - code for a VRML surface + s = vrml_surf (z [, options] ) + + Returns vrml97 code for a Shape -> IndexedFaceSet node representing a + surface passing through the given points. + + x : RxC or C : X coordinates of the points on the surface + y : RxC or R : Y " " + z : RxC : Z " " + + s : string : The code + + If x and y are omitted, they are assumed to be linspace(-1,1,C or R). + Points presenting one or more 'inf' or 'nan' coordinates are ignored. + + Options : + + "col" , col : 3 : RGB Color, default = [0.3,0.4,0.9] + or 3x(R*C): Color of vertices (vrml colorPerVertex is TRUE). + or 3x((R-1)*(C-1)) + : Color of facets + or 1 : Reflectivity (equivalent to [col,col,col] in RGB) + or R x C : Reflectivity of vertices + or 1x(R*C) + or (R-1)x(C-1) + or (R-1)*(C-1) + : Reflectivity of facets. + + RGB and reflectivity values should be in the [0,1] interval. + + "checker", c : 1x2 : Color as a checker. If c(1) is positive, checker has + c(1) rows. If it is negative, each checker row is c(1) facets + high c(2) likewise determines width of checker columns. + "checker", c : 1x1 : Same as [c,c]. + + "zcol", zc : 3xN : Specify a colormap. The color of each vertex is + interpolated according to its height (z). + + "zgray" : Black-to-white colormap. Same as "zcol", [0 1;0 1;0 1]. + + "zrb" : Red-to-blue. Same as "zcol", [0 7 10;0 0 2;7 19 2]/10. + + "steps" : Represent surface as a piecewise constant Z = f(X,Y) function + + "bars" : Represent surface as a bar plot + + "tran", tran : 1x1 : Transparency, default = 0 + + "creaseAngle", a + : 1 : vrml creaseAngle The browser may smoothe the fold + between facets forming an angle less than a. + default = 0 + "smooth" : same as "creaseAngle",pi. + "tex", texFile + + See also: vmesh(), vrml_faces(), test_moving_surf() + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + s = vrml_surf (x, y, z [, options] ) - code for a VRML surface + s = vrml_surf ( + + + +# name: +# type: sq_string +# elements: 1 +# length: 9 +vrml_text + + +# name: +# type: sq_string +# elements: 1 +# length: 533 + s = vrml_text(t,...) + + Makes vrml Shape node representing string t + + Options : + + "col" , col : default = [ 0.3 0.4 0.9 ] + "size" , size : default = 1.0 + "family", family : default = "SERIF". + (could also be : "TYPEWRITER", "SANS") + "style", style : default = "PLAIN". + (could also be : "BOLD", "ITALIC", "BOLDITALIC") + "justify", justify : default = "MIDDLE" + (could also be "FIRST", "BEGIN", "END") + + + +# name: +# type: sq_string +# elements: 1 +# length: 24 + s = vrml_text(t,. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +vrml_thick_surf + + +# name: +# type: sq_string +# elements: 1 +# length: 1178 + s = vrml_thick_surf (x, y, z [, options] ) + s = vrml_thick_surf (z [, options] ) + + Returns vrml97 code for a Shape -> IndexedFaceSet node representing a + surface passing through the given points. + + The surface may look smoother than that returned by vrml_surf, but it + has twice as many facets. + + x : RxC or C : X coordinates of the points on the surface + y : RxC or R : Y " " + z : RxC : Z " " + + s : string : The code + + If x and y are omitted, they are assumed to be 1:C and 1:R, resp + Points presenting one or more 'inf' or 'nan' coordinates are ignored. + + Options : + + "col" , col : 3 : Color, default = [0.3,0.4,0.9] + or 3xP : color of vertices (vrml colorPerVertex is TRUE). + + "tran", tran : 1x1 : Transparency, default = 0 + + "creaseAngle", a + : 1 : vrml creaseAngle value. The browser may smoothe the + crease between facets whose angle is less than a. + default = 0 + "smooth" : same as "creaseAngle",pi. + + + +# name: +# type: sq_string +# elements: 1 +# length: 80 + s = vrml_thick_surf (x, y, z [, options] ) + s = vrml_thick_surf (z + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +vrml_transfo + + +# name: +# type: sq_string +# elements: 1 +# length: 483 + v = vrml_transfo(s,t,r,c,d) + + s : string of vrml code. + t : 3 Translation default : [0,0,0] + r : 3x3 Rotation matrix, or default : eye(3) + 3 Scaled rotation axis. + c : 3 or 1 Scale default : 1 + d : string DEF name default : '' + + v : string v is s, enclosed in a Transform {} vrml node with + rotation, translation and scale params given by r, t and c. + + + + +# name: +# type: sq_string +# elements: 1 +# length: 63 + v = vrml_transfo(s,t,r,c,d) + + s : string of vrml code. + + + + + diff --git a/octave_packages/vrml-1.0.13/packinfo/.autoload b/octave_packages/vrml-1.0.13/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/vrml-1.0.13/packinfo/DESCRIPTION b/octave_packages/vrml-1.0.13/packinfo/DESCRIPTION new file mode 100644 index 0000000..36a856d --- /dev/null +++ b/octave_packages/vrml-1.0.13/packinfo/DESCRIPTION @@ -0,0 +1,12 @@ +Name: Vrml +Version: 1.0.13 +Date: 2012-06-18 +Author: Etienne Grossmann +Maintainer: Etienne Grossmann +Title: VRML. +Description: 3D graphics using VRML +Depends: octave (>= 2.9.7), linear-algebra, miscellaneous, struct, statistics +Autoload: yes +SystemRequirements: freewrl +License: GPLv3+, GFDL +Url: http://octave.sf.net diff --git a/octave_packages/vrml-1.0.13/packinfo/INDEX b/octave_packages/vrml-1.0.13/packinfo/INDEX new file mode 100644 index 0000000..e5f1948 --- /dev/null +++ b/octave_packages/vrml-1.0.13/packinfo/INDEX @@ -0,0 +1,38 @@ +vrml >> Vrml +3D visualization + vmesh + select_3D_points + vrml_browse + vrml_kill + vrml_anim +Create 3D objects + vrml_surf + vrml_points + vrml_select_points + vrml_faces + vrml_cyl + vrml_frame + vrml_flatten + vrml_transfo + vrml_Background + vrml_PointLight + vrml_text + vrml_arrow + vrml_lines + vrml_group +Support Functions + data2vrml + save_vrml + best_dir + best_dir_cov + proplan + bound_convex + vrml_DirectionalLight + vrml_ROUTE + vrml_TimeSensor + vrml_ellipsoid + vrml_interp + vrml_material + vrml_newname + vrml_parallelogram + vrml_thick_surf diff --git a/octave_packages/vrml-1.0.13/packinfo/NEWS b/octave_packages/vrml-1.0.13/packinfo/NEWS new file mode 100644 index 0000000..85711e9 --- /dev/null +++ b/octave_packages/vrml-1.0.13/packinfo/NEWS @@ -0,0 +1,32 @@ +Summary of important user-visible changes for vrml 1.0.13: +------------------------------------------------------------------- + + ** Credits: Thank you to Carnë Draug for explaining me the basics of the pkg system. + + ** The following functions are new: + + data2vrml + checker_color + vrml_Box + vrml_Sphere + vrml_parallelepiped + vrml_Viewpoint + + ** The following functions have been removed: + + select_3D_points + vrml_select_points + + ** Use of deprecated/removed functions have been fixed to work with later + Octave releases. + + ** The function `vmesh' is now able to handle vectors + + ** Some bug fixes on the function `vrml_cyl' and `vrml_material' to handles + colors correctly + + ** Package is no longer automatically loaded. + + ** The `linear-algebra' package is now a dependecy (altough not listed, + previous releases of `vrml' were also dependent on it so this is a + bugfix). diff --git a/octave_packages/vrml-1.0.13/proplan.m b/octave_packages/vrml-1.0.13/proplan.m new file mode 100644 index 0000000..6ddca6b --- /dev/null +++ b/octave_packages/vrml-1.0.13/proplan.m @@ -0,0 +1,35 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## x = proplan(x,d,v=1) +## +## orthogonally project x to the affine plane d*x == v + +function x = proplan(x,d,v) + +if exist("v")!=1, v = 1 ;end + +d = d(:) ; +N = prod(size(d)) ; # Assume x is NxP + +v = v/norm(d); +d = d/norm(d); + +p = (v*d)*ones(1,size(x,2)); + +x -= d*d'*(x-p) ; +# x = p + (eye(N)-d*d')*(x-p) ; +endfunction + diff --git a/octave_packages/vrml-1.0.13/save_vrml.m b/octave_packages/vrml-1.0.13/save_vrml.m new file mode 100644 index 0000000..5b4da7c --- /dev/null +++ b/octave_packages/vrml-1.0.13/save_vrml.m @@ -0,0 +1,119 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## save_vrml(outname,[options],s1,...) - Save vrml code +## +## Makes a vrml2 file from strings of vrml code. A "background" node is +## added. +## +## Options : +## "nobg" +## "nolight" +## +## Bugs : +## - "outname" should not contain the substring ".wrl" anywhere else +## than as a suffix. +## - "outname" should only contain the character ">" as ">>" at the +## beginning , to indicate append rather than overwriting the +## file. + +function save_vrml(outname, varargin) + +verbose = 0; +append = 0; + +if ! ischar(outname) , + error "save_vrml wants a string as first arg" +end + +if strcmp(outname(1:2),">>"), + append = 1; +end +outname = strrep(outname,">",""); + +outname = strrep(outname,".wrl",''); # No suffix. + +fname = sprintf("%s.wrl",outname); # Add suffix. +bg_col = [0.4 0.4 0.7]; +## bg_col = [1 1 1]; +l_intensity = 0.3 ; +l_ambientIntensity = 0.5 ; +l_direction = [0.57735 -0.57735 0.57735] ; + +bg_node = sprintf (["Background {\n",... + " skyColor %8.3g %8.3g %8.3g\n",... + "}\n"],\ + bg_col); +bg_node = ""; + +lightstr = sprintf (["PointLight {\n",\ + " intensity %8.3g\n",\ + " ambientIntensity %8.3g\n",\ + " direction %8.3g %8.3g %8.3g\n",\ + "}\n"],\ + l_intensity, l_ambientIntensity, l_direction); +lightstr = ""; + + # Read eventual options +ninit = nargin; + +i = 1; +args = nargin; # nargin is now a function +while --args, + + tmp = varargin{i++}; + if strcmp (tmp, "nobg"), + bg_node = ""; + elseif strcmp (tmp, "nolight"), + lightstr = ""; + else # Reached non-options + ## beginpre 2.1.39 + # va_start (); + # n = ++args ; + # while n++ < ninit, va_arg (); end + ## args, ninit + ## endpre 2.1.39 + i--; # pos 2.1.39 + break; + end +end +bg_node = [bg_node, lightstr]; +## No path. +if findstr(outname,"/"), + outname = outname(max(findstr(outname,"/"))+1:size(outname,2)) ; +end + +if append, fid = fopen(fname,"at"); # Saving. +else fid = fopen(fname,"wt"); +end ; + +if fid == -1 , error(sprintf("save_vrml : unable to open %s",fname)); end + +## Put header. +fprintf(fid,"#VRML V2.0 utf8 \n# %s , created by save_vrml.m on %s \n%s", + fname,datestr(now),bg_node); + +while i <= length (varargin) , + + if verbose, printf ("save_vrml : %i'th string\n",i); end + + fprintf (fid,"%s", varargin{i}) ; + i++ ; +end + +fprintf(fid,"\n"); +fclose(fid); +endfunction + diff --git a/octave_packages/vrml-1.0.13/test_moving_surf.m b/octave_packages/vrml-1.0.13/test_moving_surf.m new file mode 100644 index 0000000..8e3721f --- /dev/null +++ b/octave_packages/vrml-1.0.13/test_moving_surf.m @@ -0,0 +1,70 @@ +## Copyright (C) 2005-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +###key test_moving_surf +## +## Test vmesh.m + +R = 15; +C = 23; + +[x,y] = meshgrid (linspace (-1,1,C), linspace (-1,1,R)); + +z = (cos (x*2*pi) + 2*y.^2)/3; +z2 = (2*cos (x*2*pi) + y.^2)/3; + +a = [x(:),y(:),z(:)]'; +b = [x(:),y(:),z2(:)]'; + + +printf ("\ntest_changing_surf \n"); +if 1 + printf (" - display a moving surface\n"); + + s1 = vrml_surf (z,"DEFcoord","foo"); + + s2 = vrml_anim ("Coordinate",[a,b,a],"foo.set_point",[0 0.5 1],5); + + s3 = vrml_faces ([-1 -1 1 1;-1 1 1 -1;0.1 0.1 0.1 0.1], {[1 2 3 4]}, "tran",0.4,"col",[0.3 0.9 0.4]); + + vrml_browse ([s1,s2,s3]) + + printf ("Press a key. \n"); pause (); +end +if 1 + printf (" - display a moving surface w/ changing color\n"); + + c0 = rem ([1:R-1]'*ones(1,C-1) + ones(R-1,1)*[1:C-1],2)(:); + c1 = [0.8*c0 ,(1-c0)*0.8, 0.3*ones((R-1)*(C-1),1)]'; + c2 = [0.3*ones((R-1)*(C-1),1), c0*0.8, 0.8*(1-c0)]'; + + c1 = [3 9 3]'/10; + c2 = [3 3 9]'/10; + + s1 = vrml_surf (z,"DEFcol","bar","col",c1,"DEFcoord","foo"); + + [s2,tn] = vrml_anim ("Color",[c1,c2,c1],"bar.set_diffuseColor",[0 0.5 1],5); + + s4 = vrml_anim ("Coordinate",[a,b,a],"foo.set_point",[0 0.5 1],tn); + + s3 = vrml_faces ([-1 -1 1 1;-1 1 1 -1;0.1 0.1 0.1 0.1],\ + {[1 2 3 4]},"tran",0.4,"col",[0.9 0.4 0.4]); + + vrml_browse ([s1,s2,s3,s4]) + printf ("Press a key. \n"); pause (); +end + + + diff --git a/octave_packages/vrml-1.0.13/test_vmesh.m b/octave_packages/vrml-1.0.13/test_vmesh.m new file mode 100644 index 0000000..2b02809 --- /dev/null +++ b/octave_packages/vrml-1.0.13/test_vmesh.m @@ -0,0 +1,64 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +###key test_vmesh +## +## Test vmesh.m + +printf ("test_vmesh : \nDisplay a surface.\n"); + +R = 41; +C = 26; + +[x,y] = meshgrid (linspace (-1,1,C), linspace (-1,1,R)); + +z = (cos (x*2*pi) + y.^2)/3; + +vmesh (z); +printf ("Press a key.\n"); pause; + + +printf ("The same surface, with holes in it.\n"); + +z(3,3) = nan; # Bore a hole + # Bore more holes +z(1+floor(rand(1,5+R*C/30)*R*C)) = nan; + + # Try texture as a file, an "ims" or a + # matrix. +## tex = "octave-mylib/tools/imgio/test_images/test_col.xpm"; +## tex = ims_load ("octave-mylib/tools/imgio/test_images/test_col.jpg"); +## tex = kron (ones (4),eye(2)); + +vmesh (z); + +printf ("Press a key.\n"); pause; + +printf (["The same surface, with checkered stripes ",\ + "(see the 'checker' option).\n"]); + +vmesh (z,"checker",-[6,5]); + +printf ("Press a key.\n"); pause; + +printf (["The same surface, with z-dependent coloring (see 'zrb', 'zgrey'\n",\ + " and 'zcol' options)\n"]); + +vmesh (z,"zrb"); + +printf ("That's it!\n"); + + + diff --git a/octave_packages/vrml-1.0.13/test_vrml_faces.m b/octave_packages/vrml-1.0.13/test_vrml_faces.m new file mode 100644 index 0000000..b45e015 --- /dev/null +++ b/octave_packages/vrml-1.0.13/test_vrml_faces.m @@ -0,0 +1,125 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## Test that vrml_faces works with "tex" option + +1; + +## Tetrahedron : Vertices +x = [ 1 1 -1 0; + -1 1 0 0; + -1 -1 -1 1]; + +## Tetrahedron : Faces +trg = [1 2 3 1; + 2 3 1 2; + 4 4 4 3]; + +trgl = {[1 2 4],[2 3 4],[3 1 4],[1 2 3]}; + +slight = vrml_PointLight ("location", [0,5,0]); + +if 1 + s1 = vrml_faces (x, trg); + + printf ("Going to show a tetrahedron\n"); + + printf (["\n If nothing appears, it may be due to problems",\ + "\n with your FreeWRL installation\n"]); + vrml_browse ([slight, s1]); + printf ("Press a key in this terminal when done\n");pause; +end + +if 1 + s1 = vrml_faces (x, trgl,"col",[1,0.5,0.5]); + + printf ("Going to show almost the same tetrahedron\n"); + + printf (["\n If nothing appears, it may be due to problems",\ + "\n with your FreeWRL installation\n"]); + vrml_browse ([slight, s1]); + printf ("Press a key in this terminal when done\n");pause; +end + +if 1 + s1 = vrml_faces (x, trg, "col",[1 0 0 1;0 1 0 1;0 0 1 1]); + + printf ("Coloring the vertices\n"); + vrml_browse ([slight, s1]); + printf ("Press a key in this terminal when done\n");pause; +end +if 1 + s1 = vrml_faces (x, trg, "col",[1 0 0 1;0 1 0 1;0 0 1 1],"colorPerVertex",0); + + printf ("Coloring the faces\n"); + vrml_browse ([slight, s1]); + printf ("Press a key in this terminal when done\n");pause; +end + +## Texture : +H = 50; +W = 100; # Texture width +w = floor (W/2); +h = floor (H/2); +tr = tg = tb = zeros (H,W+1); +[j,i] = meshgrid (1:W+1,1:H); + +tr(find (i<=h & i*W>=j*H )) = 1; +tg(find (i> h & i*W>=(j+w)*H )) = 1; +tb(find (i> h & i*W>=j*H & j> w)) = 1; + + +if 0 + + if 1 + whiten = find(!(tr | tg | tb)); + tr(whiten) = 1; + tg(whiten) = 1; + tb(whiten) = 1; + end + + t0 = reshape (255*[tr;tg;tb], H,(W+1)*3); + t0 = t0 + 0.75 * rot90 (t0,2); + t0 = [t0, 0.5*t0]; + tex = mat2ims (t0,1); + +## ims_show (tex); + + + texfile = [pwd(),"/mytexfile.ppm"]; + ims_save (tex, texfile); + + s1 = vrml_faces (x, trg, "tex",texfile,"imsz",[H,W]); + s2 = vrml_faces (x, trg, "tex",texfile); + + printf (["Tetrahedrons should appear like (R=red, G=green, B=blue)\n\n",\ + " R 2\n",\ + " /\n",\ + " / G\n",\ + " G B /\n",\ + " 3--------4 B\n",\ + " R B \\\n",\ + " \\ R\n",\ + " G \\\n",\ + " 1\n"]); + + vrml_browse ([slight, s1, vrml_transfo(s2,[2,0,0])]); +end + + + + + + diff --git a/octave_packages/vrml-1.0.13/vmesh.m b/octave_packages/vrml-1.0.13/vmesh.m new file mode 100644 index 0000000..9d66988 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vmesh.m @@ -0,0 +1,287 @@ +## Copyright (C) 2002-2009 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vmesh (x, y, z [, options] ) - Visualize a 3D surface +## s = vmesh (z [, options] ) +## +## Visualizes a 3D surface. Returns the VRML code. +## +## x : RxC or C : X coordinates of the points on the surface +## y : RxC or R : Y " " +## z : RxC : Z " " +## +## s : string : The code +## +## If x and y are omitted, they are assumed to be linspace(-1,1,C or R). +## Points presenting one or more 'inf' or 'nan' coordinates are ignored. +## +## Options : (all options of vrml_surf may be used too) +## +## "col" , col : 3 : RGB Color, Default = [0.3,0.4,0.9] +## or 3x(R*C): Color of vertices (vrml colorPerVertex is TRUE). +## or 3x((R-1)*(C-1)) +## : Color of facets +## or 1 : Reflectivity (equivalent to [col,col,col] in RGB) +## or R x C : Reflectivity of vertices +## or 1x(R*C) +## or (R-1)x(C-1) +## or (R-1)*(C-1) +## : Reflectivity of facets. +## +## RGB and reflectivity values should be in the [0,1] interval. +## +## "checker", c : 1x2 : Color as a checker. If c(1) is positive, checker has +## c(1) rows. If it is negative, each checker row is +## c(1) facets high. c(2) does the same for columns. +## or 1x1 : Same as [c,c]. +## +## "zgray" : Color varies from black for lowest point to white +## for highest. +## +## "zrb" : Color varies from blue for lowest point to red for +## highest. +## +## "zcol", zcol : Mx3 : Color is linearly interpolated between the RGB +## values specified by the rows of zcol. +## +## "steps" : Represent surface as a piecewise constant Z = f(X,Y) +## function +## +## "bars" : Represent surface as a bar plot +## "bwid" : Bar width, relative to point separation. Default = 2/3 +## +## "level", l : 1xN : Display one or more horizontal translucent plane(s) +## +## z == l(i) (1 <= i <= length(l)) +## +## "lcol", lc : Nx3 : Color of the plane(s). Default = [.7 .7 .7] +## "ltran",lt : Nx1 : Transparency of the plane(s). Default = 0.3 +## "tex", texFile +## +## "normalize" : Normalize z to [-1,1] +## +## See also: vrml_surf(), vrml_faces(), demo("vmesh") + +function s = vmesh (x, y, z, varargin) + +level = []; +lcol = [7 7 7]/10; +ltran = 0.3; +normalize = 0; + +if (nargin <= 1) || ischar(y), # Cruft to allow not passing x and y + zz = x ; + [R,C] = size (zz); + [xx,yy] = meshgrid (linspace (-1,1,C), linspace (-1,1,R)); + + if nargin >= 3 + varargin = {y, z, varargin{:}}; + elseif nargin >= 2 + varargin = {y, varargin{:}}; + end +## if nargin >=3, +## s = vmesh ( xx, yy, zz, y, z, varargin{:} ); +## if ! nargout, clear s; end; return +## elseif nargin >=2, +## s = vmesh ( xx, yy, zz, y, varargin{:} ); +## if ! nargout, clear s; end; return +## end + x = xx ; y = yy ; z = zz ; +end + +frame = 1; + +## surf_args = list (x,y,z); # Arguments that'll be passed to vrml_surf +surf_args = {x,y,z}; # Arguments that'll be passed to vrml_surf + +if numel (varargin) + + op1 = [" tran col checker creaseAngle emit colorPerVertex tex zcol frame ",\ + " level lcol ltran bwid "]; + op0 = " smooth zgray zrb normalize steps bars "; + + df = tars (level, lcol, ltran, normalize, frame); + + opts = read_options (varargin,"op0",op0,"op1",op1,"default",df); + + # Identify options for vrml_surf() +# all_surf_opts = list ("tran", "col", "checker", "creaseAngle", "emit", \ +# "colorPerVertex", "smooth", "tex",\ +# "zgray","zrb","zcol"); + all_surf_opts = {"tran", "col", "checker", "creaseAngle", "emit", \ + "colorPerVertex", "smooth", "steps", "bars", "bwid", "tex",\ + "zgray","zrb","zcol"}; + + for i = 1:length(all_surf_opts) + optname = all_surf_opts{i}; + if isfield (opts, optname) + ## surf_args = append (surf_args, list (optname)); + surf_args{length(surf_args)+1} = optname; + if index (op1,[" ",optname," "]) + ## surf_args = append (surf_args, list(opts.(optname))); + surf_args{length(surf_args)+1} = opts.(optname); + end + end + end + lcol = opts.lcol; + level = opts.level; + ltran = opts.ltran; + frame = opts.frame; + normalize = opts.normalize; +end + +if normalize + x -= nanmean (x(:)); + y -= nanmean (y(:)); + z -= nanmean (z(:)); + + datascl = nanmax (abs([z(:);y(:);x(:)])); + + x /= datascl; + y /= datascl; + z /= datascl; + # Put back z in surf_args + surf_args{1} = x; + surf_args{2} = y; + surf_args{3} = z; +end + +s = vrml_surf (surf_args{:}); + +if numel (x) == columns (z) + x = ones(rows(z),1) * x(:)'; +else + assert (numel (x) == numel (z)); +end +if numel (y) == rows (z) + y = y(:) * ones(1,columns(z)); +else + assert (numel (y) == numel (z)); +end + +pts = [x(:)';y(:)';z(:)']; +ii = find (all (isfinite (pts))); +pt2 = pts(:,ii); x2 = x(ii); y2 = y(ii); z2 = z(ii); + +## Add a point light + +# scl = max (max(pt2') - min(pt2')); + +# lpos = [min(x2) - 0.5*scl, mean(y2), max(z2)+scl] +# pl1 = vrml_PointLight ("location", lpos, "intensity", 0.7); + +# lpos = [mean(x2), min(y2) - 0.5*scl, max(z2)+scl] +# pl2 = vrml_PointLight ("location", lpos, "intensity", 0.7); + +# pl = [pl1 pl2]; + +pl = [vrml_DirectionalLight("direction",[-1,-1,-1],"intensity",0.75),\ + vrml_DirectionalLight("direction",[-1, 1,-1],"intensity",0.5),\ + vrml_DirectionalLight("direction",[ 1,-1,-1],"intensity",0.5),\ + vrml_DirectionalLight("direction",[ 1, 1,-1],"intensity",0.33),\ + vrml_DirectionalLight("direction",[ 0, 0, 1],"intensity",0.5)]; + +# distance = max ([max (x(:)) - min (x(:)),\ +# max (y(:)) - min (y(:)),\ +# max (z(:)) - min (z(:))]) +# vp = vrml_Viewpoint ("orientation", [1 0 0 -pi/6],\ +# "position", distance*[0 0 5]); + +minpts = min (pt2'); +maxpts = max (pt2'); +medpts = (minpts + maxpts)/2; +ptssz = (maxpts - minpts); +ptssz = max (ptssz, max (ptssz/10)); + +if frame, fr = vrml_frame (minpts-ptssz/10,\ + "scale", ptssz * 1.2, "col",(ones(3)+eye(3))/2); +else fr = ""; +end + +sbg = vrml_Background ("skyColor", [0.5 0.5 0.6]); + +slevel = ""; +if ! isempty (level) + level = level(:)'; # Make a row + nlev = length (level); + + xmin = min (x(:)); xmax = max (x(:)); + ymin = min (y(:)); ymax = max (y(:)); + + if any (size (lcol) != [nlev,3]) + nlc = prod (szlc = size (lcol)); + # Transpose colors + if all (szlc == [3,nlev]), lcol = lcol'; + # Single gray level + elseif nlc == 1 , lcol = lcol * ones (nlev,3); + # nlev gray levels + elseif nlc == nlev , lcol = lcol(:)*[1 1 1]; + elseif nlc == 3 , lcol = ones(nlev,1)*lcol(:)'; + else error ("lcol has size %i x %i",szlc); + end + end + if prod (size (ltran)) == 1 , ltran = ltran*ones(1,nlev); end + + for i = 1:nlev + slevel = [slevel, \ + vrml_parallelogram([xmin xmin xmax xmax;\ + ymin ymax ymax ymin;\ + level(i) level(i) level(i) level(i)],\ + "col",lcol(i,:),"tran",ltran(i))]; + end +end + +s = [pl, sbg, s , fr, slevel]; + + + +if ! nargout, + vrml_browse (s); + clear s; +end + +%!demo +%! % Test the vmesh and vrml_browse functions with the test_vmesh script +%! R = 41; C = 26; +%! [x,y] = meshgrid (linspace (-8+eps,8+eps,C), linspace (-8+eps,8+eps,R)); +%! z = sin (sqrt (x.^2 + y.^2)) ./ (sqrt (x.^2 + y.^2)); +%! vmesh (z); +%! printf ("Press a key.\n"); pause; +%! +%! ############## The same surface, with holes (NaN's) in it. ############### +%! z(3,3) = nan; # Bore a hole +%! # Bore more holes +%! z(1+floor(rand(1,5+R*C/30)*R*C)) = nan; +%! vmesh (z); +%! printf ("Press a key.\n"); pause; +%! +%! ###### The same surface, with checkered stripes - 'checker' option ###### +%! vmesh (z,"checker",-[6,5]); +%! printf ("Press a key.\n"); pause; +%! +%! ##### With z-dependent coloring - 'zrb', 'zgray' and'zcol' options. ##### +%! vmesh (z,"zrb"); +%! printf ("That's it!\n"); + + + + +## %! test_vmesh + +return + +endfunction + + diff --git a/octave_packages/vrml-1.0.13/vrml_Background.m b/octave_packages/vrml-1.0.13/vrml_Background.m new file mode 100644 index 0000000..d57eaee --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_Background.m @@ -0,0 +1,84 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_Background (...) - Vrml Background node +## +## s is a string of the form : +## ------------------------------------------------------------------ +## Background { +## skyColor [0 0 0] +## skyAngle [0] +## groundColor [0 0 0] +## groundangle [0] +## backUrl "" +## bottomUrl "" +## frontUrl "" +## leftUrl "" +## rightUrl "" +## topUrl "" +## } +## ------------------------------------------------------------------ +## +## Options : +## All the fields of the node +## +## Example : s = vrml_Background ("skyColor",[0 0 1]); +## + +function s = vrml_Background (varargin) + +hash = struct(varargin{:}); + +opts = struct ("skyColor", 3, + "groundColor", 3, + "skyAngle", 1, + "groundAngle", 1, + "backUrl", 0, + "bottomUrl", 0, + "frontUrl", 0, + "leftUrl", 0, + "rightUrl", 0, + "topUrl", 0); + +body = ""; +for [val,key] = hash, + if isfield (opts, key) + n = opts.(key); + if (n == 0) + if (ischar(val)) + body = [ body, sprintf(' %-20s "%s"\n', key, val) ]; + else + error ("vrml_Background: field '%s' expects string", key); + endif + elseif (n == 1) + if (isscalar(val)) + body = [ body, sprintf(' %-20s [ %8.3f ]\n', key, val) ]; + else + error ("vrml_Background: field '%s' expects scalar", key); + endif + else + if (isvector(val) && length(val) == 3) + body = [body, sprintf(' %-20s [ %8.3f %8.3f %8.3f ]\n', key, val)]; + else + error ("vrml_Background: field '%s' expects [r g b]", key); + endif + endif + else + error ("vrml_Background : unknown field '%s'",key); + end +end +s = sprintf ("Background { \n%s}\n", body); +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_Box.m b/octave_packages/vrml-1.0.13/vrml_Box.m new file mode 100644 index 0000000..1a81a38 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_Box.m @@ -0,0 +1,34 @@ +## Copyright (C) 2010-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_Box (sz) - Box { ... } node +## +## If sz is not given, returns Box { } +## If sz has size 1, returns Box { } +## If sz has size 3, returns Box { } + +function s = vrml_Box (sz) + +if nargin < 1, sz = []; end +if length (sz) == 1, sz = sz * [1 1 1]; end +if !isempty (sz) + assert (numel (sz) == 3); + ssz = sprintf ("\n size %f %f %f\n",sz); +else + ssz = ""; +end + +s = ["Box {",ssz,"}\n"]; + diff --git a/octave_packages/vrml-1.0.13/vrml_DirectionalLight.m b/octave_packages/vrml-1.0.13/vrml_DirectionalLight.m new file mode 100644 index 0000000..3bf52f8 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_DirectionalLight.m @@ -0,0 +1,65 @@ +## Copyright (C) 2005-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_DirectionalLight (...) - Vrml DirectionalLight node +## +## s is a string of the form : +## ------------------------------------------------------------------ +## DirectionalLight { +## exposedField SFFloat ambientIntensity 0 # [0,1] +## exposedField SFColor color 1 1 1 # [0,1] +## exposedField SFVec3f direction 0 0 -1 # (-,) +## exposedField SFFloat intensity 1 # [0,1] +## exposedField SFBool on TRUE +## } +## ------------------------------------------------------------------ +## +## Options : +## All the fields of the node +## +## See also : vrml_PointLight + +function s = vrml_DirectionalLight (varargin) # pos 2.1.39 + + +hash = struct (); +for k=1:2:nargin, + hash = setfield(hash,varargin{k:k+1}); +end + +tpl = struct ("ambientIntensity", "%8.3f",\ + "intensity", "%8.3f",\ + "direction", "%8.3f",\ + "on", "%s",\ + "color", "%8.3f %8.3f %8.3f"); + +body = ""; +for [val,key] = hash, + + if !(isnumeric(val) && isnan (val)), + + # Check validity of field + if !isfield (tpl, key) + error (sprintf ("vrml_PointLight : unknown field '%s'",key)); + end + + body = [body,\ + sprintf(" %-20s %s\n",key, + sprintf(getfield (tpl,key), val))]; + end +end +s = sprintf ("DirectionalLight { \n%s}\n", body); +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_PointLight.m b/octave_packages/vrml-1.0.13/vrml_PointLight.m new file mode 100644 index 0000000..c035ff9 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_PointLight.m @@ -0,0 +1,74 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_PointLight (...) - Vrml PointLight node +## +## s is a string of the form : +## ------------------------------------------------------------------ +## PointLight { +## exposedField SFFloat ambientIntensity 0 ## [0,1] +## exposedField SFVec3f attenuation 1 0 0 ## [0,inf) +## exposedField SFColor color 1 1 1 ## [0,1] +## exposedField SFFloat intensity 1 ## [0,1] +## exposedField SFVec3f location 0 0 0 ## (-inf,inf) +## exposedField SFBool on TRUE +## exposedField SFFloat radius 100 ## [0,inf) +## } +## ------------------------------------------------------------------ +## +## Options : +## All the fields of the node +## +## Example : s = vrml_PointLight ("location",[0 0 1]); +## +## See also : vrml_DirectionalLight + +function s = vrml_PointLight (varargin) + +if mod(nargin,2) != 0, print_usage; end +h = struct (varargin{:}); + +tpl = struct ("ambientIntensity", "%8.3f",\ + "intensity", "%8.3f",\ + "radius", "%8.3f",\ + "on", "%s",\ + "attenuation", "%8.3f %8.3f %8.3f",\ + "color", "%8.3f %8.3f %8.3f",\ + "location", "%8.3f %8.3f %8.3f"); + +body = ""; +for [val,key] = h, + + if strcmp (key, "DEF") + continue; + elseif !(isnumeric(val) && isnan (val)) + + # Check validity of field + if ! isfield (tpl, key) + error (sprintf ("vrml_PointLight : unknown field '%s'",key)); + end + + + body = [body,\ + sprintf(" %-20s %s\n",key, \ + sprintf (getfield (tpl,key), val))]; + end +end +s = sprintf ("PointLight {\n%s}\n", body); +if isfield (h,"DEF") && !isempty (h.DEF) + s = ["DEF ",h.DEF," ",s]; +end +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_ROUTE.m b/octave_packages/vrml-1.0.13/vrml_ROUTE.m new file mode 100644 index 0000000..0ac1963 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_ROUTE.m @@ -0,0 +1,20 @@ +## Copyright (C) 2005-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## vrml_ROUTE (eventout, eventin) +function s = vrml_ROUTE (eventout, eventin) + +s = sprintf ("ROUTE %s TO %s\n",eventout, eventin);endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_Sphere.m b/octave_packages/vrml-1.0.13/vrml_Sphere.m new file mode 100644 index 0000000..00ef952 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_Sphere.m @@ -0,0 +1,30 @@ +## Copyright (C) 2010-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_Sphere (radius) - VRML code for a sphere + +function s = vrml_Sphere (sz) + +if nargin < 1, sz = []; end + +if !isempty (sz) + assert (numel (sz) == 1); + ssz = sprintf ("\n radius %f\n",sz); +else + ssz = ""; +end + +s = ["Sphere {",ssz,"}\n"]; + diff --git a/octave_packages/vrml-1.0.13/vrml_TimeSensor.m b/octave_packages/vrml-1.0.13/vrml_TimeSensor.m new file mode 100644 index 0000000..1acdb2f --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_TimeSensor.m @@ -0,0 +1,162 @@ +## Copyright (C) 2005-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_TimeSensor (...) - Low-level vrml TimeSensor node +## +## s is a vrml node with possible fields : +## ------------------------------------------------------------------ +## TimeSensor { +## exposedField SFTime cycleInterval 1 # (0,inf) +## exposedField SFBool enabled TRUE +## exposedField SFBool loop FALSE +## exposedField SFTime startTime 0 # (-inf,inf) +## exposedField SFTime stopTime 0 # (-inf,inf) +## eventOut SFTime cycleTime +## eventOut SFFloat fraction_changed # [0, 1] +## eventOut SFBool isActive +## eventOut SFTime time +## } +## ------------------------------------------------------------------ +## +## Options : +## Beyond all the fields of the node, it is also possible to use the option +## +## "DEF", name : The created node will be preceded by 'DEF name ', so that +## it is further possible to refer to it. +## +## See also : + +function s = vrml_TimeSensor (varargin) + +verbose = 0; + +tpl = struct ("cycleInterval", "SFTime",\ +"startTime", "SFTime",\ +"stopTime", "SFTime",\ +"enabled", "SFBool",\ +"loop", "SFBool" +); + +headpar = {}; +dnode = struct (); + + # Transform varargin into key-value pairs +i = j = k = 1; # i:pos in new varargin, j:pos in headpar, + # k:pos is old varargin. +while i <= length (varargin) && \ + ! (ischar (varargin{i}) && isfield (tpl, varargin{i})) + + if j <= length (headpar) + + if verbose + printf ("vrml_TimeSensor : Assume arg %i is '%s'\n",k,headpar{j}); + end + + ##varargin = splice (varargin, i, 0, headpar(j)); + varargin = {varargin{1:i-1}, headpar(j), varargin{i:end}}; + j ++; + i += 2; + k++; + else + error ("vrml_TimeSensor : Argument %i should be string, not '%s'",\ + k,typeinfo (varargin{i})); + end +end + +DEF = 0; + +if rem (length (varargin), 2), error ("vrml_TimeSensor : Odd n. of arguments"); end + +l = {"TimeSensor {\n"}; +i = 1; +while i < length (varargin) + + k = varargin{i++}; # Read key + + if ! ischar (k) + error ("vrml_TimeSensor : Arg n. %i should be a string, not a %s.",\ + i-1, typeinfo (k)); + end + if ! isfield (tpl, k) && ! strcmp (k,"DEF") + error ("vrml_TimeSensor : Unknown field '%s'. Should be one of :\n%s",\ + k, sprintf (" '%s'\n",fieldnames (tpl)'{:})); + end + + v = varargin{i++}; # Read value + # Add DEF + if strcmp (k,"DEF") + + if verbose, printf ("vrml_TimeSensor : Defining node '%s'\n",v); end + + if DEF, error ("vrml_TimeSensor : Multiple DEFs found"); end + l = {sprintf("DEF %s ", v), l{:}}; + DEF = 1; + + else # Add data field + + if verbose + printf ("vrml_TimeSensor : Adding '%s' of type %s, with arg of type %s\n",\ + k,getfield(tpl,k),typeinfo (v)); + end + tmp = getfield(tpl,k); + if strcmp (tmp(2:end), "FNode") + + if verbose, printf ("vrml_TimeSensor : Trying to learn type of node\n"); end + + if iscell (v) # v is list of arguments + + # Check whether 1st arg is node type's name. + n = v{1}; + + if all (exist (["vrml_",tn]) != [2,3,5]) + # If it isn't type's name, use default type. + if isfield (dnode, k) + if verbose + printf ("vrml_TimeSensor : Using default type : %s\n",getfield(dnode,k)); + end + v = {getfield(dnode,k), v{:}}; + else + error ("vrml_TimeSensor : Can't determine type of node '%s'",k); + end + else + if verbose + printf ("vrml_TimeSensor : 1st list element is type : %s\n",tn); + end + end + # If v is not a list, maybe it has a default + # node type type (otherwise, it's be sent + # plain. + elseif isfield (dnode, k) + if verbose + printf ("vrml_TimeSensor : Using default type : %s\n",dnode.(k)); + end + v = {getfield(dnode,k), v{:}}; + end + end + l = {l{:}, k, " ", data2vrml(getfield(tpl,k),v),"\n"}; + end + +end + +l{end+1} = "}\n"; + +s = ""; +for i=1:numel(l) + s = [s, sprintf(l{i})]; +endfor +### Stupid strcat removes trailing spaces in l's elements +### s = strcat (l{:}); +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_Viewpoint.m b/octave_packages/vrml-1.0.13/vrml_Viewpoint.m new file mode 100644 index 0000000..66dc73d --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_Viewpoint.m @@ -0,0 +1,126 @@ +## Copyright (C) 2010 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_Viewpoint (...) - Vrml Viewpoint node +## +## s is a string of the form : +## ------------------------------------------------------------------ +## Viewpoint { +## eventIn SFBool set_bind +## exposedField SFFloat fieldOfView 0.785398 # (0,pi) +## exposedField SFBool jump TRUE +## exposedField SFRotation orientation 0 0 1 0 # [-1,1],(-pi,pi) +## exposedField SFVec3f position 0 0 10 # (-,) +## field SFString description "" +## eventOut SFTime bindTime +## eventOut SFBool isBound +## } +## ------------------------------------------------------------------ +## +## Options : +## All the fields of the node +## +## Example : s = vrml_Viewpoint ("location",[0 0 1]); +## +## See also : vrml_DirectionalLight + +function s = vrml_Viewpoint (varargin) + +if mod(nargin,2) != 0, print_usage; end + +h = struct (varargin{:}); + +tpl = struct ("fieldOfView", "%8.3f",\ + "jump", "%s",\ + "orientation", "%8.3f %8.3f %8.3f %8.3f",\ + "orientation0", "%8.3f %8.3f %8.3f %8.3f",\ + "position", "%8.3f %8.3f %8.3f",\ + "description", "\"%s\"",\ + "DEF", ""); +DEF = ""; +defaultPos = [0 0 10]; + +for [val,key] = h + if ! isfield (tpl, key) + error (sprintf ("vrml_Viewpoint : unknown field '%s'",key)); + end +end +if isfield (h, "DEF") + DEF = h.DEF; + h = rmfield (h, "DEF"); +end + +if isfield (h, "orientation0") + + o = h.orientation0; + if numel (o) == 3 + o = [o(:)'/norm(o), norm(o)]; + elseif numel (o) == 4 + o(4) = sign(o(4)) * rem (abs (o(4)), pi); + o = [o(1:3)(:)'/norm(o(1:3)), o(4)]; + else + error ("Option 'orientation0' has size %i, should be 3 or 4", numel(o)); + endif + + if isfield (h, "position") + p = h.position(:); + else + p = defaultPos(:); + end + + h = rmfield (h, "orientation0"); + + h.orientation = o; + h.position = rotv (o(1:3), o(4))' * p; + +elseif isfield (h, "orientation") + + o = h.orientation; + if numel (o) == 3 + o = [o(:)'/norm(o), norm(o)]; + elseif numel (o) == 4 + o(4) = sign(o(4)) * rem (abs (o(4)), pi); + o = [o(1:3)(:)'/norm(o(1:3)), o(4)]; + else + error ("Option 'orientation' has size %i, should be 3 or 4", numel(o)); + endif + h.orientation = o; +end + +if isfield (h, "position") && numel (h.position) != 3 + error ("Option 'position' has size %i, should be 3", numel (h.position)); +endif + +if isfield (h, "jump") + if h.jump + h.jump = "TRUE"; + else + h.jump = "FALSE"; + endif +endif + +body = ""; +for [val, key] = h + body = [body,\ + sprintf(" %-20s %s\n",key, \ + sprintf (getfield (tpl,key), val))]; +end + +s = sprintf ("Viewpoint {\n%s}\n", body); +if !isempty (DEF) + s = ["DEF ", DEF," ",s]; +end +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_anim.m b/octave_packages/vrml-1.0.13/vrml_anim.m new file mode 100644 index 0000000..39b0ef0 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_anim.m @@ -0,0 +1,45 @@ +## Copyright (C) 2005-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_anim (typ, val, eventin, time) +## +## Assemble +## - an interpolator of type typ, with values val +## - a TimeSensor with period time +## and route the event to eventin +## +function [s,tname] = vrml_anim (typ, val, eventin, key, period) + +if nargin < 4, key = [0 1]; end +if nargin < 5, period = 5; end + +iname = vrml_newname (); + +si = vrml_interp (typ, val,"key",key, "DEF",iname); +if isnumeric (period) + tname = vrml_newname (); + st = vrml_TimeSensor ("cycleInterval",period,"loop",1,"DEF",tname); + +else # Use previously declared TimeSensor + tname = period; + st = ""; +end + +sr = vrml_ROUTE ([tname,".fraction_changed"],[iname,".set_fraction"]); +sr2 = vrml_ROUTE ([iname,".value_changed"],eventin); + +s = [si, st, sr, sr2]; +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_arrow.m b/octave_packages/vrml-1.0.13/vrml_arrow.m new file mode 100644 index 0000000..949fd95 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_arrow.m @@ -0,0 +1,118 @@ +## Copyright (C) 2002-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_arrow (sz, col) - Arrow pointing in "y" direction +## +## INPUT : +## ------- +## Arguments are optional. NaN's are replaced by default values. +## +## sz = [len, alen, dc, dr] has size 1, 2, 3 or 4, where +## +## len : total length <1> +## alen : If positive: length of cone/total length <1/4> +## If negative: -(length of cone) +## dc : If positive: diameter of cone base/total len <1/16> +## If negative: -(diameter of cone) +## dr : If positive: diameter of rod/total length +## If negative: -(diameter of rod) +## +## col : 3 or 3x2 : Color of body and cone <[0.3 0.4 0.9]> +## +## OUTPUT : +## -------- +## s : string : vrml representation of an arrow (a rod and a cone) + +function v = vrml_arrow (sz, col, emit) + +if nargin < 3, emit = 1; end + +if nargin<2 || isempty (col), col = [0.3 0.4 0.9;0.3 0.4 0.9]; +elseif prod (size (col)) == 3, col = [1;1]*col(:)'; +elseif all (size (col) == [3,2]), col = col'; +elseif any (size (col) != [2,3]), + error("vrml_arrow : col has size %dx%d (should be 3 or 3x2)\n",size(col)); + ## keyboard +end +col = col' ; + +s0 = [1, 1/4, 1/16, 1/32]; + # Get absolute size +if nargin<1 || isempty (sz) || isnan (sz), sz = s0 ; +elseif length (sz) == 4, sz = [sz(1),sz(2),sz(3),sz(4)]; +elseif length (sz) == 3, sz = [sz(1),sz(2),sz(3),s0(4)]; +elseif length (sz) == 2, sz = [sz(1),sz(2),s0(3),s0(4)]; +elseif length (sz) == 1, sz = [sz(1),s0(2),s0(3),s0(4)]; +else + error ("vrml_arrow : sz has size %dx%d. (should be in 1-4)\n", size(sz)); + ## keyboard +end + +assert (sz(1) > 0) + +if !isempty (tmp = find(isnan(sz))), sz(tmp) = s0(tmp) ; end + +for i = 2:4 + if sz(i) >= 0 + sz(i) *= sz(1); + else + sz(i) = -sz(i); + endif +endfor + + # Do material nodes +smat1 = vrml_material (col(:,1), emit); +smat2 = vrml_material (col(:,2), emit); + +v = sprintf (["Group {\n",\ + " children [\n",\ + " Transform {\n",\ + " translation %8.3g %8.3g %8.3g\n",\ + " children [\n",\ + " Shape {\n",\ + " appearance Appearance {\n",\ + smat1,\ + " }\n"\ + " geometry Cylinder {\n",\ + " radius %8.3g\n",\ + " height %8.3g\n",\ + " }\n",\ + " }\n",\ + " ]\n",\ + " }\n",\ + " Transform {\n",\ + " translation %8.3g %8.3g %8.3g\n",\ + " children [\n",\ + " Shape {\n",\ + " appearance Appearance {\n",\ + smat2,\ + " }\n",\ + " geometry Cone { \n",\ + " bottomRadius %8.3g \n",\ + " height %8.3g\n",\ + " }\n",\ + " }\n",\ + " ]\n",\ + " }\n",\ + " ]\n",\ + "}\n"],\ + [0,(sz(1)-sz(2))/2,0],\ + sz(4),\ + sz(1)-sz(2),\ + [0,sz(2)/2+sz(1)-sz(2),0],\ + sz(3),\ + sz(2)); +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_browse.m b/octave_packages/vrml-1.0.13/vrml_browse.m new file mode 100644 index 0000000..72b5756 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_browse.m @@ -0,0 +1,234 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## p = vrml_browse ([s]) - View vrml code s with FreeWRL +## vrml_browse ("-kill") - Kill the browser +## +## s : string : VRML code, as returned by the vrml_XYZ functions. +## If s is not specified, a sombrero is showed +## +## p : int : pid of the current browser. If freewrl has not been started +## or has died, a new one is started. p is zero or negative in +## case of failure to start freewrl. +## +## Some keystrokes for FreeWRL (more in the freewrl manpage) : +## +## 'e' : Examine : mouse 1 and drag rotates the scene +## mouse 3 and drag moves closer/farther +## 'w' : Walk : mouse 1 and drag moves for/backward, turns +## mouse 3 and drag translates parallel to the screen +## 's' : Save a snapshot in files 'octave.snapshot.NNNN.ppm' +## 'q' : Quit +## +## WARNING : FreeWRL >0.25 (http://www.crc.ca/FreeWRL/) must be installed. +## +## BUG : The vrml browser is not killed when octave exits. Sometimes the +## vrml browser does not get raised or gets raised improperly +## (shows the contents of the topmost window above it). Use +## "-kill". + +function p = vrml_browse (varargin) + +verbose = 0; + +best_option = " "; + # Allow scripting and specify where + # browser's output goes +##out_option = "--ps --psout /tmp/octave_browser_out.txt " ; +out_option = " " ; +geo_option = " " ; +global vrml_b_pid = 0; +global vrml_b_name = []; + +p = vrml_b_pid ; +bop = ""; +go_to_bg = 0; + +if nargin<1 + s = ""; +else + i = 1; + while i <= length (varargin) + o = varargin{i++}; + if strcmp (o, "-kill") + vrml_kill(); return; + elseif strcmp (o, "-bop") # Browser options + bop = [bop," ",varargin{i++}," "]; + elseif strcmp (o, "-bg") # Browser options + go_to_bg = 1; + elseif strcmp (o, "-geometry") # Browser options + geo_option = varargin{i++}; + if !ischar (geo_option) + assert (length (geo_option) == 2) + geo_option = sprintf ("--geometry %ix%i",geo_option); + else + geo_option = sprintf ("--geometry %s",geo_option); + end + end + end + s = varargin{length (varargin)}; +end + +if ! index (s, "Background") + s = [s, vrml_Background("skyColor",[.7 .7 .9])]; +end + + +vrml_b_name = "whitedune" ; +##vrml_b_name = "/home/etienne/bin/my_freewrl.sh"; + +##b_opt = [out_option," ",bop," ",best_option," --server --snapb octave.snap "] +##; +##b_opt = [out_option," ",bop," ",best_option," --server "] ; +##b_opt = [out_option," ",bop," ",best_option," --snapb octave_freewrl_snapshots "] ; +b_opt = [out_option," ",bop," ",best_option, " ",geo_option] ; + + +b_temp = "/tmp/octave_vrml_output.wrl" ; +b_log = " &> /tmp/octave_vrml_browser.log"; + +new_browser = 0 ; + # #################################### +if vrml_b_pid > 0 # There's already a browser ########## + + # Check that browser is really alive + + [status, dum] = system (sprintf ("kill -CONT %d &> /dev/null",vrml_b_pid)); + + if ! status + if verbose + printf ( "vrml_browse : browser pid=%d is still alive\n",vrml_b_pid); + end + else + if verbose + printf ( ["vrml_browse : ",\ + "browser pid=%d died. I'll spawn another\n"], vrml_b_pid); + end + vrml_b_pid = -1 ; + end +end # End of check if old browser's alive + # #################################### + + # #################################### + # Check that temp file exists ######## +[status, dum] = system (["test -e ",b_temp]); +if !length (s) + + if verbose + printf( "vrml_browse : Trying to create temp file\n"); + end + # Do a sombrero + n = 30 ; + x = y = linspace (-8, 8, n)'; + [xx, yy] = meshgrid (x, y); + r = sqrt (xx .^ 2 + yy .^ 2) + eps; + z = 3*sin (r) ./ (2*r); + x /= 4 ; y /= 4 ; + + ## pix = ones (n) ; + ## tmp = [1 0 0 1 1 1 0 0 1 1 0 0 0 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 0 ;\ + ## 0 1 1 0 1 0 1 1 0 1 1 1 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 1 1 ;\ + ## 0 1 1 0 1 0 1 1 1 1 1 1 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 0 0 ;\ + ## 0 1 1 0 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 1 1 ;\ + ## 1 0 0 1 1 1 0 0 1 1 1 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 1 0 0 0 ]; + + ## rtmp = rows(tmp)+2; + ## for i=1:rtmp:n-rtmp, + ## pix(i+[1:rows(tmp)],1:columns(tmp)) = tmp ; + ## end + ## pix = flipud (pix); + ## col = [1;1;1]*pix(:)' ; + ## keyboard + rmat = [0.90000 -0.38730 0.20000; + 0.38730 0.50000 -0.77460; + 0.20000 0.77460 0.60000]; + ## s = vrml_points ([x(:),y(:),z(:)],"balls"); + ## s = vrml_transfo (vrml_thick_surf (x,y,z, "col",col), [0.25,0,0],rmat); + s = vrml_transfo (vrml_thick_surf (x,y,z), [0.25,0,0],rmat ); +end + + +save_vrml (b_temp, s); # "nobg", s) ; + # End of preparing temp file ######### + # #################################### + + # #################################### + # Eventually start browser ########### +if vrml_b_pid <= 0 + new_browser = 1 ; + if verbose, + printf( "vrml_browse : spawning browser ...\n"); + end + ## keyboard + # Starting a background browser : + # + # popen2 seems broken. + # popen had some problem, can't recall what + # system "async" does not give me pid of + # browser, but pid of shell + # system "sync" only returns when child + # process has exited + # + # So my solution is : "system" a process that + # forks. Its child is a browser. The parent + # prints the child's pid (given by fork()) + # and exits. Octave reads the output of the + # system call, which is the browser's pid. + # Phew! + if 1 + cmd = [vrml_b_name," ",b_opt," ",b_temp," "] +## [status, out] = system (cmd = [vrml_b_name," ",b_opt," \"file:",b_temp,"\""], 1); + [status, out] = system (cmd = [vrml_b_name," ",b_opt," ",b_temp], 1); + ## cmd + if status, + + printf("vrml_browse : Can't start browser '%s'. Is it installed?\n",\ + vrml_b_name); + p = vrml_b_pid ; + return ; + else + + vrml_b_pid = -1; + server_works = 0; + end + if server_works + vrml_b_pid = str2num (out); + end + + if verbose, printf( "vrml_browse : OK\n"); end + end + +end # End of starting new browser ######## + # #################################### + +if (!new_browser) && (vrml_b_pid > 1) + # #################################### + # Send USR1 signal to browser to tell it to + # raise itself. + [status, dum] = system (sprintf ("kill -USR1 %d &> /dev/null",vrml_b_pid)); + + if status, + printf ("vrml_browse : browser pid=%d can't be signaled\n",vrml_b_pid); + else + if verbose, + printf( ["vrml_browse : USR1 sent to browser pid=%d\n"], vrml_b_pid); + end + end +end # End of signaling browser ########## + # #################################### + +p = vrml_b_pid ; +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_cyl.m b/octave_packages/vrml-1.0.13/vrml_cyl.m new file mode 100644 index 0000000..dadf47c --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_cyl.m @@ -0,0 +1,146 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_cyl(x,...) +## +## Makes a cylinder that links x(:,1) to x(:,2) +## +## Options : +## +## "tran", transparency : Transparency default = 0 +## "col" , col : Color default = [ 0.3 0.4 0.9 ] +## "rad" , radius : Radius of segments default = 0.05 +## "balls" : Add balls to extremities +## "brad" : Radius of balls default = rad +## "emit", bool : Use or not emissiveColor +## "noemit" : Same as emit,0 +## "arrow" : Last segment is an arrow +## "hcol", hcol : Set color of the head of the arrow. +## default = col + +function s = vrml_cyl (x,varargin) # pos 2.1.39 + +rad = 0.05 ; +tran = 0 ; +col = [0.3;0.4;0.9] ; +hcol = nan; +brad = nan; + +verbose = 0 ; +balls = 0 ; +emit = 0; +noemit = nan; +arrow = 0; + +if nargin > 1 + op1 = " rad tran col hcol brad emit " ; + op0 = " verbose balls noemit arrow " ; + + df = tars (rad, tran, col, hcol, verbose, balls, noemit, arrow, brad, \ + emit); + + + s = read_options (varargin, "op1",op1,"op0",op0, "default",df); # pos 2.1.39 + + rad= s.rad; + tran= s.tran; + col= s.col; + hcol= s.hcol; + emit= s.emit; + verbose= s.verbose; + balls= s.balls; + noemit= s.noemit; + arrow= s.arrow; + brad= s.brad; +end + +if isnan (brad), brad = rad; end +if !isnan (noemit), emit = ! noemit; end +if !isnan (hcol), arrow = 1; end + +s = "" ; + +N = columns (x); + + # Make col 3xN +if prod (size (col)) == 3, col = col(:); col = col(:, ones(1,N)); end +if emit, emitcol = col; else emitcol = nan(1,N); end +if prod (size (tran)) == 1, tran = tran(ones(1,N)); end +tran(find (tran==0)) = nan ; + +for i = 2:N + d = x(:,i)-x(:,i-1) ; + n = norm(d) ; + if n, + d = d/n ; + + ax = cross([0,1,0],d') ; + an = norm (ax) ; + if abs(an)>eps, ax = ax/an ; else ax = [1,0,0] ; end + an = acos(d(2)) ; + + t = mean (x(:,[i,i-1])')' ; + + if ! arrow || i != N + + smat = vrml_material (col(:,i-1), emitcol(:,i-1), tran(i-1)); + # Do a cylinder + s = [s,sprintf(["Transform {\n",\ + " translation %8.3f %8.3f %8.3f\n",\ + " children [\n",\ + " Transform {\n",\ + " rotation %8.3f %8.3f %8.3f %8.3f\n",\ + " children [\n",\ + " Shape {\n",\ + " appearance Appearance {\n",\ + " %s",\ + " }\n",\ + " geometry Cylinder {\n",\ + " height %8.3f\n",\ + " radius %8.3f\n",\ + " }\n",\ + " }\n",\ + " ]\n",\ + " }\n",\ + " ]\n",\ + "}\n"],\ + t,\ + ax,an,\ + smat,\ + n,\ + rad)]; + else + t = x(:,i-1) ; + if isnan (hcol), hcol = col(:,i); end + arrowcol = [col(:,i) hcol(1:3)(:)]; + s = [s,\ + vrml_transfo(vrml_arrow ([n,nan,2*rad/n,rad/n],arrowcol,emit),\ + t, ax*an)]; + end + end +end + +if balls, + ## "balls on" + s = [s, vrml_points(x,"balls","col",col, "rad",brad,"emit",emit)]; +elseif columns(x)>2, + # Make a rounded junction + s = [s, vrml_points(x(:,2:columns(x)-1),"balls","col",col,"rad",rad, \ + "emit", emit)]; +end + + +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_demo_tutorial_1.m b/octave_packages/vrml-1.0.13/vrml_demo_tutorial_1.m new file mode 100644 index 0000000..8d0efdb --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_demo_tutorial_1.m @@ -0,0 +1,65 @@ +## Copyright (C) 2002-2009 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +printf (["\n",\ + " VRML Mini-HOWTO's first listing\n",\ + " Display a quadratic surface w/ 31 x 31 points\n\n"]); + +printf ([" Reminder of FreeWRL keystrokes and mouse actions :\n"\ + " q : quit\n",\ + " w : switch to walk mode\n",\ + " e : switch to examine mode\n",\ + " h : toggle headlights on or off\n",\ + " drag left mouse : rotate (examine mode) or translate\n",\ + " (walk mode).\n",\ + " drag right mouse : zoom (examine mode) or translate\n",\ + " (walk mode).\n",\ + "\n"]); + +## Listing 1 + +x = linspace (-1,1,31); + +[xx,yy] = meshgrid (x,x); + +zz = xx.^2 + yy.^2; + +vmesh (zz); + +## Variant of listing 1 + +printf (" Hit a key to see the variant of listing 1\n\n"); + +pause + +vmesh (zz,"checker",[5,-2],"col",[1 0 0;0.7 0.7 0.7]', "emit",0); + +vmesh (zz,"checker",[5,-2],"col",[1 0 0;0.7 0.7 0.7]', "emit",0); + +printf (" Another one, just with 7 x 7 points\n"); + +x = linspace (-1,1,7); + +[xx,yy] = meshgrid (x,x); + +zz = 2 - xx.^2 - yy.^2; + +printf (" Now, with steps, then barss\n"); + +vmesh (zz); + +vmesh (zz,"steps"); + +vmesh (zz,"bars"); diff --git a/octave_packages/vrml-1.0.13/vrml_demo_tutorial_2.m b/octave_packages/vrml-1.0.13/vrml_demo_tutorial_2.m new file mode 100644 index 0000000..503bebe --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_demo_tutorial_2.m @@ -0,0 +1,45 @@ +## Copyright (C) 2002-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +printf("vrml_select_points does not work any more. Sorry\n"); +return + +printf (["\n",\ + " VRML Mini-HOWTO's second listing\n",\ + " Show 3D points and select some with the mouse\n\n"]); + +printf ([" Reminder of FreeWRL keystrokes and mouse actions :\n"\ + " q : quit\n",\ + " w : switch to walk mode\n",\ + " e : switch to examine mode\n",\ + " drag left mouse : rotate (examine mode) or translate\n",\ + " (walk mode).\n",\ + " drag right mouse : zoom (examine mode) or translate\n",\ + " (walk mode).\n",\ + " click on box : toggle selection\n",\ + "\n"]); + +## Listing 2 + +N = 30; + +x = [randn(3,N) .* ([1,3,6]'*ones(1,N)), [5 5;-1 1;0 0]]; + +s = select_3D_points (x); + +printf ("The selected points are : \n"); +s + + diff --git a/octave_packages/vrml-1.0.13/vrml_demo_tutorial_3.m b/octave_packages/vrml-1.0.13/vrml_demo_tutorial_3.m new file mode 100644 index 0000000..cbd376d --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_demo_tutorial_3.m @@ -0,0 +1,47 @@ +## Copyright (C) 2002-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +printf (["\n",\ + " VRML Mini-HOWTO's second listing\n",\ + " Show a XYZ frame with a background\n\n"]); + +printf ([" Reminder of FreeWRL keystrokes and mouse actions :\n"\ + " q : quit\n",\ + " w : switch to walk mode\n",\ + " e : switch to examine mode\n",\ + " drag left mouse : rotate (examine mode) or translate\n",\ + " (walk mode).\n",\ + " drag right mouse : zoom (examine mode) or translate\n",\ + " (walk mode).\n",\ + "\n"]); + +## Listing 3 + +s1 = vrml_frame ("scale",[1 2 3],"col",eye (3), "hcol",0.5*[1 1 1]); + +## One possible variant that uses a two-color sky. I don't refer to it in +## the tutorial because I am not sure that freewrl behaves correctly with +## background nodes. + +## s2 = vrml_Background ("skyColor",[3 3 9; 9 9 9]'/10,"groundColor",[3 8 3]/10); +s2 = vrml_Background ("skyColor",[3 3 9]/10,"groundColor",[3 8 3]/10); + +vrml_browse ([s1,s2]); + + + + + + diff --git a/octave_packages/vrml-1.0.13/vrml_demo_tutorial_4.m b/octave_packages/vrml-1.0.13/vrml_demo_tutorial_4.m new file mode 100644 index 0000000..ef0e214 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_demo_tutorial_4.m @@ -0,0 +1,61 @@ +## Copyright (C) 2002-2009 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +printf (["\n",\ + " VRML Mini-HOWTO's second listing\n",\ + " Show a helix of ellipsoids and one consisting of cylinders\n\n"]); + +printf ([" Reminder of FreeWRL keystrokes and mouse actions :\n"\ + " q : quit\n",\ + " w : switch to walk mode\n",\ + " e : switch to examine mode\n",\ + " h : toggle headlights on or off\n",\ + " drag left mouse : rotate (examine mode) or translate\n",\ + " (walk mode).\n",\ + " drag right mouse : zoom (examine mode) or translate\n",\ + " (walk mode).\n",\ + "\n"]); + +## Listing 4 + +x = linspace (0,4*pi,50); + + # Points on a helix + +xx1 = [x/6; sin(x); cos(x)]; + + + + # Linked by segments + +s1 = vrml_cyl (xx1, "col",kron (ones (3,25),[0.7 0.3])); + + + + # Scaled and represented by spheres + +s2 = vrml_points (xx1,"balls"); + +s2 = vrml_transfo (s2,nan,[pi/2,0,0],[1 0.5 0.5]); + +s3 = vrml_Background ("skyColor",[0 0 1]); + +vrml_browse ([s1, s2, s3]); + + + + + + diff --git a/octave_packages/vrml-1.0.13/vrml_ellipsoid.m b/octave_packages/vrml-1.0.13/vrml_ellipsoid.m new file mode 100644 index 0000000..bfaf967 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_ellipsoid.m @@ -0,0 +1,81 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## v = vrml_ellipsoid (moment, col) - Ellipsoid +## +## moment : 3x3 : Define elipsoid by x'*moment*x = 1 +## or 3 : use diag(moment) +## or 1 : use diag(moment([1,1,1])) default : eye(3) +## +## col : 3 : Color default : [0.3 0.4 0.9] +## + +function v = vrml_ellipsoid(moment, col) + + +if nargin<2 || isempty (col) || isnan (col), col = [0.3 0.4 0.9]; +else + error ("vrml_ellipsoid : col has size %d x %d. This won't do\n",size(col)); + ## keyboard +end +col = col' ; + + +if nargin<1 || isempty (moment), moment = eye(3), +elseif all (size (moment) == 3), # Do nothing +elseif prod( size (moment)) == 3, moment = diag (moment); +elseif length (moment) == 1, moment = moment*eye(3); +else + error ("vrml_ellipsoid : moment has size %d x %d. This won't do\n",size(moment)); + ## keyboard +end + +[u,d,v] = svd (moment); +d = diag(d); +d(find(d)) = 1 ./ nze (d) ; + +[r,a] = rotparams (u'); + +v = sprintf (["Transform {\n",\ + " translation 0 0 0\n",\ + " rotation %8.3g %8.3g %8.3g %8.3g\n",\ + " scale %8.3g %8.3g %8.3g\n",\ + " children [\n",\ + " Shape {\n",\ + " appearance Appearance {\n",\ + " material Material {\n",\ + " diffuseColor %8.3g %8.3g %8.3g\n",\ + " emissiveColor %8.3g %8.3g %8.3g\n",\ + " }\n",\ + " }\n",\ + " geometry Sphere {}\n",\ + " }\n",\ + " ]\n",\ + "}\n",\ + ],\ + r,a,\ + d,\ + col,\ + col/20); + +endfunction +## Example +## d0 = sort (1+2*rand(1,3)); +## d0 = 1:3; +## rv = randn (1,3); +## uu = rotv (rv); +## dd = diag (1./d0); +## mm = uu*dd*uu'; +## vrml_browse ([vrml_frame ([0,0,0],uu',"col",eye(3),"scale",2*d0), vrml_ellipsoid(mm)]); diff --git a/octave_packages/vrml-1.0.13/vrml_faces.m b/octave_packages/vrml-1.0.13/vrml_faces.m new file mode 100644 index 0000000..78fd6c1 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_faces.m @@ -0,0 +1,315 @@ +## Copyright (C) 2002-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_faces(x,f,...) - VRML facet object (IndexedFaceSet node) +## +## x : 3xP : The 3D points +## f : 3xQ : The indexes of the points forming the faces. Indexes +## should have values in 1:P. +## +## Returns a Shape -> IndexedFaceSet vrml node. +## +## No check is done on anything +## +## Options : +## +## "col" , col : 3 : Color, default = [0.3,0.4,0.9] +## or 3xP : Color of vertices +## or 3xQ : Color of facets (use "colorPerVertex" below to +## disambiguate the case P==Q). +## +## "emit", em : 3 : Emissive color of the surface +## : 3XP : (same as color) +## : 3xQ : +## : 1 : Use color as emissive color too default = 0 +## +## "tran", tran : 1x1 : Transparency, default = 0 +## +## "creaseAngle", a +## : 1 : vrml creaseAngle value. The browser may smoothe the +## crease between facets whose angle is less than a. +## default = 0 +## "tex", texfile +## : string : Name of file containing texture. default : none +## +## "imsz", sz : 2 : Size of texture image +## default is determined by imginfo() +## +## "tcoord", tcoord +## : 2x3Q : Coordinates of vertices in texture image. Each 2x3 +## block contains coords of one facet's corners. The +## coordinates should be in [0,1], as in a VRML +## TextureCoordinate node. +## default assumes faces are returned +## by extex() +## +## "smooth" : same as "creaseAngle",pi. +## "convex" +## "colorPerVertex", c: If 1, col specifies color of vertices. If 0, +## col specifies color of facets. Default = 1 +## +## "DEFcoord",n : string : DEF the coord VRML node with name n. Default = '' +## "DEFcol", n : string : DEF the color VRML node with name n. Default = '' +## +## See also: vrml_surf(), vmesh(), test_vrml_faces() + +function s = vrml_faces (x,f,varargin) + + ## mytic; starttime = cputime(); + + if rows (x) != 3 + if columns (x) != 3 + error ("x is %i x %i, has neither 3 rows nor 3 columns.", size (x)); + else + x = x'; + end + end + + tran = 0 ; + col = [0.3, 0.4, 0.9] ; + convex = emit = 0; + tcoord = imsz = tex = smooth = creaseAngle = nan ; + colorPerVertex = nan; + DEFcol = DEFcoord = ""; + + ## Read options ###################################################### + opt1 = " tex DEFcoord DEFcol imsz tcoord tran col creaseAngle colorPerVertex emit " ; + opt0 = " smooth convex " ; + + verbose = 0 ; + + i = 1; + + while numel(varargin)>=i + + tmp = varargin{i++}; + if ! ischar(tmp) , + error ("vrml_faces : Non-string option : \n") ; + ## keyboard + end + + if index(opt1,[" ",tmp," "]) , + + tmp2 = varargin{i++} ; + + eval([tmp,"=tmp2;"]) ; + + if verbose , printf ("vrml_faces : Read option : %s.\n",tmp); end + + elseif index(opt0,[" ",tmp," "]) , + + eval([tmp,"=1;"]) ; + if verbose , printf ("vrml_faces : Read boolean option : %s\n",tmp); end + + else + error ("vrml_faces : Unknown option : %s\n",tmp) ; + ## keyboard + end + endwhile + ## printf (" Options : %f\n",mytic()); ## Just for measuring time + ## End of reading options ############################################ + + if !isempty (DEFcol), col_def_str = ["DEF ",DEFcol]; + else col_def_str = ""; + end + + + if ! isnan (smooth), creaseAngle = pi ; end + + ## printf ("creaseAngle = %8.3f\n",creaseAngle); + + nfaces = columns (f); + if ismatrix(f) + if rows (f) < 3 + error ("Faces matrix 'f' has %i < 3 rows, so it does not define faces", + rows (f)); + end + if any (f > columns (x)) + error ("Faces matrix 'f' has value %i greater than number of points %i", + max (f(:)), columns (x)); + end + end + + if ! isnan (tcoord) + + col_str_1 = sprintf ([" appearance Appearance {\n",... + " texture ImageTexture {\n",... + " url \"%s\"\n",... + " }\n",... + " }\n"],... + tex); + + texcoord_point_str = sprintf (" %8.5f %8.5f\n", tcoord); + + col_str_2 = sprintf ([" texCoord TextureCoordinate {\n",\ + " point [\n %s]\n",\ + " }\n"\ + ],\ + texcoord_point_str\ + ); + + # If texture has been provided + elseif ischar (tex), # Assume triangles + + ## printf ("Using texture\n"); + + col_str_1 = sprintf ([" appearance Appearance {\n",... + " texture ImageTexture {\n",... + " url \"%s\"\n",... + " }\n",... + " }\n"],... + tex); + + # Eventually determine size of image + if isnan(imsz), imsz = imginfo (tex); end + + if isnan (tcoord), + + nb = ceil (nfaces/2); # n of blocks + lo = [0:nb-1]/nb; hi = [1:nb]/nb; + on = ones (1,nb); ze = zeros (1,nb); + + sm = (1/nb) /(imsz(2)+1); + tcoord = [lo; on; lo; ze; hi-sm; ze; lo+sm; on; hi-sm; on; hi-sm; ze]; + tcoord = reshape (tcoord, 2, 6*nb); + tcoord = tcoord (:,1:3*nfaces); + end + + col_str_2 = sprintf ([" texCoord TextureCoordinate {\n",\ + " point [\n %s]\n",\ + " }\n",\ + " texCoordIndex [\n %s]\n",\ + " coordIndex [\n %s]\n",\ + ],\ + sprintf ("%10.8f %10.8f,\n ",tcoord),\ + sprintf ("%-4d, %-4d, %-4d, -1,\n ",0:3*nfaces-1),\ + sprintf ("%-4d, %-4d, %-4d, -1,\n ",f-1) + ); + + ## TODO : f-1 abobe seems to not work if f is a cell or list (check + ## whether this is possible here) + + elseif prod (size (col))==3, # One color has been specified for the whole + # surface + + col_str_1 = [" appearance Appearance {\n",... + vrml_material(col, emit, tran,DEFcol),\ + " }\n"]; + + col_str_2 = ""; + else + if (emit) # Color is emissive by default + col_str_1 = ""; + + + else # If there's a material node, it is not + # emissive. + if tran, ts = sprintf ("transparency %8.3f",tran); + else ts = ""; + end + col_str_1 = ["appearance Appearance {\n",\ + " material Material {",ts,"}\n}\n"]; + end + if isnan (colorPerVertex) + if prod (size (col)) == 3*columns (x), colorPerVertex = 1; + elseif prod (size (col)) == 3*columns (f), colorPerVertex = 0; + end + end + if colorPerVertex, cPVs = "TRUE"; else cPVs = "FALSE"; end + + col_str_2 = sprintf ([" colorPerVertex %s\n",\ + " color %s Color {\n",\ + " color [\n%s\n",\ + " ]\n",\ + " }"],\ + cPVs,\ + col_def_str,\ + sprintf(" %8.3f %8.3f %8.3f,\n",col)); + end + + ## printf (" Colors : %f\n",mytic()); ## Just for measuring time + + etc_str = "" ; + if ! isnan (creaseAngle), + etc_str = [etc_str, sprintf(" creaseAngle %8.3f\n",creaseAngle)]; + end + + ## TODO : s/list/cell/g; Should put this code in sometime soon + ## Code below seems useless + # Faces + if iscell (f), nfaces = length (f); else nfaces = columns (f); end + + + tpl0 = sprintf ("%%%dd, ",floor (log10 (max (1, columns (x))))+1); + ltpl0 = length (tpl0); + + ptsface = zeros (1,nfaces); + + # Determine total number of vertices, number + # of vertices per face and indexes of + # vertices of each face + if iscell (f) + npts = 0; + for i = 1:length (f), + ptsface(i) = 1+length (f{i}); + npts += ptsface(i); + end + ii = [0, cumsum(ptsface)]'; + all_indexes = -ones (1,npts); + for i = 1:length (f), all_indexes(ii(i)+1:ii(i+1)-1) = f{i} - 1; end + else + f = [f;-ones(1,columns(f))]; + npts = sum (ptsface = (sum (!! f))); + all_indexes = nze (f) - 1; + all_indexes(find (all_indexes<0)) = -1; + end + ## printf (" Indexes : %f\n",mytic()); ## Just for measuring time + + coord_str = sprintf (tpl0, all_indexes); + ## That's too slow coord_str = strrep (coord_str, "-1, ","-1,\n"); + + ## printf (" Faces : %f\n",mytic()); ## Just for measuring time + + if ! convex, etc_str = [etc_str," convex FALSE\n"]; end + + if !isempty (DEFcoord), coord_def_str = ["DEF ",DEFcoord]; + else coord_def_str = ""; + end + + s = sprintf([... # string of indexed face set + "Shape {\n",... + col_str_1,... + " geometry IndexedFaceSet {\n",... + " solid FALSE # Show back of faces too\n",... + col_str_2,... + etc_str,... + " coordIndex [\n%s]\n",... + " coord %s Coordinate {\n",... + " point [\n%s]\n",... + " }\n",... + " }\n",... + "}\n",... + ],... + coord_str,... + coord_def_str,... + sprintf(" %8.3f %8.3f %8.3f,\n",x)) ; + ## printf (" Assembly : %f\n",mytic()); ## Just for measuring time + ## printf ("Total Time : %f\n",cputime() - starttime); + +%!demo +%! % Test the vrml_faces and vrml_browse functions with the test_vrml_faces script +%! test_vrml_faces +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_flatten.m b/octave_packages/vrml-1.0.13/vrml_flatten.m new file mode 100644 index 0000000..4fa2fa5 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_flatten.m @@ -0,0 +1,44 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_flatten (x [, d, w, col]) - A planar surface containing x +## +## If the points x are not coplanar (or not in the affine plane {y|d'*y==w}), +## the surface will not contain the points, but rather their projections on +## the plane {y|d'*y==w}. +## +## x : 3 x P : 3D points +## d : 3 : normal to plane | Default : given by best_dir() +## w : 1 : intercept of plane | +## col : 3 : RGB color Default : [0.3,0.4,0.9] +## +## s : string : vrml code representing the planar surface + +function s = vrml_flatten (x, d, w, col) + + +if nargin <= 3 || isnan (col), col = [0.3,0.4,0.9]; end +if nargin <= 1 || isnan (d), [d,w] = best_dir (x); +elseif nargin <= 2 || isnan (w), w = mean (d'*x); end +if ! nargin, error ("vrml_flatten : no arguments given"); end + +y = bound_convex (d,w,x); +Q = columns (y); +faces = [ones(1,Q-2); 2:Q-1; 3:Q]; + + +s = vrml_faces (y, faces, "col",col); +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_frame.m b/octave_packages/vrml-1.0.13/vrml_frame.m new file mode 100644 index 0000000..9c6c8c5 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_frame.m @@ -0,0 +1,148 @@ +## Copyright (C) 2002-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## v = vrml_frame (t, r, ...) +## +## t : 3 Translation Default : [0,0,0] +## r : 3x3 Matrix, or Default : eye(3) +## 3 Argument for rotv +## OPTIONS +## name : size : function : default +## "scale" : 3 or 1 : Length of frame's branches (including cone) <1> +## "diam" : 3 or 1 : Diameter of cone's base +## "col" : 3 or 3x3 : Color of branches (may be stacked vertically) <[3 4 9]/10> +## "hcol" : 3 or 3x3 : Color of head (may be stacked vertically) +## + +function v = vrml_frame (varargin) + +### Test with : frame with R,G,B vectors of len 3,2,1 and cone's diam are .2, +### .4, .6. +## +### vrml_browse (vrml_frame ("scale",[3,2,1],"diam",0.2*[1,2,3],"col",eye(3))); + +t = zeros (3,1); +r = eye(3); + +scale = ones (1,3); +diam = [nan,nan,nan]; +col = [0.3 0.4 0.9]; +hcol = []; + +dc = nan(1,3); +dr = nan(1,3); + +###################################################################### +## Read options +numeric_args = 0; +args = nargin; # nargin is now a function +while args && numeric_args<2 && numeric_args +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## v = vrml_group (s1, s2 ... ) - Form a group node with children s1,... + +function v = vrml_group ( varargin ) + +if nargin == 0, return end + +s = ""; + + # beginpre 2.1.38 +## if (nargin > 0) +## varargin = list(varargin, all_va_args); +## end + # endpre 2.1.38 +if nargin > 0, s = varargin{1}; end +if nargin > 1 + for i = 2:nargin, s = [s,",\n", varargin{i}]; end +end +## indent s +ni = 4; +s = [blanks(ni), strrep(s,"\n",["\n",blanks(ni)])(:)']; + +v = sprintf (["Group {\n",\ + " children [\n",\ + "%s",\ + " ]\n",\ + "}\n"],\ + s); +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_interp.m b/octave_packages/vrml-1.0.13/vrml_interp.m new file mode 100644 index 0000000..f95f6d4 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_interp.m @@ -0,0 +1,76 @@ +## Copyright (C) 2005-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_interp (typ, val,...) + +function s = vrml_interp (typ, val, varargin) + +key = []; +DEF = ""; +if nargin < 1, help vrml_interp; return; end +if nargin < 2 + val = []; +elseif nargin > 2 + op1 = " key DEF "; + df = tars (key, DEF); + s = read_options (varargin, "op1", op1, "default", df); + [key, DEF] = getfields (s, "key", "DEF"); +end + + +persistent nname = struct ("col" , "Color", + "Color" , "Color", + "coord" , "Coordinate", + "Coordinate" , "Coordinate", + "normal" , "Normal", + "Normal" , "Normal", + "orient" , "Orientation", + "Orientation", "Orientation", + "pos" , "Position", + "Position" , "Position", + "scal" , "Scalar", + "Scalar" , "Scalar"); +if isfield (nname, typ) + typs = nname.(typ); +elseif ischar(typ) +# e2 = leval ("sprintf",\ +# append (list(" '%s'\n"), fieldnames (nname))); + e2 = sprintf(" '%s'\n", fieldnames (nname){:}); + error ("vrml_interp : Unknown type '%s'. Should be in:\n%s",typ,e2); +else +# e2 = leval ("sprintf",\ +# append (list(" '%s;\n"), fieldnames (nname))); + e2 = sprintf(" '%s'\n", fieldnames (nname){:}); + error ("vrml_interp : typ should be a string in:\n%s",typ,e2); +end + +if isempty (val) + vs = ""; +else + vs = sprintf ("%8.5f, ", val); + vs = sprintf (" keyValue [ %s ]\n", vs(1:length(vs)-2)); +end +if isempty (key) + ks = ""; +else + ks = sprintf ("%8.5f, ", key); + ks = sprintf (" key [ %s ]\n", ks(1:length(ks)-2)); +end +if length (DEF), defs = ["DEF ",DEF," "]; +else defs = ""; +end + +s = [defs,typs,"Interpolator {\n", vs, ks,"}\n"];endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_kill.m b/octave_packages/vrml-1.0.13/vrml_kill.m new file mode 100644 index 0000000..0c315f6 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_kill.m @@ -0,0 +1,36 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## p = vrml_kill () - Kill the current vrml browser +## +## If a vrml browser has previously been launched with vrml_browse(), it +## will be sent a KILL signal. +## +## See also : vrml_browse. + +function p = vrml_kill () + +global vrml_b_pid = 0; + +if vrml_b_pid, + printf ("vrml_browse : Sending kill signal to browser\n"); + system (sprintf ("kill -KILL %d &> /dev/null",vrml_b_pid)); +else + printf ("vrml_browse : No live browser to kill\n"); +end +vrml_b_pid = 0; +return +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_lines.m b/octave_packages/vrml-1.0.13/vrml_lines.m new file mode 100644 index 0000000..7e6dcee --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_lines.m @@ -0,0 +1,94 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_lines(x,f,...) +## +## x : 3xP : The 3D points +## f : 3xQ : The indexes of the points forming the lines. Indexes +## should be in 1:P. +## +## Returns a Shape -> IndexedLineSet vrml node. +## +## No check is done on anything +## +## Options : +## +## "col" , col : 3x1 : Color, default = [1,0,0] + +function s = vrml_lines(x,f,varargin) + +if nargin < 2, f = ones (1,columns(x)); end +col = [1, 0, 0] ; + +opt1 = " col " ; +opt0 = " " ; + +verbose = 0 ; + +i=1; + +while (nargin -2) >=i , + + tmp = varargin{i++} ; # pos 2.1.39 + if ! ischar(tmp) , + error ("vrml_lines : Non-string option : \n") ; + ## keyboard + + end + if index(opt1,[" ",tmp," "]) , + + + tmp2 = varargin{i++}; # pos 2.1.39 + ## args-- ; + eval([tmp,"=tmp2;"]) ; + + if verbose , printf ("vrml_lines : Read option : %s.\n",tmp); end + + elseif index(opt0,[" ",tmp," "]) , + + eval([tmp,"=1;"]) ; + if verbose , printf ("vrml_lines : Read boolean option : %s\n",tmp); end + + else + error ("vrml_lines : Unknown option : %s\n",tmp) ; + ## keyboard + end +endwhile + +if exist("col")!=1, col = [0.5, 0.5, 0.8]; end + +s = sprintf([... # string of indexed face set + "Shape {\n",... + " appearance Appearance {\n",... + " material Material {\n",... + " diffuseColor %8.3f %8.3f %8.3f \n",... + " emissiveColor %8.3f %8.3f %8.3f\n",... + " }\n",... + " }\n",... + " geometry IndexedLineSet {\n",... + " coordIndex [\n%s]\n",... + " coord Coordinate {\n",... + " point [\n%s]\n",... + " }\n",... + " }\n",... + "}\n",... + ],... + col,col,... + sprintf(" %4d, %4d, %4d, -1,\n",f-1),... + sprintf(" %8.3f %8.3f %8.3f,\n",x)) ; + + +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_material.m b/octave_packages/vrml-1.0.13/vrml_material.m new file mode 100644 index 0000000..6fe12ca --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_material.m @@ -0,0 +1,62 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_material (dc,ec,tr) - Returns a "material" vrml node +## +## dc : 3x1 : diffuseColor +## ec : 3x1 : emissiveColor +## or 1x1 : use dc as emissiveColor if ec is true. Default = 0 +## tr : 1x1 : transparency Default = 0 + +function s = vrml_material (dc, ec, tran,DEF) + +if nargin < 1, dc = [0.3 0.4 0.9] ; # Default color +elseif prod (size (dc)) != 3, + error ("dc should have length 3 (it is %i x %i)",size (dc)); +end + +emit = 1; + +if nargin < 2, ec = 0; end +if nargin < 3, tran = 0; end +if nargin < 4, DEF = ""; end + +if prod (size (ec)) == 1 && !isnan (ec) , emit = ec ; ec = dc ; end +if isnan (tran) + tran = 0; +end + +if emit && !isnan (ec) + se = sprintf (" emissiveColor %8.3g %8.3g %8.3g\n",ec); +else + se = ""; +end +if ! isnan (tran) && tran + st = sprintf (" transparency %8.3g\n",tran); +else + st = ""; +end + +if isempty (DEF), sd = ""; +else sd = ["DEF ",DEF]; +end + +s = sprintf ([" material ",sd," Material {\n",\ + se,st,\ + " diffuseColor %8.3g %8.3g %8.3g \n",\ + " }\n"],\ + dc); +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_newname.m b/octave_packages/vrml-1.0.13/vrml_newname.m new file mode 100644 index 0000000..27d1a7a --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_newname.m @@ -0,0 +1,36 @@ +## Copyright (C) 2005-2012 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## n = vrml_newname (root) - A name for a vrml node, starting by root +## +## vrml_newname ("-clear") +function n = vrml_newname (root) + +persistent vrml_namespace = struct(); + +if nargin < 1, root = ""; end + +if strcmp (root, "-clear"), + vrml_namespace = struct (); + return +end +if isempty (root), root = "N"; end + +n = sprintf ([root,"%0d"],100000*rand()); +while isfield (vrml_namespace, n) + n = sprintf ([root,"%0d"],100000*rand()); +end +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_parallelepiped.m b/octave_packages/vrml-1.0.13/vrml_parallelepiped.m new file mode 100644 index 0000000..528b743 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_parallelepiped.m @@ -0,0 +1,112 @@ +## Copyright (C) 2007-2010 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_parallelogram (bnds,...) +## +## bnds = [xmin, ymin, zmin; xmax, ymax, zmax] +## +## OPTIONS : +## --------- +## col, c : 3x1 : Color of surface +## emit, e : 1 : +## tran, t : 1 : +## +## border,b : 1 : +## bocol, c : 3 : +## boemit,e : 1 : +## borad, r : 1 : +## +## balls, b : 1 : +## bcol, c : 3 : +## bemit, e : 1 : +## brad, r : 1 : + +function s = vrml_parallelepiped (bnds, varargin) + +col = [0.3,0.4,0.9]; +emit = 0; +tran = 0; +balls = 0; +border = 0; +bcol = btran = bemit = brad = borad = bocol = boemit = nan; + +if !isnumeric (bnds) + error ("bnds must be a 2 x 3 matrix, not a %s",typeinfo(bnds)); +endif +if prod (size (bnds)) != 6 + error ("bnds must be 2 x 3, not %s",sprintf("%i x ",size(bnds))(1:end-3)); +endif +if nargin > 1 + op1 = " col emit tran balls border bcol btran bemit brad borad bocol boemit "; + df = tars (col,emit,tran,balls,border,bcol,btran,bemit,brad,borad,bocol,boemit); + s = read_options (varargin, "op1",op1, "default",df); + col=s.col; emit=s.emit; tran=s.tran; balls=s.balls; border=s.border; + bcol = s.bcol; btran = s.btran; bemit = s.bemit; brad = s.brad; + borad = s.borad; bocol = s.bocol; boemit = s.boemit; +end + +if ! isnan (bcol) ||! isnan (brad) || ! isnan (bemit), balls = 1; end +if balls + if isnan (bcol), bcol = col; end + if isnan (btran), btran = tran; end + if isnan (brad) + brad = (max (abs (diff(bnds))))/20; + end +end + +x = [bnds([1 2 2 1 1 2 2 1],1)';\ + bnds([1 1 2 2 1 1 2 2],2)';\ + bnds([1 1 1 1 2 2 2 2],3)']; + +faces = [1 2 3 4;\ + 5 6 7 8;\ + 1 2 6 5;\ + 2 3 7 6;\ + 3 4 8 7;\ + 4 1 5 8]'; + + # The facet +s = vrml_faces (x,faces,"col",col, "tran", tran,"emit",emit); + + # Decoration : balls on vertices +if balls + if isnan (bemit), bemit = emit; end + s = [s,vrml_points(x,"balls","rad",brad,"col",bcol,"tran",btran,"emit",bemit)]; +end + + # Decoration : border + +if ! isnan (bocol) ||! isnan (borad) || ! isnan (boemit), border = 1; end +if border + if isnan (borad) + borad = (norm (x(:,1)-x(:,2))+ norm(x(:,1)-x(:,2)))/80; + end + if isnan (boemit) + if isnan (bemit), boemit = emit; else boemit = bemit; end + end + if isnan (bocol), bocol = col; end + + if !balls # Make pretty junctions of cylinders + s = [s,\ + vrml_cyl(x(:,[1:columns(x),1]),"rad",borad,"emit",boemit,"col",col),\ + vrml_points(x(:,1),"balls","rad",borad,"emit",boemit,"col",col)]; + else # but only if balls don't cover them + s = [s,vrml_cyl(x(:,[1:columns(x),1]),"rad",borad,"emit",boemit)]; + end + +end + +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_parallelogram.m b/octave_packages/vrml-1.0.13/vrml_parallelogram.m new file mode 100644 index 0000000..0dd0e49 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_parallelogram.m @@ -0,0 +1,99 @@ +## Copyright (C) 2003 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_parallelogram (x,...) +## +## x : 3 x 3 : Each column is a 3D point. The fourth corner is +## x(:,1)-x(:,2)+x(:,3) +## +## OPTIONS : +## --------- +## col, c : 3x1 : Color of surface +## emit, e : 1 : +## tran, t : 1 : +## +## border,b : 1 : +## bocol, c : 3 : +## boemit,e : 1 : +## borad, r : 1 : +## +## balls, b : 1 : +## bcol, c : 3 : +## bemit, e : 1 : +## brad, r : 1 : + +function s = vrml_parallelogram (x, varargin) + +col = [0.3,0.4,0.9]; +emit = 0; +tran = 0; +balls = 0; +border = 0; +bcol = btran = bemit = brad = borad = bocol = boemit = nan; + +if nargin > 1 + op1 = " col emit tran balls border bcol btran bemit brad borad bocol boemit "; + df = tars (col,emit,tran,balls,border,bcol,btran,bemit,brad,borad,bocol,boemit); + s = read_options (varargin, "op1",op1, "default",df); + col=s.col; emit=s.emit; tran=s.tran; balls=s.balls; border=s.border; + bcol = s.bcol; btran = s.btran; bemit = s.bemit; brad = s.brad; + borad = s.borad; bocol = s.bocol; boemit = s.boemit; +end + +if ! isnan (bcol) ||! isnan (brad) || ! isnan (bemit), balls = 1; end +if balls + if isnan (bcol), bcol = col; end + if isnan (btran), btran = tran; end + if isnan (brad) + brad = (norm (x(:,1)-x(:,2))+ norm(x(:,1)-x(:,2)))/20; + end +end + +x = [x(:,1:3), x(:,1)-x(:,2)+x(:,3)]; + + # The facet + +s = vrml_faces (x, (1:4)', "col",col, "tran", tran,"emit",emit); + + # Decoration : balls on vertices +if balls + if isnan (bemit), bemit = emit; end + s = [s,vrml_points(x,"balls","rad",brad,"col",bcol,"tran",btran,"emit",bemit)]; +end + + # Decoration : border + +if ! isnan (bocol) ||! isnan (borad) || ! isnan (boemit), border = 1; end +if border + if isnan (borad) + borad = (norm (x(:,1)-x(:,2))+ norm(x(:,1)-x(:,2)))/80; + end + if isnan (boemit) + if isnan (bemit), boemit = emit; else boemit = bemit; end + end + if isnan (bocol), bocol = col; end + + if !balls # Make pretty junctions of cylinders + s = [s,\ + vrml_cyl(x(:,[1:columns(x),1]),"rad",borad,"emit",boemit,"col",col),\ + vrml_points(x(:,1),"balls","rad",borad,"emit",boemit,"col",col)]; + else # but only if balls don't cover them + s = [s,vrml_cyl(x(:,[1:columns(x),1]),"rad",borad,"emit",boemit)]; + end + +end + +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_points.m b/octave_packages/vrml-1.0.13/vrml_points.m new file mode 100644 index 0000000..196de1a --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_points.m @@ -0,0 +1,219 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_points(x,options) +## +## x : 3xP : 3D points +## +## Makes a vrml2 "point [ ... ]" node from a 3xP matrix x. +## +## OPTIONS (name and size/type, if applicable): +## --------------------------------------- +## "balls" : Displays spheres rather than points. Overrides the +## "hide" options and no Coordinate node is defined;makes +## "name" ineffective. +## +## "boxes" or +## "cubes" : Displays cubes rather than points. Overrides the "hide" +## options and no Coordinate node is defined;makes "name" +## ineffective. +## +## "rad", 1 or P: Radius of balls/size of cubes. default = 0.1 +## +## "nums" : Displays numbers rather than points. Overrides the +## "hide" options and no Coordinate node is defined; +## makes "name" ineffective. +## +## WARNING : This option seems to make freewrl 0.34 hang, so that it +## is necessary to kill it (do vrml_browse ("-kill")). Other +## browsers can can view the code produced by this option. +## +## "col", 3x1 : Points will have RGB col. default = [0.3,0.4,0.9] +## or 3xP : The color of each point. +## "tran", 1x1 : Transparency default = 0 +## "emit", e : Use or not emissiveColor default = 1 +## +## "name", str : The Coordinate node will be called name +## (default="allpoints"). +## "hide" : The points will be defined, but not showed. + +function s = vrml_points(x,varargin) +## varargin +hide = 0; +cubes = balls = nums = 0; +rad = 0.1 ; +name = "allpoints" ; +col = [0.3 0.4 0.9]; +emit = 1; +tran = 0; + +i = 1; # pos 2.1.39 + +while i <= nargin-1 + + tmp = varargin{i++}; + if strcmp(tmp,"hide") , + hide = 1; + elseif strcmp(tmp,"balls") , + balls = 1; + elseif strcmp(tmp,"cubes") || strcmp(tmp,"boxes") , + cubes = 1; + elseif strcmp(tmp,"rad") , + + rad = varargin{i++}; + elseif strcmp(tmp,"nums") , + nums = 1; + elseif strcmp(tmp,"emit") , + + emit = varargin{i++}; + elseif strcmp(tmp,"col") , + + col = varargin{i++}; + elseif strcmp(tmp,"name") , + + name = varargin{i++}; + elseif strcmp(tmp,"tran") , + tran = varargin{i++}; + end +end + +if rows (x) != 3, + if columns (x) == 3, + x = x' ; + else + error ("vrml_points : input is neither 3xP or Px3\n"); + ## keyboard + end +end +P = columns (x) ; + # Produce a PointSet +if !balls && !cubes && !nums, + + if prod (size (col)) == 3*P # One color per point + smat = ""; + scol = sprintf (" color Color { color [\n %s]\n }\n",\ + sprintf (" %8.3f %8.3f %8.3f\n", col)); + else # One color + smat = [" appearance Appearance {\n",\ + vrml_material(col, emit),"\n",\ + " }\n"]; + scol = ""; + end + + s = sprintf(["Shape {\n",\ + smat,\ + " geometry PointSet {\n",\ + scol,\ + " coord DEF %s Coordinate {\n point [\n " ],name); # ] + + + s0 = sprintf("%10.6g %10.6g %10.6g ,\n ",x); + + s = sprintf("%s%s]\n }\n }\n }\n",s,s0); # [ + + if hide, s = ["Switch {\nchoice\n[\n",s,"\n]\n}"]; end + + # Use numbers +elseif nums, + printf ("Foo\n"); + s = ""; + if prod (size (col)) == 3, col = col(:) * ones (1,P); end + for i = 1:P, + s0 = sprintf([\ + "Transform {\n",\ + " translation %10.6g %10.6g %10.6g\n",\ + " children [\n",\ # ] + " Billboard {\n",\ + " children [\n",\ # ] + " Shape {\n",\ + " appearance Appearance {\n",\ + vrml_material(col(:,i), emit, tran),"\n",\ + " }\n",\ + " geometry Text {\n",\ + " string \"%s\"\n",\ + " fontStyle FontStyle { size 0.25 }\n",\ + " }\n",\ + " }\n",\ + " ]\n",\ + " }\n",\ + " ]\n",\ + "}\n"],\ # [ + x(:,i),sprintf("%d",i-1)); + ## x(:,i),col,col,sprintf("%d",i-1)); + ## " emissiveColor %8.3f %8.3f %8.3f\n",\ + ## " axisOfRotation 0.0 0.0 0.0\n",\ + + s = sprintf("%s%s",s,s0); + end +else + # If all radiuses are the same, do a single + # geometry node for all points + if all (size (rad) == 1) || ! any (abs (diff (rad))>eps) + all_same_rad = 1; + if balls, shapestr = sprintf("Sphere { radius %8.3f}",rad) ; + else shapestr = sprintf("Box { size %8.3f %8.3f %8.3f}",rad,rad,rad) ; + end + else + all_same_rad = 0; + end + + # If all colors are the same, do a single + # geometry node for all points + if prod (size (col)) == 3 || ! any (abs (diff (col'))>eps) + all_same_col = 1; + colorstr = vrml_material (col(1:3), emit); + else + all_same_col = 0; + end + + s = ""; + for i = 1:P + # If some radiuses differ, I must do + # geometry nodes individually + if ! all_same_rad + # Skip zero-sized objects + if ! rad(:,i), continue; end + + if balls + shapestr = sprintf("Sphere { radius %8.3f}",rad(:,i)); + else + shapestr = sprintf("Box { size %8.3f %8.3f %8.3f}",rad(:,[i,i,i])); + end + end + # If some colors differ, I must do material + # nodes individually + if ! all_same_col, colorstr = vrml_material (col(:,i), emit); end + + s0 = sprintf([\ + "Transform {\n",\ + " translation %10.6g %10.6g %10.6g\n",\ + " children [\n",\ # ] + " Shape {\n",\ + " appearance Appearance {\n",\ + colorstr,"\n",\ + " }\n",\ + " geometry ",shapestr,"\n",\ + " }\n",\ + " ]\n",\ + "}\n"],\ + x(:,i)); + ## " emissiveColor %8.3f %8.3f %8.3f\n",\ + ## x(:,i),col,col,shape); + s = sprintf("%s%s",s,s0); + end +end +endfunction + + diff --git a/octave_packages/vrml-1.0.13/vrml_surf.m b/octave_packages/vrml-1.0.13/vrml_surf.m new file mode 100644 index 0000000..a47adff --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_surf.m @@ -0,0 +1,506 @@ +## Copyright (C) 2002-2009 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_surf (x, y, z [, options] ) - code for a VRML surface +## s = vrml_surf (z [, options] ) +## +## Returns vrml97 code for a Shape -> IndexedFaceSet node representing a +## surface passing through the given points. +## +## x : RxC or C : X coordinates of the points on the surface +## y : RxC or R : Y " " +## z : RxC : Z " " +## +## s : string : The code +## +## If x and y are omitted, they are assumed to be linspace(-1,1,C or R). +## Points presenting one or more 'inf' or 'nan' coordinates are ignored. +## +## Options : +## +## "col" , col : 3 : RGB Color, default = [0.3,0.4,0.9] +## or 3x(R*C): Color of vertices (vrml colorPerVertex is TRUE). +## or 3x((R-1)*(C-1)) +## : Color of facets +## or 1 : Reflectivity (equivalent to [col,col,col] in RGB) +## or R x C : Reflectivity of vertices +## or 1x(R*C) +## or (R-1)x(C-1) +## or (R-1)*(C-1) +## : Reflectivity of facets. +## +## RGB and reflectivity values should be in the [0,1] interval. +## +## "checker", c : 1x2 : Color as a checker. If c(1) is positive, checker has +## c(1) rows. If it is negative, each checker row is c(1) facets +## high c(2) likewise determines width of checker columns. +## "checker", c : 1x1 : Same as [c,c]. +## +## "zcol", zc : 3xN : Specify a colormap. The color of each vertex is +## interpolated according to its height (z). +## +## "zgray" : Black-to-white colormap. Same as "zcol", [0 1;0 1;0 1]. +## +## "zrb" : Red-to-blue. Same as "zcol", [0 7 10;0 0 2;7 19 2]/10. +## +## "steps" : Represent surface as a piecewise constant Z = f(X,Y) function +## +## "bars" : Represent surface as a bar plot +## +## "tran", tran : 1x1 : Transparency, default = 0 +## +## "creaseAngle", a +## : 1 : vrml creaseAngle The browser may smoothe the fold +## between facets forming an angle less than a. +## default = 0 +## "smooth" : same as "creaseAngle",pi. +## "tex", texFile +## +## See also: vmesh(), vrml_faces(), test_moving_surf() + +function s = vrml_surf (x, y, z,varargin) + +if (nargin <= 1) || ischar(y), # Cruft to allow not passing x and y + zz = x ; + [R,C] = size (zz); + [xx,yy] = meshgrid (linspace (-1,1,C), linspace (-1,1,R)); + ## ones(R,1)*[1:C] ; + ## yy = ## [1:R]'*ones(1,C) ; + ##if nargin >=3, + ## s = vrml_surf ( xx, yy, zz, y, z, varargin{:} ); + ## return + ##elseif nargin >=2, + ## s = vrml_surf ( xx, yy, zz, y, varargin{:} ); + ## return + ##end + if nargin >= 3 + varargin = {y, z, varargin{:}}; + elseif nargin >= 2 + varargin = {y, varargin{:}}; + end + + x = xx ; y = yy ; z = zz ; +end + +defaultCol = [0.3; 0.4; 0.9]; + + # Read options + # Default values + +upper = 1; # Do "upper" triangulation of square grid +tran = 0 ; # Transparency +col = defaultCol ; # Color +checker = 0; # Checkered coloring +colorPerVertex = 1; # Color vertices or faces +zrb = zgray = zcol = 0; # Color by elevation +emit = 0; # emissiveColor or diffuse only +smooth = creaseAngle = nan ; +steps = 0; +bars = 0; +tex = 0; +bwid = -1; +DEFcoord = DEFcol = ""; # Give a name to VRML objects + +if numel (varargin) + + op1 = " tran col creaseAngle emit colorPerVertex checker DEFcoord DEFcol zcol bwid tex "; + op0 = " smooth zgray zrb steps bars " ; + + default = tars (tran, col, creaseAngle, emit, colorPerVertex, steps, bars, \ + bwid, DEFcoord, DEFcol, zcol, smooth, checker, zgray, zrb, tex); + + s = read_options (varargin,"op0",op0,"op1",op1,"default",default); + + tran= s.tran; + col= s.col; + creaseAngle= s.creaseAngle; + emit= s.emit; + colorPerVertex= s.colorPerVertex; + DEFcoord= s.DEFcoord; + DEFcol= s.DEFcol; + zcol= s.zcol; + smooth= s.smooth; + steps= s.steps; + bars= s.bars; + bwid= s.bwid; + tex= s.tex; + if bwid >= 0 + bars = 1; + end + checker= s.checker; + zgray= s.zgray; + zrb= s.zrb; +end +## keyboard +if ! isnan (smooth), creaseAngle = pi ; end + +[R,C] = size(z); +if any (size (x) == 1), x = ones(R,1)*x(:)' ; end +if any (size (y) == 1), y = y(:)*ones(1,C) ; end + +if bars + + if bwid < 0 + bwid = 2/3; + end + brad = bwid/2; + + R4 = 4*R; + C4 = 4*C; + x2 = y2 = z2 = zeros (R4,C4); + + x2(:,1) = x2(:,2) = kron ((1+brad)*x(:,1) - brad*x(:,2), [1;1;1;1]); + x2(:,C4-1) = x2(:,C4) = kron ((1+brad)*x(:,C) - brad*x(:,C-1), [1;1;1;1]); + x2(:,5:4:C4) = x2(:,6:4:C4) = kron ((1-brad)*x(:,2:C) + brad*x(:,1:C-1), [1;1;1;1]); + x2(:,3:4:C4-4) = x2(:,4:4:C4-4) = kron ((1-brad)*x(:,1:C-1)+brad*x(:,2:C), [1;1;1;1]); + + y2(1,:) = y2(2,:) = kron ((1+brad)*y(1,:) - brad*y(2,:), [1 1 1 1]); + y2(R4-1,:) = y2(R4,:) = kron ((1+brad)*y(R,:) - brad*y(R-1,:), [1 1 1 1]); + y2(5:4:R4,:) = y2(6:4:R4,:) = kron ((1-brad)*y(2:R,:) + brad*y(1:R-1,:), [1 1 1 1]); + y2(3:4:R4-4,:) = y2(4:4:R4-4,:) = kron ((1-brad)*y(1:R-1,:) + brad*y(2:R,:), [1 1 1 1]); + + z2([2:4:R4;3:4:R4],[2:4:C4;3:4:C4]) = kron(z,ones(2)); + + x = x2; + y = y2; + z = z2; + R = R4; + C = C4; + + if numel (size (col)) == 2 && all (size (col) == size (defaultCol)) && all (col == defaultCol) + col = [col, 0.8*col, 0.9*col]; + end + if numel (col) == 3 + col = col(:); + topCol = col; + botCol = col; + sideCol = [col,col,col,col]; + elseif numel (col) == 6 + col = col(:); + topCol = col(1:3); + botCol = col(1:3); + sideCol = col(4:6)*ones(1,4); + elseif numel (col) == 9 + col = col(:); + topCol = col(1:3); + botCol = col(7:9); + sideCol = col(4:6)*ones(1,4); + end + col = ones(3, R-1, C-1); + for i=1:3 + col(i,2:4:R-1,2:4:C-1) = topCol(i); + col(i,4:4:R-1,:) = botCol(i); + col(i,:,4:4:C-1) = botCol(i); + col(i,3:4:R-1,2:4:C-1) = sideCol(i,1); + col(i,2:4:R-1,1:4:C-1) = sideCol(i,2); + col(i,1:4:R-1,2:4:C-1) = sideCol(i,3); + col(i,2:4:R-1,3:4:C-1) = sideCol(i,2); + end + iOnFloor = find (! z(1:R-1,1:C-1)); + if ! isempty (iOnFloor) + ## keyboard + col(3*(iOnFloor-1)+1) = botCol(1); + col(3*(iOnFloor-1)+2) = botCol(2); + col(3*(iOnFloor-1)+3) = botCol(3); + end + +elseif steps # Constant by parts + + # Intermediate coordinates (R+1) x (C+1) + x2 = (x([1,1:R],[1,1:C]) + x([1,1:R],[1:C,C])) / 2; + y2 = (y([1,1:R],[1:C,C]) + y([1:R,R],[1:C,C])) / 2; + + # Extend extremities so all patches have same size + x2(1,:) = 2*x2(1,:) - x2(2,:); + x2(:,1) = 2*x2(:,1) - x2(:,2); + x2(R+1,:) = 2*x2(R+1,:) - x2(R,:); + x2(:,C+1) = 2*x2(:,C+1) - x2(:,C); + + y2(1,:) = 2*y2(1,:) - y2(2,:); + y2(:,1) = 2*y2(:,1) - y2(:,2); + y2(R+1,:) = 2*y2(R+1,:) - y2(R,:); + y2(:,C+1) = 2*y2(:,C+1) - y2(:,C); + + # Duplicate intermediate values 2R x 2C + ii = [1,([1;1]*(2:R))(:)',R+1]; + jj = [1,([1;1]*(2:C))(:)',C+1]; + + x2 = x2(ii,jj); + y2 = y2(ii,jj); + + z2 = z([1;1]*(1:R),[1;1]*(1:C));; + x = x2; + y = y2; + z = z2; + + if checker + col = checker_color (checker, col, 2*R,2*C); + end + if numel (col) == R*C + col = [1;1;1]*col(:)'; + end + if numel (col) == 3*R*C + col = reshape (col, 3,R,C); + col2 = zeros (3,2*R-1,2*C-1); + col2(1,:,:) = defaultCol(1); + col2(2,:,:) = defaultCol(2); + col2(3,:,:) = defaultCol(3); + col2(:,1:2:end,1:2:end) = col; + col = reshape (col2,3,(2*R-1)*(2*C-1)); + end + + R *= 2; + C *= 2; +end + +pts = [x(:)';y(:)';z(:)']; + +keepp = all (!isnan(pts) & finite(pts)) ; +keepip = find (keepp); +if tex + [texX,texY] = meshgrid (linspace (0,1,C), linspace (0,1,R)); + texXY = [texX(:)'; texY(:)']; +end + +trgs = zeros(3,2*(R-1)*(C-1)) ; + +## Points are numbered as +## +## 1 R+1 .. (C-1)*R+1 +## 2 R+2 : +## : : : +## R 2*R .. C*R +## + + +## (x,y), (x,y+1), (x+1,y) i.e. n, n+1, n+R + +if !upper # Do regular triangulation + ## Triangles are numbered as : + ## + ## X = (R-1)*(C-1) + ## +-----+-----+-----+-----+-----+ + ## | /| /| /| /|-R+1/| + ## | 1 / | R / | / | / |R*C/ | + ## | / | / | / | / | / | + ## | /X+1| /X+R| / | / | / | + ## |/ |/ |/ |/ |/ | + ## +-----+-----+-----+-----+-----+ + ## | /| /| /| /| /| + ## | 2 / |R+2/ | / | / | / | + ## | / | / | / | / | / | + ## | / | / | / | / | / | + ## |/ |/ |/ |/ |/ | + ## +-----+-----+-----+-----+-----+ + ## : : : + ## : : : + ## +-----+-----+-----+-----+-----+ + ## | /| /| /| /| /| + ## |R-1/ |2*R/ | / | / |C*R/ | + ## | / |-1/ | / | / | / | + ## | /X+R| / | / | / | /C*R| + ## |/ |/ |/ |/ |/ X+ | + ## +-----+-----+-----+-----+-----+ + + tmp = 1:(R-1)*(C-1); + + trgs(1,tmp) = ([1:R-1]'*ones(1,C-1) + R*ones(R-1,1)*[0:C-2])(:)'; + trgs(2,tmp) = ([ 2:R ]'*ones(1,C-1) + R*ones(R-1,1)*[0:C-2])(:)'; + trgs(3,tmp) = ([1:R-1]'*ones(1,C-1) + R*ones(R-1,1)*[1:C-1])(:)'; + + tmp += (R-1)*(C-1); + + trgs(1,tmp) = ([1:R-1]'*ones(1,C-1) + R*ones(R-1,1)*[1:C-1])(:)'; + trgs(2,tmp) = ([ 2:R ]'*ones(1,C-1) + R*ones(R-1,1)*[0:C-2])(:)'; + trgs(3,tmp) = ([ 2:R ]'*ones(1,C-1) + R*ones(R-1,1)*[1:C-1])(:)'; + +else # Do "upper" triangulation + + ## Each triangle is +-----+ +-----+ + ## the highest of either | /| or |\ | + ## | / | | \ | + ## | / | | \ | + ## | / | | \ | + ## |/ | | \| + ## +-----+ +-----+ + + + tmp = 1:(R-1)*(C-1); + tmp2 = reshape(1:R*C,R,C); + foo1 = z(1:R-1,1:C-1) + z(2:R,2:C); + foo2 = z(2:R,1:C-1) + z(1:R-1,2:C); + tmp3 = (!isnan(foo1) & (isnan (foo2) | foo1 > foo2))(:)'; + + trgs(1,tmp) = tmp2(1:R-1,1:C-1)(:)'; + trgs(2,tmp) = tmp2(2:R,1:C-1)(:)'; + trgs(3,tmp) = trgs(1,tmp) + R + tmp3 ; + tmp += (R-1)*(C-1); + trgs(1,tmp) = tmp2(1:R-1,2:C)(:)'; + trgs(2,tmp) = tmp2(2:R,2:C)(:)'; + trgs(3,tmp) = trgs(1,tmp) - R + 1 - tmp3 ; +end # EOF "upper" triangulation + +#trgs = trgs(:,find(rem(1:R-1,2)'*rem(1:C-1,2))); + + +if length (col) == 1 # Convert graylevel to RGB + col = [1 1 1]*col; + +elseif any (prod (size (col)) == [R*C,(R-1)*(C-1)]) + col = [1;1;1]*col(:)'; +end + +if zgray || zrb || any (zcol(:)) # Treat zgray zrb and zcol options + zx = max (z(keepip)); + zn = min (z(keepip)); + if zgray, zcol = [0 0 0; 1 1 1]'; + elseif zrb , zcol = [0 0 0.7; 0.5 0 0.8; 1 0 0]'; + end + + ci = 1 + floor (cw = (columns (zcol)-1) * (z(keepip) - zn)/(zx - zn)); + cw = cw - ci + 1; + ii = find (ci >= columns (zcol)); + if ! isempty (ii), ci(ii) = columns (zcol) - 1; cw(ii) = 1; end + col = zeros (3,R*C); + col(:,keepip) = \ + zcol(:,ci) .* ([1;1;1]*(1-cw)) + zcol(:,ci+1) .* ([1;1;1]*cw); + +end # EOF zgray zrb and zcol options + + +if checker && numel (col) <= 6 + if isnan (checker), checker = 10; end + if length (checker) == 1, checker = [checker, checker]; end + + col = checker_color (checker, col, R,C); + + if 0 + if checker(1) > 0, checker(1) = - (C-1)/checker(1); end + if checker(2) > 0, checker(2) = - (R-1)/checker(2); end + + checker *= -1; + colx = 2 * (rem (0:C-2,2*checker(1)) < checker(1)) - 1; + coly = 2 * (rem (0:R-2,2*checker(2)) < checker(2)) - 1; + icol = 1 + ((coly'*colx) > 0); + # Keep at most 1st 2 colors of col for the + # checker + if prod (size (col)) == 2, + col = [1;1;1]*col; + elseif prod (size (col)) < 6, # Can't be < 3 because of previous code + col = col(1:3)(:); + if all (col >= 1-eps), col = [col [0;0;0]]; # Black and White + else col = [col [1;1;1]]; # X and White + end + end + col = reshape (col(:),3,2); + col = col(:,icol); + end +end # EOF if checker + + +if prod (size (col)) == 3*(R-1)*(C-1), + colorPerVertex = 0; +end + +if ! colorPerVertex + if prod (size (col)) == 3*(R-1)*(C-1) + col = reshape (col,3, (R-1)*(C-1)); + col = [col, col]; + else + printf(["vrml_surf : ",\ + " colorPerVertex==0, (R-1)*(C-1)==%i, but col has size [%i,%i]\n"],\ + R*C,size (col)); + end + +end + +if ! all(keepp), + + # Try to toggle some triangles to fill in + # holes + if ! upper + nt = (R-1)*(C-1) ; + tmp = ! reshape(keepp(trgs),3,2*nt); + tmp = all( tmp == kron([0,0;0,1;1,0],ones(1,nt)) ); + trgs(3, find ( tmp(1:nt) & rem (trgs(3,1:nt),R)) )++ ; + trgs(2, nt+ find ( tmp(nt+1:2*nt) & (rem (trgs(3,nt+1:2*nt),R)!=1)) )-- ; + + # Remove whatever can't be kept + keept = all (reshape(keepp(trgs),3,2*(R-1)*(C-1))); + else + tmp = reshape (keepp,R,C); + keept = \ + all (reshape (tmp(trgs(1:2,:)),2,2*(R-1)*(C-1))) & \ + [(tmp(1:R-1,2:C) | tmp(2:R,2:C))(:)', \ + (tmp(1:R-1,1:C-1) | tmp(2:R,1:C-1))(:)'] ; + end + + keepit = find (keept); + + renum = cumsum (keepp); + + pts = pts (:,keepip); + trgs = reshape(renum (trgs (:,keepit)), 3, columns(keepit)); + + if prod (size (col)) == 6*(R-1)*(C-1) + col = col(:,keepit); + # Coherence check : colorPerVertex == 0 + if colorPerVertex + error ("Col has size 3*(R-1)*(C-1), but colorPerVertex == 1"); + end + + elseif prod (size (col)) == 3*R*C + col = col(:,keepip); + + # Coherence check : colorPerVertex == 1 + if ! colorPerVertex + error ("Col has size 3*R*C, but colorPerVertex == 0"); + end + end + +end +## printf ("Calling vrml_faces\n"); +if !tex + s = vrml_faces (pts, trgs, "col", col,\ + "colorPerVertex",colorPerVertex,\ + "creaseAngle", creaseAngle,\ + "tran", tran, "emit", emit,\ + "DEFcoord",DEFcoord,"DEFcol",DEFcol); +else + texXY = texXY(:,keepip); +# texXY(:,[1:5,232:236]) +# pts(:,[1:5,232:236]) +# trgs(:,1:20) +# [texXY; pts] +# trgs +# texXY(:,trgs(:)) +# R, C +# keyboard + s = vrml_faces (pts, trgs,\ + "tran", tran, "tex", tex, "tcoord", texXY,\ + "DEFcoord",DEFcoord,"DEFcol",DEFcol); +end +## printf ("Done\n"); +## R=5; C=11; +## x = ones(R,1)*[1:C]; y = [1:R]'*ones(1,C); +## zz = z = sin(x)+(2*y/R-1).^2 ; +## ## Punch some holes +## holes = ind2sub ([R,C],[3,3,3,1,2,3,2,3;1,2,3,5,7,7,9,10]') +## z(holes) = nan +## save_vrml("tmp.wrl",vrml_surf(x,y,z+1)) +## save_vrml("tmp.wrl",vrml_surf(z,"col",[0.5,0,0],"tran",0.5),vrml_surf(z+1)) + +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_text.m b/octave_packages/vrml-1.0.13/vrml_text.m new file mode 100644 index 0000000..5bba54e --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_text.m @@ -0,0 +1,83 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_text(t,...) +## +## Makes vrml Shape node representing string t +## +## Options : +## +## "col" , col : default = [ 0.3 0.4 0.9 ] +## "size" , size : default = 1.0 +## "family", family : default = "SERIF". +## (could also be : "TYPEWRITER", "SANS") +## "style", style : default = "PLAIN". +## (could also be : "BOLD", "ITALIC", "BOLDITALIC") +## "justify", justify : default = "MIDDLE" +## (could also be "FIRST", "BEGIN", "END") + +function s = vrml_text(t,varargin) + +col = [0.3,0.4,0.9] ; +size = 1.0 ; +family = "SERIF" ; +justify = "MIDDLE" ; +style = "PLAIN" ; +verbose = 0 ; + +filename = "vrml_text" ; +if nargin > 1 + op1 = " col size family justify style " ; + op0 = " verbose " ; + + df = tars (col, size, family, justify, style, verbose); + + s = read_options (varargin, "op1",op1,"op0",op0, "default",df); + col= s.col; + size= s.size; + family= s.family; + justify= s.justify; + style= s.style; + verbose= s.verbose; +end +s = sprintf (["Shape {\n",\ + " appearance Appearance {\n",\ + " material Material {\n",\ + " diffuseColor %8.3f %8.3f %8.3f\n",\ + " emissiveColor %8.3f %8.3f %8.3f\n",\ + " }\n",\ + " }\n",\ + " geometry Text {\n",\ + " string \"%s\"\n"\ + " fontStyle FontStyle {\n",\ + " family \"%s\"\n",\ + " justify \"%s\"\n",\ + " style \"%s\"\n",\ + " size %-8.3f\n",\ + " }\n",\ + " }\n",\ + "}\n",\ + ],\ + col,\ + col,\ + t,\ + family,\ + justify,\ + style,\ + size\ + ); + +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_thick_surf.m b/octave_packages/vrml-1.0.13/vrml_thick_surf.m new file mode 100644 index 0000000..e3e8e51 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_thick_surf.m @@ -0,0 +1,183 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## s = vrml_thick_surf (x, y, z [, options] ) +## s = vrml_thick_surf (z [, options] ) +## +## Returns vrml97 code for a Shape -> IndexedFaceSet node representing a +## surface passing through the given points. +## +## The surface may look smoother than that returned by vrml_surf, but it +## has twice as many facets. +## +## x : RxC or C : X coordinates of the points on the surface +## y : RxC or R : Y " " +## z : RxC : Z " " +## +## s : string : The code +## +## If x and y are omitted, they are assumed to be 1:C and 1:R, resp +## Points presenting one or more 'inf' or 'nan' coordinates are ignored. +## +## Options : +## +## "col" , col : 3 : Color, default = [0.3,0.4,0.9] +## or 3xP : color of vertices (vrml colorPerVertex is TRUE). +## +## "tran", tran : 1x1 : Transparency, default = 0 +## +## "creaseAngle", a +## : 1 : vrml creaseAngle value. The browser may smoothe the +## crease between facets whose angle is less than a. +## default = 0 +## "smooth" : same as "creaseAngle",pi. + +function s = vrml_thick_surf (x, y, z, varargin) + + # Default values +tran = 0 ; +col = [0.3, 0.4, 0.9] ; +smooth = creaseAngle = nan ; +nargin = nargin(); + +if (nargin <= 1) || ischar(y), # Cruft to allow not passing x and y + zz = x ; + [R,C] = size (zz); + xx = ones(R,1)*[1:C] ; + yy = [1:R]'*ones(1,C) ; + if nargin >=3, + + s = vrml_surf ( xx, yy, zz, y, z, varargin{:} ); + return + elseif nargin >=2, + + s = vrml_surf ( xx, yy, zz, y, varargin{:} ); + return + end + x = xx ; y = yy ; z = zz ; +end + + # Read options +filename = "vrml_thick_surf" ; +verbose = 0 ; + +if nargin > 3, + + opt1 = " tran col creaseAngle " ; + opt0 = " smooth " ; + + nargin -= 3 ; + + read_options_old ; +end + +if ! isnan (smooth), creaseAngle = pi ; end +[R,C] = size(z); +if any (size (x) == 1), x = ones(R,1)*x(:)' ; end +if any (size (y) == 1), y = y(:)*ones(1,C) ; end + +pts = [x(:)';y(:)';z(:)']; + +keepp = all (!isnan(pts) & finite(pts)) ; + +trgs = zeros(3,4*(R-1)*(C-1)) ; + +tmp = 1:(R-1)*(C-1); + +## Points are numbered as +## +## 1 R+1 .. (C-1)*R+1 +## 2 R+2 : +## : : : +## R 2*R .. C*R +## + +## Triangles are numbered as : +## +## X = (R-1)*(C-1) +## _______________________________ +## | /| /| /| /|-R+1/| +## | 1 / |R+1/ | / | / |R*C/ | +## | / | / | / | / | / | +## | /X+1| /X+R| / | / | / | +## |/ |/ |/ |/ |/ | +## ------------------------------- +## | /| /| /| /| /| +## | 2 / |R+2/ | / | / | / | +## | / | / | / | / | / | +## | / | / | / | / | / | +## |/ |/ |/ |/ |/ | +## ------------------------------- +## : : : +## : : : +## ------------------------------- +## | /| /| /| /| /| +## | R / |2*R/ | / | / |C*R/ | +## | / | / | / | / | / | +## | /X+R| / | / | / | /C*R| +## |/ |/ |/ |/ |/ X+ | +## ------------------------------- + +## (x,y), (x,y+1), (x+1,y) i.e. n, n+1, n+R + +trgs(1,tmp) = ([1:R-1]'*ones(1,C-1) + R*ones(R-1,1)*[0:C-2])(:)'; +trgs(2,tmp) = ([ 2:R ]'*ones(1,C-1) + R*ones(R-1,1)*[0:C-2])(:)'; +trgs(3,tmp) = ([1:R-1]'*ones(1,C-1) + R*ones(R-1,1)*[1:C-1])(:)'; + +## (x+1,y), (x,y+1), (x+1,y+1) i.e. n+R, n+1, n+R+1 +tmp += (R-1)*(C-1); + +trgs(1,tmp) = ([1:R-1]'*ones(1,C-1) + R*ones(R-1,1)*[1:C-1])(:)'; +trgs(2,tmp) = ([ 2:R ]'*ones(1,C-1) + R*ones(R-1,1)*[0:C-2])(:)'; +trgs(3,tmp) = ([ 2:R ]'*ones(1,C-1) + R*ones(R-1,1)*[1:C-1])(:)'; + +## (x,y), (x+1,y+1), (x+1,y) i.e. n, n+1, n+R+1 +tmp += (R-1)*(C-1); + +trgs(1,tmp) = ([1:R-1]'*ones(1,C-1) + R*ones(R-1,1)*[0:C-2])(:)'; +trgs(2,tmp) = ([2:R ]'*ones(1,C-1) + R*ones(R-1,1)*[1:C-1])(:)'; +trgs(3,tmp) = ([1:R-1]'*ones(1,C-1) + R*ones(R-1,1)*[1:C-1])(:)'; + +## (x,y), (x,y+1), (x+1,y+1) i.e. n, n+1, n+R+1 +tmp += (R-1)*(C-1); + +trgs(1,tmp) = ([1:R-1]'*ones(1,C-1) + R*ones(R-1,1)*[0:C-2])(:)'; +trgs(2,tmp) = ([ 2:R ]'*ones(1,C-1) + R*ones(R-1,1)*[0:C-2])(:)'; +trgs(3,tmp) = ([ 2:R ]'*ones(1,C-1) + R*ones(R-1,1)*[1:C-1])(:)'; + + +if ! all(keepp), + + keept = all (reshape(keepp(trgs),3,4*(R-1)*(C-1))); + ## keept = all (keepp(trgs)) ; + keepip = find (keepp); + keepit = find (keept); + renum = cumsum (keepp); + + pts = pts (:,keepip) ; + trgs = reshape(renum (trgs (:,keepit)), 3, columns(keepit)); + +end +s = vrml_faces (pts, trgs, "col", col, "tran", tran, "creaseAngle", creaseAngle); + +## x=-1:0.1:1;y=(x=ones(columns(x),1)*x)'; +## r = sqrt (x.^2+y.^2); c = cos(2*pi*r.^2)./(2+r.^2); +## Punch some holes +## holes = ind2sub (size (c), [7,7,9,10,15,16;8,9,10,11,14,14]') +## c(holes) = nan; +## vrml_browse ("tmp.wrl",vrml_thick_surf (x, y, c)) +## or save_vrml ("tmp.wrl", vrml_thick_surf (x, y, c)) +endfunction + diff --git a/octave_packages/vrml-1.0.13/vrml_transfo.m b/octave_packages/vrml-1.0.13/vrml_transfo.m new file mode 100644 index 0000000..3560ec1 --- /dev/null +++ b/octave_packages/vrml-1.0.13/vrml_transfo.m @@ -0,0 +1,115 @@ +## Copyright (C) 2002 Etienne Grossmann +## +## This program is free software; you can redistribute it and/or modify it under +## the terms of the GNU General Public License as published by the Free Software +## Foundation; either version 3 of the License, or (at your option) any later +## version. +## +## This program is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +## details. +## +## You should have received a copy of the GNU General Public License along with +## this program; if not, see . + +## v = vrml_transfo(s,t,r,c,d) +## +## s : string of vrml code. +## t : 3 Translation default : [0,0,0] +## r : 3x3 Rotation matrix, or default : eye(3) +## 3 Scaled rotation axis. +## c : 3 or 1 Scale default : 1 +## d : string DEF name default : '' +## +## v : string v is s, enclosed in a Transform {} vrml node with +## rotation, translation and scale params given by r, t and c. +## + +function v = vrml_transfo(s,t,r,c,DEF) + +## Hint : if s is "%s", you may later do v2 = sprintf (v,s2) which should be +## equal to vrml_transfo (s2,etc) + +verbose = 0; +## +t0 = [0;0;0]; +r0 = [1,0,0,0]; +c0 = [1;1;1]; +if nargin<2 || isnan (t), t = t0; end # Default translation +if nargin<3 || isnan (r), r = r0; end # Default rotation +if nargin<4 || isnan (c), c = c0; end # Default scale +if nargin<5, DEF = ""; end + +if verbose > 1 + if nargin > 1, printf ("vrml_transfo : t = %s\n",sprintf ("%f ",t)); end + if nargin > 2, printf ("vrml_transfo : r = %s\n",sprintf ("%f ",r)); end + if nargin > 3, printf ("vrml_transfo : c = %s\n",sprintf ("%f ",c)); end + if nargin > 4, printf ("vrml_transfo : DEF = %s\n",DEF); end +end +t = t(:); +c = c(:); +## if nargin<4, s = "%s" ; end + +if prod(size(t)) != 3, error("t has %i elements, not 3",prod(size(t))); end + + +if prod(size(c))==1, c = [c;c;c]; end + +if all(size(r) == 3) + if abs (det (r) - 1) > sqrt (eps), r2 = orth (r); + else r2 = r; + end + [axis,ang] = rotparams (r2); +elseif prod(size(r)) == 4 + ang = r(4); + axis = r(1:3); +elseif prod(size(r)) == 3 + ang = norm(r); + if abs(ang)>eps, + axis = r/ang; + else + axis = [0,1,0]; ang = 0; + end +else + error ("vrml_transfo : rotation should have size 3x3, 3 or 4\n"); +end +if verbose, + printf (["vrml_transfo : %8.3f %8.3f %8.3f %8.3f\n",\ + " %8.3f %8.3f %8.3f\n"],\ + axis,ang,t); + printf ("length of string is %i\n",prod(size(s))); +end + + # Indent s by 4 +if length (s) && strcmp(s(prod(size(s))),"\n") # chomp + s = s(1:prod(size(s))-1) ; +end +## strrep is slow, as if it copied everything by hand. So don't indent. +# mytic() ; +# s = [" ",strrep(s,"\n","\n ")] ; +# mytic() +if verbose, printf (" done indenting s\n"); end + +sr = st = ss = sd = ""; +if abs (ang) > sqrt (eps) + sr = sprintf (" rotation %8.3f %8.3f %8.3f %8.3f\n",axis,ang); +end +if any (abs (t - t0)>sqrt (eps)) + st = sprintf (" translation %8.3f %8.3f %8.3f\n",t); +end +if any (abs (c - c0)>sqrt (eps)) + ss = sprintf (" scale %8.3f %8.3f %8.3f\n",c); +end +if !isempty (DEF), sd = ["DEF ",DEF," "]; end + +v = sprintf([sd,"Transform {\n",sr,st,ss,\ + " children [\n%s\n",\ + " ]\n",\ + "}\n",\ + ],\ + s) ; +## keyboard + +endfunction + diff --git a/octave_packages/zenity-0.5.7/doc-cache b/octave_packages/zenity-0.5.7/doc-cache new file mode 100644 index 0000000..3ee565e --- /dev/null +++ b/octave_packages/zenity-0.5.7/doc-cache @@ -0,0 +1,372 @@ +# Created by Octave 3.6.1, Mon Apr 16 18:53:51 2012 UTC +# name: cache +# type: cell +# rows: 3 +# columns: 9 +# name: +# type: sq_string +# elements: 1 +# length: 15 +zenity_calendar + + +# name: +# type: sq_string +# elements: 1 +# length: 395 + -- Function File: D = zenity_calendar(TITLE, DAY, MONTH, YEAR) + Displays a date selection window. The variable TITLE sets the + title of the calendar. The optional arguments DAY, MONTH, and + YEAR changes the standard selected date. + + See also: zenity_list, zenity_progress, zenity_entry, + zenity_message, zenity_text_info, zenity_file_selection, + zenity_notification + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 33 +Displays a date selection window. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +zenity_entry + + +# name: +# type: sq_string +# elements: 1 +# length: 533 + -- Function File: S = zenity_entry(TEXT, ENTRY_TEXT, PASSWORD) + Displays a text entry dialog. The variable TEXT sets the title of + the dialog, and the ENTRY_TEXT variable sets the default value of + the text entry field. If the PASSWORD variable is non-empty the + value of the text entry field will not be displayed on the screen. + All arguments are optional. + + See also: zenity_calendar, zenity_list, zenity_progress, + zenity_message, zenity_text_info, zenity_file_selection, + zenity_notification + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 29 +Displays a text entry dialog. + + + +# name: +# type: sq_string +# elements: 1 +# length: 21 +zenity_file_selection + + +# name: +# type: sq_string +# elements: 1 +# length: 668 + -- Function File: zenity_file_selection (TITLE, OPTION1, ...) + Opens a file selection dialog. The variable TITLE sets the title + of the file selection window. The optional string arguments can be + `save' + The file selection dialog is a dialog for saving files. + + `multiple' + It is possible to select multiple files. + + `directory' + It is possible to select directories as well as files. + + `Anything else' + The argument will be the default selected file. + and `error'. + + See also: zenity_calendar, zenity_list, zenity_progress, + zenity_entry, zenity_message, zenity_text_info, zenity_notification + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 30 +Opens a file selection dialog. + + + +# name: +# type: sq_string +# elements: 1 +# length: 11 +zenity_list + + +# name: +# type: sq_string +# elements: 1 +# length: 1613 + -- Function File: S = zenity_list(TITLE, COLUMNS, DATA, OPTIONS1, ...) + Displays a graphical list of data. The variable TITLE sets the + title of the list. The variable COLUMNS must be a cell array of + strings of length N containing the headers of the list. The + variable DATA must be cell array of strings of length NxM + containing the data of the list. + + The code + zenity_list("Age versus Height", {"Age", "Height"}, + {"10", "20"; "120cm", "180cm"}) + produces a list of the data. The user can select a row in the + table, and it's first value will be returned by the function when + the user closes the window. + + It's possible to alter the behaviour of the list window by passing + more than three arguments to the funtion. Theese optional string + arguments can be + `checklist' + The first row in the list will be a check box. The first + value of each data row must be either "TRUE" or "FALSE". + + `radiolist' + The first row in the list will be a radio list. The first + value of each data row must be either "TRUE" or "FALSE". + + `editable' + The values of the list will be editable by the user. + + `A numeric value' + The value returned by the function will be the value of this + column of the user selected row. + + `all' + The value returned by the function will be the entire row + selected by the user. + + See also: zenity_calendar, zenity_progress, zenity_entry, + zenity_message, zenity_text_info, zenity_file_selection, + zenity_notification + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Displays a graphical list of data. + + + +# name: +# type: sq_string +# elements: 1 +# length: 14 +zenity_message + + +# name: +# type: sq_string +# elements: 1 +# length: 637 + -- Function File: zenity_message (TEXT, TYPE) + Displays a graphical message dialog. The variable TEXT sets the + message of the dialog, and the optional variable TYPE sets the + type of the message. TYPE must be one of the following strings + `error', `info', `question', and `warning'. The default value of + TYPE is `info'. Retuns the value `status' which is 0 for 'Ok' and + 1 for 'Cancel' button selection; a value of -1 indicates a failure + of dialog box. + + See also: zenity_calendar, zenity_list, zenity_progress, + zenity_entry, zenity_text_info, zenity_file_selection, + zenity_notification + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 36 +Displays a graphical message dialog. + + + +# name: +# type: sq_string +# elements: 1 +# length: 19 +zenity_notification + + +# name: +# type: sq_string +# elements: 1 +# length: 457 + -- Function File: zenity_notification (TEXT, ICON) + Displays an icon with a text in the notification area. The + variable TEXT sets the text in the notification area, and the + optional variable ICON determines which icon to show. ICON can be + either `info', `warning', `question', and `error'. + + See also: zenity_calendar, zenity_list, zenity_progress, + zenity_entry, zenity_message, zenity_text_info, + zenity_file_selection + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Displays an icon with a text in the notification area. + + + +# name: +# type: sq_string +# elements: 1 +# length: 15 +zenity_progress + + +# name: +# type: sq_string +# elements: 1 +# length: 1142 + -- Function File: H = zenity_progress(TITLE, OPTION1, OPTION2) + -- Function File: zenity_progress (H, PROGRESS) + -- Function File: zenity_progress (H, PROGRESS, TEXT) + Displays a graphical progress bar. If the first argument is + either non-present or a string, a new progress bar is created and + a handle is returned. If the first argument is a string it will be + used as the title of the progress bar. The two optional arguments + OPTION1 and OPTION2 can be + `auto-close' + The progress bar will be closed when it reaches 100. + + `pulsate' + The progress bar will pulsate. + + If the first argument is a handle to a progress bar and the second + argument is an integer, the progress bar will set its current value + to the given integer. If the second argument is a string, the text + of the progress bar will be set to the given string. It is + possible to pass both an integer and a string to the function in + one function call. + + See also: zenity_calendar, zenity_list, zenity_entry, + zenity_message, zenity_text_info, zenity_file_selection, + zenity_notification + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 34 +Displays a graphical progress bar. + + + +# name: +# type: sq_string +# elements: 1 +# length: 12 +zenity_scale + + +# name: +# type: sq_string +# elements: 1 +# length: 1064 + -- Function File: OUTPUT = zenity_scale(TITLE,TEXT, VALUE, MINVAL, + MAXVAL,STEP,PRINT_PARTIAL,HIDEVAL) + Displays a selection scale (range widget) window. Allows the user + to choose a parameter within the set ranges, and sets default + value, and step sizes. The variable TITLE sets the title of the + window. The variable TEXT sets the label of the range widget. + The other arguments VALUE, MINVAL,MAXVAL, STEP, PRINT_PARTIAL, and + HIDEVAL. The range widget can be used to select anywhere from + MINVAL to MAXVAL values in increments of STEP. The variable + PRINT_PARTIAL and HIDEVAL are boolean flags to partial and hidden + views of the value on the range widget. The first 3 parameters + are essential, while the remaining parameters MINVAL, + MAXVAL,STEP,PRINT_PARTIAL,HIDEVAL if not specified take on default + values of 0,100,1,false,false respectively. + + See also: zenity_list, zenity_progress, zenity_entry, + zenity_message, zenity_text_info, zenity_file_selection, + zenity_notification + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 49 +Displays a selection scale (range widget) window. + + + +# name: +# type: sq_string +# elements: 1 +# length: 16 +zenity_text_info + + +# name: +# type: sq_string +# elements: 1 +# length: 560 + -- Function File: S = zenity_text_info(TITLE, TEXT, EDITABLE) + Display a large amount of text in a graphical display. The title + of the display window is set with the variable TITLE, and the + actual text ti display is set with the variable TEXT. If the + optional argument EDITABLE is given the displayed text is + editable. In this case the altered text is returned from the + function. + + See also: zenity_calendar, zenity_list, zenity_progress, + zenity_entry, zenity_message, zenity_file_selection, + zenity_notification + + + + + +# name: +# type: sq_string +# elements: 1 +# length: 54 +Display a large amount of text in a graphical display. + + + + + diff --git a/octave_packages/zenity-0.5.7/packinfo/.autoload b/octave_packages/zenity-0.5.7/packinfo/.autoload new file mode 100644 index 0000000..e69de29 diff --git a/octave_packages/zenity-0.5.7/packinfo/DESCRIPTION b/octave_packages/zenity-0.5.7/packinfo/DESCRIPTION new file mode 100644 index 0000000..27fc7bb --- /dev/null +++ b/octave_packages/zenity-0.5.7/packinfo/DESCRIPTION @@ -0,0 +1,15 @@ +Name: Zenity +Version: 0.5.7 +Date: 2009-05-06 +Author: Søren Hauberg +Maintainer: Søren Hauberg +Title: Zenity +Description: A set of functions for creating simple graphical + user interfaces. It is currently possible to create + calendar windows, text entries, file selection dialogs, + lists, message windows, icons in the notification area, + and windows for large amount of text. +License: GPL version 2 or later +SystemRequirements: zenity (>= 2.16) +Url: http://octave.sf.net +Autoload: yes diff --git a/octave_packages/zenity-0.5.7/packinfo/INDEX b/octave_packages/zenity-0.5.7/packinfo/INDEX new file mode 100644 index 0000000..70c3263 --- /dev/null +++ b/octave_packages/zenity-0.5.7/packinfo/INDEX @@ -0,0 +1,11 @@ +Zenity >> Zenity +Simple GUIs + zenity_calendar + zenity_entry + zenity_file_selection + zenity_list + zenity_message + zenity_notification + zenity_text_info + zenity_progress + zenity_scale diff --git a/octave_packages/zenity-0.5.7/zenity_calendar.m b/octave_packages/zenity-0.5.7/zenity_calendar.m new file mode 100644 index 0000000..ed29cbf --- /dev/null +++ b/octave_packages/zenity-0.5.7/zenity_calendar.m @@ -0,0 +1,48 @@ +## Copyright (C) 2006 Søren Hauberg +## +## 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{d} = zenity_calendar(@var{title}, @var{day}, @var{month}, @var{year}) +## Displays a date selection window. +## The variable @var{title} sets the title of the calendar. +## The optional arguments @var{day}, @var{month}, and @var{year} changes +## the standard selected date. +## +## @seealso{zenity_list, zenity_progress, zenity_entry, zenity_message, +## zenity_text_info, zenity_file_selection, zenity_notification} +## @end deftypefn + +function d = zenity_calendar(title, day, month, year) + [Y, M, D] = datevec(date); + if (nargin < 1), title = "Select a date"; endif + if (nargin < 2), day = D; endif + if (nargin < 3), month = M; endif + if (nargin < 4), year = Y; endif + + cmd = sprintf(['zenity --calendar --title="%s" --text="%s" ', ... + '--day=%d --month=%d --year=%d --date-format="%%m/%%d/%%Y"'], + title, title, day, month, year); + [status, output] = system(cmd); + if (status == 0) + if (length(output) > 0 && output(end) == "\n") + output = output(1:end-1); + endif + d = datestr(output); + elseif (status == 1) + d = ""; + else + error("zenity_calendar: %s", output); + endif +endfunction diff --git a/octave_packages/zenity-0.5.7/zenity_entry.m b/octave_packages/zenity-0.5.7/zenity_entry.m new file mode 100644 index 0000000..5131257 --- /dev/null +++ b/octave_packages/zenity-0.5.7/zenity_entry.m @@ -0,0 +1,48 @@ +## Copyright (C) 2006 Søren Hauberg +## +## 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{s} = zenity_entry(@var{text}, @var{entry_text}, @var{password}) +## Displays a text entry dialog. +## The variable @var{text} sets the title of the dialog, and the +## @var{entry_text} variable sets the default value of the text +## entry field. If the @var{password} variable is non-empty the +## value of the text entry field will not be displayed on the screen. +## All arguments are optional. +## +## @seealso{zenity_calendar, zenity_list, zenity_progress, zenity_message, +## zenity_text_info, zenity_file_selection, zenity_notification} +## @end deftypefn + +function s = zenity_entry(text, entrytext, password) + if (nargin < 1), text = ""; endif + if (nargin < 2), entrytext = ""; endif + if (nargin < 3), password = ""; endif + + if (!isempty(text)), text = sprintf('--text="%s" --title="%s"', text, text); endif + if (!isempty(entrytext)), entrytext = sprintf('--entry-text="%s"', entrytext); endif + if (!isempty(password)), password = "--hide-text"; endif + + cmd = sprintf('zenity --entry %s %s %s', text, entrytext, password); + [status, output] = system(cmd); + if (status == 0) + if (output(end) == "\n") output = output(1:end-1); endif + s = output; + elseif (status == 1) + s = ""; + else + error("zenity_entry: %s", output); + endif +endfunction diff --git a/octave_packages/zenity-0.5.7/zenity_file_selection.m b/octave_packages/zenity-0.5.7/zenity_file_selection.m new file mode 100644 index 0000000..7162996 --- /dev/null +++ b/octave_packages/zenity-0.5.7/zenity_file_selection.m @@ -0,0 +1,80 @@ +## Copyright (C) 2006 Søren Hauberg +## +## 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} zenity_file_selection(@var{title}, @var{option1}, ...) +## Opens a file selection dialog. +## The variable @var{title} sets the title of the file selection window. +## The optional string arguments can be +## @table @samp +## @item save +## The file selection dialog is a dialog for saving files. +## @item multiple +## It is possible to select multiple files. +## @item directory +## It is possible to select directories as well as files. +## @item Anything else +## The argument will be the default selected file. +## @end table +## and @code{error}. +## +## @seealso{zenity_calendar, zenity_list, zenity_progress, zenity_entry, zenity_message, +## zenity_text_info, zenity_notification} +## @end deftypefn + +function files = zenity_file_selection(title, varargin) + + save = multiple = directory = filename = title = ""; + if (nargin == 0 || isempty(title)), title = "Select a file"; endif + for i = 1:length(varargin) + option = varargin{i}; + isc = ischar(option); + if (isc && strcmpi(option, "save")) + save = "--save"; + elseif (isc && strcmpi(option, "multiple")) + multiple = "--multiple"; + elseif (isc && strcmpi(option, "directory")) + directory = "--directory"; + elseif (isc) + filename = sprintf('--filename="%s"', varargin{i}); + else + error("zenity_file_selection: unsupported option"); + endif + endfor + + cmd = sprintf('zenity --file-selection --title="%s" --separator=":" %s %s %s %s', ... + title, save, multiple, directory, filename); + [status, output] = system(cmd); + if (status == 0) + if (length(output) > 0 && output(end) == "\n") + output = output(1:end-1); + endif + idx = strfind(output, ":"); + idx = [0, idx, length(output)+1]; + l = length(idx); + if (l == 2) + files = output; + else + files = cell(1, l-1); + for i = 1:l-1 + files{i} = output((idx(i)+1):(idx(i+1)-1)); + endfor + endif + elseif (status == 1) + files = ""; + else + error("zenity_file_selection: %s", output); + endif +endfunction diff --git a/octave_packages/zenity-0.5.7/zenity_list.m b/octave_packages/zenity-0.5.7/zenity_list.m new file mode 100644 index 0000000..03e6c96 --- /dev/null +++ b/octave_packages/zenity-0.5.7/zenity_list.m @@ -0,0 +1,105 @@ +## Copyright (C) 2006 Søren Hauberg +## +## 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{s} = zenity_list(@var{title}, @var{columns}, @var{data}, @var{options1}, ...) +## Displays a graphical list of data. +## The variable @var{title} sets the title of the list. The variable +## @var{columns} must be a cell array of strings of length N containing the headers +## of the list. The variable @var{data} must be cell array of strings of +## length NxM containing the data of the list. +## +## The code +## @example +## zenity_list("Age versus Height", @{"Age", "Height"@}, +## @{"10", "20"; "120cm", "180cm"@}) +## @end example +## produces a list of the data. The user can select a row in the table, and it's +## first value will be returned by the function when the user closes the window. +## +## It's possible to alter the behaviour of the list window by passing more than +## three arguments to the funtion. Theese optional string arguments can be +## @table @samp +## @item checklist +## The first row in the list will be a check box. The first value of each data row +## must be either "TRUE" or "FALSE". +## @item radiolist +## The first row in the list will be a radio list. The first value of each data row +## must be either "TRUE" or "FALSE". +## @item editable +## The values of the list will be editable by the user. +## @item A numeric value +## The value returned by the function will be the value of this column +## of the user selected row. +## @item all +## The value returned by the function will be the entire row selected by the user. +## @end table +## +## @seealso{zenity_calendar, zenity_progress, zenity_entry, zenity_message, +## zenity_text_info, zenity_file_selection, zenity_notification} +## @end deftypefn + +function s = zenity_list(title, columns, data, varargin) + if (nargin < 3 || !ischar(title) || !iscellstr(columns) || !iscellstr(data)) + print_usage(); + endif + + checklist = radiolist = editable = ""; + print_column = "1"; + for i = 1:length(varargin) + option = varargin{i}; + isc = ischar(option); + if (isc && strcmpi(option, "checklist")) + checklist = "--checklist"; + elseif (isc && strcmpi(option, "radiolist")) + radiolist = "--radiolist"; + elseif (isc && strcmpi(option, "editable")) + editable = "--editable"; + elseif (isc && strcmpi(option, "all")) + print_column = "all"; + elseif (isnumeric(option)) + print_column = num2str(option); + else + error("zenity_list: unsupported option"); + endif + endfor + + columns = sprintf('--column="%s" ', columns{:}); + data = sprintf("%s ", data{:}); + + cmd = sprintf('zenity --list --title="%s" %s %s %s --print-column="%s" --separator=":" %s %s', ... + title, checklist, radiolist, editable, print_column, columns, data); + [status, output] = system(cmd); + if (status == 0) + if (length(output) > 0 && output(end) == "\n") + output = output(1:end-1); + endif + idx = strfind(output, ":"); + idx = [0, idx, length(output)+1]; + l = length(idx); + if (l == 2) + s = output; + else + s = cell(1, l-1); + for i = 1:l-1 + s{i} = output((idx(i)+1):(idx(i+1)-1)); + endfor + endif + elseif (status == 1) + s = ""; + else + error("zenity_list: %s", output); + endif +endfunction diff --git a/octave_packages/zenity-0.5.7/zenity_message.m b/octave_packages/zenity-0.5.7/zenity_message.m new file mode 100644 index 0000000..72464b9 --- /dev/null +++ b/octave_packages/zenity-0.5.7/zenity_message.m @@ -0,0 +1,43 @@ +## Copyright (C) 2006 Søren Hauberg +## +## 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} zenity_message(@var{text}, @var{type}) +## Displays a graphical message dialog. +## The variable @var{text} sets the message of the dialog, and the +## optional variable @var{type} sets the type of the message. +## @var{type} must be one of the following strings @code{error}, +## @code{info}, @code{question}, and @code{warning}. The default +## value of @var{type} is @code{info}. Retuns the value @code{status} +## which is 0 for 'Ok' and 1 for 'Cancel' button selection; a value +## of -1 indicates a failure of dialog box. +## +## @seealso{zenity_calendar, zenity_list, zenity_progress, zenity_entry, +## zenity_text_info, zenity_file_selection, zenity_notification} +## @end deftypefn + +function status=zenity_message(text, type) + if (nargin == 0 || !ischar(text)), print_usage(); endif + if (nargin < 2), type = "info"; endif + if !(ischar(type) && any(strcmp(type, {"error", "info", "question", "warning"}))) + error("zenity_message: unsupported message type: %s", type); + endif + + cmd = sprintf('zenity --%s --text="%s"', type, text); + [status, output] = system(cmd); + if (status == -1) + error("zenity_message: %s", output); + endif +endfunction diff --git a/octave_packages/zenity-0.5.7/zenity_notification.m b/octave_packages/zenity-0.5.7/zenity_notification.m new file mode 100644 index 0000000..f5970e3 --- /dev/null +++ b/octave_packages/zenity-0.5.7/zenity_notification.m @@ -0,0 +1,43 @@ +## Copyright (C) 2006 Søren Hauberg +## +## 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} zenity_notification(@var{text}, @var{icon}) +## Displays an icon with a text in the notification area. +## The variable @var{text} sets the text in the notification area, and the +## optional variable @var{icon} determines which icon to show. +## @var{icon} can be either @code{info}, @code{warning}, @code{question}, +## and @code{error}. +## +## @seealso{zenity_calendar, zenity_list, zenity_progress, zenity_entry, zenity_message, +## zenity_text_info, zenity_file_selection} +## @end deftypefn + +function zenity_notification(text, icon) + if (nargin == 0 || !ischar(text)) + print_usage(); + endif + + icon = ""; + if (nargin > 1 && ischar(icon)) + icon = sprintf('--window-icon="%s"', icon); + endif + + cmd = sprintf('zenity --notification --text="%s" %s', text, icon); + [status, output] = system(cmd); + if (status == -1) + error("zenity_notification: %s", output); + endif +endfunction diff --git a/octave_packages/zenity-0.5.7/zenity_progress.m b/octave_packages/zenity-0.5.7/zenity_progress.m new file mode 100644 index 0000000..cd7df5d --- /dev/null +++ b/octave_packages/zenity-0.5.7/zenity_progress.m @@ -0,0 +1,87 @@ +## Copyright (C) 2006 Søren Hauberg +## +## 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{h} = zenity_progress(@var{title}, @var{option1}, @var{option2}) +## @deftypefnx {Function File} zenity_progress(@var{h}, @var{progress}) +## @deftypefnx {Function File} zenity_progress(@var{h}, @var{progress}, @var{text}) +## Displays a graphical progress bar. +## If the first argument is either non-present or a string, a new progress bar is +## created and a handle is returned. If the first argument is a string it will be +## used as the title of the progress bar. The two optional arguments @var{option1} +## and @var{option2} can be +## @table @samp +## @item auto-close +## The progress bar will be closed when it reaches 100. +## @item pulsate +## The progress bar will pulsate. +## @end table +## +## If the first argument is a handle to a progress bar and the second +## argument is an integer, the progress bar will set its current value +## to the given integer. If the second argument is a string, the text +## of the progress bar will be set to the given string. +## It is possible to pass both an integer and a string to the function +## in one function call. +## +## @seealso{zenity_calendar, zenity_list, zenity_entry, zenity_message, +## zenity_text_info, zenity_file_selection, zenity_notification} +## @end deftypefn + +function pid = zenity_progress(h, progress, text) + ## Create a progress bar? + if (nargin == 0 || (nargin >= 1 && ischar(h))) + ## Title + title = options = ""; + if (nargin == 1) + title = sprintf('--title="%s" --text="%s"', h, h); + endif + ## Options + if (nargin > 1 && ischar(progress)) + if (strcmpi(progress, "auto-close")) + options = sprintf("%s --auto-close", options); + elseif (strcmpi(progress, "pulsate")) + options = sprintf("%s --pulsate", options); + endif + endif + if (nargin > 2 && ischar(text)) + if (strcmpi(text, "auto-close")) + options = sprintf("%s --auto-close", options); + elseif (strcmpi(text, "pulsate")) + options = sprintf("%s --pulsate", options); + endif + endif + ## Start the process + pid = popen(["zenity --progress ", title, " ", options], "w"); + ## Handle an existing process + elseif (nargin > 0 && isnumeric(h)) + out = ""; + if (nargin > 1 && isnumeric(progress)) + out = sprintf("%s\n%d\n", out, progress); + endif + if (nargin > 1 && ischar(progress)) + out = sprintf("%s\n#%s\n", out, progress); + endif + if (nargin > 2 && isnumeric(text)) + out = sprintf("%s\n%d\n", out, text); + endif + if (nargin > 2 && ischar(text)) + out = sprintf("%s\n#%s\n", out, text); + endif + fputs(h, out); + else + print_usage(); + endif +endfunction diff --git a/octave_packages/zenity-0.5.7/zenity_scale.m b/octave_packages/zenity-0.5.7/zenity_scale.m new file mode 100644 index 0000000..1194cc6 --- /dev/null +++ b/octave_packages/zenity-0.5.7/zenity_scale.m @@ -0,0 +1,71 @@ +## Copyright (C) 2006 Muthiah Annamalai +## +## 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{output} = zenity_scale(@var{title},@var{text}, @var{value}, @var{minval}, @var{maxval},@var{step},@var{print_partial},@var{hideval}) +## Displays a selection scale (range widget) window. +## Allows the user to choose a parameter within the set ranges, and sets +## default value, and step sizes. +## The variable @var{title} sets the title of the window. +## The variable @var{text} sets the label of the range widget. +## The other arguments @var{value}, @var{minval},@var{maxval}, +## @var{step}, @var{print_partial}, and @var{hideval}. +## The range widget can be used to select anywhere from @var{minval} to +## @var{maxval} values in increments of @var{step}. The variable +## @var{print_partial} and @var{hideval} are boolean flags to partial +## and hidden views of the value on the range widget. +## The first 3 parameters are essential, while the remaining parameters +## @var{minval}, @var{maxval},@var{step},@var{print_partial},@var{hideval} if +## not specified take on default values of 0,100,1,false,false +## respectively. +## @seealso{zenity_list, zenity_progress, zenity_entry, zenity_message, +## zenity_text_info, zenity_file_selection, zenity_notification} +## @end deftypefn + +function output = zenity_scale(title,text, value, minval, maxval, step, print_partial, hideval) + + if (nargin < 1), title="Adjust the scale value"; endif + if (nargin < 2), text=""; endif + if (nargin < 3), value=0; endif + if (nargin < 4), minval= 0; endif + if (nargin < 5), maxval= 100; endif + if (nargin < 6), step = 1; endif + if (nargin < 7), print_partial = false; endif + if (nargin < 8), hideval = false; endif + + ppartial=""; + hvalue=""; + + if(length(title)==0), title="Adjust the scale value"; endif + if(print_partial), ppartial="--print-partial"; endif + if(hideval), hvalue="--hide-value"; endif + + cmd = sprintf(['zenity --scale --title="%s" --text="%s" ', ... + '--value=%d --min-value=%d --max-value=%d --step=%d ',... + '%s %s '],title, text, value, minval,maxval,step,ppartial,hvalue); + [status, output] = system(cmd); + if (status == 0) + output = str2num(output); + elseif (status == 1) + output = value; ##default when user kills it. + else + error("zenity_scale: %s", output); ##kill -9 + endif +endfunction +% +%(Shamelessly copied from Søren Hauberg's zenity_calendar). +%zenity --scale --text 'What is in your Wallet' --value 10 --min-value 0 --max-value 100 --step 5 +%zenity_scale('','What is in your Wallet',10,0,100,5) +% \ No newline at end of file diff --git a/octave_packages/zenity-0.5.7/zenity_text_info.m b/octave_packages/zenity-0.5.7/zenity_text_info.m new file mode 100644 index 0000000..833dbf7 --- /dev/null +++ b/octave_packages/zenity-0.5.7/zenity_text_info.m @@ -0,0 +1,54 @@ +## Copyright (C) 2006 Søren Hauberg +## +## 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{s} = zenity_text_info(@var{title}, @var{text}, @var{editable}) +## Display a large amount of text in a graphical display. +## The title of the display window is set with the variable @var{title}, +## and the actual text ti display is set with the variable @var{text}. +## If the optional argument @var{editable} is given the displayed text +## is editable. In this case the altered text is returned from the function. +## +## @seealso{zenity_calendar, zenity_list, zenity_progress, zenity_entry, zenity_message, +## zenity_file_selection, zenity_notification} +## @end deftypefn + +function s = zenity_text_info(title, text, editable) + if (nargin < 2 || !ischar(title) || !ischar(text)) + print_usage(); + endif + + if (nargin < 3) + editable = "--editable"; + else + editable = ""; + endif + + filename = tmpnam(); + fid = fopen(filename, "w"); + fprintf(fid, "%s", text); + fclose(fid); + + cmd = sprintf('zenity --text-info --title="%s" --filename="%s" %s', title, filename, editable); + [status, output] = system(cmd); + unlink(filename); + if (status == 0) + s = output; + elseif (status == 1) + s = ""; + else + error("zenity_text_info: %s", output); + endif +endfunction -- 2.47.0